utils/warnings.cmo : utils/warnings.cmi
utils/warnings.cmx : utils/warnings.cmi
parsing/ast_helper.cmi : parsing/parsetree.cmi parsing/longident.cmi \
- parsing/location.cmi parsing/asttypes.cmi
+ parsing/location.cmi parsing/docstrings.cmi parsing/asttypes.cmi
parsing/ast_mapper.cmi : parsing/parsetree.cmi parsing/location.cmi
parsing/asttypes.cmi : parsing/location.cmi
+parsing/docstrings.cmi : parsing/parsetree.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/location.cmi
+parsing/parser.cmi : parsing/parsetree.cmi parsing/location.cmi \
+ parsing/docstrings.cmi
parsing/parsetree.cmi : parsing/longident.cmi parsing/location.cmi \
parsing/asttypes.cmi
parsing/pprintast.cmi : parsing/parsetree.cmi parsing/longident.cmi \
parsing/printast.cmi : parsing/parsetree.cmi
parsing/syntaxerr.cmi : parsing/location.cmi
parsing/ast_helper.cmo : parsing/parsetree.cmi parsing/longident.cmi \
- parsing/location.cmi parsing/asttypes.cmi parsing/ast_helper.cmi
+ parsing/location.cmi parsing/docstrings.cmi parsing/asttypes.cmi \
+ parsing/ast_helper.cmi
parsing/ast_helper.cmx : parsing/parsetree.cmi parsing/longident.cmx \
- parsing/location.cmx parsing/asttypes.cmi parsing/ast_helper.cmi
+ parsing/location.cmx parsing/docstrings.cmx parsing/asttypes.cmi \
+ parsing/ast_helper.cmi
parsing/ast_mapper.cmo : parsing/parsetree.cmi utils/misc.cmi \
parsing/longident.cmi parsing/location.cmi utils/config.cmi \
utils/clflags.cmi parsing/asttypes.cmi parsing/ast_helper.cmi \
parsing/longident.cmx parsing/location.cmx utils/config.cmx \
utils/clflags.cmx parsing/asttypes.cmi parsing/ast_helper.cmx \
parsing/ast_mapper.cmi
+parsing/docstrings.cmo : utils/warnings.cmi parsing/parsetree.cmi \
+ parsing/location.cmi parsing/asttypes.cmi parsing/docstrings.cmi
+parsing/docstrings.cmx : utils/warnings.cmx parsing/parsetree.cmi \
+ parsing/location.cmx parsing/asttypes.cmi parsing/docstrings.cmi
parsing/lexer.cmo : utils/warnings.cmi parsing/parser.cmi utils/misc.cmi \
- parsing/location.cmi parsing/lexer.cmi
+ parsing/location.cmi parsing/docstrings.cmi parsing/lexer.cmi
parsing/lexer.cmx : utils/warnings.cmx parsing/parser.cmx utils/misc.cmx \
- parsing/location.cmx parsing/lexer.cmi
+ parsing/location.cmx parsing/docstrings.cmx parsing/lexer.cmi
parsing/location.cmo : utils/warnings.cmi utils/terminfo.cmi \
parsing/location.cmi
parsing/location.cmx : utils/warnings.cmx utils/terminfo.cmx \
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/location.cmi parsing/lexer.cmi parsing/docstrings.cmi \
+ parsing/parse.cmi
parsing/parse.cmx : parsing/syntaxerr.cmx parsing/parser.cmx \
- parsing/location.cmx parsing/lexer.cmx parsing/parse.cmi
+ parsing/location.cmx parsing/lexer.cmx parsing/docstrings.cmx \
+ parsing/parse.cmi
parsing/parser.cmo : parsing/syntaxerr.cmi parsing/parsetree.cmi \
- parsing/longident.cmi parsing/location.cmi utils/clflags.cmi \
- parsing/asttypes.cmi parsing/ast_helper.cmi parsing/parser.cmi
+ parsing/longident.cmi parsing/location.cmi parsing/docstrings.cmi \
+ utils/clflags.cmi parsing/asttypes.cmi parsing/ast_helper.cmi \
+ parsing/parser.cmi
parsing/parser.cmx : parsing/syntaxerr.cmx parsing/parsetree.cmi \
- parsing/longident.cmx parsing/location.cmx utils/clflags.cmx \
- parsing/asttypes.cmi parsing/ast_helper.cmx parsing/parser.cmi
+ parsing/longident.cmx parsing/location.cmx parsing/docstrings.cmx \
+ utils/clflags.cmx parsing/asttypes.cmi parsing/ast_helper.cmx \
+ parsing/parser.cmi
parsing/pprintast.cmo : parsing/parsetree.cmi utils/misc.cmi \
parsing/longident.cmi parsing/location.cmi parsing/asttypes.cmi \
parsing/pprintast.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/envaux.cmi : typing/subst.cmi typing/path.cmi typing/env.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/path.cmi : typing/ident.cmi
typing/predef.cmi : typing/types.cmi typing/path.cmi typing/ident.cmi
typing/primitive.cmi :
+typing/printtyped.cmi : typing/typedtree.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/ident.cmi typing/env.cmi parsing/asttypes.cmi typing/annot.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
+ typing/includecore.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/typedtree.cmi : typing/types.cmi typing/primitive.cmi typing/path.cmi \
parsing/parsetree.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 typing/path.cmi \
parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \
typing/includemod.cmi typing/ident.cmi typing/env.cmi \
typing/datarepr.cmx : typing/types.cmx typing/path.cmx parsing/location.cmx \
typing/ident.cmx typing/btype.cmx parsing/asttypes.cmi \
typing/datarepr.cmi
+typing/envaux.cmo : typing/types.cmi typing/subst.cmi typing/printtyp.cmi \
+ typing/path.cmi utils/misc.cmi typing/ident.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 utils/misc.cmx typing/ident.cmx typing/env.cmx \
+ parsing/asttypes.cmi typing/envaux.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.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 utils/misc.cmi typing/ident.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 utils/misc.cmx typing/ident.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/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/printtyped.cmo : typing/typedtree.cmi parsing/printast.cmi \
+ typing/path.cmi utils/misc.cmi parsing/longident.cmi parsing/location.cmi \
+ typing/ident.cmi parsing/asttypes.cmi typing/printtyped.cmi
+typing/printtyped.cmx : typing/typedtree.cmx parsing/printast.cmx \
+ typing/path.cmx utils/misc.cmx parsing/longident.cmx parsing/location.cmx \
+ typing/ident.cmx parsing/asttypes.cmi typing/printtyped.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.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \
utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \
typing/printtyp.cmi
-typing/printtyped.cmo : typing/typedtree.cmi parsing/printast.cmi \
- typing/path.cmi utils/misc.cmi parsing/longident.cmi parsing/location.cmi \
- typing/ident.cmi parsing/asttypes.cmi typing/printtyped.cmi
-typing/printtyped.cmx : typing/typedtree.cmx parsing/printast.cmx \
- typing/path.cmx utils/misc.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/types.cmi typing/typedtree.cmi typing/typedecl.cmi \
typing/typecore.cmi parsing/syntaxerr.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 typing/cmt_format.cmi \
- utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \
- parsing/ast_helper.cmi typing/typeclass.cmi
+ parsing/parsetree.cmi utils/misc.cmi parsing/longident.cmi \
+ parsing/location.cmi typing/includeclass.cmi typing/ident.cmi \
+ typing/env.cmi typing/ctype.cmi typing/cmt_format.cmi utils/clflags.cmi \
+ typing/btype.cmi parsing/asttypes.cmi parsing/ast_helper.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 parsing/syntaxerr.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 typing/cmt_format.cmx \
- utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \
- parsing/ast_helper.cmx typing/typeclass.cmi
+ parsing/parsetree.cmi utils/misc.cmx parsing/longident.cmx \
+ parsing/location.cmx typing/includeclass.cmx typing/ident.cmx \
+ typing/env.cmx typing/ctype.cmx typing/cmt_format.cmx utils/clflags.cmx \
+ typing/btype.cmx parsing/asttypes.cmi parsing/ast_helper.cmx \
+ typing/typeclass.cmi
typing/typecore.cmo : utils/warnings.cmi typing/typetexp.cmi \
typing/types.cmi typing/typedtree.cmi parsing/syntaxerr.cmi \
typing/subst.cmi typing/stypes.cmi typing/printtyp.cmi \
typing/ident.cmx typing/env.cmx typing/ctype.cmx utils/config.cmx \
utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \
parsing/ast_helper.cmx typing/typedecl.cmi
-typing/typedtree.cmo : typing/types.cmi typing/primitive.cmi typing/path.cmi \
- parsing/parsetree.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 \
- parsing/parsetree.cmi 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 utils/misc.cmi \
parsing/asttypes.cmi typing/typedtreeIter.cmi
typing/typedtreeIter.cmx : typing/typedtree.cmx utils/misc.cmx \
typing/typedtreeMap.cmi
typing/typedtreeMap.cmx : typing/typedtree.cmx utils/misc.cmx \
typing/typedtreeMap.cmi
+typing/typedtree.cmo : typing/types.cmi typing/primitive.cmi typing/path.cmi \
+ parsing/parsetree.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 \
+ parsing/parsetree.cmi utils/misc.cmx parsing/longident.cmx \
+ parsing/location.cmx typing/ident.cmx typing/env.cmx parsing/asttypes.cmi \
+ typing/typedtree.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 \
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/opcodes.cmo utils/misc.cmi parsing/location.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 : 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/opcodes.cmx utils/misc.cmx parsing/location.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 bytecomp/printlambda.cmi typing/path.cmi utils/misc.cmi \
parsing/location.cmi bytecomp/instruct.cmi typing/ident.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 parsing/location.cmi \
- bytecomp/lambda.cmi typing/ident.cmi bytecomp/dll.cmi \
+ bytecomp/lambda.cmi typing/ident.cmi bytecomp/dll.cmi utils/config.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 \
typing/predef.cmx utils/misc.cmx bytecomp/meta.cmx parsing/location.cmx \
- bytecomp/lambda.cmx typing/ident.cmx bytecomp/dll.cmx \
+ bytecomp/lambda.cmx typing/ident.cmx bytecomp/dll.cmx utils/config.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/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/CSEgen.cmi : asmcomp/mach.cmi
asmcomp/asmgen.cmi : bytecomp/lambda.cmi asmcomp/cmm.cmi
asmcomp/asmlibrarian.cmi :
asmcomp/asmlink.cmi : asmcomp/cmx_format.cmi
asmcomp/asmpackager.cmi : typing/env.cmi
+asmcomp/branch_relaxation.cmi : asmcomp/linearize.cmi \
+ asmcomp/branch_relaxation_intf.cmo
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 : bytecomp/lambda.cmi typing/ident.cmi asmcomp/debuginfo.cmi
asmcomp/cmmgen.cmi : asmcomp/cmx_format.cmi asmcomp/cmm.cmi \
asmcomp/clambda.cmi
+asmcomp/cmm.cmi : bytecomp/lambda.cmi typing/ident.cmi asmcomp/debuginfo.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/CSEgen.cmi : asmcomp/mach.cmi
asmcomp/deadcode.cmi : asmcomp/mach.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/emit.cmi : asmcomp/linearize.cmi asmcomp/cmm.cmi
asmcomp/interf.cmi : asmcomp/mach.cmi
asmcomp/linearize.cmi : asmcomp/reg.cmi asmcomp/mach.cmi bytecomp/lambda.cmi \
asmcomp/debuginfo.cmi
asmcomp/printmach.cmi : asmcomp/reg.cmi asmcomp/mach.cmi
asmcomp/proc.cmi : asmcomp/reg.cmi asmcomp/mach.cmi
asmcomp/reg.cmi : typing/ident.cmi asmcomp/cmm.cmi
-asmcomp/reload.cmi : asmcomp/mach.cmi
asmcomp/reloadgen.cmi : asmcomp/reg.cmi asmcomp/mach.cmi
+asmcomp/reload.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/spill.cmi : asmcomp/mach.cmi
asmcomp/split.cmi : asmcomp/mach.cmi
asmcomp/strmatch.cmi : asmcomp/cmm.cmi
-asmcomp/CSE.cmo : asmcomp/mach.cmi asmcomp/CSEgen.cmi asmcomp/arch.cmo
-asmcomp/CSE.cmx : asmcomp/mach.cmx asmcomp/CSEgen.cmx asmcomp/arch.cmx
-asmcomp/CSEgen.cmo : asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/mach.cmi \
- asmcomp/CSEgen.cmi
-asmcomp/CSEgen.cmx : asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/mach.cmx \
- asmcomp/CSEgen.cmi
asmcomp/arch.cmo :
asmcomp/arch.cmx :
asmcomp/asmgen.cmo : bytecomp/translmod.cmi asmcomp/split.cmi \
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/branch_relaxation_intf.cmo : asmcomp/linearize.cmi asmcomp/arch.cmo
+asmcomp/branch_relaxation_intf.cmx : asmcomp/linearize.cmx asmcomp/arch.cmx
+asmcomp/branch_relaxation.cmo : utils/misc.cmi asmcomp/mach.cmi \
+ asmcomp/linearize.cmi asmcomp/cmm.cmi asmcomp/branch_relaxation_intf.cmo \
+ asmcomp/branch_relaxation.cmi
+asmcomp/branch_relaxation.cmx : utils/misc.cmx asmcomp/mach.cmx \
+ asmcomp/linearize.cmx asmcomp/cmm.cmx asmcomp/branch_relaxation_intf.cmx \
+ asmcomp/branch_relaxation.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/debuginfo.cmx asmcomp/compilenv.cmx utils/clflags.cmx \
asmcomp/clambda.cmx parsing/asttypes.cmi asmcomp/arch.cmx \
asmcomp/closure.cmi
-asmcomp/cmm.cmo : bytecomp/lambda.cmi typing/ident.cmi asmcomp/debuginfo.cmi \
- asmcomp/arch.cmo asmcomp/cmm.cmi
-asmcomp/cmm.cmx : bytecomp/lambda.cmx typing/ident.cmx asmcomp/debuginfo.cmx \
- asmcomp/arch.cmx asmcomp/cmm.cmi
asmcomp/cmmgen.cmo : typing/types.cmi bytecomp/switch.cmi \
asmcomp/strmatch.cmi asmcomp/proc.cmi typing/primitive.cmi utils/misc.cmi \
bytecomp/lambda.cmi typing/ident.cmi asmcomp/debuginfo.cmi \
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/cmm.cmo : bytecomp/lambda.cmi typing/ident.cmi asmcomp/debuginfo.cmi \
+ asmcomp/arch.cmo asmcomp/cmm.cmi
+asmcomp/cmm.cmx : bytecomp/lambda.cmx typing/ident.cmx asmcomp/debuginfo.cmx \
+ asmcomp/arch.cmx asmcomp/cmm.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/compilenv.cmx : utils/misc.cmx parsing/location.cmx typing/ident.cmx \
typing/env.cmx utils/config.cmx asmcomp/cmx_format.cmi \
asmcomp/clambda.cmx asmcomp/compilenv.cmi
+asmcomp/CSEgen.cmo : asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/mach.cmi \
+ asmcomp/CSEgen.cmi
+asmcomp/CSEgen.cmx : asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/mach.cmx \
+ asmcomp/CSEgen.cmi
+asmcomp/CSE.cmo : asmcomp/mach.cmi asmcomp/CSEgen.cmi asmcomp/arch.cmo
+asmcomp/CSE.cmx : asmcomp/mach.cmx asmcomp/CSEgen.cmx asmcomp/arch.cmx
asmcomp/deadcode.cmo : asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/mach.cmi \
asmcomp/deadcode.cmi
asmcomp/deadcode.cmx : asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/mach.cmx \
asmcomp/debuginfo.cmi
asmcomp/debuginfo.cmx : parsing/location.cmx bytecomp/lambda.cmx \
asmcomp/debuginfo.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/emit.cmo : asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \
asmcomp/mach.cmi asmcomp/linearize.cmi bytecomp/lambda.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/compilenv.cmi asmcomp/cmm.cmi utils/clflags.cmi \
+ asmcomp/branch_relaxation.cmi asmcomp/arch.cmo asmcomp/emit.cmi
asmcomp/emit.cmx : asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \
asmcomp/mach.cmx asmcomp/linearize.cmx bytecomp/lambda.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/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/compilenv.cmx asmcomp/cmm.cmx utils/clflags.cmx \
+ asmcomp/branch_relaxation.cmx asmcomp/arch.cmx asmcomp/emit.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/arch.cmx asmcomp/proc.cmi
asmcomp/reg.cmo : typing/ident.cmi asmcomp/cmm.cmi asmcomp/reg.cmi
asmcomp/reg.cmx : typing/ident.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/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.cmi
asmcomp/reloadgen.cmx : asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \
asmcomp/reloadgen.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/cmm.cmx utils/clflags.cmx asmcomp/arch.cmx asmcomp/reload.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
driver/compile.cmi :
driver/compmisc.cmi : typing/env.cmi
driver/errors.cmi :
-driver/main.cmi :
driver/main_args.cmi :
+driver/main.cmi :
driver/optcompile.cmi :
driver/opterrors.cmi :
driver/optmain.cmi :
parsing/asttypes.cmi driver/compmisc.cmi
driver/errors.cmo : parsing/location.cmi driver/errors.cmi
driver/errors.cmx : parsing/location.cmx driver/errors.cmi
+driver/main_args.cmo : utils/warnings.cmi driver/main_args.cmi
+driver/main_args.cmx : utils/warnings.cmx driver/main_args.cmi
driver/main.cmo : utils/warnings.cmi utils/misc.cmi driver/main_args.cmi \
parsing/location.cmi utils/config.cmi driver/compmisc.cmi \
driver/compile.cmi driver/compenv.cmi utils/clflags.cmi \
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/typemod.cmi \
typing/typedtree.cmi typing/typecore.cmi bytecomp/translmod.cmi \
typing/stypes.cmi bytecomp/simplif.cmi typing/printtyped.cmi \
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 \
- 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
+ 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/datarepr.cmi typing/ctype.cmi typing/btype.cmi \
+ toplevel/genprintval.cmi
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
+ 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/datarepr.cmx typing/ctype.cmx typing/btype.cmx \
+ toplevel/genprintval.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 \
parsing/longident.cmi parsing/location.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 \
- parsing/asttypes.cmi toplevel/topdirs.cmi
+ typing/btype.cmi parsing/asttypes.cmi toplevel/topdirs.cmi
toplevel/topdirs.cmx : utils/warnings.cmx typing/typetexp.cmx \
typing/types.cmx toplevel/trace.cmx toplevel/toploop.cmx \
bytecomp/symtable.cmx typing/printtyp.cmx typing/predef.cmx \
parsing/longident.cmx parsing/location.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 \
- parsing/asttypes.cmi toplevel/topdirs.cmi
+ typing/btype.cmx parsing/asttypes.cmi toplevel/topdirs.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 \
/byterun/.depend
/byterun/.depend.nt
/byterun/.DS_Store
-/byterun/jumptbl.h
+/byterun/caml/jumptbl.h
/byterun/primitives
/byterun/prims.c
-/byterun/opnames.h
-/byterun/version.h
+/byterun/caml/opnames.h
+/byterun/caml/version.h
/byterun/ocamlrun
/byterun/ocamlrun.exe
/byterun/ocamlrund
/testsuite/tests/tool-debugger/find-artifacts/compiler-libs
/testsuite/tests/tool-debugger/find-artifacts/out
+# /testsuite/tests/tool-debugger/no_debug_event/
+/testsuite/tests/tool-debugger/no_debug_event/*.o
+/testsuite/tests/tool-debugger/no_debug_event/*.a
+/testsuite/tests/tool-debugger/no_debug_event/*.so
+/testsuite/tests/tool-debugger/no_debug_event/*.obj
+/testsuite/tests/tool-debugger/no_debug_event/*.lib
+/testsuite/tests/tool-debugger/no_debug_event/*.dll
+/testsuite/tests/tool-debugger/no_debug_event/*.cm[ioxat]
+/testsuite/tests/tool-debugger/no_debug_event/*.cmx[as]
+/testsuite/tests/tool-debugger/no_debug_event/*.cmti
+/testsuite/tests/tool-debugger/no_debug_event/*.annot
+/testsuite/tests/tool-debugger/no_debug_event/*.result
+/testsuite/tests/tool-debugger/no_debug_event/*.byte
+/testsuite/tests/tool-debugger/no_debug_event/*.native
+/testsuite/tests/tool-debugger/no_debug_event/program
+/testsuite/tests/tool-debugger/no_debug_event/*.exe
+/testsuite/tests/tool-debugger/no_debug_event/*.exe.manifest
+/testsuite/tests/tool-debugger/no_debug_event/.depend
+/testsuite/tests/tool-debugger/no_debug_event/.depend.nt
+/testsuite/tests/tool-debugger/no_debug_event/.DS_Store
+/testsuite/tests/tool-debugger/no_debug_event/compiler-libs
+/testsuite/tests/tool-debugger/no_debug_event/out
+/testsuite/tests/tool-debugger/no_debug_event/c
+/testsuite/tests/tool-debugger/no_debug_event/c.exe
+
# /testsuite/tests/tool-lexyacc/
/testsuite/tests/tool-lexyacc/*.o
/testsuite/tests/tool-lexyacc/*.a
--- /dev/null
+S ./asmcomp
+B ./asmcomp
+
+S ./bytecomp
+B ./bytecomp
+
+S ./driver
+B ./driver
+
+S ./lex
+B ./lex
+
+S ./otherlibs/bigarray
+B ./otherlibs/bigarray
+
+S ./otherlibs/dynlink
+B ./otherlibs/dynlink
+
+S ./otherlibs/graph
+B ./otherlibs/graph
+
+S ./otherlibs/num
+B ./otherlibs/num
+
+S ./otherlibs/str
+B ./otherlibs/str
+
+S ./otherlibs/systhreads
+B ./otherlibs/systhreads
+
+S ./otherlibs/threads
+B ./otherlibs/threads
+
+S ./otherlibs/unix
+B ./otherlibs/unix
+
+S ./parsing
+B ./parsing
+
+S ./stdlib
+B ./stdlib
+
+S ./toplevel
+B ./toplevel
+
+S ./typing
+B ./typing
+
+S ./utils
+B ./utils
+
./configure
make world.opt
sudo make install
- cd testsuite && make all
- git clone git://github.com/ocaml/camlp4
- cd camlp4 && ./configure && make && sudo make install
+ (cd testsuite && make all)
+ git clone git://github.com/ocaml/camlp4 -b 4.02
+ (cd camlp4 && ./configure && make && sudo make install)
git clone git://github.com/ocaml/opam
- cd opam && ./configure && make lib-ext && make && sudo make install
+ (cd opam && ./configure && make lib-ext && make && sudo make install)
opam init -y -a git://github.com/ocaml/opam-repository
opam install -y utop
;;
-OCaml 4.02.1:
+OCaml 4.02.2:
-------------
+
+(Changes that can break existing programs are marked with a "*")
+
+Language features:
+- PR#6583: add a new class of binary operators with the same syntactic
+ precedence as method calls; these operators start with # followed
+ by a non-empty sequence of operator symbols (for instance #+, #!?).
+ It is also possible to use '#' as part of these extra symbols
+ (for instance ##, or #+#); this is rejected by the type-checker,
+ but can be used e.g. by ppx rewriters.
+ (Alain Frisch, request by Gabriel Radanne)
+* PR#6016: add a "nonrec" keyword for type declarations
+ (Jérémie Dimino)
+
+Compilers:
+- PR#6600: make -short-paths faster by building the printing map
+ incrementally
+ (Jacques Garrigue)
+- PR#6642: replace $CAMLORIGIN in -ccopt with the path to cma or cmxa
+ (Peter Zotov, Gabriel Scherer, review by Damien Doligez)
+- PR#6797: new option -output-complete-obj
+ to output an object file with included runtime and autolink libraries
+ (Peter Zotov)
+- PR#6845: -no-check-prims to tell ocamlc not to check primitives in runtime
+ (Alain Frisch)
+- GPR#149: Attach documentation comments to parse tree
+ (Leo White)
+- GPR#159: Better locations for structure/signature items
+ (Leo White)
+
+Toplevel and debugger:
+- PR#5958: generalized polymorphic #install_printer
+ (Pierre Chambart and Grégoire Henry)
+
+OCamlbuild:
+- PR#6237: explicit "infer" tag to control or disable menhir --infer
+ (Hugo Heuzard)
+- PR#6625: pass -linkpkg to files built with -output-obj.
+ (Peter Zotov)
+- PR#6702: explicit "linkpkg" and "dontlink(foo)" flags
+ (Peter Zotov, Gabriel Scherer)
+- PR#6712: Ignore common VCS directories
+ (Peter Zotov)
+- PR#6720: pass -g to C compilers when tag 'debug' is set
+ (Peter Zotov, Gabriel Scherer)
+- PR#6733: add .byte.so and .native.so targets to pass
+ -output-obj -cclib -shared.
+ (Peter Zotov)
+- PR#6733: "runtime_variant(X)" to pass -runtime-variant X option.
+ (Peter Zotov)
+- PR#6774: new menhir-specific flags "only_tokens" and "external_tokens(Foo)"
+ (François Pottier)
+
+Libraries:
+- PR#6285: Add support for nanosecond precision in Unix.stat()
+ (Jérémie Dimino, report by user 'gfxmonk')
+- PR#6781: Add higher baud rates to Unix termios
+ (Damien Doligez, report by Berke Durak)
+- PR#6834: Add Obj.{first,last}_non_constant_constructor_tag
+ (Mark Shinwell, request by Gabriel Scherer)
+
+Runtime:
+- PR#6078: Release the runtime system when calling caml_dlopen
+ (Jérémie Dimino)
+- PR#6675: GC hooks
+ (Damien Doligez and Roshan James)
+
+Build system:
+- PR#5418 (comments) : generate dependencies with $(CC) instead of gcc
+ (Damien Doligez and Michael Grünewald)
+- PR#6266: Cross compilation for iOs, Android etc
+ (Peter Zotov, review by Damien Doligez and Mark Shinwell)
+
+Installation procedure:
+- Update instructions for x86-64 PIC mode and POWER architecture builds
+ (Mark Shinwell)
+
+Bug fixes:
+- PR#5271: Location.prerr_warning is hard-coded to use Format.err_formatter
+ (Damien Doligez, report by Rolf Rolles)
+- PR#5395: OCamlbuild mishandles relative symlinks and include paths
+ (Damien Doligez, report by Didier Le Botlan)
+- PR#5822: wrong value of Options.ext_dll on windows
+ (Damien Doligez and Daniel Weil)
+- PR#5836, PR#6684: printing lazy values in ocamldebug may segfault
+ (Gabriel Scherer, request by the Coq team)
+- PR#5887: move the byterun/*.h headers to byterun/caml/*.h to avoid
+ header name clashes
+ (Jérôme Vouillon and Adrien Nader and Peter Zotov)
+- PR#6281: Graphics window does not acknowledge second click (double click)
+ (Kyle Headley)
+- PR#6490: incorrect backtraces in gdb on AArch64. Also fixes incorrect
+ backtraces on 32-bit ARM.
+ (Mark Shinwell)
+- PR#6573: extern "C" for systhreads/threads.h
+ (Mickaël Delahaye)
+- PR#6575: Array.init evaluates callback although it should not do so
+ (Alain Frisch, report by Gerd Stolpmann)
+- PR#6607: The manual doesn't mention 0x200 flag for OCAMLRUNPARAM=v
+ (Alain Frisch)
+- PR#6616: allow meaningful use of -use-runtime without -custom.
+ (Peter Zotov)
+- PR#6617: allow android build with pthreads support (since SDK r10c)
+ (Peter Zotov)
+- PR#6626: ocamlbuild on cygwin cannot find ocamlfind
+ (Gergely Szilvasy)
+- PR#6628: Configure script rejects legitimate arguments
+ (Michael Grünewald, Damien Doligez)
+- PR#6630: Failure of tests/prim-bigstring/{big,}string.ml on big-endian
+ architectures
+ (Pierre Chambart, testing by Mark Shinwell)
+- PR#6640: ocamlbuild: wrong "unused tag" warning on "precious"
+ (report by user 'william')
+- PR#6652: ocamlbuild -clean does not print a newline after output
+ (Damien Doligez, report by Andi McClure)
+- PR#6658: cross-compiler: version check not working on OS X
+ (Gerd Stolpmann)
+- PR#6665: Failure of tests/asmcomp on sparc
+ (Stéphane Glondu)
+- PR#6667: wrong implementation of %bswap16 on ARM64
+ (Xavier Leroy)
+- PR#6669: fix 4.02 regression in toplevel printing of lazy values
+ (Leo White, review by Gabriel Scherer)
+- PR#6671: Windows: environment variable 'TZ' affects Unix.gettimeofday
+ (Mickael Delahaye and Damien Doligez)
+- PR#6680: Missing parentheses in warning about polymorphic variant value
+ (Jacques Garrigue and Gabriel Scherer, report by Philippe Veber)
+- PR#6686: Bug in [subst_boxed_number]
+ (Jérémie Dimino, Mark Shinwell)
+- PR#6690: Uncaught exception (Not_found) with (wrong) wildcard or unification
+ type variable in place of a local abstract type
+ (Jacques Garrigue, report by Mikhail Mandrykin)
+- PR#6693 (part two): Incorrect relocation types in x86-64 runtime system
+ (Peter Zotov, review by Jacques-Henri Jourdan, Xavier Leroy and Mark Shinwell)
+- PR#6717: Pprintast does not print let-pattern attributes
+ (Gabriel Scherer, report by Peter Zotov)
+- PR#6727: Printf.sprintf "%F" misbehavior
+ (Benoît Vaugon, report by Vassili Karpov)
+- PR#6747: ocamlobjinfo: missing symbol caml_plugin_header due to underscore
+ (Damien Doligez, Maverick Woo)
+- PR#6749: ocamlopt returns n for (n mod 1) instead of 0
+ (Mark Shinwell and Jérémie Dimino)
+- PR#6753: Num.quo_num and Num.mod_num incorrect for some negative arguments
+ (Xavier Leroy)
+- PR#6758: Ocamldoc "analyse_module: parsetree and typedtree don't match"
+ (Damien Doligez, report by user 'maro')
+- PR#6759: big_int_of_string incorrectly parses some hexa literals
+ (Damien Doligez, report by Pierre-yves Strub)
+- PR#6763: #show with -short-paths doesn't select shortest type paths
+ (Jacques Garrigue, report by David Sheets)
+- PR#6768: Typechecker overflow the stack on cyclic type
+ (Jacques Garrigue, report by user 'darktenaibre')
+- PR#6772: asmrun/signals_asm.c doesn't compile on NetBSD/i386
+ (Kenji Tokudome)
+- PR#6775: Digest.file leaks file descriptor on error
+ (Valentin Gatien-Baron)
+- PR#6779: Cross-compilers cannot link bytecode using custom primitives
+ (Damien Doligez, request by Peter Zotov)
+- PR#6787: Soundness bug with polymorphic variants
+ (Jacques Garrigue, with help from Leo White and Grégoire Henry,
+ report by Michael O'Connor)
+- PR#6790: otherlibs should be built with -g
+ (Damien Doligez, report by Peter Zotov)
+- PR#6791: "%s@[", "%s@{" regression in Scanf
+ (Benoît Vaugon)
+- PR#6793: ocamlbuild passes nonsensical "-ocamlc ..." commands to menhir
+ (Gabriel Scherer, report by Damien Doligez)
+- PR#6799: include guards missing for unixsupport.h and other files
+ (Andreas Hauptmann)
+- PR#6810: Improve documentation of Bigarray.Genarray.map_file
+ (Mark Shinwell and Daniel Bünzli)
+- PR#6812: -short-paths and -no-alias-deps can create inconsistent assumptions
+ (Jacques Garrigue, report by Valentin Gatien-Baron)
+- PR#6817: GADT exhaustiveness breakage with modules
+ (Leo White, report by Pierre Chambart)
+- PR#6824: fix buffer sharing on partial application of Format.asprintf
+ (Gabriel Scherer, report by Alain Frisch)
+- PR#6831: Build breaks for -aspp gcc on solaris-like OSs
+ (John Tibble)
+- PR#6836: Assertion failure using -short-paths
+ (Jacques Garrigue, report by David Sheets)
+- PR#6837: Build profiling libraries on FreeBSD and NetBSD x86-64
+ (Mark Shinwell, report by Michael Grünewald)
+- PR#6841: Changing compilation unit name with -o breaks ocamldebug
+ (Jacques Garrigue, report by Jordan Walke)
+- PR#6843: record weak dependencies even when the .cmi is missing
+ (Leo White, Gabriel Scherer)
+- PR#6849: Inverted pattern unification error
+ (Jacques Garrigue, report by Leo White)
+- PR#6857: __MODULE__ doesn't give the current module with -o
+ (Jacques Garrigue, report by Valentin Gatien-Baron)
+- PR#6862: Exhaustiveness check wrong for class constructor arguments
+ (Jacques Garrigue)
+- PR#6869: Improve comment on [Hashtbl.hash_param]
+ (Mark Shinwell, report by Jun Furuse)
+- PR#6870: Unsoundness when -rectypes fails to detect non-contractive type
+ (Jacques Garrigue, report by Stephen Dolan)
+- PR#6872: Type-directed propagation fails to disambiguate variants
+ that are also exception constructors
+ (Jacques Garrigue, report by Romain Beauxis)
+- PR#6878: AArch64 backend generates invalid asm: conditional branch
+ out of range (Mark Shinwell, report by Richard Jones, testing by Richard
+ Jones and Xavier Leroy, code review by Xavier Leroy and Thomas Refis)
+- PR#6879: Wrong optimization of 1 mod n
+ (Mark Shinwell, report by Jean-Christophe Filliâtre)
+- PR#6884: The __CYGWIN32__ #define should be replaced with __CYGWIN__
+ (Adrien Nader)
+- PR#6886: -no-alias-deps allows to build self-referential compilation units
+ (Jacques Garrigue, report by Valentin Gatien-Baron)
+- PR#6889: ast_mapper fails to rewrite class attributes
+ (Sébastien Briais)
+- PR#6893: ocamlbuild: "tag not used" warning when using (p)dep
+ (Gabriel Scherer, report by Christiano Haesbaert)
+- GPR#143: fix getsockopt behaviour for boolean socket options
+ (Anil Madhavapeddy and Andrew Ray)
+- GPR#190: typo in pervasives
+ (Guillaume Bury)
+- Misplaced assertion in major_gc.c for no-naked-pointers mode
+ (Stephen Dolan, Mark Shinwell)
+
+Feature wishes:
+- PR#6452, GPR#140: add internal suport for custom printing formats
+ (Jérémie Dimino)
+- PR#6641: add -g, -ocamlcflags, -ocamloptflags options to ocamlmklib
+ (Peter Zotov)
+- PR#6693: also build libasmrun_shared.so and lib{asm,caml}run_pic.a
+ (Peter Zotov, review by Mark Shinwell)
+- PR#6842: export Typemod.modtype_of_package
+ (Jacques Garrigue, request by Jun Furuse)
+- GPR#139: more versatile specification of locations of .annot
+ (Christophe Troestler, review by Damien Doligez)
+- GPR#157: store the path of cmos inside debug section at link time
+ (Hugo Heuzard, review by Damien Doligez)
+- GPR#191: Making gc.h and some part of memory.h public
+ (Thomas Refis)
+
+OCaml 4.02.1 (14 Oct 2014):
+---------------------------
+
(Changes that can break existing programs are marked with a "*")
Standard library:
(Xavier Leroy, Alain Frisch, relase-worthy report by Jacques-Pascal Deplaix)
- PR#6530: Add stack overflow handling for native code (OpenBSD i386 and amd64)
(Cristopher Zimmermann)
-- PR#6533: broken semantics of %(%) when substitued by a box
+- PR#6533: broken semantics of %(%) when substituted by a box
(Benoît Vaugon, report by Boris Yakobowski)
- PR#6534: legacy support for %.10s
(Benoît Vaugon, Gabriel Scherer, report by Nick Chapman)
(Jacques Garrigue, report by Mark Shinwell)
- PR#6572: Fatal error with recursive modules
(Jacques Garrigue, report by Quentin Stievenart)
+- PR#6575: Array.init evaluates callback although it should not do so
+ (Alain Frisch, report by Gerd Stolpmann)
- PR#6578: Recursive module containing alias causes Segmentation fault
(Jacques Garrigue)
- PR#6581: Some bugs in generative functors
- ocamlbuild: add an -ocamlmklib option to change the ocamlmklib command
(Jérôme Vouillon)
-OCaml 4.02.0:
--------------
+OCaml 4.02.0 (29 Aug 2014):
+---------------------------
(Changes that can break existing programs are marked with a "*")
(Alain Frisch)
- Generative functors (PR#5905)
(Jacques Garrigue)
-- Module aliases
+* Module aliases
(Jacques Garrigue)
* Alternative syntax for string literals {id|...|id} (can break comments)
(Alain Frisch)
an applicative functor if no types are created
(Jacques Garrigue, suggestion by Leo White)
* Module aliases are now typed in a specific way, which remembers their
- identity. In particular this changes the signature inferred by
- "module type of"
+ identity. Compiled interfaces become smaller, but may depend on the
+ original modules. This also changes the signature inferred by "module type of".
(Jacques Garrigue, feedback from Leo White, Mark Shinwell and Nick Chapman)
- PR#6331: Slight change in the criterion to distinguish private
abbreviations and private row types: create a private abbreviation for
- PR#4855: 'camlp4 -I +dir' accepted, dir is relative to 'camlp4 -where'
(Jun Furuse and Hongbo Zhang, report by Dmitry Grebeniuk)
- PR#5201: ocamlbuild: add --norc to the bash invocation to help performances
- (user 'daweil')
+ (Daniel Weil)
- PR#5650: Camlp4FoldGenerator doesn't handle well "abstract" types
(Hongbo Zhang)
- PR#5808: allow simple patterns, not just identifiers, in "let p : t = ..."
- make ocamldebug -I auto-detection work with ocamlbuild
(Josh Watzman)
-OCaml 4.01.0:
--------------
+OCaml 4.01.0 (12 Sep 2013):
+---------------------------
(Changes that can break existing programs are marked with a "*")
(Guillaume Melquiond, Alain Frisch)
-OCaml 4.00.1:
--------------
+OCaml 4.00.1 (5 Oct 2012):
+--------------------------
Bug fixes:
- PR#4019: better documentation of Str.matched_string
- PR#5761: Incorrect bigarray custom block size
-OCaml 4.00.0:
--------------
+OCaml 4.00.0 (26 Jul 2012):
+---------------------------
(Changes that can break existing programs are marked with a "*")
- Copy VERSION file to library directory when installing.
-OCaml 3.12.1:
--------------
+OCaml 3.12.1 (4 Jul 2011):
+--------------------------
Bug fixes:
- PR#4345, PR#4767: problems with camlp4 printing of float values
comparing a custom block value with an unboxed integer.
-Objective Caml 3.12.0:
-----------------------
+Objective Caml 3.12.0 (2 Aug 2010):
+-----------------------------------
(Changes that can break existing programs are marked with a "*" )
- Small problem with representation of Int32, Int64, and Nativeint constants.
- Use RTLD_LOCAL for native dynlink in private mode.
-Objective Caml 3.11.2:
-----------------------
+Objective Caml 3.11.2 (20 Jan 2010):
+------------------------------------
Bug fixes:
- PR#4151: better documentation for min and max w.r.t. NaN
- PR#4723: "clear_rules" function to empty the set of ocamlbuild rules
- PR#4921: configure option to help cross-compilers
-Objective Caml 3.11.1:
-----------------------
+Objective Caml 3.11.1 (12 Jun 2009):
+------------------------------------
Bug fixes:
- PR#4095: ocamldebug: strange behaviour of control-C
- Support for 64-bit mode in Solaris/x86 (PR#4670).
-Objective Caml 3.11.0:
-----------------------
+Objective Caml 3.11.0 (03 Dec 2008):
+------------------------------------
(Changes that can break existing programs are marked with a "*" )
- PR#4614: Inconsistent declaration of CamlCBCmd in LablTk library.
-Objective Caml 3.10.2:
-----------------------
+Objective Caml 3.10.2 (29 Feb 2008):
+------------------------------------
Bug fixes:
- PR#1217 (partial) Typo in ocamldep man page
- Bug in typing of polymorphic variants (reported on caml-list)
-Objective Caml 3.10.1:
-----------------------
+Objective Caml 3.10.1 (11 Jan 2008):
+------------------------------------
Bug fixes:
- PR#3830 small bugs in docs
emacs files
-Objective Caml 3.10.0:
-----------------------
+Objective Caml 3.10.0 (18 May 2007):
+------------------------------------
(Changes that can break existing programs are marked with a "*" )
License: fixed a typo in the "special exception" to the LGPL.
-Objective Caml 3.09.3:
-----------------------
+Objective Caml 3.09.3 (15 Sep 2006):
+------------------------------------
Bug fixes:
- ocamldoc: -using modtype constraint to filter module elements displayed
-Objective Caml 3.09.2:
-----------------------
+Objective Caml 3.09.2 (14 Apr 2006):
+------------------------------------
Bug fixes:
- Makefile: problem with "make world.opt" PR#3954
- ported to MacOS X on Intel PR#3985
- configure: added support for GNU Hurd PR#3991
-Objective Caml 3.09.1:
-----------------------
+Objective Caml 3.09.1 (4 Jan 2006):
+-----------------------------------
Bug fixes:
- compilers: raise not_found with -principal PR#3855
New features:
- otherlibs/labltk: browser uses menu bars instead of menu buttons
-Objective Caml 3.09.0:
-----------------------
+Objective Caml 3.09.0 (27 Oct 2006):
+------------------------------------
(Changes that can break existing programs are marked with a "*" )
- Configuration information is installed in `ocamlc -where`/Makefile.config
and can be used by client Makefiles or shell scripts.
-Objective Caml 3.08.4:
-----------------------
+Objective Caml 3.08.4 (11 Aug 2005):
+------------------------------------
New features:
- configure: find X11 config in some 64-bit Linux distribs
- yacc: avoid name capture for idents of the Parsing module
-Objective Caml 3.08.3:
-----------------------
+Objective Caml 3.08.3 (24 Mar 2005):
+------------------------------------
New features:
- support for ocamlopt -pack under Mac OS X (PR#2634, PR#3320)
- windows: better handling of InterpreterPath registry entry (PR#3334, PR#3432)
-Objective Caml 3.08.2:
-----------------------
+Objective Caml 3.08.2 (22 Nov 2004):
+------------------------------------
Bug fixes:
- runtime: memory leak when unmarshalling big data structures (PR#3247)
- unix: added missing #includes (PR#3088)
-Objective Caml 3.08.1:
-----------------------
+Objective Caml 3.08.1 (19 Aug 2004):
+------------------------------------
Licence:
- The emacs files are now under GPL
- added -v option to ocamllex
- ocamldoc: new -intf and -impl options supported (PR#3036)
-Objective Caml 3.08.0:
-----------------------
+Objective Caml 3.08.0 (13 Jul 2004):
+------------------------------------
(Changes that can break existing programs are marked with a "*" )
- See camlp4/CHANGES and camlp4/ICHANGES for more info.
-Objective Caml 3.07:
---------------------
+Objective Caml 3.07 (29 Sep 2003):
+----------------------------------
Language features:
- Experimental support for recursive module definitions
- fix: empty [] in generated HTML indexes
-Objective Caml 3.06:
---------------------
+Objective Caml 3.06 (20 Aug 2002):
+----------------------------------
Type-checking:
- Apply value restriction to polymorphic record fields.
- Fixed two problems with the Mingw port under Cygwin 1.3.
-Objective Caml 3.05:
---------------------
+Objective Caml 3.05 (29 Jul 2002):
+----------------------------------
Language features:
- Support for polymorphic methods and record fields.
- LablTk library: fixed a bug in Fileinput
-Objective Caml 3.04:
---------------------
+Objective Caml 3.04 (13 Dec 2001):
+----------------------------------
Type-checker:
- Allowed coercing self to the type of the current class, avoiding
runtime system) allowing unrestricted linking, whether static or dynamic.
-Objective Caml 3.03 ALPHA:
---------------------------
+Objective Caml 3.03 ALPHA (12 Oct 2001):
+----------------------------------------
Language:
- Removed built-in syntactic sugar for streams and stream patterns
-Objective Caml 3.02:
---------------------
+Objective Caml 3.02 (30 Jul 2001):
+----------------------------------
Both compilers:
- Fixed embarrassing bug in pattern-matching compilation
- Removed the last traces of support for 68k
-Objective Caml 3.01:
---------------------
+Objective Caml 3.01 (09 Mar 2001):
+----------------------------------
New language features:
- Variables are allowed in "or" patterns, e.g.
- Int64.format works on Mac OS 8/9.
-Objective Caml 3.00:
---------------------
+Objective Caml 3.00 (25 Apr 2000):
+----------------------------------
Language:
- OCaml/OLabl merger:
program written in O'Caml.
-Objective Caml 2.04:
---------------------
+Objective Caml 2.04 (26 Nov 1999):
+----------------------------------
- C interface: corrected inconsistent change in the CAMLparam* macros.
- Fixed internal error in ocamlc -g.
- Native-code compiler: fixed bug in assembling certain
floating-point constants (masm doesn't grok 2e5, wants 2.0e5).
-Objective Caml 2.03:
---------------------
+Objective Caml 2.03 (19 Nov 1999):
+----------------------------------
New ports:
- Ported to BeOS / Intel x86 (bytecode and native-code).
not loading properly.
-Objective Caml 2.02:
---------------------
+Objective Caml 2.02 (04 Mar 1999):
+----------------------------------
* Type system:
- Check that all components of a signature have unique names.
- Fixed end-of-line bug in ocamlcp causing problems with generated sources.
-Objective Caml 2.01:
---------------------
+Objective Caml 2.01 (09 Dec 1998):
+----------------------------------
* Typing:
- Added warning for expressions of the form "a; b" where a does not have
* Macintosh port: source code for Macintosh application merged in.
-Objective Caml 2.00:
---------------------
+Objective Caml 2.00 (19 Aug 1998):
+----------------------------------
* Language:
- New class language. See http://caml.inria.fr/ocaml/refman/
- Fixed bug with next-error under Emacs 20.
-Objective Caml 1.07:
---------------------
+Objective Caml 1.07 (11 Dec 1997):
+----------------------------------
* Native-code compiler:
- Revised interface between generated code and GC, fixes serious GC
* MS Windows port: better handling of long command lines in Sys.command
-Objective Caml 1.06:
---------------------
+Objective Caml 1.06 (18 Nov 1997):
+----------------------------------
* Language:
- Added two new keywords: "assert" (check assertion) and "lazy"
* Emacs editing mode and debugger interface updated to July '97 version.
-Objective Caml 1.05:
---------------------
+Objective Caml 1.05 (21 Mar 1997):
+----------------------------------
* Typing: fixed several bugs causing spurious type errors.
* Macintosh port: fixed signed division problem in bytecomp/emitcode.ml
-Objective Caml 1.04:
---------------------
+Objective Caml 1.04 (11 Mar 1997):
+----------------------------------
* Replay debugger ported from Caml Light; added debugger support in
compiler (option -g) and runtime system. Debugger is alpha-quality
* Emacs editing mode and debugger interface included in distribution.
-Objective Caml 1.03:
---------------------
+Objective Caml 1.03 (29 Oct 1996):
+----------------------------------
* Typing:
- bug with type names escaping their scope via unification with
* Perl-free, cpp-free, cholesterol-free installation procedure.
-Objective Caml 1.02:
---------------------
+Objective Caml 1.02 (27 Sep 1996):
+----------------------------------
+
* Typing:
- fixed bug with type names escaping their scope via unification
with non-generalized type variables '_a;
and call caml_main() later.
-Objective Caml 1.01:
---------------------
+Objective Caml 1.01 (12 Jun 1996):
+----------------------------------
+
* Typing: better report of type incompatibilities;
non-generalizable type variables in a struct...end no longer flagged
immediately as an error;
some error messages have been made clearer;
several bugs fixes.
-Objective Caml 1.00:
---------------------
+Objective Caml 1.00 (9 May 1996):
+---------------------------------
* Merge of Jerome Vouillon and Didier Remy's object-oriented
extensions.
* Dynlink library: added support for linking libraries (.cma files).
-Caml Special Light 1.15:
-------------------------
+Caml Special Light 1.15 (15 Mar 1996):
+--------------------------------------
* Caml Special Light now runs under Windows NT and 95. Many thanks to
Kevin Gallo (Microsoft Research) who contributed his initial port.
* Unix library: bug in gethostbyaddr fixed; bounds checking for read,
write, etc.
-Caml Special Light 1.14:
-------------------------
+Caml Special Light 1.14 (8 Feb 1996):
+-------------------------------------
* cslopt ported to the PowerPC/RS6000 architecture. Better support for
AIX in the bytecode system as well.
* Several bug fixes in callbacks and signals.
-Caml Special Light 1.13:
-------------------------
+Caml Special Light 1.13 (4 Jan 1996):
+-------------------------------------
* Pattern-matching compilation revised to factor out accesses inside
matched structures.
* cslopt for the Sparc: don't use Sparc V8 smul and sdiv instructions,
emulation on V7 processors is abysmal.
-Caml Special Light 1.12:
-------------------------
+Caml Special Light 1.12 (30 Nov 1995):
+--------------------------------------
* Fixed an embarrassing bug with references to floats.
-Caml Special Light 1.11:
-------------------------
+Caml Special Light 1.11 (29 Nov 1995):
+--------------------------------------
* Streams and stream parsers a la Caml Light are back (thanks to
Daniel de Rauglaudre).
* Lower memory consumption for the native-code compiler.
-Caml Special Light 1.10:
-------------------------
+Caml Special Light 1.10 (07 Nov 1995):
+--------------------------------------
* Many bug fixes (too many to list here).
Malecki and Victor Manuel Gulias Fernandez); better docs for the Unix
and regexp libraries.
-Caml Special Light 1.07:
-------------------------
+Caml Special Light 1.07 (20 Sep 1995):
+--------------------------------------
* Syntax: optional ;; allowed in compilation units and structures
(back by popular demand)
* Standard library: added List.memq; documentation of Array fixed.
-Caml Special Light 1.06:
-------------------------
+Caml Special Light 1.06 (12 Sep 1995):
+--------------------------------------
* First public release.
or:
./configure -prefix /usr -mandir '$(PREFIX)/man/manl'
- On a Linux x86/64 bits host, to build a 32-bit version of OCaml:
+ On a Linux x86-64 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):
+ On a Linux x86-64 host, to build the run-time system in PIC mode,
+ no special options should be required---the libraries should be built
+ automatically. The old instructions were:
./configure -cc "gcc -fPIC" -aspp "gcc -c -fPIC"
+ On a 64-bit POWER architecture host running Linux, OCaml only operates
+ in a 32-bit environment. If your system compiler is configured as 32-bit,
+ e.g. Red Hat 5.9, you don't need to do anything special. If that is
+ not the case (e.g. Red Hat 6.4), then IBM's "Advance Toolchain" can
+ be used. For example:
+ export PATH=/opt/at7.0/bin:$PATH
+ ./configure -cc "gcc -m32" -as "as -a32" -aspp "gcc -m32 -c" \
+ -partialld "ld -r -m elf32ppc"
+
On a MacOSX 10.5/Intel Core 2 or MacOSX 10.5/PowerPC host,
to build a 64-bit version of OCaml:
./configure -cc "gcc -m64"
# The main Makefile
include config/Makefile
+CAMLRUN ?= boot/ocamlrun
+CAMLYACC ?= boot/ocamlyacc
include stdlib/StdlibModules
-CAMLC=boot/ocamlrun boot/ocamlc -nostdlib -I boot
-CAMLOPT=boot/ocamlrun ./ocamlopt -nostdlib -I stdlib -I otherlibs/dynlink
-COMPFLAGS=-strict-sequence -w +33..39+48 -warn-error A -bin-annot \
+CAMLC=$(CAMLRUN) boot/ocamlc -nostdlib -I boot
+CAMLOPT=$(CAMLRUN) ./ocamlopt -nostdlib -I stdlib -I otherlibs/dynlink
+COMPFLAGS=-strict-sequence -w +33..39+48+50 -warn-error A -bin-annot \
-safe-string $(INCLUDES)
LINKFLAGS=
-CAMLYACC=boot/ocamlyacc
YACCFLAGS=-v
-CAMLLEX=boot/ocamlrun boot/ocamllex
-CAMLDEP=boot/ocamlrun tools/ocamldep
+CAMLLEX=$(CAMLRUN) boot/ocamllex
+CAMLDEP=$(CAMLRUN) tools/ocamldep
DEPFLAGS=$(INCLUDES)
-CAMLRUN=byterun/ocamlrun
SHELL=/bin/sh
MKDIR=mkdir -p
utils/consistbl.cmo
PARSING=parsing/location.cmo parsing/longident.cmo \
- parsing/ast_helper.cmo \
+ parsing/docstrings.cmo parsing/ast_helper.cmo \
parsing/syntaxerr.cmo parsing/parser.cmo \
parsing/lexer.cmo parsing/parse.cmo parsing/printast.cmo \
parsing/pprintast.cmo \
asmcomp/deadcode.cmo \
asmcomp/printlinear.cmo asmcomp/linearize.cmo \
asmcomp/schedgen.cmo asmcomp/scheduling.cmo \
+ asmcomp/branch_relaxation_intf.cmo \
+ asmcomp/branch_relaxation.cmo \
asmcomp/emitaux.cmo asmcomp/emit.cmo asmcomp/asmgen.cmo \
asmcomp/asmlink.cmo asmcomp/asmlibrarian.cmo asmcomp/asmpackager.cmo \
driver/opterrors.cmo driver/optcompile.cmo
if test -f boot/libcamlrun.a; then :; else \
ln -s ../byterun/libcamlrun.a boot/libcamlrun.a; fi
if test -d stdlib/caml; then :; else \
- ln -s ../byterun stdlib/caml; fi
+ ln -s ../byterun/caml stdlib/caml; fi
# Build the core system: the minimum needed to make depend and bootstrap
core:
cp ocaml $(INSTALL_BINDIR)/ocaml$(EXE)
cd stdlib; $(MAKE) install
cp lex/ocamllex $(INSTALL_BINDIR)/ocamllex$(EXE)
- cp yacc/ocamlyacc$(EXE) $(INSTALL_BINDIR)/ocamlyacc$(EXE)
+ cp $(CAMLYACC)$(EXE) $(INSTALL_BINDIR)/ocamlyacc$(EXE)
cp utils/*.cmi parsing/*.cmi typing/*.cmi bytecomp/*.cmi driver/*.cmi \
toplevel/*.cmi $(INSTALL_COMPLIBDIR)
cp compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma \
# The numeric opcodes
-bytecomp/opcodes.ml: byterun/instruct.h
- sed -n -e '/^enum/p' -e 's/,//g' -e '/^ /p' byterun/instruct.h | \
+bytecomp/opcodes.ml: byterun/caml/instruct.h
+ sed -n -e '/^enum/p' -e 's/,//g' -e '/^ /p' byterun/caml/instruct.h | \
awk -f tools/make-opcodes > bytecomp/opcodes.ml
partialclean::
byterun/primitives:
cd byterun; $(MAKE) primitives
-bytecomp/runtimedef.ml: byterun/primitives byterun/fail.h
+bytecomp/runtimedef.ml: byterun/primitives byterun/caml/fail.h
(echo 'let builtin_exceptions = [|'; \
- sed -n -e 's|.*/\* \("[A-Za-z_]*"\) \*/$$| \1;|p' byterun/fail.h | \
+ sed -n -e 's|.*/\* \("[A-Za-z_]*"\) \*/$$| \1;|p' byterun/caml/fail.h | \
sed -e '$$s/;$$//'; \
echo '|]'; \
echo 'let builtin_primitives = [|'; \
beforedepend:: asmcomp/emit.ml
tools/cvt_emit: tools/cvt_emit.mll
- cd tools; \
- $(MAKE) CAMLC="../$(CAMLRUN) ../boot/ocamlc -I ../stdlib" cvt_emit
+ cd tools && $(MAKE) cvt_emit
# The "expunge" utility
cd stdlib; $(MAKE) all
library-cross:
- cd stdlib; $(MAKE) RUNTIME=../byterun/ocamlrun all
+ cd stdlib; $(MAKE) CAMLRUN=../byterun/ocamlrun all
libraryopt:
cd stdlib; $(MAKE) allopt
otherlibraries: ocamltools
for i in $(OTHERLIBRARIES); do \
- (cd otherlibs/$$i; $(MAKE) RUNTIME=$(RUNTIME) all) || exit $$?; \
+ (cd otherlibs/$$i; $(MAKE) all) || exit $$?; \
done
otherlibrariesopt:
# Check that the stack limit is reasonable.
checkstack:
- @if $(BYTECC) $(BYTECCCOMPOPTS) $(BYTECCLINKOPTS) \
- -o tools/checkstack tools/checkstack.c; \
- then tools/checkstack; \
+ @if $(MKEXE) -o tools/checkstack$(EXE) tools/checkstack.c; \
+ then tools/checkstack$(EXE); \
else :; \
fi
@rm -f tools/checkstack
# The main Makefile
include config/Makefile
+CAMLRUN ?= boot/ocamlrun
+CAMLYACC ?= boot/ocamlyacc
include stdlib/StdlibModules
-CAMLC=boot/ocamlrun boot/ocamlc -nostdlib -I boot
-CAMLOPT=boot/ocamlrun ./ocamlopt -nostdlib -I stdlib -I otherlibs/dynlink
+CAMLC=$(CAMLRUN) boot/ocamlc -nostdlib -I boot
+CAMLOPT=$(CAMLRUN) ./ocamlopt -nostdlib -I stdlib -I otherlibs/dynlink
COMPFLAGS=-strict-sequence -w +33..39+48 -warn-error A -bin-annot $(INCLUDES)
LINKFLAGS=
-CAMLYACC=boot/ocamlyacc
YACCFLAGS=
-CAMLLEX=boot/ocamlrun boot/ocamllex
-CAMLDEP=boot/ocamlrun tools/ocamldep
+CAMLLEX=$(CAMLRUN) boot/ocamllex
+CAMLDEP=$(CAMLRUN) tools/ocamldep
DEPFLAGS=$(INCLUDES)
-CAMLRUN=byterun/ocamlrun
OCAMLBUILDBYTE=$(WITH_OCAMLBUILD:=.byte)
OCAMLBUILDNATIVE=$(WITH_OCAMLBUILD:=.native)
utils/consistbl.cmo
PARSING=parsing/location.cmo parsing/longident.cmo \
- parsing/ast_helper.cmo \
+ parsing/docstrings.cmo parsing/ast_helper.cmo \
parsing/syntaxerr.cmo parsing/parser.cmo \
parsing/lexer.cmo parsing/parse.cmo parsing/printast.cmo \
parsing/pprintast.cmo \
if test -n "$(WITH_OCAMLDOC)"; then (cd ocamldoc; $(MAKEREC) installopt); fi
if test -n "$(WITH_OCAMLBUILD)"; then (cd ocamlbuild; $(MAKE) installopt); \
else :; fi
- for i in $(OTHERLIBRARIES); do $(MAKEREC) -C otherlibs/$$i installopt; done
+ for i in $(OTHERLIBRARIES); do \
+ $(MAKEREC) -C otherlibs/$$i installopt || exit $$?; \
+ done
if test -f ocamlopt.opt ; then $(MAKEREC) installoptopt; fi
cd tools; $(MAKE) installopt
# The numeric opcodes
-bytecomp/opcodes.ml: byterun/instruct.h
- sed -n -e "/^enum/p" -e "s|,||g" -e "/^ /p" byterun/instruct.h | \
+bytecomp/opcodes.ml: byterun/caml/instruct.h
+ sed -n -e "/^enum/p" -e "s|,||g" -e "/^ /p" byterun/caml/instruct.h | \
gawk -f tools/make-opcodes > bytecomp/opcodes.ml
partialclean::
byterun/primitives:
cd byterun ; $(MAKEREC) primitives
-bytecomp/runtimedef.ml: byterun/primitives byterun/fail.h
+bytecomp/runtimedef.ml: byterun/primitives byterun/caml/fail.h
(echo 'let builtin_exceptions = [|'; \
- sed -n -e 's|.*/\* \("[A-Za-z_]*"\) \*/$$| \1;|p' byterun/fail.h | \
+ sed -n -e 's|.*/\* \("[A-Za-z_]*"\) \*/$$| \1;|p' byterun/caml/fail.h | \
sed -e '$$s/;$$//'; \
echo '|]'; \
echo 'let builtin_primitives = [|'; \
# Preprocess the code emitters
asmcomp/emit.ml: $(ASMCOMP_EMIT) tools/cvt_emit
- boot/ocamlrun tools/cvt_emit < $(ASMCOMP_EMIT) > asmcomp/emit.ml
+ $(CAMLRUN) tools/cvt_emit < $(ASMCOMP_EMIT) > asmcomp/emit.ml
partialclean::
rm -f asmcomp/emit.ml
library:
cd stdlib ; $(MAKEREC) all
library-cross:
- cd stdlib ; $(MAKEREC) RUNTIME=../byterun/ocamlrun all
+ cd stdlib ; $(MAKEREC) CAMLRUN=../byterun/ocamlrun all
libraryopt:
cd stdlib ; $(MAKEREC) allopt
partialclean::
# The extra libraries
otherlibraries:
- for i in $(OTHERLIBRARIES); do $(MAKEREC) -C otherlibs/$$i all; done
+ for i in $(OTHERLIBRARIES); do \
+ $(MAKEREC) -C otherlibs/$$i all || exit $$?; \
+ done
otherlibrariesopt:
- for i in $(OTHERLIBRARIES); do $(MAKEREC) -C otherlibs/$$i allopt; done
+ for i in $(OTHERLIBRARIES); \
+ do $(MAKEREC) -C otherlibs/$$i allopt || exit $$?; \
+ done
partialclean::
- for i in $(OTHERLIBRARIES); do $(MAKEREC) -C otherlibs/$$i partialclean; done
+ for i in $(OTHERLIBRARIES); \
+ do $(MAKEREC) -C otherlibs/$$i partialclean || exit $$?; \
+ done
clean::
- for i in $(OTHERLIBRARIES); do $(MAKEREC) -C otherlibs/$$i clean; done
+ for i in $(OTHERLIBRARIES); do \
+ $(MAKEREC) -C otherlibs/$$i clean || exit $$?; \
+ done
alldepend::
- for i in $(OTHERLIBRARIES); do $(MAKEREC) -C otherlibs/$$i depend; done
+ for i in $(OTHERLIBRARIES); do \
+ $(MAKEREC) -C otherlibs/$$i depend || exit $$?; \
+ done
# The replay debugger
distclean:
$(MAKE) clean
+ rm -f asmrun/.depend.nt byterun/.depend.nt
rm -f boot/ocamlrun boot/ocamlrun.exe boot/camlheader boot/ocamlyacc \
boot/*.cm* boot/libcamlrun.a
rm -f config/Makefile config/m.h config/s.h
Release notes on the MS Windows ports of OCaml
----------------------------------------------
-There are no less than four ports of OCaml for MS Windows available:
+There are no less than five ports of OCaml for MS Windows available:
- a native Win32 port, built with the Microsoft 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 native Win32 port, built with the 64-bit version of the gcc
+ compiler from the mingw-w64 project, packaged in Cygwin
+ (under the name mingw64-x86_64);
- 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
Native MS Native MinGW Cygwin
-64 bits? Win32 or Win64 Win32 only Win32 only
+64 bits? Win32 or Win64 Win32 or Win64 Win32 only
Third-party software required
- for base bytecode system none none none
------------------------------------------------------------------------------
- The native Win32 port built with Mingw
- --------------------------------------
+ The native Win32 and Win64 ports built with Mingw
+ -------------------------------------------------
REQUIREMENTS:
-This port runs under MS Windows Seven, Vista, XP, and 2000.
+Those ports run under MS Windows Seven, Vista, XP, and 2000.
The base bytecode system (ocamlc, ocaml, ocamllex, ocamlyacc, ...)
runs without any additional tools.
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):
+You will need to install at least the following Cygwin packages for
+the 32-bit flavor (use the Setup tool from Cygwin):
mingw64-i686-binutils
- mingw64-i686-gcc
mingw64-i686-gcc-core
mingw64-i686-runtime
+and the following packages for the 64-bit:
+
+ mingw64-x86_64-binutils
+ mingw64-x86_64-gcc-core
+ mingw64-x86_64-runtime
NOTES:
- 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
+
+ For both flavor of OCaml (32-bit and 64-bit):
diffutils
make
ncurses
+
+ For the 32 bit flavor of OCaml:
+ mingw64-i686-binutils
+ mingw64-i686-gcc-core
+ mingw64-i686-runtime
+
+ For the 64 bit flavor of OCaml:
+ mingw64-x86_64-binutils
+ mingw64-x86_64-gcc-core
+ mingw64-x86_64-runtime
+
- The flexdll tool (see above). Do not forget to add the flexdll directory
to your PATH
cp config/m-nt.h config/m.h
cp config/s-nt.h config/s.h
+
+For a 32 bit OCaml:
cp config/Makefile.mingw config/Makefile
+For a 64 bit OCaml:
+ cp config/Makefile.mingw64 config/Makefile
+
Then, edit config/Makefile as needed, following the comments in this file.
Normally, the only variable that need to be changed is
PREFIX where to install everything
* The replay debugger is partially supported (no reverse execution).
-* The default Makefile.mingw passes -static-libgcc to the linker.
+* The default Makefile.mingw and Makefile.mingw64 pass -static-libgcc to the linker.
For more information on this topic:
http://gcc.gnu.org/onlinedocs/gcc-4.9.1/gcc/Link-Options.html#Link-Options
-4.02.1
+4.02.2+rc1
# The version string is the first line of this file.
# It must be in the format described in stdlib/sys.mli
open Linearize
open Emitaux
+(* [Branch_relaxation] is not used in this file, but is required by
+ emit.mlp files for certain other targets; the reference here ensures
+ that when releases are being prepared the .depend files are correct
+ for all targets. *)
+open! Branch_relaxation
+
let macosx = (Config.system = "macosx")
let mingw64 = (Config.system = "mingw64")
let cygwin = (Config.system = "cygwin")
let n = frame_size() in
if n > 0 then begin
ignore(emit_stack_adjustment (-n));
- if !contains_calls then
+ if !contains_calls then begin
+ cfi_offset ~reg:14 (* lr *) ~offset:(-4);
` str lr, [sp, #{emit_int(n - 4)}]\n`
+ end
end;
`{emit_label !tailrec_entry_point}:\n`;
emit_all 0 fundecl.fun_body;
(* Specific operations *)
type specific_operation =
+ | Ifar_alloc of int
+ | Ifar_intop_checkbound
+ | Ifar_intop_imm_checkbound of int
| Ishiftarith of arith_operation * int
| Ishiftcheckbound of int
+ | Ifar_shiftcheckbound of int
| Imuladd (* multiply and add *)
| Imulsub (* multiply and subtract *)
| Inegmulf (* floating-point negate and multiply *)
let print_specific_operation printreg op ppf arg =
match op with
+ | Ifar_alloc n ->
+ fprintf ppf "(far) alloc %i" n
+ | Ifar_intop_checkbound ->
+ fprintf ppf "%a (far) check > %a" printreg arg.(0) printreg arg.(1)
+ | Ifar_intop_imm_checkbound n ->
+ fprintf ppf "%a (far) check > %i" printreg arg.(0) n
| Ishiftarith(op, shift) ->
let op_name = function
| Ishiftadd -> "+"
printreg arg.(0) (op_name op) printreg arg.(1) shift_mark
| Ishiftcheckbound n ->
fprintf ppf "check %a >> %i > %a" printreg arg.(0) n printreg arg.(1)
+ | Ifar_shiftcheckbound n ->
+ fprintf ppf
+ "(far) check %a >> %i > %a" printreg arg.(0) n printreg arg.(1)
| Imuladd ->
fprintf ppf "(%a * %a) + %a"
printreg arg.(0)
in
if n < 0n then emit_neg true 48 else emit_pos true 48
+let num_instructions_for_intconst n =
+ let num_instructions = ref 0 in
+ let rec count_pos first shift =
+ if shift < 0 then begin
+ if first then incr num_instructions
+ end else begin
+ let s = Nativeint.(logand (shift_right_logical n shift) 0xFFFFn) in
+ if s = 0n then count_pos first (shift - 16) else begin
+ incr num_instructions;
+ count_pos false (shift - 16)
+ end
+ end
+ and count_neg first shift =
+ if shift < 0 then begin
+ if first then incr num_instructions
+ end else begin
+ let s = Nativeint.(logand (shift_right_logical n shift) 0xFFFFn) in
+ if s = 0xFFFFn then count_neg first (shift - 16) else begin
+ incr num_instructions;
+ count_neg false (shift - 16)
+ end
+ end
+ in
+ if n < 0n then count_neg true 48 else count_pos true 48;
+ !num_instructions
+
(* Recognize float constants appropriate for FMOV dst, #fpimm instruction:
"a normalized binary floating point encoding with 1 sign bit, 4
bits of fraction and a 3-bit exponent" *)
` ldr {emit_reg dst}, [{emit_reg dst}, #:got_lo12:{emit_symbol s}]\n`
end
+(* The following functions are used for calculating the sizes of the
+ call GC and bounds check points emitted out-of-line from the function
+ body. See branch_relaxation.mli. *)
+
+let num_call_gc_and_check_bound_points instr =
+ let rec loop instr ((call_gc, check_bound) as totals) =
+ match instr.desc with
+ | Lend -> totals
+ | Lop (Ialloc _) when !fastcode_flag ->
+ loop instr.next (call_gc + 1, check_bound)
+ | Lop (Iintop Icheckbound)
+ | Lop (Iintop_imm (Icheckbound, _))
+ | Lop (Ispecific (Ishiftcheckbound _)) ->
+ let check_bound =
+ (* When not in debug mode, there is at most one check-bound point. *)
+ if not !Clflags.debug then 1
+ else check_bound + 1
+ in
+ loop instr.next (call_gc, check_bound)
+ (* The following four should never be seen, since this function is run
+ before branch relaxation. *)
+ | Lop (Ispecific (Ifar_alloc _))
+ | Lop (Ispecific Ifar_intop_checkbound)
+ | Lop (Ispecific (Ifar_intop_imm_checkbound _))
+ | Lop (Ispecific (Ifar_shiftcheckbound _)) -> assert false
+ | _ -> loop instr.next totals
+ in
+ loop instr (0, 0)
+
+let max_out_of_line_code_offset instr ~num_call_gc ~num_check_bound =
+ if num_call_gc < 1 && num_check_bound < 1 then 0
+ else begin
+ let size_of_call_gc = 2 in
+ let size_of_check_bound = 1 in
+ let size_of_last_thing =
+ (* Call-GC points come before check-bound points. *)
+ if num_check_bound >= 1 then size_of_check_bound else size_of_call_gc
+ in
+ let total_size =
+ size_of_call_gc*num_call_gc + size_of_check_bound*num_check_bound
+ in
+ let max_offset = total_size - size_of_last_thing in
+ assert (max_offset >= 0);
+ max_offset
+ end
+
+module BR = Branch_relaxation.Make (struct
+ (* CR-someday mshinwell: B and BL have +/- 128Mb ranges; for the moment we
+ assume we will never exceed this. It would seem to be most likely to
+ occur for branches between functions; in this case, the linker should be
+ able to insert veneers anyway. (See section 4.6.7 of the document
+ "ELF for the ARM 64-bit architecture (AArch64)".) *)
+
+ type distance = int
+
+ module Cond_branch = struct
+ type t = TB | CB | Bcc
+
+ let all = [TB; CB; Bcc]
+
+ (* AArch64 instructions are 32 bits wide, so [distance] in this module
+ means units of 32-bit words. *)
+ let max_displacement = function
+ | TB -> 32 * 1024 / 4 (* +/- 32Kb *)
+ | CB | Bcc -> 1 * 1024 * 1024 / 4 (* +/- 1Mb *)
+
+ let classify_instr = function
+ | Lop (Ialloc _)
+ | Lop (Iintop Icheckbound)
+ | Lop (Iintop_imm (Icheckbound, _))
+ | Lop (Ispecific (Ishiftcheckbound _)) -> Some Bcc
+ (* The various "far" variants in [specific_operation] don't need to
+ return [Some] here, since their code sequences never contain any
+ conditional branches that might need relaxing. *)
+ | Lcondbranch (Itruetest, _)
+ | Lcondbranch (Ifalsetest, _) -> Some CB
+ | Lcondbranch (Iinttest _, _)
+ | Lcondbranch (Iinttest_imm _, _)
+ | Lcondbranch (Ifloattest _, _) -> Some Bcc
+ | Lcondbranch (Ioddtest, _)
+ | Lcondbranch (Ieventest, _) -> Some TB
+ | Lcondbranch3 _ -> Some Bcc
+ | _ -> None
+ end
+
+ let offset_pc_at_branch = 0
+
+ let epilogue_size () =
+ if !contains_calls then 3 else 2
+
+ let instr_size = function
+ | Lend -> 0
+ | Lop (Imove | Ispill | Ireload) -> 1
+ | Lop (Iconst_int n | Iconst_blockheader n) ->
+ num_instructions_for_intconst n
+ | Lop (Iconst_float _) -> 2
+ | Lop (Iconst_symbol _) -> 2
+ | Lop (Icall_ind) -> 1
+ | Lop (Icall_imm _) -> 1
+ | Lop (Itailcall_ind) -> epilogue_size ()
+ | Lop (Itailcall_imm s) ->
+ if s = !function_name then 1 else epilogue_size ()
+ | Lop (Iextcall (_, false)) -> 1
+ | Lop (Iextcall (_, true)) -> 3
+ | Lop (Istackoffset _) -> 2
+ | Lop (Iload (size, addr)) | Lop (Istore (size, addr, _)) ->
+ let based = match addr with Iindexed _ -> 0 | Ibased _ -> 1 in
+ based + begin match size with Single -> 2 | _ -> 1 end
+ | Lop (Ialloc _) when !fastcode_flag -> 4
+ | Lop (Ispecific (Ifar_alloc _)) when !fastcode_flag -> 5
+ | Lop (Ialloc num_words) | Lop (Ispecific (Ifar_alloc num_words)) ->
+ begin match num_words with
+ | 16 | 24 | 32 -> 1
+ | _ -> 1 + num_instructions_for_intconst (Nativeint.of_int num_words)
+ end
+ | Lop (Iintop (Icomp _)) -> 2
+ | Lop (Iintop_imm (Icomp _, _)) -> 2
+ | Lop (Iintop Icheckbound) -> 2
+ | Lop (Ispecific Ifar_intop_checkbound) -> 3
+ | Lop (Iintop_imm (Icheckbound, _)) -> 2
+ | Lop (Ispecific (Ifar_intop_imm_checkbound _)) -> 3
+ | Lop (Ispecific (Ishiftcheckbound _)) -> 2
+ | Lop (Ispecific (Ifar_shiftcheckbound _)) -> 3
+ | Lop (Iintop Imod) -> 2
+ | Lop (Iintop Imulh) -> 1
+ | Lop (Iintop _) -> 1
+ | Lop (Iintop_imm _) -> 1
+ | Lop (Ifloatofint | Iintoffloat | Iabsf | Inegf | Ispecific Isqrtf) -> 1
+ | Lop (Iaddf | Isubf | Imulf | Idivf | Ispecific Inegmulf) -> 1
+ | Lop (Ispecific (Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf)) -> 1
+ | Lop (Ispecific (Ishiftarith _)) -> 1
+ | Lop (Ispecific (Imuladd | Imulsub)) -> 1
+ | Lop (Ispecific (Ibswap 16)) -> 2
+ | Lop (Ispecific (Ibswap _)) -> 1
+ | Lreloadretaddr -> 0
+ | Lreturn -> epilogue_size ()
+ | Llabel _ -> 0
+ | Lbranch _ -> 1
+ | Lcondbranch (tst, _) ->
+ begin match tst with
+ | Itruetest -> 1
+ | Ifalsetest -> 1
+ | Iinttest _ -> 2
+ | Iinttest_imm _ -> 2
+ | Ifloattest _ -> 2
+ | Ioddtest -> 1
+ | Ieventest -> 1
+ end
+ | Lcondbranch3 (lbl0, lbl1, lbl2) ->
+ 1 + begin match lbl0 with None -> 0 | Some _ -> 1 end
+ + begin match lbl1 with None -> 0 | Some _ -> 1 end
+ + begin match lbl2 with None -> 0 | Some _ -> 1 end
+ | Lswitch jumptbl -> 3 + Array.length jumptbl
+ | Lsetuptrap _ -> 2
+ | Lpushtrap -> 3
+ | Lpoptrap -> 1
+ | Lraise k ->
+ begin match !Clflags.debug, k with
+ | true, (Lambda.Raise_regular | Lambda.Raise_reraise) -> 1
+ | false, _
+ | true, Lambda.Raise_notrace -> 4
+ end
+
+ let relax_allocation ~num_words =
+ Lop (Ispecific (Ifar_alloc num_words))
+
+ let relax_intop_checkbound () =
+ Lop (Ispecific Ifar_intop_checkbound)
+
+ let relax_intop_imm_checkbound ~bound =
+ Lop (Ispecific (Ifar_intop_imm_checkbound bound))
+
+ let relax_specific_op = function
+ | Ishiftcheckbound shift -> Lop (Ispecific (Ifar_shiftcheckbound shift))
+ | _ -> assert false
+end)
+
+(* Output the assembly code for allocation. *)
+
+let assembly_code_for_allocation i ~n ~far =
+ let lbl_frame = record_frame_label i.live i.dbg in
+ if !fastcode_flag then begin
+ let lbl_redo = new_label() in
+ let lbl_call_gc = new_label() in
+ `{emit_label lbl_redo}:`;
+ ` sub {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, #{emit_int n}\n`;
+ ` cmp {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_limit}\n`;
+ ` add {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n`;
+ if not far then begin
+ ` b.lo {emit_label lbl_call_gc}\n`
+ end else begin
+ let lbl = new_label () in
+ ` b.cs {emit_label lbl}\n`;
+ ` b {emit_label lbl_call_gc}\n`;
+ `{emit_label lbl}:\n`
+ end;
+ call_gc_sites :=
+ { gc_lbl = lbl_call_gc;
+ gc_return_lbl = lbl_redo;
+ gc_frame_lbl = lbl_frame } :: !call_gc_sites
+ end else begin
+ begin match n with
+ | 16 -> ` bl {emit_symbol "caml_alloc1"}\n`
+ | 24 -> ` bl {emit_symbol "caml_alloc2"}\n`
+ | 32 -> ` bl {emit_symbol "caml_alloc3"}\n`
+ | _ -> emit_intconst reg_x15 (Nativeint.of_int n);
+ ` bl {emit_symbol "caml_allocN"}\n`
+ end;
+ `{emit_label lbl_frame}: add {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n`
+ end
+
(* Output the assembly code for an instruction *)
let emit_instr i =
` str {emit_reg src}, {emit_addressing addr base}\n`
end
| Lop(Ialloc n) ->
- let lbl_frame = record_frame_label i.live i.dbg in
- if !fastcode_flag then begin
- let lbl_redo = new_label() in
- let lbl_call_gc = new_label() in
- `{emit_label lbl_redo}:`;
- ` sub {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, #{emit_int n}\n`;
- ` cmp {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_limit}\n`;
- ` add {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n`;
- ` b.lo {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
- end else begin
- begin match n with
- | 16 -> ` bl {emit_symbol "caml_alloc1"}\n`
- | 24 -> ` bl {emit_symbol "caml_alloc2"}\n`
- | 32 -> ` bl {emit_symbol "caml_alloc3"}\n`
- | _ -> emit_intconst reg_x15 (Nativeint.of_int n);
- ` bl {emit_symbol "caml_allocN"}\n`
- end;
- `{emit_label lbl_frame}: add {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n`
- end
+ assembly_code_for_allocation i ~n ~far:false
+ | Lop(Ispecific (Ifar_alloc n)) ->
+ assembly_code_for_allocation i ~n ~far:true
| Lop(Iintop(Icomp cmp)) ->
` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
` cset {emit_reg i.res.(0)}, {emit_string (name_for_comparison cmp)}\n`
let lbl = bound_error_label i.dbg in
` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
` b.ls {emit_label lbl}\n`
+ | Lop(Ispecific Ifar_intop_checkbound) ->
+ let lbl = bound_error_label i.dbg in
+ let lbl2 = new_label () in
+ ` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+ ` b.hi {emit_label lbl2}\n`;
+ ` b {emit_label lbl}\n`;
+ `{emit_label lbl2}:\n`;
| Lop(Iintop_imm(Icheckbound, n)) ->
let lbl = bound_error_label i.dbg in
` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`;
` b.ls {emit_label lbl}\n`
+ | Lop(Ispecific(Ifar_intop_imm_checkbound bound)) ->
+ let lbl = bound_error_label i.dbg in
+ let lbl2 = new_label () in
+ ` cmp {emit_reg i.arg.(0)}, #{emit_int bound}\n`;
+ ` b.hi {emit_label lbl2}\n`;
+ ` b {emit_label lbl}\n`;
+ `{emit_label lbl2}:\n`;
| 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`;
` b.cs {emit_label lbl}\n`
+ | Lop(Ispecific(Ifar_shiftcheckbound shift)) ->
+ let lbl = bound_error_label i.dbg in
+ let lbl2 = new_label () in
+ ` cmp {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, lsr #{emit_int shift}\n`;
+ ` b.lo {emit_label lbl2}\n`;
+ ` b {emit_label lbl}\n`;
+ `{emit_label lbl2}:\n`;
| Lop(Iintop Imod) ->
` sdiv {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
` msub {emit_reg i.res.(0)}, {emit_reg reg_tmp1}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`
begin match size with
| 16 ->
` rev16 {emit_wreg i.res.(0)}, {emit_wreg i.arg.(0)}\n`;
- ` ubfm {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, #0, #16\n`
+ ` ubfm {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, #0, #15\n`
| 32 ->
` rev {emit_wreg i.res.(0)}, {emit_wreg i.arg.(0)}\n`
| 64 ->
let n = frame_size() in
if n > 0 then
emit_stack_adjustment (-n);
- if !contains_calls then
- ` str x30, [sp, #{emit_int (n-8)}]\n`;
+ if !contains_calls then begin
+ cfi_offset ~reg:30 (* return address *) ~offset:(-8);
+ ` str x30, [sp, #{emit_int (n-8)}]\n`
+ end;
`{emit_label !tailrec_entry_point}:\n`;
+ let num_call_gc, num_check_bound =
+ num_call_gc_and_check_bound_points fundecl.fun_body
+ in
+ let max_out_of_line_code_offset =
+ max_out_of_line_code_offset fundecl.fun_body ~num_call_gc
+ ~num_check_bound
+ in
+ BR.relax fundecl.fun_body ~max_out_of_line_code_offset;
emit_all fundecl.fun_body;
List.iter emit_call_gc !call_gc_sites;
List.iter emit_call_bound_error !bound_error_sites;
+ assert (List.length !call_gc_sites = num_call_gc);
+ assert (List.length !bound_error_sites = num_check_bound);
cfi_endproc();
` .type {emit_symbol fundecl.fun_name}, %function\n`;
` .size {emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n`;
let lib_ccobjs = ref []
let lib_ccopts = ref []
-let add_ccobjs l =
+let add_ccobjs origin l =
if not !Clflags.no_auto_link then begin
lib_ccobjs := l.lib_ccobjs @ !lib_ccobjs;
- lib_ccopts := l.lib_ccopts @ !lib_ccopts
+ let replace_origin = Misc.replace_substring ~before:"$CAMLORIGIN" ~after:origin in
+ lib_ccopts := List.map replace_origin l.lib_ccopts @ !lib_ccopts
end
let runtime_lib () =
| Library (file_name,infos) ->
(* This is an archive file. Each unit contained in it will be linked
in only if needed. *)
- add_ccobjs infos;
+ add_ccobjs (Filename.dirname file_name) infos;
List.fold_right
(fun (info, crc) reqd ->
if info.ui_force_link
let call_linker file_list startup_file output_name =
let main_dll = !Clflags.output_c_object
&& Filename.check_suffix output_name Config.ext_dll
+ and main_obj_runtime = !Clflags.output_complete_object
in
let files = startup_file :: (List.rev file_list) in
let files, c_lib =
- if (not !Clflags.output_c_object) || main_dll then
+ if (not !Clflags.output_c_object) || main_dll || main_obj_runtime then
files @ (List.rev !Clflags.ccobjs) @ runtime_lib (),
- (if !Clflags.nopervasives then "" else Config.native_c_libraries)
+ (if !Clflags.nopervasives || main_obj_runtime then "" else Config.native_c_libraries)
else
files, ""
in
--- /dev/null
+(***********************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* Mark Shinwell, Jane Street Europe *)
+(* *)
+(* 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 Mach
+open Linearize
+
+module Make (T : Branch_relaxation_intf.S) = struct
+ let label_map code =
+ let map = Hashtbl.create 37 in
+ let rec fill_map pc instr =
+ match instr.desc with
+ | Lend -> (pc, map)
+ | Llabel lbl -> Hashtbl.add map lbl pc; fill_map pc instr.next
+ | op -> fill_map (pc + T.instr_size op) instr.next
+ in
+ fill_map 0 code
+
+ let branch_overflows map pc_branch lbl_dest max_branch_offset =
+ let pc_dest = Hashtbl.find map lbl_dest in
+ let delta = pc_dest - (pc_branch + T.offset_pc_at_branch) in
+ delta <= -max_branch_offset || delta >= max_branch_offset
+
+ let opt_branch_overflows map pc_branch opt_lbl_dest max_branch_offset =
+ match opt_lbl_dest with
+ | None -> false
+ | Some lbl_dest ->
+ branch_overflows map pc_branch lbl_dest max_branch_offset
+
+ let instr_overflows ~code_size ~max_out_of_line_code_offset instr map pc =
+ match T.Cond_branch.classify_instr instr.desc with
+ | None -> false
+ | Some branch ->
+ let max_branch_offset =
+ (* Remember to cut some slack for multi-word instructions (in the
+ [Linearize] sense of the word) where the branch can be anywhere in
+ the middle. 12 words of slack is plenty. *)
+ T.Cond_branch.max_displacement branch - 12
+ in
+ match instr.desc with
+ | Lop (Ialloc _)
+ | Lop (Iintop Icheckbound)
+ | Lop (Iintop_imm (Icheckbound, _))
+ | Lop (Ispecific _) ->
+ (* We assume that any branches eligible for relaxation generated
+ by these instructions only branch forward. We further assume
+ that any of these may branch to an out-of-line code block. *)
+ code_size + max_out_of_line_code_offset - pc >= max_branch_offset
+ | Lcondbranch (_, lbl) ->
+ branch_overflows map pc lbl max_branch_offset
+ | Lcondbranch3 (lbl0, lbl1, lbl2) ->
+ opt_branch_overflows map pc lbl0 max_branch_offset
+ || opt_branch_overflows map pc lbl1 max_branch_offset
+ || opt_branch_overflows map pc lbl2 max_branch_offset
+ | _ ->
+ Misc.fatal_error "Unsupported instruction for branch relaxation"
+
+ let fixup_branches ~code_size ~max_out_of_line_code_offset map code =
+ let expand_optbranch lbl n arg next =
+ match lbl with
+ | None -> next
+ | Some l ->
+ instr_cons (Lcondbranch (Iinttest_imm (Isigned Cmm.Ceq, n), l))
+ arg [||] next
+ in
+ let rec fixup did_fix pc instr =
+ match instr.desc with
+ | Lend -> did_fix
+ | _ ->
+ let overflows =
+ instr_overflows ~code_size ~max_out_of_line_code_offset instr map pc
+ in
+ if not overflows then
+ fixup did_fix (pc + T.instr_size instr.desc) instr.next
+ else
+ match instr.desc with
+ | Lop (Ialloc num_words) ->
+ instr.desc <- T.relax_allocation ~num_words;
+ fixup true (pc + T.instr_size instr.desc) instr.next
+ | Lop (Iintop Icheckbound) ->
+ instr.desc <- T.relax_intop_checkbound ();
+ fixup true (pc + T.instr_size instr.desc) instr.next
+ | Lop (Iintop_imm (Icheckbound, bound)) ->
+ instr.desc <- T.relax_intop_imm_checkbound ~bound;
+ fixup true (pc + T.instr_size instr.desc) instr.next
+ | Lop (Ispecific specific) ->
+ instr.desc <- T.relax_specific_op specific;
+ fixup true (pc + T.instr_size instr.desc) instr.next
+ | Lcondbranch (test, lbl) ->
+ let lbl2 = new_label() in
+ let cont =
+ instr_cons (Lbranch lbl) [||] [||]
+ (instr_cons (Llabel lbl2) [||] [||] instr.next)
+ in
+ instr.desc <- Lcondbranch (invert_test test, lbl2);
+ instr.next <- cont;
+ fixup true (pc + T.instr_size instr.desc) instr.next
+ | Lcondbranch3 (lbl0, lbl1, lbl2) ->
+ let cont =
+ expand_optbranch lbl0 0 instr.arg
+ (expand_optbranch lbl1 1 instr.arg
+ (expand_optbranch lbl2 2 instr.arg instr.next))
+ in
+ instr.desc <- cont.desc;
+ instr.next <- cont.next;
+ fixup true pc instr
+ | _ ->
+ (* Any other instruction has already been rejected in
+ [instr_overflows] above.
+ We can *never* get here. *)
+ assert false
+ in
+ fixup false 0 code
+
+ (* Iterate branch expansion till all conditional branches are OK *)
+
+ let rec relax code ~max_out_of_line_code_offset =
+ let min_of_max_branch_offsets =
+ List.fold_left (fun min_of_max_branch_offsets branch ->
+ min min_of_max_branch_offsets
+ (T.Cond_branch.max_displacement branch))
+ max_int T.Cond_branch.all
+ in
+ let (code_size, map) = label_map code in
+ if code_size >= min_of_max_branch_offsets
+ && fixup_branches ~code_size ~max_out_of_line_code_offset map code
+ then relax code ~max_out_of_line_code_offset
+ else ()
+end
--- /dev/null
+(***********************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* Mark Shinwell, Jane Street Europe *)
+(* *)
+(* Copyright 2015 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the Q Public License version 1.0. *)
+(* *)
+(***********************************************************************)
+
+(* Fix up conditional branches that exceed hardware-allowed ranges. *)
+
+module Make (T : Branch_relaxation_intf.S) : sig
+ val relax
+ : Linearize.instruction
+ (* [max_offset_of_out_of_line_code] specifies the furthest distance,
+ measured from the first address immediately after the last instruction
+ of the function, that may be branched to from within the function in
+ order to execute "out of line" code blocks such as call GC and
+ bounds check points. *)
+ -> max_out_of_line_code_offset:T.distance
+ -> unit
+end
--- /dev/null
+(***********************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* Mark Shinwell, Jane Street Europe *)
+(* *)
+(* Copyright 2015 Institut National de 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 type S = sig
+ (* The distance between two instructions, in arbitrary units (typically
+ the natural word size of instructions). *)
+ type distance = int
+
+ module Cond_branch : sig
+ (* The various types of conditional branches for a given target that
+ may require relaxation. *)
+ type t
+
+ (* All values of type [t] that the emitter may produce. *)
+ val all : t list
+
+ (* If [max_displacement branch] is [n] then [branch] is assumed to
+ reach any address in the range [pc - n, pc + n] (inclusive), after
+ the [pc] of the branch has been adjusted by [offset_pc_at_branch]
+ (see below). *)
+ val max_displacement : t -> distance
+
+ (* Which variety of conditional branch may be produced by the emitter for a
+ given instruction description. For the moment we assume that only one
+ such variety per instruction description is needed.
+
+ N.B. The only instructions supported are the following:
+ - Lop (Ialloc _)
+ - Lop (Iintop Icheckbound)
+ - Lop (Iintop_imm (Icheckbound, _))
+ - Lop (Ispecific _)
+ - Lcondbranch (_, _)
+ - Lcondbranch3 (_, _, _)
+ [classify_instr] is expected to return [None] when called on any
+ instruction not in this list. *)
+ val classify_instr : Linearize.instruction_desc -> t option
+ end
+
+ (* The value to be added to the program counter (in [distance] units)
+ when it is at a branch instruction, prior to calculating the distance
+ to a branch target. *)
+ val offset_pc_at_branch : distance
+
+ (* The maximum size of a given instruction. *)
+ val instr_size : Linearize.instruction_desc -> distance
+
+ (* Insertion of target-specific code to relax operations that cannot be
+ relaxed generically. It is assumed that these rewrites do not change
+ the size of out-of-line code (cf. branch_relaxation.mli). *)
+ val relax_allocation : num_words:int -> Linearize.instruction_desc
+ val relax_intop_checkbound : unit -> Linearize.instruction_desc
+ val relax_intop_imm_checkbound : bound:int -> Linearize.instruction_desc
+ val relax_specific_op : Arch.specific_operation -> Linearize.instruction_desc
+end
(c1, Cconst_int 0) ->
Csequence(c1, Cop(Craise (Raise_regular, dbg),
[Cconst_symbol "caml_exn_Division_by_zero"]))
- | (c1, Cconst_int 1) ->
- c1
- | (Cconst_int(0 | 1) as c1, c2) ->
- Csequence(c2, c1)
+ | (c1, Cconst_int (1 | (-1))) ->
+ Csequence(c1, Cconst_int 0)
+ | (Cconst_int 0, c2) ->
+ Csequence(c2, Cconst_int 0)
| (Cconst_int n1, Cconst_int n2) ->
Cconst_int (n1 mod n2)
| (c1, (Cconst_int n as c2)) when n <> min_int ->
Cassign(id, subst arg)
| Ctuple argv -> Ctuple(List.map subst argv)
| Cop(Cload chunk, [Cvar id]) as e ->
- if Ident.same id boxed_id && chunk = box_chunk && box_offset = 0
- then Cvar unboxed_id
- else e
+ if not (Ident.same id boxed_id) then e
+ else if chunk = box_chunk && box_offset = 0 then
+ Cvar unboxed_id
+ else begin
+ need_boxed := true;
+ e
+ end
| Cop(Cload chunk, [Cop(Cadda, [Cvar id; Cconst_int ofs])]) as e ->
- if Ident.same id boxed_id && chunk = box_chunk && ofs = box_offset
- then Cvar unboxed_id
- else e
+ if not (Ident.same id boxed_id) then e
+ else if chunk = box_chunk && ofs = box_offset then
+ Cvar unboxed_id
+ else begin
+ need_boxed := true;
+ e
+ end
| Cop(op, argv) -> Cop(op, List.map subst argv)
| Csequence(e1, e2) -> Csequence(subst e1, subst e2)
| Cifthenelse(e1, e2, e3) -> Cifthenelse(subst e1, subst e2, subst e3)
| Ccatch(nfail, ids, e1, e2) -> Ccatch(nfail, ids, subst e1, subst e2)
| Cexit (nfail, el) -> Cexit (nfail, List.map subst el)
| Ctrywith(e1, id, e2) -> Ctrywith(subst e1, id, subst e2)
- | e -> e in
+ | Cconst_int _ | Cconst_natint _ | Cconst_float _ | Cconst_symbol _
+ | Cconst_pointer _ | Cconst_natpointer _
+ | Cconst_blockheader _ as e -> e
+ in
let res = subst exp in
(res, !need_boxed, !assigned)
emit_string "\t.cfi_adjust_cfa_offset\t"; emit_int n; emit_string "\n";
end
+let cfi_offset ~reg ~offset =
+ if is_cfi_enabled () then begin
+ emit_string "\t.cfi_offset ";
+ emit_int reg;
+ emit_string ", ";
+ emit_int offset;
+ emit_string "\n"
+ end
+
(* Emit debug information *)
(* This assoc list is expected to be very short *)
val cfi_startproc : unit -> unit
val cfi_endproc : unit -> unit
val cfi_adjust_cfa_offset : int -> unit
+val cfi_offset : reg:int -> offset:int -> unit
(* Label of glue code for calling the GC *)
let call_gc_label = ref 0
-(* Fixup conditional branches that exceed hardware allowed range *)
-
-let load_store_size = function
- Ibased(s, d) -> 2
- | Iindexed ofs -> if is_immediate ofs then 1 else 3
- | Iindexed2 -> 1
-
-let instr_size = function
- Lend -> 0
- | Lop(Imove | Ispill | Ireload) -> 1
- | Lop(Iconst_int n | Iconst_blockheader n) ->
- if is_native_immediate n then 1 else 2
- | Lop(Iconst_float s) -> 2
- | Lop(Iconst_symbol s) -> 2
- | Lop(Icall_ind) -> 2
- | Lop(Icall_imm s) -> 1
- | Lop(Itailcall_ind) -> 5
- | Lop(Itailcall_imm s) -> if s = !function_name then 1 else 4
- | Lop(Iextcall(s, true)) -> 3
- | Lop(Iextcall(s, false)) -> if pic_externals then 4 else 1
- | Lop(Istackoffset n) -> 1
- | Lop(Iload(chunk, addr)) ->
+module BR = Branch_relaxation.Make (struct
+ type distance = int
+
+ module Cond_branch = struct
+ type t = Branch
+
+ let all = [Branch]
+
+ let max_displacement = function
+ (* 14-bit signed offset in words. *)
+ | Branch -> 8192
+
+ let classify_instr = function
+ | Lop (Ialloc _)
+ (* [Ialloc_far] does not need to be here, since its code sequence
+ never involves any conditional branches that might need relaxing. *)
+ | Lcondbranch _
+ | Lcondbranch3 _ -> Some Branch
+ | _ -> None
+ end
+
+ let offset_pc_at_branch = 1
+
+ let load_store_size = function
+ | Ibased(s, d) -> 2
+ | Iindexed ofs -> if is_immediate ofs then 1 else 3
+ | Iindexed2 -> 1
+
+ let instr_size = function
+ | Lend -> 0
+ | Lop(Imove | Ispill | Ireload) -> 1
+ | Lop(Iconst_int n | Iconst_blockheader n) ->
+ if is_native_immediate n then 1 else 2
+ | Lop(Iconst_float s) -> 2
+ | Lop(Iconst_symbol s) -> 2
+ | Lop(Icall_ind) -> 2
+ | Lop(Icall_imm s) -> 1
+ | Lop(Itailcall_ind) -> 5
+ | Lop(Itailcall_imm s) -> if s = !function_name then 1 else 4
+ | Lop(Iextcall(s, true)) -> 3
+ | Lop(Iextcall(s, false)) -> if pic_externals then 4 else 1
+ | Lop(Istackoffset n) -> 1
+ | Lop(Iload(chunk, addr)) ->
if chunk = Byte_signed
then load_store_size addr + 1
else load_store_size addr
- | Lop(Istore(chunk, addr, _)) -> load_store_size addr
- | Lop(Ialloc n) -> 4
- | Lop(Ispecific(Ialloc_far n)) -> 5
- | Lop(Iintop Imod) -> 3
- | Lop(Iintop(Icomp cmp)) -> 4
- | Lop(Iintop op) -> 1
- | Lop(Iintop_imm(Icomp cmp, n)) -> 4
- | Lop(Iintop_imm(op, n)) -> 1
- | Lop(Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf) -> 1
- | Lop(Ifloatofint) -> 9
- | Lop(Iintoffloat) -> 4
- | Lop(Ispecific sop) -> 1
- | Lreloadretaddr -> 2
- | Lreturn -> 2
- | Llabel lbl -> 0
- | Lbranch lbl -> 1
- | Lcondbranch(tst, lbl) -> 2
- | Lcondbranch3(lbl0, lbl1, lbl2) ->
+ | Lop(Istore(chunk, addr, _)) -> load_store_size addr
+ | Lop(Ialloc n) -> 4
+ | Lop(Ispecific(Ialloc_far n)) -> 5
+ | Lop(Iintop Imod) -> 3
+ | Lop(Iintop(Icomp cmp)) -> 4
+ | Lop(Iintop op) -> 1
+ | Lop(Iintop_imm(Icomp cmp, n)) -> 4
+ | Lop(Iintop_imm(op, n)) -> 1
+ | Lop(Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf) -> 1
+ | Lop(Ifloatofint) -> 9
+ | Lop(Iintoffloat) -> 4
+ | Lop(Ispecific sop) -> 1
+ | Lreloadretaddr -> 2
+ | Lreturn -> 2
+ | Llabel lbl -> 0
+ | Lbranch lbl -> 1
+ | Lcondbranch(tst, lbl) -> 2
+ | Lcondbranch3(lbl0, lbl1, lbl2) ->
1 + (if lbl0 = None then 0 else 1)
+ (if lbl1 = None then 0 else 1)
+ (if lbl2 = None then 0 else 1)
- | Lswitch jumptbl -> 8
- | Lsetuptrap lbl -> 1
- | Lpushtrap -> 4
- | Lpoptrap -> 2
- | Lraise _ -> 6
-
-let label_map code =
- let map = Hashtbl.create 37 in
- let rec fill_map pc instr =
- match instr.desc with
- Lend -> (pc, map)
- | Llabel lbl -> Hashtbl.add map lbl pc; fill_map pc instr.next
- | op -> fill_map (pc + instr_size op) instr.next
- in fill_map 0 code
-
-let max_branch_offset = 8180
-(* 14-bit signed offset in words. Remember to cut some slack
- for multi-word instructions where the branch can be anywhere in
- the middle. 12 words of slack is plenty. *)
-
-let branch_overflows map pc_branch lbl_dest =
- let pc_dest = Hashtbl.find map lbl_dest in
- let delta = pc_dest - (pc_branch + 1) in
- delta <= -max_branch_offset || delta >= max_branch_offset
-
-let opt_branch_overflows map pc_branch opt_lbl_dest =
- match opt_lbl_dest with
- None -> false
- | Some lbl_dest -> branch_overflows map pc_branch lbl_dest
-
-let fixup_branches codesize map code =
- let expand_optbranch lbl n arg next =
- match lbl with
- None -> next
- | Some l ->
- instr_cons (Lcondbranch(Iinttest_imm(Isigned Ceq, n), l))
- arg [||] next in
- let rec fixup did_fix pc instr =
- match instr.desc with
- Lend -> did_fix
- | Lcondbranch(test, lbl) when branch_overflows map pc lbl ->
- let lbl2 = new_label() in
- let cont =
- instr_cons (Lbranch lbl) [||] [||]
- (instr_cons (Llabel lbl2) [||] [||] instr.next) in
- instr.desc <- Lcondbranch(invert_test test, lbl2);
- instr.next <- cont;
- fixup true (pc + 2) instr.next
- | Lcondbranch3(lbl0, lbl1, lbl2)
- when opt_branch_overflows map pc lbl0
- || opt_branch_overflows map pc lbl1
- || opt_branch_overflows map pc lbl2 ->
- let cont =
- expand_optbranch lbl0 0 instr.arg
- (expand_optbranch lbl1 1 instr.arg
- (expand_optbranch lbl2 2 instr.arg instr.next)) in
- instr.desc <- cont.desc;
- instr.next <- cont.next;
- fixup true pc instr
- | Lop(Ialloc n) when codesize - pc >= max_branch_offset ->
- instr.desc <- Lop(Ispecific(Ialloc_far n));
- fixup true (pc + 4) instr.next
- | op ->
- fixup did_fix (pc + instr_size op) instr.next
- in fixup false 0 code
-
-(* Iterate branch expansion till all conditional branches are OK *)
-
-let rec branch_normalization code =
- let (codesize, map) = label_map code in
- if codesize >= max_branch_offset && fixup_branches codesize map code
- then branch_normalization code
- else ()
+ | Lswitch jumptbl -> 8
+ | Lsetuptrap lbl -> 1
+ | Lpushtrap -> 4
+ | Lpoptrap -> 2
+ | Lraise _ -> 6
+
+ let relax_allocation ~num_words = Lop (Ispecific (Ialloc_far num_words))
+ (* [classify_addr], above, never identifies these instructions as needing
+ relaxing. As such, these functions should never be called. *)
+ let relax_specific_op _ = assert false
+ let relax_intop_checkbound () = assert false
+ let relax_intop_imm_checkbound ~bound:_ = assert false
+end)
(* Output the assembly code for an instruction *)
` addi {emit_gpr 1}, {emit_gpr 1}, {emit_int(-n)}\n`
end;
`{emit_label !tailrec_entry_point}:\n`;
- branch_normalization fundecl.fun_body;
+ (* On this target, there is at most one "out of line" code block per
+ function: a single "call GC" point. It comes immediately after the
+ function's body. *)
+ BR.relax fundecl.fun_body ~max_out_of_line_code_offset:0;
emit_all fundecl.fun_body;
(* Emit the glue code to call the GC *)
if !call_gc_label > 0 then begin
-alloc.o: alloc.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/major_gc.h ../byterun/freelist.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/stacks.h \
- ../byterun/memory.h
-array.o: array.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/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h
-backtrace.o: backtrace.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/backtrace.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/misc.h ../byterun/mlvalues.h stack.h
-callback.o: callback.c ../byterun/callback.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/misc.h ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/mlvalues.h
-compact.o: compact.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/finalise.h ../byterun/roots.h \
- ../byterun/misc.h ../byterun/config.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/mlvalues.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/freelist.h \
- ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \
- ../byterun/memory.h ../byterun/mlvalues.h ../byterun/roots.h \
- ../byterun/weak.h
-compare.o: compare.c ../byterun/custom.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/misc.h ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h
-custom.o: custom.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/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/mlvalues.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 \
- ../byterun/fail.h ../byterun/mlvalues.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/misc.h ../byterun/osdeps.h \
- ../byterun/prims.h
-extern.o: extern.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/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 \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/printexc.h \
- ../byterun/signals.h stack.h ../byterun/roots.h ../byterun/memory.h \
- ../byterun/callback.h
-finalise.o: finalise.c ../byterun/callback.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/misc.h ../byterun/fail.h ../byterun/mlvalues.h \
- ../byterun/roots.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/signals.h
-floats.o: floats.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/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/stacks.h ../byterun/memory.h
-freelist.o: freelist.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/freelist.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/mlvalues.h ../byterun/gc.h \
- ../byterun/gc_ctrl.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/major_gc.h ../byterun/misc.h ../byterun/mlvalues.h
-gc_ctrl.o: gc_ctrl.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/compact.h ../byterun/custom.h \
- ../byterun/finalise.h ../byterun/roots.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/freelist.h ../byterun/gc.h \
- ../byterun/gc_ctrl.h ../byterun/major_gc.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h stack.h
-globroots.o: globroots.c ../byterun/memory.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/gc.h \
- ../byterun/mlvalues.h ../byterun/misc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/misc.h \
- ../byterun/mlvalues.h ../byterun/roots.h ../byterun/memory.h \
- ../byterun/globroots.h ../byterun/roots.h
-hash.o: hash.c ../byterun/mlvalues.h ../byterun/config.h \
- ../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/hash.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/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 \
- ../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
-io.o: io.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/custom.h \
- ../byterun/fail.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/signals.h \
- ../byterun/sys.h
-lexing.o: lexing.c ../byterun/fail.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/mlvalues.h ../byterun/stacks.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h
-main.o: main.c ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/misc.h ../byterun/sys.h
-major_gc.o: major_gc.c ../byterun/compact.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/misc.h \
- ../byterun/custom.h ../byterun/mlvalues.h ../byterun/config.h \
- ../byterun/fail.h ../byterun/finalise.h ../byterun/roots.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/freelist.h \
- ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h ../byterun/roots.h \
- ../byterun/weak.h
-md5.o: md5.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/md5.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/io.h \
- ../byterun/reverse.h
-memory.o: memory.c ../byterun/fail.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/freelist.h ../byterun/gc.h \
- ../byterun/gc_ctrl.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/minor_gc.h ../byterun/minor_gc.h ../byterun/misc.h \
- ../byterun/mlvalues.h ../byterun/signals.h
-meta.o: meta.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/fail.h ../byterun/fix_code.h \
- ../byterun/interp.h ../byterun/intext.h ../byterun/io.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/minor_gc.h \
- ../byterun/minor_gc.h ../byterun/misc.h ../byterun/mlvalues.h \
- ../byterun/prims.h ../byterun/stacks.h ../byterun/memory.h
-minor_gc.o: minor_gc.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/fail.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/mlvalues.h ../byterun/finalise.h \
- ../byterun/roots.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \
- ../byterun/memory.h ../byterun/minor_gc.h ../byterun/misc.h \
- ../byterun/mlvalues.h ../byterun/roots.h ../byterun/signals.h \
- ../byterun/weak.h
-misc.o: misc.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/mlvalues.h \
- ../byterun/misc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h
-natdynlink.o: natdynlink.c ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.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 stack.h ../byterun/callback.h ../byterun/alloc.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 \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/minor_gc.h \
- ../byterun/minor_gc.h ../byterun/misc.h ../byterun/mlvalues.h \
- ../byterun/prims.h
-parsing.o: parsing.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/mlvalues.h ../byterun/config.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/alloc.h
-printexc.o: printexc.c ../byterun/backtrace.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/misc.h ../byterun/callback.h ../byterun/debugger.h \
- ../byterun/fail.h ../byterun/misc.h ../byterun/mlvalues.h \
- ../byterun/printexc.h
-roots.o: roots.c ../byterun/finalise.h ../byterun/roots.h \
- ../byterun/misc.h ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/globroots.h ../byterun/memory.h \
- ../byterun/major_gc.h ../byterun/minor_gc.h ../byterun/misc.h \
- ../byterun/mlvalues.h stack.h ../byterun/roots.h
-signals.o: signals.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/callback.h ../byterun/config.h \
- ../byterun/fail.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/roots.h \
- ../byterun/memory.h ../byterun/signals.h ../byterun/signals_machdep.h \
- ../byterun/sys.h
-signals_asm.o: signals_asm.c ../byterun/fail.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/osdeps.h ../byterun/signals.h ../byterun/signals_machdep.h \
- signals_osdep.h stack.h
-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/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
-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
-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 \
- ../byterun/fail.h ../byterun/instruct.h ../byterun/mlvalues.h \
- ../byterun/osdeps.h ../byterun/signals.h ../byterun/stacks.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/sys.h
-terminfo.o: terminfo.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/fail.h \
- ../byterun/io.h ../byterun/mlvalues.h
-unix.o: unix.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/memory.h ../byterun/config.h \
- ../byterun/gc.h ../byterun/mlvalues.h ../byterun/misc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/osdeps.h
-weak.o: weak.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/major_gc.h ../byterun/freelist.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/minor_gc.h ../byterun/mlvalues.h
-alloc.d.o: alloc.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/major_gc.h ../byterun/freelist.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/stacks.h \
- ../byterun/memory.h
-array.d.o: array.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/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h
-backtrace.d.o: backtrace.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/backtrace.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/misc.h ../byterun/mlvalues.h stack.h
-callback.d.o: callback.c ../byterun/callback.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/misc.h ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/mlvalues.h
-compact.d.o: compact.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/finalise.h ../byterun/roots.h \
- ../byterun/misc.h ../byterun/config.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/mlvalues.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/freelist.h \
- ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \
- ../byterun/memory.h ../byterun/mlvalues.h ../byterun/roots.h \
- ../byterun/weak.h
-compare.d.o: compare.c ../byterun/custom.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/misc.h ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h
-custom.d.o: custom.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/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/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 \
- ../byterun/fail.h ../byterun/mlvalues.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/misc.h ../byterun/osdeps.h \
- ../byterun/prims.h
-extern.d.o: extern.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/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 \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/printexc.h \
- ../byterun/signals.h stack.h ../byterun/roots.h ../byterun/memory.h \
- ../byterun/callback.h
-finalise.d.o: finalise.c ../byterun/callback.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/misc.h ../byterun/fail.h ../byterun/mlvalues.h \
- ../byterun/roots.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/signals.h
-floats.d.o: floats.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/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/stacks.h ../byterun/memory.h
-freelist.d.o: freelist.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/freelist.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/mlvalues.h ../byterun/gc.h \
- ../byterun/gc_ctrl.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/major_gc.h ../byterun/misc.h ../byterun/mlvalues.h
-gc_ctrl.d.o: gc_ctrl.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/compact.h ../byterun/custom.h \
- ../byterun/finalise.h ../byterun/roots.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/freelist.h ../byterun/gc.h \
- ../byterun/gc_ctrl.h ../byterun/major_gc.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h stack.h
-globroots.d.o: globroots.c ../byterun/memory.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/gc.h \
- ../byterun/mlvalues.h ../byterun/misc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/misc.h \
- ../byterun/mlvalues.h ../byterun/roots.h ../byterun/memory.h \
- ../byterun/globroots.h ../byterun/roots.h
-hash.d.o: hash.c ../byterun/mlvalues.h ../byterun/config.h \
- ../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/hash.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/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 \
- ../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
-io.d.o: io.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/custom.h \
- ../byterun/fail.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/signals.h \
- ../byterun/sys.h
-lexing.d.o: lexing.c ../byterun/fail.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/mlvalues.h ../byterun/stacks.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h
-main.d.o: main.c ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/misc.h ../byterun/sys.h
-major_gc.d.o: major_gc.c ../byterun/compact.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/misc.h \
- ../byterun/custom.h ../byterun/mlvalues.h ../byterun/config.h \
- ../byterun/fail.h ../byterun/finalise.h ../byterun/roots.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/freelist.h \
- ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h ../byterun/roots.h \
- ../byterun/weak.h
-md5.d.o: md5.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/md5.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/io.h \
- ../byterun/reverse.h
-memory.d.o: memory.c ../byterun/fail.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/freelist.h ../byterun/gc.h \
- ../byterun/gc_ctrl.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/minor_gc.h ../byterun/minor_gc.h ../byterun/misc.h \
- ../byterun/mlvalues.h ../byterun/signals.h
-meta.d.o: meta.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/fail.h ../byterun/fix_code.h \
- ../byterun/interp.h ../byterun/intext.h ../byterun/io.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/minor_gc.h \
- ../byterun/minor_gc.h ../byterun/misc.h ../byterun/mlvalues.h \
- ../byterun/prims.h ../byterun/stacks.h ../byterun/memory.h
-minor_gc.d.o: minor_gc.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/fail.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/mlvalues.h ../byterun/finalise.h \
- ../byterun/roots.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \
- ../byterun/memory.h ../byterun/minor_gc.h ../byterun/misc.h \
- ../byterun/mlvalues.h ../byterun/roots.h ../byterun/signals.h \
- ../byterun/weak.h
-misc.d.o: misc.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/mlvalues.h \
- ../byterun/misc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h
-natdynlink.d.o: natdynlink.c ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.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 stack.h ../byterun/callback.h ../byterun/alloc.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 \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/minor_gc.h \
- ../byterun/minor_gc.h ../byterun/misc.h ../byterun/mlvalues.h \
- ../byterun/prims.h
-parsing.d.o: parsing.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/mlvalues.h ../byterun/config.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/alloc.h
-printexc.d.o: printexc.c ../byterun/backtrace.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/misc.h ../byterun/callback.h ../byterun/debugger.h \
- ../byterun/fail.h ../byterun/misc.h ../byterun/mlvalues.h \
- ../byterun/printexc.h
-roots.d.o: roots.c ../byterun/finalise.h ../byterun/roots.h \
- ../byterun/misc.h ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/globroots.h ../byterun/memory.h \
- ../byterun/major_gc.h ../byterun/minor_gc.h ../byterun/misc.h \
- ../byterun/mlvalues.h stack.h ../byterun/roots.h
-signals.d.o: signals.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/callback.h ../byterun/config.h \
- ../byterun/fail.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/roots.h \
- ../byterun/memory.h ../byterun/signals.h ../byterun/signals_machdep.h \
- ../byterun/sys.h
-signals_asm.d.o: signals_asm.c ../byterun/fail.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/osdeps.h ../byterun/signals.h ../byterun/signals_machdep.h \
- signals_osdep.h stack.h
-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/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
-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
-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 \
- ../byterun/fail.h ../byterun/instruct.h ../byterun/mlvalues.h \
- ../byterun/osdeps.h ../byterun/signals.h ../byterun/stacks.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/sys.h
-terminfo.d.o: terminfo.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/fail.h \
- ../byterun/io.h ../byterun/mlvalues.h
-unix.d.o: unix.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/memory.h ../byterun/config.h \
- ../byterun/gc.h ../byterun/mlvalues.h ../byterun/misc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/osdeps.h
-weak.d.o: weak.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/major_gc.h ../byterun/freelist.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/minor_gc.h ../byterun/mlvalues.h
-alloc.p.o: alloc.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/major_gc.h ../byterun/freelist.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/stacks.h \
- ../byterun/memory.h
-array.p.o: array.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/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h
-backtrace.p.o: backtrace.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/backtrace.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/misc.h ../byterun/mlvalues.h stack.h
-callback.p.o: callback.c ../byterun/callback.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/misc.h ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/mlvalues.h
-compact.p.o: compact.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/finalise.h ../byterun/roots.h \
- ../byterun/misc.h ../byterun/config.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/mlvalues.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/freelist.h \
- ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \
- ../byterun/memory.h ../byterun/mlvalues.h ../byterun/roots.h \
- ../byterun/weak.h
-compare.p.o: compare.c ../byterun/custom.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/misc.h ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h
-custom.p.o: custom.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/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/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 \
- ../byterun/fail.h ../byterun/mlvalues.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/misc.h ../byterun/osdeps.h \
- ../byterun/prims.h
-extern.p.o: extern.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/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 \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/printexc.h \
- ../byterun/signals.h stack.h ../byterun/roots.h ../byterun/memory.h \
- ../byterun/callback.h
-finalise.p.o: finalise.c ../byterun/callback.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/misc.h ../byterun/fail.h ../byterun/mlvalues.h \
- ../byterun/roots.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/signals.h
-floats.p.o: floats.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/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/stacks.h ../byterun/memory.h
-freelist.p.o: freelist.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/freelist.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/mlvalues.h ../byterun/gc.h \
- ../byterun/gc_ctrl.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/major_gc.h ../byterun/misc.h ../byterun/mlvalues.h
-gc_ctrl.p.o: gc_ctrl.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/compact.h ../byterun/custom.h \
- ../byterun/finalise.h ../byterun/roots.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/freelist.h ../byterun/gc.h \
- ../byterun/gc_ctrl.h ../byterun/major_gc.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h stack.h
-globroots.p.o: globroots.c ../byterun/memory.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/gc.h \
- ../byterun/mlvalues.h ../byterun/misc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/misc.h \
- ../byterun/mlvalues.h ../byterun/roots.h ../byterun/memory.h \
- ../byterun/globroots.h ../byterun/roots.h
-hash.p.o: hash.c ../byterun/mlvalues.h ../byterun/config.h \
- ../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/hash.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/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 \
- ../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
-io.p.o: io.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/custom.h \
- ../byterun/fail.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/signals.h \
- ../byterun/sys.h
-lexing.p.o: lexing.c ../byterun/fail.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/mlvalues.h ../byterun/stacks.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h
-main.p.o: main.c ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/misc.h ../byterun/sys.h
-major_gc.p.o: major_gc.c ../byterun/compact.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/misc.h \
- ../byterun/custom.h ../byterun/mlvalues.h ../byterun/config.h \
- ../byterun/fail.h ../byterun/finalise.h ../byterun/roots.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/freelist.h \
- ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h ../byterun/roots.h \
- ../byterun/weak.h
-md5.p.o: md5.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/md5.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/io.h \
- ../byterun/reverse.h
-memory.p.o: memory.c ../byterun/fail.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/freelist.h ../byterun/gc.h \
- ../byterun/gc_ctrl.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/minor_gc.h ../byterun/minor_gc.h ../byterun/misc.h \
- ../byterun/mlvalues.h ../byterun/signals.h
-meta.p.o: meta.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/fail.h ../byterun/fix_code.h \
- ../byterun/interp.h ../byterun/intext.h ../byterun/io.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/minor_gc.h \
- ../byterun/minor_gc.h ../byterun/misc.h ../byterun/mlvalues.h \
- ../byterun/prims.h ../byterun/stacks.h ../byterun/memory.h
-minor_gc.p.o: minor_gc.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/fail.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/mlvalues.h ../byterun/finalise.h \
- ../byterun/roots.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \
- ../byterun/memory.h ../byterun/minor_gc.h ../byterun/misc.h \
- ../byterun/mlvalues.h ../byterun/roots.h ../byterun/signals.h \
- ../byterun/weak.h
-misc.p.o: misc.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/mlvalues.h \
- ../byterun/misc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h
-natdynlink.p.o: natdynlink.c ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.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 stack.h ../byterun/callback.h ../byterun/alloc.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 \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/minor_gc.h \
- ../byterun/minor_gc.h ../byterun/misc.h ../byterun/mlvalues.h \
- ../byterun/prims.h
-parsing.p.o: parsing.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/mlvalues.h ../byterun/config.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/alloc.h
-printexc.p.o: printexc.c ../byterun/backtrace.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/misc.h ../byterun/callback.h ../byterun/debugger.h \
- ../byterun/fail.h ../byterun/misc.h ../byterun/mlvalues.h \
- ../byterun/printexc.h
-roots.p.o: roots.c ../byterun/finalise.h ../byterun/roots.h \
- ../byterun/misc.h ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/globroots.h ../byterun/memory.h \
- ../byterun/major_gc.h ../byterun/minor_gc.h ../byterun/misc.h \
- ../byterun/mlvalues.h stack.h ../byterun/roots.h
-signals.p.o: signals.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/callback.h ../byterun/config.h \
- ../byterun/fail.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/roots.h \
- ../byterun/memory.h ../byterun/signals.h ../byterun/signals_machdep.h \
- ../byterun/sys.h
-signals_asm.p.o: signals_asm.c ../byterun/fail.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/osdeps.h ../byterun/signals.h ../byterun/signals_machdep.h \
- signals_osdep.h stack.h
-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/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
-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
-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 \
- ../byterun/fail.h ../byterun/instruct.h ../byterun/mlvalues.h \
- ../byterun/osdeps.h ../byterun/signals.h ../byterun/stacks.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/sys.h
-terminfo.p.o: terminfo.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/fail.h \
- ../byterun/io.h ../byterun/mlvalues.h
-unix.p.o: unix.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/memory.h ../byterun/config.h \
- ../byterun/gc.h ../byterun/mlvalues.h ../byterun/misc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/osdeps.h
-weak.p.o: weak.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/major_gc.h ../byterun/freelist.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/minor_gc.h ../byterun/mlvalues.h
+alloc.o: alloc.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/custom.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/stacks.h ../byterun/caml/memory.h
+array.o: array.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/fail.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h
+backtrace.o: backtrace.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/backtrace.h ../byterun/caml/memory.h \
+ ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/misc.h \
+ ../byterun/caml/mlvalues.h stack.h
+callback.o: callback.c ../byterun/caml/callback.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/misc.h ../byterun/caml/fail.h ../byterun/caml/memory.h \
+ ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/mlvalues.h
+compact.o: compact.c ../byterun/caml/address_class.h \
+ ../byterun/caml/misc.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/config.h \
+ ../byterun/caml/finalise.h ../byterun/caml/roots.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/freelist.h \
+ ../byterun/caml/gc.h ../byterun/caml/gc_ctrl.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/memory.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/roots.h \
+ ../byterun/caml/weak.h
+compare.o: compare.c ../byterun/caml/custom.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/misc.h \
+ ../byterun/caml/fail.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h
+custom.o: custom.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/custom.h ../byterun/caml/fail.h ../byterun/caml/memory.h \
+ ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/mlvalues.h
+debugger.o: debugger.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/config.h ../byterun/caml/debugger.h \
+ ../byterun/caml/misc.h
+dynlink.o: dynlink.c ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/alloc.h ../byterun/caml/misc.h ../byterun/caml/config.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/dynlink.h \
+ ../byterun/caml/fail.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/misc.h \
+ ../byterun/caml/osdeps.h ../byterun/caml/prims.h \
+ ../byterun/caml/signals.h
+extern.o: extern.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/custom.h ../byterun/caml/fail.h ../byterun/caml/gc.h \
+ ../byterun/caml/intext.h ../byterun/caml/io.h ../byterun/caml/io.h \
+ ../byterun/caml/md5.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/reverse.h
+fail.o: fail.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/fail.h ../byterun/caml/io.h ../byterun/caml/gc.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/printexc.h ../byterun/caml/signals.h stack.h \
+ ../byterun/caml/roots.h ../byterun/caml/memory.h \
+ ../byterun/caml/callback.h
+finalise.o: finalise.c ../byterun/caml/callback.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/misc.h ../byterun/caml/fail.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/roots.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/signals.h
+floats.o: floats.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/fail.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/misc.h \
+ ../byterun/caml/reverse.h ../byterun/caml/stacks.h \
+ ../byterun/caml/memory.h
+freelist.o: freelist.c ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/freelist.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/mlvalues.h ../byterun/caml/gc.h \
+ ../byterun/caml/gc_ctrl.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/misc.h \
+ ../byterun/caml/mlvalues.h
+gc_ctrl.o: gc_ctrl.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/compact.h ../byterun/caml/custom.h \
+ ../byterun/caml/finalise.h ../byterun/caml/roots.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/freelist.h \
+ ../byterun/caml/gc.h ../byterun/caml/gc_ctrl.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h stack.h
+globroots.o: globroots.c ../byterun/caml/memory.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/gc.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/misc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/roots.h ../byterun/caml/memory.h \
+ ../byterun/caml/globroots.h ../byterun/caml/roots.h
+hash.o: hash.c ../byterun/caml/mlvalues.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/misc.h ../byterun/caml/custom.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/hash.h
+intern.o: intern.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/callback.h ../byterun/caml/custom.h \
+ ../byterun/caml/fail.h ../byterun/caml/gc.h ../byterun/caml/intext.h \
+ ../byterun/caml/io.h ../byterun/caml/io.h ../byterun/caml/md5.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/misc.h ../byterun/caml/reverse.h
+ints.o: ints.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/custom.h ../byterun/caml/fail.h ../byterun/caml/intext.h \
+ ../byterun/caml/io.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h
+io.o: io.c ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/alloc.h \
+ ../byterun/caml/misc.h ../byterun/caml/config.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/custom.h \
+ ../byterun/caml/fail.h ../byterun/caml/io.h ../byterun/caml/memory.h \
+ ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/misc.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/signals.h \
+ ../byterun/caml/sys.h
+lexing.o: lexing.c ../byterun/caml/fail.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/stacks.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h
+main.o: main.c ../byterun/caml/misc.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/misc.h ../byterun/caml/sys.h
+major_gc.o: major_gc.c ../byterun/caml/compact.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/misc.h ../byterun/caml/custom.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/config.h \
+ ../byterun/caml/fail.h ../byterun/caml/finalise.h \
+ ../byterun/caml/roots.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/freelist.h ../byterun/caml/gc.h \
+ ../byterun/caml/gc_ctrl.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/roots.h ../byterun/caml/weak.h
+md5.o: md5.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/fail.h ../byterun/caml/md5.h ../byterun/caml/io.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/io.h ../byterun/caml/reverse.h
+memory.o: memory.c ../byterun/caml/address_class.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/fail.h ../byterun/caml/freelist.h ../byterun/caml/gc.h \
+ ../byterun/caml/gc_ctrl.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/signals.h
+meta.o: meta.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/config.h ../byterun/caml/fail.h \
+ ../byterun/caml/fix_code.h ../byterun/caml/interp.h \
+ ../byterun/caml/intext.h ../byterun/caml/io.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/prims.h ../byterun/caml/stacks.h \
+ ../byterun/caml/memory.h
+minor_gc.o: minor_gc.c ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/fail.h ../byterun/caml/misc.h ../byterun/caml/config.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/finalise.h \
+ ../byterun/caml/roots.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/gc.h ../byterun/caml/gc_ctrl.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/memory.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/misc.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/roots.h \
+ ../byterun/caml/signals.h ../byterun/caml/weak.h
+misc.o: misc.c ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/misc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h
+natdynlink.o: natdynlink.c ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/misc.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h stack.h ../byterun/caml/callback.h \
+ ../byterun/caml/alloc.h ../byterun/caml/intext.h ../byterun/caml/io.h \
+ ../byterun/caml/osdeps.h ../byterun/caml/fail.h \
+ ../byterun/caml/signals.h
+obj.o: obj.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/fail.h ../byterun/caml/gc.h ../byterun/caml/interp.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/misc.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/prims.h
+parsing.o: parsing.c ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/config.h \
+ ../byterun/caml/misc.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/alloc.h
+printexc.o: printexc.c ../byterun/caml/backtrace.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/misc.h ../byterun/caml/callback.h \
+ ../byterun/caml/debugger.h ../byterun/caml/fail.h ../byterun/caml/misc.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/printexc.h
+roots.o: roots.c ../byterun/caml/finalise.h ../byterun/caml/roots.h \
+ ../byterun/caml/misc.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/globroots.h ../byterun/caml/memory.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h stack.h \
+ ../byterun/caml/roots.h
+signals_asm.o: signals_asm.c ../byterun/caml/fail.h \
+ ../byterun/caml/misc.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/osdeps.h ../byterun/caml/signals.h \
+ ../byterun/caml/signals_machdep.h signals_osdep.h stack.h
+signals.o: signals.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/callback.h ../byterun/caml/config.h \
+ ../byterun/caml/fail.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/roots.h ../byterun/caml/memory.h \
+ ../byterun/caml/signals.h ../byterun/caml/signals_machdep.h \
+ ../byterun/caml/sys.h
+startup.o: startup.c ../byterun/caml/callback.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/misc.h ../byterun/caml/backtrace.h \
+ ../byterun/caml/custom.h ../byterun/caml/debugger.h \
+ ../byterun/caml/fail.h ../byterun/caml/freelist.h ../byterun/caml/gc.h \
+ ../byterun/caml/gc_ctrl.h ../byterun/caml/intext.h ../byterun/caml/io.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/misc.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/osdeps.h \
+ ../byterun/caml/printexc.h stack.h ../byterun/caml/sys.h
+str.o: str.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/fail.h ../byterun/caml/mlvalues.h ../byterun/caml/misc.h
+sys.o: sys.c ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/alloc.h \
+ ../byterun/caml/misc.h ../byterun/caml/config.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/debugger.h \
+ ../byterun/caml/fail.h ../byterun/caml/instruct.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/osdeps.h \
+ ../byterun/caml/signals.h ../byterun/caml/stacks.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/sys.h
+terminfo.o: terminfo.c ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/alloc.h ../byterun/caml/misc.h ../byterun/caml/config.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/fail.h ../byterun/caml/io.h \
+ ../byterun/caml/mlvalues.h
+unix.o: unix.c ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/memory.h \
+ ../byterun/caml/config.h ../byterun/caml/gc.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/misc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/misc.h \
+ ../byterun/caml/osdeps.h
+weak.o: weak.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/fail.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/mlvalues.h
+alloc.d.o: alloc.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/custom.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/stacks.h ../byterun/caml/memory.h
+array.d.o: array.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/fail.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h
+backtrace.d.o: backtrace.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/backtrace.h ../byterun/caml/memory.h \
+ ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/misc.h \
+ ../byterun/caml/mlvalues.h stack.h
+callback.d.o: callback.c ../byterun/caml/callback.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/misc.h ../byterun/caml/fail.h ../byterun/caml/memory.h \
+ ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/mlvalues.h
+compact.d.o: compact.c ../byterun/caml/address_class.h \
+ ../byterun/caml/misc.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/config.h \
+ ../byterun/caml/finalise.h ../byterun/caml/roots.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/freelist.h \
+ ../byterun/caml/gc.h ../byterun/caml/gc_ctrl.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/memory.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/roots.h \
+ ../byterun/caml/weak.h
+compare.d.o: compare.c ../byterun/caml/custom.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/misc.h \
+ ../byterun/caml/fail.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h
+custom.d.o: custom.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/custom.h ../byterun/caml/fail.h ../byterun/caml/memory.h \
+ ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/mlvalues.h
+debugger.d.o: debugger.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/config.h ../byterun/caml/debugger.h \
+ ../byterun/caml/misc.h
+dynlink.d.o: dynlink.c ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/alloc.h ../byterun/caml/misc.h ../byterun/caml/config.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/dynlink.h \
+ ../byterun/caml/fail.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/misc.h \
+ ../byterun/caml/osdeps.h ../byterun/caml/prims.h \
+ ../byterun/caml/signals.h
+extern.d.o: extern.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/custom.h ../byterun/caml/fail.h ../byterun/caml/gc.h \
+ ../byterun/caml/intext.h ../byterun/caml/io.h ../byterun/caml/io.h \
+ ../byterun/caml/md5.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/reverse.h
+fail.d.o: fail.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/fail.h ../byterun/caml/io.h ../byterun/caml/gc.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/printexc.h ../byterun/caml/signals.h stack.h \
+ ../byterun/caml/roots.h ../byterun/caml/memory.h \
+ ../byterun/caml/callback.h
+finalise.d.o: finalise.c ../byterun/caml/callback.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/misc.h ../byterun/caml/fail.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/roots.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/signals.h
+floats.d.o: floats.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/fail.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/misc.h \
+ ../byterun/caml/reverse.h ../byterun/caml/stacks.h \
+ ../byterun/caml/memory.h
+freelist.d.o: freelist.c ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/freelist.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/mlvalues.h ../byterun/caml/gc.h \
+ ../byterun/caml/gc_ctrl.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/misc.h \
+ ../byterun/caml/mlvalues.h
+gc_ctrl.d.o: gc_ctrl.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/compact.h ../byterun/caml/custom.h \
+ ../byterun/caml/finalise.h ../byterun/caml/roots.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/freelist.h \
+ ../byterun/caml/gc.h ../byterun/caml/gc_ctrl.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h stack.h
+globroots.d.o: globroots.c ../byterun/caml/memory.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/gc.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/misc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/roots.h ../byterun/caml/memory.h \
+ ../byterun/caml/globroots.h ../byterun/caml/roots.h
+hash.d.o: hash.c ../byterun/caml/mlvalues.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/misc.h ../byterun/caml/custom.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/hash.h
+intern.d.o: intern.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/callback.h ../byterun/caml/custom.h \
+ ../byterun/caml/fail.h ../byterun/caml/gc.h ../byterun/caml/intext.h \
+ ../byterun/caml/io.h ../byterun/caml/io.h ../byterun/caml/md5.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/misc.h ../byterun/caml/reverse.h
+ints.d.o: ints.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/custom.h ../byterun/caml/fail.h ../byterun/caml/intext.h \
+ ../byterun/caml/io.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h
+io.d.o: io.c ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/alloc.h \
+ ../byterun/caml/misc.h ../byterun/caml/config.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/custom.h \
+ ../byterun/caml/fail.h ../byterun/caml/io.h ../byterun/caml/memory.h \
+ ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/misc.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/signals.h \
+ ../byterun/caml/sys.h
+lexing.d.o: lexing.c ../byterun/caml/fail.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/stacks.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h
+main.d.o: main.c ../byterun/caml/misc.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/misc.h ../byterun/caml/sys.h
+major_gc.d.o: major_gc.c ../byterun/caml/compact.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/misc.h ../byterun/caml/custom.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/config.h \
+ ../byterun/caml/fail.h ../byterun/caml/finalise.h \
+ ../byterun/caml/roots.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/freelist.h ../byterun/caml/gc.h \
+ ../byterun/caml/gc_ctrl.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/roots.h ../byterun/caml/weak.h
+md5.d.o: md5.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/fail.h ../byterun/caml/md5.h ../byterun/caml/io.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/io.h ../byterun/caml/reverse.h
+memory.d.o: memory.c ../byterun/caml/address_class.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/fail.h ../byterun/caml/freelist.h ../byterun/caml/gc.h \
+ ../byterun/caml/gc_ctrl.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/signals.h
+meta.d.o: meta.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/config.h ../byterun/caml/fail.h \
+ ../byterun/caml/fix_code.h ../byterun/caml/interp.h \
+ ../byterun/caml/intext.h ../byterun/caml/io.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/prims.h ../byterun/caml/stacks.h \
+ ../byterun/caml/memory.h
+minor_gc.d.o: minor_gc.c ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/fail.h ../byterun/caml/misc.h ../byterun/caml/config.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/finalise.h \
+ ../byterun/caml/roots.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/gc.h ../byterun/caml/gc_ctrl.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/memory.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/misc.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/roots.h \
+ ../byterun/caml/signals.h ../byterun/caml/weak.h
+misc.d.o: misc.c ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/misc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h
+natdynlink.d.o: natdynlink.c ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/misc.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h stack.h ../byterun/caml/callback.h \
+ ../byterun/caml/alloc.h ../byterun/caml/intext.h ../byterun/caml/io.h \
+ ../byterun/caml/osdeps.h ../byterun/caml/fail.h \
+ ../byterun/caml/signals.h
+obj.d.o: obj.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/fail.h ../byterun/caml/gc.h ../byterun/caml/interp.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/misc.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/prims.h
+parsing.d.o: parsing.c ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/config.h \
+ ../byterun/caml/misc.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/alloc.h
+printexc.d.o: printexc.c ../byterun/caml/backtrace.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/misc.h ../byterun/caml/callback.h \
+ ../byterun/caml/debugger.h ../byterun/caml/fail.h ../byterun/caml/misc.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/printexc.h
+roots.d.o: roots.c ../byterun/caml/finalise.h ../byterun/caml/roots.h \
+ ../byterun/caml/misc.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/globroots.h ../byterun/caml/memory.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h stack.h \
+ ../byterun/caml/roots.h
+signals_asm.d.o: signals_asm.c ../byterun/caml/fail.h \
+ ../byterun/caml/misc.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/osdeps.h ../byterun/caml/signals.h \
+ ../byterun/caml/signals_machdep.h signals_osdep.h stack.h
+signals.d.o: signals.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/callback.h ../byterun/caml/config.h \
+ ../byterun/caml/fail.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/roots.h ../byterun/caml/memory.h \
+ ../byterun/caml/signals.h ../byterun/caml/signals_machdep.h \
+ ../byterun/caml/sys.h
+startup.d.o: startup.c ../byterun/caml/callback.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/misc.h ../byterun/caml/backtrace.h \
+ ../byterun/caml/custom.h ../byterun/caml/debugger.h \
+ ../byterun/caml/fail.h ../byterun/caml/freelist.h ../byterun/caml/gc.h \
+ ../byterun/caml/gc_ctrl.h ../byterun/caml/intext.h ../byterun/caml/io.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/misc.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/osdeps.h \
+ ../byterun/caml/printexc.h stack.h ../byterun/caml/sys.h
+str.d.o: str.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/fail.h ../byterun/caml/mlvalues.h ../byterun/caml/misc.h
+sys.d.o: sys.c ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/alloc.h \
+ ../byterun/caml/misc.h ../byterun/caml/config.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/debugger.h \
+ ../byterun/caml/fail.h ../byterun/caml/instruct.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/osdeps.h \
+ ../byterun/caml/signals.h ../byterun/caml/stacks.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/sys.h
+terminfo.d.o: terminfo.c ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/alloc.h ../byterun/caml/misc.h ../byterun/caml/config.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/fail.h ../byterun/caml/io.h \
+ ../byterun/caml/mlvalues.h
+unix.d.o: unix.c ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/memory.h \
+ ../byterun/caml/config.h ../byterun/caml/gc.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/misc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/misc.h \
+ ../byterun/caml/osdeps.h
+weak.d.o: weak.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/fail.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/mlvalues.h
+alloc.p.o: alloc.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/custom.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/stacks.h ../byterun/caml/memory.h
+array.p.o: array.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/fail.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h
+backtrace.p.o: backtrace.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/backtrace.h ../byterun/caml/memory.h \
+ ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/misc.h \
+ ../byterun/caml/mlvalues.h stack.h
+callback.p.o: callback.c ../byterun/caml/callback.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/misc.h ../byterun/caml/fail.h ../byterun/caml/memory.h \
+ ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/mlvalues.h
+compact.p.o: compact.c ../byterun/caml/address_class.h \
+ ../byterun/caml/misc.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/config.h \
+ ../byterun/caml/finalise.h ../byterun/caml/roots.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/freelist.h \
+ ../byterun/caml/gc.h ../byterun/caml/gc_ctrl.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/memory.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/roots.h \
+ ../byterun/caml/weak.h
+compare.p.o: compare.c ../byterun/caml/custom.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/misc.h \
+ ../byterun/caml/fail.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h
+custom.p.o: custom.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/custom.h ../byterun/caml/fail.h ../byterun/caml/memory.h \
+ ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/mlvalues.h
+debugger.p.o: debugger.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/config.h ../byterun/caml/debugger.h \
+ ../byterun/caml/misc.h
+dynlink.p.o: dynlink.c ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/alloc.h ../byterun/caml/misc.h ../byterun/caml/config.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/dynlink.h \
+ ../byterun/caml/fail.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/misc.h \
+ ../byterun/caml/osdeps.h ../byterun/caml/prims.h \
+ ../byterun/caml/signals.h
+extern.p.o: extern.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/custom.h ../byterun/caml/fail.h ../byterun/caml/gc.h \
+ ../byterun/caml/intext.h ../byterun/caml/io.h ../byterun/caml/io.h \
+ ../byterun/caml/md5.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/reverse.h
+fail.p.o: fail.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/fail.h ../byterun/caml/io.h ../byterun/caml/gc.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/printexc.h ../byterun/caml/signals.h stack.h \
+ ../byterun/caml/roots.h ../byterun/caml/memory.h \
+ ../byterun/caml/callback.h
+finalise.p.o: finalise.c ../byterun/caml/callback.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/misc.h ../byterun/caml/fail.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/roots.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/signals.h
+floats.p.o: floats.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/fail.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/misc.h \
+ ../byterun/caml/reverse.h ../byterun/caml/stacks.h \
+ ../byterun/caml/memory.h
+freelist.p.o: freelist.c ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/freelist.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/mlvalues.h ../byterun/caml/gc.h \
+ ../byterun/caml/gc_ctrl.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/misc.h \
+ ../byterun/caml/mlvalues.h
+gc_ctrl.p.o: gc_ctrl.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/compact.h ../byterun/caml/custom.h \
+ ../byterun/caml/finalise.h ../byterun/caml/roots.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/freelist.h \
+ ../byterun/caml/gc.h ../byterun/caml/gc_ctrl.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h stack.h
+globroots.p.o: globroots.c ../byterun/caml/memory.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/gc.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/misc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/roots.h ../byterun/caml/memory.h \
+ ../byterun/caml/globroots.h ../byterun/caml/roots.h
+hash.p.o: hash.c ../byterun/caml/mlvalues.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/misc.h ../byterun/caml/custom.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/hash.h
+intern.p.o: intern.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/callback.h ../byterun/caml/custom.h \
+ ../byterun/caml/fail.h ../byterun/caml/gc.h ../byterun/caml/intext.h \
+ ../byterun/caml/io.h ../byterun/caml/io.h ../byterun/caml/md5.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/misc.h ../byterun/caml/reverse.h
+ints.p.o: ints.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/custom.h ../byterun/caml/fail.h ../byterun/caml/intext.h \
+ ../byterun/caml/io.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h
+io.p.o: io.c ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/alloc.h \
+ ../byterun/caml/misc.h ../byterun/caml/config.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/custom.h \
+ ../byterun/caml/fail.h ../byterun/caml/io.h ../byterun/caml/memory.h \
+ ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/misc.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/signals.h \
+ ../byterun/caml/sys.h
+lexing.p.o: lexing.c ../byterun/caml/fail.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/stacks.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h
+main.p.o: main.c ../byterun/caml/misc.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/misc.h ../byterun/caml/sys.h
+major_gc.p.o: major_gc.c ../byterun/caml/compact.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/misc.h ../byterun/caml/custom.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/config.h \
+ ../byterun/caml/fail.h ../byterun/caml/finalise.h \
+ ../byterun/caml/roots.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/freelist.h ../byterun/caml/gc.h \
+ ../byterun/caml/gc_ctrl.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/roots.h ../byterun/caml/weak.h
+md5.p.o: md5.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/fail.h ../byterun/caml/md5.h ../byterun/caml/io.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/io.h ../byterun/caml/reverse.h
+memory.p.o: memory.c ../byterun/caml/address_class.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/fail.h ../byterun/caml/freelist.h ../byterun/caml/gc.h \
+ ../byterun/caml/gc_ctrl.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/signals.h
+meta.p.o: meta.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/config.h ../byterun/caml/fail.h \
+ ../byterun/caml/fix_code.h ../byterun/caml/interp.h \
+ ../byterun/caml/intext.h ../byterun/caml/io.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/prims.h ../byterun/caml/stacks.h \
+ ../byterun/caml/memory.h
+minor_gc.p.o: minor_gc.c ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/fail.h ../byterun/caml/misc.h ../byterun/caml/config.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/finalise.h \
+ ../byterun/caml/roots.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/gc.h ../byterun/caml/gc_ctrl.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/memory.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/misc.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/roots.h \
+ ../byterun/caml/signals.h ../byterun/caml/weak.h
+misc.p.o: misc.c ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/misc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h
+natdynlink.p.o: natdynlink.c ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/misc.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h stack.h ../byterun/caml/callback.h \
+ ../byterun/caml/alloc.h ../byterun/caml/intext.h ../byterun/caml/io.h \
+ ../byterun/caml/osdeps.h ../byterun/caml/fail.h \
+ ../byterun/caml/signals.h
+obj.p.o: obj.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/fail.h ../byterun/caml/gc.h ../byterun/caml/interp.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/misc.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/prims.h
+parsing.p.o: parsing.c ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/config.h \
+ ../byterun/caml/misc.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/alloc.h
+printexc.p.o: printexc.c ../byterun/caml/backtrace.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/misc.h ../byterun/caml/callback.h \
+ ../byterun/caml/debugger.h ../byterun/caml/fail.h ../byterun/caml/misc.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/printexc.h
+roots.p.o: roots.c ../byterun/caml/finalise.h ../byterun/caml/roots.h \
+ ../byterun/caml/misc.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/globroots.h ../byterun/caml/memory.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h stack.h \
+ ../byterun/caml/roots.h
+signals_asm.p.o: signals_asm.c ../byterun/caml/fail.h \
+ ../byterun/caml/misc.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/osdeps.h ../byterun/caml/signals.h \
+ ../byterun/caml/signals_machdep.h signals_osdep.h stack.h
+signals.p.o: signals.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/callback.h ../byterun/caml/config.h \
+ ../byterun/caml/fail.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
+ ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
+ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/roots.h ../byterun/caml/memory.h \
+ ../byterun/caml/signals.h ../byterun/caml/signals_machdep.h \
+ ../byterun/caml/sys.h
+startup.p.o: startup.c ../byterun/caml/callback.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/misc.h ../byterun/caml/backtrace.h \
+ ../byterun/caml/custom.h ../byterun/caml/debugger.h \
+ ../byterun/caml/fail.h ../byterun/caml/freelist.h ../byterun/caml/gc.h \
+ ../byterun/caml/gc_ctrl.h ../byterun/caml/intext.h ../byterun/caml/io.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/misc.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/osdeps.h \
+ ../byterun/caml/printexc.h stack.h ../byterun/caml/sys.h
+str.p.o: str.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/fail.h ../byterun/caml/mlvalues.h ../byterun/caml/misc.h
+sys.p.o: sys.c ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/alloc.h \
+ ../byterun/caml/misc.h ../byterun/caml/config.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/debugger.h \
+ ../byterun/caml/fail.h ../byterun/caml/instruct.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/osdeps.h \
+ ../byterun/caml/signals.h ../byterun/caml/stacks.h \
+ ../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/sys.h
+terminfo.p.o: terminfo.c ../byterun/caml/config.h \
+ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \
+ ../byterun/caml/alloc.h ../byterun/caml/misc.h ../byterun/caml/config.h \
+ ../byterun/caml/mlvalues.h ../byterun/caml/fail.h ../byterun/caml/io.h \
+ ../byterun/caml/mlvalues.h
+unix.p.o: unix.c ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/memory.h \
+ ../byterun/caml/config.h ../byterun/caml/gc.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/misc.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/misc.h \
+ ../byterun/caml/osdeps.h
+weak.p.o: weak.c ../byterun/caml/alloc.h ../byterun/caml/misc.h \
+ ../byterun/caml/config.h ../byterun/caml/../../config/m.h \
+ ../byterun/caml/../../config/s.h ../byterun/caml/mlvalues.h \
+ ../byterun/caml/fail.h ../byterun/caml/major_gc.h \
+ ../byterun/caml/freelist.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
+ ../byterun/caml/major_gc.h ../byterun/caml/minor_gc.h \
+ ../byterun/caml/address_class.h ../byterun/caml/mlvalues.h
CC=$(NATIVECC)
FLAGS=-I../byterun -DCAML_NAME_SPACE -DNATIVE_CODE \
-DTARGET_$(ARCH) -DSYS_$(SYSTEM) $(IFLEXDIR)
-CFLAGS=$(FLAGS) -O $(NATIVECCCOMPOPTS)
+CFLAGS=$(FLAGS) $(NATIVECCCOMPOPTS)
DFLAGS=$(FLAGS) -g -DDEBUG $(NATIVECCCOMPOPTS)
PFLAGS=$(FLAGS) -pg -O -DPROFILING $(NATIVECCPROFOPTS)
+PICFLAGS=$(FLAGS) -O $(SHAREDCCCOMPOPTS) $(NATIVECCCOMPOPTS)
COBJS=startup.o main.o fail.o roots.o globroots.o signals.o signals_asm.o \
misc.o freelist.o major_gc.o minor_gc.o memory.o alloc.o compare.o ints.o \
OBJS=$(COBJS) $(ASMOBJS)
DOBJS=$(COBJS:.o=.d.o) $(ASMOBJS)
POBJS=$(COBJS:.o=.p.o) $(ASMOBJS:.o=.p.o)
+PICOBJS=$(COBJS:.o=.pic.o) $(ASMOBJS:.o=.pic.o)
-all: libasmrun.a all-$(RUNTIMED) all-$(PROFILING)
+all: libasmrun.a all-$(RUNTIMED) all-$(PROFILING) all-$(SHARED)
libasmrun.a: $(OBJS)
rm -f libasmrun.a
- ar rc libasmrun.a $(OBJS)
+ $(ARCMD) rc libasmrun.a $(OBJS)
$(RANLIB) libasmrun.a
all-noruntimed:
libasmrund.a: $(DOBJS)
rm -f libasmrund.a
- ar rc libasmrund.a $(DOBJS)
+ $(ARCMD) rc libasmrund.a $(DOBJS)
$(RANLIB) libasmrund.a
all-noprof:
libasmrunp.a: $(POBJS)
rm -f libasmrunp.a
- ar rc libasmrunp.a $(POBJS)
+ $(ARCMD) rc libasmrunp.a $(POBJS)
$(RANLIB) libasmrunp.a
+all-noshared:
+
+all-shared: libasmrun_pic.a libasmrun_shared.so
+
+libasmrun_pic.a: $(PICOBJS)
+ rm -f libasmrun_pic.a
+ ar rc libasmrun_pic.a $(PICOBJS)
+ $(RANLIB) libasmrun_pic.a
+
+libasmrun_shared.so: $(PICOBJS)
+ $(MKDLL) -o libasmrun_shared.so $(PICOBJS) $(NATIVECCLIBS)
+
INSTALL_LIBDIR=$(DESTDIR)$(LIBDIR)
-install: install-default install-$(RUNTIMED) install-$(PROFILING)
+install: install-default install-$(RUNTIMED) install-$(PROFILING) install-$(SHARED)
install-default:
cp libasmrun.a $(INSTALL_LIBDIR)/libasmrun.a
cd $(INSTALL_LIBDIR); $(RANLIB) libasmrun.a
+.PHONY: install-default
install-noruntimed:
.PHONY: install-noruntimed
install-noprof:
rm -f $(INSTALL_LIBDIR)/libasmrunp.a
ln -s libasmrun.a $(INSTALL_LIBDIR)/libasmrunp.a
+.PHONY: install-noprof
install-prof:
cp libasmrunp.a $(INSTALL_LIBDIR)/libasmrunp.a
cd $(INSTALL_LIBDIR); $(RANLIB) libasmrunp.a
+.PHONY: install-prof
+
+install-noshared:
+.PHONY: install-noshared
+
+install-shared:
+ cp libasmrun_pic.a $(INSTALL_LIBDIR)/libasmrun_pic.a
+ cd $(INSTALL_LIBDIR); $(RANLIB) libasmrunp.a
+ cp libasmrun_shared.so $(INSTALL_LIBDIR)/libasmrun_shared.so
+.PHONY: install-prof
power-bsd_elf.S: power-elf.S
cp power-elf.S power-bsd_elf.S
power.p.o: power-$(SYSTEM).o
cp power-$(SYSTEM).o power.p.o
+power.pic.o: power-$(SYSTEM).pic.o
+ cp power-$(SYSTEM).pic.o power.pic.o
+
main.c: ../byterun/main.c
ln -s ../byterun/main.c main.c
misc.c: ../byterun/misc.c
clean::
rm -f $(LINKEDFILES)
-.SUFFIXES: .S .d.o .p.o
-
-.S.o:
- $(ASPP) -DSYS_$(SYSTEM) -DMODEL_$(MODEL) -o $*.o $*.S || \
+%.o: %.S
+ $(ASPP) -DSYS_$(SYSTEM) -DMODEL_$(MODEL) -o $@ $< || \
{ 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) -DMODEL_$(MODEL) $(ASPPPROFFLAGS) -o $*.p.o $*.S
+%.p.o: %.S
+ $(ASPP) -DSYS_$(SYSTEM) -DMODEL_$(MODEL) $(ASPPPROFFLAGS) -o $@ $<
+
+%.pic.o: %.S
+ $(ASPP) -DSYS_$(SYSTEM) -DMODEL_$(MODEL) $(SHAREDCCCOMPOPTS) -o $@ $<
+
+%.d.o: %.c
+ $(CC) -c $(DFLAGS) -o $@ $<
+
+%.p.o: %.c
+ $(CC) -c $(PFLAGS) -o $@ $<
-.c.d.o:
- ln -s -f $*.c $*.d.c
- $(CC) -c $(DFLAGS) $*.d.c
- rm -f $*.d.c
+%.pic.o: %.c
+ $(CC) -c $(PICFLAGS) -o $@ $<
-.c.p.o:
- ln -s -f $*.c $*.p.c
- $(CC) -c $(PFLAGS) $*.p.c
- rm -f $*.p.c
+%.o: %.s
+ $(ASPP) -DSYS_$(SYSTEM) -o $@ $<
-.s.o:
- $(ASPP) -DSYS_$(SYSTEM) -o $*.o $*.s
+%.p.o: %.s
+ $(ASPP) -DSYS_$(SYSTEM) $(ASPPPROFFLAGS) -o $@ $<
-.s.p.o:
- $(ASPP) -DSYS_$(SYSTEM) $(ASPPPROFFLAGS) -o $*.p.o $*.s
+%.pic.o: %.s
+ $(ASPP) -DSYS_$(SYSTEM) $(SHAREDCCCOMPOPTS) -o $@ $<
clean::
rm -f *.o *.a *~
depend: $(COBJS:.o=.c) ${LINKEDFILES}
- -gcc -MM $(FLAGS) *.c > .depend
- gcc -MM $(FLAGS) -DDEBUG *.c | sed -e 's/\.o/.d.o/' >> .depend
- gcc -MM $(FLAGS) -DDEBUG *.c | sed -e 's/\.o/.p.o/' >> .depend
+ $(CC) -MM $(FLAGS) *.c > .depend
+ $(CC) -MM $(FLAGS) -DDEBUG *.c | sed -e 's/\.o/.d.o/' >> .depend
+ $(CC) -MM $(FLAGS) -DPROFILING *.c | sed -e 's/\.o/.p.o/' >> .depend
include .depend
win32.$(O): ../byterun/win32.c
$(CC) -c $(NATIVECCCOMPOPTS) -DNATIVE_CODE $(IFLEXDIR) ../byterun/win32.c
-.SUFFIXES: .c .$(O)
-
-.c.$(O):
+%.$(O): %.c
$(CC) $(CFLAGS) -c $<
clean::
/* Save callee-save registers */
PUSH_CALLEE_SAVE_REGS
/* Initial entry point is G(caml_program) */
- leaq GCALL(caml_program)(%rip), %r12
+ LEA_VAR(caml_program, %r12)
/* Common code for caml_start_program and caml_callback* */
LBL(caml_start_program):
/* Build a callback link */
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 */
+ LEA_VAR(caml_apply2, %r12) /* code pointer */
jmp LBL(caml_start_program)
CFI_ENDPROC
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 */
+ LEA_VAR(caml_apply3, %r12) /* code pointer */
jmp LBL(caml_start_program)
CFI_ENDPROC
FUNCTION(G(caml_ml_array_bound_error))
CFI_STARTPROC
- leaq GCALL(caml_array_bound_error)(%rip), %rax
+ LEA_VAR(caml_array_bound_error, %rax)
jmp LBL(caml_c_call)
CFI_ENDPROC
#include <stdlib.h>
#include <string.h>
-#include "alloc.h"
-#include "backtrace.h"
-#include "memory.h"
-#include "misc.h"
-#include "mlvalues.h"
+#include "caml/alloc.h"
+#include "caml/backtrace.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
#include "stack.h"
int caml_backtrace_active = 0;
/* Extract location information for the given frame descriptor */
-struct loc_info {
- int loc_valid;
- int loc_is_raise;
- char * loc_filename;
- int loc_lnum;
- int loc_startchr;
- int loc_endchr;
-};
-
-static void extract_location_info(frame_descr * d,
- /*out*/ struct loc_info * li)
+CAMLexport void extract_location_info(frame_descr * d,
+ /*out*/ struct caml_loc_info * li)
{
uintnat infoptr;
uint32 info1, info2;
useless. We kept it to keep code identical to the byterun/
implementation. */
-static void print_location(struct loc_info * li, int index)
+static void print_location(struct caml_loc_info * li, int index)
{
char * info;
void caml_print_exception_backtrace(void)
{
int i;
- struct loc_info li;
+ struct caml_loc_info li;
for (i = 0; i < caml_backtrace_pos; i++) {
extract_location_info((frame_descr *) (caml_backtrace_buffer[i]), &li);
CAMLprim value caml_convert_raw_backtrace_slot(value backtrace_slot) {
CAMLparam1(backtrace_slot);
CAMLlocal2(p, fname);
- struct loc_info li;
+ struct caml_loc_info li;
extract_location_info(Descrptr_Val(backtrace_slot), &li);
#include <stdio.h>
#include <signal.h>
-#include "alloc.h"
-#include "fail.h"
-#include "io.h"
-#include "gc.h"
-#include "memory.h"
-#include "mlvalues.h"
-#include "printexc.h"
-#include "signals.h"
+#include "caml/alloc.h"
+#include "caml/fail.h"
+#include "caml/io.h"
+#include "caml/gc.h"
+#include "caml/memory.h"
+#include "caml/mlvalues.h"
+#include "caml/printexc.h"
+#include "caml/signals.h"
#include "stack.h"
-#include "roots.h"
-#include "callback.h"
+#include "caml/roots.h"
+#include "caml/callback.h"
/* The globals holding predefined exceptions */
/* Linux/BSD with ELF binaries and Solaris do not prefix identifiers with _.
Linux/BSD with a.out binaries and NextStep do. */
-#if defined(SYS_solaris)
+#if (defined(SYS_solaris) && !defined(__GNUC__))
#define CONCAT(a,b) a/**/b
#else
#define CONCAT(a,b) a##b
/* */
/***********************************************************************/
-#include "misc.h"
-#include "mlvalues.h"
-#include "memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/memory.h"
#include "stack.h"
-#include "callback.h"
-#include "alloc.h"
-#include "intext.h"
-#include "osdeps.h"
-#include "fail.h"
+#include "caml/callback.h"
+#include "caml/alloc.h"
+#include "caml/intext.h"
+#include "caml/osdeps.h"
+#include "caml/fail.h"
+#include "caml/signals.h"
#include <stdio.h>
#include <string.h>
CAMLlocal1 (res);
void *sym;
void *handle;
+ char *p;
/* TODO: dlclose in case of error... */
- handle = caml_dlopen(String_val(filename), 1, Int_val(global));
+ p = caml_strdup(String_val(filename));
+ caml_enter_blocking_section();
+ handle = caml_dlopen(p, 1, Int_val(global));
+ caml_leave_blocking_section();
+ caml_stat_free(p);
if (NULL == handle)
CAMLreturn(caml_copy_string(caml_dlerror()));
CAMLparam2 (filename, symbol);
CAMLlocal2 (res, v);
void *handle;
+ char *p;
/* TODO: dlclose in case of error... */
- handle = caml_dlopen(String_val(filename), 1, 1);
+ p = caml_strdup(String_val(filename));
+ caml_enter_blocking_section();
+ handle = caml_dlopen(p, 1, 1);
+ caml_leave_blocking_section();
+ caml_stat_free(p);
if (NULL == handle) {
res = caml_alloc(1,1);
/* To walk the memory roots for garbage collection */
-#include "finalise.h"
-#include "globroots.h"
-#include "memory.h"
-#include "major_gc.h"
-#include "minor_gc.h"
-#include "misc.h"
-#include "mlvalues.h"
+#include "caml/finalise.h"
+#include "caml/globroots.h"
+#include "caml/memory.h"
+#include "caml/major_gc.h"
+#include "caml/minor_gc.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
#include "stack.h"
-#include "roots.h"
+#include "caml/roots.h"
#include <string.h>
#include <stdio.h>
#include <signal.h>
#include <errno.h>
#include <stdio.h>
-#include "fail.h"
-#include "memory.h"
-#include "osdeps.h"
-#include "signals.h"
-#include "signals_machdep.h"
+#include "caml/fail.h"
+#include "caml/memory.h"
+#include "caml/osdeps.h"
+#include "caml/signals.h"
+#include "caml/signals_machdep.h"
#include "signals_osdep.h"
#include "stack.h"
extern char * caml_code_area_start, * caml_code_area_end;
extern char caml_system__code_begin, caml_system__code_end;
+/* Do not use the macro from address_class.h here. */
+#undef Is_in_code_area
#define Is_in_code_area(pc) \
( ((char *)(pc) >= caml_code_area_start && \
(char *)(pc) <= caml_code_area_end) \
#elif defined(TARGET_arm) && (defined(SYS_linux_eabi) \
|| defined(SYS_linux_eabihf))
- #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 <sys/ucontext.h>
- #endif
+ #include <sys/ucontext.h>
#define DECLARE_SIGNAL_HANDLER(name) \
static void name(int sig, siginfo_t * info, ucontext_t * context)
#elif defined(TARGET_i386) && defined(SYS_bsd_elf)
- #define DECLARE_SIGNAL_HANDLER(name) \
- static void name(int sig, siginfo_t * info, struct sigcontext * context)
+ #if defined (__NetBSD__)
+ #include <ucontext.h>
+ #define DECLARE_SIGNAL_HANDLER(name) \
+ static void name(int sig, siginfo_t * info, ucontext_t * context)
+ #else
+ #define DECLARE_SIGNAL_HANDLER(name) \
+ static void name(int sig, siginfo_t * info, struct sigcontext * context)
+ #endif
#define SET_SIGACT(sigact,name) \
sigact.sa_sigaction = (void (*)(int,siginfo_t *,void *)) (name); \
sigact.sa_flags = SA_SIGINFO
- #define CONTEXT_PC (context->sc_eip)
+ #if defined (__NetBSD__)
+ #define CONTEXT_PC (_UC_MACHINE_PC(context))
+ #else
+ #define CONTEXT_PC (context->sc_eip)
+ #endif
#define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
/****************** I386, BSD */
unsigned short live_ofs[1];
} frame_descr;
+struct caml_loc_info {
+ int loc_valid;
+ int loc_is_raise;
+ char * loc_filename;
+ int loc_lnum;
+ int loc_startchr;
+ int loc_endchr;
+};
+
/* Hash table of frame descriptors */
extern frame_descr ** caml_frame_descriptors;
extern void caml_register_frametable(intnat *);
extern void caml_register_dyn_global(void *);
+CAMLextern void extract_location_info(frame_descr * d,
+ /*out*/ struct caml_loc_info * li);
+
+
extern uintnat caml_stack_usage (void);
extern uintnat (*caml_stack_usage_hook)(void);
#include <stdio.h>
#include <stdlib.h>
-#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"
-#include "osdeps.h"
-#include "printexc.h"
+#include "caml/callback.h"
+#include "caml/backtrace.h"
+#include "caml/custom.h"
+#include "caml/debugger.h"
+#include "caml/fail.h"
+#include "caml/freelist.h"
+#include "caml/gc.h"
+#include "caml/gc_ctrl.h"
+#include "caml/intext.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/osdeps.h"
+#include "caml/printexc.h"
#include "stack.h"
-#include "sys.h"
+#include "caml/sys.h"
#ifdef HAS_UI
-#include "ui.h"
+#include "caml/ui.h"
#endif
extern int caml_parser_trace;
let lib_ccopts = ref []
let lib_dllibs = ref []
-let add_ccobjs l =
+let add_ccobjs origin l =
if not !Clflags.no_auto_link then begin
if
String.length !Clflags.use_runtime = 0
then begin
if l.lib_custom then Clflags.custom_runtime := true;
lib_ccobjs := l.lib_ccobjs @ !lib_ccobjs;
- lib_ccopts := l.lib_ccopts @ !lib_ccopts;
+ let replace_origin = Misc.replace_substring ~before:"$CAMLORIGIN" ~after:origin in
+ lib_ccopts := List.map replace_origin l.lib_ccopts @ !lib_ccopts;
end;
lib_dllibs := l.lib_dllibs @ !lib_dllibs
end
seek_in ic pos_toc;
let toc = (input_value ic : library) in
close_in ic;
- add_ccobjs toc;
+ add_ccobjs (Filename.dirname file_name) toc;
let required =
List.fold_right
(fun compunit reqd ->
(* Record compilation events *)
-let debug_info = ref ([] : (int * LongString.t) list)
+let debug_info = ref ([] : (int * Instruct.debug_event list * string list) list)
(* Link in a compilation unit *)
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 = LongString.input_bytes inchan compunit.cu_debugsize in
- debug_info := (currpos_fun(), buffer) :: !debug_info
+ let debug_event_list : Instruct.debug_event list = input_value inchan in
+ let debug_dirs : string list = input_value inchan in
+ let file_path = Filename.dirname (Location.absolute_path file_name) in
+ let debug_dirs =
+ if List.mem file_path debug_dirs
+ then debug_dirs
+ else file_path :: debug_dirs in
+ debug_info := (currpos_fun(), debug_event_list, debug_dirs) :: !debug_info
end;
Array.iter output_fun code_block;
if !Clflags.link_everything then
let output_debug_info oc =
output_binary_int oc (List.length !debug_info);
List.iter
- (fun (ofs, evl) ->
+ (fun (ofs, evl, debug_dirs) ->
output_binary_int oc ofs;
- Array.iter (output_bytes oc) evl)
+ output_value oc evl;
+ output_value oc debug_dirs)
!debug_info;
debug_info := []
Bytesections.init_record outchan;
(* The path to the bytecode interpreter (in use_runtime mode) *)
if String.length !Clflags.use_runtime > 0 then begin
- output_string outchan (make_absolute !Clflags.use_runtime);
+ output_string outchan ("#!" ^ (make_absolute !Clflags.use_runtime));
output_char outchan '\n';
Bytesections.record outchan "RNTM"
end;
raise x
end else begin
let basename = Filename.chop_extension output_name in
- let c_file = basename ^ ".c"
- and obj_file = basename ^ Config.ext_obj in
+ let c_file =
+ if !Clflags.output_complete_object
+ then Filename.temp_file "camlobj" ".c"
+ else basename ^ ".c"
+ and obj_file =
+ if !Clflags.output_complete_object
+ then Filename.temp_file "camlobj" Config.ext_obj
+ else basename ^ Config.ext_obj
+ in
if Sys.file_exists c_file then raise(Error(File_exists c_file));
let temps = ref [] in
try
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
+ if not (Filename.check_suffix output_name Config.ext_obj) ||
+ !Clflags.output_complete_object then begin
temps := obj_file :: !temps;
+ let mode, c_libs =
+ if Filename.check_suffix output_name Config.ext_obj
+ then Ccomp.Partial, ""
+ else Ccomp.MainDll, Config.bytecomp_c_libraries
+ in
if not (
let runtime_lib = "-lcamlrun" ^ !Clflags.runtime_variant in
- Ccomp.call_linker Ccomp.MainDll output_name
+ Ccomp.call_linker mode output_name
([obj_file] @ List.rev !Clflags.ccobjs @ [runtime_lib])
- Config.bytecomp_c_libraries
+ c_libs
) then raise (Error Custom_runtime);
end
end;
| Loc_FILE -> Lconst (Const_immstring file)
| Loc_MODULE ->
let filename = Filename.basename file in
- let module_name =
- try String.capitalize (Filename.chop_extension filename)
- with Invalid_argument _ -> "//"^filename^"//"
- in Lconst (Const_immstring module_name)
+ let name = Env.get_unit_name () in
+ let module_name = if name = "" then "//"^filename^"//" else name in
+ Lconst (Const_immstring module_name)
| Loc_LOC ->
let loc = Printf.sprintf "File %S, line %d, characters %d-%d"
file lnum cnum enum in
try
find_numtable !c_prim_table name
with Not_found ->
- if !Clflags.custom_runtime then
+ if !Clflags.custom_runtime || Config.host <> Config.target
+ || !Clflags.no_check_prims
+ then
enter_numtable c_prim_table name
else begin
let symb =
(lam, Ident.empty) id_pos_list
in
if s == Ident.empty then lam else subst_lambda s lam
-
+
(* Compose two coercions
apply_coercion c1 (apply_coercion c2 e) behaves like
| Tstr_primitive descr ->
record_primitive descr.val_val;
transl_structure fields cc rootpath rem
- | Tstr_type(decls) ->
+ | Tstr_type decls ->
transl_structure fields cc rootpath rem
| Tstr_typext(tyext) ->
let ids = List.map (fun ext -> ext.ext_id) tyext.tyext_constructors in
| Tstr_primitive descr ->
record_primitive descr.val_val;
transl_store rootpath subst rem
- | Tstr_type(decls) ->
+ | Tstr_type decls ->
transl_store rootpath subst rem
| Tstr_typext(tyext) ->
let ids = List.map (fun ext -> ext.ext_id) tyext.tyext_constructors in
-alloc.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
-array.o: array.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
-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 \
- 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 fail.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 \
- freelist.h minor_gc.h interp.h instruct.h fix_code.h stacks.h
-compact.o: compact.c config.h ../config/m.h ../config/s.h compatibility.h \
- finalise.h roots.h misc.h memory.h gc.h mlvalues.h major_gc.h \
- freelist.h minor_gc.h gc_ctrl.h weak.h
-compare.o: compare.c custom.h compatibility.h mlvalues.h config.h \
- ../config/m.h ../config/s.h misc.h fail.h memory.h gc.h major_gc.h \
- freelist.h minor_gc.h
-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 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 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 \
- freelist.h minor_gc.h printexc.h signals.h stacks.h
-finalise.o: finalise.c callback.h compatibility.h mlvalues.h config.h \
- ../config/m.h ../config/s.h misc.h fail.h roots.h memory.h gc.h \
- 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 \
- 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
-freelist.o: freelist.c config.h ../config/m.h ../config/s.h \
- compatibility.h freelist.h misc.h mlvalues.h gc.h gc_ctrl.h memory.h \
- major_gc.h minor_gc.h
-gc_ctrl.o: gc_ctrl.c alloc.h compatibility.h misc.h config.h \
- ../config/m.h ../config/s.h mlvalues.h compact.h custom.h finalise.h \
- roots.h memory.h gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h \
- stacks.h
-globroots.o: globroots.c memory.h compatibility.h config.h ../config/m.h \
- ../config/s.h gc.h mlvalues.h misc.h major_gc.h freelist.h minor_gc.h \
- 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 hash.h
+alloc.o: alloc.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/custom.h caml/major_gc.h caml/freelist.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
+ caml/address_class.h caml/mlvalues.h caml/stacks.h caml/memory.h
+array.o: array.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
+ caml/mlvalues.h
+backtrace.o: backtrace.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/mlvalues.h caml/config.h \
+ caml/misc.h caml/alloc.h caml/mlvalues.h caml/io.h caml/instruct.h \
+ caml/intext.h caml/io.h caml/exec.h caml/fix_code.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/startup.h caml/exec.h caml/stacks.h \
+ caml/memory.h caml/sys.h caml/backtrace.h caml/fail.h
+callback.o: callback.c caml/callback.h caml/compatibility.h \
+ caml/mlvalues.h caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/mlvalues.h caml/interp.h caml/instruct.h caml/fix_code.h \
+ caml/stacks.h caml/memory.h
+compact.o: compact.c caml/address_class.h caml/misc.h \
+ caml/compatibility.h caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/mlvalues.h caml/config.h caml/finalise.h \
+ caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/freelist.h caml/gc.h \
+ caml/gc_ctrl.h caml/major_gc.h caml/memory.h caml/mlvalues.h \
+ caml/roots.h caml/weak.h
+compare.o: compare.c caml/custom.h caml/compatibility.h caml/mlvalues.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h caml/misc.h \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/misc.h caml/mlvalues.h
+custom.o: custom.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/custom.h caml/fail.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/mlvalues.h
+debugger.o: debugger.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/config.h caml/debugger.h caml/misc.h caml/fail.h \
+ caml/fix_code.h caml/instruct.h caml/intext.h caml/io.h caml/io.h \
+ caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/sys.h
+dynlink.o: dynlink.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/alloc.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/dynlink.h caml/fail.h caml/mlvalues.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/misc.h caml/osdeps.h caml/prims.h \
+ caml/signals.h
+extern.o: extern.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
+ caml/mlvalues.h caml/reverse.h
+fail.o: fail.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/misc.h caml/mlvalues.h caml/printexc.h caml/signals.h caml/stacks.h \
+ caml/memory.h
+finalise.o: finalise.c caml/callback.h caml/compatibility.h \
+ caml/mlvalues.h caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/misc.h caml/fail.h caml/mlvalues.h \
+ caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/signals.h
+fix_code.o: fix_code.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/debugger.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/fix_code.h caml/instruct.h \
+ caml/intext.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
+floats.o: floats.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
+freelist.o: freelist.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/freelist.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/gc.h caml/gc_ctrl.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/major_gc.h caml/misc.h caml/mlvalues.h
+gc_ctrl.o: gc_ctrl.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/compact.h caml/custom.h caml/finalise.h \
+ caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/freelist.h caml/gc.h \
+ caml/gc_ctrl.h caml/major_gc.h caml/minor_gc.h caml/misc.h \
+ caml/mlvalues.h caml/stacks.h
+globroots.o: globroots.c caml/memory.h caml/compatibility.h caml/config.h \
+ caml/../../config/m.h caml/../../config/s.h caml/gc.h caml/mlvalues.h \
+ caml/misc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/memory.h caml/globroots.h caml/roots.h
+hash.o: hash.c caml/mlvalues.h caml/compatibility.h caml/config.h \
+ caml/../../config/m.h caml/../../config/s.h caml/misc.h caml/custom.h \
+ caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/hash.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 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 memory.h gc.h \
- major_gc.h freelist.h minor_gc.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
-lexing.o: lexing.c fail.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h \
- minor_gc.h
-main.o: main.c misc.h compatibility.h config.h ../config/m.h \
- ../config/s.h mlvalues.h sys.h
-major_gc.o: major_gc.c compact.h config.h ../config/m.h ../config/s.h \
- compatibility.h misc.h custom.h mlvalues.h fail.h finalise.h roots.h \
- memory.h gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h weak.h
-md5.o: md5.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h md5.h io.h memory.h gc.h major_gc.h \
- freelist.h minor_gc.h reverse.h
-memory.o: memory.c fail.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h freelist.h gc.h gc_ctrl.h major_gc.h memory.h \
- minor_gc.h signals.h
-meta.o: meta.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h fix_code.h interp.h intext.h io.h \
- major_gc.h freelist.h memory.h gc.h minor_gc.h prims.h stacks.h
-minor_gc.o: minor_gc.c config.h ../config/m.h ../config/s.h \
- compatibility.h fail.h misc.h mlvalues.h finalise.h roots.h memory.h \
- gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h signals.h weak.h
-misc.o: misc.c config.h ../config/m.h ../config/s.h compatibility.h \
- misc.h memory.h gc.h mlvalues.h major_gc.h freelist.h minor_gc.h
-obj.o: obj.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h gc.h interp.h major_gc.h freelist.h \
- memory.h minor_gc.h prims.h
-parsing.o: parsing.c config.h ../config/m.h ../config/s.h compatibility.h \
- mlvalues.h misc.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
- alloc.h
-prims.o: prims.c mlvalues.h compatibility.h config.h ../config/m.h \
- ../config/s.h misc.h prims.h
-printexc.o: printexc.c backtrace.h mlvalues.h compatibility.h config.h \
- ../config/m.h ../config/s.h misc.h callback.h debugger.h fail.h \
- printexc.h
-roots.o: roots.c finalise.h roots.h misc.h compatibility.h config.h \
- ../config/m.h ../config/s.h memory.h gc.h mlvalues.h major_gc.h \
- freelist.h minor_gc.h globroots.h stacks.h
-signals.o: signals.c alloc.h compatibility.h misc.h config.h \
- ../config/m.h ../config/s.h mlvalues.h callback.h fail.h memory.h gc.h \
- major_gc.h freelist.h minor_gc.h roots.h signals.h signals_machdep.h \
- sys.h
-signals_byt.o: signals_byt.c config.h ../config/m.h ../config/s.h \
- compatibility.h memory.h gc.h mlvalues.h misc.h major_gc.h freelist.h \
- minor_gc.h osdeps.h signals.h signals_machdep.h
-stacks.o: stacks.c config.h ../config/m.h ../config/s.h compatibility.h \
- fail.h misc.h mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h \
- minor_gc.h
-startup.o: startup.c config.h ../config/m.h ../config/s.h compatibility.h \
- alloc.h misc.h mlvalues.h backtrace.h callback.h custom.h debugger.h \
- dynlink.h exec.h fail.h fix_code.h freelist.h gc_ctrl.h instrtrace.h \
- interp.h intext.h io.h memory.h gc.h major_gc.h minor_gc.h osdeps.h \
- 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
-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
-terminfo.o: terminfo.c config.h ../config/m.h ../config/s.h \
- compatibility.h alloc.h misc.h mlvalues.h fail.h io.h
-unix.o: unix.c config.h ../config/m.h ../config/s.h compatibility.h \
- memory.h gc.h mlvalues.h misc.h major_gc.h freelist.h minor_gc.h \
- osdeps.h
-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
-array.d.o: array.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
-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 \
- 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 fail.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 \
- freelist.h minor_gc.h interp.h instruct.h fix_code.h stacks.h
-compact.d.o: compact.c config.h ../config/m.h ../config/s.h compatibility.h \
- finalise.h roots.h misc.h memory.h gc.h mlvalues.h major_gc.h \
- freelist.h minor_gc.h gc_ctrl.h weak.h
-compare.d.o: compare.c custom.h compatibility.h mlvalues.h config.h \
- ../config/m.h ../config/s.h misc.h fail.h memory.h gc.h major_gc.h \
- freelist.h minor_gc.h
-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 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 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 \
- freelist.h minor_gc.h printexc.h signals.h stacks.h
-finalise.d.o: finalise.c callback.h compatibility.h mlvalues.h config.h \
- ../config/m.h ../config/s.h misc.h fail.h roots.h memory.h gc.h \
- 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 \
- 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
-freelist.d.o: freelist.c config.h ../config/m.h ../config/s.h \
- compatibility.h freelist.h misc.h mlvalues.h gc.h gc_ctrl.h memory.h \
- major_gc.h minor_gc.h
-gc_ctrl.d.o: gc_ctrl.c alloc.h compatibility.h misc.h config.h \
- ../config/m.h ../config/s.h mlvalues.h compact.h custom.h finalise.h \
- roots.h memory.h gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h \
- stacks.h
-globroots.d.o: globroots.c memory.h compatibility.h config.h ../config/m.h \
- ../config/s.h gc.h mlvalues.h misc.h major_gc.h freelist.h minor_gc.h \
- 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 hash.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 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 memory.h gc.h \
- major_gc.h freelist.h minor_gc.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
-lexing.d.o: lexing.c fail.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h \
- minor_gc.h
-main.d.o: main.c misc.h compatibility.h config.h ../config/m.h \
- ../config/s.h mlvalues.h sys.h
-major_gc.d.o: major_gc.c compact.h config.h ../config/m.h ../config/s.h \
- compatibility.h misc.h custom.h mlvalues.h fail.h finalise.h roots.h \
- memory.h gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h weak.h
-md5.d.o: md5.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h md5.h io.h memory.h gc.h major_gc.h \
- freelist.h minor_gc.h reverse.h
-memory.d.o: memory.c fail.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h freelist.h gc.h gc_ctrl.h major_gc.h memory.h \
- minor_gc.h signals.h
-meta.d.o: meta.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h fix_code.h interp.h intext.h io.h \
- major_gc.h freelist.h memory.h gc.h minor_gc.h prims.h stacks.h
-minor_gc.d.o: minor_gc.c config.h ../config/m.h ../config/s.h \
- compatibility.h fail.h misc.h mlvalues.h finalise.h roots.h memory.h \
- gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h signals.h weak.h
-misc.d.o: misc.c config.h ../config/m.h ../config/s.h compatibility.h \
- misc.h memory.h gc.h mlvalues.h major_gc.h freelist.h minor_gc.h
-obj.d.o: obj.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h gc.h interp.h major_gc.h freelist.h \
- memory.h minor_gc.h prims.h
-parsing.d.o: parsing.c config.h ../config/m.h ../config/s.h compatibility.h \
- mlvalues.h misc.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
- alloc.h
-prims.d.o: prims.c mlvalues.h compatibility.h config.h ../config/m.h \
- ../config/s.h misc.h prims.h
-printexc.d.o: printexc.c backtrace.h mlvalues.h compatibility.h config.h \
- ../config/m.h ../config/s.h misc.h callback.h debugger.h fail.h \
- printexc.h
-roots.d.o: roots.c finalise.h roots.h misc.h compatibility.h config.h \
- ../config/m.h ../config/s.h memory.h gc.h mlvalues.h major_gc.h \
- freelist.h minor_gc.h globroots.h stacks.h
-signals.d.o: signals.c alloc.h compatibility.h misc.h config.h \
- ../config/m.h ../config/s.h mlvalues.h callback.h fail.h memory.h gc.h \
- major_gc.h freelist.h minor_gc.h roots.h signals.h signals_machdep.h \
- sys.h
-signals_byt.d.o: signals_byt.c config.h ../config/m.h ../config/s.h \
- compatibility.h memory.h gc.h mlvalues.h misc.h major_gc.h freelist.h \
- minor_gc.h osdeps.h signals.h signals_machdep.h
-stacks.d.o: stacks.c config.h ../config/m.h ../config/s.h compatibility.h \
- fail.h misc.h mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h \
- minor_gc.h
-startup.d.o: startup.c config.h ../config/m.h ../config/s.h compatibility.h \
- alloc.h misc.h mlvalues.h backtrace.h callback.h custom.h debugger.h \
- dynlink.h exec.h fail.h fix_code.h freelist.h gc_ctrl.h instrtrace.h \
- interp.h intext.h io.h memory.h gc.h major_gc.h minor_gc.h osdeps.h \
- 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
-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
-terminfo.d.o: terminfo.c config.h ../config/m.h ../config/s.h \
- compatibility.h alloc.h misc.h mlvalues.h fail.h io.h
-unix.d.o: unix.c config.h ../config/m.h ../config/s.h compatibility.h \
- memory.h gc.h mlvalues.h misc.h major_gc.h freelist.h minor_gc.h \
- osdeps.h
-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
-array.pic.o: array.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
-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 \
- 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 fail.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 \
- freelist.h minor_gc.h interp.h instruct.h fix_code.h stacks.h
-compact.pic.o: compact.c config.h ../config/m.h ../config/s.h compatibility.h \
- finalise.h roots.h misc.h memory.h gc.h mlvalues.h major_gc.h \
- freelist.h minor_gc.h gc_ctrl.h weak.h
-compare.pic.o: compare.c custom.h compatibility.h mlvalues.h config.h \
- ../config/m.h ../config/s.h misc.h fail.h memory.h gc.h major_gc.h \
- freelist.h minor_gc.h
-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 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 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 \
- freelist.h minor_gc.h printexc.h signals.h stacks.h
-finalise.pic.o: finalise.c callback.h compatibility.h mlvalues.h config.h \
- ../config/m.h ../config/s.h misc.h fail.h roots.h memory.h gc.h \
- 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 \
- 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
-freelist.pic.o: freelist.c config.h ../config/m.h ../config/s.h \
- compatibility.h freelist.h misc.h mlvalues.h gc.h gc_ctrl.h memory.h \
- major_gc.h minor_gc.h
-gc_ctrl.pic.o: gc_ctrl.c alloc.h compatibility.h misc.h config.h \
- ../config/m.h ../config/s.h mlvalues.h compact.h custom.h finalise.h \
- roots.h memory.h gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h \
- stacks.h
-globroots.pic.o: globroots.c memory.h compatibility.h config.h ../config/m.h \
- ../config/s.h gc.h mlvalues.h misc.h major_gc.h freelist.h minor_gc.h \
- 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 hash.h
+intern.o: intern.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/callback.h caml/custom.h caml/fail.h caml/gc.h \
+ caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/mlvalues.h caml/misc.h caml/reverse.h
+interp.o: interp.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/backtrace.h caml/callback.h caml/debugger.h \
+ caml/fail.h caml/fix_code.h caml/instrtrace.h caml/instruct.h \
+ caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/misc.h \
+ caml/mlvalues.h caml/prims.h caml/signals.h caml/stacks.h caml/memory.h \
+ caml/jumptbl.h
+ints.o: ints.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/misc.h caml/mlvalues.h
+io.o: io.c caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/compatibility.h caml/alloc.h caml/misc.h caml/config.h \
+ caml/mlvalues.h caml/custom.h caml/fail.h caml/io.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/misc.h caml/mlvalues.h caml/signals.h \
+ caml/sys.h
+lexing.o: lexing.c caml/fail.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h
+main.o: main.c caml/misc.h caml/compatibility.h caml/config.h \
+ caml/../../config/m.h caml/../../config/s.h caml/mlvalues.h caml/misc.h \
+ caml/sys.h
+major_gc.o: major_gc.c caml/compact.h caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/misc.h caml/custom.h \
+ caml/mlvalues.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h caml/weak.h
+md5.o: md5.c caml/alloc.h caml/compatibility.h caml/misc.h caml/config.h \
+ caml/../../config/m.h caml/../../config/s.h caml/mlvalues.h caml/fail.h \
+ caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/mlvalues.h \
+ caml/io.h caml/reverse.h
+memory.o: memory.c caml/address_class.h caml/misc.h caml/compatibility.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/minor_gc.h caml/misc.h \
+ caml/mlvalues.h caml/signals.h
+meta.o: meta.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/config.h caml/fail.h caml/fix_code.h caml/interp.h \
+ caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/stacks.h \
+ caml/memory.h
+minor_gc.o: minor_gc.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/fail.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \
+ caml/memory.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/signals.h caml/weak.h
+misc.o: misc.c caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/compatibility.h caml/misc.h caml/config.h caml/memory.h caml/gc.h \
+ caml/mlvalues.h caml/misc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h
+obj.o: obj.c caml/alloc.h caml/compatibility.h caml/misc.h caml/config.h \
+ caml/../../config/m.h caml/../../config/s.h caml/mlvalues.h caml/fail.h \
+ caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h
+parsing.o: parsing.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/mlvalues.h caml/config.h \
+ caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/alloc.h
+prims.o: prims.c caml/mlvalues.h caml/compatibility.h caml/config.h \
+ caml/../../config/m.h caml/../../config/s.h caml/misc.h caml/prims.h
+printexc.o: printexc.c caml/backtrace.h caml/mlvalues.h \
+ caml/compatibility.h caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/misc.h caml/callback.h caml/debugger.h \
+ caml/fail.h caml/misc.h caml/mlvalues.h caml/printexc.h
+roots.o: roots.c caml/finalise.h caml/roots.h caml/misc.h \
+ caml/compatibility.h caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/globroots.h caml/major_gc.h caml/memory.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h
+signals_byt.o: signals_byt.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/memory.h caml/config.h \
+ caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/osdeps.h caml/signals.h \
+ caml/signals_machdep.h
+signals.o: signals.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/callback.h caml/config.h caml/fail.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/memory.h caml/signals.h caml/signals_machdep.h caml/sys.h
+stacks.o: stacks.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/fail.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/misc.h caml/mlvalues.h caml/stacks.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h
+startup.o: startup.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/alloc.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/backtrace.h caml/callback.h \
+ caml/custom.h caml/debugger.h caml/dynlink.h caml/exec.h caml/fail.h \
+ caml/fix_code.h caml/freelist.h caml/gc_ctrl.h caml/instrtrace.h \
+ caml/interp.h caml/intext.h caml/io.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/prims.h \
+ caml/printexc.h caml/reverse.h caml/signals.h caml/stacks.h \
+ caml/memory.h caml/sys.h caml/startup.h caml/exec.h caml/version.h
+str.o: str.c caml/alloc.h caml/compatibility.h caml/misc.h caml/config.h \
+ caml/../../config/m.h caml/../../config/s.h caml/mlvalues.h caml/fail.h \
+ caml/mlvalues.h caml/misc.h
+sys.o: sys.c caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/compatibility.h caml/alloc.h caml/misc.h caml/config.h \
+ caml/mlvalues.h caml/debugger.h caml/fail.h caml/instruct.h \
+ caml/mlvalues.h caml/osdeps.h caml/signals.h caml/stacks.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/sys.h
+terminfo.o: terminfo.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/alloc.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/fail.h caml/io.h caml/mlvalues.h
+unix.o: unix.c caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/compatibility.h caml/memory.h caml/config.h caml/gc.h \
+ caml/mlvalues.h caml/misc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/misc.h caml/osdeps.h
+weak.o: weak.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/fail.h caml/major_gc.h caml/freelist.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
+ caml/address_class.h caml/mlvalues.h
+win32.o: win32.c caml/address_class.h caml/misc.h caml/compatibility.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
+ caml/osdeps.h caml/signals.h caml/sys.h
+alloc.d.o: alloc.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/custom.h caml/major_gc.h caml/freelist.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
+ caml/address_class.h caml/mlvalues.h caml/stacks.h caml/memory.h
+array.d.o: array.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
+ caml/mlvalues.h
+backtrace.d.o: backtrace.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/mlvalues.h caml/config.h \
+ caml/misc.h caml/alloc.h caml/mlvalues.h caml/io.h caml/instruct.h \
+ caml/intext.h caml/io.h caml/exec.h caml/fix_code.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/startup.h caml/exec.h caml/stacks.h \
+ caml/memory.h caml/sys.h caml/backtrace.h caml/fail.h
+callback.d.o: callback.c caml/callback.h caml/compatibility.h \
+ caml/mlvalues.h caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/mlvalues.h caml/interp.h caml/instruct.h caml/fix_code.h \
+ caml/stacks.h caml/memory.h
+compact.d.o: compact.c caml/address_class.h caml/misc.h \
+ caml/compatibility.h caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/mlvalues.h caml/config.h caml/finalise.h \
+ caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/freelist.h caml/gc.h \
+ caml/gc_ctrl.h caml/major_gc.h caml/memory.h caml/mlvalues.h \
+ caml/roots.h caml/weak.h
+compare.d.o: compare.c caml/custom.h caml/compatibility.h caml/mlvalues.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h caml/misc.h \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/misc.h caml/mlvalues.h
+custom.d.o: custom.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/custom.h caml/fail.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/mlvalues.h
+debugger.d.o: debugger.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/config.h caml/debugger.h caml/misc.h caml/fail.h \
+ caml/fix_code.h caml/instruct.h caml/intext.h caml/io.h caml/io.h \
+ caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/sys.h
+dynlink.d.o: dynlink.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/alloc.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/dynlink.h caml/fail.h caml/mlvalues.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/misc.h caml/osdeps.h caml/prims.h \
+ caml/signals.h
+extern.d.o: extern.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
+ caml/mlvalues.h caml/reverse.h
+fail.d.o: fail.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/misc.h caml/mlvalues.h caml/printexc.h caml/signals.h caml/stacks.h \
+ caml/memory.h
+finalise.d.o: finalise.c caml/callback.h caml/compatibility.h \
+ caml/mlvalues.h caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/misc.h caml/fail.h caml/mlvalues.h \
+ caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/signals.h
+fix_code.d.o: fix_code.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/debugger.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/fix_code.h caml/instruct.h \
+ caml/intext.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
+floats.d.o: floats.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
+freelist.d.o: freelist.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/freelist.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/gc.h caml/gc_ctrl.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/major_gc.h caml/misc.h caml/mlvalues.h
+gc_ctrl.d.o: gc_ctrl.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/compact.h caml/custom.h caml/finalise.h \
+ caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/freelist.h caml/gc.h \
+ caml/gc_ctrl.h caml/major_gc.h caml/minor_gc.h caml/misc.h \
+ caml/mlvalues.h caml/stacks.h
+globroots.d.o: globroots.c caml/memory.h caml/compatibility.h caml/config.h \
+ caml/../../config/m.h caml/../../config/s.h caml/gc.h caml/mlvalues.h \
+ caml/misc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/memory.h caml/globroots.h caml/roots.h
+hash.d.o: hash.c caml/mlvalues.h caml/compatibility.h caml/config.h \
+ caml/../../config/m.h caml/../../config/s.h caml/misc.h caml/custom.h \
+ caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/hash.h
+instrtrace.d.o: instrtrace.c caml/instruct.h caml/misc.h \
+ caml/compatibility.h caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/mlvalues.h caml/misc.h caml/opnames.h \
+ caml/prims.h caml/stacks.h caml/mlvalues.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h
+intern.d.o: intern.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/callback.h caml/custom.h caml/fail.h caml/gc.h \
+ caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/mlvalues.h caml/misc.h caml/reverse.h
+interp.d.o: interp.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/backtrace.h caml/callback.h caml/debugger.h \
+ caml/fail.h caml/fix_code.h caml/instrtrace.h caml/instruct.h \
+ caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/misc.h \
+ caml/mlvalues.h caml/prims.h caml/signals.h caml/stacks.h caml/memory.h
+ints.d.o: ints.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/misc.h caml/mlvalues.h
+io.d.o: io.c caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/compatibility.h caml/alloc.h caml/misc.h caml/config.h \
+ caml/mlvalues.h caml/custom.h caml/fail.h caml/io.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/misc.h caml/mlvalues.h caml/signals.h \
+ caml/sys.h
+lexing.d.o: lexing.c caml/fail.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h
+main.d.o: main.c caml/misc.h caml/compatibility.h caml/config.h \
+ caml/../../config/m.h caml/../../config/s.h caml/mlvalues.h caml/misc.h \
+ caml/sys.h
+major_gc.d.o: major_gc.c caml/compact.h caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/misc.h caml/custom.h \
+ caml/mlvalues.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h caml/weak.h
+md5.d.o: md5.c caml/alloc.h caml/compatibility.h caml/misc.h caml/config.h \
+ caml/../../config/m.h caml/../../config/s.h caml/mlvalues.h caml/fail.h \
+ caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/mlvalues.h \
+ caml/io.h caml/reverse.h
+memory.d.o: memory.c caml/address_class.h caml/misc.h caml/compatibility.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/minor_gc.h caml/misc.h \
+ caml/mlvalues.h caml/signals.h
+meta.d.o: meta.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/config.h caml/fail.h caml/fix_code.h caml/interp.h \
+ caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/stacks.h \
+ caml/memory.h
+minor_gc.d.o: minor_gc.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/fail.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \
+ caml/memory.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/signals.h caml/weak.h
+misc.d.o: misc.c caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/compatibility.h caml/misc.h caml/config.h caml/memory.h caml/gc.h \
+ caml/mlvalues.h caml/misc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h
+obj.d.o: obj.c caml/alloc.h caml/compatibility.h caml/misc.h caml/config.h \
+ caml/../../config/m.h caml/../../config/s.h caml/mlvalues.h caml/fail.h \
+ caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h
+parsing.d.o: parsing.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/mlvalues.h caml/config.h \
+ caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/alloc.h
+prims.d.o: prims.c caml/mlvalues.h caml/compatibility.h caml/config.h \
+ caml/../../config/m.h caml/../../config/s.h caml/misc.h caml/prims.h
+printexc.d.o: printexc.c caml/backtrace.h caml/mlvalues.h \
+ caml/compatibility.h caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/misc.h caml/callback.h caml/debugger.h \
+ caml/fail.h caml/misc.h caml/mlvalues.h caml/printexc.h
+roots.d.o: roots.c caml/finalise.h caml/roots.h caml/misc.h \
+ caml/compatibility.h caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/globroots.h caml/major_gc.h caml/memory.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h
+signals_byt.d.o: signals_byt.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/memory.h caml/config.h \
+ caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/osdeps.h caml/signals.h \
+ caml/signals_machdep.h
+signals.d.o: signals.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/callback.h caml/config.h caml/fail.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/memory.h caml/signals.h caml/signals_machdep.h caml/sys.h
+stacks.d.o: stacks.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/fail.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/misc.h caml/mlvalues.h caml/stacks.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h
+startup.d.o: startup.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/alloc.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/backtrace.h caml/callback.h \
+ caml/custom.h caml/debugger.h caml/dynlink.h caml/exec.h caml/fail.h \
+ caml/fix_code.h caml/freelist.h caml/gc_ctrl.h caml/instrtrace.h \
+ caml/interp.h caml/intext.h caml/io.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/prims.h \
+ caml/printexc.h caml/reverse.h caml/signals.h caml/stacks.h \
+ caml/memory.h caml/sys.h caml/startup.h caml/exec.h caml/version.h
+str.d.o: str.c caml/alloc.h caml/compatibility.h caml/misc.h caml/config.h \
+ caml/../../config/m.h caml/../../config/s.h caml/mlvalues.h caml/fail.h \
+ caml/mlvalues.h caml/misc.h
+sys.d.o: sys.c caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/compatibility.h caml/alloc.h caml/misc.h caml/config.h \
+ caml/mlvalues.h caml/debugger.h caml/fail.h caml/instruct.h \
+ caml/mlvalues.h caml/osdeps.h caml/signals.h caml/stacks.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/sys.h
+terminfo.d.o: terminfo.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/alloc.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/fail.h caml/io.h caml/mlvalues.h
+unix.d.o: unix.c caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/compatibility.h caml/memory.h caml/config.h caml/gc.h \
+ caml/mlvalues.h caml/misc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/misc.h caml/osdeps.h
+weak.d.o: weak.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/fail.h caml/major_gc.h caml/freelist.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
+ caml/address_class.h caml/mlvalues.h
+win32.d.o: win32.c caml/address_class.h caml/misc.h caml/compatibility.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
+ caml/osdeps.h caml/signals.h caml/sys.h
+alloc.pic.o: alloc.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/custom.h caml/major_gc.h caml/freelist.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
+ caml/address_class.h caml/mlvalues.h caml/stacks.h caml/memory.h
+array.pic.o: array.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
+ caml/mlvalues.h
+backtrace.pic.o: backtrace.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/mlvalues.h caml/config.h \
+ caml/misc.h caml/alloc.h caml/mlvalues.h caml/io.h caml/instruct.h \
+ caml/intext.h caml/io.h caml/exec.h caml/fix_code.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/startup.h caml/exec.h caml/stacks.h \
+ caml/memory.h caml/sys.h caml/backtrace.h caml/fail.h
+callback.pic.o: callback.c caml/callback.h caml/compatibility.h \
+ caml/mlvalues.h caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/misc.h caml/fail.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/mlvalues.h caml/interp.h caml/instruct.h caml/fix_code.h \
+ caml/stacks.h caml/memory.h
+compact.pic.o: compact.c caml/address_class.h caml/misc.h \
+ caml/compatibility.h caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/mlvalues.h caml/config.h caml/finalise.h \
+ caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/freelist.h caml/gc.h \
+ caml/gc_ctrl.h caml/major_gc.h caml/memory.h caml/mlvalues.h \
+ caml/roots.h caml/weak.h
+compare.pic.o: compare.c caml/custom.h caml/compatibility.h caml/mlvalues.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h caml/misc.h \
+ caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/misc.h caml/mlvalues.h
+custom.pic.o: custom.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/custom.h caml/fail.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/mlvalues.h
+debugger.pic.o: debugger.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/config.h caml/debugger.h caml/misc.h caml/fail.h \
+ caml/fix_code.h caml/instruct.h caml/intext.h caml/io.h caml/io.h \
+ caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/sys.h
+dynlink.pic.o: dynlink.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/alloc.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/dynlink.h caml/fail.h caml/mlvalues.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/misc.h caml/osdeps.h caml/prims.h \
+ caml/signals.h
+extern.pic.o: extern.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/custom.h caml/fail.h caml/gc.h caml/intext.h \
+ caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
+ caml/mlvalues.h caml/reverse.h
+fail.pic.o: fail.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/fail.h caml/io.h caml/gc.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/misc.h caml/mlvalues.h caml/printexc.h caml/signals.h caml/stacks.h \
+ caml/memory.h
+finalise.pic.o: finalise.c caml/callback.h caml/compatibility.h \
+ caml/mlvalues.h caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/misc.h caml/fail.h caml/mlvalues.h \
+ caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/signals.h
+fix_code.pic.o: fix_code.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/debugger.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/fix_code.h caml/instruct.h \
+ caml/intext.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/misc.h caml/mlvalues.h caml/reverse.h
+floats.pic.o: floats.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/mlvalues.h \
+ caml/misc.h caml/reverse.h caml/stacks.h caml/memory.h
+freelist.pic.o: freelist.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/freelist.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/gc.h caml/gc_ctrl.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/major_gc.h caml/misc.h caml/mlvalues.h
+gc_ctrl.pic.o: gc_ctrl.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/compact.h caml/custom.h caml/finalise.h \
+ caml/roots.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/freelist.h caml/gc.h \
+ caml/gc_ctrl.h caml/major_gc.h caml/minor_gc.h caml/misc.h \
+ caml/mlvalues.h caml/stacks.h
+globroots.pic.o: globroots.c caml/memory.h caml/compatibility.h caml/config.h \
+ caml/../../config/m.h caml/../../config/s.h caml/gc.h caml/mlvalues.h \
+ caml/misc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/memory.h caml/globroots.h caml/roots.h
+hash.pic.o: hash.c caml/mlvalues.h caml/compatibility.h caml/config.h \
+ caml/../../config/m.h caml/../../config/s.h caml/misc.h caml/custom.h \
+ caml/mlvalues.h caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/hash.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 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 memory.h gc.h \
- major_gc.h freelist.h minor_gc.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
-lexing.pic.o: lexing.c fail.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h \
- minor_gc.h
-main.pic.o: main.c misc.h compatibility.h config.h ../config/m.h \
- ../config/s.h mlvalues.h sys.h
-major_gc.pic.o: major_gc.c compact.h config.h ../config/m.h ../config/s.h \
- compatibility.h misc.h custom.h mlvalues.h fail.h finalise.h roots.h \
- memory.h gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h weak.h
-md5.pic.o: md5.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h md5.h io.h memory.h gc.h major_gc.h \
- freelist.h minor_gc.h reverse.h
-memory.pic.o: memory.c fail.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h freelist.h gc.h gc_ctrl.h major_gc.h memory.h \
- minor_gc.h signals.h
-meta.pic.o: meta.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h fix_code.h interp.h intext.h io.h \
- major_gc.h freelist.h memory.h gc.h minor_gc.h prims.h stacks.h
-minor_gc.pic.o: minor_gc.c config.h ../config/m.h ../config/s.h \
- compatibility.h fail.h misc.h mlvalues.h finalise.h roots.h memory.h \
- gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h signals.h weak.h
-misc.pic.o: misc.c config.h ../config/m.h ../config/s.h compatibility.h \
- misc.h memory.h gc.h mlvalues.h major_gc.h freelist.h minor_gc.h
-obj.pic.o: obj.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h gc.h interp.h major_gc.h freelist.h \
- memory.h minor_gc.h prims.h
-parsing.pic.o: parsing.c config.h ../config/m.h ../config/s.h compatibility.h \
- mlvalues.h misc.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
- alloc.h
-prims.pic.o: prims.c mlvalues.h compatibility.h config.h ../config/m.h \
- ../config/s.h misc.h prims.h
-printexc.pic.o: printexc.c backtrace.h mlvalues.h compatibility.h config.h \
- ../config/m.h ../config/s.h misc.h callback.h debugger.h fail.h \
- printexc.h
-roots.pic.o: roots.c finalise.h roots.h misc.h compatibility.h config.h \
- ../config/m.h ../config/s.h memory.h gc.h mlvalues.h major_gc.h \
- freelist.h minor_gc.h globroots.h stacks.h
-signals.pic.o: signals.c alloc.h compatibility.h misc.h config.h \
- ../config/m.h ../config/s.h mlvalues.h callback.h fail.h memory.h gc.h \
- major_gc.h freelist.h minor_gc.h roots.h signals.h signals_machdep.h \
- sys.h
-signals_byt.pic.o: signals_byt.c config.h ../config/m.h ../config/s.h \
- compatibility.h memory.h gc.h mlvalues.h misc.h major_gc.h freelist.h \
- minor_gc.h osdeps.h signals.h signals_machdep.h
-stacks.pic.o: stacks.c config.h ../config/m.h ../config/s.h compatibility.h \
- fail.h misc.h mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h \
- minor_gc.h
-startup.pic.o: startup.c config.h ../config/m.h ../config/s.h compatibility.h \
- alloc.h misc.h mlvalues.h backtrace.h callback.h custom.h debugger.h \
- dynlink.h exec.h fail.h fix_code.h freelist.h gc_ctrl.h instrtrace.h \
- interp.h intext.h io.h memory.h gc.h major_gc.h minor_gc.h osdeps.h \
- 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
-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
-terminfo.pic.o: terminfo.c config.h ../config/m.h ../config/s.h \
- compatibility.h alloc.h misc.h mlvalues.h fail.h io.h
-unix.pic.o: unix.c config.h ../config/m.h ../config/s.h compatibility.h \
- memory.h gc.h mlvalues.h misc.h major_gc.h freelist.h minor_gc.h \
- osdeps.h
-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
+intern.pic.o: intern.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/callback.h caml/custom.h caml/fail.h caml/gc.h \
+ caml/intext.h caml/io.h caml/io.h caml/md5.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/mlvalues.h caml/misc.h caml/reverse.h
+interp.pic.o: interp.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/backtrace.h caml/callback.h caml/debugger.h \
+ caml/fail.h caml/fix_code.h caml/instrtrace.h caml/instruct.h \
+ caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/minor_gc.h caml/address_class.h caml/misc.h \
+ caml/mlvalues.h caml/prims.h caml/signals.h caml/stacks.h caml/memory.h \
+ caml/jumptbl.h
+ints.pic.o: ints.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/custom.h caml/fail.h caml/intext.h caml/io.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/misc.h caml/mlvalues.h
+io.pic.o: io.c caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/compatibility.h caml/alloc.h caml/misc.h caml/config.h \
+ caml/mlvalues.h caml/custom.h caml/fail.h caml/io.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/misc.h caml/mlvalues.h caml/signals.h \
+ caml/sys.h
+lexing.pic.o: lexing.c caml/fail.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/mlvalues.h caml/stacks.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h
+main.pic.o: main.c caml/misc.h caml/compatibility.h caml/config.h \
+ caml/../../config/m.h caml/../../config/s.h caml/mlvalues.h caml/misc.h \
+ caml/sys.h
+major_gc.pic.o: major_gc.c caml/compact.h caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/misc.h caml/custom.h \
+ caml/mlvalues.h caml/config.h caml/fail.h caml/finalise.h caml/roots.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/misc.h caml/mlvalues.h caml/roots.h caml/weak.h
+md5.pic.o: md5.c caml/alloc.h caml/compatibility.h caml/misc.h caml/config.h \
+ caml/../../config/m.h caml/../../config/s.h caml/mlvalues.h caml/fail.h \
+ caml/md5.h caml/io.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/mlvalues.h \
+ caml/io.h caml/reverse.h
+memory.pic.o: memory.c caml/address_class.h caml/misc.h caml/compatibility.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/fail.h caml/freelist.h caml/gc.h caml/gc_ctrl.h \
+ caml/major_gc.h caml/freelist.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/minor_gc.h caml/address_class.h caml/minor_gc.h caml/misc.h \
+ caml/mlvalues.h caml/signals.h
+meta.pic.o: meta.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/config.h caml/fail.h caml/fix_code.h caml/interp.h \
+ caml/intext.h caml/io.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h caml/stacks.h \
+ caml/memory.h
+minor_gc.pic.o: minor_gc.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/fail.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/finalise.h caml/roots.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/gc.h caml/gc_ctrl.h caml/major_gc.h \
+ caml/memory.h caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/signals.h caml/weak.h
+misc.pic.o: misc.c caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/compatibility.h caml/misc.h caml/config.h caml/memory.h caml/gc.h \
+ caml/mlvalues.h caml/misc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h
+obj.pic.o: obj.c caml/alloc.h caml/compatibility.h caml/misc.h caml/config.h \
+ caml/../../config/m.h caml/../../config/s.h caml/mlvalues.h caml/fail.h \
+ caml/gc.h caml/interp.h caml/major_gc.h caml/freelist.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/minor_gc.h caml/address_class.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/prims.h
+parsing.pic.o: parsing.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/mlvalues.h caml/config.h \
+ caml/misc.h caml/memory.h caml/gc.h caml/mlvalues.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/alloc.h
+prims.pic.o: prims.c caml/mlvalues.h caml/compatibility.h caml/config.h \
+ caml/../../config/m.h caml/../../config/s.h caml/misc.h caml/prims.h
+printexc.pic.o: printexc.c caml/backtrace.h caml/mlvalues.h \
+ caml/compatibility.h caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/misc.h caml/callback.h caml/debugger.h \
+ caml/fail.h caml/misc.h caml/mlvalues.h caml/printexc.h
+roots.pic.o: roots.c caml/finalise.h caml/roots.h caml/misc.h \
+ caml/compatibility.h caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/memory.h caml/gc.h caml/mlvalues.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/globroots.h caml/major_gc.h caml/memory.h caml/minor_gc.h \
+ caml/misc.h caml/mlvalues.h caml/roots.h caml/stacks.h
+signals_byt.pic.o: signals_byt.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/memory.h caml/config.h \
+ caml/gc.h caml/mlvalues.h caml/misc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/osdeps.h caml/signals.h \
+ caml/signals_machdep.h
+signals.pic.o: signals.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/callback.h caml/config.h caml/fail.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/misc.h caml/mlvalues.h caml/roots.h \
+ caml/memory.h caml/signals.h caml/signals_machdep.h caml/sys.h
+stacks.pic.o: stacks.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/fail.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/misc.h caml/mlvalues.h caml/stacks.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h
+startup.pic.o: startup.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/alloc.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/backtrace.h caml/callback.h \
+ caml/custom.h caml/debugger.h caml/dynlink.h caml/exec.h caml/fail.h \
+ caml/fix_code.h caml/freelist.h caml/gc_ctrl.h caml/instrtrace.h \
+ caml/interp.h caml/intext.h caml/io.h caml/io.h caml/memory.h caml/gc.h \
+ caml/major_gc.h caml/freelist.h caml/minor_gc.h caml/address_class.h \
+ caml/minor_gc.h caml/misc.h caml/mlvalues.h caml/osdeps.h caml/prims.h \
+ caml/printexc.h caml/reverse.h caml/signals.h caml/stacks.h \
+ caml/memory.h caml/sys.h caml/startup.h caml/exec.h caml/version.h
+str.pic.o: str.c caml/alloc.h caml/compatibility.h caml/misc.h caml/config.h \
+ caml/../../config/m.h caml/../../config/s.h caml/mlvalues.h caml/fail.h \
+ caml/mlvalues.h caml/misc.h
+sys.pic.o: sys.c caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/compatibility.h caml/alloc.h caml/misc.h caml/config.h \
+ caml/mlvalues.h caml/debugger.h caml/fail.h caml/instruct.h \
+ caml/mlvalues.h caml/osdeps.h caml/signals.h caml/stacks.h caml/memory.h \
+ caml/gc.h caml/major_gc.h caml/freelist.h caml/minor_gc.h \
+ caml/address_class.h caml/sys.h
+terminfo.pic.o: terminfo.c caml/config.h caml/../../config/m.h \
+ caml/../../config/s.h caml/compatibility.h caml/alloc.h caml/misc.h \
+ caml/config.h caml/mlvalues.h caml/fail.h caml/io.h caml/mlvalues.h
+unix.pic.o: unix.c caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/compatibility.h caml/memory.h caml/config.h caml/gc.h \
+ caml/mlvalues.h caml/misc.h caml/major_gc.h caml/freelist.h \
+ caml/minor_gc.h caml/address_class.h caml/misc.h caml/osdeps.h
+weak.pic.o: weak.c caml/alloc.h caml/compatibility.h caml/misc.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/fail.h caml/major_gc.h caml/freelist.h \
+ caml/memory.h caml/gc.h caml/major_gc.h caml/minor_gc.h \
+ caml/address_class.h caml/mlvalues.h
+win32.pic.o: win32.c caml/address_class.h caml/misc.h caml/compatibility.h \
+ caml/config.h caml/../../config/m.h caml/../../config/s.h \
+ caml/mlvalues.h caml/fail.h caml/memory.h caml/gc.h caml/major_gc.h \
+ caml/freelist.h caml/minor_gc.h caml/address_class.h caml/misc.h \
+ caml/osdeps.h caml/signals.h caml/sys.h
-jumptbl.h
+caml/jumptbl.h
primitives
prims.c
-opnames.h
-version.h
+caml/opnames.h
+caml/version.h
ocamlrun
ocamlrun.exe
ocamlrund
include Makefile.common
-CFLAGS=-DCAML_NAME_SPACE -O $(BYTECCCOMPOPTS) $(IFLEXDIR)
+CFLAGS=-DCAML_NAME_SPACE $(BYTECCCOMPOPTS) $(IFLEXDIR)
DFLAGS=-DCAML_NAME_SPACE -g -DDEBUG $(BYTECCCOMPOPTS) $(IFLEXDIR)
OBJS=$(COMMONOBJS) $(UNIX_OR_WIN32).o main.o
DOBJS=$(OBJS:.o=.d.o) instrtrace.d.o
PICOBJS=$(OBJS:.o=.pic.o)
-SHARED_LIBS_TMP=$(SUPPORTS_SHARED_LIBRARIES:%false=)
-SHARED_LIBS_DEPS=$(SHARED_LIBS_TMP:%true=libcamlrun_shared.so)
-
-all:: $(SHARED_LIBS_DEPS)
+all:: all-$(SHARED)
ocamlrun$(EXE): libcamlrun.a prims.o
$(MKEXE) $(BYTECCLINKOPTS) -o ocamlrun$(EXE) \
prims.o libcamlrund.a $(BYTECCLIBS)
libcamlrun.a: $(OBJS)
- ar rc libcamlrun.a $(OBJS)
+ $(ARCMD) rc libcamlrun.a $(OBJS)
$(RANLIB) libcamlrun.a
libcamlrund.a: $(DOBJS)
- ar rc libcamlrund.a $(DOBJS)
+ $(ARCMD) rc libcamlrund.a $(DOBJS)
$(RANLIB) libcamlrund.a
+all-noshared:
+.PHONY: all-noshared
+
+all-shared: libcamlrun_pic.a libcamlrun_shared.so
+.PHONY: all-shared
+
+libcamlrun_pic.a: $(PICOBJS)
+ ar rc libcamlrun_pic.a $(PICOBJS)
+ $(RANLIB) libcamlrun_pic.a
+
libcamlrun_shared.so: $(PICOBJS)
$(MKDLL) -o libcamlrun_shared.so $(PICOBJS) $(BYTECCLIBS)
-install::
- if test -f libcamlrun_shared.so; then \
- cp libcamlrun_shared.so $(INSTALL_LIBDIR)/libcamlrun_shared.so; fi
+install:: install-$(SHARED)
-clean::
- rm -f libcamlrun_shared.so
+install-noshared:
+.PHONY: install-noshared
-.SUFFIXES: .d.o .pic.o
+install-shared:
+ cp libcamlrun_shared.so $(INSTALL_LIBDIR)/libcamlrun_shared.so
+ cp libcamlrun_pic.a $(INSTALL_LIBDIR)/libcamlrun_pic.a
+ cd $(INSTALL_LIBDIR); $(RANLIB) libcamlrun_pic.a
+.PHONY: install-shared
-.c.d.o:
- ln -s -f $*.c $*.d.c
- $(CC) -c $(DFLAGS) $*.d.c
- rm $*.d.c
+clean::
+ rm -f libcamlrun_shared.so libcamlrun_pic.a
-.c.pic.o:
- ln -s -f $*.c $*.pic.c
- $(CC) -c $(CFLAGS) $(SHAREDCCCOMPOPTS) $*.pic.c
- rm $*.pic.c
+%.d.o: %.c
+ $(CC) -c $(DFLAGS) $< -o $@
-clean::
- rm -f *.pic.c *.d.c
+%.pic.o: %.c
+ $(CC) -c $(CFLAGS) $(SHAREDCCCOMPOPTS) $< -o $@
-depend : prims.c opnames.h jumptbl.h version.h
- -gcc -MM $(BYTECCCOMPOPTS) *.c > .depend
- -gcc -MM $(BYTECCCOMPOPTS) -DDEBUG *.c | sed -e 's/\.o/.d.o/' >> .depend
- -gcc -MM $(BYTECCCOMPOPTS) *.c | sed -e 's/\.o/.pic.o/' >> .depend
+depend : prims.c caml/opnames.h caml/jumptbl.h caml/version.h
+ -$(CC) -MM $(BYTECCCOMPOPTS) *.c > .depend
+ -$(CC) -MM $(BYTECCCOMPOPTS) -DDEBUG *.c | sed -e 's/\.o/.d.o/' >> .depend
+ -$(CC) -MM $(BYTECCCOMPOPTS) *.c | sed -e 's/\.o/.pic.o/' >> .depend
.PHONY: depend
include .depend
#########################################################################
include ../config/Makefile
+CAMLRUN ?= ../boot/ocamlrun
+CAMLYACC ?= ../boot/ocamlyacc
CC=$(BYTECC)
dynlink.c backtrace.c
PUBLIC_INCLUDES=\
- alloc.h callback.h config.h custom.h fail.h hash.h intext.h \
+ address_class.h alloc.h callback.h config.h custom.h fail.h gc.h \
+ hash.h intext.h \
memory.h misc.h mlvalues.h printexc.h signals.h compatibility.h \
version.h
install::
- cp ocamlrun$(EXE) $(INSTALL_BINDIR)/ocamlrun$(EXE)
+ cp $(CAMLRUN)$(EXE) $(INSTALL_BINDIR)/ocamlrun$(EXE)
cp libcamlrun.$(A) $(INSTALL_LIBDIR)/libcamlrun.$(A)
cd $(INSTALL_LIBDIR); $(RANLIB) libcamlrun.$(A)
if test -d $(INSTALL_LIBDIR)/caml; then : ; \
else mkdir $(INSTALL_LIBDIR)/caml; fi
for i in $(PUBLIC_INCLUDES); do \
- sed -f ../tools/cleanup-header $$i > $(INSTALL_LIBDIR)/caml/$$i; \
+ sed -f ../tools/cleanup-header caml/$$i > $(INSTALL_LIBDIR)/caml/$$i; \
done
cp ld.conf $(INSTALL_LIBDIR)/ld.conf
.PHONY: install
install-noruntimed:
.PHONY: install-noruntimed
+# TODO: when cross-compiling, do not install ocamlrund
+# it doesn't hurt to install it, but it's useless and might be confusing
+# because it's an executable for the target machine, while we're installing
+# binaries for the host.
install-runtimed:
cp ocamlrund$(EXE) $(INSTALL_BINDIR)/ocamlrund$(EXE)
cp libcamlrund.$(A) $(INSTALL_LIBDIR)/libcamlrund.$(A)
| sort | uniq > primitives
prims.c : primitives
- (echo '#include "mlvalues.h"'; \
- echo '#include "prims.h"'; \
+ (echo '#include "caml/mlvalues.h"'; \
+ echo '#include "caml/prims.h"'; \
sed -e 's/.*/extern value &();/' primitives; \
echo 'c_primitive caml_builtin_cprim[] = {'; \
sed -e 's/.*/ &,/' primitives; \
sed -e 's/.*/ "&",/' primitives; \
echo ' 0 };') > prims.c
-opnames.h : instruct.h
+caml/opnames.h : caml/instruct.h
sed -e '/\/\*/d' \
-e '/^#/d' \
-e 's/enum /char * names_of_/' \
-e 's/{$$/[] = {/' \
- -e 's/\([[:upper:]][[:upper:]_0-9]*\)/"\1"/g' instruct.h > opnames.h
+ -e 's/\([[:upper:]][[:upper:]_0-9]*\)/"\1"/g' caml/instruct.h > caml/opnames.h
-# jumptbl.h is required only if you have GCC 2.0 or later
-jumptbl.h : instruct.h
+# caml/jumptbl.h is required only if you have GCC 2.0 or later
+caml/jumptbl.h : caml/instruct.h
sed -n -e '/^ /s/ \([A-Z]\)/ \&\&lbl_\1/gp' \
- -e '/^}/q' instruct.h > jumptbl.h
+ -e '/^}/q' caml/instruct.h > caml/jumptbl.h
-version.h : ../VERSION ../tools/make-version-header.sh
- ../tools/make-version-header.sh ../VERSION > version.h
+caml/version.h : ../VERSION ../tools/make-version-header.sh
+ ../tools/make-version-header.sh ../VERSION > caml/version.h
clean ::
rm -f ocamlrun$(EXE) ocamlrund$(EXE) *.$(O) *.$(A) *.$(SO)
- rm -f primitives prims.c opnames.h jumptbl.h ld.conf
- rm -f version.h
+ rm -f primitives prims.c caml/opnames.h caml/jumptbl.h ld.conf
+ rm -f caml/version.h
.PHONY: clean
$(EXTRALIBS) libcamlrun.$(A)
ocamlrund$(EXE): libcamlrund.$(A) prims.$(O) main.$(O)
- $(MKEXE) -o ocamlrun$(EXE) $(BYTECCDBGCOMPOPTS) prims.$(O) \
+ $(MKEXE) -o ocamlrund$(EXE) $(BYTECCDBGCOMPOPTS) prims.$(O) \
$(call SYSLIB,ws2_32) $(EXTRALIBS) libcamlrund.$(A)
libcamlrun.$(A): $(OBJS)
libcamlrund.$(A): $(DOBJS)
$(call MKLIB,libcamlrund.$(A),$(DOBJS))
-.SUFFIXES: .$(O) .$(DBGO)
-
-.c.$(O):
+%.$(O): %.c
$(CC) $(CFLAGS) $(BYTECCCOMPOPTS) -c $<
-.c.$(DBGO):
- $(CC) $(CFLAGS) $(BYTECCDBGCOMPOPTS) -c $<
- mv $*.$(O) $*.$(DBGO)
+%.$(DBGO): %.c
+ $(CC) $(CFLAGS) $(BYTECCDBGCOMPOPTS) -c -o $@ $<
.depend.nt: .depend
rm -f .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
+ echo "win32.o: win32.c \\" >> .depend.win32
+ echo " caml/fail.h caml/compatibility.h caml/misc.h \\" >> .depend.win32
+ echo " caml/config.h ../config/m.h ../config/s.h \\" >> .depend.win32
+ echo " caml/mlvalues.h caml/memory.h caml/gc.h \\" >> .depend.win32
+ echo " caml/major_gc.h caml/freelist.h caml/minor_gc.h \\" >> .depend.win32
+ echo " caml/osdeps.h caml/signals.h" >> .depend.win32
cat .depend >> .depend.win32
sed -e '/\.d\.o/q' -e 's/^\(.*\)\.o:/\1.$$(O) \1.$$(DBGO):/' \
.depend.win32 > .depend.nt
*/
#include <string.h>
-#include "alloc.h"
-#include "custom.h"
-#include "major_gc.h"
-#include "memory.h"
-#include "mlvalues.h"
-#include "stacks.h"
+#include "caml/alloc.h"
+#include "caml/custom.h"
+#include "caml/major_gc.h"
+#include "caml/memory.h"
+#include "caml/mlvalues.h"
+#include "caml/stacks.h"
#define Setup_for_gc
#define Restore_after_gc
}
return Val_unit;
}
+
+
+
+
+++ /dev/null
-/***********************************************************************/
-/* */
-/* OCaml */
-/* */
-/* Xavier Leroy and Damien Doligez, 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. */
-/* */
-/***********************************************************************/
-
-#ifndef CAML_ALLOC_H
-#define CAML_ALLOC_H
-
-
-#ifndef CAML_NAME_SPACE
-#include "compatibility.h"
-#endif
-#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);
-CAMLextern value caml_alloc_string (mlsize_t); /* size in bytes */
-CAMLextern value caml_copy_string (char const *);
-CAMLextern value caml_copy_string_array (char const **);
-CAMLextern value caml_copy_double (double);
-CAMLextern value caml_copy_int32 (int32); /* defined in [ints.c] */
-CAMLextern value caml_copy_int64 (int64); /* defined in [ints.c] */
-CAMLextern value caml_copy_nativeint (intnat); /* defined in [ints.c] */
-CAMLextern value caml_alloc_array (value (*funct) (char const *),
- char const ** array);
-CAMLextern value caml_alloc_sprintf(const char * format, ...);
-
-typedef void (*final_fun)(value);
-CAMLextern value caml_alloc_final (mlsize_t, /*size in words*/
- final_fun, /*finalization function*/
- mlsize_t, /*resources consumed*/
- mlsize_t /*max resources*/);
-
-CAMLextern int caml_convert_flag_list (value, int *);
-
-#ifdef __cplusplus
-}
-#endif
-
-#endif /* CAML_ALLOC_H */
/* Operations on arrays */
#include <string.h>
-#include "alloc.h"
-#include "fail.h"
-#include "memory.h"
-#include "misc.h"
-#include "mlvalues.h"
+#include "caml/alloc.h"
+#include "caml/fail.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
CAMLexport mlsize_t caml_array_length(value array)
{
#include <stdlib.h>
#include <string.h>
-#include "config.h"
+#include "caml/config.h"
#ifdef HAS_UNISTD
#include <unistd.h>
#endif
-#include "mlvalues.h"
-#include "alloc.h"
-#include "io.h"
-#include "instruct.h"
-#include "intext.h"
-#include "exec.h"
-#include "fix_code.h"
-#include "memory.h"
-#include "startup.h"
-#include "stacks.h"
-#include "sys.h"
-#include "backtrace.h"
-#include "fail.h"
+#include "caml/mlvalues.h"
+#include "caml/alloc.h"
+#include "caml/io.h"
+#include "caml/instruct.h"
+#include "caml/intext.h"
+#include "caml/exec.h"
+#include "caml/fix_code.h"
+#include "caml/memory.h"
+#include "caml/startup.h"
+#include "caml/stacks.h"
+#include "caml/sys.h"
+#include "caml/backtrace.h"
+#include "caml/fail.h"
CAMLexport int caml_backtrace_active = 0;
CAMLexport int caml_backtrace_pos = 0;
#define Codet_Val(v) ((code_t)(Long_val(v)<<1))
/* returns the next frame pointer (or NULL if none is available);
- updates *sp to point to the following one, and *trapsp to the next
+ updates *sp to point to the following one, and *trsp 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 caml_next_frame_pointer(value ** sp, value ** trsp)
{
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);
+ if(&Trap_pc(*trsp) == p) {
+ *trsp = Trap_link(*trsp);
continue;
}
if (*p >= caml_start_code && *p < end_code) return *p;
/* first compute the size of the trace */
{
value * sp = caml_extern_sp;
- value * trapsp = caml_trapsp;
+ value * trsp = caml_trapsp;
for (trace_size = 0; trace_size < max_frames; trace_size++) {
- code_t p = caml_next_frame_pointer(&sp, &trapsp);
+ code_t p = caml_next_frame_pointer(&sp, &trsp);
if (p == NULL) break;
}
}
/* then collect the trace */
{
value * sp = caml_extern_sp;
- value * trapsp = caml_trapsp;
+ value * trsp = caml_trapsp;
uintnat trace_pos;
for (trace_pos = 0; trace_pos < trace_size; trace_pos++) {
- code_t p = caml_next_frame_pointer(&sp, &trapsp);
+ code_t p = caml_next_frame_pointer(&sp, &trsp);
Assert(p != NULL);
Field(trace, trace_pos) = Val_Codet(p);
}
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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. */
-/* */
-/***********************************************************************/
-
-#ifndef CAML_BACKTRACE_H
-#define CAML_BACKTRACE_H
-
-#include "mlvalues.h"
-
-CAMLextern int caml_backtrace_active;
-CAMLextern int caml_backtrace_pos;
-CAMLextern code_t * caml_backtrace_buffer;
-CAMLextern value caml_backtrace_last_exn;
-CAMLextern char * caml_cds_file;
-
-CAMLprim value caml_record_backtrace(value vflag);
-#ifndef NATIVE_CODE
-extern void caml_stash_backtrace(value exn, code_t pc, value * sp, int reraise);
-#endif
-CAMLextern void caml_print_exception_backtrace(void);
-
-#endif /* CAML_BACKTRACE_H */
/* Callbacks from C to OCaml */
#include <string.h>
-#include "callback.h"
-#include "fail.h"
-#include "memory.h"
-#include "mlvalues.h"
+#include "caml/callback.h"
+#include "caml/fail.h"
+#include "caml/memory.h"
+#include "caml/mlvalues.h"
#ifndef NATIVE_CODE
/* Bytecode callbacks */
-#include "interp.h"
-#include "instruct.h"
-#include "fix_code.h"
-#include "stacks.h"
+#include "caml/interp.h"
+#include "caml/instruct.h"
+#include "caml/fix_code.h"
+#include "caml/stacks.h"
CAMLexport int caml_callback_depth = 0;
}
return NULL;
}
+
+CAMLexport void caml_iterate_named_values(caml_named_action f)
+{
+ int i;
+ for(i = 0; i < Named_value_size; i++){
+ struct named_value * nv;
+ for (nv = named_value_table[i]; nv != NULL; nv = nv->next) {
+ f( &nv->val, nv->name );
+ }
+ }
+}
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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. */
-/* */
-/***********************************************************************/
-
-/* Callbacks from C to OCaml */
-
-#ifndef CAML_CALLBACK_H
-#define CAML_CALLBACK_H
-
-#ifndef CAML_NAME_SPACE
-#include "compatibility.h"
-#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,
- value arg3);
-CAMLextern value caml_callbackN (value closure, int narg, value args[]);
-
-CAMLextern value caml_callback_exn (value closure, value arg);
-CAMLextern value caml_callback2_exn (value closure, value arg1, value arg2);
-CAMLextern value caml_callback3_exn (value closure,
- value arg1, value arg2, value arg3);
-CAMLextern value caml_callbackN_exn (value closure, int narg, value args[]);
-
-#define Make_exception_result(v) ((v) | 2)
-#define Is_exception_result(v) (((v) & 3) == 2)
-#define Extract_exception(v) ((v) & ~3)
-
-CAMLextern value * caml_named_value (char const * name);
-
-CAMLextern void caml_main (char ** argv);
-CAMLextern void caml_startup (char ** argv);
-
-CAMLextern int caml_callback_depth;
-
-#ifdef __cplusplus
-}
-#endif
-
-#endif
--- /dev/null
+/***********************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Damien Doligez, projet Para, 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. */
+/* */
+/***********************************************************************/
+
+/* Classification of addresses for GC and runtime purposes. */
+
+#ifndef CAML_ADDRESS_CLASS_H
+#define CAML_ADDRESS_CLASS_H
+
+#include "misc.h"
+#include "mlvalues.h"
+
+/* Use the following macros to test an address for the different classes
+ it might belong to. */
+
+#define Is_young(val) \
+ (Assert (Is_block (val)), \
+ (addr)(val) < (addr)caml_young_end && (addr)(val) > (addr)caml_young_start)
+
+#define Is_in_heap(a) (Classify_addr(a) & In_heap)
+
+#define Is_in_heap_or_young(a) (Classify_addr(a) & (In_heap | In_young))
+
+#define Is_in_value_area(a) \
+ (Classify_addr(a) & (In_heap | In_young | In_static_data))
+
+#define Is_in_code_area(pc) \
+ ( ((char *)(pc) >= caml_code_area_start && \
+ (char *)(pc) <= caml_code_area_end) \
+ || (Classify_addr(pc) & In_code_area) )
+
+#define Is_in_static_data(a) (Classify_addr(a) & In_static_data)
+
+/***********************************************************************/
+/* The rest of this file is private and may change without notice. */
+
+extern char *caml_young_start, *caml_young_end;
+extern char * caml_code_area_start, * caml_code_area_end;
+
+#define Not_in_heap 0
+#define In_heap 1
+#define In_young 2
+#define In_static_data 4
+#define In_code_area 8
+
+#ifdef ARCH_SIXTYFOUR
+
+/* 64 bits: Represent page table as a sparse hash table */
+int caml_page_table_lookup(void * addr);
+#define Classify_addr(a) (caml_page_table_lookup((void *)(a)))
+
+#else
+
+/* 32 bits: Represent page table as a 2-level array */
+#define Pagetable2_log 11
+#define Pagetable2_size (1 << Pagetable2_log)
+#define Pagetable1_log (Page_log + Pagetable2_log)
+#define Pagetable1_size (1 << (32 - Pagetable1_log))
+CAMLextern unsigned char * caml_page_table[Pagetable1_size];
+
+#define Pagetable_index1(a) (((uintnat)(a)) >> Pagetable1_log)
+#define Pagetable_index2(a) \
+ ((((uintnat)(a)) >> Page_log) & (Pagetable2_size - 1))
+#define Classify_addr(a) \
+ caml_page_table[Pagetable_index1(a)][Pagetable_index2(a)]
+
+#endif
+
+int caml_page_table_add(int kind, void * start, void * end);
+int caml_page_table_remove(int kind, void * start, void * end);
+int caml_page_table_initialize(mlsize_t bytesize);
+
+#endif /* CAML_ADDRESS_CLASS_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Xavier Leroy and Damien Doligez, 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. */
+/* */
+/***********************************************************************/
+
+#ifndef CAML_ALLOC_H
+#define CAML_ALLOC_H
+
+
+#ifndef CAML_NAME_SPACE
+#include "compatibility.h"
+#endif
+#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);
+CAMLextern value caml_alloc_string (mlsize_t); /* size in bytes */
+CAMLextern value caml_copy_string (char const *);
+CAMLextern value caml_copy_string_array (char const **);
+CAMLextern value caml_copy_double (double);
+CAMLextern value caml_copy_int32 (int32); /* defined in [ints.c] */
+CAMLextern value caml_copy_int64 (int64); /* defined in [ints.c] */
+CAMLextern value caml_copy_nativeint (intnat); /* defined in [ints.c] */
+CAMLextern value caml_alloc_array (value (*funct) (char const *),
+ char const ** array);
+CAMLextern value caml_alloc_sprintf(const char * format, ...);
+
+typedef void (*final_fun)(value);
+CAMLextern value caml_alloc_final (mlsize_t, /*size in words*/
+ final_fun, /*finalization function*/
+ mlsize_t, /*resources consumed*/
+ mlsize_t /*max resources*/);
+
+CAMLextern int caml_convert_flag_list (value, int *);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_ALLOC_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* 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. */
+/* */
+/***********************************************************************/
+
+#ifndef CAML_BACKTRACE_H
+#define CAML_BACKTRACE_H
+
+#include "mlvalues.h"
+
+CAMLextern int caml_backtrace_active;
+CAMLextern int caml_backtrace_pos;
+CAMLextern code_t * caml_backtrace_buffer;
+CAMLextern value caml_backtrace_last_exn;
+CAMLextern char * caml_cds_file;
+
+CAMLprim value caml_record_backtrace(value vflag);
+#ifndef NATIVE_CODE
+extern void caml_stash_backtrace(value exn, code_t pc, value * sp, int reraise);
+#endif
+CAMLextern void caml_print_exception_backtrace(void);
+
+#endif /* CAML_BACKTRACE_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* 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. */
+/* */
+/***********************************************************************/
+
+/* Callbacks from C to OCaml */
+
+#ifndef CAML_CALLBACK_H
+#define CAML_CALLBACK_H
+
+#ifndef CAML_NAME_SPACE
+#include "compatibility.h"
+#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,
+ value arg3);
+CAMLextern value caml_callbackN (value closure, int narg, value args[]);
+
+CAMLextern value caml_callback_exn (value closure, value arg);
+CAMLextern value caml_callback2_exn (value closure, value arg1, value arg2);
+CAMLextern value caml_callback3_exn (value closure,
+ value arg1, value arg2, value arg3);
+CAMLextern value caml_callbackN_exn (value closure, int narg, value args[]);
+
+#define Make_exception_result(v) ((v) | 2)
+#define Is_exception_result(v) (((v) & 3) == 2)
+#define Extract_exception(v) ((v) & ~3)
+
+CAMLextern value * caml_named_value (char const * name);
+typedef void (*caml_named_action) (value*, char *);
+CAMLextern void caml_iterate_named_values(caml_named_action f);
+
+CAMLextern void caml_main (char ** argv);
+CAMLextern void caml_startup (char ** argv);
+
+CAMLextern int caml_callback_depth;
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif
--- /dev/null
+/***********************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Damien Doligez, projet Para, 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. */
+/* */
+/***********************************************************************/
+
+#ifndef CAML_COMPACT_H
+#define CAML_COMPACT_H
+
+
+#include "config.h"
+#include "misc.h"
+
+extern void caml_compact_heap (void);
+extern void caml_compact_heap_maybe (void);
+
+
+#endif /* CAML_COMPACT_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Damien Doligez, Projet Moscova, 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. */
+/* */
+/***********************************************************************/
+
+#ifndef CAML_COMPARE_H
+#define CAML_COMPARE_H
+
+CAMLextern int caml_compare_unordered;
+
+#endif /* CAML_COMPARE_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Damien Doligez, projet Moscova, 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. */
+/* */
+/***********************************************************************/
+
+/* definitions for compatibility with old identifiers */
+
+#ifndef CAML_COMPATIBILITY_H
+#define CAML_COMPATIBILITY_H
+
+#ifndef CAML_NAME_SPACE
+
+/*
+ #define --> CAMLextern (defined with CAMLexport or CAMLprim)
+ (rien) --> CAMLprim
+ g --> global C identifier
+ x --> special case
+
+ SP* signals the special cases:
+ - when the identifier was not simply prefixed with [caml_]
+ - when the [caml_] version was already used for something else, and
+ was renamed out of the way (watch out for [caml_alloc] and
+ [caml_array_bound_error] in *.s)
+*/
+
+/* a faire:
+ - ui_* (reverifier que win32.c n'en depend pas)
+*/
+
+
+/* **** alloc.c */
+#define alloc caml_alloc /*SP*/
+#define alloc_small caml_alloc_small
+#define alloc_tuple caml_alloc_tuple
+#define alloc_string caml_alloc_string
+#define alloc_final caml_alloc_final
+#define copy_string caml_copy_string
+#define alloc_array caml_alloc_array
+#define copy_string_array caml_copy_string_array
+#define convert_flag_list caml_convert_flag_list
+
+/* **** array.c */
+
+/* **** backtrace.c */
+#define backtrace_active caml_backtrace_active
+#define backtrace_pos caml_backtrace_pos
+#define backtrace_buffer caml_backtrace_buffer
+#define backtrace_last_exn caml_backtrace_last_exn
+#define print_exception_backtrace caml_print_exception_backtrace
+
+/* **** callback.c */
+#define callback_depth caml_callback_depth
+#define callbackN_exn caml_callbackN_exn
+#define callback_exn caml_callback_exn
+#define callback2_exn caml_callback2_exn
+#define callback3_exn caml_callback3_exn
+#define callback caml_callback
+#define callback2 caml_callback2
+#define callback3 caml_callback3
+#define callbackN caml_callbackN
+
+/* **** compact.c */
+
+/* **** compare.c */
+#define compare_unordered caml_compare_unordered
+
+/* **** custom.c */
+#define alloc_custom caml_alloc_custom
+#define register_custom_operations caml_register_custom_operations
+
+/* **** debugger.c */
+
+/* **** dynlink.c */
+
+/* **** extern.c */
+#define output_val caml_output_val
+#define output_value_to_malloc caml_output_value_to_malloc
+#define output_value_to_block caml_output_value_to_block
+#define serialize_int_1 caml_serialize_int_1
+#define serialize_int_2 caml_serialize_int_2
+#define serialize_int_4 caml_serialize_int_4
+#define serialize_int_8 caml_serialize_int_8
+#define serialize_float_4 caml_serialize_float_4
+#define serialize_float_8 caml_serialize_float_8
+#define serialize_block_1 caml_serialize_block_1
+#define serialize_block_2 caml_serialize_block_2
+#define serialize_block_4 caml_serialize_block_4
+#define serialize_block_8 caml_serialize_block_8
+#define serialize_block_float_8 caml_serialize_block_float_8
+
+/* **** fail.c */
+#define external_raise caml_external_raise
+#define mlraise caml_raise /*SP*/
+#define raise_constant caml_raise_constant
+#define raise_with_arg caml_raise_with_arg
+#define raise_with_string caml_raise_with_string
+#define failwith caml_failwith
+#define invalid_argument caml_invalid_argument
+#define array_bound_error caml_array_bound_error /*SP*/
+#define raise_out_of_memory caml_raise_out_of_memory
+#define raise_stack_overflow caml_raise_stack_overflow
+#define raise_sys_error caml_raise_sys_error
+#define raise_end_of_file caml_raise_end_of_file
+#define raise_zero_divide caml_raise_zero_divide
+#define raise_not_found caml_raise_not_found
+#define raise_sys_blocked_io caml_raise_sys_blocked_io
+/* **** asmrun/fail.c */
+/* **** asmrun/<arch>.s */
+
+/* **** finalise.c */
+
+/* **** fix_code.c */
+
+/* **** floats.c */
+/*#define Double_val caml_Double_val done in mlvalues.h as needed */
+/*#define Store_double_val caml_Store_double_val done in mlvalues.h as needed */
+#define copy_double caml_copy_double
+
+/* **** freelist.c */
+
+/* **** gc_ctrl.c */
+
+/* **** globroots.c */
+#define register_global_root caml_register_global_root
+#define remove_global_root caml_remove_global_root
+
+/* **** hash.c */
+#define hash_variant caml_hash_variant
+
+/* **** instrtrace.c */
+
+/* **** intern.c */
+#define input_val caml_input_val
+#define input_val_from_string caml_input_val_from_string
+#define input_value_from_malloc caml_input_value_from_malloc
+#define input_value_from_block caml_input_value_from_block
+#define deserialize_uint_1 caml_deserialize_uint_1
+#define deserialize_sint_1 caml_deserialize_sint_1
+#define deserialize_uint_2 caml_deserialize_uint_2
+#define deserialize_sint_2 caml_deserialize_sint_2
+#define deserialize_uint_4 caml_deserialize_uint_4
+#define deserialize_sint_4 caml_deserialize_sint_4
+#define deserialize_uint_8 caml_deserialize_uint_8
+#define deserialize_sint_8 caml_deserialize_sint_8
+#define deserialize_float_4 caml_deserialize_float_4
+#define deserialize_float_8 caml_deserialize_float_8
+#define deserialize_block_1 caml_deserialize_block_1
+#define deserialize_block_2 caml_deserialize_block_2
+#define deserialize_block_4 caml_deserialize_block_4
+#define deserialize_block_8 caml_deserialize_block_8
+#define deserialize_block_float_8 caml_deserialize_block_float_8
+#define deserialize_error caml_deserialize_error
+
+/* **** interp.c */
+
+/* **** ints.c */
+#define int32_ops caml_int32_ops
+#define copy_int32 caml_copy_int32
+/*#define Int64_val caml_Int64_val *** done in mlvalues.h as needed */
+#define int64_ops caml_int64_ops
+#define copy_int64 caml_copy_int64
+#define nativeint_ops caml_nativeint_ops
+#define copy_nativeint caml_copy_nativeint
+
+/* **** io.c */
+#define channel_mutex_free caml_channel_mutex_free
+#define channel_mutex_lock caml_channel_mutex_lock
+#define channel_mutex_unlock caml_channel_mutex_unlock
+#define channel_mutex_unlock_exn caml_channel_mutex_unlock_exn
+#define all_opened_channels caml_all_opened_channels
+#define open_descriptor_in caml_open_descriptor_in /*SP*/
+#define open_descriptor_out caml_open_descriptor_out /*SP*/
+#define close_channel caml_close_channel /*SP*/
+#define channel_size caml_channel_size /*SP*/
+#define channel_binary_mode caml_channel_binary_mode
+#define flush_partial caml_flush_partial /*SP*/
+#define flush caml_flush /*SP*/
+#define putword caml_putword
+#define putblock caml_putblock
+#define really_putblock caml_really_putblock
+#define seek_out caml_seek_out /*SP*/
+#define pos_out caml_pos_out /*SP*/
+#define do_read caml_do_read
+#define refill caml_refill
+#define getword caml_getword
+#define getblock caml_getblock
+#define really_getblock caml_really_getblock
+#define seek_in caml_seek_in /*SP*/
+#define pos_in caml_pos_in /*SP*/
+#define input_scan_line caml_input_scan_line /*SP*/
+#define finalize_channel caml_finalize_channel
+#define alloc_channel caml_alloc_channel
+/*#define Val_file_offset caml_Val_file_offset *** done in io.h as needed */
+/*#define File_offset_val caml_File_offset_val *** done in io.h as needed */
+
+/* **** lexing.c */
+
+/* **** main.c */
+/* *** no change */
+
+/* **** major_gc.c */
+#define heap_start caml_heap_start
+#define page_table caml_page_table
+
+/* **** md5.c */
+#define md5_string caml_md5_string
+#define md5_chan caml_md5_chan
+#define MD5Init caml_MD5Init
+#define MD5Update caml_MD5Update
+#define MD5Final caml_MD5Final
+#define MD5Transform caml_MD5Transform
+
+/* **** memory.c */
+#define alloc_shr caml_alloc_shr
+#define initialize caml_initialize
+#define modify caml_modify
+#define stat_alloc caml_stat_alloc
+#define stat_free caml_stat_free
+#define stat_resize caml_stat_resize
+
+/* **** meta.c */
+
+/* **** minor_gc.c */
+#define young_start caml_young_start
+#define young_end caml_young_end
+#define young_ptr caml_young_ptr
+#define young_limit caml_young_limit
+#define ref_table caml_ref_table
+#define minor_collection caml_minor_collection
+#define check_urgent_gc caml_check_urgent_gc
+
+/* **** misc.c */
+
+/* **** obj.c */
+
+/* **** parsing.c */
+
+/* **** prims.c */
+
+/* **** printexc.c */
+#define format_caml_exception caml_format_exception /*SP*/
+
+/* **** roots.c */
+#define local_roots caml_local_roots
+#define scan_roots_hook caml_scan_roots_hook
+#define do_local_roots caml_do_local_roots
+
+/* **** signals.c */
+#define pending_signals caml_pending_signals
+#define something_to_do caml_something_to_do
+#define enter_blocking_section_hook caml_enter_blocking_section_hook
+#define leave_blocking_section_hook caml_leave_blocking_section_hook
+#define try_leave_blocking_section_hook caml_try_leave_blocking_section_hook
+#define async_action_hook caml_async_action_hook
+#define enter_blocking_section caml_enter_blocking_section
+#define leave_blocking_section caml_leave_blocking_section
+#define convert_signal_number caml_convert_signal_number
+/* **** asmrun/signals.c */
+#define garbage_collection caml_garbage_collection
+
+/* **** stacks.c */
+#define stack_low caml_stack_low
+#define stack_high caml_stack_high
+#define stack_threshold caml_stack_threshold
+#define extern_sp caml_extern_sp
+#define trapsp caml_trapsp
+#define trap_barrier caml_trap_barrier
+
+/* **** startup.c */
+#define atom_table caml_atom_table
+/* **** asmrun/startup.c */
+#define static_data_start caml_static_data_start
+#define static_data_end caml_static_data_end
+
+/* **** str.c */
+#define string_length caml_string_length
+
+/* **** sys.c */
+#define sys_error caml_sys_error
+#define sys_exit caml_sys_exit
+
+/* **** terminfo.c */
+
+/* **** unix.c & win32.c */
+#define search_exe_in_path caml_search_exe_in_path
+
+/* **** weak.c */
+
+/* **** asmcomp/asmlink.ml */
+
+/* **** asmcomp/cmmgen.ml */
+
+/* **** asmcomp/asmlink.ml, asmcomp/cmmgen.ml, asmcomp/compilenv.ml */
+
+/* ************************************************************* */
+
+/* **** otherlibs/bigarray */
+#define int8 caml_ba_int8
+#define uint8 caml_ba_uint8
+#define int16 caml_ba_int16
+#define uint16 caml_ba_uint16
+#define MAX_NUM_DIMS CAML_BA_MAX_NUM_DIMS
+#define caml_bigarray_kind caml_ba_kind
+#define BIGARRAY_FLOAT32 CAML_BA_FLOAT32
+#define BIGARRAY_FLOAT64 CAML_BA_FLOAT64
+#define BIGARRAY_SINT8 CAML_BA_SINT8
+#define BIGARRAY_UINT8 CAML_BA_UINT8
+#define BIGARRAY_SINT16 CAML_BA_SINT16
+#define BIGARRAY_UINT16 CAML_BA_UINT16
+#define BIGARRAY_INT32 CAML_BA_INT32
+#define BIGARRAY_INT64 CAML_BA_INT64
+#define BIGARRAY_CAML_INT CAML_BA_CAML_INT
+#define BIGARRAY_NATIVE_INT CAML_BA_NATIVE_INT
+#define BIGARRAY_COMPLEX32 CAML_BA_COMPLEX32
+#define BIGARRAY_COMPLEX64 CAML_BA_COMPLEX64
+#define BIGARRAY_KIND_MASK CAML_BA_KIND_MASK
+#define caml_bigarray_layout caml_ba_layout
+#define BIGARRAY_C_LAYOUT CAML_BA_C_LAYOUT
+#define BIGARRAY_FORTRAN_LAYOUT CAML_BA_FORTRAN_LAYOUT
+#define BIGARRAY_LAYOUT_MASK CAML_BA_LAYOUT_MASK
+#define caml_bigarray_managed caml_ba_managed
+#define BIGARRAY_EXTERNAL CAML_BA_EXTERNAL
+#define BIGARRAY_MANAGED CAML_BA_MANAGED
+#define BIGARRAY_MAPPED_FILE CAML_BA_MAPPED_FILE
+#define BIGARRAY_MANAGED_MASK CAML_BA_MANAGED_MASK
+#define caml_bigarray_proxy caml_ba_proxy
+#define caml_bigarray caml_ba_array
+#define Bigarray_val Caml_ba_array_val
+#define Data_bigarray_val Caml_ba_data_val
+#define alloc_bigarray caml_ba_alloc
+#define alloc_bigarray_dims caml_ba_alloc_dims
+#define bigarray_map_file caml_ba_map_file
+#define bigarray_unmap_file caml_ba_unmap_file
+#define bigarray_element_size caml_ba_element_size
+#define bigarray_byte_size caml_ba_byte_size
+#define bigarray_deserialize caml_ba_deserialize
+#define MAX_BIGARRAY_MEMORY CAML_BA_MAX_MEMORY
+#define bigarray_create caml_ba_create
+#define bigarray_get_N caml_ba_get_N
+#define bigarray_get_1 caml_ba_get_1
+#define bigarray_get_2 caml_ba_get_2
+#define bigarray_get_3 caml_ba_get_3
+#define bigarray_get_generic caml_ba_get_generic
+#define bigarray_set_1 caml_ba_set_1
+#define bigarray_set_2 caml_ba_set_2
+#define bigarray_set_3 caml_ba_set_3
+#define bigarray_set_N caml_ba_set_N
+#define bigarray_set_generic caml_ba_set_generic
+#define bigarray_num_dims caml_ba_num_dims
+#define bigarray_dim caml_ba_dim
+#define bigarray_kind caml_ba_kind
+#define bigarray_layout caml_ba_layout
+#define bigarray_slice caml_ba_slice
+#define bigarray_sub caml_ba_sub
+#define bigarray_blit caml_ba_blit
+#define bigarray_fill caml_ba_fill
+#define bigarray_reshape caml_ba_reshape
+#define bigarray_init caml_ba_init
+
+#endif /* CAML_NAME_SPACE */
+#endif /* CAML_COMPATIBILITY_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Xavier Leroy and Damien Doligez, 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. */
+/* */
+/***********************************************************************/
+
+#ifndef CAML_CONFIG_H
+#define CAML_CONFIG_H
+
+/* <include ../config/m.h> */
+/* <include ../config/s.h> */
+/* <private> */
+#include "../../config/m.h"
+#include "../../config/s.h"
+/* </private> */
+
+#ifndef CAML_NAME_SPACE
+#include "compatibility.h"
+#endif
+
+/* Types for 32-bit integers, 64-bit integers,
+ native integers (as wide as a pointer type) */
+
+#if SIZEOF_INT == 4
+typedef int int32;
+typedef unsigned int uint32;
+#define ARCH_INT32_PRINTF_FORMAT ""
+#elif SIZEOF_LONG == 4
+typedef long int32;
+typedef unsigned long uint32;
+#define ARCH_INT32_PRINTF_FORMAT "l"
+#elif SIZEOF_SHORT == 4
+typedef short int32;
+typedef unsigned short uint32;
+#define ARCH_INT32_PRINTF_FORMAT ""
+#else
+#error "No 32-bit integer type available"
+#endif
+
+#ifndef ARCH_INT64_TYPE
+#if SIZEOF_LONGLONG == 8
+#define ARCH_INT64_TYPE long long
+#define ARCH_UINT64_TYPE unsigned long long
+#define ARCH_INT64_PRINTF_FORMAT "ll"
+#elif SIZEOF_LONG == 8
+#define ARCH_INT64_TYPE long
+#define ARCH_UINT64_TYPE unsigned long
+#define ARCH_INT64_PRINTF_FORMAT "l"
+#else
+#error "No 64-bit integer type available"
+#endif
+#endif
+
+typedef ARCH_INT64_TYPE int64;
+typedef ARCH_UINT64_TYPE uint64;
+
+#if SIZEOF_PTR == SIZEOF_LONG
+/* Standard models: ILP32 or I32LP64 */
+typedef long intnat;
+typedef unsigned long uintnat;
+#define ARCH_INTNAT_PRINTF_FORMAT "l"
+#elif SIZEOF_PTR == SIZEOF_INT
+/* Hypothetical IP32L64 model */
+typedef int intnat;
+typedef unsigned int uintnat;
+#define ARCH_INTNAT_PRINTF_FORMAT ""
+#elif SIZEOF_PTR == 8
+/* Win64 model: IL32LLP64 */
+typedef int64 intnat;
+typedef uint64 uintnat;
+#define ARCH_INTNAT_PRINTF_FORMAT ARCH_INT64_PRINTF_FORMAT
+#else
+#error "No integer type available to represent pointers"
+#endif
+
+/* Endianness of floats */
+
+/* ARCH_FLOAT_ENDIANNESS encodes the byte order of doubles as follows:
+ the value [0xabcdefgh] means that the least significant byte of the
+ float is at byte offset [a], the next lsb at [b], ..., and the
+ most significant byte at [h]. */
+
+#if defined(__arm__) && !defined(__ARM_EABI__)
+#define ARCH_FLOAT_ENDIANNESS 0x45670123
+#elif defined(ARCH_BIG_ENDIAN)
+#define ARCH_FLOAT_ENDIANNESS 0x76543210
+#else
+#define ARCH_FLOAT_ENDIANNESS 0x01234567
+#endif
+
+/* 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)
+#define THREADED_CODE
+#endif
+
+
+/* Do not change this definition. */
+#define Page_size (1 << Page_log)
+
+/* Memory model parameters */
+
+/* The size of a page for memory management (in bytes) is [1 << Page_log].
+ It must be a multiple of [sizeof (value)] and >= 8 and <= 20. */
+#define Page_log 12 /* A page is 4 kilobytes. */
+
+/* Initial size of stack (bytes). */
+#define Stack_size (4096 * sizeof(value))
+
+/* Minimum free size of stack (bytes); below that, it is reallocated. */
+#define Stack_threshold (256 * sizeof(value))
+
+/* Default maximum size of the stack (words). */
+#define Max_stack_def (1024 * 1024)
+
+
+/* Maximum size of a block allocated in the young generation (words). */
+/* Must be > 4 */
+#define Max_young_wosize 256
+
+
+/* Minimum size of the minor zone (words).
+ This must be at least [Max_young_wosize + 1]. */
+#define Minor_heap_min 4096
+
+/* Maximum size of the minor zone (words).
+ Must be greater than or equal to [Minor_heap_min].
+*/
+#define Minor_heap_max (1 << 28)
+
+/* Default size of the minor zone. (words) */
+#define Minor_heap_def 262144
+
+
+/* Minimum size increment when growing the heap (words).
+ Must be a multiple of [Page_size / sizeof (value)]. */
+#define Heap_chunk_min (15 * Page_size)
+
+/* Default size increment when growing the heap.
+ If this is <= 1000, it's a percentage of the current heap size.
+ If it is > 1000, it's a number of words. */
+#define Heap_chunk_def 15
+
+/* Default initial size of the major heap (words);
+ Must be a multiple of [Page_size / sizeof (value)]. */
+#define Init_heap_def (31 * Page_size)
+/* (about 512 kB for a 32-bit platform, 1 MB for a 64-bit platform.) */
+
+
+/* Default speed setting for the major GC. The heap will grow until
+ the dead objects and the free list represent this percentage of the
+ total size of live objects. */
+#define Percent_free_def 80
+
+/* Default setting for the compacter: 500%
+ (i.e. trigger the compacter when 5/6 of the heap is free or garbage)
+ This can be set quite high because the overhead is over-estimated
+ when fragmentation occurs.
+ */
+#define Max_percent_free_def 500
+
+
+#endif /* CAML_CONFIG_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Manuel Serrano and Xavier Leroy, 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. */
+/* */
+/***********************************************************************/
+
+#ifndef CAML_CUSTOM_H
+#define CAML_CUSTOM_H
+
+
+#ifndef CAML_NAME_SPACE
+#include "compatibility.h"
+#endif
+#include "mlvalues.h"
+
+struct custom_operations {
+ char *identifier;
+ void (*finalize)(value v);
+ int (*compare)(value v1, value v2);
+ intnat (*hash)(value v);
+ void (*serialize)(value v,
+ /*out*/ uintnat * wsize_32 /*size in bytes*/,
+ /*out*/ uintnat * wsize_64 /*size in bytes*/);
+ uintnat (*deserialize)(void * dst);
+ int (*compare_ext)(value v1, value v2);
+};
+
+#define custom_finalize_default NULL
+#define custom_compare_default NULL
+#define custom_hash_default NULL
+#define custom_serialize_default NULL
+#define custom_deserialize_default NULL
+#define custom_compare_ext_default NULL
+
+#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*/
+ mlsize_t max /*max resources*/);
+
+CAMLextern void caml_register_custom_operations(struct custom_operations * ops);
+
+CAMLextern int caml_compare_unordered;
+ /* Used by custom comparison to report unordered NaN-like cases. */
+
+/* <private> */
+extern struct custom_operations * caml_find_custom_operations(char * ident);
+extern struct custom_operations *
+ caml_final_custom_operations(void (*fn)(value));
+
+extern void caml_init_custom_operations(void);
+/* </private> */
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_CUSTOM_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* 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. */
+/* */
+/***********************************************************************/
+
+/* Interface with the debugger */
+
+#ifndef CAML_DEBUGGER_H
+#define CAML_DEBUGGER_H
+
+#include "misc.h"
+#include "mlvalues.h"
+
+CAMLextern int caml_debugger_in_use;
+CAMLextern int caml_debugger_fork_mode; /* non-zero for parent */
+extern uintnat caml_event_count;
+
+enum event_kind {
+ EVENT_COUNT, BREAKPOINT, PROGRAM_START, PROGRAM_EXIT,
+ TRAP_BARRIER, UNCAUGHT_EXC
+};
+
+void caml_debugger_init (void);
+void caml_debugger (enum event_kind event);
+void caml_debugger_cleanup_fork (void);
+
+/* Communication protocol */
+
+/* Requests from the debugger to the runtime system */
+
+enum debugger_request {
+ REQ_SET_EVENT = 'e', /* uint32 pos */
+ /* Set an event on the instruction at position pos */
+ REQ_SET_BREAKPOINT = 'B', /* uint32 pos, (char k) */
+ /* Set a breakpoint at position pos */
+ /* In profiling mode, the breakpoint kind is set to k */
+ REQ_RESET_INSTR = 'i', /* uint32 pos */
+ /* Clear an event or breapoint at position pos, restores initial instr. */
+ REQ_CHECKPOINT = 'c', /* no args */
+ /* Checkpoint the runtime system by forking a child process.
+ Reply is pid of child process or -1 if checkpoint failed. */
+ REQ_GO = 'g', /* uint32 n */
+ /* Run the program for n events.
+ Reply is one of debugger_reply described below. */
+ REQ_STOP = 's', /* no args */
+ /* Terminate the runtime system */
+ REQ_WAIT = 'w', /* no args */
+ /* Reap one dead child (a discarded checkpoint). */
+ REQ_INITIAL_FRAME = '0', /* no args */
+ /* Set current frame to bottom frame (the one currently executing).
+ Reply is stack offset and current pc. */
+ REQ_GET_FRAME = 'f', /* no args */
+ /* Return current frame location (stack offset + current pc). */
+ REQ_SET_FRAME = 'S', /* uint32 stack_offset */
+ /* Set current frame to given stack offset. No reply. */
+ REQ_UP_FRAME = 'U', /* uint32 n */
+ /* Move one frame up. Argument n is size of current frame (in words).
+ Reply is stack offset and current pc, or -1 if top of stack reached. */
+ REQ_SET_TRAP_BARRIER = 'b', /* uint32 offset */
+ /* Set the trap barrier at the given offset. */
+ REQ_GET_LOCAL = 'L', /* uint32 slot_number */
+ /* Return the local variable at the given slot in the current frame.
+ Reply is one value. */
+ REQ_GET_ENVIRONMENT = 'E', /* uint32 slot_number */
+ /* Return the local variable at the given slot in the heap environment
+ of the current frame. Reply is one value. */
+ REQ_GET_GLOBAL = 'G', /* uint32 global_number */
+ /* Return the specified global variable. Reply is one value. */
+ REQ_GET_ACCU = 'A', /* no args */
+ /* Return the current contents of the accumulator. Reply is one value. */
+ REQ_GET_HEADER = 'H', /* mlvalue v */
+ /* As REQ_GET_OBJ, but sends only the header. */
+ REQ_GET_FIELD = 'F', /* mlvalue v, uint32 fieldnum */
+ /* As REQ_GET_OBJ, but sends only one field. */
+ REQ_MARSHAL_OBJ = 'M', /* mlvalue v */
+ /* Send a copy of the data structure rooted at v, using the same
+ format as [caml_output_value]. */
+ REQ_GET_CLOSURE_CODE = 'C', /* mlvalue v */
+ /* Send the code address of the given closure.
+ Reply is one uint32. */
+ REQ_SET_FORK_MODE = 'K' /* uint32 m */
+ /* Set whether to follow the child (m=0) or the parent on fork. */
+};
+
+/* Replies to a REQ_GO request. All replies are followed by three uint32:
+ - the value of the event counter
+ - the position of the stack
+ - the current pc. */
+
+enum debugger_reply {
+ REP_EVENT = 'e',
+ /* Event counter reached 0. */
+ REP_BREAKPOINT = 'b',
+ /* Breakpoint hit. */
+ REP_EXITED = 'x',
+ /* Program exited by calling exit or reaching the end of the source. */
+ REP_TRAP = 's',
+ /* Trap barrier crossed. */
+ REP_UNCAUGHT_EXC = 'u'
+ /* Program exited due to a stray exception. */
+};
+
+#endif /* CAML_DEBUGGER_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* 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 GNU Library General Public License, with */
+/* the special exception on linking described in file ../LICENSE. */
+/* */
+/***********************************************************************/
+
+/* Dynamic loading of C primitives. */
+
+#ifndef CAML_DYNLINK_H
+#define CAML_DYNLINK_H
+
+#include "misc.h"
+
+/* Build the table of primitives, given a search path, a list
+ of shared libraries, and a list of primitive names
+ (all three 0-separated in char arrays).
+ Abort the runtime system on error. */
+extern void caml_build_primitive_table(char * lib_path,
+ char * libs,
+ char * req_prims);
+
+/* The search path for shared libraries */
+extern struct ext_table caml_shared_libs_path;
+
+/* Build the table of primitives as a copy of the builtin primitive table.
+ Used for executables generated by ocamlc -output-obj. */
+extern void caml_build_primitive_table_builtin(void);
+
+#endif /* CAML_DYNLINK_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* 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. */
+/* */
+/***********************************************************************/
+
+/* exec.h : format of executable bytecode files */
+
+#ifndef CAML_EXEC_H
+#define CAML_EXEC_H
+
+/* Executable bytecode files are composed of a number of sections,
+ identified by 4-character names. A table of contents at the
+ end of the file lists the section names along with their sizes,
+ in the order in which they appear in the file:
+
+ offset 0 ---> initial junk
+ data for section 1
+ data for section 2
+ ...
+ data for section N
+ table of contents:
+ descriptor for section 1
+ ...
+ descriptor for section N
+ trailer
+ end of file --->
+*/
+
+/* Structure of t.o.c. entries
+ Numerical quantities are 32-bit unsigned integers, big endian */
+
+struct section_descriptor {
+ char name[4]; /* Section name */
+ uint32 len; /* Length of data in bytes */
+};
+
+/* Structure of the trailer. */
+
+struct exec_trailer {
+ uint32 num_sections; /* Number of sections */
+ char magic[12]; /* The magic number */
+ struct section_descriptor * section; /* Not part of file */
+};
+
+#define TRAILER_SIZE (4+12)
+
+/* Magic number for this release */
+
+#define EXEC_MAGIC "Caml1999X011"
+
+
+#endif /* CAML_EXEC_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* 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. */
+/* */
+/***********************************************************************/
+
+#ifndef CAML_FAIL_H
+#define CAML_FAIL_H
+
+/* <private> */
+#include <setjmp.h>
+/* </private> */
+
+#ifndef CAML_NAME_SPACE
+#include "compatibility.h"
+#endif
+#include "misc.h"
+#include "mlvalues.h"
+
+/* <private> */
+#define OUT_OF_MEMORY_EXN 0 /* "Out_of_memory" */
+#define SYS_ERROR_EXN 1 /* "Sys_error" */
+#define FAILURE_EXN 2 /* "Failure" */
+#define INVALID_EXN 3 /* "Invalid_argument" */
+#define END_OF_FILE_EXN 4 /* "End_of_file" */
+#define ZERO_DIVIDE_EXN 5 /* "Division_by_zero" */
+#define NOT_FOUND_EXN 6 /* "Not_found" */
+#define MATCH_FAILURE_EXN 7 /* "Match_failure" */
+#define STACK_OVERFLOW_EXN 8 /* "Stack_overflow" */
+#define SYS_BLOCKED_IO 9 /* "Sys_blocked_io" */
+#define ASSERT_FAILURE_EXN 10 /* "Assert_failure" */
+#define UNDEFINED_RECURSIVE_MODULE_EXN 11 /* "Undefined_recursive_module" */
+
+#ifdef POSIX_SIGNALS
+struct longjmp_buffer {
+ sigjmp_buf buf;
+};
+#else
+struct longjmp_buffer {
+ jmp_buf buf;
+};
+#define sigsetjmp(buf,save) setjmp(buf)
+#define siglongjmp(buf,val) longjmp(buf,val)
+#endif
+
+CAMLextern struct longjmp_buffer * caml_external_raise;
+extern value caml_exn_bucket;
+int caml_is_special_exception(value exn);
+
+/* </private> */
+
+#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_string (value tag, char const * msg) Noreturn;
+CAMLextern void caml_failwith (char const *) Noreturn;
+CAMLextern void caml_invalid_argument (char const *) Noreturn;
+CAMLextern void caml_raise_out_of_memory (void) Noreturn;
+CAMLextern void caml_raise_stack_overflow (void) Noreturn;
+CAMLextern void caml_raise_sys_error (value) Noreturn;
+CAMLextern void caml_raise_end_of_file (void) Noreturn;
+CAMLextern void caml_raise_zero_divide (void) Noreturn;
+CAMLextern void caml_raise_not_found (void) Noreturn;
+CAMLextern void caml_array_bound_error (void) Noreturn;
+CAMLextern void caml_raise_sys_blocked_io (void) Noreturn;
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_FAIL_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* 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 GNU Library General Public License, with */
+/* the special exception on linking described in file ../LICENSE. */
+/* */
+/***********************************************************************/
+
+#ifndef CAML_FINALISE_H
+#define CAML_FINALISE_H
+
+#include "roots.h"
+
+void caml_final_update (void);
+void caml_final_do_calls (void);
+void caml_final_do_strong_roots (scanning_action f);
+void caml_final_do_weak_roots (scanning_action f);
+void caml_final_do_young_roots (scanning_action f);
+void caml_final_empty_young (void);
+value caml_final_register (value f, value v);
+
+#endif /* CAML_FINALISE_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* 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. */
+/* */
+/***********************************************************************/
+
+/* Handling of blocks of bytecode (endianness switch, threading). */
+
+#ifndef CAML_FIX_CODE_H
+#define CAML_FIX_CODE_H
+
+
+#include "config.h"
+#include "misc.h"
+#include "mlvalues.h"
+
+extern code_t caml_start_code;
+extern asize_t caml_code_size;
+extern unsigned char * caml_saved_code;
+
+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);
+int caml_is_instruction (opcode_t instr1, opcode_t instr2);
+
+#ifdef THREADED_CODE
+extern char ** caml_instr_table;
+extern char * caml_instr_base;
+void caml_thread_code (code_t code, asize_t len);
+#endif
+
+#endif /* CAML_FIX_CODE_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Damien Doligez, projet Para, 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. */
+/* */
+/***********************************************************************/
+
+/* Free lists of heap blocks. */
+
+#ifndef CAML_FREELIST_H
+#define CAML_FREELIST_H
+
+
+#include "misc.h"
+#include "mlvalues.h"
+
+extern asize_t caml_fl_cur_size; /* size in words */
+
+char *caml_fl_allocate (mlsize_t);
+void caml_fl_init_merge (void);
+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, int);
+void caml_set_allocation_policy (uintnat);
+
+
+#endif /* CAML_FREELIST_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Damien Doligez, projet Para, 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. */
+/* */
+/***********************************************************************/
+
+#ifndef CAML_GC_H
+#define CAML_GC_H
+
+
+#include "mlvalues.h"
+
+#define Caml_white (0 << 8)
+#define Caml_gray (1 << 8)
+#define Caml_blue (2 << 8)
+#define Caml_black (3 << 8)
+
+#define Color_hd(hd) ((color_t) ((hd) & Caml_black))
+#define Color_hp(hp) (Color_hd (Hd_hp (hp)))
+#define Color_val(val) (Color_hd (Hd_val (val)))
+
+#define Is_white_hd(hd) (Color_hd (hd) == Caml_white)
+#define Is_gray_hd(hd) (Color_hd (hd) == Caml_gray)
+#define Is_blue_hd(hd) (Color_hd (hd) == Caml_blue)
+#define Is_black_hd(hd) (Color_hd (hd) == Caml_black)
+
+#define Whitehd_hd(hd) (((hd) & ~Caml_black)/*| Caml_white*/)
+#define Grayhd_hd(hd) (((hd) & ~Caml_black) | Caml_gray)
+#define Blackhd_hd(hd) (((hd)/*& ~Caml_black*/)| Caml_black)
+#define Bluehd_hd(hd) (((hd) & ~Caml_black) | Caml_blue)
+
+/* This depends on the layout of the header. See [mlvalues.h]. */
+#define Make_header(wosize, tag, color) \
+ (/*Assert ((wosize) <= Max_wosize),*/ \
+ ((header_t) (((header_t) (wosize) << 10) \
+ + (color) \
+ + (tag_t) (tag))) \
+ )
+
+#define Is_white_val(val) (Color_val(val) == Caml_white)
+#define Is_gray_val(val) (Color_val(val) == Caml_gray)
+#define Is_blue_val(val) (Color_val(val) == Caml_blue)
+#define Is_black_val(val) (Color_val(val) == Caml_black)
+
+/* For extern.c */
+#define Colornum_hd(hd) ((color_t) (((hd) >> 8) & 3))
+#define Coloredhd_hd(hd,colnum) (((hd) & ~Caml_black) | ((colnum) << 8))
+
+#endif /* CAML_GC_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Damien Doligez, projet Para, 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. */
+/* */
+/***********************************************************************/
+
+#ifndef CAML_GC_CTRL_H
+#define CAML_GC_CTRL_H
+
+#include "misc.h"
+
+extern double
+ caml_stat_minor_words,
+ caml_stat_promoted_words,
+ caml_stat_major_words;
+
+extern intnat
+ caml_stat_minor_collections,
+ caml_stat_major_collections,
+ caml_stat_heap_size,
+ caml_stat_top_heap_size,
+ caml_stat_compactions,
+ caml_stat_heap_chunks;
+
+uintnat caml_normalize_heap_increment (uintnat);
+
+void caml_init_gc (uintnat, uintnat, uintnat,
+ uintnat, uintnat);
+
+
+#ifdef DEBUG
+void caml_heap_check (void);
+#endif
+
+#endif /* CAML_GC_CTRL_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* 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. */
+/* */
+/***********************************************************************/
+
+/* Registration of global memory roots */
+
+#ifndef CAML_GLOBROOTS_H
+#define CAML_GLOBROOTS_H
+
+#include "mlvalues.h"
+#include "roots.h"
+
+void caml_scan_global_roots(scanning_action f);
+void caml_scan_global_young_roots(scanning_action f);
+
+#endif /* CAML_GLOBROOTS_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* 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"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+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);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_HASH_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* 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. */
+/* */
+/***********************************************************************/
+
+/* Trace the instructions executed */
+
+#ifndef _instrtrace_
+#define _instrtrace_
+
+
+#include "mlvalues.h"
+#include "misc.h"
+
+extern int caml_trace_flag;
+extern intnat caml_icount;
+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);
+#endif
--- /dev/null
+/***********************************************************************/
+/* */
+/* 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. */
+/* */
+/***********************************************************************/
+
+/* The instruction set. */
+
+#ifndef CAML_INSTRUCT_H
+#define CAML_INSTRUCT_H
+
+enum instructions {
+ ACC0, ACC1, ACC2, ACC3, ACC4, ACC5, ACC6, ACC7,
+ ACC, PUSH,
+ PUSHACC0, PUSHACC1, PUSHACC2, PUSHACC3,
+ PUSHACC4, PUSHACC5, PUSHACC6, PUSHACC7,
+ PUSHACC, POP, ASSIGN,
+ ENVACC1, ENVACC2, ENVACC3, ENVACC4, ENVACC,
+ PUSHENVACC1, PUSHENVACC2, PUSHENVACC3, PUSHENVACC4, PUSHENVACC,
+ PUSH_RETADDR, APPLY, APPLY1, APPLY2, APPLY3,
+ APPTERM, APPTERM1, APPTERM2, APPTERM3,
+ RETURN, RESTART, GRAB,
+ CLOSURE, CLOSUREREC,
+ OFFSETCLOSUREM2, OFFSETCLOSURE0, OFFSETCLOSURE2, OFFSETCLOSURE,
+ PUSHOFFSETCLOSUREM2, PUSHOFFSETCLOSURE0,
+ PUSHOFFSETCLOSURE2, PUSHOFFSETCLOSURE,
+ GETGLOBAL, PUSHGETGLOBAL, GETGLOBALFIELD, PUSHGETGLOBALFIELD, SETGLOBAL,
+ ATOM0, ATOM, PUSHATOM0, PUSHATOM,
+ MAKEBLOCK, MAKEBLOCK1, MAKEBLOCK2, MAKEBLOCK3, MAKEFLOATBLOCK,
+ GETFIELD0, GETFIELD1, GETFIELD2, GETFIELD3, GETFIELD, GETFLOATFIELD,
+ SETFIELD0, SETFIELD1, SETFIELD2, SETFIELD3, SETFIELD, SETFLOATFIELD,
+ VECTLENGTH, GETVECTITEM, SETVECTITEM,
+ GETSTRINGCHAR, SETSTRINGCHAR,
+ BRANCH, BRANCHIF, BRANCHIFNOT, SWITCH, BOOLNOT,
+ PUSHTRAP, POPTRAP, RAISE,
+ CHECK_SIGNALS,
+ C_CALL1, C_CALL2, C_CALL3, C_CALL4, C_CALL5, C_CALLN,
+ CONST0, CONST1, CONST2, CONST3, CONSTINT,
+ PUSHCONST0, PUSHCONST1, PUSHCONST2, PUSHCONST3, PUSHCONSTINT,
+ NEGINT, ADDINT, SUBINT, MULINT, DIVINT, MODINT,
+ ANDINT, ORINT, XORINT, LSLINT, LSRINT, ASRINT,
+ EQ, NEQ, LTINT, LEINT, GTINT, GEINT,
+ OFFSETINT, OFFSETREF, ISINT,
+ GETMETHOD,
+ BEQ, BNEQ, BLTINT, BLEINT, BGTINT, BGEINT,
+ ULTINT, UGEINT,
+ BULTINT, BUGEINT,
+ GETPUBMET, GETDYNMET,
+ STOP,
+ EVENT, BREAK,
+ RERAISE, RAISE_NOTRACE,
+FIRST_UNIMPLEMENTED_OP};
+
+
+#endif /* CAML_INSTRUCT_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* 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. */
+/* */
+/***********************************************************************/
+
+/* Software emulation of 64-bit integer arithmetic, for C compilers
+ that do not support it. */
+
+#ifndef CAML_INT64_EMUL_H
+#define CAML_INT64_EMUL_H
+
+#include <math.h>
+
+#ifdef ARCH_BIG_ENDIAN
+#define I64_literal(hi,lo) { hi, lo }
+#else
+#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)
+{
+ if (x.h > y.h) return 1;
+ if (x.h < y.h) return -1;
+ if (x.l > y.l) return 1;
+ if (x.l < y.l) return -1;
+ return 0;
+}
+
+#define I64_ult(x, y) (I64_ucompare(x, y) < 0)
+
+/* Signed comparison */
+static int I64_compare(int64 x, int64 y)
+{
+ if ((int32)x.h > (int32)y.h) return 1;
+ if ((int32)x.h < (int32)y.h) return -1;
+ if (x.l > y.l) return 1;
+ if (x.l < y.l) return -1;
+ return 0;
+}
+
+/* Negation */
+static int64 I64_neg(int64 x)
+{
+ int64 res;
+ res.l = -x.l;
+ res.h = ~x.h;
+ if (res.l == 0) res.h++;
+ return res;
+}
+
+/* Addition */
+static int64 I64_add(int64 x, int64 y)
+{
+ int64 res;
+ res.l = x.l + y.l;
+ res.h = x.h + y.h;
+ if (res.l < x.l) res.h++;
+ return res;
+}
+
+/* Subtraction */
+static int64 I64_sub(int64 x, int64 y)
+{
+ int64 res;
+ res.l = x.l - y.l;
+ res.h = x.h - y.h;
+ if (x.l < y.l) res.h--;
+ return res;
+}
+
+/* Multiplication */
+static int64 I64_mul(int64 x, int64 y)
+{
+ int64 res;
+ uint32 prod00 = (x.l & 0xFFFF) * (y.l & 0xFFFF);
+ uint32 prod10 = (x.l >> 16) * (y.l & 0xFFFF);
+ uint32 prod01 = (x.l & 0xFFFF) * (y.l >> 16);
+ uint32 prod11 = (x.l >> 16) * (y.l >> 16);
+ res.l = prod00;
+ res.h = prod11 + (prod01 >> 16) + (prod10 >> 16);
+ prod01 = prod01 << 16; res.l += prod01; if (res.l < prod01) res.h++;
+ prod10 = prod10 << 16; res.l += prod10; if (res.l < prod10) res.h++;
+ res.h += x.l * y.h + x.h * y.l;
+ return res;
+}
+
+#define I64_is_zero(x) (((x).l | (x).h) == 0)
+#define I64_is_negative(x) ((int32) (x).h < 0)
+#define I64_is_min_int(x) ((x).l == 0 && (x).h == 0x80000000U)
+#define I64_is_minus_one(x) (((x).l & (x).h) == 0xFFFFFFFFU)
+
+/* Bitwise operations */
+static int64 I64_and(int64 x, int64 y)
+{
+ int64 res;
+ res.l = x.l & y.l;
+ res.h = x.h & y.h;
+ return res;
+}
+
+static int64 I64_or(int64 x, int64 y)
+{
+ int64 res;
+ res.l = x.l | y.l;
+ res.h = x.h | y.h;
+ return res;
+}
+
+static int64 I64_xor(int64 x, int64 y)
+{
+ int64 res;
+ res.l = x.l ^ y.l;
+ res.h = x.h ^ y.h;
+ return res;
+}
+
+/* Shifts */
+static int64 I64_lsl(int64 x, int s)
+{
+ int64 res;
+ s = s & 63;
+ if (s == 0) return x;
+ if (s < 32) {
+ res.l = x.l << s;
+ res.h = (x.h << s) | (x.l >> (32 - s));
+ } else {
+ res.l = 0;
+ res.h = x.l << (s - 32);
+ }
+ return res;
+}
+
+static int64 I64_lsr(int64 x, int s)
+{
+ int64 res;
+ s = s & 63;
+ if (s == 0) return x;
+ if (s < 32) {
+ res.l = (x.l >> s) | (x.h << (32 - s));
+ res.h = x.h >> s;
+ } else {
+ res.l = x.h >> (s - 32);
+ res.h = 0;
+ }
+ return res;
+}
+
+static int64 I64_asr(int64 x, int s)
+{
+ int64 res;
+ s = s & 63;
+ if (s == 0) return x;
+ if (s < 32) {
+ res.l = (x.l >> s) | (x.h << (32 - s));
+ res.h = (int32) x.h >> s;
+ } else {
+ res.l = (int32) x.h >> (s - 32);
+ res.h = (int32) x.h >> 31;
+ }
+ return res;
+}
+
+/* Division and modulus */
+
+#define I64_SHL1(x) x.h = (x.h << 1) | (x.l >> 31); x.l <<= 1
+#define I64_SHR1(x) x.l = (x.l >> 1) | (x.h << 31); x.h >>= 1
+
+static void I64_udivmod(uint64 modulus, uint64 divisor,
+ uint64 * quo, uint64 * mod)
+{
+ int64 quotient, mask;
+ int cmp;
+
+ quotient.h = 0; quotient.l = 0;
+ mask.h = 0; mask.l = 1;
+ while ((int32) divisor.h >= 0) {
+ cmp = I64_ucompare(divisor, modulus);
+ I64_SHL1(divisor);
+ I64_SHL1(mask);
+ if (cmp >= 0) break;
+ }
+ while (mask.l | mask.h) {
+ if (I64_ucompare(modulus, divisor) >= 0) {
+ quotient.h |= mask.h; quotient.l |= mask.l;
+ modulus = I64_sub(modulus, divisor);
+ }
+ I64_SHR1(mask);
+ I64_SHR1(divisor);
+ }
+ *quo = quotient;
+ *mod = modulus;
+}
+
+static int64 I64_div(int64 x, int64 y)
+{
+ int64 q, r;
+ int32 sign;
+
+ sign = x.h ^ y.h;
+ if ((int32) x.h < 0) x = I64_neg(x);
+ if ((int32) y.h < 0) y = I64_neg(y);
+ I64_udivmod(x, y, &q, &r);
+ if (sign < 0) q = I64_neg(q);
+ return q;
+}
+
+static int64 I64_mod(int64 x, int64 y)
+{
+ int64 q, r;
+ int32 sign;
+
+ sign = x.h;
+ if ((int32) x.h < 0) x = I64_neg(x);
+ if ((int32) y.h < 0) y = I64_neg(y);
+ I64_udivmod(x, y, &q, &r);
+ if (sign < 0) r = I64_neg(r);
+ return r;
+}
+
+/* Coercions */
+
+static int64 I64_of_int32(int32 x)
+{
+ int64 res;
+ res.l = x;
+ res.h = x >> 31;
+ return res;
+}
+
+#define I64_to_int32(x) ((int32) (x).l)
+
+/* Note: we assume sizeof(intnat) = 4 here, which is true otherwise
+ autoconfiguration would have selected native 64-bit integers */
+#define I64_of_intnat I64_of_int32
+#define I64_to_intnat I64_to_int32
+
+static double I64_to_double(int64 x)
+{
+ double res;
+ int32 sign = x.h;
+ if (sign < 0) x = I64_neg(x);
+ res = ldexp((double) x.h, 32) + x.l;
+ if (sign < 0) res = -res;
+ return res;
+}
+
+static int64 I64_of_double(double f)
+{
+ int64 res;
+ double frac, integ;
+ int neg;
+
+ neg = (f < 0);
+ f = fabs(f);
+ frac = modf(ldexp(f, -32), &integ);
+ res.h = (uint32) integ;
+ res.l = (uint32) ldexp(frac, 32);
+ if (neg) res = I64_neg(res);
+ 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 */
--- /dev/null
+/***********************************************************************/
+/* */
+/* 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. */
+/* */
+/***********************************************************************/
+
+/* printf-like formatting of 64-bit integers, in case the C library
+ printf() function does not support them. */
+
+#ifndef CAML_INT64_FORMAT_H
+#define CAML_INT64_FORMAT_H
+
+static void I64_format(char * buffer, char * fmt, int64 x)
+{
+ static char conv_lower[] = "0123456789abcdef";
+ static char conv_upper[] = "0123456789ABCDEF";
+ char rawbuffer[24];
+ char justify, signstyle, filler, alternate, signedconv;
+ int base, width, sign, i, rawlen;
+ char * cvtbl;
+ char * p, * r;
+ int64 wbase, digit;
+
+ /* Parsing of format */
+ justify = '+';
+ signstyle = '-';
+ filler = ' ';
+ alternate = 0;
+ base = 0;
+ signedconv = 0;
+ width = 0;
+ cvtbl = conv_lower;
+ for (p = fmt; *p != 0; p++) {
+ switch (*p) {
+ case '-':
+ justify = '-'; break;
+ case '+': case ' ':
+ signstyle = *p; break;
+ case '0':
+ filler = '0'; break;
+ case '#':
+ alternate = 1; break;
+ case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ width = atoi(p);
+ while (p[1] >= '0' && p[1] <= '9') p++;
+ break;
+ case 'd': case 'i':
+ signedconv = 1; /* fallthrough */
+ case 'u':
+ base = 10; break;
+ case 'x':
+ base = 16; break;
+ case 'X':
+ base = 16; cvtbl = conv_upper; break;
+ case 'o':
+ base = 8; break;
+ }
+ }
+ if (base == 0) { buffer[0] = 0; return; }
+ /* Do the conversion */
+ sign = 1;
+ if (signedconv && I64_is_negative(x)) { sign = -1; x = I64_neg(x); }
+ r = rawbuffer + sizeof(rawbuffer);
+ wbase = I64_of_int32(base);
+ do {
+ I64_udivmod(x, wbase, &x, &digit);
+ *--r = cvtbl[I64_to_int32(digit)];
+ } while (! I64_is_zero(x));
+ rawlen = rawbuffer + sizeof(rawbuffer) - r;
+ /* Adjust rawlen to reflect additional chars (sign, etc) */
+ if (signedconv && (sign < 0 || signstyle != '-')) rawlen++;
+ if (alternate) {
+ if (base == 8) rawlen += 1;
+ if (base == 16) rawlen += 2;
+ }
+ /* Do the formatting */
+ p = buffer;
+ if (justify == '+' && filler == ' ') {
+ for (i = rawlen; i < width; i++) *p++ = ' ';
+ }
+ if (signedconv) {
+ if (sign < 0) *p++ = '-';
+ else if (signstyle != '-') *p++ = signstyle;
+ }
+ if (alternate && base == 8) *p++ = '0';
+ if (alternate && base == 16) { *p++ = '0'; *p++ = 'x'; }
+ if (justify == '+' && filler == '0') {
+ for (i = rawlen; i < width; i++) *p++ = '0';
+ }
+ while (r < rawbuffer + sizeof(rawbuffer)) *p++ = *r++;
+ if (justify == '-') {
+ for (i = rawlen; i < width; i++) *p++ = ' ';
+ }
+ *p = 0;
+}
+
+#endif /* CAML_INT64_FORMAT_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* 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. */
+/* */
+/***********************************************************************/
+
+/* Wrapper macros around native 64-bit integer arithmetic,
+ so that it has the same interface as the software emulation
+ provided in int64_emul.h */
+
+#ifndef CAML_INT64_NATIVE_H
+#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))
+#define I64_add(x,y) ((x) + (y))
+#define I64_sub(x,y) ((x) - (y))
+#define I64_mul(x,y) ((x) * (y))
+#define I64_is_zero(x) ((x) == 0)
+#define I64_is_negative(x) ((x) < 0)
+#define I64_is_min_int(x) ((x) == ((int64)1 << 63))
+#define I64_is_minus_one(x) ((x) == -1)
+
+#define I64_div(x,y) ((x) / (y))
+#define I64_mod(x,y) ((x) % (y))
+#define I64_udivmod(x,y,quo,rem) \
+ (*(rem) = (uint64)(x) % (uint64)(y), \
+ *(quo) = (uint64)(x) / (uint64)(y))
+#define I64_and(x,y) ((x) & (y))
+#define I64_or(x,y) ((x) | (y))
+#define I64_xor(x,y) ((x) ^ (y))
+#define I64_lsl(x,y) ((x) << (y))
+#define I64_asr(x,y) ((x) >> (y))
+#define I64_lsr(x,y) ((uint64)(x) >> (y))
+#define I64_to_intnat(x) ((intnat) (x))
+#define I64_of_intnat(x) ((intnat) (x))
+#define I64_to_int32(x) ((int32) (x))
+#define I64_of_int32(x) ((int64) (x))
+#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 */
--- /dev/null
+/***********************************************************************/
+/* */
+/* 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. */
+/* */
+/***********************************************************************/
+
+/* The bytecode interpreter */
+
+#ifndef CAML_INTERP_H
+#define CAML_INTERP_H
+
+#include "misc.h"
+#include "mlvalues.h"
+
+/* interpret a bytecode */
+value caml_interprete (code_t prog, asize_t prog_size);
+
+/* tell the runtime that a bytecode program might be needed */
+void caml_prepare_bytecode(code_t prog, asize_t prog_size);
+
+/* tell the runtime that a bytecode program is no more needed */
+void caml_release_bytecode(code_t prog, asize_t prog_size);
+
+#endif /* CAML_INTERP_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* 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. */
+/* */
+/***********************************************************************/
+
+/* Structured input/output */
+
+#ifndef CAML_INTEXT_H
+#define CAML_INTEXT_H
+
+#ifndef CAML_NAME_SPACE
+#include "compatibility.h"
+#endif
+#include "misc.h"
+#include "mlvalues.h"
+
+/* <private> */
+#include "io.h"
+
+/* Magic number */
+
+#define Intext_magic_number 0x8495A6BE
+
+/* Codes for the compact format */
+
+#define PREFIX_SMALL_BLOCK 0x80
+#define PREFIX_SMALL_INT 0x40
+#define PREFIX_SMALL_STRING 0x20
+#define CODE_INT8 0x0
+#define CODE_INT16 0x1
+#define CODE_INT32 0x2
+#define CODE_INT64 0x3
+#define CODE_SHARED8 0x4
+#define CODE_SHARED16 0x5
+#define CODE_SHARED32 0x6
+#define CODE_BLOCK32 0x8
+#define CODE_BLOCK64 0x13
+#define CODE_STRING8 0x9
+#define CODE_STRING32 0xA
+#define CODE_DOUBLE_BIG 0xB
+#define CODE_DOUBLE_LITTLE 0xC
+#define CODE_DOUBLE_ARRAY8_BIG 0xD
+#define CODE_DOUBLE_ARRAY8_LITTLE 0xE
+#define CODE_DOUBLE_ARRAY32_BIG 0xF
+#define CODE_DOUBLE_ARRAY32_LITTLE 0x7
+#define CODE_CODEPOINTER 0x10
+#define CODE_INFIXPOINTER 0x11
+#define CODE_CUSTOM 0x12
+
+#if ARCH_FLOAT_ENDIANNESS == 0x76543210
+#define CODE_DOUBLE_NATIVE CODE_DOUBLE_BIG
+#define CODE_DOUBLE_ARRAY8_NATIVE CODE_DOUBLE_ARRAY8_BIG
+#define CODE_DOUBLE_ARRAY32_NATIVE CODE_DOUBLE_ARRAY32_BIG
+#else
+#define CODE_DOUBLE_NATIVE CODE_DOUBLE_LITTLE
+#define CODE_DOUBLE_ARRAY8_NATIVE CODE_DOUBLE_ARRAY8_LITTLE
+#define CODE_DOUBLE_ARRAY32_NATIVE CODE_DOUBLE_ARRAY32_LITTLE
+#endif
+
+/* Size-ing data structures for extern. Chosen so that
+ sizeof(struct trail_block) and sizeof(struct output_block)
+ are slightly below 8Kb. */
+
+#define ENTRIES_PER_TRAIL_BLOCK 1025
+#define SIZE_EXTERN_OUTPUT_BLOCK 8100
+
+/* The entry points */
+
+void caml_output_val (struct channel * chan, value v, value flags);
+ /* Output [v] with flags [flags] on the channel [chan]. */
+
+/* </private> */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+CAMLextern void caml_output_value_to_malloc(value v, value flags,
+ /*out*/ char ** buf,
+ /*out*/ intnat * len);
+ /* Output [v] with flags [flags] to a memory buffer allocated with
+ malloc. On return, [*buf] points to the buffer and [*len]
+ contains the number of bytes in buffer. */
+CAMLextern intnat caml_output_value_to_block(value v, value flags,
+ char * data, intnat len);
+ /* Output [v] with flags [flags] to a user-provided memory buffer.
+ [data] points to the start of this buffer, and [len] is its size
+ in bytes. Return the number of bytes actually written in buffer.
+ Raise [Failure] if buffer is too short. */
+
+/* <private> */
+value caml_input_val (struct channel * chan);
+ /* Read a structured value from the channel [chan]. */
+/* </private> */
+
+CAMLextern value caml_input_val_from_string (value str, intnat ofs);
+ /* 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
+ to the beginning of the buffer, and [ofs] is the offset of the
+ beginning of the externed data in this buffer. The buffer is
+ deallocated with [free] on return, or if an exception is raised. */
+CAMLextern value caml_input_value_from_block(char * data, intnat len);
+ /* Read a structured value from a user-provided buffer. [data] points
+ to the beginning of the externed data in this buffer,
+ and [len] is the length in bytes of valid data in this buffer.
+ The buffer is never deallocated by this routine. */
+
+/* Functions for writing user-defined marshallers */
+
+CAMLextern void caml_serialize_int_1(int i);
+CAMLextern void caml_serialize_int_2(int i);
+CAMLextern void caml_serialize_int_4(int32 i);
+CAMLextern void caml_serialize_int_8(int64 i);
+CAMLextern void caml_serialize_float_4(float f);
+CAMLextern void caml_serialize_float_8(double f);
+CAMLextern void caml_serialize_block_1(void * data, intnat len);
+CAMLextern void caml_serialize_block_2(void * data, intnat len);
+CAMLextern void caml_serialize_block_4(void * data, intnat len);
+CAMLextern void caml_serialize_block_8(void * data, intnat len);
+CAMLextern void caml_serialize_block_float_8(void * data, intnat len);
+
+CAMLextern int caml_deserialize_uint_1(void);
+CAMLextern int caml_deserialize_sint_1(void);
+CAMLextern int caml_deserialize_uint_2(void);
+CAMLextern int caml_deserialize_sint_2(void);
+CAMLextern uint32 caml_deserialize_uint_4(void);
+CAMLextern int32 caml_deserialize_sint_4(void);
+CAMLextern uint64 caml_deserialize_uint_8(void);
+CAMLextern int64 caml_deserialize_sint_8(void);
+CAMLextern float caml_deserialize_float_4(void);
+CAMLextern double caml_deserialize_float_8(void);
+CAMLextern void caml_deserialize_block_1(void * data, intnat len);
+CAMLextern void caml_deserialize_block_2(void * data, intnat len);
+CAMLextern void caml_deserialize_block_4(void * data, intnat len);
+CAMLextern void caml_deserialize_block_8(void * data, intnat len);
+CAMLextern void caml_deserialize_block_float_8(void * data, intnat len);
+CAMLextern void caml_deserialize_error(char * msg);
+
+/* <private> */
+
+/* Auxiliary stuff for sending code pointers */
+
+struct code_fragment {
+ char * code_start;
+ char * code_end;
+ unsigned char digest[16];
+ char digest_computed;
+};
+
+struct ext_table caml_code_fragments_table;
+
+/* </private> */
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_INTEXT_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* 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. */
+/* */
+/***********************************************************************/
+
+/* Buffered input/output */
+
+#ifndef CAML_IO_H
+#define CAML_IO_H
+
+#include "misc.h"
+#include "mlvalues.h"
+
+#ifndef IO_BUFFER_SIZE
+#define IO_BUFFER_SIZE 65536
+#endif
+
+#if defined(_WIN32)
+typedef __int64 file_offset;
+#elif defined(HAS_OFF_T)
+#include <sys/types.h>
+typedef off_t file_offset;
+#else
+typedef long file_offset;
+#endif
+
+struct channel {
+ int fd; /* Unix file descriptor */
+ file_offset offset; /* Absolute position of fd in the file */
+ char * end; /* Physical end of the buffer */
+ char * curr; /* Current position in the buffer */
+ char * max; /* Logical end of the buffer (for input) */
+ void * mutex; /* Placeholder for mutex (for systhreads) */
+ struct channel * next, * prev;/* Double chaining of channels (flush_all) */
+ int revealed; /* For Cash only */
+ int old_revealed; /* For Cash only */
+ int refcount; /* For flush_all and for Cash */
+ int flags; /* Bitfield */
+ char buff[IO_BUFFER_SIZE]; /* The buffer itself */
+};
+
+enum {
+ CHANNEL_FLAG_FROM_SOCKET = 1 /* For Windows */
+};
+
+/* For an output channel:
+ [offset] is the absolute position of the beginning of the buffer [buff].
+ For an input channel:
+ [offset] is the absolute position of the logical end of the buffer, [max].
+*/
+
+/* Functions and macros that can be called from C. Take arguments of
+ type struct channel *. No locking is performed. */
+
+#define putch(channel, ch) do{ \
+ if ((channel)->curr >= (channel)->end) caml_flush_partial(channel); \
+ *((channel)->curr)++ = (ch); \
+}while(0)
+
+#define getch(channel) \
+ ((channel)->curr >= (channel)->max \
+ ? caml_refill(channel) \
+ : (unsigned char) *((channel)->curr)++)
+
+CAMLextern struct channel * caml_open_descriptor_in (int);
+CAMLextern struct channel * caml_open_descriptor_out (int);
+CAMLextern void caml_close_channel (struct channel *);
+CAMLextern int caml_channel_binary_mode (struct channel *);
+CAMLextern value caml_alloc_channel(struct channel *chan);
+
+CAMLextern int caml_flush_partial (struct channel *);
+CAMLextern void caml_flush (struct channel *);
+CAMLextern void caml_putword (struct channel *, uint32);
+CAMLextern int caml_putblock (struct channel *, char *, intnat);
+CAMLextern void caml_really_putblock (struct channel *, char *, intnat);
+
+CAMLextern unsigned char caml_refill (struct channel *);
+CAMLextern uint32 caml_getword (struct channel *);
+CAMLextern int caml_getblock (struct channel *, char *, intnat);
+CAMLextern int caml_really_getblock (struct channel *, char *, intnat);
+
+/* Extract a struct channel * from the heap object representing it */
+
+#define Channel(v) (*((struct channel **) (Data_custom_val(v))))
+
+/* The locking machinery */
+
+CAMLextern void (*caml_channel_mutex_free) (struct channel *);
+CAMLextern void (*caml_channel_mutex_lock) (struct channel *);
+CAMLextern void (*caml_channel_mutex_unlock) (struct channel *);
+CAMLextern void (*caml_channel_mutex_unlock_exn) (void);
+
+CAMLextern struct channel * caml_all_opened_channels;
+
+#define Lock(channel) \
+ if (caml_channel_mutex_lock != NULL) (*caml_channel_mutex_lock)(channel)
+#define Unlock(channel) \
+ if (caml_channel_mutex_unlock != NULL) (*caml_channel_mutex_unlock)(channel)
+#define Unlock_exn() \
+ if (caml_channel_mutex_unlock_exn != NULL) (*caml_channel_mutex_unlock_exn)()
+
+/* Conversion between file_offset and int64 */
+
+#define Val_file_offset(fofs) caml_copy_int64(fofs)
+#define File_offset_val(v) ((file_offset) Int64_val(v))
+
+#endif /* CAML_IO_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Damien Doligez, projet Para, 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. */
+/* */
+/***********************************************************************/
+
+#ifndef CAML_MAJOR_GC_H
+#define CAML_MAJOR_GC_H
+
+
+#include "freelist.h"
+#include "misc.h"
+
+typedef struct {
+ void *block; /* address of the malloced block this chunk live in */
+ asize_t alloc; /* in bytes, used for compaction */
+ asize_t size; /* in bytes */
+ char *next;
+} heap_chunk_head;
+
+#define Chunk_size(c) (((heap_chunk_head *) (c)) [-1]).size
+#define Chunk_alloc(c) (((heap_chunk_head *) (c)) [-1]).alloc
+#define Chunk_next(c) (((heap_chunk_head *) (c)) [-1]).next
+#define Chunk_block(c) (((heap_chunk_head *) (c)) [-1]).block
+
+extern int caml_gc_phase;
+extern int caml_gc_subphase;
+extern uintnat caml_allocated_words;
+extern double caml_extra_heap_resources;
+extern uintnat caml_dependent_size, caml_dependent_allocated;
+extern uintnat caml_fl_size_at_phase_change;
+
+#define Phase_mark 0
+#define Phase_sweep 1
+#define Phase_idle 2
+#define Subphase_main 10
+#define Subphase_weak1 11
+#define Subphase_weak2 12
+#define Subphase_final 13
+
+CAMLextern char *caml_heap_start;
+extern uintnat total_heap_size;
+extern char *caml_gc_sweep_hp;
+
+void caml_init_major_heap (asize_t); /* size in bytes */
+asize_t caml_round_heap_chunk_size (asize_t); /* size in bytes */
+void caml_darken (value, value *);
+intnat caml_major_collection_slice (intnat);
+void major_collection (void);
+void caml_finish_major_cycle (void);
+
+
+#endif /* CAML_MAJOR_GC_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* 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. */
+/* */
+/***********************************************************************/
+
+/* MD5 message digest */
+
+#ifndef CAML_MD5_H
+#define CAML_MD5_H
+
+
+#include "mlvalues.h"
+#include "io.h"
+
+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];
+ uint32 bits[2];
+ unsigned char in[64];
+};
+
+CAMLextern void caml_MD5Init (struct MD5Context *context);
+CAMLextern void caml_MD5Update (struct MD5Context *context, unsigned char *buf,
+ uintnat len);
+CAMLextern void caml_MD5Final (unsigned char *digest, struct MD5Context *ctx);
+CAMLextern void caml_MD5Transform (uint32 *buf, uint32 *in);
+
+
+#endif /* CAML_MD5_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Damien Doligez, projet Para, 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. */
+/* */
+/***********************************************************************/
+
+/* Allocation macros and functions */
+
+#ifndef CAML_MEMORY_H
+#define CAML_MEMORY_H
+
+#ifndef CAML_NAME_SPACE
+#include "compatibility.h"
+#endif
+#include "config.h"
+/* <private> */
+#include "gc.h"
+#include "major_gc.h"
+#include "minor_gc.h"
+/* </private> */
+#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);
+CAMLextern void caml_free_dependent_memory (mlsize_t);
+CAMLextern void caml_modify (value *, value);
+CAMLextern void caml_initialize (value *, value);
+CAMLextern value caml_check_urgent_gc (value);
+CAMLextern void * caml_stat_alloc (asize_t); /* Size in bytes. */
+CAMLextern void caml_stat_free (void *);
+CAMLextern void * caml_stat_resize (void *, asize_t); /* Size in bytes. */
+char *caml_alloc_for_heap (asize_t request); /* Size in bytes. */
+void caml_free_for_heap (char *mem);
+int caml_add_to_heap (char *mem);
+color_t caml_allocation_color (void *hp);
+
+/* void caml_shrink_heap (char *); Only used in compact.c */
+
+/* <private> */
+
+#ifdef DEBUG
+#define DEBUG_clear(result, wosize) do{ \
+ uintnat caml__DEBUG_i; \
+ for (caml__DEBUG_i = 0; caml__DEBUG_i < (wosize); ++ caml__DEBUG_i){ \
+ Field ((result), caml__DEBUG_i) = Debug_uninit_minor; \
+ } \
+}while(0)
+#else
+#define DEBUG_clear(result, wosize)
+#endif
+
+#define Alloc_small(result, wosize, tag) do{ CAMLassert ((wosize) >= 1); \
+ CAMLassert ((tag_t) (tag) < 256); \
+ CAMLassert ((wosize) <= Max_young_wosize); \
+ caml_young_ptr -= Bhsize_wosize (wosize); \
+ if (caml_young_ptr < caml_young_start){ \
+ caml_young_ptr += Bhsize_wosize (wosize); \
+ Setup_for_gc; \
+ caml_minor_collection (); \
+ Restore_after_gc; \
+ caml_young_ptr -= Bhsize_wosize (wosize); \
+ } \
+ Hd_hp (caml_young_ptr) = Make_header ((wosize), (tag), Caml_black); \
+ (result) = Val_hp (caml_young_ptr); \
+ DEBUG_clear ((result), (wosize)); \
+}while(0)
+
+/* Deprecated alias for [caml_modify] */
+
+#define Modify(fp,val) caml_modify((fp), (val))
+
+/* </private> */
+
+struct caml__roots_block {
+ struct caml__roots_block *next;
+ intnat ntables;
+ intnat nitems;
+ value *tables [5];
+};
+
+CAMLextern struct caml__roots_block *caml_local_roots; /* defined in roots.c */
+
+/* The following macros are used to declare C local variables and
+ function parameters of type [value].
+
+ The function body must start with one of the [CAMLparam] macros.
+ If the function has no parameter of type [value], use [CAMLparam0].
+ If the function has 1 to 5 [value] parameters, use the corresponding
+ [CAMLparam] with the parameters as arguments.
+ If the function has more than 5 [value] parameters, use [CAMLparam5]
+ for the first 5 parameters, and one or more calls to the [CAMLxparam]
+ macros for the others.
+ If the function takes an array of [value]s as argument, use
+ [CAMLparamN] to declare it (or [CAMLxparamN] if you already have a
+ call to [CAMLparam] for some other arguments).
+
+ 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, 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 OCaml.
+ Do not use them for anything (local or global variables, struct or
+ union tags, macros, etc.)
+*/
+
+#define CAMLparam0() \
+ struct caml__roots_block *caml__frame = caml_local_roots
+
+#define CAMLparam1(x) \
+ CAMLparam0 (); \
+ CAMLxparam1 (x)
+
+#define CAMLparam2(x, y) \
+ CAMLparam0 (); \
+ CAMLxparam2 (x, y)
+
+#define CAMLparam3(x, y, z) \
+ CAMLparam0 (); \
+ CAMLxparam3 (x, y, z)
+
+#define CAMLparam4(x, y, z, t) \
+ CAMLparam0 (); \
+ CAMLxparam4 (x, y, z, t)
+
+#define CAMLparam5(x, y, z, t, u) \
+ CAMLparam0 (); \
+ CAMLxparam5 (x, y, z, t, u)
+
+#define CAMLparamN(x, size) \
+ CAMLparam0 (); \
+ CAMLxparamN (x, (size))
+
+
+#if defined(__GNUC__) && (__GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ > 7))
+ #define CAMLunused __attribute__ ((unused))
+#else
+ #define CAMLunused
+#endif
+
+#define CAMLxparam1(x) \
+ struct caml__roots_block caml__roots_##x; \
+ CAMLunused int caml__dummy_##x = ( \
+ (caml__roots_##x.next = caml_local_roots), \
+ (caml_local_roots = &caml__roots_##x), \
+ (caml__roots_##x.nitems = 1), \
+ (caml__roots_##x.ntables = 1), \
+ (caml__roots_##x.tables [0] = &x), \
+ 0)
+
+#define CAMLxparam2(x, y) \
+ struct caml__roots_block caml__roots_##x; \
+ CAMLunused int caml__dummy_##x = ( \
+ (caml__roots_##x.next = caml_local_roots), \
+ (caml_local_roots = &caml__roots_##x), \
+ (caml__roots_##x.nitems = 1), \
+ (caml__roots_##x.ntables = 2), \
+ (caml__roots_##x.tables [0] = &x), \
+ (caml__roots_##x.tables [1] = &y), \
+ 0)
+
+#define CAMLxparam3(x, y, z) \
+ struct caml__roots_block caml__roots_##x; \
+ CAMLunused int caml__dummy_##x = ( \
+ (caml__roots_##x.next = caml_local_roots), \
+ (caml_local_roots = &caml__roots_##x), \
+ (caml__roots_##x.nitems = 1), \
+ (caml__roots_##x.ntables = 3), \
+ (caml__roots_##x.tables [0] = &x), \
+ (caml__roots_##x.tables [1] = &y), \
+ (caml__roots_##x.tables [2] = &z), \
+ 0)
+
+#define CAMLxparam4(x, y, z, t) \
+ struct caml__roots_block caml__roots_##x; \
+ CAMLunused int caml__dummy_##x = ( \
+ (caml__roots_##x.next = caml_local_roots), \
+ (caml_local_roots = &caml__roots_##x), \
+ (caml__roots_##x.nitems = 1), \
+ (caml__roots_##x.ntables = 4), \
+ (caml__roots_##x.tables [0] = &x), \
+ (caml__roots_##x.tables [1] = &y), \
+ (caml__roots_##x.tables [2] = &z), \
+ (caml__roots_##x.tables [3] = &t), \
+ 0)
+
+#define CAMLxparam5(x, y, z, t, u) \
+ struct caml__roots_block caml__roots_##x; \
+ CAMLunused int caml__dummy_##x = ( \
+ (caml__roots_##x.next = caml_local_roots), \
+ (caml_local_roots = &caml__roots_##x), \
+ (caml__roots_##x.nitems = 1), \
+ (caml__roots_##x.ntables = 5), \
+ (caml__roots_##x.tables [0] = &x), \
+ (caml__roots_##x.tables [1] = &y), \
+ (caml__roots_##x.tables [2] = &z), \
+ (caml__roots_##x.tables [3] = &t), \
+ (caml__roots_##x.tables [4] = &u), \
+ 0)
+
+#define CAMLxparamN(x, size) \
+ struct caml__roots_block caml__roots_##x; \
+ CAMLunused int caml__dummy_##x = ( \
+ (caml__roots_##x.next = caml_local_roots), \
+ (caml_local_roots = &caml__roots_##x), \
+ (caml__roots_##x.nitems = (size)), \
+ (caml__roots_##x.ntables = 1), \
+ (caml__roots_##x.tables[0] = &(x[0])), \
+ 0)
+
+#define CAMLlocal1(x) \
+ value x = Val_unit; \
+ CAMLxparam1 (x)
+
+#define CAMLlocal2(x, y) \
+ value x = Val_unit, y = Val_unit; \
+ CAMLxparam2 (x, y)
+
+#define CAMLlocal3(x, y, z) \
+ value x = Val_unit, y = Val_unit, z = Val_unit; \
+ CAMLxparam3 (x, y, z)
+
+#define CAMLlocal4(x, y, z, t) \
+ value x = Val_unit, y = Val_unit, z = Val_unit, t = Val_unit; \
+ CAMLxparam4 (x, y, z, t)
+
+#define CAMLlocal5(x, y, z, t, u) \
+ value x = Val_unit, y = Val_unit, z = Val_unit, t = Val_unit, u = Val_unit; \
+ CAMLxparam5 (x, y, z, t, u)
+
+#define CAMLlocalN(x, size) \
+ value x [(size)]; \
+ int caml__i_##x; \
+ for (caml__i_##x = 0; caml__i_##x < size; caml__i_##x ++) { \
+ x[caml__i_##x] = Val_unit; \
+ } \
+ CAMLxparamN (x, (size))
+
+
+#define CAMLreturn0 do{ \
+ caml_local_roots = caml__frame; \
+ return; \
+}while (0)
+
+#define CAMLreturnT(type, result) do{ \
+ type caml__temp_result = (result); \
+ caml_local_roots = caml__frame; \
+ return (caml__temp_result); \
+}while(0)
+
+#define CAMLreturn(result) CAMLreturnT(value, result)
+
+#define CAMLnoreturn ((void) caml__frame)
+
+
+/* convenience macro */
+#define Store_field(block, offset, val) do{ \
+ mlsize_t caml__temp_offset = (offset); \
+ value caml__temp_val = (val); \
+ caml_modify (&Field ((block), caml__temp_offset), caml__temp_val); \
+}while(0)
+
+/*
+ NOTE: [Begin_roots] and [End_roots] are superseded by [CAMLparam]*,
+ [CAMLxparam]*, [CAMLlocal]*, [CAMLreturn].
+
+ [Begin_roots] and [End_roots] are used for C variables that are GC roots.
+ 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 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.
+ At the end, insert [End_roots()].
+
+ Note that [Begin_roots] opens a new block, and [End_roots] closes it.
+ Thus they must occur in matching pairs at the same brace nesting level.
+
+ You can use [Val_unit] as a dummy initial value for your variables.
+*/
+
+#define Begin_root Begin_roots1
+
+#define Begin_roots1(r0) { \
+ struct caml__roots_block caml__roots_block; \
+ caml__roots_block.next = caml_local_roots; \
+ caml_local_roots = &caml__roots_block; \
+ caml__roots_block.nitems = 1; \
+ caml__roots_block.ntables = 1; \
+ caml__roots_block.tables[0] = &(r0);
+
+#define Begin_roots2(r0, r1) { \
+ struct caml__roots_block caml__roots_block; \
+ caml__roots_block.next = caml_local_roots; \
+ caml_local_roots = &caml__roots_block; \
+ caml__roots_block.nitems = 1; \
+ caml__roots_block.ntables = 2; \
+ caml__roots_block.tables[0] = &(r0); \
+ caml__roots_block.tables[1] = &(r1);
+
+#define Begin_roots3(r0, r1, r2) { \
+ struct caml__roots_block caml__roots_block; \
+ caml__roots_block.next = caml_local_roots; \
+ caml_local_roots = &caml__roots_block; \
+ caml__roots_block.nitems = 1; \
+ caml__roots_block.ntables = 3; \
+ caml__roots_block.tables[0] = &(r0); \
+ caml__roots_block.tables[1] = &(r1); \
+ caml__roots_block.tables[2] = &(r2);
+
+#define Begin_roots4(r0, r1, r2, r3) { \
+ struct caml__roots_block caml__roots_block; \
+ caml__roots_block.next = caml_local_roots; \
+ caml_local_roots = &caml__roots_block; \
+ caml__roots_block.nitems = 1; \
+ caml__roots_block.ntables = 4; \
+ caml__roots_block.tables[0] = &(r0); \
+ caml__roots_block.tables[1] = &(r1); \
+ caml__roots_block.tables[2] = &(r2); \
+ caml__roots_block.tables[3] = &(r3);
+
+#define Begin_roots5(r0, r1, r2, r3, r4) { \
+ struct caml__roots_block caml__roots_block; \
+ caml__roots_block.next = caml_local_roots; \
+ caml_local_roots = &caml__roots_block; \
+ caml__roots_block.nitems = 1; \
+ caml__roots_block.ntables = 5; \
+ caml__roots_block.tables[0] = &(r0); \
+ caml__roots_block.tables[1] = &(r1); \
+ caml__roots_block.tables[2] = &(r2); \
+ caml__roots_block.tables[3] = &(r3); \
+ caml__roots_block.tables[4] = &(r4);
+
+#define Begin_roots_block(table, size) { \
+ struct caml__roots_block caml__roots_block; \
+ caml__roots_block.next = caml_local_roots; \
+ caml_local_roots = &caml__roots_block; \
+ caml__roots_block.nitems = (size); \
+ caml__roots_block.ntables = 1; \
+ caml__roots_block.tables[0] = (table);
+
+#define End_roots() caml_local_roots = caml__roots_block.next; }
+
+
+/* [caml_register_global_root] registers a global C variable as a memory root
+ for the duration of the program, or until [caml_remove_global_root] is
+ called. */
+
+CAMLextern void caml_register_global_root (value *);
+
+/* [caml_remove_global_root] removes a memory root registered on a global C
+ variable with [caml_register_global_root]. */
+
+CAMLextern void caml_remove_global_root (value *);
+
+/* [caml_register_generational_global_root] registers a global C
+ variable as a memory root for the duration of the program, or until
+ [caml_remove_generational_global_root] is called.
+ The program guarantees that the value contained in this variable
+ will not be assigned directly. If the program needs to change
+ 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 OCaml value before the call.
+ In return for these constraints, scanning of memory roots during
+ minor collection is made more efficient. */
+
+CAMLextern void caml_register_generational_global_root (value *);
+
+/* [caml_remove_generational_global_root] removes a memory root
+ registered on a global C variable with
+ [caml_register_generational_global_root]. */
+
+CAMLextern void caml_remove_generational_global_root (value *);
+
+/* [caml_modify_generational_global_root(r, newval)]
+ modifies the value contained in [r], storing [newval] inside.
+ In other words, the assignment [*r = newval] is performed,
+ but in a way that is compatible with the optimized scanning of
+ generational global roots. [r] must be a global memory root
+ previously registered with [caml_register_generational_global_root]. */
+
+CAMLextern void caml_modify_generational_global_root(value *r, value newval);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_MEMORY_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Damien Doligez, projet Para, 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. */
+/* */
+/***********************************************************************/
+
+#ifndef CAML_MINOR_GC_H
+#define CAML_MINOR_GC_H
+
+
+#include "address_class.h"
+
+CAMLextern char *caml_young_start, *caml_young_ptr;
+CAMLextern char *caml_young_end, *caml_young_limit;
+extern asize_t caml_minor_heap_size;
+extern int caml_in_minor_collection;
+
+struct caml_ref_table {
+ value **base;
+ value **end;
+ value **threshold;
+ value **ptr;
+ value **limit;
+ asize_t size;
+ asize_t reserve;
+};
+CAMLextern struct caml_ref_table caml_ref_table, caml_weak_ref_table;
+
+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 */
+extern void caml_realloc_ref_table (struct caml_ref_table *);
+extern void caml_alloc_table (struct caml_ref_table *, asize_t, asize_t);
+extern void caml_oldify_one (value, value *);
+extern void caml_oldify_mopup (void);
+
+#define Oldify(p) do{ \
+ value __oldify__v__ = *p; \
+ if (Is_block (__oldify__v__) && Is_young (__oldify__v__)){ \
+ caml_oldify_one (__oldify__v__, (p)); \
+ } \
+ }while(0)
+
+#endif /* CAML_MINOR_GC_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Xavier Leroy and Damien Doligez, 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. */
+/* */
+/***********************************************************************/
+
+/* Miscellaneous macros and variables. */
+
+#ifndef CAML_MISC_H
+#define CAML_MISC_H
+
+#ifndef CAML_NAME_SPACE
+#include "compatibility.h"
+#endif
+#include "config.h"
+
+/* Standard definitions */
+
+#include <stddef.h>
+#include <stdlib.h>
+
+/* Basic types and constants */
+
+typedef size_t asize_t;
+
+#ifndef NULL
+#define NULL 0
+#endif
+
+/* <private> */
+typedef char * addr;
+/* </private> */
+
+#ifdef __GNUC__
+ /* Works only in GCC 2.5 and later */
+ #define Noreturn __attribute__ ((noreturn))
+#else
+ #define Noreturn
+#endif
+
+/* Export control (to mark primitives and to handle Windows DLL) */
+
+#define CAMLexport
+#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
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* GC timing hooks. These can be assigned by the user. The hook functions
+ must not allocate or change the heap in any way. */
+typedef void (*caml_timing_hook) (void);
+extern caml_timing_hook caml_major_slice_begin_hook, caml_major_slice_end_hook;
+extern caml_timing_hook caml_minor_gc_begin_hook, caml_minor_gc_end_hook;
+extern caml_timing_hook caml_finalise_begin_hook, caml_finalise_end_hook;
+
+/* Assertions */
+
+#ifdef DEBUG
+#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)
+#endif
+
+CAMLextern void caml_fatal_error (char *msg) Noreturn;
+CAMLextern void caml_fatal_error_arg (char *fmt, char *arg) Noreturn;
+CAMLextern void caml_fatal_error_arg2 (char *fmt1, char *arg1,
+ char *fmt2, char *arg2) Noreturn;
+
+/* Safe string operations */
+
+CAMLextern char * caml_strdup(const char * s);
+CAMLextern char * caml_strconcat(int n, ...); /* n args of const char * type */
+
+/* <private> */
+
+/* Data structures */
+
+struct ext_table {
+ int size;
+ int capacity;
+ void ** contents;
+};
+
+extern void caml_ext_table_init(struct ext_table * tbl, int init_capa);
+extern int caml_ext_table_add(struct ext_table * tbl, void * data);
+extern void caml_ext_table_free(struct ext_table * tbl, int free_entries);
+
+/* GC flags and messages */
+
+extern uintnat caml_verb_gc;
+void caml_gc_message (int, char *, uintnat);
+
+/* Memory routines */
+
+char *caml_aligned_malloc (asize_t, int, void **);
+
+#ifdef DEBUG
+#ifdef ARCH_SIXTYFOUR
+#define Debug_tag(x) (0xD700D7D7D700D6D7ul \
+ | ((uintnat) (x) << 16) \
+ | ((uintnat) (x) << 48))
+#else
+#define Debug_tag(x) (0xD700D6D7ul | ((uintnat) (x) << 16))
+#endif /* ARCH_SIXTYFOUR */
+
+/*
+ 00 -> free words in minor heap
+ 01 -> fields of free list blocks in major heap
+ 03 -> heap chunks deallocated by heap shrinking
+ 04 -> fields deallocated by [caml_obj_truncate]
+ 10 -> uninitialised fields of minor objects
+ 11 -> uninitialised fields of major objects
+ 15 -> uninitialised words of [caml_aligned_malloc] blocks
+ 85 -> filler bytes of [caml_aligned_malloc]
+
+ special case (byte by byte):
+ D7 -> uninitialised words of [caml_stat_alloc] blocks
+*/
+#define Debug_free_minor Debug_tag (0x00)
+#define Debug_free_major Debug_tag (0x01)
+#define Debug_free_shrink Debug_tag (0x03)
+#define Debug_free_truncate Debug_tag (0x04)
+#define Debug_uninit_minor Debug_tag (0x10)
+#define Debug_uninit_major Debug_tag (0x11)
+#define Debug_uninit_align Debug_tag (0x15)
+#define Debug_filler_align Debug_tag (0x85)
+
+#define Debug_uninit_stat 0xD7
+
+extern void caml_set_fields (char *, unsigned long, unsigned long);
+#endif /* DEBUG */
+
+
+#ifndef CAML_AVOID_CONFLICTS
+#define Assert CAMLassert
+#endif
+
+/* snprintf emulation for Win32 */
+
+#ifdef _WIN32
+extern int caml_snprintf(char * buf, size_t size, const char * format, ...);
+#define snprintf caml_snprintf
+#endif
+
+/* </private> */
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_MISC_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Xavier Leroy and Damien Doligez, 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. */
+/* */
+/***********************************************************************/
+
+#ifndef CAML_MLVALUES_H
+#define CAML_MLVALUES_H
+
+#ifndef CAML_NAME_SPACE
+#include "compatibility.h"
+#endif
+#include "config.h"
+#include "misc.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* Definitions
+
+ word: Four bytes on 32 and 16 bit architectures,
+ eight bytes on 64 bit architectures.
+ long: A C integer having the same number of bytes as a word.
+ val: The ML representation of something. A long or a block or a pointer
+ outside the heap. If it is a block, it is the (encoded) address
+ of an object. If it is a long, it is encoded as well.
+ block: Something allocated. It always has a header and some
+ fields or some number of bytes (a multiple of the word size).
+ field: A word-sized val which is part of a block.
+ bp: Pointer to the first byte of a block. (a char *)
+ op: Pointer to the first field of a block. (a value *)
+ hp: Pointer to the header of a block. (a char *)
+ int32: Four bytes on all architectures.
+ int64: Eight bytes on all architectures.
+
+ Remark: A block size is always a multiple of the word size, and at least
+ one word plus the header.
+
+ bosize: Size (in bytes) of the "bytes" part.
+ wosize: Size (in words) of the "fields" part.
+ bhsize: Size (in bytes) of the block with its header.
+ whsize: Size (in words) of the block with its header.
+
+ hd: A header.
+ tag: The value of the tag field of the header.
+ color: The value of the color field of the header.
+ This is for use only by the GC.
+*/
+
+typedef intnat value;
+typedef uintnat header_t;
+typedef uintnat mlsize_t;
+typedef unsigned int tag_t; /* Actually, an unsigned char */
+typedef uintnat color_t;
+typedef uintnat mark_t;
+
+/* Longs vs blocks. */
+#define Is_long(x) (((x) & 1) != 0)
+#define Is_block(x) (((x) & 1) == 0)
+
+/* Conversion macro names are always of the form "to_from". */
+/* Example: Val_long as in "Val from long" or "Val of long". */
+#define Val_long(x) (((intnat)(x) << 1) + 1)
+#define Long_val(x) ((x) >> 1)
+#define Max_long (((intnat)1 << (8 * sizeof(value) - 2)) - 1)
+#define Min_long (-((intnat)1 << (8 * sizeof(value) - 2)))
+#define Val_int(x) Val_long(x)
+#define Int_val(x) ((int) Long_val(x))
+#define Unsigned_long_val(x) ((uintnat)(x) >> 1)
+#define Unsigned_int_val(x) ((int) Unsigned_long_val(x))
+
+/* Structure of the header:
+
+For 16-bit and 32-bit architectures:
+ +--------+-------+-----+
+ | wosize | color | tag |
+ +--------+-------+-----+
+bits 31 10 9 8 7 0
+
+For 64-bit architectures:
+
+ +--------+-------+-----+
+ | wosize | color | tag |
+ +--------+-------+-----+
+bits 63 10 9 8 7 0
+
+*/
+
+#define Tag_hd(hd) ((tag_t) ((hd) & 0xFF))
+#define Wosize_hd(hd) ((mlsize_t) ((hd) >> 10))
+
+#define Hd_val(val) (((header_t *) (val)) [-1]) /* Also an l-value. */
+#define Hd_op(op) (Hd_val (op)) /* Also an l-value. */
+#define Hd_bp(bp) (Hd_val (bp)) /* Also an l-value. */
+#define Hd_hp(hp) (* ((header_t *) (hp))) /* Also an l-value. */
+#define Hp_val(val) ((char *) (((header_t *) (val)) - 1))
+#define Hp_op(op) (Hp_val (op))
+#define Hp_bp(bp) (Hp_val (bp))
+#define Val_op(op) ((value) (op))
+#define Val_hp(hp) ((value) (((header_t *) (hp)) + 1))
+#define Op_hp(hp) ((value *) Val_hp (hp))
+#define Bp_hp(hp) ((char *) Val_hp (hp))
+
+#define Num_tags (1 << 8)
+#ifdef ARCH_SIXTYFOUR
+#define Max_wosize (((intnat)1 << 54) - 1)
+#else
+#define Max_wosize ((1 << 22) - 1)
+#endif
+
+#define Wosize_val(val) (Wosize_hd (Hd_val (val)))
+#define Wosize_op(op) (Wosize_val (op))
+#define Wosize_bp(bp) (Wosize_val (bp))
+#define Wosize_hp(hp) (Wosize_hd (Hd_hp (hp)))
+#define Whsize_wosize(sz) ((sz) + 1)
+#define Wosize_whsize(sz) ((sz) - 1)
+#define Wosize_bhsize(sz) ((sz) / sizeof (value) - 1)
+#define Bsize_wsize(sz) ((sz) * sizeof (value))
+#define Wsize_bsize(sz) ((sz) / sizeof (value))
+#define Bhsize_wosize(sz) (Bsize_wsize (Whsize_wosize (sz)))
+#define Bhsize_bosize(sz) ((sz) + sizeof (header_t))
+#define Bosize_val(val) (Bsize_wsize (Wosize_val (val)))
+#define Bosize_op(op) (Bosize_val (Val_op (op)))
+#define Bosize_bp(bp) (Bosize_val (Val_bp (bp)))
+#define Bosize_hd(hd) (Bsize_wsize (Wosize_hd (hd)))
+#define Whsize_hp(hp) (Whsize_wosize (Wosize_hp (hp)))
+#define Whsize_val(val) (Whsize_hp (Hp_val (val)))
+#define Whsize_bp(bp) (Whsize_val (Val_bp (bp)))
+#define Whsize_hd(hd) (Whsize_wosize (Wosize_hd (hd)))
+#define Bhsize_hp(hp) (Bsize_wsize (Whsize_hp (hp)))
+#define Bhsize_hd(hd) (Bsize_wsize (Whsize_hd (hd)))
+
+#ifdef ARCH_BIG_ENDIAN
+#define Tag_val(val) (((unsigned char *) (val)) [-1])
+ /* Also an l-value. */
+#define Tag_hp(hp) (((unsigned char *) (hp)) [sizeof(value)-1])
+ /* Also an l-value. */
+#else
+#define Tag_val(val) (((unsigned char *) (val)) [-sizeof(value)])
+ /* Also an l-value. */
+#define Tag_hp(hp) (((unsigned char *) (hp)) [0])
+ /* Also an l-value. */
+#endif
+
+/* The lowest tag for blocks containing no value. */
+#define No_scan_tag 251
+
+
+/* 1- If tag < No_scan_tag : a tuple of fields. */
+
+/* Pointer to the first field. */
+#define Op_val(x) ((value *) (x))
+/* Fields are numbered from 0. */
+#define Field(x, i) (((value *)(x)) [i]) /* Also an l-value. */
+
+typedef int32 opcode_t;
+typedef opcode_t * code_t;
+
+/* NOTE: [Forward_tag] and [Infix_tag] must be just under
+ [No_scan_tag], with [Infix_tag] the lower one.
+ See [caml_oldify_one] in minor_gc.c for more details.
+
+ NOTE: Update stdlib/obj.ml whenever you change the tags.
+ */
+
+/* Forward_tag: forwarding pointer that the GC may silently shortcut.
+ See stdlib/lazy.ml. */
+#define Forward_tag 250
+#define Forward_val(v) Field(v, 0)
+
+/* If tag == Infix_tag : an infix header inside a closure */
+/* Infix_tag must be odd so that the infix header is scanned as an integer */
+/* Infix_tag must be 1 modulo 4 and infix headers can only occur in blocks
+ with tag Closure_tag (see compact.c). */
+
+#define Infix_tag 249
+#define Infix_offset_hd(hd) (Bosize_hd(hd))
+#define Infix_offset_val(v) Infix_offset_hd(Hd_val(v))
+
+/* Another special case: objects */
+#define Object_tag 248
+#define Class_val(val) Field((val), 0)
+#define Oid_val(val) Long_val(Field((val), 1))
+CAMLextern value caml_get_public_method (value obj, value tag);
+/* Called as:
+ caml_callback(caml_get_public_method(obj, caml_hash_variant(name)), obj) */
+/* caml_get_public_method returns 0 if tag not in the table.
+ Note however that tags being hashed, same tag does not necessarily mean
+ same method name. */
+
+/* Special case of tuples of fields: closures */
+#define Closure_tag 247
+#define Code_val(val) (((code_t *) (val)) [0]) /* Also an l-value. */
+
+/* This tag is used (with Forward_tag) to implement lazy values.
+ See major_gc.c and stdlib/lazy.ml. */
+#define Lazy_tag 246
+
+/* Another special case: variants */
+CAMLextern value caml_hash_variant(char const * tag);
+
+/* 2- If tag >= No_scan_tag : a sequence of bytes. */
+
+/* Pointer to the first byte */
+#define Bp_val(v) ((char *) (v))
+#define Val_bp(p) ((value) (p))
+/* Bytes are numbered from 0. */
+#define Byte(x, i) (((char *) (x)) [i]) /* Also an l-value. */
+#define Byte_u(x, i) (((unsigned char *) (x)) [i]) /* Also an l-value. */
+
+/* Abstract things. Their contents is not traced by the GC; therefore they
+ must not contain any [value].
+*/
+#define Abstract_tag 251
+
+/* Strings. */
+#define String_tag 252
+#define String_val(x) ((char *) Bp_val(x))
+CAMLextern mlsize_t caml_string_length (value); /* size in bytes */
+
+/* Floating-point numbers. */
+#define Double_tag 253
+#define Double_wosize ((sizeof(double) / sizeof(value)))
+#ifndef ARCH_ALIGN_DOUBLE
+#define Double_val(v) (* (double *)(v))
+#define Store_double_val(v,d) (* (double *)(v) = (d))
+#else
+CAMLextern double caml_Double_val (value);
+CAMLextern void caml_Store_double_val (value,double);
+#define Double_val(v) caml_Double_val(v)
+#define Store_double_val(v,d) caml_Store_double_val(v,d)
+#endif
+
+/* Arrays of floating-point numbers. */
+#define Double_array_tag 254
+#define Double_field(v,i) Double_val((value)((double *)(v) + (i)))
+#define Store_double_field(v,i,d) do{ \
+ mlsize_t caml__temp_i = (i); \
+ 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)
+ followed by raw data. The contents of custom blocks is not traced by
+ the GC; therefore, they must not contain any [value].
+ See [custom.h] for operations on method suites. */
+#define Custom_tag 255
+#define Data_custom_val(v) ((void *) &Field((v), 1))
+struct custom_operations; /* defined in [custom.h] */
+
+/* Int32.t, Int64.t and Nativeint.t are represented as custom blocks. */
+
+#define Int32_val(v) (*((int32 *) Data_custom_val(v)))
+#define Nativeint_val(v) (*((intnat *) Data_custom_val(v)))
+#ifndef ARCH_ALIGN_INT64
+#define Int64_val(v) (*((int64 *) Data_custom_val(v)))
+#else
+CAMLextern int64 caml_Int64_val(value v);
+#define Int64_val(v) caml_Int64_val(v)
+#endif
+
+/* 3- Atoms are 0-tuples. They are statically allocated once and for all. */
+
+CAMLextern header_t caml_atom_table[];
+#define Atom(tag) (Val_hp (&(caml_atom_table [(tag)])))
+
+/* Booleans are integers 0 or 1 */
+
+#define Val_bool(x) Val_int((x) != 0)
+#define Bool_val(x) Int_val(x)
+#define Val_false Val_int(0)
+#define Val_true Val_int(1)
+#define Val_not(x) (Val_false + Val_true - (x))
+
+/* The unit value is 0 (tagged) */
+
+#define Val_unit Val_int(0)
+
+/* List constructors */
+#define Val_emptylist Val_int(0)
+#define Tag_cons 0
+
+/* The table of global identifiers */
+
+extern value caml_global_data;
+
+CAMLextern value caml_set_oo_id(value obj);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_MLVALUES_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* 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. */
+/* */
+/***********************************************************************/
+
+/* Operating system - specific stuff */
+
+#ifndef CAML_OSDEPS_H
+#define CAML_OSDEPS_H
+
+#include "misc.h"
+
+/* Decompose the given path into a list of directories, and add them
+ to the given table. Return the block to be freed later. */
+extern char * caml_decompose_path(struct ext_table * tbl, char * path);
+
+/* Search the given file in the given list of directories.
+ If not found, return a copy of [name]. Result is allocated with
+ [caml_stat_alloc]. */
+extern char * caml_search_in_path(struct ext_table * path, char * name);
+
+/* Same, but search an executable name in the system path for executables. */
+CAMLextern char * caml_search_exe_in_path(char * name);
+
+/* Same, but search a shared library in the given path. */
+extern char * caml_search_dll_in_path(struct ext_table * path, char * name);
+
+/* Open a shared library and return a handle on it.
+ If [for_execution] is true, perform full symbol resolution and
+ execute initialization code so that functions from the shared library
+ can be called. If [for_execution] is false, functions from this
+ shared library will not be called, but just checked for presence,
+ so symbol resolution can be skipped.
+ If [global] is true, symbols from the shared library can be used
+ to resolve for other libraries to be opened later on.
+ Return [NULL] on error. */
+extern void * caml_dlopen(char * libname, int for_execution, int global);
+
+/* Close a shared library handle */
+extern void caml_dlclose(void * handle);
+
+/* Look up the given symbol in the given shared library.
+ Return [NULL] if not found, or symbol value if found. */
+extern void * caml_dlsym(void * handle, char * name);
+
+extern void * caml_globalsym(char * name);
+
+/* Return an error message describing the most recent dynlink failure. */
+extern char * caml_dlerror(void);
+
+/* Add to [contents] the (short) names of the files contained in
+ the directory named [dirname]. No entries are added for [.] and [..].
+ Return 0 on success, -1 on error; set errno in the case of error. */
+extern int caml_read_directory(char * dirname, struct ext_table * contents);
+
+/* Recover executable name if possible (/proc/sef/exe under Linux,
+ GetModuleFileName under Windows). */
+extern int caml_executable_name(char * name, int name_len);
+
+#endif /* CAML_OSDEPS_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* 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. */
+/* */
+/***********************************************************************/
+
+/* Interface with C primitives. */
+
+#ifndef CAML_PRIMS_H
+#define CAML_PRIMS_H
+
+typedef value (*c_primitive)();
+
+extern c_primitive caml_builtin_cprim[];
+extern char * caml_names_of_builtin_cprim[];
+
+extern struct ext_table caml_prim_table;
+#ifdef DEBUG
+extern struct ext_table caml_prim_name_table;
+#endif
+
+#define Primitive(n) ((c_primitive)(caml_prim_table.contents[n]))
+
+extern char * caml_section_table;
+extern asize_t caml_section_table_size;
+
+#endif /* CAML_PRIMS_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* 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. */
+/* */
+/***********************************************************************/
+
+#ifndef CAML_PRINTEXC_H
+#define CAML_PRINTEXC_H
+
+
+#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 */
--- /dev/null
+/***********************************************************************/
+/* */
+/* 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. */
+/* */
+/***********************************************************************/
+
+/* Swap byte-order in 16, 32, and 64-bit integers or floats */
+
+#ifndef CAML_REVERSE_H
+#define CAML_REVERSE_H
+
+#define Reverse_16(dst,src) { \
+ char * _p, * _q; \
+ char _a; \
+ _p = (char *) (src); \
+ _q = (char *) (dst); \
+ _a = _p[0]; \
+ _q[0] = _p[1]; \
+ _q[1] = _a; \
+}
+
+#define Reverse_32(dst,src) { \
+ char * _p, * _q; \
+ char _a, _b; \
+ _p = (char *) (src); \
+ _q = (char *) (dst); \
+ _a = _p[0]; \
+ _b = _p[1]; \
+ _q[0] = _p[3]; \
+ _q[1] = _p[2]; \
+ _q[3] = _a; \
+ _q[2] = _b; \
+}
+
+#define Reverse_64(dst,src) { \
+ char * _p, * _q; \
+ char _a, _b; \
+ _p = (char *) (src); \
+ _q = (char *) (dst); \
+ _a = _p[0]; \
+ _b = _p[1]; \
+ _q[0] = _p[7]; \
+ _q[1] = _p[6]; \
+ _q[7] = _a; \
+ _q[6] = _b; \
+ _a = _p[2]; \
+ _b = _p[3]; \
+ _q[2] = _p[5]; \
+ _q[3] = _p[4]; \
+ _q[5] = _a; \
+ _q[4] = _b; \
+}
+
+#define Perm_index(perm,i) ((perm >> (i * 4)) & 0xF)
+
+#define Permute_64(dst,perm_dst,src,perm_src) { \
+ char * _p; \
+ char _a, _b, _c, _d, _e, _f, _g, _h; \
+ _p = (char *) (src); \
+ _a = _p[Perm_index(perm_src, 0)]; \
+ _b = _p[Perm_index(perm_src, 1)]; \
+ _c = _p[Perm_index(perm_src, 2)]; \
+ _d = _p[Perm_index(perm_src, 3)]; \
+ _e = _p[Perm_index(perm_src, 4)]; \
+ _f = _p[Perm_index(perm_src, 5)]; \
+ _g = _p[Perm_index(perm_src, 6)]; \
+ _h = _p[Perm_index(perm_src, 7)]; \
+ _p = (char *) (dst); \
+ _p[Perm_index(perm_dst, 0)] = _a; \
+ _p[Perm_index(perm_dst, 1)] = _b; \
+ _p[Perm_index(perm_dst, 2)] = _c; \
+ _p[Perm_index(perm_dst, 3)] = _d; \
+ _p[Perm_index(perm_dst, 4)] = _e; \
+ _p[Perm_index(perm_dst, 5)] = _f; \
+ _p[Perm_index(perm_dst, 6)] = _g; \
+ _p[Perm_index(perm_dst, 7)] = _h; \
+}
+
+#endif /* CAML_REVERSE_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Xavier Leroy and Damien Doligez, 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. */
+/* */
+/***********************************************************************/
+
+#ifndef CAML_ROOTS_H
+#define CAML_ROOTS_H
+
+#include "misc.h"
+#include "memory.h"
+
+typedef void (*scanning_action) (value, value *);
+
+void caml_oldify_local_roots (void);
+void caml_darken_all_roots (void);
+void caml_do_roots (scanning_action);
+#ifndef NATIVE_CODE
+CAMLextern void caml_do_local_roots (scanning_action, value *, value *,
+ struct caml__roots_block *);
+#else
+CAMLextern void caml_do_local_roots(scanning_action f, char * bottom_of_stack,
+ uintnat last_retaddr, value * gc_regs,
+ struct caml__roots_block * local_roots);
+#endif
+
+CAMLextern void (*caml_scan_roots_hook) (scanning_action);
+
+#endif /* CAML_ROOTS_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Xavier Leroy and Damien Doligez, 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. */
+/* */
+/***********************************************************************/
+
+#ifndef CAML_SIGNALS_H
+#define CAML_SIGNALS_H
+
+#ifndef CAML_NAME_SPACE
+#include "compatibility.h"
+#endif
+#include "misc.h"
+#include "mlvalues.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* <private> */
+CAMLextern intnat volatile caml_signals_are_pending;
+CAMLextern intnat volatile caml_pending_signals[];
+CAMLextern int volatile caml_something_to_do;
+extern int volatile caml_force_major_slice;
+/* </private> */
+
+CAMLextern void caml_enter_blocking_section (void);
+CAMLextern void caml_leave_blocking_section (void);
+
+/* <private> */
+void caml_urge_major_slice (void);
+CAMLextern int caml_convert_signal_number (int);
+CAMLextern int caml_rev_convert_signal_number (int);
+void caml_execute_signal(int signal_number, int in_signal_handler);
+void caml_record_signal(int signal_number);
+void caml_process_pending_signals(void);
+void caml_process_event(void);
+int caml_set_signal_action(int signo, int action);
+
+CAMLextern void (*caml_enter_blocking_section_hook)(void);
+CAMLextern void (*caml_leave_blocking_section_hook)(void);
+CAMLextern int (*caml_try_leave_blocking_section_hook)(void);
+CAMLextern void (* volatile caml_async_action_hook)(void);
+/* </private> */
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_SIGNALS_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Xavier Leroy and Damien Doligez, 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. */
+/* */
+/***********************************************************************/
+
+/* Processor-specific operation: atomic "read and clear" */
+
+#ifndef CAML_SIGNALS_MACHDEP_H
+#define CAML_SIGNALS_MACHDEP_H
+
+#if defined(__GNUC__) && defined(__i386__)
+
+#define Read_and_clear(dst,src) \
+ asm("xorl %0, %0; xchgl %0, %1" \
+ : "=r" (dst), "=m" (src) \
+ : "m" (src))
+
+#elif defined(__GNUC__) && defined(__x86_64__)
+
+#define Read_and_clear(dst,src) \
+ asm("xorq %0, %0; xchgq %0, %1" \
+ : "=r" (dst), "=m" (src) \
+ : "m" (src))
+
+#elif defined(__GNUC__) && defined(__ppc__)
+
+#define Read_and_clear(dst,src) \
+ asm("0: lwarx %0, 0, %1\n\t" \
+ "stwcx. %2, 0, %1\n\t" \
+ "bne- 0b" \
+ : "=&r" (dst) \
+ : "r" (&(src)), "r" (0) \
+ : "cr0", "memory")
+
+#elif defined(__GNUC__) && defined(__ppc64__)
+
+#define Read_and_clear(dst,src) \
+ asm("0: ldarx %0, 0, %1\n\t" \
+ "stdcx. %2, 0, %1\n\t" \
+ "bne- 0b" \
+ : "=&r" (dst) \
+ : "r" (&(src)), "r" (0) \
+ : "cr0", "memory")
+
+#else
+
+/* Default, non-atomic implementation */
+#define Read_and_clear(dst,src) ((dst) = (src), (src) = 0)
+
+#endif
+
+#endif /* CAML_SIGNALS_MACHDEP_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* 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. */
+/* */
+/***********************************************************************/
+
+/* structure of the stacks */
+
+#ifndef CAML_STACKS_H
+#define CAML_STACKS_H
+
+
+#include "misc.h"
+#include "mlvalues.h"
+#include "memory.h"
+
+CAMLextern value * caml_stack_low;
+CAMLextern value * caml_stack_high;
+CAMLextern value * caml_stack_threshold;
+CAMLextern value * caml_extern_sp;
+CAMLextern value * caml_trapsp;
+CAMLextern value * caml_trap_barrier;
+
+#define Trap_pc(tp) (((code_t *)(tp))[0])
+#define Trap_link(tp) (((value **)(tp))[1])
+
+void caml_init_stack (uintnat init_max_size);
+void caml_realloc_stack (asize_t required_size);
+void caml_change_max_stack_size (uintnat new_max_size);
+uintnat caml_stack_usage (void);
+
+CAMLextern uintnat (*caml_stack_usage_hook)(void);
+
+#endif /* CAML_STACKS_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* 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. */
+/* */
+/***********************************************************************/
+
+#ifndef CAML_STARTUP_H
+#define CAML_STARTUP_H
+
+#include "mlvalues.h"
+#include "exec.h"
+
+CAMLextern void caml_main(char **argv);
+
+CAMLextern void caml_startup_code(
+ code_t code, asize_t code_size,
+ char *data, asize_t data_size,
+ char *section_table, asize_t section_table_size,
+ char **argv);
+
+enum { FILE_NOT_FOUND = -1, BAD_BYTECODE = -2 };
+
+extern int caml_attempt_open(char **name, struct exec_trailer *trail,
+ int do_open_script);
+extern void caml_read_section_descriptors(int fd, struct exec_trailer *trail);
+extern int32 caml_seek_optional_section(int fd, struct exec_trailer *trail,
+ char *name);
+extern int32 caml_seek_section(int fd, struct exec_trailer *trail, char *name);
+
+
+#endif /* CAML_STARTUP_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* 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. */
+/* */
+/***********************************************************************/
+
+#ifndef CAML_SYS_H
+#define CAML_SYS_H
+
+#include "misc.h"
+
+#define NO_ARG Val_int(0)
+
+CAMLextern void caml_sys_error (value);
+CAMLextern void caml_sys_io_error (value);
+extern void caml_sys_init (char * exe_name, char ** argv);
+CAMLextern value caml_sys_exit (value);
+
+extern char * caml_exe_name;
+
+#endif /* CAML_SYS_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Damien Doligez, projet Para, 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. */
+/* */
+/***********************************************************************/
+
+/* Function declarations for non-Unix user interfaces */
+
+#ifndef CAML_UI_H
+#define CAML_UI_H
+
+#include "config.h"
+
+void ui_exit (int return_code);
+int ui_read (int file_desc, char *buf, unsigned int length);
+int ui_write (int file_desc, char *buf, unsigned int length);
+void ui_print_stderr (char *format, void *arg);
+
+#endif /* CAML_UI_H */
--- /dev/null
+/***********************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Damien Doligez, projet Para, 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 GNU Library General Public License, with */
+/* the special exception on linking described in file ../LICENSE. */
+/* */
+/***********************************************************************/
+
+/* Operations on weak arrays */
+
+#ifndef CAML_WEAK_H
+#define CAML_WEAK_H
+
+#include "mlvalues.h"
+
+extern value caml_weak_list_head;
+extern value caml_weak_none;
+
+#endif /* CAML_WEAK_H */
#include <string.h>
-#include "config.h"
-#include "finalise.h"
-#include "freelist.h"
-#include "gc.h"
-#include "gc_ctrl.h"
-#include "major_gc.h"
-#include "memory.h"
-#include "mlvalues.h"
-#include "roots.h"
-#include "weak.h"
+#include "caml/address_class.h"
+#include "caml/config.h"
+#include "caml/finalise.h"
+#include "caml/freelist.h"
+#include "caml/gc.h"
+#include "caml/gc_ctrl.h"
+#include "caml/major_gc.h"
+#include "caml/memory.h"
+#include "caml/mlvalues.h"
+#include "caml/roots.h"
+#include "caml/weak.h"
extern uintnat caml_percent_free; /* major_gc.c */
extern void caml_shrink_heap (char *); /* memory.c */
/* Use Ecolor (q) == 0 instead of Is_block (q) because q could be an
inverted pointer for an infix header (with Ecolor == 2). */
- if (Ecolor (q) == 0 && (Classify_addr (q) & In_heap)){
+ if (Ecolor (q) == 0 && Is_in_heap (q)){
switch (Ecolor (Hd_val (q))){
case 0:
case 3: /* Pointer or header: insert in inverted list. */
+++ /dev/null
-/***********************************************************************/
-/* */
-/* OCaml */
-/* */
-/* Damien Doligez, projet Para, 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. */
-/* */
-/***********************************************************************/
-
-#ifndef CAML_COMPACT_H
-#define CAML_COMPACT_H
-
-
-#include "config.h"
-#include "misc.h"
-
-extern void caml_compact_heap (void);
-extern void caml_compact_heap_maybe (void);
-
-
-#endif /* CAML_COMPACT_H */
#include <string.h>
#include <stdlib.h>
-#include "custom.h"
-#include "fail.h"
-#include "memory.h"
-#include "misc.h"
-#include "mlvalues.h"
+#include "caml/custom.h"
+#include "caml/fail.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
/* Structural comparison on trees. */
+++ /dev/null
-/***********************************************************************/
-/* */
-/* OCaml */
-/* */
-/* Damien Doligez, Projet Moscova, 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. */
-/* */
-/***********************************************************************/
-
-#ifndef CAML_COMPARE_H
-#define CAML_COMPARE_H
-
-CAMLextern int caml_compare_unordered;
-
-#endif /* CAML_COMPARE_H */
+++ /dev/null
-/***********************************************************************/
-/* */
-/* OCaml */
-/* */
-/* Damien Doligez, projet Moscova, 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. */
-/* */
-/***********************************************************************/
-
-/* definitions for compatibility with old identifiers */
-
-#ifndef CAML_COMPATIBILITY_H
-#define CAML_COMPATIBILITY_H
-
-#ifndef CAML_NAME_SPACE
-
-/*
- #define --> CAMLextern (defined with CAMLexport or CAMLprim)
- (rien) --> CAMLprim
- g --> global C identifier
- x --> special case
-
- SP* signals the special cases:
- - when the identifier was not simply prefixed with [caml_]
- - when the [caml_] version was already used for something else, and
- was renamed out of the way (watch out for [caml_alloc] and
- [caml_array_bound_error] in *.s)
-*/
-
-/* a faire:
- - ui_* (reverifier que win32.c n'en depend pas)
-*/
-
-
-/* **** alloc.c */
-#define alloc caml_alloc /*SP*/
-#define alloc_small caml_alloc_small
-#define alloc_tuple caml_alloc_tuple
-#define alloc_string caml_alloc_string
-#define alloc_final caml_alloc_final
-#define copy_string caml_copy_string
-#define alloc_array caml_alloc_array
-#define copy_string_array caml_copy_string_array
-#define convert_flag_list caml_convert_flag_list
-
-/* **** array.c */
-
-/* **** backtrace.c */
-#define backtrace_active caml_backtrace_active
-#define backtrace_pos caml_backtrace_pos
-#define backtrace_buffer caml_backtrace_buffer
-#define backtrace_last_exn caml_backtrace_last_exn
-#define print_exception_backtrace caml_print_exception_backtrace
-
-/* **** callback.c */
-#define callback_depth caml_callback_depth
-#define callbackN_exn caml_callbackN_exn
-#define callback_exn caml_callback_exn
-#define callback2_exn caml_callback2_exn
-#define callback3_exn caml_callback3_exn
-#define callback caml_callback
-#define callback2 caml_callback2
-#define callback3 caml_callback3
-#define callbackN caml_callbackN
-
-/* **** compact.c */
-
-/* **** compare.c */
-#define compare_unordered caml_compare_unordered
-
-/* **** custom.c */
-#define alloc_custom caml_alloc_custom
-#define register_custom_operations caml_register_custom_operations
-
-/* **** debugger.c */
-
-/* **** dynlink.c */
-
-/* **** extern.c */
-#define output_val caml_output_val
-#define output_value_to_malloc caml_output_value_to_malloc
-#define output_value_to_block caml_output_value_to_block
-#define serialize_int_1 caml_serialize_int_1
-#define serialize_int_2 caml_serialize_int_2
-#define serialize_int_4 caml_serialize_int_4
-#define serialize_int_8 caml_serialize_int_8
-#define serialize_float_4 caml_serialize_float_4
-#define serialize_float_8 caml_serialize_float_8
-#define serialize_block_1 caml_serialize_block_1
-#define serialize_block_2 caml_serialize_block_2
-#define serialize_block_4 caml_serialize_block_4
-#define serialize_block_8 caml_serialize_block_8
-#define serialize_block_float_8 caml_serialize_block_float_8
-
-/* **** fail.c */
-#define external_raise caml_external_raise
-#define mlraise caml_raise /*SP*/
-#define raise_constant caml_raise_constant
-#define raise_with_arg caml_raise_with_arg
-#define raise_with_string caml_raise_with_string
-#define failwith caml_failwith
-#define invalid_argument caml_invalid_argument
-#define array_bound_error caml_array_bound_error /*SP*/
-#define raise_out_of_memory caml_raise_out_of_memory
-#define raise_stack_overflow caml_raise_stack_overflow
-#define raise_sys_error caml_raise_sys_error
-#define raise_end_of_file caml_raise_end_of_file
-#define raise_zero_divide caml_raise_zero_divide
-#define raise_not_found caml_raise_not_found
-#define raise_sys_blocked_io caml_raise_sys_blocked_io
-/* **** asmrun/fail.c */
-/* **** asmrun/<arch>.s */
-
-/* **** finalise.c */
-
-/* **** fix_code.c */
-
-/* **** floats.c */
-/*#define Double_val caml_Double_val done in mlvalues.h as needed */
-/*#define Store_double_val caml_Store_double_val done in mlvalues.h as needed */
-#define copy_double caml_copy_double
-
-/* **** freelist.c */
-
-/* **** gc_ctrl.c */
-
-/* **** globroots.c */
-#define register_global_root caml_register_global_root
-#define remove_global_root caml_remove_global_root
-
-/* **** hash.c */
-#define hash_variant caml_hash_variant
-
-/* **** instrtrace.c */
-
-/* **** intern.c */
-#define input_val caml_input_val
-#define input_val_from_string caml_input_val_from_string
-#define input_value_from_malloc caml_input_value_from_malloc
-#define input_value_from_block caml_input_value_from_block
-#define deserialize_uint_1 caml_deserialize_uint_1
-#define deserialize_sint_1 caml_deserialize_sint_1
-#define deserialize_uint_2 caml_deserialize_uint_2
-#define deserialize_sint_2 caml_deserialize_sint_2
-#define deserialize_uint_4 caml_deserialize_uint_4
-#define deserialize_sint_4 caml_deserialize_sint_4
-#define deserialize_uint_8 caml_deserialize_uint_8
-#define deserialize_sint_8 caml_deserialize_sint_8
-#define deserialize_float_4 caml_deserialize_float_4
-#define deserialize_float_8 caml_deserialize_float_8
-#define deserialize_block_1 caml_deserialize_block_1
-#define deserialize_block_2 caml_deserialize_block_2
-#define deserialize_block_4 caml_deserialize_block_4
-#define deserialize_block_8 caml_deserialize_block_8
-#define deserialize_block_float_8 caml_deserialize_block_float_8
-#define deserialize_error caml_deserialize_error
-
-/* **** interp.c */
-
-/* **** ints.c */
-#define int32_ops caml_int32_ops
-#define copy_int32 caml_copy_int32
-/*#define Int64_val caml_Int64_val *** done in mlvalues.h as needed */
-#define int64_ops caml_int64_ops
-#define copy_int64 caml_copy_int64
-#define nativeint_ops caml_nativeint_ops
-#define copy_nativeint caml_copy_nativeint
-
-/* **** io.c */
-#define channel_mutex_free caml_channel_mutex_free
-#define channel_mutex_lock caml_channel_mutex_lock
-#define channel_mutex_unlock caml_channel_mutex_unlock
-#define channel_mutex_unlock_exn caml_channel_mutex_unlock_exn
-#define all_opened_channels caml_all_opened_channels
-#define open_descriptor_in caml_open_descriptor_in /*SP*/
-#define open_descriptor_out caml_open_descriptor_out /*SP*/
-#define close_channel caml_close_channel /*SP*/
-#define channel_size caml_channel_size /*SP*/
-#define channel_binary_mode caml_channel_binary_mode
-#define flush_partial caml_flush_partial /*SP*/
-#define flush caml_flush /*SP*/
-#define putword caml_putword
-#define putblock caml_putblock
-#define really_putblock caml_really_putblock
-#define seek_out caml_seek_out /*SP*/
-#define pos_out caml_pos_out /*SP*/
-#define do_read caml_do_read
-#define refill caml_refill
-#define getword caml_getword
-#define getblock caml_getblock
-#define really_getblock caml_really_getblock
-#define seek_in caml_seek_in /*SP*/
-#define pos_in caml_pos_in /*SP*/
-#define input_scan_line caml_input_scan_line /*SP*/
-#define finalize_channel caml_finalize_channel
-#define alloc_channel caml_alloc_channel
-/*#define Val_file_offset caml_Val_file_offset *** done in io.h as needed */
-/*#define File_offset_val caml_File_offset_val *** done in io.h as needed */
-
-/* **** lexing.c */
-
-/* **** main.c */
-/* *** no change */
-
-/* **** major_gc.c */
-#define heap_start caml_heap_start
-#define page_table caml_page_table
-
-/* **** md5.c */
-#define md5_string caml_md5_string
-#define md5_chan caml_md5_chan
-#define MD5Init caml_MD5Init
-#define MD5Update caml_MD5Update
-#define MD5Final caml_MD5Final
-#define MD5Transform caml_MD5Transform
-
-/* **** memory.c */
-#define alloc_shr caml_alloc_shr
-#define initialize caml_initialize
-#define modify caml_modify
-#define stat_alloc caml_stat_alloc
-#define stat_free caml_stat_free
-#define stat_resize caml_stat_resize
-
-/* **** meta.c */
-
-/* **** minor_gc.c */
-#define young_start caml_young_start
-#define young_end caml_young_end
-#define young_ptr caml_young_ptr
-#define young_limit caml_young_limit
-#define ref_table caml_ref_table
-#define minor_collection caml_minor_collection
-#define check_urgent_gc caml_check_urgent_gc
-
-/* **** misc.c */
-
-/* **** obj.c */
-
-/* **** parsing.c */
-
-/* **** prims.c */
-
-/* **** printexc.c */
-#define format_caml_exception caml_format_exception /*SP*/
-
-/* **** roots.c */
-#define local_roots caml_local_roots
-#define scan_roots_hook caml_scan_roots_hook
-#define do_local_roots caml_do_local_roots
-
-/* **** signals.c */
-#define pending_signals caml_pending_signals
-#define something_to_do caml_something_to_do
-#define enter_blocking_section_hook caml_enter_blocking_section_hook
-#define leave_blocking_section_hook caml_leave_blocking_section_hook
-#define try_leave_blocking_section_hook caml_try_leave_blocking_section_hook
-#define async_action_hook caml_async_action_hook
-#define enter_blocking_section caml_enter_blocking_section
-#define leave_blocking_section caml_leave_blocking_section
-#define convert_signal_number caml_convert_signal_number
-/* **** asmrun/signals.c */
-#define garbage_collection caml_garbage_collection
-
-/* **** stacks.c */
-#define stack_low caml_stack_low
-#define stack_high caml_stack_high
-#define stack_threshold caml_stack_threshold
-#define extern_sp caml_extern_sp
-#define trapsp caml_trapsp
-#define trap_barrier caml_trap_barrier
-
-/* **** startup.c */
-#define atom_table caml_atom_table
-/* **** asmrun/startup.c */
-#define static_data_start caml_static_data_start
-#define static_data_end caml_static_data_end
-
-/* **** str.c */
-#define string_length caml_string_length
-
-/* **** sys.c */
-#define sys_error caml_sys_error
-#define sys_exit caml_sys_exit
-
-/* **** terminfo.c */
-
-/* **** unix.c & win32.c */
-#define search_exe_in_path caml_search_exe_in_path
-
-/* **** weak.c */
-
-/* **** asmcomp/asmlink.ml */
-
-/* **** asmcomp/cmmgen.ml */
-
-/* **** asmcomp/asmlink.ml, asmcomp/cmmgen.ml, asmcomp/compilenv.ml */
-
-/* ************************************************************* */
-
-/* **** otherlibs/bigarray */
-#define int8 caml_ba_int8
-#define uint8 caml_ba_uint8
-#define int16 caml_ba_int16
-#define uint16 caml_ba_uint16
-#define MAX_NUM_DIMS CAML_BA_MAX_NUM_DIMS
-#define caml_bigarray_kind caml_ba_kind
-#define BIGARRAY_FLOAT32 CAML_BA_FLOAT32
-#define BIGARRAY_FLOAT64 CAML_BA_FLOAT64
-#define BIGARRAY_SINT8 CAML_BA_SINT8
-#define BIGARRAY_UINT8 CAML_BA_UINT8
-#define BIGARRAY_SINT16 CAML_BA_SINT16
-#define BIGARRAY_UINT16 CAML_BA_UINT16
-#define BIGARRAY_INT32 CAML_BA_INT32
-#define BIGARRAY_INT64 CAML_BA_INT64
-#define BIGARRAY_CAML_INT CAML_BA_CAML_INT
-#define BIGARRAY_NATIVE_INT CAML_BA_NATIVE_INT
-#define BIGARRAY_COMPLEX32 CAML_BA_COMPLEX32
-#define BIGARRAY_COMPLEX64 CAML_BA_COMPLEX64
-#define BIGARRAY_KIND_MASK CAML_BA_KIND_MASK
-#define caml_bigarray_layout caml_ba_layout
-#define BIGARRAY_C_LAYOUT CAML_BA_C_LAYOUT
-#define BIGARRAY_FORTRAN_LAYOUT CAML_BA_FORTRAN_LAYOUT
-#define BIGARRAY_LAYOUT_MASK CAML_BA_LAYOUT_MASK
-#define caml_bigarray_managed caml_ba_managed
-#define BIGARRAY_EXTERNAL CAML_BA_EXTERNAL
-#define BIGARRAY_MANAGED CAML_BA_MANAGED
-#define BIGARRAY_MAPPED_FILE CAML_BA_MAPPED_FILE
-#define BIGARRAY_MANAGED_MASK CAML_BA_MANAGED_MASK
-#define caml_bigarray_proxy caml_ba_proxy
-#define caml_bigarray caml_ba_array
-#define Bigarray_val Caml_ba_array_val
-#define Data_bigarray_val Caml_ba_data_val
-#define alloc_bigarray caml_ba_alloc
-#define alloc_bigarray_dims caml_ba_alloc_dims
-#define bigarray_map_file caml_ba_map_file
-#define bigarray_unmap_file caml_ba_unmap_file
-#define bigarray_element_size caml_ba_element_size
-#define bigarray_byte_size caml_ba_byte_size
-#define bigarray_deserialize caml_ba_deserialize
-#define MAX_BIGARRAY_MEMORY CAML_BA_MAX_MEMORY
-#define bigarray_create caml_ba_create
-#define bigarray_get_N caml_ba_get_N
-#define bigarray_get_1 caml_ba_get_1
-#define bigarray_get_2 caml_ba_get_2
-#define bigarray_get_3 caml_ba_get_3
-#define bigarray_get_generic caml_ba_get_generic
-#define bigarray_set_1 caml_ba_set_1
-#define bigarray_set_2 caml_ba_set_2
-#define bigarray_set_3 caml_ba_set_3
-#define bigarray_set_N caml_ba_set_N
-#define bigarray_set_generic caml_ba_set_generic
-#define bigarray_num_dims caml_ba_num_dims
-#define bigarray_dim caml_ba_dim
-#define bigarray_kind caml_ba_kind
-#define bigarray_layout caml_ba_layout
-#define bigarray_slice caml_ba_slice
-#define bigarray_sub caml_ba_sub
-#define bigarray_blit caml_ba_blit
-#define bigarray_fill caml_ba_fill
-#define bigarray_reshape caml_ba_reshape
-#define bigarray_init caml_ba_init
-
-#endif /* CAML_NAME_SPACE */
-#endif /* CAML_COMPATIBILITY_H */
+++ /dev/null
-/***********************************************************************/
-/* */
-/* OCaml */
-/* */
-/* Xavier Leroy and Damien Doligez, 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. */
-/* */
-/***********************************************************************/
-
-#ifndef CAML_CONFIG_H
-#define CAML_CONFIG_H
-
-/* <include ../config/m.h> */
-/* <include ../config/s.h> */
-/* <private> */
-#include "../config/m.h"
-#include "../config/s.h"
-/* </private> */
-
-#ifndef CAML_NAME_SPACE
-#include "compatibility.h"
-#endif
-
-/* Types for 32-bit integers, 64-bit integers,
- native integers (as wide as a pointer type) */
-
-#if SIZEOF_INT == 4
-typedef int int32;
-typedef unsigned int uint32;
-#define ARCH_INT32_PRINTF_FORMAT ""
-#elif SIZEOF_LONG == 4
-typedef long int32;
-typedef unsigned long uint32;
-#define ARCH_INT32_PRINTF_FORMAT "l"
-#elif SIZEOF_SHORT == 4
-typedef short int32;
-typedef unsigned short uint32;
-#define ARCH_INT32_PRINTF_FORMAT ""
-#else
-#error "No 32-bit integer type available"
-#endif
-
-#ifndef ARCH_INT64_TYPE
-#if SIZEOF_LONGLONG == 8
-#define ARCH_INT64_TYPE long long
-#define ARCH_UINT64_TYPE unsigned long long
-#define ARCH_INT64_PRINTF_FORMAT "ll"
-#elif SIZEOF_LONG == 8
-#define ARCH_INT64_TYPE long
-#define ARCH_UINT64_TYPE unsigned long
-#define ARCH_INT64_PRINTF_FORMAT "l"
-#else
-#error "No 64-bit integer type available"
-#endif
-#endif
-
-typedef ARCH_INT64_TYPE int64;
-typedef ARCH_UINT64_TYPE uint64;
-
-#if SIZEOF_PTR == SIZEOF_LONG
-/* Standard models: ILP32 or I32LP64 */
-typedef long intnat;
-typedef unsigned long uintnat;
-#define ARCH_INTNAT_PRINTF_FORMAT "l"
-#elif SIZEOF_PTR == SIZEOF_INT
-/* Hypothetical IP32L64 model */
-typedef int intnat;
-typedef unsigned int uintnat;
-#define ARCH_INTNAT_PRINTF_FORMAT ""
-#elif SIZEOF_PTR == 8
-/* Win64 model: IL32LLP64 */
-typedef int64 intnat;
-typedef uint64 uintnat;
-#define ARCH_INTNAT_PRINTF_FORMAT ARCH_INT64_PRINTF_FORMAT
-#else
-#error "No integer type available to represent pointers"
-#endif
-
-/* Endianness of floats */
-
-/* ARCH_FLOAT_ENDIANNESS encodes the byte order of doubles as follows:
- the value [0xabcdefgh] means that the least significant byte of the
- float is at byte offset [a], the next lsb at [b], ..., and the
- most significant byte at [h]. */
-
-#if defined(__arm__) && !defined(__ARM_EABI__)
-#define ARCH_FLOAT_ENDIANNESS 0x45670123
-#elif defined(ARCH_BIG_ENDIAN)
-#define ARCH_FLOAT_ENDIANNESS 0x76543210
-#else
-#define ARCH_FLOAT_ENDIANNESS 0x01234567
-#endif
-
-/* 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)
-#define THREADED_CODE
-#endif
-
-
-/* Do not change this definition. */
-#define Page_size (1 << Page_log)
-
-/* Memory model parameters */
-
-/* The size of a page for memory management (in bytes) is [1 << Page_log].
- It must be a multiple of [sizeof (value)] and >= 8 and <= 20. */
-#define Page_log 12 /* A page is 4 kilobytes. */
-
-/* Initial size of stack (bytes). */
-#define Stack_size (4096 * sizeof(value))
-
-/* Minimum free size of stack (bytes); below that, it is reallocated. */
-#define Stack_threshold (256 * sizeof(value))
-
-/* Default maximum size of the stack (words). */
-#define Max_stack_def (1024 * 1024)
-
-
-/* Maximum size of a block allocated in the young generation (words). */
-/* Must be > 4 */
-#define Max_young_wosize 256
-
-
-/* Minimum size of the minor zone (words).
- This must be at least [Max_young_wosize + 1]. */
-#define Minor_heap_min 4096
-
-/* Maximum size of the minor zone (words).
- Must be greater than or equal to [Minor_heap_min].
-*/
-#define Minor_heap_max (1 << 28)
-
-/* Default size of the minor zone. (words) */
-#define Minor_heap_def 262144
-
-
-/* Minimum size increment when growing the heap (words).
- Must be a multiple of [Page_size / sizeof (value)]. */
-#define Heap_chunk_min (15 * Page_size)
-
-/* Default size increment when growing the heap.
- If this is <= 1000, it's a percentage of the current heap size.
- If it is > 1000, it's a number of words. */
-#define Heap_chunk_def 15
-
-/* Default initial size of the major heap (words);
- Must be a multiple of [Page_size / sizeof (value)]. */
-#define Init_heap_def (31 * Page_size)
-/* (about 512 kB for a 32-bit platform, 1 MB for a 64-bit platform.) */
-
-
-/* Default speed setting for the major GC. The heap will grow until
- the dead objects and the free list represent this percentage of the
- total size of live objects. */
-#define Percent_free_def 80
-
-/* Default setting for the compacter: 500%
- (i.e. trigger the compacter when 5/6 of the heap is free or garbage)
- This can be set quite high because the overhead is over-estimated
- when fragmentation occurs.
- */
-#define Max_percent_free_def 500
-
-
-#endif /* CAML_CONFIG_H */
#include <string.h>
-#include "alloc.h"
-#include "custom.h"
-#include "fail.h"
-#include "memory.h"
-#include "mlvalues.h"
+#include "caml/alloc.h"
+#include "caml/custom.h"
+#include "caml/fail.h"
+#include "caml/memory.h"
+#include "caml/mlvalues.h"
CAMLexport value caml_alloc_custom(struct custom_operations * ops,
uintnat size,
+++ /dev/null
-/***********************************************************************/
-/* */
-/* OCaml */
-/* */
-/* Manuel Serrano and Xavier Leroy, 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. */
-/* */
-/***********************************************************************/
-
-#ifndef CAML_CUSTOM_H
-#define CAML_CUSTOM_H
-
-
-#ifndef CAML_NAME_SPACE
-#include "compatibility.h"
-#endif
-#include "mlvalues.h"
-
-struct custom_operations {
- char *identifier;
- void (*finalize)(value v);
- int (*compare)(value v1, value v2);
- intnat (*hash)(value v);
- void (*serialize)(value v,
- /*out*/ uintnat * wsize_32 /*size in bytes*/,
- /*out*/ uintnat * wsize_64 /*size in bytes*/);
- uintnat (*deserialize)(void * dst);
- int (*compare_ext)(value v1, value v2);
-};
-
-#define custom_finalize_default NULL
-#define custom_compare_default NULL
-#define custom_hash_default NULL
-#define custom_serialize_default NULL
-#define custom_deserialize_default NULL
-#define custom_compare_ext_default NULL
-
-#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*/
- mlsize_t max /*max resources*/);
-
-CAMLextern void caml_register_custom_operations(struct custom_operations * ops);
-
-CAMLextern int caml_compare_unordered;
- /* Used by custom comparison to report unordered NaN-like cases. */
-
-/* <private> */
-extern struct custom_operations * caml_find_custom_operations(char * ident);
-extern struct custom_operations *
- caml_final_custom_operations(void (*fn)(value));
-
-extern void caml_init_custom_operations(void);
-/* </private> */
-
-#ifdef __cplusplus
-}
-#endif
-
-#endif /* CAML_CUSTOM_H */
#include <string.h>
-#include "alloc.h"
-#include "config.h"
-#include "debugger.h"
-#include "misc.h"
+#include "caml/alloc.h"
+#include "caml/config.h"
+#include "caml/debugger.h"
+#include "caml/misc.h"
int caml_debugger_in_use = 0;
uintnat caml_event_count;
#include <process.h>
#endif
-#include "fail.h"
-#include "fix_code.h"
-#include "instruct.h"
-#include "intext.h"
-#include "io.h"
-#include "mlvalues.h"
-#include "stacks.h"
-#include "sys.h"
+#include "caml/fail.h"
+#include "caml/fix_code.h"
+#include "caml/instruct.h"
+#include "caml/intext.h"
+#include "caml/io.h"
+#include "caml/mlvalues.h"
+#include "caml/stacks.h"
+#include "caml/sys.h"
static int sock_domain; /* Socket domain for the debugger */
static union { /* Socket address for the debugger */
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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. */
-/* */
-/***********************************************************************/
-
-/* Interface with the debugger */
-
-#ifndef CAML_DEBUGGER_H
-#define CAML_DEBUGGER_H
-
-#include "misc.h"
-#include "mlvalues.h"
-
-CAMLextern int caml_debugger_in_use;
-CAMLextern int caml_debugger_fork_mode; /* non-zero for parent */
-extern uintnat caml_event_count;
-
-enum event_kind {
- EVENT_COUNT, BREAKPOINT, PROGRAM_START, PROGRAM_EXIT,
- TRAP_BARRIER, UNCAUGHT_EXC
-};
-
-void caml_debugger_init (void);
-void caml_debugger (enum event_kind event);
-void caml_debugger_cleanup_fork (void);
-
-/* Communication protocol */
-
-/* Requests from the debugger to the runtime system */
-
-enum debugger_request {
- REQ_SET_EVENT = 'e', /* uint32 pos */
- /* Set an event on the instruction at position pos */
- REQ_SET_BREAKPOINT = 'B', /* uint32 pos, (char k) */
- /* Set a breakpoint at position pos */
- /* In profiling mode, the breakpoint kind is set to k */
- REQ_RESET_INSTR = 'i', /* uint32 pos */
- /* Clear an event or breapoint at position pos, restores initial instr. */
- REQ_CHECKPOINT = 'c', /* no args */
- /* Checkpoint the runtime system by forking a child process.
- Reply is pid of child process or -1 if checkpoint failed. */
- REQ_GO = 'g', /* uint32 n */
- /* Run the program for n events.
- Reply is one of debugger_reply described below. */
- REQ_STOP = 's', /* no args */
- /* Terminate the runtime system */
- REQ_WAIT = 'w', /* no args */
- /* Reap one dead child (a discarded checkpoint). */
- REQ_INITIAL_FRAME = '0', /* no args */
- /* Set current frame to bottom frame (the one currently executing).
- Reply is stack offset and current pc. */
- REQ_GET_FRAME = 'f', /* no args */
- /* Return current frame location (stack offset + current pc). */
- REQ_SET_FRAME = 'S', /* uint32 stack_offset */
- /* Set current frame to given stack offset. No reply. */
- REQ_UP_FRAME = 'U', /* uint32 n */
- /* Move one frame up. Argument n is size of current frame (in words).
- Reply is stack offset and current pc, or -1 if top of stack reached. */
- REQ_SET_TRAP_BARRIER = 'b', /* uint32 offset */
- /* Set the trap barrier at the given offset. */
- REQ_GET_LOCAL = 'L', /* uint32 slot_number */
- /* Return the local variable at the given slot in the current frame.
- Reply is one value. */
- REQ_GET_ENVIRONMENT = 'E', /* uint32 slot_number */
- /* Return the local variable at the given slot in the heap environment
- of the current frame. Reply is one value. */
- REQ_GET_GLOBAL = 'G', /* uint32 global_number */
- /* Return the specified global variable. Reply is one value. */
- REQ_GET_ACCU = 'A', /* no args */
- /* Return the current contents of the accumulator. Reply is one value. */
- REQ_GET_HEADER = 'H', /* mlvalue v */
- /* As REQ_GET_OBJ, but sends only the header. */
- REQ_GET_FIELD = 'F', /* mlvalue v, uint32 fieldnum */
- /* As REQ_GET_OBJ, but sends only one field. */
- REQ_MARSHAL_OBJ = 'M', /* mlvalue v */
- /* Send a copy of the data structure rooted at v, using the same
- format as [caml_output_value]. */
- REQ_GET_CLOSURE_CODE = 'C', /* mlvalue v */
- /* Send the code address of the given closure.
- Reply is one uint32. */
- REQ_SET_FORK_MODE = 'K' /* uint32 m */
- /* Set whether to follow the child (m=0) or the parent on fork. */
-};
-
-/* Replies to a REQ_GO request. All replies are followed by three uint32:
- - the value of the event counter
- - the position of the stack
- - the current pc. */
-
-enum debugger_reply {
- REP_EVENT = 'e',
- /* Event counter reached 0. */
- REP_BREAKPOINT = 'b',
- /* Breakpoint hit. */
- REP_EXITED = 'x',
- /* Program exited by calling exit or reaching the end of the source. */
- REP_TRAP = 's',
- /* Trap barrier crossed. */
- REP_UNCAUGHT_EXC = 'u'
- /* Program exited due to a stray exception. */
-};
-
-#endif /* CAML_DEBUGGER_H */
#include <string.h>
#include <fcntl.h>
#include <sys/stat.h>
-#include "config.h"
+#include "caml/config.h"
#ifdef HAS_UNISTD
#include <unistd.h>
#endif
-#include "alloc.h"
-#include "dynlink.h"
-#include "fail.h"
-#include "mlvalues.h"
-#include "memory.h"
-#include "misc.h"
-#include "osdeps.h"
-#include "prims.h"
+#include "caml/alloc.h"
+#include "caml/dynlink.h"
+#include "caml/fail.h"
+#include "caml/mlvalues.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/osdeps.h"
+#include "caml/prims.h"
+#include "caml/signals.h"
#ifndef NATIVE_CODE
realname = caml_search_dll_in_path(&caml_shared_libs_path, name);
caml_gc_message(0x100, "Loading shared library %s\n",
(uintnat) realname);
+ caml_enter_blocking_section();
handle = caml_dlopen(realname, 1, 1);
+ caml_leave_blocking_section();
if (handle == NULL)
caml_fatal_error_arg2("Fatal error: cannot load shared library %s\n", name,
"Reason: %s\n", caml_dlerror());
{
void * handle;
value result;
+ char * p;
caml_gc_message(0x100, "Opening shared library %s\n",
(uintnat) String_val(filename));
- handle = caml_dlopen(String_val(filename), Int_val(mode), 1);
+ p = caml_strdup(String_val(filename));
+ caml_enter_blocking_section();
+ handle = caml_dlopen(p, Int_val(mode), 1);
+ caml_leave_blocking_section();
+ caml_stat_free(p);
if (handle == NULL) caml_failwith(caml_dlerror());
result = caml_alloc_small(1, Abstract_tag);
Handle_val(result) = handle;
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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 GNU Library General Public License, with */
-/* the special exception on linking described in file ../LICENSE. */
-/* */
-/***********************************************************************/
-
-/* Dynamic loading of C primitives. */
-
-#ifndef CAML_DYNLINK_H
-#define CAML_DYNLINK_H
-
-#include "misc.h"
-
-/* Build the table of primitives, given a search path, a list
- of shared libraries, and a list of primitive names
- (all three 0-separated in char arrays).
- Abort the runtime system on error. */
-extern void caml_build_primitive_table(char * lib_path,
- char * libs,
- char * req_prims);
-
-/* The search path for shared libraries */
-extern struct ext_table caml_shared_libs_path;
-
-/* Build the table of primitives as a copy of the builtin primitive table.
- Used for executables generated by ocamlc -output-obj. */
-extern void caml_build_primitive_table_builtin(void);
-
-#endif /* CAML_DYNLINK_H */
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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. */
-/* */
-/***********************************************************************/
-
-/* exec.h : format of executable bytecode files */
-
-#ifndef CAML_EXEC_H
-#define CAML_EXEC_H
-
-/* Executable bytecode files are composed of a number of sections,
- identified by 4-character names. A table of contents at the
- end of the file lists the section names along with their sizes,
- in the order in which they appear in the file:
-
- offset 0 ---> initial junk
- data for section 1
- data for section 2
- ...
- data for section N
- table of contents:
- descriptor for section 1
- ...
- descriptor for section N
- trailer
- end of file --->
-*/
-
-/* Structure of t.o.c. entries
- Numerical quantities are 32-bit unsigned integers, big endian */
-
-struct section_descriptor {
- char name[4]; /* Section name */
- uint32 len; /* Length of data in bytes */
-};
-
-/* Structure of the trailer. */
-
-struct exec_trailer {
- uint32 num_sections; /* Number of sections */
- char magic[12]; /* The magic number */
- struct section_descriptor * section; /* Not part of file */
-};
-
-#define TRAILER_SIZE (4+12)
-
-/* Magic number for this release */
-
-#define EXEC_MAGIC "Caml1999X011"
-
-
-#endif /* CAML_EXEC_H */
/* Structured output */
-/* The interface of this file is "intext.h" */
+/* The interface of this file is "caml/intext.h" */
#include <string.h>
-#include "alloc.h"
-#include "custom.h"
-#include "fail.h"
-#include "gc.h"
-#include "intext.h"
-#include "io.h"
-#include "md5.h"
-#include "memory.h"
-#include "misc.h"
-#include "mlvalues.h"
-#include "reverse.h"
+#include "caml/alloc.h"
+#include "caml/custom.h"
+#include "caml/fail.h"
+#include "caml/gc.h"
+#include "caml/intext.h"
+#include "caml/io.h"
+#include "caml/md5.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/reverse.h"
static uintnat obj_counter; /* Number of objects emitted so far */
static uintnat size_32; /* Size in words of 32-bit block for struct. */
#include <stdio.h>
#include <stdlib.h>
-#include "alloc.h"
-#include "fail.h"
-#include "io.h"
-#include "gc.h"
-#include "memory.h"
-#include "misc.h"
-#include "mlvalues.h"
-#include "printexc.h"
-#include "signals.h"
-#include "stacks.h"
+#include "caml/alloc.h"
+#include "caml/fail.h"
+#include "caml/io.h"
+#include "caml/gc.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/printexc.h"
+#include "caml/signals.h"
+#include "caml/stacks.h"
CAMLexport struct longjmp_buffer * caml_external_raise = NULL;
value caml_exn_bucket;
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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. */
-/* */
-/***********************************************************************/
-
-#ifndef CAML_FAIL_H
-#define CAML_FAIL_H
-
-/* <private> */
-#include <setjmp.h>
-/* </private> */
-
-#ifndef CAML_NAME_SPACE
-#include "compatibility.h"
-#endif
-#include "misc.h"
-#include "mlvalues.h"
-
-/* <private> */
-#define OUT_OF_MEMORY_EXN 0 /* "Out_of_memory" */
-#define SYS_ERROR_EXN 1 /* "Sys_error" */
-#define FAILURE_EXN 2 /* "Failure" */
-#define INVALID_EXN 3 /* "Invalid_argument" */
-#define END_OF_FILE_EXN 4 /* "End_of_file" */
-#define ZERO_DIVIDE_EXN 5 /* "Division_by_zero" */
-#define NOT_FOUND_EXN 6 /* "Not_found" */
-#define MATCH_FAILURE_EXN 7 /* "Match_failure" */
-#define STACK_OVERFLOW_EXN 8 /* "Stack_overflow" */
-#define SYS_BLOCKED_IO 9 /* "Sys_blocked_io" */
-#define ASSERT_FAILURE_EXN 10 /* "Assert_failure" */
-#define UNDEFINED_RECURSIVE_MODULE_EXN 11 /* "Undefined_recursive_module" */
-
-#ifdef POSIX_SIGNALS
-struct longjmp_buffer {
- sigjmp_buf buf;
-};
-#else
-struct longjmp_buffer {
- jmp_buf buf;
-};
-#define sigsetjmp(buf,save) setjmp(buf)
-#define siglongjmp(buf,val) longjmp(buf,val)
-#endif
-
-CAMLextern struct longjmp_buffer * caml_external_raise;
-extern value caml_exn_bucket;
-int caml_is_special_exception(value exn);
-
-/* </private> */
-
-#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_string (value tag, char const * msg) Noreturn;
-CAMLextern void caml_failwith (char const *) Noreturn;
-CAMLextern void caml_invalid_argument (char const *) Noreturn;
-CAMLextern void caml_raise_out_of_memory (void) Noreturn;
-CAMLextern void caml_raise_stack_overflow (void) Noreturn;
-CAMLextern void caml_raise_sys_error (value) Noreturn;
-CAMLextern void caml_raise_end_of_file (void) Noreturn;
-CAMLextern void caml_raise_zero_divide (void) Noreturn;
-CAMLextern void caml_raise_not_found (void) Noreturn;
-CAMLextern void caml_array_bound_error (void) Noreturn;
-CAMLextern void caml_raise_sys_blocked_io (void) Noreturn;
-
-#ifdef __cplusplus
-}
-#endif
-
-#endif /* CAML_FAIL_H */
/* Handling of finalised values. */
-#include "callback.h"
-#include "fail.h"
-#include "mlvalues.h"
-#include "roots.h"
-#include "signals.h"
+#include "caml/callback.h"
+#include "caml/fail.h"
+#include "caml/mlvalues.h"
+#include "caml/roots.h"
+#include "caml/signals.h"
struct final {
value fun;
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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 GNU Library General Public License, with */
-/* the special exception on linking described in file ../LICENSE. */
-/* */
-/***********************************************************************/
-
-#ifndef CAML_FINALISE_H
-#define CAML_FINALISE_H
-
-#include "roots.h"
-
-void caml_final_update (void);
-void caml_final_do_calls (void);
-void caml_final_do_strong_roots (scanning_action f);
-void caml_final_do_weak_roots (scanning_action f);
-void caml_final_do_young_roots (scanning_action f);
-void caml_final_empty_young (void);
-value caml_final_register (value f, value v);
-
-#endif /* CAML_FINALISE_H */
/* Handling of blocks of bytecode (endianness switch, threading). */
-#include "config.h"
+#include "caml/config.h"
#ifdef HAS_UNISTD
#include <unistd.h>
#endif
-#include "debugger.h"
-#include "fix_code.h"
-#include "instruct.h"
-#include "intext.h"
-#include "md5.h"
-#include "memory.h"
-#include "misc.h"
-#include "mlvalues.h"
-#include "reverse.h"
+#include "caml/debugger.h"
+#include "caml/fix_code.h"
+#include "caml/instruct.h"
+#include "caml/intext.h"
+#include "caml/md5.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/reverse.h"
code_t caml_start_code;
asize_t caml_code_size;
char ** caml_instr_table;
char * caml_instr_base;
-void caml_thread_code (code_t code, asize_t len)
+static int* opcode_nargs = NULL;
+int* caml_init_opcode_nargs()
{
- code_t p;
- int l [FIRST_UNIMPLEMENTED_OP];
- int i;
+ if( opcode_nargs == NULL ){
+ int* l = (int*)caml_stat_alloc(sizeof(int) * FIRST_UNIMPLEMENTED_OP);
+ int i;
- for (i = 0; i < FIRST_UNIMPLEMENTED_OP; i++) {
- l [i] = 0;
+ for (i = 0; i < FIRST_UNIMPLEMENTED_OP; i++) {
+ l [i] = 0;
+ }
+ /* Instructions with one operand */
+ l[PUSHACC] = l[ACC] = l[POP] = l[ASSIGN] =
+ l[PUSHENVACC] = l[ENVACC] = l[PUSH_RETADDR] = l[APPLY] =
+ l[APPTERM1] = l[APPTERM2] = l[APPTERM3] = l[RETURN] =
+ l[GRAB] = l[PUSHGETGLOBAL] = l[GETGLOBAL] = l[SETGLOBAL] =
+ l[PUSHATOM] = l[ATOM] = l[MAKEBLOCK1] = l[MAKEBLOCK2] =
+ l[MAKEBLOCK3] = l[MAKEFLOATBLOCK] = l[GETFIELD] =
+ l[GETFLOATFIELD] = l[SETFIELD] = l[SETFLOATFIELD] =
+ l[BRANCH] = l[BRANCHIF] = l[BRANCHIFNOT] = l[PUSHTRAP] =
+ l[C_CALL1] = l[C_CALL2] = l[C_CALL3] = l[C_CALL4] = l[C_CALL5] =
+ l[CONSTINT] = l[PUSHCONSTINT] = l[OFFSETINT] =
+ l[OFFSETREF] = l[OFFSETCLOSURE] = l[PUSHOFFSETCLOSURE] = 1;
+
+ /* Instructions with two operands */
+ l[APPTERM] = l[CLOSURE] = l[PUSHGETGLOBALFIELD] =
+ l[GETGLOBALFIELD] = l[MAKEBLOCK] = l[C_CALLN] =
+ l[BEQ] = l[BNEQ] = l[BLTINT] = l[BLEINT] = l[BGTINT] = l[BGEINT] =
+ l[BULTINT] = l[BUGEINT] = l[GETPUBMET] = 2;
+
+ opcode_nargs = l;
}
- /* Instructions with one operand */
- l[PUSHACC] = l[ACC] = l[POP] = l[ASSIGN] =
- l[PUSHENVACC] = l[ENVACC] = l[PUSH_RETADDR] = l[APPLY] =
- l[APPTERM1] = l[APPTERM2] = l[APPTERM3] = l[RETURN] =
- l[GRAB] = l[PUSHGETGLOBAL] = l[GETGLOBAL] = l[SETGLOBAL] =
- l[PUSHATOM] = l[ATOM] = l[MAKEBLOCK1] = l[MAKEBLOCK2] =
- l[MAKEBLOCK3] = l[MAKEFLOATBLOCK] = l[GETFIELD] =
- l[GETFLOATFIELD] = l[SETFIELD] = l[SETFLOATFIELD] =
- l[BRANCH] = l[BRANCHIF] = l[BRANCHIFNOT] = l[PUSHTRAP] =
- l[C_CALL1] = l[C_CALL2] = l[C_CALL3] = l[C_CALL4] = l[C_CALL5] =
- l[CONSTINT] = l[PUSHCONSTINT] = l[OFFSETINT] =
- l[OFFSETREF] = l[OFFSETCLOSURE] = l[PUSHOFFSETCLOSURE] = 1;
-
- /* Instructions with two operands */
- l[APPTERM] = l[CLOSURE] = l[PUSHGETGLOBALFIELD] =
- l[GETGLOBALFIELD] = l[MAKEBLOCK] = l[C_CALLN] =
- l[BEQ] = l[BNEQ] = l[BLTINT] = l[BLEINT] = l[BGTINT] = l[BGEINT] =
- l[BULTINT] = l[BUGEINT] = l[GETPUBMET] = 2;
+ return opcode_nargs;
+}
+
+void caml_thread_code (code_t code, asize_t len)
+{
+ code_t p;
+ int* l = caml_init_opcode_nargs();
len /= sizeof(opcode_t);
for (p = code; p < code + len; /*nothing*/) {
opcode_t instr = *p;
Assert(p == code + len);
}
+#else
+
+int* caml_init_opcode_nargs()
+{
+ return NULL;
+}
+
#endif /* THREADED_CODE */
void caml_set_instruction(code_t pos, opcode_t instr)
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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. */
-/* */
-/***********************************************************************/
-
-/* Handling of blocks of bytecode (endianness switch, threading). */
-
-#ifndef CAML_FIX_CODE_H
-#define CAML_FIX_CODE_H
-
-
-#include "config.h"
-#include "misc.h"
-#include "mlvalues.h"
-
-extern code_t caml_start_code;
-extern asize_t caml_code_size;
-extern unsigned char * caml_saved_code;
-
-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);
-int caml_is_instruction (opcode_t instr1, opcode_t instr2);
-
-#ifdef THREADED_CODE
-extern char ** caml_instr_table;
-extern char * caml_instr_base;
-void caml_thread_code (code_t code, asize_t len);
-#endif
-
-#endif /* CAML_FIX_CODE_H */
/* */
/***********************************************************************/
-/* The interface of this file is in "mlvalues.h" and "alloc.h" */
+/* The interface of this file is in "caml/mlvalues.h" and "caml/alloc.h" */
#include <math.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
-#include "alloc.h"
-#include "fail.h"
-#include "memory.h"
-#include "mlvalues.h"
-#include "misc.h"
-#include "reverse.h"
-#include "stacks.h"
+#include "caml/alloc.h"
+#include "caml/fail.h"
+#include "caml/memory.h"
+#include "caml/mlvalues.h"
+#include "caml/misc.h"
+#include "caml/reverse.h"
+#include "caml/stacks.h"
#ifdef _MSC_VER
#include <float.h>
error:
if (buf != parse_buffer) caml_stat_free(buf);
caml_failwith("float_of_string");
+ return Val_unit; /* not reached */
}
CAMLprim value caml_int_of_float(value f)
CAMLprim value caml_classify_float(value vd)
{
/* Cygwin 1.3 has problems with fpclassify (PR#1293), so don't use it */
-#if defined(fpclassify) && !defined(__CYGWIN32__) && !defined(__MINGW32__)
+ /* FIXME Cygwin 1.3 is ancient! Revisit this decision. */
+#if defined(fpclassify) && !defined(__CYGWIN__) && !defined(__MINGW32__)
switch (fpclassify(Double_val(vd))) {
case FP_NAN:
return Val_int(FP_nan);
#include <string.h>
-#include "config.h"
-#include "freelist.h"
-#include "gc.h"
-#include "gc_ctrl.h"
-#include "memory.h"
-#include "major_gc.h"
-#include "misc.h"
-#include "mlvalues.h"
+#include "caml/config.h"
+#include "caml/freelist.h"
+#include "caml/gc.h"
+#include "caml/gc_ctrl.h"
+#include "caml/memory.h"
+#include "caml/major_gc.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
/* The free-list is kept sorted by increasing addresses.
This makes the merging of adjacent free blocks possible.
+++ /dev/null
-/***********************************************************************/
-/* */
-/* OCaml */
-/* */
-/* Damien Doligez, projet Para, 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. */
-/* */
-/***********************************************************************/
-
-/* Free lists of heap blocks. */
-
-#ifndef CAML_FREELIST_H
-#define CAML_FREELIST_H
-
-
-#include "misc.h"
-#include "mlvalues.h"
-
-extern asize_t caml_fl_cur_size; /* size in words */
-
-char *caml_fl_allocate (mlsize_t);
-void caml_fl_init_merge (void);
-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, int);
-void caml_set_allocation_policy (uintnat);
-
-
-#endif /* CAML_FREELIST_H */
+++ /dev/null
-/***********************************************************************/
-/* */
-/* OCaml */
-/* */
-/* Damien Doligez, projet Para, 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. */
-/* */
-/***********************************************************************/
-
-#ifndef CAML_GC_H
-#define CAML_GC_H
-
-
-#include "mlvalues.h"
-
-#define Caml_white (0 << 8)
-#define Caml_gray (1 << 8)
-#define Caml_blue (2 << 8)
-#define Caml_black (3 << 8)
-
-#define Color_hd(hd) ((color_t) ((hd) & Caml_black))
-#define Color_hp(hp) (Color_hd (Hd_hp (hp)))
-#define Color_val(val) (Color_hd (Hd_val (val)))
-
-#define Is_white_hd(hd) (Color_hd (hd) == Caml_white)
-#define Is_gray_hd(hd) (Color_hd (hd) == Caml_gray)
-#define Is_blue_hd(hd) (Color_hd (hd) == Caml_blue)
-#define Is_black_hd(hd) (Color_hd (hd) == Caml_black)
-
-#define Whitehd_hd(hd) (((hd) & ~Caml_black)/*| Caml_white*/)
-#define Grayhd_hd(hd) (((hd) & ~Caml_black) | Caml_gray)
-#define Blackhd_hd(hd) (((hd)/*& ~Caml_black*/)| Caml_black)
-#define Bluehd_hd(hd) (((hd) & ~Caml_black) | Caml_blue)
-
-/* This depends on the layout of the header. See [mlvalues.h]. */
-#define Make_header(wosize, tag, color) \
- (/*Assert ((wosize) <= Max_wosize),*/ \
- ((header_t) (((header_t) (wosize) << 10) \
- + (color) \
- + (tag_t) (tag))) \
- )
-
-#define Is_white_val(val) (Color_val(val) == Caml_white)
-#define Is_gray_val(val) (Color_val(val) == Caml_gray)
-#define Is_blue_val(val) (Color_val(val) == Caml_blue)
-#define Is_black_val(val) (Color_val(val) == Caml_black)
-
-/* For extern.c */
-#define Colornum_hd(hd) ((color_t) (((hd) >> 8) & 3))
-#define Coloredhd_hd(hd,colnum) (((hd) & ~Caml_black) | ((colnum) << 8))
-
-#endif /* CAML_GC_H */
/* */
/***********************************************************************/
-#include "alloc.h"
-#include "compact.h"
-#include "custom.h"
-#include "finalise.h"
-#include "freelist.h"
-#include "gc.h"
-#include "gc_ctrl.h"
-#include "major_gc.h"
-#include "minor_gc.h"
-#include "misc.h"
-#include "mlvalues.h"
+#include "caml/alloc.h"
+#include "caml/compact.h"
+#include "caml/custom.h"
+#include "caml/finalise.h"
+#include "caml/freelist.h"
+#include "caml/gc.h"
+#include "caml/gc_ctrl.h"
+#include "caml/major_gc.h"
+#include "caml/minor_gc.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
#ifdef NATIVE_CODE
#include "stack.h"
#else
-#include "stacks.h"
+#include "caml/stacks.h"
#endif
#ifndef NATIVE_CODE
+++ /dev/null
-/***********************************************************************/
-/* */
-/* OCaml */
-/* */
-/* Damien Doligez, projet Para, 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. */
-/* */
-/***********************************************************************/
-
-#ifndef CAML_GC_CTRL_H
-#define CAML_GC_CTRL_H
-
-#include "misc.h"
-
-extern double
- caml_stat_minor_words,
- caml_stat_promoted_words,
- caml_stat_major_words;
-
-extern intnat
- caml_stat_minor_collections,
- caml_stat_major_collections,
- caml_stat_heap_size,
- caml_stat_top_heap_size,
- caml_stat_compactions,
- caml_stat_heap_chunks;
-
-uintnat caml_normalize_heap_increment (uintnat);
-
-void caml_init_gc (uintnat, uintnat, uintnat,
- uintnat, uintnat);
-
-
-#ifdef DEBUG
-void caml_heap_check (void);
-#endif
-
-#endif /* CAML_GC_CTRL_H */
/* Registration of global memory roots */
-#include "memory.h"
-#include "misc.h"
-#include "mlvalues.h"
-#include "roots.h"
-#include "globroots.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/roots.h"
+#include "caml/globroots.h"
/* The sets of global memory roots are represented as skip lists
(see William Pugh, "Skip lists: a probabilistic alternative to
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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. */
-/* */
-/***********************************************************************/
-
-/* Registration of global memory roots */
-
-#ifndef CAML_GLOBROOTS_H
-#define CAML_GLOBROOTS_H
-
-#include "mlvalues.h"
-#include "roots.h"
-
-void caml_scan_global_roots(scanning_action f);
-void caml_scan_global_young_roots(scanning_action f);
-
-#endif /* CAML_GLOBROOTS_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"
+#include "caml/mlvalues.h"
+#include "caml/custom.h"
+#include "caml/memory.h"
+#include "caml/hash.h"
/* The new implementation, based on MurmurHash 3,
http://code.google.com/p/smhasher/ */
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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
#include <string.h>
#include <ctype.h>
-#include "instruct.h"
-#include "misc.h"
-#include "mlvalues.h"
-#include "opnames.h"
-#include "prims.h"
-#include "stacks.h"
+#include "caml/instruct.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/opnames.h"
+#include "caml/prims.h"
+#include "caml/stacks.h"
extern code_t caml_start_code;
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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. */
-/* */
-/***********************************************************************/
-
-/* Trace the instructions executed */
-
-#ifndef _instrtrace_
-#define _instrtrace_
-
-
-#include "mlvalues.h"
-#include "misc.h"
-
-extern int caml_trace_flag;
-extern intnat caml_icount;
-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);
-#endif
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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. */
-/* */
-/***********************************************************************/
-
-/* The instruction set. */
-
-#ifndef CAML_INSTRUCT_H
-#define CAML_INSTRUCT_H
-
-enum instructions {
- ACC0, ACC1, ACC2, ACC3, ACC4, ACC5, ACC6, ACC7,
- ACC, PUSH,
- PUSHACC0, PUSHACC1, PUSHACC2, PUSHACC3,
- PUSHACC4, PUSHACC5, PUSHACC6, PUSHACC7,
- PUSHACC, POP, ASSIGN,
- ENVACC1, ENVACC2, ENVACC3, ENVACC4, ENVACC,
- PUSHENVACC1, PUSHENVACC2, PUSHENVACC3, PUSHENVACC4, PUSHENVACC,
- PUSH_RETADDR, APPLY, APPLY1, APPLY2, APPLY3,
- APPTERM, APPTERM1, APPTERM2, APPTERM3,
- RETURN, RESTART, GRAB,
- CLOSURE, CLOSUREREC,
- OFFSETCLOSUREM2, OFFSETCLOSURE0, OFFSETCLOSURE2, OFFSETCLOSURE,
- PUSHOFFSETCLOSUREM2, PUSHOFFSETCLOSURE0,
- PUSHOFFSETCLOSURE2, PUSHOFFSETCLOSURE,
- GETGLOBAL, PUSHGETGLOBAL, GETGLOBALFIELD, PUSHGETGLOBALFIELD, SETGLOBAL,
- ATOM0, ATOM, PUSHATOM0, PUSHATOM,
- MAKEBLOCK, MAKEBLOCK1, MAKEBLOCK2, MAKEBLOCK3, MAKEFLOATBLOCK,
- GETFIELD0, GETFIELD1, GETFIELD2, GETFIELD3, GETFIELD, GETFLOATFIELD,
- SETFIELD0, SETFIELD1, SETFIELD2, SETFIELD3, SETFIELD, SETFLOATFIELD,
- VECTLENGTH, GETVECTITEM, SETVECTITEM,
- GETSTRINGCHAR, SETSTRINGCHAR,
- BRANCH, BRANCHIF, BRANCHIFNOT, SWITCH, BOOLNOT,
- PUSHTRAP, POPTRAP, RAISE,
- CHECK_SIGNALS,
- C_CALL1, C_CALL2, C_CALL3, C_CALL4, C_CALL5, C_CALLN,
- CONST0, CONST1, CONST2, CONST3, CONSTINT,
- PUSHCONST0, PUSHCONST1, PUSHCONST2, PUSHCONST3, PUSHCONSTINT,
- NEGINT, ADDINT, SUBINT, MULINT, DIVINT, MODINT,
- ANDINT, ORINT, XORINT, LSLINT, LSRINT, ASRINT,
- EQ, NEQ, LTINT, LEINT, GTINT, GEINT,
- OFFSETINT, OFFSETREF, ISINT,
- GETMETHOD,
- BEQ, BNEQ, BLTINT, BLEINT, BGTINT, BGEINT,
- ULTINT, UGEINT,
- BULTINT, BUGEINT,
- GETPUBMET, GETDYNMET,
- STOP,
- EVENT, BREAK,
- RERAISE, RAISE_NOTRACE,
-FIRST_UNIMPLEMENTED_OP};
-
-
-#endif /* CAML_INSTRUCT_H */
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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. */
-/* */
-/***********************************************************************/
-
-/* Software emulation of 64-bit integer arithmetic, for C compilers
- that do not support it. */
-
-#ifndef CAML_INT64_EMUL_H
-#define CAML_INT64_EMUL_H
-
-#include <math.h>
-
-#ifdef ARCH_BIG_ENDIAN
-#define I64_literal(hi,lo) { hi, lo }
-#else
-#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)
-{
- if (x.h > y.h) return 1;
- if (x.h < y.h) return -1;
- if (x.l > y.l) return 1;
- if (x.l < y.l) return -1;
- return 0;
-}
-
-#define I64_ult(x, y) (I64_ucompare(x, y) < 0)
-
-/* Signed comparison */
-static int I64_compare(int64 x, int64 y)
-{
- if ((int32)x.h > (int32)y.h) return 1;
- if ((int32)x.h < (int32)y.h) return -1;
- if (x.l > y.l) return 1;
- if (x.l < y.l) return -1;
- return 0;
-}
-
-/* Negation */
-static int64 I64_neg(int64 x)
-{
- int64 res;
- res.l = -x.l;
- res.h = ~x.h;
- if (res.l == 0) res.h++;
- return res;
-}
-
-/* Addition */
-static int64 I64_add(int64 x, int64 y)
-{
- int64 res;
- res.l = x.l + y.l;
- res.h = x.h + y.h;
- if (res.l < x.l) res.h++;
- return res;
-}
-
-/* Subtraction */
-static int64 I64_sub(int64 x, int64 y)
-{
- int64 res;
- res.l = x.l - y.l;
- res.h = x.h - y.h;
- if (x.l < y.l) res.h--;
- return res;
-}
-
-/* Multiplication */
-static int64 I64_mul(int64 x, int64 y)
-{
- int64 res;
- uint32 prod00 = (x.l & 0xFFFF) * (y.l & 0xFFFF);
- uint32 prod10 = (x.l >> 16) * (y.l & 0xFFFF);
- uint32 prod01 = (x.l & 0xFFFF) * (y.l >> 16);
- uint32 prod11 = (x.l >> 16) * (y.l >> 16);
- res.l = prod00;
- res.h = prod11 + (prod01 >> 16) + (prod10 >> 16);
- prod01 = prod01 << 16; res.l += prod01; if (res.l < prod01) res.h++;
- prod10 = prod10 << 16; res.l += prod10; if (res.l < prod10) res.h++;
- res.h += x.l * y.h + x.h * y.l;
- return res;
-}
-
-#define I64_is_zero(x) (((x).l | (x).h) == 0)
-#define I64_is_negative(x) ((int32) (x).h < 0)
-#define I64_is_min_int(x) ((x).l == 0 && (x).h == 0x80000000U)
-#define I64_is_minus_one(x) (((x).l & (x).h) == 0xFFFFFFFFU)
-
-/* Bitwise operations */
-static int64 I64_and(int64 x, int64 y)
-{
- int64 res;
- res.l = x.l & y.l;
- res.h = x.h & y.h;
- return res;
-}
-
-static int64 I64_or(int64 x, int64 y)
-{
- int64 res;
- res.l = x.l | y.l;
- res.h = x.h | y.h;
- return res;
-}
-
-static int64 I64_xor(int64 x, int64 y)
-{
- int64 res;
- res.l = x.l ^ y.l;
- res.h = x.h ^ y.h;
- return res;
-}
-
-/* Shifts */
-static int64 I64_lsl(int64 x, int s)
-{
- int64 res;
- s = s & 63;
- if (s == 0) return x;
- if (s < 32) {
- res.l = x.l << s;
- res.h = (x.h << s) | (x.l >> (32 - s));
- } else {
- res.l = 0;
- res.h = x.l << (s - 32);
- }
- return res;
-}
-
-static int64 I64_lsr(int64 x, int s)
-{
- int64 res;
- s = s & 63;
- if (s == 0) return x;
- if (s < 32) {
- res.l = (x.l >> s) | (x.h << (32 - s));
- res.h = x.h >> s;
- } else {
- res.l = x.h >> (s - 32);
- res.h = 0;
- }
- return res;
-}
-
-static int64 I64_asr(int64 x, int s)
-{
- int64 res;
- s = s & 63;
- if (s == 0) return x;
- if (s < 32) {
- res.l = (x.l >> s) | (x.h << (32 - s));
- res.h = (int32) x.h >> s;
- } else {
- res.l = (int32) x.h >> (s - 32);
- res.h = (int32) x.h >> 31;
- }
- return res;
-}
-
-/* Division and modulus */
-
-#define I64_SHL1(x) x.h = (x.h << 1) | (x.l >> 31); x.l <<= 1
-#define I64_SHR1(x) x.l = (x.l >> 1) | (x.h << 31); x.h >>= 1
-
-static void I64_udivmod(uint64 modulus, uint64 divisor,
- uint64 * quo, uint64 * mod)
-{
- int64 quotient, mask;
- int cmp;
-
- quotient.h = 0; quotient.l = 0;
- mask.h = 0; mask.l = 1;
- while ((int32) divisor.h >= 0) {
- cmp = I64_ucompare(divisor, modulus);
- I64_SHL1(divisor);
- I64_SHL1(mask);
- if (cmp >= 0) break;
- }
- while (mask.l | mask.h) {
- if (I64_ucompare(modulus, divisor) >= 0) {
- quotient.h |= mask.h; quotient.l |= mask.l;
- modulus = I64_sub(modulus, divisor);
- }
- I64_SHR1(mask);
- I64_SHR1(divisor);
- }
- *quo = quotient;
- *mod = modulus;
-}
-
-static int64 I64_div(int64 x, int64 y)
-{
- int64 q, r;
- int32 sign;
-
- sign = x.h ^ y.h;
- if ((int32) x.h < 0) x = I64_neg(x);
- if ((int32) y.h < 0) y = I64_neg(y);
- I64_udivmod(x, y, &q, &r);
- if (sign < 0) q = I64_neg(q);
- return q;
-}
-
-static int64 I64_mod(int64 x, int64 y)
-{
- int64 q, r;
- int32 sign;
-
- sign = x.h;
- if ((int32) x.h < 0) x = I64_neg(x);
- if ((int32) y.h < 0) y = I64_neg(y);
- I64_udivmod(x, y, &q, &r);
- if (sign < 0) r = I64_neg(r);
- return r;
-}
-
-/* Coercions */
-
-static int64 I64_of_int32(int32 x)
-{
- int64 res;
- res.l = x;
- res.h = x >> 31;
- return res;
-}
-
-#define I64_to_int32(x) ((int32) (x).l)
-
-/* Note: we assume sizeof(intnat) = 4 here, which is true otherwise
- autoconfiguration would have selected native 64-bit integers */
-#define I64_of_intnat I64_of_int32
-#define I64_to_intnat I64_to_int32
-
-static double I64_to_double(int64 x)
-{
- double res;
- int32 sign = x.h;
- if (sign < 0) x = I64_neg(x);
- res = ldexp((double) x.h, 32) + x.l;
- if (sign < 0) res = -res;
- return res;
-}
-
-static int64 I64_of_double(double f)
-{
- int64 res;
- double frac, integ;
- int neg;
-
- neg = (f < 0);
- f = fabs(f);
- frac = modf(ldexp(f, -32), &integ);
- res.h = (uint32) integ;
- res.l = (uint32) ldexp(frac, 32);
- if (neg) res = I64_neg(res);
- 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 */
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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. */
-/* */
-/***********************************************************************/
-
-/* printf-like formatting of 64-bit integers, in case the C library
- printf() function does not support them. */
-
-#ifndef CAML_INT64_FORMAT_H
-#define CAML_INT64_FORMAT_H
-
-static void I64_format(char * buffer, char * fmt, int64 x)
-{
- static char conv_lower[] = "0123456789abcdef";
- static char conv_upper[] = "0123456789ABCDEF";
- char rawbuffer[24];
- char justify, signstyle, filler, alternate, signedconv;
- int base, width, sign, i, rawlen;
- char * cvtbl;
- char * p, * r;
- int64 wbase, digit;
-
- /* Parsing of format */
- justify = '+';
- signstyle = '-';
- filler = ' ';
- alternate = 0;
- base = 0;
- signedconv = 0;
- width = 0;
- cvtbl = conv_lower;
- for (p = fmt; *p != 0; p++) {
- switch (*p) {
- case '-':
- justify = '-'; break;
- case '+': case ' ':
- signstyle = *p; break;
- case '0':
- filler = '0'; break;
- case '#':
- alternate = 1; break;
- case '1': case '2': case '3': case '4': case '5':
- case '6': case '7': case '8': case '9':
- width = atoi(p);
- while (p[1] >= '0' && p[1] <= '9') p++;
- break;
- case 'd': case 'i':
- signedconv = 1; /* fallthrough */
- case 'u':
- base = 10; break;
- case 'x':
- base = 16; break;
- case 'X':
- base = 16; cvtbl = conv_upper; break;
- case 'o':
- base = 8; break;
- }
- }
- if (base == 0) { buffer[0] = 0; return; }
- /* Do the conversion */
- sign = 1;
- if (signedconv && I64_is_negative(x)) { sign = -1; x = I64_neg(x); }
- r = rawbuffer + sizeof(rawbuffer);
- wbase = I64_of_int32(base);
- do {
- I64_udivmod(x, wbase, &x, &digit);
- *--r = cvtbl[I64_to_int32(digit)];
- } while (! I64_is_zero(x));
- rawlen = rawbuffer + sizeof(rawbuffer) - r;
- /* Adjust rawlen to reflect additional chars (sign, etc) */
- if (signedconv && (sign < 0 || signstyle != '-')) rawlen++;
- if (alternate) {
- if (base == 8) rawlen += 1;
- if (base == 16) rawlen += 2;
- }
- /* Do the formatting */
- p = buffer;
- if (justify == '+' && filler == ' ') {
- for (i = rawlen; i < width; i++) *p++ = ' ';
- }
- if (signedconv) {
- if (sign < 0) *p++ = '-';
- else if (signstyle != '-') *p++ = signstyle;
- }
- if (alternate && base == 8) *p++ = '0';
- if (alternate && base == 16) { *p++ = '0'; *p++ = 'x'; }
- if (justify == '+' && filler == '0') {
- for (i = rawlen; i < width; i++) *p++ = '0';
- }
- while (r < rawbuffer + sizeof(rawbuffer)) *p++ = *r++;
- if (justify == '-') {
- for (i = rawlen; i < width; i++) *p++ = ' ';
- }
- *p = 0;
-}
-
-#endif /* CAML_INT64_FORMAT_H */
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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. */
-/* */
-/***********************************************************************/
-
-/* Wrapper macros around native 64-bit integer arithmetic,
- so that it has the same interface as the software emulation
- provided in int64_emul.h */
-
-#ifndef CAML_INT64_NATIVE_H
-#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))
-#define I64_add(x,y) ((x) + (y))
-#define I64_sub(x,y) ((x) - (y))
-#define I64_mul(x,y) ((x) * (y))
-#define I64_is_zero(x) ((x) == 0)
-#define I64_is_negative(x) ((x) < 0)
-#define I64_is_min_int(x) ((x) == ((int64)1 << 63))
-#define I64_is_minus_one(x) ((x) == -1)
-
-#define I64_div(x,y) ((x) / (y))
-#define I64_mod(x,y) ((x) % (y))
-#define I64_udivmod(x,y,quo,rem) \
- (*(rem) = (uint64)(x) % (uint64)(y), \
- *(quo) = (uint64)(x) / (uint64)(y))
-#define I64_and(x,y) ((x) & (y))
-#define I64_or(x,y) ((x) | (y))
-#define I64_xor(x,y) ((x) ^ (y))
-#define I64_lsl(x,y) ((x) << (y))
-#define I64_asr(x,y) ((x) >> (y))
-#define I64_lsr(x,y) ((uint64)(x) >> (y))
-#define I64_to_intnat(x) ((intnat) (x))
-#define I64_of_intnat(x) ((intnat) (x))
-#define I64_to_int32(x) ((int32) (x))
-#define I64_of_int32(x) ((int64) (x))
-#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 */
/* Structured input, compact format */
-/* The interface of this file is "intext.h" */
+/* The interface of this file is "caml/intext.h" */
#include <string.h>
#include <stdio.h>
-#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"
-#include "reverse.h"
+#include "caml/alloc.h"
+#include "caml/callback.h"
+#include "caml/custom.h"
+#include "caml/fail.h"
+#include "caml/gc.h"
+#include "caml/intext.h"
+#include "caml/io.h"
+#include "caml/md5.h"
+#include "caml/memory.h"
+#include "caml/mlvalues.h"
+#include "caml/misc.h"
+#include "caml/reverse.h"
static unsigned char * intern_src;
/* Reading pointer in block holding input data. */
/* The bytecode interpreter */
#include <stdio.h>
-#include "alloc.h"
-#include "backtrace.h"
-#include "callback.h"
-#include "debugger.h"
-#include "fail.h"
-#include "fix_code.h"
-#include "instrtrace.h"
-#include "instruct.h"
-#include "interp.h"
-#include "major_gc.h"
-#include "memory.h"
-#include "misc.h"
-#include "mlvalues.h"
-#include "prims.h"
-#include "signals.h"
-#include "stacks.h"
+#include "caml/alloc.h"
+#include "caml/backtrace.h"
+#include "caml/callback.h"
+#include "caml/debugger.h"
+#include "caml/fail.h"
+#include "caml/fix_code.h"
+#include "caml/instrtrace.h"
+#include "caml/instruct.h"
+#include "caml/interp.h"
+#include "caml/major_gc.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/prims.h"
+#include "caml/signals.h"
+#include "caml/stacks.h"
/* Registers for the abstract machine:
pc the code pointer
#ifdef THREADED_CODE
static void * jumptable[] = {
-# include "jumptbl.h"
+# include "caml/jumptbl.h"
};
#endif
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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. */
-/* */
-/***********************************************************************/
-
-/* The bytecode interpreter */
-
-#ifndef CAML_INTERP_H
-#define CAML_INTERP_H
-
-#include "misc.h"
-#include "mlvalues.h"
-
-/* interpret a bytecode */
-value caml_interprete (code_t prog, asize_t prog_size);
-
-/* tell the runtime that a bytecode program might be needed */
-void caml_prepare_bytecode(code_t prog, asize_t prog_size);
-
-/* tell the runtime that a bytecode program is no more needed */
-void caml_release_bytecode(code_t prog, asize_t prog_size);
-
-#endif /* CAML_INTERP_H */
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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. */
-/* */
-/***********************************************************************/
-
-/* Structured input/output */
-
-#ifndef CAML_INTEXT_H
-#define CAML_INTEXT_H
-
-#ifndef CAML_NAME_SPACE
-#include "compatibility.h"
-#endif
-#include "misc.h"
-#include "mlvalues.h"
-
-/* <private> */
-#include "io.h"
-
-/* Magic number */
-
-#define Intext_magic_number 0x8495A6BE
-
-/* Codes for the compact format */
-
-#define PREFIX_SMALL_BLOCK 0x80
-#define PREFIX_SMALL_INT 0x40
-#define PREFIX_SMALL_STRING 0x20
-#define CODE_INT8 0x0
-#define CODE_INT16 0x1
-#define CODE_INT32 0x2
-#define CODE_INT64 0x3
-#define CODE_SHARED8 0x4
-#define CODE_SHARED16 0x5
-#define CODE_SHARED32 0x6
-#define CODE_BLOCK32 0x8
-#define CODE_BLOCK64 0x13
-#define CODE_STRING8 0x9
-#define CODE_STRING32 0xA
-#define CODE_DOUBLE_BIG 0xB
-#define CODE_DOUBLE_LITTLE 0xC
-#define CODE_DOUBLE_ARRAY8_BIG 0xD
-#define CODE_DOUBLE_ARRAY8_LITTLE 0xE
-#define CODE_DOUBLE_ARRAY32_BIG 0xF
-#define CODE_DOUBLE_ARRAY32_LITTLE 0x7
-#define CODE_CODEPOINTER 0x10
-#define CODE_INFIXPOINTER 0x11
-#define CODE_CUSTOM 0x12
-
-#if ARCH_FLOAT_ENDIANNESS == 0x76543210
-#define CODE_DOUBLE_NATIVE CODE_DOUBLE_BIG
-#define CODE_DOUBLE_ARRAY8_NATIVE CODE_DOUBLE_ARRAY8_BIG
-#define CODE_DOUBLE_ARRAY32_NATIVE CODE_DOUBLE_ARRAY32_BIG
-#else
-#define CODE_DOUBLE_NATIVE CODE_DOUBLE_LITTLE
-#define CODE_DOUBLE_ARRAY8_NATIVE CODE_DOUBLE_ARRAY8_LITTLE
-#define CODE_DOUBLE_ARRAY32_NATIVE CODE_DOUBLE_ARRAY32_LITTLE
-#endif
-
-/* Size-ing data structures for extern. Chosen so that
- sizeof(struct trail_block) and sizeof(struct output_block)
- are slightly below 8Kb. */
-
-#define ENTRIES_PER_TRAIL_BLOCK 1025
-#define SIZE_EXTERN_OUTPUT_BLOCK 8100
-
-/* The entry points */
-
-void caml_output_val (struct channel * chan, value v, value flags);
- /* Output [v] with flags [flags] on the channel [chan]. */
-
-/* </private> */
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-CAMLextern void caml_output_value_to_malloc(value v, value flags,
- /*out*/ char ** buf,
- /*out*/ intnat * len);
- /* Output [v] with flags [flags] to a memory buffer allocated with
- malloc. On return, [*buf] points to the buffer and [*len]
- contains the number of bytes in buffer. */
-CAMLextern intnat caml_output_value_to_block(value v, value flags,
- char * data, intnat len);
- /* Output [v] with flags [flags] to a user-provided memory buffer.
- [data] points to the start of this buffer, and [len] is its size
- in bytes. Return the number of bytes actually written in buffer.
- Raise [Failure] if buffer is too short. */
-
-/* <private> */
-value caml_input_val (struct channel * chan);
- /* Read a structured value from the channel [chan]. */
-/* </private> */
-
-CAMLextern value caml_input_val_from_string (value str, intnat ofs);
- /* 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
- to the beginning of the buffer, and [ofs] is the offset of the
- beginning of the externed data in this buffer. The buffer is
- deallocated with [free] on return, or if an exception is raised. */
-CAMLextern value caml_input_value_from_block(char * data, intnat len);
- /* Read a structured value from a user-provided buffer. [data] points
- to the beginning of the externed data in this buffer,
- and [len] is the length in bytes of valid data in this buffer.
- The buffer is never deallocated by this routine. */
-
-/* Functions for writing user-defined marshallers */
-
-CAMLextern void caml_serialize_int_1(int i);
-CAMLextern void caml_serialize_int_2(int i);
-CAMLextern void caml_serialize_int_4(int32 i);
-CAMLextern void caml_serialize_int_8(int64 i);
-CAMLextern void caml_serialize_float_4(float f);
-CAMLextern void caml_serialize_float_8(double f);
-CAMLextern void caml_serialize_block_1(void * data, intnat len);
-CAMLextern void caml_serialize_block_2(void * data, intnat len);
-CAMLextern void caml_serialize_block_4(void * data, intnat len);
-CAMLextern void caml_serialize_block_8(void * data, intnat len);
-CAMLextern void caml_serialize_block_float_8(void * data, intnat len);
-
-CAMLextern int caml_deserialize_uint_1(void);
-CAMLextern int caml_deserialize_sint_1(void);
-CAMLextern int caml_deserialize_uint_2(void);
-CAMLextern int caml_deserialize_sint_2(void);
-CAMLextern uint32 caml_deserialize_uint_4(void);
-CAMLextern int32 caml_deserialize_sint_4(void);
-CAMLextern uint64 caml_deserialize_uint_8(void);
-CAMLextern int64 caml_deserialize_sint_8(void);
-CAMLextern float caml_deserialize_float_4(void);
-CAMLextern double caml_deserialize_float_8(void);
-CAMLextern void caml_deserialize_block_1(void * data, intnat len);
-CAMLextern void caml_deserialize_block_2(void * data, intnat len);
-CAMLextern void caml_deserialize_block_4(void * data, intnat len);
-CAMLextern void caml_deserialize_block_8(void * data, intnat len);
-CAMLextern void caml_deserialize_block_float_8(void * data, intnat len);
-CAMLextern void caml_deserialize_error(char * msg);
-
-/* <private> */
-
-/* Auxiliary stuff for sending code pointers */
-
-struct code_fragment {
- char * code_start;
- char * code_end;
- unsigned char digest[16];
- char digest_computed;
-};
-
-struct ext_table caml_code_fragments_table;
-
-/* </private> */
-
-#ifdef __cplusplus
-}
-#endif
-
-#endif /* CAML_INTEXT_H */
#include <stdio.h>
#include <string.h>
-#include "alloc.h"
-#include "custom.h"
-#include "fail.h"
-#include "intext.h"
-#include "memory.h"
-#include "misc.h"
-#include "mlvalues.h"
+#include "caml/alloc.h"
+#include "caml/custom.h"
+#include "caml/fail.h"
+#include "caml/intext.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
static char * parse_sign_and_base(char * p,
/*out*/ int * base,
#include <limits.h>
#include <string.h>
#include <sys/types.h>
-#include "config.h"
+#include "caml/config.h"
#ifdef HAS_UNISTD
#include <unistd.h>
#endif
#ifdef __CYGWIN__
#include </usr/include/io.h>
#endif
-#include "alloc.h"
-#include "custom.h"
-#include "fail.h"
-#include "io.h"
-#include "memory.h"
-#include "misc.h"
-#include "mlvalues.h"
-#include "signals.h"
-#include "sys.h"
+#include "caml/alloc.h"
+#include "caml/custom.h"
+#include "caml/fail.h"
+#include "caml/io.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/signals.h"
+#include "caml/sys.h"
#ifndef SEEK_SET
#define SEEK_SET 0
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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. */
-/* */
-/***********************************************************************/
-
-/* Buffered input/output */
-
-#ifndef CAML_IO_H
-#define CAML_IO_H
-
-#include "misc.h"
-#include "mlvalues.h"
-
-#ifndef IO_BUFFER_SIZE
-#define IO_BUFFER_SIZE 65536
-#endif
-
-#if defined(_WIN32)
-typedef __int64 file_offset;
-#elif defined(HAS_OFF_T)
-#include <sys/types.h>
-typedef off_t file_offset;
-#else
-typedef long file_offset;
-#endif
-
-struct channel {
- int fd; /* Unix file descriptor */
- file_offset offset; /* Absolute position of fd in the file */
- char * end; /* Physical end of the buffer */
- char * curr; /* Current position in the buffer */
- char * max; /* Logical end of the buffer (for input) */
- void * mutex; /* Placeholder for mutex (for systhreads) */
- struct channel * next, * prev;/* Double chaining of channels (flush_all) */
- int revealed; /* For Cash only */
- int old_revealed; /* For Cash only */
- int refcount; /* For flush_all and for Cash */
- int flags; /* Bitfield */
- char buff[IO_BUFFER_SIZE]; /* The buffer itself */
-};
-
-enum {
- CHANNEL_FLAG_FROM_SOCKET = 1 /* For Windows */
-};
-
-/* For an output channel:
- [offset] is the absolute position of the beginning of the buffer [buff].
- For an input channel:
- [offset] is the absolute position of the logical end of the buffer, [max].
-*/
-
-/* Functions and macros that can be called from C. Take arguments of
- type struct channel *. No locking is performed. */
-
-#define putch(channel, ch) do{ \
- if ((channel)->curr >= (channel)->end) caml_flush_partial(channel); \
- *((channel)->curr)++ = (ch); \
-}while(0)
-
-#define getch(channel) \
- ((channel)->curr >= (channel)->max \
- ? caml_refill(channel) \
- : (unsigned char) *((channel)->curr)++)
-
-CAMLextern struct channel * caml_open_descriptor_in (int);
-CAMLextern struct channel * caml_open_descriptor_out (int);
-CAMLextern void caml_close_channel (struct channel *);
-CAMLextern int caml_channel_binary_mode (struct channel *);
-CAMLextern value caml_alloc_channel(struct channel *chan);
-
-CAMLextern int caml_flush_partial (struct channel *);
-CAMLextern void caml_flush (struct channel *);
-CAMLextern void caml_putword (struct channel *, uint32);
-CAMLextern int caml_putblock (struct channel *, char *, intnat);
-CAMLextern void caml_really_putblock (struct channel *, char *, intnat);
-
-CAMLextern unsigned char caml_refill (struct channel *);
-CAMLextern uint32 caml_getword (struct channel *);
-CAMLextern int caml_getblock (struct channel *, char *, intnat);
-CAMLextern int caml_really_getblock (struct channel *, char *, intnat);
-
-/* Extract a struct channel * from the heap object representing it */
-
-#define Channel(v) (*((struct channel **) (Data_custom_val(v))))
-
-/* The locking machinery */
-
-CAMLextern void (*caml_channel_mutex_free) (struct channel *);
-CAMLextern void (*caml_channel_mutex_lock) (struct channel *);
-CAMLextern void (*caml_channel_mutex_unlock) (struct channel *);
-CAMLextern void (*caml_channel_mutex_unlock_exn) (void);
-
-CAMLextern struct channel * caml_all_opened_channels;
-
-#define Lock(channel) \
- if (caml_channel_mutex_lock != NULL) (*caml_channel_mutex_lock)(channel)
-#define Unlock(channel) \
- if (caml_channel_mutex_unlock != NULL) (*caml_channel_mutex_unlock)(channel)
-#define Unlock_exn() \
- if (caml_channel_mutex_unlock_exn != NULL) (*caml_channel_mutex_unlock_exn)()
-
-/* Conversion between file_offset and int64 */
-
-#define Val_file_offset(fofs) caml_copy_int64(fofs)
-#define File_offset_val(v) ((file_offset) Int64_val(v))
-
-#endif /* CAML_IO_H */
/* The table-driven automaton for lexers generated by camllex. */
-#include "fail.h"
-#include "mlvalues.h"
-#include "stacks.h"
+#include "caml/fail.h"
+#include "caml/mlvalues.h"
+#include "caml/stacks.h"
struct lexer_buffer {
value refill_buff;
/* Main entry point (can be overridden by a user-provided main()
function that calls caml_main() later). */
-#include "misc.h"
-#include "mlvalues.h"
-#include "sys.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/sys.h"
CAMLextern void caml_main (char **);
#include <limits.h>
-#include "compact.h"
-#include "custom.h"
-#include "config.h"
-#include "fail.h"
-#include "finalise.h"
-#include "freelist.h"
-#include "gc.h"
-#include "gc_ctrl.h"
-#include "major_gc.h"
-#include "misc.h"
-#include "mlvalues.h"
-#include "roots.h"
-#include "weak.h"
+#include "caml/compact.h"
+#include "caml/custom.h"
+#include "caml/config.h"
+#include "caml/fail.h"
+#include "caml/finalise.h"
+#include "caml/freelist.h"
+#include "caml/gc.h"
+#include "caml/gc_ctrl.h"
+#include "caml/major_gc.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/roots.h"
+#include "caml/weak.h"
#if defined (NATIVE_CODE) && defined (NO_NAKED_POINTERS)
#define NATIVE_CODE_AND_NO_NAKED_POINTERS
static unsigned long major_gc_counter = 0;
#endif
+void (*caml_major_gc_hook)(void) = NULL;
+
static void realloc_gray_vals (void)
{
value *new;
{
#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS
if (Is_block (v) && Wosize_val (v) > 0) {
- /* We insist that naked pointers to outside the heap point to things that
- look like values with headers coloured black. This isn't always
- strictly necessary but is essential in certain cases---in particular
- when the value is allocated in a read-only section. (For the values
- where it would be safe it is a performance improvement since we avoid
- putting them on the grey list.) */
- CAMLassert (Is_in_heap (v) || Is_black_hd (Hd_val (v)));
#else
if (Is_block (v) && Is_in_heap (v)) {
#endif
h = Hd_val (v);
t = Tag_hd (h);
}
+#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS
+ /* We insist that naked pointers to outside the heap point to things that
+ look like values with headers coloured black. This isn't always
+ strictly necessary but is essential in certain cases---in particular
+ when the value is allocated in a read-only section. (For the values
+ where it would be safe it is a performance improvement since we avoid
+ putting them on the grey list.) */
+ CAMLassert (Is_in_heap (v) || Is_black_hd (h));
+#endif
CAMLassert (!Is_blue_hd (h));
if (Is_white_hd (h)){
if (t < No_scan_tag){
int marking_closure = 0;
#endif
+ if (caml_major_slice_begin_hook != NULL) (*caml_major_slice_begin_hook) ();
caml_gc_message (0x40, "Marking %ld words\n", work);
caml_gc_message (0x40, "Subphase = %ld\n", caml_gc_subphase);
gray_vals_ptr = gray_vals_cur;
be reliably determined, so we always use the page table when
marking such values. */
&& (!marking_closure || Is_in_heap (child))) {
- /* See [caml_darken] for a description of this assertion. */
- CAMLassert (Is_in_heap (child) || Is_black_hd (Hd_val (child)));
#else
if (Is_block (child) && Is_in_heap (child)) {
#endif
child -= Infix_offset_val(child);
hd = Hd_val(child);
}
+#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS
+ /* See [caml_darken] for a description of this assertion. */
+ CAMLassert (Is_in_heap (child) || Is_black_hd (hd));
+#endif
if (Is_white_hd (hd)){
Hd_val (child) = Grayhd_hd (hd);
*gray_vals_ptr++ = child;
limit = chunk + Chunk_size (chunk);
work = 0;
caml_fl_size_at_phase_change = caml_fl_cur_size;
+ if (caml_major_gc_hook) (*caml_major_gc_hook)();
}
break;
default: Assert (0);
}
}
gray_vals_cur = gray_vals_ptr;
+ if (caml_major_slice_end_hook != NULL) (*caml_major_slice_end_hook) ();
}
static void sweep_slice (intnat work)
char *hp;
header_t hd;
+ if (caml_major_slice_begin_hook != NULL) (*caml_major_slice_begin_hook) ();
caml_gc_message (0x40, "Sweeping %ld words\n", work);
while (work > 0){
if (caml_gc_sweep_hp < limit){
}
}
}
+ if (caml_major_slice_end_hook != NULL) (*caml_major_slice_end_hook) ();
}
/* The main entry point for the GC. Called after each minor GC.
+++ /dev/null
-/***********************************************************************/
-/* */
-/* OCaml */
-/* */
-/* Damien Doligez, projet Para, 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. */
-/* */
-/***********************************************************************/
-
-#ifndef CAML_MAJOR_GC_H
-#define CAML_MAJOR_GC_H
-
-
-#include "freelist.h"
-#include "misc.h"
-
-typedef struct {
- void *block; /* address of the malloced block this chunk live in */
- asize_t alloc; /* in bytes, used for compaction */
- asize_t size; /* in bytes */
- char *next;
-} heap_chunk_head;
-
-#define Chunk_size(c) (((heap_chunk_head *) (c)) [-1]).size
-#define Chunk_alloc(c) (((heap_chunk_head *) (c)) [-1]).alloc
-#define Chunk_next(c) (((heap_chunk_head *) (c)) [-1]).next
-#define Chunk_block(c) (((heap_chunk_head *) (c)) [-1]).block
-
-extern int caml_gc_phase;
-extern int caml_gc_subphase;
-extern uintnat caml_allocated_words;
-extern double caml_extra_heap_resources;
-extern uintnat caml_dependent_size, caml_dependent_allocated;
-extern uintnat caml_fl_size_at_phase_change;
-
-#define Phase_mark 0
-#define Phase_sweep 1
-#define Phase_idle 2
-#define Subphase_main 10
-#define Subphase_weak1 11
-#define Subphase_weak2 12
-#define Subphase_final 13
-
-CAMLextern char *caml_heap_start;
-extern uintnat total_heap_size;
-extern char *caml_gc_sweep_hp;
-
-void caml_init_major_heap (asize_t); /* size in bytes */
-asize_t caml_round_heap_chunk_size (asize_t); /* size in bytes */
-void caml_darken (value, value *);
-intnat caml_major_collection_slice (intnat);
-void major_collection (void);
-void caml_finish_major_cycle (void);
-
-
-#endif /* CAML_MAJOR_GC_H */
/***********************************************************************/
#include <string.h>
-#include "alloc.h"
-#include "fail.h"
-#include "md5.h"
-#include "memory.h"
-#include "mlvalues.h"
-#include "io.h"
-#include "reverse.h"
+#include "caml/alloc.h"
+#include "caml/fail.h"
+#include "caml/md5.h"
+#include "caml/memory.h"
+#include "caml/mlvalues.h"
+#include "caml/io.h"
+#include "caml/reverse.h"
/* MD5 message digest */
return res;
}
-CAMLprim value caml_md5_chan(value vchan, value len)
+CAMLexport value caml_md5_channel(struct channel *chan, intnat toread)
{
- CAMLparam2 (vchan, len);
- struct channel * chan = Channel(vchan);
+ CAMLparam0();
struct MD5Context ctx;
value res;
- intnat toread, read;
+ intnat read;
char buffer[4096];
Lock(chan);
caml_MD5Init(&ctx);
- toread = Long_val(len);
if (toread < 0){
while (1){
read = caml_getblock (chan, buffer, sizeof(buffer));
CAMLreturn (res);
}
+CAMLprim value caml_md5_chan(value vchan, value len)
+{
+ CAMLparam2 (vchan, len);
+ CAMLreturn (caml_md5_channel(Channel(vchan), Long_val(len)));
+}
+
CAMLexport void caml_md5_block(unsigned char digest[16],
void * data, uintnat len)
{
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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. */
-/* */
-/***********************************************************************/
-
-/* MD5 message digest */
-
-#ifndef CAML_MD5_H
-#define CAML_MD5_H
-
-
-#include "mlvalues.h"
-#include "io.h"
-
-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];
- uint32 bits[2];
- unsigned char in[64];
-};
-
-CAMLextern void caml_MD5Init (struct MD5Context *context);
-CAMLextern void caml_MD5Update (struct MD5Context *context, unsigned char *buf,
- uintnat len);
-CAMLextern void caml_MD5Final (unsigned char *digest, struct MD5Context *ctx);
-CAMLextern void caml_MD5Transform (uint32 *buf, uint32 *in);
-
-
-#endif /* CAML_MD5_H */
#include <stdlib.h>
#include <string.h>
-#include "fail.h"
-#include "freelist.h"
-#include "gc.h"
-#include "gc_ctrl.h"
-#include "major_gc.h"
-#include "memory.h"
-#include "major_gc.h"
-#include "minor_gc.h"
-#include "misc.h"
-#include "mlvalues.h"
-#include "signals.h"
+#include "caml/address_class.h"
+#include "caml/fail.h"
+#include "caml/freelist.h"
+#include "caml/gc.h"
+#include "caml/gc_ctrl.h"
+#include "caml/major_gc.h"
+#include "caml/memory.h"
+#include "caml/major_gc.h"
+#include "caml/minor_gc.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/signals.h"
extern uintnat caml_percent_free; /* major_gc.c */
+++ /dev/null
-/***********************************************************************/
-/* */
-/* OCaml */
-/* */
-/* Damien Doligez, projet Para, 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. */
-/* */
-/***********************************************************************/
-
-/* Allocation macros and functions */
-
-#ifndef CAML_MEMORY_H
-#define CAML_MEMORY_H
-
-#ifndef CAML_NAME_SPACE
-#include "compatibility.h"
-#endif
-#include "config.h"
-/* <private> */
-#include "gc.h"
-#include "major_gc.h"
-#include "minor_gc.h"
-/* </private> */
-#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);
-CAMLextern void caml_free_dependent_memory (mlsize_t);
-CAMLextern void caml_modify (value *, value);
-CAMLextern void caml_initialize (value *, value);
-CAMLextern value caml_check_urgent_gc (value);
-CAMLextern void * caml_stat_alloc (asize_t); /* Size in bytes. */
-CAMLextern void caml_stat_free (void *);
-CAMLextern void * caml_stat_resize (void *, asize_t); /* Size in bytes. */
-char *caml_alloc_for_heap (asize_t request); /* Size in bytes. */
-void caml_free_for_heap (char *mem);
-int caml_add_to_heap (char *mem);
-color_t caml_allocation_color (void *hp);
-
-/* void caml_shrink_heap (char *); Only used in compact.c */
-
-/* <private> */
-
-#define Not_in_heap 0
-#define In_heap 1
-#define In_young 2
-#define In_static_data 4
-#define In_code_area 8
-
-#ifdef ARCH_SIXTYFOUR
-
-/* 64 bits: Represent page table as a sparse hash table */
-int caml_page_table_lookup(void * addr);
-#define Classify_addr(a) (caml_page_table_lookup((void *)(a)))
-
-#else
-
-/* 32 bits: Represent page table as a 2-level array */
-#define Pagetable2_log 11
-#define Pagetable2_size (1 << Pagetable2_log)
-#define Pagetable1_log (Page_log + Pagetable2_log)
-#define Pagetable1_size (1 << (32 - Pagetable1_log))
-CAMLextern unsigned char * caml_page_table[Pagetable1_size];
-
-#define Pagetable_index1(a) (((uintnat)(a)) >> Pagetable1_log)
-#define Pagetable_index2(a) \
- ((((uintnat)(a)) >> Page_log) & (Pagetable2_size - 1))
-#define Classify_addr(a) \
- caml_page_table[Pagetable_index1(a)][Pagetable_index2(a)]
-
-#endif
-
-#define Is_in_value_area(a) \
- (Classify_addr(a) & (In_heap | In_young | In_static_data))
-#define Is_in_heap(a) (Classify_addr(a) & In_heap)
-#define Is_in_heap_or_young(a) (Classify_addr(a) & (In_heap | In_young))
-
-int caml_page_table_add(int kind, void * start, void * end);
-int caml_page_table_remove(int kind, void * start, void * end);
-int caml_page_table_initialize(mlsize_t bytesize);
-
-#ifdef DEBUG
-#define DEBUG_clear(result, wosize) do{ \
- uintnat caml__DEBUG_i; \
- for (caml__DEBUG_i = 0; caml__DEBUG_i < (wosize); ++ caml__DEBUG_i){ \
- Field ((result), caml__DEBUG_i) = Debug_uninit_minor; \
- } \
-}while(0)
-#else
-#define DEBUG_clear(result, wosize)
-#endif
-
-#define Alloc_small(result, wosize, tag) do{ CAMLassert ((wosize) >= 1); \
- CAMLassert ((tag_t) (tag) < 256); \
- CAMLassert ((wosize) <= Max_young_wosize); \
- caml_young_ptr -= Bhsize_wosize (wosize); \
- if (caml_young_ptr < caml_young_start){ \
- caml_young_ptr += Bhsize_wosize (wosize); \
- Setup_for_gc; \
- caml_minor_collection (); \
- Restore_after_gc; \
- caml_young_ptr -= Bhsize_wosize (wosize); \
- } \
- Hd_hp (caml_young_ptr) = Make_header ((wosize), (tag), Caml_black); \
- (result) = Val_hp (caml_young_ptr); \
- DEBUG_clear ((result), (wosize)); \
-}while(0)
-
-/* Deprecated alias for [caml_modify] */
-
-#define Modify(fp,val) caml_modify((fp), (val))
-
-/* </private> */
-
-struct caml__roots_block {
- struct caml__roots_block *next;
- intnat ntables;
- intnat nitems;
- value *tables [5];
-};
-
-CAMLextern struct caml__roots_block *caml_local_roots; /* defined in roots.c */
-
-/* The following macros are used to declare C local variables and
- function parameters of type [value].
-
- The function body must start with one of the [CAMLparam] macros.
- If the function has no parameter of type [value], use [CAMLparam0].
- If the function has 1 to 5 [value] parameters, use the corresponding
- [CAMLparam] with the parameters as arguments.
- If the function has more than 5 [value] parameters, use [CAMLparam5]
- for the first 5 parameters, and one or more calls to the [CAMLxparam]
- macros for the others.
- If the function takes an array of [value]s as argument, use
- [CAMLparamN] to declare it (or [CAMLxparamN] if you already have a
- call to [CAMLparam] for some other arguments).
-
- 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, 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 OCaml.
- Do not use them for anything (local or global variables, struct or
- union tags, macros, etc.)
-*/
-
-#define CAMLparam0() \
- struct caml__roots_block *caml__frame = caml_local_roots
-
-#define CAMLparam1(x) \
- CAMLparam0 (); \
- CAMLxparam1 (x)
-
-#define CAMLparam2(x, y) \
- CAMLparam0 (); \
- CAMLxparam2 (x, y)
-
-#define CAMLparam3(x, y, z) \
- CAMLparam0 (); \
- CAMLxparam3 (x, y, z)
-
-#define CAMLparam4(x, y, z, t) \
- CAMLparam0 (); \
- CAMLxparam4 (x, y, z, t)
-
-#define CAMLparam5(x, y, z, t, u) \
- CAMLparam0 (); \
- CAMLxparam5 (x, y, z, t, u)
-
-#define CAMLparamN(x, size) \
- CAMLparam0 (); \
- CAMLxparamN (x, (size))
-
-
-#if defined(__GNUC__) && (__GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ > 7))
- #define CAMLunused __attribute__ ((unused))
-#else
- #define CAMLunused
-#endif
-
-#define CAMLxparam1(x) \
- struct caml__roots_block caml__roots_##x; \
- CAMLunused int caml__dummy_##x = ( \
- (caml__roots_##x.next = caml_local_roots), \
- (caml_local_roots = &caml__roots_##x), \
- (caml__roots_##x.nitems = 1), \
- (caml__roots_##x.ntables = 1), \
- (caml__roots_##x.tables [0] = &x), \
- 0)
-
-#define CAMLxparam2(x, y) \
- struct caml__roots_block caml__roots_##x; \
- CAMLunused int caml__dummy_##x = ( \
- (caml__roots_##x.next = caml_local_roots), \
- (caml_local_roots = &caml__roots_##x), \
- (caml__roots_##x.nitems = 1), \
- (caml__roots_##x.ntables = 2), \
- (caml__roots_##x.tables [0] = &x), \
- (caml__roots_##x.tables [1] = &y), \
- 0)
-
-#define CAMLxparam3(x, y, z) \
- struct caml__roots_block caml__roots_##x; \
- CAMLunused int caml__dummy_##x = ( \
- (caml__roots_##x.next = caml_local_roots), \
- (caml_local_roots = &caml__roots_##x), \
- (caml__roots_##x.nitems = 1), \
- (caml__roots_##x.ntables = 3), \
- (caml__roots_##x.tables [0] = &x), \
- (caml__roots_##x.tables [1] = &y), \
- (caml__roots_##x.tables [2] = &z), \
- 0)
-
-#define CAMLxparam4(x, y, z, t) \
- struct caml__roots_block caml__roots_##x; \
- CAMLunused int caml__dummy_##x = ( \
- (caml__roots_##x.next = caml_local_roots), \
- (caml_local_roots = &caml__roots_##x), \
- (caml__roots_##x.nitems = 1), \
- (caml__roots_##x.ntables = 4), \
- (caml__roots_##x.tables [0] = &x), \
- (caml__roots_##x.tables [1] = &y), \
- (caml__roots_##x.tables [2] = &z), \
- (caml__roots_##x.tables [3] = &t), \
- 0)
-
-#define CAMLxparam5(x, y, z, t, u) \
- struct caml__roots_block caml__roots_##x; \
- CAMLunused int caml__dummy_##x = ( \
- (caml__roots_##x.next = caml_local_roots), \
- (caml_local_roots = &caml__roots_##x), \
- (caml__roots_##x.nitems = 1), \
- (caml__roots_##x.ntables = 5), \
- (caml__roots_##x.tables [0] = &x), \
- (caml__roots_##x.tables [1] = &y), \
- (caml__roots_##x.tables [2] = &z), \
- (caml__roots_##x.tables [3] = &t), \
- (caml__roots_##x.tables [4] = &u), \
- 0)
-
-#define CAMLxparamN(x, size) \
- struct caml__roots_block caml__roots_##x; \
- CAMLunused int caml__dummy_##x = ( \
- (caml__roots_##x.next = caml_local_roots), \
- (caml_local_roots = &caml__roots_##x), \
- (caml__roots_##x.nitems = (size)), \
- (caml__roots_##x.ntables = 1), \
- (caml__roots_##x.tables[0] = &(x[0])), \
- 0)
-
-#define CAMLlocal1(x) \
- value x = Val_unit; \
- CAMLxparam1 (x)
-
-#define CAMLlocal2(x, y) \
- value x = Val_unit, y = Val_unit; \
- CAMLxparam2 (x, y)
-
-#define CAMLlocal3(x, y, z) \
- value x = Val_unit, y = Val_unit, z = Val_unit; \
- CAMLxparam3 (x, y, z)
-
-#define CAMLlocal4(x, y, z, t) \
- value x = Val_unit, y = Val_unit, z = Val_unit, t = Val_unit; \
- CAMLxparam4 (x, y, z, t)
-
-#define CAMLlocal5(x, y, z, t, u) \
- value x = Val_unit, y = Val_unit, z = Val_unit, t = Val_unit, u = Val_unit; \
- CAMLxparam5 (x, y, z, t, u)
-
-#define CAMLlocalN(x, size) \
- value x [(size)]; \
- int caml__i_##x; \
- for (caml__i_##x = 0; caml__i_##x < size; caml__i_##x ++) { \
- x[caml__i_##x] = Val_unit; \
- } \
- CAMLxparamN (x, (size))
-
-
-#define CAMLreturn0 do{ \
- caml_local_roots = caml__frame; \
- return; \
-}while (0)
-
-#define CAMLreturnT(type, result) do{ \
- type caml__temp_result = (result); \
- caml_local_roots = caml__frame; \
- return (caml__temp_result); \
-}while(0)
-
-#define CAMLreturn(result) CAMLreturnT(value, result)
-
-#define CAMLnoreturn ((void) caml__frame)
-
-
-/* convenience macro */
-#define Store_field(block, offset, val) do{ \
- mlsize_t caml__temp_offset = (offset); \
- value caml__temp_val = (val); \
- caml_modify (&Field ((block), caml__temp_offset), caml__temp_val); \
-}while(0)
-
-/*
- NOTE: [Begin_roots] and [End_roots] are superseded by [CAMLparam]*,
- [CAMLxparam]*, [CAMLlocal]*, [CAMLreturn].
-
- [Begin_roots] and [End_roots] are used for C variables that are GC roots.
- 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 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.
- At the end, insert [End_roots()].
-
- Note that [Begin_roots] opens a new block, and [End_roots] closes it.
- Thus they must occur in matching pairs at the same brace nesting level.
-
- You can use [Val_unit] as a dummy initial value for your variables.
-*/
-
-#define Begin_root Begin_roots1
-
-#define Begin_roots1(r0) { \
- struct caml__roots_block caml__roots_block; \
- caml__roots_block.next = caml_local_roots; \
- caml_local_roots = &caml__roots_block; \
- caml__roots_block.nitems = 1; \
- caml__roots_block.ntables = 1; \
- caml__roots_block.tables[0] = &(r0);
-
-#define Begin_roots2(r0, r1) { \
- struct caml__roots_block caml__roots_block; \
- caml__roots_block.next = caml_local_roots; \
- caml_local_roots = &caml__roots_block; \
- caml__roots_block.nitems = 1; \
- caml__roots_block.ntables = 2; \
- caml__roots_block.tables[0] = &(r0); \
- caml__roots_block.tables[1] = &(r1);
-
-#define Begin_roots3(r0, r1, r2) { \
- struct caml__roots_block caml__roots_block; \
- caml__roots_block.next = caml_local_roots; \
- caml_local_roots = &caml__roots_block; \
- caml__roots_block.nitems = 1; \
- caml__roots_block.ntables = 3; \
- caml__roots_block.tables[0] = &(r0); \
- caml__roots_block.tables[1] = &(r1); \
- caml__roots_block.tables[2] = &(r2);
-
-#define Begin_roots4(r0, r1, r2, r3) { \
- struct caml__roots_block caml__roots_block; \
- caml__roots_block.next = caml_local_roots; \
- caml_local_roots = &caml__roots_block; \
- caml__roots_block.nitems = 1; \
- caml__roots_block.ntables = 4; \
- caml__roots_block.tables[0] = &(r0); \
- caml__roots_block.tables[1] = &(r1); \
- caml__roots_block.tables[2] = &(r2); \
- caml__roots_block.tables[3] = &(r3);
-
-#define Begin_roots5(r0, r1, r2, r3, r4) { \
- struct caml__roots_block caml__roots_block; \
- caml__roots_block.next = caml_local_roots; \
- caml_local_roots = &caml__roots_block; \
- caml__roots_block.nitems = 1; \
- caml__roots_block.ntables = 5; \
- caml__roots_block.tables[0] = &(r0); \
- caml__roots_block.tables[1] = &(r1); \
- caml__roots_block.tables[2] = &(r2); \
- caml__roots_block.tables[3] = &(r3); \
- caml__roots_block.tables[4] = &(r4);
-
-#define Begin_roots_block(table, size) { \
- struct caml__roots_block caml__roots_block; \
- caml__roots_block.next = caml_local_roots; \
- caml_local_roots = &caml__roots_block; \
- caml__roots_block.nitems = (size); \
- caml__roots_block.ntables = 1; \
- caml__roots_block.tables[0] = (table);
-
-#define End_roots() caml_local_roots = caml__roots_block.next; }
-
-
-/* [caml_register_global_root] registers a global C variable as a memory root
- for the duration of the program, or until [caml_remove_global_root] is
- called. */
-
-CAMLextern void caml_register_global_root (value *);
-
-/* [caml_remove_global_root] removes a memory root registered on a global C
- variable with [caml_register_global_root]. */
-
-CAMLextern void caml_remove_global_root (value *);
-
-/* [caml_register_generational_global_root] registers a global C
- variable as a memory root for the duration of the program, or until
- [caml_remove_generational_global_root] is called.
- The program guarantees that the value contained in this variable
- will not be assigned directly. If the program needs to change
- 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 OCaml value before the call.
- In return for these constraints, scanning of memory roots during
- minor collection is made more efficient. */
-
-CAMLextern void caml_register_generational_global_root (value *);
-
-/* [caml_remove_generational_global_root] removes a memory root
- registered on a global C variable with
- [caml_register_generational_global_root]. */
-
-CAMLextern void caml_remove_generational_global_root (value *);
-
-/* [caml_modify_generational_global_root(r, newval)]
- modifies the value contained in [r], storing [newval] inside.
- In other words, the assignment [*r = newval] is performed,
- but in a way that is compatible with the optimized scanning of
- generational global roots. [r] must be a global memory root
- previously registered with [caml_register_generational_global_root]. */
-
-CAMLextern void caml_modify_generational_global_root(value *r, value newval);
-
-#ifdef __cplusplus
-}
-#endif
-
-#endif /* CAML_MEMORY_H */
/* Primitives for the toplevel */
#include <string.h>
-#include "alloc.h"
-#include "config.h"
-#include "fail.h"
-#include "fix_code.h"
-#include "interp.h"
-#include "intext.h"
-#include "major_gc.h"
-#include "memory.h"
-#include "minor_gc.h"
-#include "misc.h"
-#include "mlvalues.h"
-#include "prims.h"
-#include "stacks.h"
+#include "caml/alloc.h"
+#include "caml/config.h"
+#include "caml/fail.h"
+#include "caml/fix_code.h"
+#include "caml/interp.h"
+#include "caml/intext.h"
+#include "caml/major_gc.h"
+#include "caml/memory.h"
+#include "caml/minor_gc.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/prims.h"
+#include "caml/stacks.h"
#ifndef NATIVE_CODE
/***********************************************************************/
#include <string.h>
-#include "config.h"
-#include "fail.h"
-#include "finalise.h"
-#include "gc.h"
-#include "gc_ctrl.h"
-#include "major_gc.h"
-#include "memory.h"
-#include "minor_gc.h"
-#include "misc.h"
-#include "mlvalues.h"
-#include "roots.h"
-#include "signals.h"
-#include "weak.h"
+#include "caml/config.h"
+#include "caml/fail.h"
+#include "caml/finalise.h"
+#include "caml/gc.h"
+#include "caml/gc_ctrl.h"
+#include "caml/major_gc.h"
+#include "caml/memory.h"
+#include "caml/minor_gc.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/roots.h"
+#include "caml/signals.h"
+#include "caml/weak.h"
asize_t caml_minor_heap_size;
static void *caml_young_base = NULL;
void caml_empty_minor_heap (void)
{
value **r;
+ uintnat prev_alloc_words;
if (caml_young_ptr != caml_young_end){
+ if (caml_minor_gc_begin_hook != NULL) (*caml_minor_gc_begin_hook) ();
+ prev_alloc_words = caml_allocated_words;
caml_in_minor_collection = 1;
caml_gc_message (0x02, "<", 0);
caml_oldify_local_roots();
clear_table (&caml_weak_ref_table);
caml_gc_message (0x02, ">", 0);
caml_in_minor_collection = 0;
+ caml_stat_promoted_words += caml_allocated_words - prev_alloc_words;
+ ++ caml_stat_minor_collections;
+ caml_final_empty_young ();
+ if (caml_minor_gc_end_hook != NULL) (*caml_minor_gc_end_hook) ();
}
- caml_final_empty_young ();
#ifdef DEBUG
{
value *p;
*/
CAMLexport void caml_minor_collection (void)
{
- intnat prev_alloc_words = caml_allocated_words;
-
caml_empty_minor_heap ();
- caml_stat_promoted_words += caml_allocated_words - prev_alloc_words;
- ++ caml_stat_minor_collections;
caml_major_collection_slice (0);
caml_force_major_slice = 0;
+ if (caml_finalise_begin_hook != NULL) (*caml_finalise_begin_hook) ();
caml_final_do_calls ();
+ if (caml_finalise_end_hook != NULL) (*caml_finalise_end_hook) ();
caml_empty_minor_heap ();
}
+++ /dev/null
-/***********************************************************************/
-/* */
-/* OCaml */
-/* */
-/* Damien Doligez, projet Para, 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. */
-/* */
-/***********************************************************************/
-
-#ifndef CAML_MINOR_GC_H
-#define CAML_MINOR_GC_H
-
-
-#include "misc.h"
-
-CAMLextern char *caml_young_start, *caml_young_ptr;
-CAMLextern char *caml_young_end, *caml_young_limit;
-extern asize_t caml_minor_heap_size;
-extern int caml_in_minor_collection;
-
-struct caml_ref_table {
- value **base;
- value **end;
- value **threshold;
- value **ptr;
- value **limit;
- asize_t size;
- asize_t reserve;
-};
-CAMLextern struct caml_ref_table caml_ref_table, caml_weak_ref_table;
-
-#define Is_young(val) \
- (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); /* 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 */
-extern void caml_realloc_ref_table (struct caml_ref_table *);
-extern void caml_alloc_table (struct caml_ref_table *, asize_t, asize_t);
-extern void caml_oldify_one (value, value *);
-extern void caml_oldify_mopup (void);
-
-#define Oldify(p) do{ \
- value __oldify__v__ = *p; \
- if (Is_block (__oldify__v__) && Is_young (__oldify__v__)){ \
- caml_oldify_one (__oldify__v__, (p)); \
- } \
- }while(0)
-
-#endif /* CAML_MINOR_GC_H */
#include <stdio.h>
#include <string.h>
#include <stdarg.h>
-#include "config.h"
-#include "misc.h"
-#include "memory.h"
+#include "caml/config.h"
+#include "caml/misc.h"
+#include "caml/memory.h"
+
+caml_timing_hook caml_major_slice_begin_hook = NULL;
+caml_timing_hook caml_major_slice_end_hook = NULL;
+caml_timing_hook caml_minor_gc_begin_hook = NULL;
+caml_timing_hook caml_minor_gc_end_hook = NULL;
+caml_timing_hook caml_finalise_begin_hook = NULL;
+caml_timing_hook caml_finalise_end_hook = NULL;
#ifdef DEBUG
+++ /dev/null
-/***********************************************************************/
-/* */
-/* OCaml */
-/* */
-/* Xavier Leroy and Damien Doligez, 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. */
-/* */
-/***********************************************************************/
-
-/* Miscellaneous macros and variables. */
-
-#ifndef CAML_MISC_H
-#define CAML_MISC_H
-
-#ifndef CAML_NAME_SPACE
-#include "compatibility.h"
-#endif
-#include "config.h"
-
-/* Standard definitions */
-
-#include <stddef.h>
-#include <stdlib.h>
-
-/* Basic types and constants */
-
-typedef size_t asize_t;
-
-#ifndef NULL
-#define NULL 0
-#endif
-
-/* <private> */
-typedef char * addr;
-/* </private> */
-
-#ifdef __GNUC__
- /* Works only in GCC 2.5 and later */
- #define Noreturn __attribute__ ((noreturn))
-#else
- #define Noreturn
-#endif
-
-/* Export control (to mark primitives and to handle Windows DLL) */
-
-#define CAMLexport
-#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) ? (void) 0 : caml_failed_assert ( #x , __FILE__, __LINE__))
-CAMLextern int caml_failed_assert (char *, char *, int);
-#else
-#define CAMLassert(x) ((void) 0)
-#endif
-
-CAMLextern void caml_fatal_error (char *msg) Noreturn;
-CAMLextern void caml_fatal_error_arg (char *fmt, char *arg) Noreturn;
-CAMLextern void caml_fatal_error_arg2 (char *fmt1, char *arg1,
- char *fmt2, char *arg2) Noreturn;
-
-/* Safe string operations */
-
-CAMLextern char * caml_strdup(const char * s);
-CAMLextern char * caml_strconcat(int n, ...); /* n args of const char * type */
-
-/* <private> */
-
-/* Data structures */
-
-struct ext_table {
- int size;
- int capacity;
- void ** contents;
-};
-
-extern void caml_ext_table_init(struct ext_table * tbl, int init_capa);
-extern int caml_ext_table_add(struct ext_table * tbl, void * data);
-extern void caml_ext_table_free(struct ext_table * tbl, int free_entries);
-
-/* GC flags and messages */
-
-extern uintnat caml_verb_gc;
-void caml_gc_message (int, char *, uintnat);
-
-/* Memory routines */
-
-char *caml_aligned_malloc (asize_t, int, void **);
-
-#ifdef DEBUG
-#ifdef ARCH_SIXTYFOUR
-#define Debug_tag(x) (0xD700D7D7D700D6D7ul \
- | ((uintnat) (x) << 16) \
- | ((uintnat) (x) << 48))
-#else
-#define Debug_tag(x) (0xD700D6D7ul | ((uintnat) (x) << 16))
-#endif /* ARCH_SIXTYFOUR */
-
-/*
- 00 -> free words in minor heap
- 01 -> fields of free list blocks in major heap
- 03 -> heap chunks deallocated by heap shrinking
- 04 -> fields deallocated by [caml_obj_truncate]
- 10 -> uninitialised fields of minor objects
- 11 -> uninitialised fields of major objects
- 15 -> uninitialised words of [caml_aligned_malloc] blocks
- 85 -> filler bytes of [caml_aligned_malloc]
-
- special case (byte by byte):
- D7 -> uninitialised words of [caml_stat_alloc] blocks
-*/
-#define Debug_free_minor Debug_tag (0x00)
-#define Debug_free_major Debug_tag (0x01)
-#define Debug_free_shrink Debug_tag (0x03)
-#define Debug_free_truncate Debug_tag (0x04)
-#define Debug_uninit_minor Debug_tag (0x10)
-#define Debug_uninit_major Debug_tag (0x11)
-#define Debug_uninit_align Debug_tag (0x15)
-#define Debug_filler_align Debug_tag (0x85)
-
-#define Debug_uninit_stat 0xD7
-
-extern void caml_set_fields (char *, unsigned long, unsigned long);
-#endif /* DEBUG */
-
-
-#ifndef CAML_AVOID_CONFLICTS
-#define Assert CAMLassert
-#endif
-
-/* snprintf emulation for Win32 */
-
-#ifdef _WIN32
-extern int caml_snprintf(char * buf, size_t size, const char * format, ...);
-#define snprintf caml_snprintf
-#endif
-
-/* </private> */
-
-#endif /* CAML_MISC_H */
+++ /dev/null
-/***********************************************************************/
-/* */
-/* OCaml */
-/* */
-/* Xavier Leroy and Damien Doligez, 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. */
-/* */
-/***********************************************************************/
-
-#ifndef CAML_MLVALUES_H
-#define CAML_MLVALUES_H
-
-#ifndef CAML_NAME_SPACE
-#include "compatibility.h"
-#endif
-#include "config.h"
-#include "misc.h"
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/* Definitions
-
- word: Four bytes on 32 and 16 bit architectures,
- eight bytes on 64 bit architectures.
- long: A C integer having the same number of bytes as a word.
- val: The ML representation of something. A long or a block or a pointer
- outside the heap. If it is a block, it is the (encoded) address
- of an object. If it is a long, it is encoded as well.
- block: Something allocated. It always has a header and some
- fields or some number of bytes (a multiple of the word size).
- field: A word-sized val which is part of a block.
- bp: Pointer to the first byte of a block. (a char *)
- op: Pointer to the first field of a block. (a value *)
- hp: Pointer to the header of a block. (a char *)
- int32: Four bytes on all architectures.
- int64: Eight bytes on all architectures.
-
- Remark: A block size is always a multiple of the word size, and at least
- one word plus the header.
-
- bosize: Size (in bytes) of the "bytes" part.
- wosize: Size (in words) of the "fields" part.
- bhsize: Size (in bytes) of the block with its header.
- whsize: Size (in words) of the block with its header.
-
- hd: A header.
- tag: The value of the tag field of the header.
- color: The value of the color field of the header.
- This is for use only by the GC.
-*/
-
-typedef intnat value;
-typedef uintnat header_t;
-typedef uintnat mlsize_t;
-typedef unsigned int tag_t; /* Actually, an unsigned char */
-typedef uintnat color_t;
-typedef uintnat mark_t;
-
-/* Longs vs blocks. */
-#define Is_long(x) (((x) & 1) != 0)
-#define Is_block(x) (((x) & 1) == 0)
-
-/* Conversion macro names are always of the form "to_from". */
-/* Example: Val_long as in "Val from long" or "Val of long". */
-#define Val_long(x) (((intnat)(x) << 1) + 1)
-#define Long_val(x) ((x) >> 1)
-#define Max_long (((intnat)1 << (8 * sizeof(value) - 2)) - 1)
-#define Min_long (-((intnat)1 << (8 * sizeof(value) - 2)))
-#define Val_int(x) Val_long(x)
-#define Int_val(x) ((int) Long_val(x))
-#define Unsigned_long_val(x) ((uintnat)(x) >> 1)
-#define Unsigned_int_val(x) ((int) Unsigned_long_val(x))
-
-/* Structure of the header:
-
-For 16-bit and 32-bit architectures:
- +--------+-------+-----+
- | wosize | color | tag |
- +--------+-------+-----+
-bits 31 10 9 8 7 0
-
-For 64-bit architectures:
-
- +--------+-------+-----+
- | wosize | color | tag |
- +--------+-------+-----+
-bits 63 10 9 8 7 0
-
-*/
-
-#define Tag_hd(hd) ((tag_t) ((hd) & 0xFF))
-#define Wosize_hd(hd) ((mlsize_t) ((hd) >> 10))
-
-#define Hd_val(val) (((header_t *) (val)) [-1]) /* Also an l-value. */
-#define Hd_op(op) (Hd_val (op)) /* Also an l-value. */
-#define Hd_bp(bp) (Hd_val (bp)) /* Also an l-value. */
-#define Hd_hp(hp) (* ((header_t *) (hp))) /* Also an l-value. */
-#define Hp_val(val) ((char *) (((header_t *) (val)) - 1))
-#define Hp_op(op) (Hp_val (op))
-#define Hp_bp(bp) (Hp_val (bp))
-#define Val_op(op) ((value) (op))
-#define Val_hp(hp) ((value) (((header_t *) (hp)) + 1))
-#define Op_hp(hp) ((value *) Val_hp (hp))
-#define Bp_hp(hp) ((char *) Val_hp (hp))
-
-#define Num_tags (1 << 8)
-#ifdef ARCH_SIXTYFOUR
-#define Max_wosize (((intnat)1 << 54) - 1)
-#else
-#define Max_wosize ((1 << 22) - 1)
-#endif
-
-#define Wosize_val(val) (Wosize_hd (Hd_val (val)))
-#define Wosize_op(op) (Wosize_val (op))
-#define Wosize_bp(bp) (Wosize_val (bp))
-#define Wosize_hp(hp) (Wosize_hd (Hd_hp (hp)))
-#define Whsize_wosize(sz) ((sz) + 1)
-#define Wosize_whsize(sz) ((sz) - 1)
-#define Wosize_bhsize(sz) ((sz) / sizeof (value) - 1)
-#define Bsize_wsize(sz) ((sz) * sizeof (value))
-#define Wsize_bsize(sz) ((sz) / sizeof (value))
-#define Bhsize_wosize(sz) (Bsize_wsize (Whsize_wosize (sz)))
-#define Bhsize_bosize(sz) ((sz) + sizeof (header_t))
-#define Bosize_val(val) (Bsize_wsize (Wosize_val (val)))
-#define Bosize_op(op) (Bosize_val (Val_op (op)))
-#define Bosize_bp(bp) (Bosize_val (Val_bp (bp)))
-#define Bosize_hd(hd) (Bsize_wsize (Wosize_hd (hd)))
-#define Whsize_hp(hp) (Whsize_wosize (Wosize_hp (hp)))
-#define Whsize_val(val) (Whsize_hp (Hp_val (val)))
-#define Whsize_bp(bp) (Whsize_val (Val_bp (bp)))
-#define Whsize_hd(hd) (Whsize_wosize (Wosize_hd (hd)))
-#define Bhsize_hp(hp) (Bsize_wsize (Whsize_hp (hp)))
-#define Bhsize_hd(hd) (Bsize_wsize (Whsize_hd (hd)))
-
-#ifdef ARCH_BIG_ENDIAN
-#define Tag_val(val) (((unsigned char *) (val)) [-1])
- /* Also an l-value. */
-#define Tag_hp(hp) (((unsigned char *) (hp)) [sizeof(value)-1])
- /* Also an l-value. */
-#else
-#define Tag_val(val) (((unsigned char *) (val)) [-sizeof(value)])
- /* Also an l-value. */
-#define Tag_hp(hp) (((unsigned char *) (hp)) [0])
- /* Also an l-value. */
-#endif
-
-/* The lowest tag for blocks containing no value. */
-#define No_scan_tag 251
-
-
-/* 1- If tag < No_scan_tag : a tuple of fields. */
-
-/* Pointer to the first field. */
-#define Op_val(x) ((value *) (x))
-/* Fields are numbered from 0. */
-#define Field(x, i) (((value *)(x)) [i]) /* Also an l-value. */
-
-typedef int32 opcode_t;
-typedef opcode_t * code_t;
-
-/* NOTE: [Forward_tag] and [Infix_tag] must be just under
- [No_scan_tag], with [Infix_tag] the lower one.
- See [caml_oldify_one] in minor_gc.c for more details.
-
- NOTE: Update stdlib/obj.ml whenever you change the tags.
- */
-
-/* Forward_tag: forwarding pointer that the GC may silently shortcut.
- See stdlib/lazy.ml. */
-#define Forward_tag 250
-#define Forward_val(v) Field(v, 0)
-
-/* If tag == Infix_tag : an infix header inside a closure */
-/* Infix_tag must be odd so that the infix header is scanned as an integer */
-/* Infix_tag must be 1 modulo 4 and infix headers can only occur in blocks
- with tag Closure_tag (see compact.c). */
-
-#define Infix_tag 249
-#define Infix_offset_hd(hd) (Bosize_hd(hd))
-#define Infix_offset_val(v) Infix_offset_hd(Hd_val(v))
-
-/* Another special case: objects */
-#define Object_tag 248
-#define Class_val(val) Field((val), 0)
-#define Oid_val(val) Long_val(Field((val), 1))
-CAMLextern value caml_get_public_method (value obj, value tag);
-/* Called as:
- caml_callback(caml_get_public_method(obj, caml_hash_variant(name)), obj) */
-/* caml_get_public_method returns 0 if tag not in the table.
- Note however that tags being hashed, same tag does not necessarily mean
- same method name. */
-
-/* Special case of tuples of fields: closures */
-#define Closure_tag 247
-#define Code_val(val) (((code_t *) (val)) [0]) /* Also an l-value. */
-
-/* This tag is used (with Forward_tag) to implement lazy values.
- See major_gc.c and stdlib/lazy.ml. */
-#define Lazy_tag 246
-
-/* Another special case: variants */
-CAMLextern value caml_hash_variant(char const * tag);
-
-/* 2- If tag >= No_scan_tag : a sequence of bytes. */
-
-/* Pointer to the first byte */
-#define Bp_val(v) ((char *) (v))
-#define Val_bp(p) ((value) (p))
-/* Bytes are numbered from 0. */
-#define Byte(x, i) (((char *) (x)) [i]) /* Also an l-value. */
-#define Byte_u(x, i) (((unsigned char *) (x)) [i]) /* Also an l-value. */
-
-/* Abstract things. Their contents is not traced by the GC; therefore they
- must not contain any [value].
-*/
-#define Abstract_tag 251
-
-/* Strings. */
-#define String_tag 252
-#define String_val(x) ((char *) Bp_val(x))
-CAMLextern mlsize_t caml_string_length (value); /* size in bytes */
-
-/* Floating-point numbers. */
-#define Double_tag 253
-#define Double_wosize ((sizeof(double) / sizeof(value)))
-#ifndef ARCH_ALIGN_DOUBLE
-#define Double_val(v) (* (double *)(v))
-#define Store_double_val(v,d) (* (double *)(v) = (d))
-#else
-CAMLextern double caml_Double_val (value);
-CAMLextern void caml_Store_double_val (value,double);
-#define Double_val(v) caml_Double_val(v)
-#define Store_double_val(v,d) caml_Store_double_val(v,d)
-#endif
-
-/* Arrays of floating-point numbers. */
-#define Double_array_tag 254
-#define Double_field(v,i) Double_val((value)((double *)(v) + (i)))
-#define Store_double_field(v,i,d) do{ \
- mlsize_t caml__temp_i = (i); \
- 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)
- followed by raw data. The contents of custom blocks is not traced by
- the GC; therefore, they must not contain any [value].
- See [custom.h] for operations on method suites. */
-#define Custom_tag 255
-#define Data_custom_val(v) ((void *) &Field((v), 1))
-struct custom_operations; /* defined in [custom.h] */
-
-/* Int32.t, Int64.t and Nativeint.t are represented as custom blocks. */
-
-#define Int32_val(v) (*((int32 *) Data_custom_val(v)))
-#define Nativeint_val(v) (*((intnat *) Data_custom_val(v)))
-#ifndef ARCH_ALIGN_INT64
-#define Int64_val(v) (*((int64 *) Data_custom_val(v)))
-#else
-CAMLextern int64 caml_Int64_val(value v);
-#define Int64_val(v) caml_Int64_val(v)
-#endif
-
-/* 3- Atoms are 0-tuples. They are statically allocated once and for all. */
-
-CAMLextern header_t caml_atom_table[];
-#define Atom(tag) (Val_hp (&(caml_atom_table [(tag)])))
-
-/* Booleans are integers 0 or 1 */
-
-#define Val_bool(x) Val_int((x) != 0)
-#define Bool_val(x) Int_val(x)
-#define Val_false Val_int(0)
-#define Val_true Val_int(1)
-#define Val_not(x) (Val_false + Val_true - (x))
-
-/* The unit value is 0 (tagged) */
-
-#define Val_unit Val_int(0)
-
-/* List constructors */
-#define Val_emptylist Val_int(0)
-#define Tag_cons 0
-
-/* The table of global identifiers */
-
-extern value caml_global_data;
-
-#ifdef __cplusplus
-}
-#endif
-
-CAMLextern value caml_set_oo_id(value obj);
-
-#endif /* CAML_MLVALUES_H */
/* Operations on objects */
#include <string.h>
-#include "alloc.h"
-#include "fail.h"
-#include "gc.h"
-#include "interp.h"
-#include "major_gc.h"
-#include "memory.h"
-#include "minor_gc.h"
-#include "misc.h"
-#include "mlvalues.h"
-#include "prims.h"
+#include "caml/alloc.h"
+#include "caml/fail.h"
+#include "caml/gc.h"
+#include "caml/interp.h"
+#include "caml/major_gc.h"
+#include "caml/memory.h"
+#include "caml/minor_gc.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/prims.h"
CAMLprim value caml_static_alloc(value size)
{
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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. */
-/* */
-/***********************************************************************/
-
-/* Operating system - specific stuff */
-
-#ifndef CAML_OSDEPS_H
-#define CAML_OSDEPS_H
-
-#include "misc.h"
-
-/* Decompose the given path into a list of directories, and add them
- to the given table. Return the block to be freed later. */
-extern char * caml_decompose_path(struct ext_table * tbl, char * path);
-
-/* Search the given file in the given list of directories.
- If not found, return a copy of [name]. Result is allocated with
- [caml_stat_alloc]. */
-extern char * caml_search_in_path(struct ext_table * path, char * name);
-
-/* Same, but search an executable name in the system path for executables. */
-CAMLextern char * caml_search_exe_in_path(char * name);
-
-/* Same, but search a shared library in the given path. */
-extern char * caml_search_dll_in_path(struct ext_table * path, char * name);
-
-/* Open a shared library and return a handle on it.
- If [for_execution] is true, perform full symbol resolution and
- execute initialization code so that functions from the shared library
- can be called. If [for_execution] is false, functions from this
- shared library will not be called, but just checked for presence,
- so symbol resolution can be skipped.
- If [global] is true, symbols from the shared library can be used
- to resolve for other libraries to be opened later on.
- Return [NULL] on error. */
-extern void * caml_dlopen(char * libname, int for_execution, int global);
-
-/* Close a shared library handle */
-extern void caml_dlclose(void * handle);
-
-/* Look up the given symbol in the given shared library.
- Return [NULL] if not found, or symbol value if found. */
-extern void * caml_dlsym(void * handle, char * name);
-
-extern void * caml_globalsym(char * name);
-
-/* Return an error message describing the most recent dynlink failure. */
-extern char * caml_dlerror(void);
-
-/* Add to [contents] the (short) names of the files contained in
- the directory named [dirname]. No entries are added for [.] and [..].
- Return 0 on success, -1 on error; set errno in the case of error. */
-extern int caml_read_directory(char * dirname, struct ext_table * contents);
-
-/* Recover executable name if possible (/proc/sef/exe under Linux,
- GetModuleFileName under Windows). */
-extern int caml_executable_name(char * name, int name_len);
-
-#endif /* CAML_OSDEPS_H */
#include <stdio.h>
#include <string.h>
-#include "config.h"
-#include "mlvalues.h"
-#include "memory.h"
-#include "alloc.h"
+#include "caml/config.h"
+#include "caml/mlvalues.h"
+#include "caml/memory.h"
+#include "caml/alloc.h"
#define ERRCODE 256
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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. */
-/* */
-/***********************************************************************/
-
-/* Interface with C primitives. */
-
-#ifndef CAML_PRIMS_H
-#define CAML_PRIMS_H
-
-typedef value (*c_primitive)();
-
-extern c_primitive caml_builtin_cprim[];
-extern char * caml_names_of_builtin_cprim[];
-
-extern struct ext_table caml_prim_table;
-#ifdef DEBUG
-extern struct ext_table caml_prim_name_table;
-#endif
-
-#define Primitive(n) ((c_primitive)(caml_prim_table.contents[n]))
-
-extern char * caml_section_table;
-extern asize_t caml_section_table_size;
-
-#endif /* CAML_PRIMS_H */
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
-#include "backtrace.h"
-#include "callback.h"
-#include "debugger.h"
-#include "fail.h"
-#include "misc.h"
-#include "mlvalues.h"
-#include "printexc.h"
+#include "caml/backtrace.h"
+#include "caml/callback.h"
+#include "caml/debugger.h"
+#include "caml/fail.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/printexc.h"
struct stringbuf {
char * ptr;
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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. */
-/* */
-/***********************************************************************/
-
-#ifndef CAML_PRINTEXC_H
-#define CAML_PRINTEXC_H
-
-
-#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 */
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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. */
-/* */
-/***********************************************************************/
-
-/* Swap byte-order in 16, 32, and 64-bit integers or floats */
-
-#ifndef CAML_REVERSE_H
-#define CAML_REVERSE_H
-
-#define Reverse_16(dst,src) { \
- char * _p, * _q; \
- char _a; \
- _p = (char *) (src); \
- _q = (char *) (dst); \
- _a = _p[0]; \
- _q[0] = _p[1]; \
- _q[1] = _a; \
-}
-
-#define Reverse_32(dst,src) { \
- char * _p, * _q; \
- char _a, _b; \
- _p = (char *) (src); \
- _q = (char *) (dst); \
- _a = _p[0]; \
- _b = _p[1]; \
- _q[0] = _p[3]; \
- _q[1] = _p[2]; \
- _q[3] = _a; \
- _q[2] = _b; \
-}
-
-#define Reverse_64(dst,src) { \
- char * _p, * _q; \
- char _a, _b; \
- _p = (char *) (src); \
- _q = (char *) (dst); \
- _a = _p[0]; \
- _b = _p[1]; \
- _q[0] = _p[7]; \
- _q[1] = _p[6]; \
- _q[7] = _a; \
- _q[6] = _b; \
- _a = _p[2]; \
- _b = _p[3]; \
- _q[2] = _p[5]; \
- _q[3] = _p[4]; \
- _q[5] = _a; \
- _q[4] = _b; \
-}
-
-#define Perm_index(perm,i) ((perm >> (i * 4)) & 0xF)
-
-#define Permute_64(dst,perm_dst,src,perm_src) { \
- char * _p; \
- char _a, _b, _c, _d, _e, _f, _g, _h; \
- _p = (char *) (src); \
- _a = _p[Perm_index(perm_src, 0)]; \
- _b = _p[Perm_index(perm_src, 1)]; \
- _c = _p[Perm_index(perm_src, 2)]; \
- _d = _p[Perm_index(perm_src, 3)]; \
- _e = _p[Perm_index(perm_src, 4)]; \
- _f = _p[Perm_index(perm_src, 5)]; \
- _g = _p[Perm_index(perm_src, 6)]; \
- _h = _p[Perm_index(perm_src, 7)]; \
- _p = (char *) (dst); \
- _p[Perm_index(perm_dst, 0)] = _a; \
- _p[Perm_index(perm_dst, 1)] = _b; \
- _p[Perm_index(perm_dst, 2)] = _c; \
- _p[Perm_index(perm_dst, 3)] = _d; \
- _p[Perm_index(perm_dst, 4)] = _e; \
- _p[Perm_index(perm_dst, 5)] = _f; \
- _p[Perm_index(perm_dst, 6)] = _g; \
- _p[Perm_index(perm_dst, 7)] = _h; \
-}
-
-#endif /* CAML_REVERSE_H */
/* To walk the memory roots for garbage collection */
-#include "finalise.h"
-#include "globroots.h"
-#include "major_gc.h"
-#include "memory.h"
-#include "minor_gc.h"
-#include "misc.h"
-#include "mlvalues.h"
-#include "roots.h"
-#include "stacks.h"
+#include "caml/finalise.h"
+#include "caml/globroots.h"
+#include "caml/major_gc.h"
+#include "caml/memory.h"
+#include "caml/minor_gc.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/roots.h"
+#include "caml/stacks.h"
CAMLexport struct caml__roots_block *caml_local_roots = NULL;
+++ /dev/null
-/***********************************************************************/
-/* */
-/* OCaml */
-/* */
-/* Xavier Leroy and Damien Doligez, 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. */
-/* */
-/***********************************************************************/
-
-#ifndef CAML_ROOTS_H
-#define CAML_ROOTS_H
-
-#include "misc.h"
-#include "memory.h"
-
-typedef void (*scanning_action) (value, value *);
-
-void caml_oldify_local_roots (void);
-void caml_darken_all_roots (void);
-void caml_do_roots (scanning_action);
-#ifndef NATIVE_CODE
-CAMLextern void caml_do_local_roots (scanning_action, value *, value *,
- struct caml__roots_block *);
-#else
-CAMLextern void caml_do_local_roots(scanning_action f, char * bottom_of_stack,
- uintnat last_retaddr, value * gc_regs,
- struct caml__roots_block * local_roots);
-#endif
-
-CAMLextern void (*caml_scan_roots_hook) (scanning_action);
-
-#endif /* CAML_ROOTS_H */
#include <signal.h>
#include <errno.h>
-#include "alloc.h"
-#include "callback.h"
-#include "config.h"
-#include "fail.h"
-#include "memory.h"
-#include "misc.h"
-#include "mlvalues.h"
-#include "roots.h"
-#include "signals.h"
-#include "signals_machdep.h"
-#include "sys.h"
+#include "caml/alloc.h"
+#include "caml/callback.h"
+#include "caml/config.h"
+#include "caml/fail.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/roots.h"
+#include "caml/signals.h"
+#include "caml/signals_machdep.h"
+#include "caml/sys.h"
#ifndef NSIG
#define NSIG 64
+++ /dev/null
-/***********************************************************************/
-/* */
-/* OCaml */
-/* */
-/* Xavier Leroy and Damien Doligez, 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. */
-/* */
-/***********************************************************************/
-
-#ifndef CAML_SIGNALS_H
-#define CAML_SIGNALS_H
-
-#ifndef CAML_NAME_SPACE
-#include "compatibility.h"
-#endif
-#include "misc.h"
-#include "mlvalues.h"
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/* <private> */
-CAMLextern intnat volatile caml_signals_are_pending;
-CAMLextern intnat volatile caml_pending_signals[];
-CAMLextern int volatile caml_something_to_do;
-extern int volatile caml_force_major_slice;
-/* </private> */
-
-CAMLextern void caml_enter_blocking_section (void);
-CAMLextern void caml_leave_blocking_section (void);
-
-/* <private> */
-void caml_urge_major_slice (void);
-CAMLextern int caml_convert_signal_number (int);
-CAMLextern int caml_rev_convert_signal_number (int);
-void caml_execute_signal(int signal_number, int in_signal_handler);
-void caml_record_signal(int signal_number);
-void caml_process_pending_signals(void);
-void caml_process_event(void);
-int caml_set_signal_action(int signo, int action);
-
-CAMLextern void (*caml_enter_blocking_section_hook)(void);
-CAMLextern void (*caml_leave_blocking_section_hook)(void);
-CAMLextern int (*caml_try_leave_blocking_section_hook)(void);
-CAMLextern void (* volatile caml_async_action_hook)(void);
-/* </private> */
-
-#ifdef __cplusplus
-}
-#endif
-
-#endif /* CAML_SIGNALS_H */
#include <signal.h>
#include <errno.h>
-#include "config.h"
-#include "memory.h"
-#include "osdeps.h"
-#include "signals.h"
-#include "signals_machdep.h"
+#include "caml/config.h"
+#include "caml/memory.h"
+#include "caml/osdeps.h"
+#include "caml/signals.h"
+#include "caml/signals_machdep.h"
#ifndef NSIG
#define NSIG 64
+++ /dev/null
-/***********************************************************************/
-/* */
-/* OCaml */
-/* */
-/* Xavier Leroy and Damien Doligez, 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. */
-/* */
-/***********************************************************************/
-
-/* Processor-specific operation: atomic "read and clear" */
-
-#ifndef CAML_SIGNALS_MACHDEP_H
-#define CAML_SIGNALS_MACHDEP_H
-
-#if defined(__GNUC__) && defined(__i386__)
-
-#define Read_and_clear(dst,src) \
- asm("xorl %0, %0; xchgl %0, %1" \
- : "=r" (dst), "=m" (src) \
- : "m" (src))
-
-#elif defined(__GNUC__) && defined(__x86_64__)
-
-#define Read_and_clear(dst,src) \
- asm("xorq %0, %0; xchgq %0, %1" \
- : "=r" (dst), "=m" (src) \
- : "m" (src))
-
-#elif defined(__GNUC__) && defined(__ppc__)
-
-#define Read_and_clear(dst,src) \
- asm("0: lwarx %0, 0, %1\n\t" \
- "stwcx. %2, 0, %1\n\t" \
- "bne- 0b" \
- : "=&r" (dst) \
- : "r" (&(src)), "r" (0) \
- : "cr0", "memory")
-
-#elif defined(__GNUC__) && defined(__ppc64__)
-
-#define Read_and_clear(dst,src) \
- asm("0: ldarx %0, 0, %1\n\t" \
- "stdcx. %2, 0, %1\n\t" \
- "bne- 0b" \
- : "=&r" (dst) \
- : "r" (&(src)), "r" (0) \
- : "cr0", "memory")
-
-#else
-
-/* Default, non-atomic implementation */
-#define Read_and_clear(dst,src) ((dst) = (src), (src) = 0)
-
-#endif
-
-#endif /* CAML_SIGNALS_MACHDEP_H */
/* To initialize and resize the stacks */
#include <string.h>
-#include "config.h"
-#include "fail.h"
-#include "misc.h"
-#include "mlvalues.h"
-#include "stacks.h"
+#include "caml/config.h"
+#include "caml/fail.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/stacks.h"
CAMLexport value * caml_stack_low;
CAMLexport value * caml_stack_high;
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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. */
-/* */
-/***********************************************************************/
-
-/* structure of the stacks */
-
-#ifndef CAML_STACKS_H
-#define CAML_STACKS_H
-
-
-#include "misc.h"
-#include "mlvalues.h"
-#include "memory.h"
-
-CAMLextern value * caml_stack_low;
-CAMLextern value * caml_stack_high;
-CAMLextern value * caml_stack_threshold;
-CAMLextern value * caml_extern_sp;
-CAMLextern value * caml_trapsp;
-CAMLextern value * caml_trap_barrier;
-
-#define Trap_pc(tp) (((code_t *)(tp))[0])
-#define Trap_link(tp) (((value **)(tp))[1])
-
-void caml_init_stack (uintnat init_max_size);
-void caml_realloc_stack (asize_t required_size);
-void caml_change_max_stack_size (uintnat new_max_size);
-uintnat caml_stack_usage (void);
-
-CAMLextern uintnat (*caml_stack_usage_hook)(void);
-
-#endif /* CAML_STACKS_H */
#include <stdlib.h>
#include <string.h>
#include <fcntl.h>
-#include "config.h"
+#include "caml/config.h"
#ifdef HAS_UNISTD
#include <unistd.h>
#endif
#ifdef _WIN32
#include <process.h>
#endif
-#include "alloc.h"
-#include "backtrace.h"
-#include "callback.h"
-#include "custom.h"
-#include "debugger.h"
-#include "dynlink.h"
-#include "exec.h"
-#include "fail.h"
-#include "fix_code.h"
-#include "freelist.h"
-#include "gc_ctrl.h"
-#include "instrtrace.h"
-#include "interp.h"
-#include "intext.h"
-#include "io.h"
-#include "memory.h"
-#include "minor_gc.h"
-#include "misc.h"
-#include "mlvalues.h"
-#include "osdeps.h"
-#include "prims.h"
-#include "printexc.h"
-#include "reverse.h"
-#include "signals.h"
-#include "stacks.h"
-#include "sys.h"
-#include "startup.h"
-#include "version.h"
+#include "caml/alloc.h"
+#include "caml/backtrace.h"
+#include "caml/callback.h"
+#include "caml/custom.h"
+#include "caml/debugger.h"
+#include "caml/dynlink.h"
+#include "caml/exec.h"
+#include "caml/fail.h"
+#include "caml/fix_code.h"
+#include "caml/freelist.h"
+#include "caml/gc_ctrl.h"
+#include "caml/instrtrace.h"
+#include "caml/interp.h"
+#include "caml/intext.h"
+#include "caml/io.h"
+#include "caml/memory.h"
+#include "caml/minor_gc.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/osdeps.h"
+#include "caml/prims.h"
+#include "caml/printexc.h"
+#include "caml/reverse.h"
+#include "caml/signals.h"
+#include "caml/stacks.h"
+#include "caml/sys.h"
+#include "caml/startup.h"
+#include "caml/version.h"
#ifndef O_BINARY
#define O_BINARY 0
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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. */
-/* */
-/***********************************************************************/
-
-#ifndef CAML_STARTUP_H
-#define CAML_STARTUP_H
-
-#include "mlvalues.h"
-#include "exec.h"
-
-CAMLextern void caml_main(char **argv);
-
-CAMLextern void caml_startup_code(
- code_t code, asize_t code_size,
- char *data, asize_t data_size,
- char *section_table, asize_t section_table_size,
- char **argv);
-
-enum { FILE_NOT_FOUND = -1, BAD_BYTECODE = -2 };
-
-extern int caml_attempt_open(char **name, struct exec_trailer *trail,
- int do_open_script);
-extern void caml_read_section_descriptors(int fd, struct exec_trailer *trail);
-extern int32 caml_seek_optional_section(int fd, struct exec_trailer *trail,
- char *name);
-extern int32 caml_seek_section(int fd, struct exec_trailer *trail, char *name);
-
-
-#endif /* CAML_STARTUP_H */
#include <ctype.h>
#include <stdio.h>
#include <stdarg.h>
-#include "alloc.h"
-#include "fail.h"
-#include "mlvalues.h"
-#include "misc.h"
+#include "caml/alloc.h"
+#include "caml/fail.h"
+#include "caml/mlvalues.h"
+#include "caml/misc.h"
#ifdef HAS_LOCALE
#include <locale.h>
#endif
#if !_WIN32
#include <sys/wait.h>
#endif
-#include "config.h"
+#include "caml/config.h"
#ifdef HAS_UNISTD
#include <unistd.h>
#endif
#ifdef HAS_GETTIMEOFDAY
#include <sys/time.h>
#endif
-#include "alloc.h"
-#include "debugger.h"
-#include "fail.h"
-#include "instruct.h"
-#include "mlvalues.h"
-#include "osdeps.h"
-#include "signals.h"
-#include "stacks.h"
-#include "sys.h"
+#include "caml/alloc.h"
+#include "caml/debugger.h"
+#include "caml/fail.h"
+#include "caml/instruct.h"
+#include "caml/mlvalues.h"
+#include "caml/osdeps.h"
+#include "caml/signals.h"
+#include "caml/stacks.h"
+#include "caml/sys.h"
static char * error_message(void)
{
}
char * caml_exe_name;
-static char ** caml_main_argv;
+char ** caml_main_argv;
CAMLprim value caml_sys_get_argv(value unit)
{
+++ /dev/null
-/***********************************************************************/
-/* */
-/* 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. */
-/* */
-/***********************************************************************/
-
-#ifndef CAML_SYS_H
-#define CAML_SYS_H
-
-#include "misc.h"
-
-#define NO_ARG Val_int(0)
-
-CAMLextern void caml_sys_error (value);
-CAMLextern void caml_sys_io_error (value);
-extern void caml_sys_init (char * exe_name, char ** argv);
-CAMLextern value caml_sys_exit (value);
-
-extern char * caml_exe_name;
-
-#endif /* CAML_SYS_H */
/* Read and output terminal commands */
-#include "config.h"
-#include "alloc.h"
-#include "fail.h"
-#include "io.h"
-#include "mlvalues.h"
+#include "caml/config.h"
+#include "caml/alloc.h"
+#include "caml/fail.h"
+#include "caml/io.h"
+#include "caml/mlvalues.h"
#define Uninitialised (Val_int(0))
#define Bad_term (Val_int(1))
+++ /dev/null
-/***********************************************************************/
-/* */
-/* OCaml */
-/* */
-/* Damien Doligez, projet Para, 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. */
-/* */
-/***********************************************************************/
-
-/* Function declarations for non-Unix user interfaces */
-
-#ifndef CAML_UI_H
-#define CAML_UI_H
-
-#include "config.h"
-
-void ui_exit (int return_code);
-int ui_read (int file_desc, char *buf, unsigned int length);
-int ui_write (int file_desc, char *buf, unsigned int length);
-void ui_print_stderr (char *format, void *arg);
-
-#endif /* CAML_UI_H */
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
-#include "config.h"
+#include "caml/config.h"
#ifdef SUPPORT_DYNAMIC_LINKING
-#ifdef __CYGWIN32__
+#ifdef __CYGWIN__
#include "flexdll.h"
#else
#include <dlfcn.h>
#else
#include <sys/dir.h>
#endif
-#include "memory.h"
-#include "misc.h"
-#include "osdeps.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/osdeps.h"
#ifndef S_ISREG
#define S_ISREG(mode) (((mode) & S_IFMT) == S_IFREG)
return caml_strdup(name);
}
-#ifdef __CYGWIN32__
+#ifdef __CYGWIN__
/* Cygwin needs special treatment because of the implicit ".exe" at the
end of executable file names */
caml_ext_table_init(&path, 8);
tofree = caml_decompose_path(&path, getenv("PATH"));
-#ifndef __CYGWIN32__
+#ifndef __CYGWIN__
res = caml_search_in_path(&path, name);
#else
res = cygwin_search_exe_in_path(&path, name);
}
#ifdef SUPPORT_DYNAMIC_LINKING
-#ifdef __CYGWIN32__
+#ifdef __CYGWIN__
/* Use flexdll */
void * caml_dlopen(char * libname, int for_execution, int global)
#include <string.h>
-#include "alloc.h"
-#include "fail.h"
-#include "major_gc.h"
-#include "memory.h"
-#include "mlvalues.h"
+#include "caml/alloc.h"
+#include "caml/fail.h"
+#include "caml/major_gc.h"
+#include "caml/memory.h"
+#include "caml/mlvalues.h"
value caml_weak_list_head = 0;
+++ /dev/null
-/***********************************************************************/
-/* */
-/* OCaml */
-/* */
-/* Damien Doligez, projet Para, 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 GNU Library General Public License, with */
-/* the special exception on linking described in file ../LICENSE. */
-/* */
-/***********************************************************************/
-
-/* Operations on weak arrays */
-
-#ifndef CAML_WEAK_H
-#define CAML_WEAK_H
-
-#include "mlvalues.h"
-
-extern value caml_weak_list_head;
-extern value caml_weak_none;
-
-#endif /* CAML_WEAK_H */
#include <errno.h>
#include <string.h>
#include <signal.h>
-#include "fail.h"
-#include "memory.h"
-#include "misc.h"
-#include "osdeps.h"
-#include "signals.h"
-#include "sys.h"
+#include "caml/address_class.h"
+#include "caml/fail.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/osdeps.h"
+#include "caml/signals.h"
+#include "caml/sys.h"
#include <flexdll.h>
caml_raise_stack_overflow();
}
-extern char * caml_code_area_start, * caml_code_area_end;
CAMLextern int caml_is_in_code(void *);
-#define Is_in_code_area(pc) \
- ( ((char *)(pc) >= caml_code_area_start && \
- (char *)(pc) <= caml_code_area_end) \
- || (Classify_addr(pc) & In_code_area) )
-
static LONG CALLBACK
caml_UnhandledExceptionFilter (EXCEPTION_POINTERS* exn_info)
{
X11_LINK=
BYTECCRPATH=
SUPPORTS_SHARED_LIBRARIES=true
-SHAREDCCCOMPOPTS=
+SHAREDCCCOMPOPTS=-O
MKSHAREDLIBRPATH=
NATIVECCPROFOPTS=
NATIVECCRPATH=
X11_LINK=
BYTECCRPATH=
SUPPORTS_SHARED_LIBRARIES=true
-SHAREDCCCOMPOPTS=
+SHAREDCCCOMPOPTS=-O
MKSHAREDLIBRPATH=
NATIVECCPROFOPTS=
NATIVECCRPATH=
X11_LINK=
BYTECCRPATH=
SUPPORTS_SHARED_LIBRARIES=true
-SHAREDCCCOMPOPTS=
+SHAREDCCCOMPOPTS=-Ox
NATIVECCPROFOPTS=
NATIVECCRPATH=
ASM=ml -nologo -coff -Cp -c -Fo
X11_LINK=
BYTECCRPATH=
SUPPORTS_SHARED_LIBRARIES=true
-SHAREDCCCOMPOPTS=
+SHAREDCCCOMPOPTS=-Ox
NATIVECCPROFOPTS=
NATIVECCRPATH=
ASM=ml64 -nologo -Cp -c -Fo
--- /dev/null
+/***********************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Jeremie Dimino, Jane Street Group, LLC */
+/* */
+/* Copyright 2015 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 _GNU_SOURCE
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <unistd.h>
+
+#include "../../otherlibs/unix/nanosecond_stat.h"
+
+int main() {
+ struct stat *buf;
+ double a, m, c;
+ a = (double)NSEC(buf, a);
+ m = (double)NSEC(buf, m);
+ c = (double)NSEC(buf, c);
+ return 0;
+}
# Find a program in the path
+doprint=false
+case $1 in
+ -p) shift; doprint=true;;
+ *) ;;
+esac
+
IFS=':'
for dir in $PATH; do
if test -z "$dir"; then dir=.; fi
- if test -f $dir/$1; then exit 0; fi
+ if test -f $dir/$1 -a -x $dir/$1; then
+ if $doprint; then echo "$dir/$1"; fi
+ exit 0
+ fi
done
exit 1
configure_options="$*"
prefix=/usr/local
bindir=''
+target_bindir=''
libdir=''
mandir=''
manext=1
}
err() {
- printf "[ERROR!]%b\n" "$*" 1>&3
+ printf "[ERROR!] %b\n" "$*" 1>&3
exit 2
}
# Parse command-line arguments
-if echo "$configure_options" | grep -q -e '--\?[a-zA-Z0-9-]\+='; then
- err "Arguments to this script look like '-prefix /foo/bar', not '-prefix=/foo/bar' (note the '=')."
-fi
-
while : ; do
case "$1" in
"") break;;
prefix=$2; shift;;
-bindir|--bindir)
bindir=$2; shift;;
+ -target-bindir|--target-bindir)
+ target_bindir="$2"; shift;;
-libdir|--libdir)
libdir=$2; shift;;
-mandir|--mandir)
no_naked_pointers=true;;
-no-cfi|--no-cfi)
with_cfi=false;;
- *) err "Unknown option \"$1\".";;
+ *) if echo "$1" | grep -q -e '^--\?[a-zA-Z0-9-]\+='; then
+ err "configure expects arguments of the form '-prefix /foo/bar'," \
+ "not '-prefix=/foo/bar' (note the '=')."
+ else
+ err "Unknown option \"$1\"."
+ fi;;
esac
shift
done
fi
inf "Configuring for target $target ..."
+if [ x"$host" = x"$target" ]; then
+ cross_compiler=false
+else
+ cross_compiler=true
+fi
+
# Do we have gcc?
if test -z "$ccoption"; then
if sh ./searchpath "${TOOLPREF}gcc"; then
cc="${TOOLPREF}gcc"
else
- if test x"$host" = x"$target"; then
- cc="cc"
- else
+ if $cross_compiler; then
err "No cross-compiler found for ${target}.\n" \
"It should be named ${TOOLPREF}gcc and be in the PATH."
+ else
+ cc="cc"
fi
fi
else
*,powerpc-*-aix*)
bytecccompopts="-D_XOPEN_SOURCE=500";;
*gcc*,*-*-cygwin*)
+ case $target in
+ i686-*) flavor=cygwin;;
+ x86_64-*) flavor=cygwin64;;
+ *) err "unknown cygwin variant";;
+ esac
bytecccompopts="-fno-defer-pop $gcc_warnings -U_WIN32"
dllccompopts="-U_WIN32 -DCAML_DLL"
if test $with_sharedlibs = yes; then
- flexlink="flexlink -chain cygwin -merge-manifest -stack 16777216"
+ flexlink="flexlink -chain $flavor -merge-manifest -stack 16777216"
flexdir=`$flexlink -where | dos2unix`
if test -z "$flexdir"; then
wrn "flexlink not found: native shared libraries won't be available."
1) err "The C compiler $cc is not ANSI-compliant.\n" \
"You need an ANSI C compiler to build OCaml.";;
*)
- if test x"$host" != x"$target"; then
+ if $cross_compiler; then
wrn "Unable to compile the test program.\n" \
"This failure is expected for cross-compilation:\n" \
"we will assume the C compiler is ANSI-compliant."
fi;;
esac
-# Determine which ocamlrun executable to use; for cross-compilation, a native
-# "ocamlrun" executable must be available on the system.
-if test x"$target" != x"$host"; then
+# For cross-compilation, we need a host-based ocamlrun and ocamlyacc,
+# and the user must specify the target BINDIR
+if $cross_compiler; then
if ! sh ./searchpath ocamlrun; then
err "Cross-compilation requires an ocaml runtime environment\n" \
"(the ocamlrun binary). Moreover, its version must be the same\n" \
"as the one you're trying to build (`cut -f1 -d+ < ../../VERSION`)."
else
- ocaml_system_version=`ocamlrun -version | sed 's/[^0-9]*\([0-9.]\+\).*/\1/'`
- ocaml_source_version=`sed -n '1 s/\([0-9\.]\+\).*/\1/ p' < ../../VERSION`
+ ocaml_system_version=`ocamlrun -version | sed 's/[^0-9]*\([0-9.]*\).*/\1/'`
+ ocaml_source_version=`sed -n '1 s/\([0-9\.]*\).*/\1/ p' < ../../VERSION`
if test x"$ocaml_system_version" != x"$ocaml_source_version"; then
err "While you have an ocaml runtime environment, its version\n" \
"($ocaml_system_version) doesn't match the version of these sources\n" \
"($ocaml_source_version)."
else
- CAMLRUN="ocamlrun"
+ echo "CAMLRUN=`./searchpath -p ocamlrun`" >> Makefile
fi
fi
-else
- CAMLRUN=`cd ../.. && pwd`/boot/ocamlrun
-fi
-echo "CAMLRUN=$CAMLRUN" >> Makefile
+ if ! sh ./searchpath ocamlyacc; then
+ err "Cross-compilation requires an ocamlyacc binary."
+ else
+ ocamlyacc 2>/dev/null
+ if test "$?" -ne 1; then
+ err "While you have an ocamlyacc binary, it cannot be executed successfully."
+ else
+ echo "CAMLYACC=`./searchpath -p ocamlyacc`" >> Makefile
+ fi
+ fi
+
+ if [ -z "$target_bindir" ]; then
+ err "Cross-compilation requires -target-bindir."
+ else
+ echo "TARGET_BINDIR=$target_bindir" >> Makefile
+ fi
+fi # cross-compiler
+
# Check the sizes of data types
# OCaml needs a 32 or 64 bit architecture, a 32-bit integer type and
case "$nativecc" in gcc*) ;; *) cc_profile='-xpg';; esac;;
amd64,linux) profiling='prof';;
amd64,openbsd) profiling='prof';;
+ amd64,freebsd) profiling='prof';;
+ amd64,netbsd) profiling='prof';;
amd64,gnu) profiling='prof';;
arm,linux*) profiling='prof';;
power,elf) profiling='prof';;
"under Cygwin"
echo "SHARPBANGSCRIPTS=false" >> Makefile;;
*-*-mingw*)
- inf "We won't use it, though, because it's on the target platform it would be used and windows doesn't support it."
+ inf "We won't use it, though, because it's on the target platform " \
+ "it would be used and windows doesn't support it."
echo "SHARPBANGSCRIPTS=false" >> Makefile;;
*)
echo "SHARPBANGSCRIPTS=true" >> Makefile;;
echo "#define HAS_PWRITE" >> s.h
fi
+nanosecond_stat=none
+for i in 1 2 3; do
+ if sh ./trycompile -DHAS_NANOSECOND_STAT=$i nanosecond_stat.c; then nanosecond_stat=$i; break; fi
+done
+if test $nanosecond_stat != "none"; then
+ inf "stat() supports nanosecond precision."
+ echo "#define HAS_NANOSECOND_STAT $nanosecond_stat" >> s.h
+fi
+
nargs=none
for i in 5 6; do
if sh ./trycompile -DNUM_ARGS=${i} gethostbyname.c; then nargs=$i; break; fi
echo "#define NO_NAKED_POINTERS" >> m.h
fi
+# Add Unix-style optimization flag
+bytecccompopts="-O $bytecccompopts"
+dllcccompopts="-O $dllcccompopts"
+nativecccompopts="-O $nativecccompopts"
+sharedcccompopts="-O $sharedcccompopts"
+
# Final twiddling of compiler options to work around known bugs
nativeccprofopts="$nativecccompopts"
#ml let syslib x = "-l"^x;;
### How to build a static library
-MKLIB=ar rc \$(1) \$(2); ranlib \$(1)
-#ml let mklib out files opts = Printf.sprintf "ar rc %s %s %s; ranlib %s" out opts files out;;
+MKLIB=${TOOLPREF}ar rc \$(1) \$(2); ${TOOLPREF}ranlib \$(1)
+#ml let mklib out files opts = Printf.sprintf "${TOOLPREF}ar rc %s %s %s; ${TOOLPREF}ranlib %s" out opts files out;;
EOF
echo "ARCH=$arch" >> Makefile
echo "MODEL=$model" >> Makefile
echo "MKDLL=$mksharedlib" >> Makefile
echo "MKMAINDLL=$mkmaindll" >> Makefile
echo "RUNTIMED=${debugruntime}" >>Makefile
+if $shared_libraries_supported; then
+ echo "SHARED=shared" >>Makefile
+else
+ echo "SHARED=noshared" >>Makefile
+fi
echo "WITH_DEBUGGER=${with_debugger}" >>Makefile
echo "WITH_OCAMLDOC=${with_ocamldoc}" >>Makefile
echo "WITH_OCAMLBUILD=${with_ocamlbuild}" >>Makefile
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
+parser.cmi : parser_aux.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
#########################################################################
include ../config/Makefile
+CAMLRUN ?= ../boot/ocamlrun
+CAMLYACC ?= ../boot/ocamlyacc
-ROOTDIR=..
-CAMLC=$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib
+CAMLC=$(CAMLRUN) ../ocamlc -nostdlib -I ../stdlib
COMPFLAGS=-warn-error A -safe-string $(INCLUDES)
LINKFLAGS=-linkall -I $(UNIXDIR)
-CAMLYACC=../boot/ocamlyacc
YACCFLAGS=
-CAMLLEX=../boot/ocamlrun ../boot/ocamllex
-CAMLDEP=../boot/ocamlrun ../tools/ocamldep
+CAMLLEX=$(CAMLRUN) ../boot/ocamllex
+CAMLDEP=$(CAMLRUN) ../tools/ocamldep
DEPFLAGS=$(INCLUDES)
INSTALL_BINDIR=$(DESTDIR)$(BINDIR)
$(UNIXDIR)/unix.cma \
../utils/misc.cmo ../utils/config.cmo ../utils/tbl.cmo \
../utils/clflags.cmo ../utils/consistbl.cmo ../utils/warnings.cmo \
- ../parsing/location.cmo ../parsing/longident.cmo \
+ ../parsing/location.cmo ../parsing/longident.cmo ../parsing/docstrings.cmo \
../parsing/ast_helper.cmo ../parsing/ast_mapper.cmo \
../typing/ident.cmo ../typing/path.cmo ../typing/types.cmo \
../typing/btype.cmo ../typing/primitive.cmo ../typing/typedtree.cmo \
let module_name = convert_module (module_of_longident mdle) in
new_breakpoint
(try
+ let ev = event_at_pos module_name 0 in
+ let ev_pos =
+ {Lexing.dummy_pos with
+ pos_fname = (Events.get_pos ev).pos_fname} in
let buffer =
- try get_buffer Lexing.dummy_pos module_name with
+ try get_buffer ev_pos module_name with
| Not_found ->
eprintf "No source file for %s.@." module_name;
raise Toplevel
| Local obj -> Obj.is_block obj
| Remote v -> Obj.is_block (Array.unsafe_get (Obj.magic v : Obj.t array) 0)
- let tag = function
- | Local obj -> Obj.tag obj
- | Remote v ->
- output_char !conn.io_out 'H';
- output_remote_value !conn.io_out v;
- flush !conn.io_out;
- let header = input_binary_int !conn.io_in in
- header land 0xFF
+ let tag obj =
+ if not (is_block obj) then Obj.int_tag
+ else match obj with
+ | Local obj -> Obj.tag obj
+ | Remote v ->
+ output_char !conn.io_out 'H';
+ output_remote_value !conn.io_out v;
+ flush !conn.io_out;
+ let header = input_binary_int !conn.io_in in
+ header land 0xFF
let size = function
| Local obj -> Obj.size obj
(*** Conversion function. ***)
let source_of_module pos mdle =
+ let pos_fname = pos.Lexing.pos_fname in
+ if Sys.file_exists pos_fname then pos_fname else
let is_submodule m m' =
let len' = String.length m' in
try
let last_objfiles = ref []
(* Check validity of module name *)
-let check_unit_name ppf filename name =
+let is_unit_name 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 -> ()
+ true
+ with Exit -> false
;;
+let check_unit_name ppf filename name =
+ if not (is_unit_name name) then
+ Location.print_warning (Location.in_file filename) ppf
+ (Warnings.Bad_module_name name);;
+
(* Compute name of module from output file name *)
let module_of_filename ppf inputfile outputprefix =
let basename = Filename.basename outputprefix in
| "verbose" -> set "verbose" [ verbose ] v
| "nopervasives" -> set "nopervasives" [ nopervasives ] v
| "slash" -> set "slash" [ force_slash ] v (* for ocamldep *)
+ | "keep-docs" -> set "keep-docs" [ Clflags.keep_docs ] v
| "keep-locs" -> set "keep-locs" [ Clflags.keep_locs ] v
| "compact" -> clear "compact" [ optimize_for_speed ] v
(* *)
(***********************************************************************)
-(* val check_unit_name : Format.formatter -> string -> string -> unit *)
val module_of_filename : Format.formatter -> string -> string -> string
val output_prefix : string -> string
Before_args | Before_compile | Before_link
val readenv : Format.formatter -> readenv_position -> unit
+
+(* [is_unit_name name] returns true only if [name] can be used as a
+ correct module name *)
+val is_unit_name : string -> bool
+(* [check_unit_name ppf filename name] prints a warning in [filename]
+ on [ppf] if [name] should not be used as a module name. *)
+val check_unit_name : Format.formatter -> string -> string -> unit
let modulename = module_of_filename ppf sourcefile outputprefix in
Env.set_unit_name modulename;
let env = Compmisc.initial_env() in
- if !Clflags.print_types then begin
- let comp ast =
- ast
+ try
+ let (typedtree, coercion) =
+ Pparse.parse_implementation ~tool_name ppf sourcefile
++ print_if ppf Clflags.dump_parsetree Printast.implementation
++ 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
- ++ (fun _ -> ());
- Warnings.check_fatal ();
- Stypes.dump (Some (outputprefix ^ ".annot"))
+ Printtyped.implementation_with_coercion
in
- try comp (Pparse.parse_implementation ~tool_name ppf sourcefile)
- with x ->
- Stypes.dump (Some (outputprefix ^ ".annot"));
- raise x
- end else begin
- let objfile = outputprefix ^ ".cmo" in
- let oc = open_out_bin objfile in
- let comp ast =
- ast
- ++ print_if ppf Clflags.dump_parsetree Printast.implementation
- ++ 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
- ++ print_if ppf Clflags.dump_lambda Printlambda.lambda
- ++ Bytegen.compile_implementation modulename
- ++ print_if ppf Clflags.dump_instr Printinstr.instrlist
- ++ Emitcode.to_file oc modulename objfile;
+ if !Clflags.print_types then begin
Warnings.check_fatal ();
- close_out oc;
Stypes.dump (Some (outputprefix ^ ".annot"))
- in
- try comp (Pparse.parse_implementation ~tool_name ppf sourcefile)
- with x ->
- close_out oc;
- remove_file objfile;
- Stypes.dump (Some (outputprefix ^ ".annot"));
- raise x
- end
+ end else begin
+ let bytecode =
+ (typedtree, coercion)
+ ++ Translmod.transl_implementation modulename
+ ++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda
+ ++ Simplif.simplify_lambda
+ ++ print_if ppf Clflags.dump_lambda Printlambda.lambda
+ ++ Bytegen.compile_implementation modulename
+ ++ print_if ppf Clflags.dump_instr Printinstr.instrlist
+ in
+ let objfile = outputprefix ^ ".cmo" in
+ let oc = open_out_bin objfile in
+ try
+ bytecode
+ ++ Emitcode.to_file oc modulename objfile;
+ Warnings.check_fatal ();
+ close_out oc;
+ Stypes.dump (Some (outputprefix ^ ".annot"))
+ with x ->
+ close_out oc;
+ remove_file objfile;
+ raise x
+ end
+ with x ->
+ Stypes.dump (Some (outputprefix ^ ".annot"));
+ raise x
let c_file name =
Location.input_name := name;
let _compat_32 = set bytecode_compatible_32
let _config = show_config
let _custom = set custom_runtime
+ let _no_check_prims = set no_check_prims
let _dllib s = dllibs := Misc.rev_split_words s @ !dllibs
let _dllpath s = dllpaths := !dllpaths @ [s]
let _for_pack s = for_package := Some s
let _impl = impl
let _intf = intf
let _intf_suffix s = Config.interface_suffix := s
+ let _keep_docs = set keep_docs
let _keep_locs = set keep_locs
let _labels = unset classic
let _linkall = set link_everything
let _o s = output_name := Some s
let _open s = open_modules := s :: !open_modules
let _output_obj () = output_c_object := true; custom_runtime := true
+ let _output_complete_obj () =
+ output_c_object := true; output_complete_object := true; custom_runtime := true
let _pack = set make_package
let _pp s = preprocessor := Some s
let _ppx s = first_ppx := s :: !first_ppx
exit 2
let _ = main ()
+
+
+
+
"-intf_suffix", Arg.String f, "<string> (deprecated) same as -intf-suffix"
;;
+let mk_keep_docs f =
+ "-keep-docs", Arg.Unit f, " Keep documentation strings in .cmi files"
+;;
+
let mk_keep_locs f =
"-keep-locs", Arg.Unit f, " Keep locations in .cmi files"
;;
"-no-app-funct", Arg.Unit f, " Deactivate applicative functors"
;;
+let mk_no_check_prims f =
+ "-no-check-prims", Arg.Unit f, " Do not check runtime for primitives"
+;;
+
let mk_no_float_const_prop f =
"-no-float-const-prop", Arg.Unit f,
" Deactivate constant propagation for floating-point operations"
"-open", Arg.String f, "<module> Opens the module <module> before typing"
let mk_output_obj f =
- "-output-obj", Arg.Unit f, " Output a C object file instead of an executable"
+ "-output-obj", Arg.Unit f, " Output an object file instead of an executable"
+;;
+
+let mk_output_complete_obj f =
+ "-output-complete-obj", Arg.Unit f,
+ " Output an object file, including runtime, instead of an executable"
;;
let mk_p f =
val _impl : string -> unit
val _intf : string -> unit
val _intf_suffix : string -> unit
+ val _keep_docs : unit -> unit
val _keep_locs : unit -> unit
val _linkall : unit -> unit
val _noautolink : unit -> unit
val _o : string -> unit
val _output_obj : unit -> unit
+ val _output_complete_obj : unit -> unit
val _pack : unit -> unit
val _pp : string -> unit
val _principal : unit -> unit
include Compiler_options
val _compat_32 : unit -> unit
val _custom : unit -> unit
+ val _no_check_prims : unit -> unit
val _dllib : string -> unit
val _dllpath : string -> unit
val _make_runtime : unit -> unit
mk_compat_32 F._compat_32;
mk_config F._config;
mk_custom F._custom;
+ mk_custom F._no_check_prims;
mk_dllib F._dllib;
mk_dllpath F._dllpath;
mk_dtypes F._annot;
mk_intf F._intf;
mk_intf_suffix F._intf_suffix;
mk_intf_suffix_2 F._intf_suffix;
+ mk_keep_docs F._keep_docs;
mk_keep_locs F._keep_locs;
mk_labels F._labels;
mk_linkall F._linkall;
mk_modern F._labels;
mk_no_alias_deps F._no_alias_deps;
mk_no_app_funct F._no_app_funct;
+ mk_no_check_prims F._no_check_prims;
mk_noassert F._noassert;
mk_noautolink_byt F._noautolink;
mk_nolabels F._nolabels;
mk_o F._o;
mk_open F._open;
mk_output_obj F._output_obj;
+ mk_output_complete_obj F._output_complete_obj;
mk_pack_byt F._pack;
mk_pp F._pp;
mk_ppx F._ppx;
mk_inline F._inline;
mk_intf F._intf;
mk_intf_suffix F._intf_suffix;
+ mk_keep_docs F._keep_docs;
mk_keep_locs F._keep_locs;
mk_labels F._labels;
mk_linkall F._linkall;
mk_o F._o;
mk_open F._open;
mk_output_obj F._output_obj;
+ mk_output_complete_obj F._output_complete_obj;
mk_p F._p;
mk_pack_opt F._pack;
mk_pp F._pp;
val _impl : string -> unit
val _intf : string -> unit
val _intf_suffix : string -> unit
+ val _keep_docs : unit -> unit
val _keep_locs : unit -> unit
val _linkall : unit -> unit
val _noautolink : unit -> unit
val _o : string -> unit
val _output_obj : unit -> unit
+ val _output_complete_obj : unit -> unit
val _pack : unit -> unit
val _pp : string -> unit
val _principal : unit -> unit
include Compiler_options
val _compat_32 : unit -> unit
val _custom : unit -> unit
+ val _no_check_prims : unit -> unit
val _dllib : string -> unit
val _dllpath : string -> unit
val _make_runtime : unit -> unit
let cmxfile = outputprefix ^ ".cmx" in
let objfile = outputprefix ^ ext_obj in
let comp ast =
- if !Clflags.print_types
- then
+ let (typedtree, coercion) =
ast
++ print_if ppf Clflags.dump_parsetree Printast.implementation
++ 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
- ++ (fun _ -> ())
- else begin
- ast
- ++ print_if ppf Clflags.dump_parsetree Printast.implementation
- ++ 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
+ Printtyped.implementation_with_coercion
+ in
+ if not !Clflags.print_types then begin
+ (typedtree, coercion)
++ Translmod.transl_store_implementation modulename
+++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda
+++ Simplif.simplify_lambda
let _inline n = inline_threshold := n * 8
let _intf = intf
let _intf_suffix s = Config.interface_suffix := s
+ let _keep_docs = set keep_docs
let _keep_locs = set keep_locs
let _labels = clear classic
let _linkall = set link_everything
let _o s = output_name := Some s
let _open s = open_modules := s :: !open_modules
let _output_obj = set output_c_object
+ let _output_complete_obj s =
+ set output_c_object s; set output_complete_object s
let _p = set gprofile
let _pack = set make_package
let _pp s = preprocessor := Some s
(* Optionally preprocess a source file *)
-let preprocess sourcefile =
- match !Clflags.preprocessor with
- None -> sourcefile
- | Some pp ->
+let call_external_preprocessor sourcefile pp =
let tmpfile = Filename.temp_file "ocamlpp" "" in
let comm = Printf.sprintf "%s %s > %s"
pp (Filename.quote sourcefile) tmpfile
end;
tmpfile
+let preprocess sourcefile =
+ match !Clflags.preprocessor with
+ None -> sourcefile
+ | Some pp -> call_external_preprocessor sourcefile pp
+
+
let remove_preprocessed inputfile =
match !Clflags.preprocessor with
None -> ()
exception Outdated_version
-let file ppf ~tool_name inputfile parse_fun ast_magic =
+let open_and_check_magic inputfile ast_magic =
let ic = open_in_bin inputfile in
let is_ast_file =
try
Misc.fatal_error "OCaml and preprocessor have incompatible versions"
| _ -> false
in
+ (ic, is_ast_file)
+
+let file ppf ~tool_name inputfile parse_fun ast_magic =
+ let (ic, is_ast_file) = open_and_check_magic inputfile ast_magic in
let ast =
try
if is_ast_file then begin
close_in ic;
apply_rewriters ~restore:false ~tool_name ast_magic ast
+
let report_error ppf = function
| CannotRun cmd ->
fprintf ppf "Error while running external preprocessor@.\
val parse_implementation: formatter -> tool_name:string -> string -> Parsetree.structure
val parse_interface: formatter -> tool_name:string -> string -> Parsetree.signature
+
+(* [call_external_preprocessor sourcefile pp] *)
+val call_external_preprocessor : string -> string -> string
+val open_and_check_magic : string -> string -> in_channel * bool
+val read_ast : string -> string -> 'a
(require 'caml-emacs)))
+(defvar caml-types-build-dirs '("_build" "_obuild")
+ "List of possible compilation directories created by build systems.
+It is expected that the files under `caml-types-build-dir' preserve
+the paths relative to the parent directory of `caml-types-build-dir'.")
+(make-variable-buffer-local 'caml-types-build-dir)
+
+(defvar caml-annot-dir nil
+ "A directory, generally relative to the file location, containing the
+.annot file. Intended to be set as a local variable in the .ml file.
+See \"Specifying File Variables\" in the Emacs info manual.")
+(make-variable-buffer-local 'caml-annot-dir)
+(put 'caml-annot-dir 'safe-local-variable #'stringp)
(defvar caml-types-location-re nil "Regexp to parse *.annot files.
(defun caml-types-parent-dir (d) (file-name-directory (directory-file-name d)))
(defun caml-types-locate-type-file (target-path)
- (let ((sibling (concat (file-name-sans-extension target-path) ".annot")))
- (if (file-exists-p sibling)
- sibling
- (let ((project-dir (file-name-directory sibling))
- type-path)
- (while (not (file-exists-p
- (setq type-path
- (expand-file-name
- (file-relative-name sibling project-dir)
- (expand-file-name "_build" project-dir)))))
- (if (equal project-dir (caml-types-parent-dir project-dir))
- (error (concat "No annotation file. "
- "You should compile with option \"-annot\".")))
- (setq project-dir (caml-types-parent-dir project-dir)))
- type-path))))
+ "Given the path to an OCaml file, this function tries to locate
+and return the corresponding .annot file."
+ (let ((sibling (concat (file-name-sans-extension target-path) ".annot")))
+ (if (file-exists-p sibling)
+ sibling
+ (let* ((dir (file-name-directory sibling)))
+ (if caml-annot-dir
+ ;; Use the relative path set by the user
+ (let* ((annot-dir (expand-file-name caml-annot-dir dir))
+ (fname (file-name-nondirectory sibling))
+ (path-fname (expand-file-name fname annot-dir)))
+ (if (file-exists-p path-fname)
+ path-fname
+ (error (concat "No annotation file in " caml-annot-dir
+ ". Compile with option \"-annot\"."))))
+ ;; Else, try to get the .annot from one of build dirs.
+ (let* ((is-build (regexp-opt caml-types-build-dirs))
+ (project-dir (locate-dominating-file
+ dir
+ (lambda(d) (directory-files d nil is-build))))
+ (annot
+ (if project-dir
+ (locate-file
+ (file-relative-name sibling project-dir)
+ (mapcar (lambda(d) (expand-file-name d project-dir))
+ caml-types-build-dirs)))))
+ (if annot
+ annot
+ (error (concat "No annotation file. Compile with option "
+ "\"-annot\" or set `caml-annot-dir'.")))))))))
(defun caml-types-date< (date1 date2)
(or (< (car date1) (car date2))
--- /dev/null
+Patch taken from:
+ https://github.com/mshinwell/ocaml/commits/4.02-block-bounds
+
+diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml
+index 01eff9c..b498b58 100644
+--- a/asmcomp/cmmgen.ml
++++ b/asmcomp/cmmgen.ml
+@@ -22,6 +22,13 @@ open Clambda
+ open Cmm
+ open Cmx_format
+
++let do_check_field_access = true
++(*
++ match try Some (Sys.getenv "BOUNDS") with Not_found -> None with
++ | None | Some "" -> false
++ | Some _ -> true
++*)
++
+ (* Local binding of complex expressions *)
+
+ let bind name arg fn =
+@@ -494,6 +501,35 @@ let get_tag ptr =
+ let get_size ptr =
+ Cop(Clsr, [header ptr; Cconst_int 10])
+
++(* Bounds checks upon field access, for debugging the compiler *)
++
++let check_field_access ptr field_index if_success =
++ if not do_check_field_access then
++ if_success
++ else
++ let field_index = Cconst_int field_index in
++ (* If [ptr] points at an infix header, we need to move it back to the "main"
++ [Closure_tag] header. *)
++ let ptr =
++ Cifthenelse (Cop (Ccmpi Cne, [get_tag ptr; Cconst_int Obj.infix_tag]),
++ ptr,
++ Cop (Csuba, [ptr;
++ Cop (Cmuli, [get_size ptr (* == Infix_offset_val(ptr) *);
++ Cconst_int size_addr])]))
++ in
++ let not_too_small = Cop (Ccmpi Cge, [field_index; Cconst_int 0]) in
++ let not_too_big = Cop (Ccmpi Clt, [field_index; get_size ptr]) in
++ let failure =
++ Cop (Cextcall ("caml_field_access_out_of_bounds_error", typ_addr, false,
++ Debuginfo.none),
++ [ptr; field_index])
++ in
++ Cifthenelse (not_too_small,
++ Cifthenelse (not_too_big,
++ if_success,
++ failure),
++ failure)
++
+ (* Array indexing *)
+
+ let log2_size_addr = Misc.log2 size_addr
+@@ -1550,13 +1586,18 @@ and transl_prim_1 p arg dbg =
+ return_unit(remove_unit (transl arg))
+ (* Heap operations *)
+ | Pfield n ->
+- get_field (transl arg) n
++ let ptr = transl arg in
++ let body = get_field ptr n in
++ check_field_access ptr n body
+ | Pfloatfield n ->
+ let ptr = transl arg in
+- box_float(
+- Cop(Cload Double_u,
+- [if n = 0 then ptr
+- else Cop(Cadda, [ptr; Cconst_int(n * size_float)])]))
++ let body =
++ box_float(
++ Cop(Cload Double_u,
++ [if n = 0 then ptr
++ else Cop(Cadda, [ptr; Cconst_int(n * size_float)])]))
++ in
++ check_field_access ptr n body
+ | Pint_as_pointer ->
+ Cop(Cadda, [transl arg; Cconst_int (-1)])
+ (* Exceptions *)
+@@ -1649,20 +1690,25 @@ and transl_prim_1 p arg dbg =
+ and transl_prim_2 p arg1 arg2 dbg =
+ match p with
+ (* Heap operations *)
+- Psetfield(n, ptr) ->
+- if ptr then
+- 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))
++ Psetfield(n, is_ptr) ->
++ let ptr = transl arg1 in
++ let body =
++ if is_ptr then
++ Cop(Cextcall("caml_modify", typ_void, false,Debuginfo.none),
++ [field_address ptr n; transl arg2])
++ else
++ set_field ptr n (transl arg2)
++ in
++ check_field_access ptr n (return_unit body)
+ | Psetfloatfield n ->
+ let ptr = transl arg1 in
+- return_unit(
++ let body =
+ Cop(Cstore Double_u,
+ [if n = 0 then ptr
+ else Cop(Cadda, [ptr; Cconst_int(n * size_float)]);
+- transl_unbox_float arg2]))
+-
++ transl_unbox_float arg2])
++ in
++ check_field_access ptr n (return_unit body)
+ (* Boolean operations *)
+ | Psequand ->
+ Cifthenelse(test_bool(transl arg1), transl arg2, Cconst_int 1)
+diff --git a/asmrun/fail.c b/asmrun/fail.c
+index cb2c1cb..4f67c74 100644
+--- a/asmrun/fail.c
++++ b/asmrun/fail.c
+@@ -15,6 +15,7 @@
+
+ #include <stdio.h>
+ #include <signal.h>
++#include <assert.h>
+ #include "alloc.h"
+ #include "fail.h"
+ #include "io.h"
+@@ -180,3 +181,20 @@ int caml_is_special_exception(value exn) {
+ || exn == (value) caml_exn_Assert_failure
+ || exn == (value) caml_exn_Undefined_recursive_module;
+ }
++
++void caml_field_access_out_of_bounds_error(value v_block, intnat index)
++{
++ assert(Is_block(v_block));
++ fprintf(stderr, "Fatal error: out-of-bounds access to field %ld ", index);
++ fprintf(stderr, "of block at %p (%s, size %ld, tag %d)\n",
++ (void*) v_block,
++ Is_young(v_block) ? "in minor heap"
++ : Is_in_heap(v_block) ? "in major heap"
++ : Is_in_value_area(v_block) ? "in static data"
++ : "out-of-heap",
++ (long) Wosize_val(v_block), (int) Tag_val(v_block));
++ fflush(stderr);
++ /* This error may have occurred in places where it is not reasonable to
++ attempt to continue. */
++ abort();
++}
--- /dev/null
+#!/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. #
+# #
+#######################################################################
+
+(
+case $# in
+ 0) find . -type f -print;;
+ *) echo $1;;
+esac
+) | \
+while read f; do
+awk -f - "$f" <<\EOF
+
+function checkline (x) {
+ return ( $0 ~ ("^.{0,4}" x) );
+}
+
+function hrule () {
+ return (checkline("[*#]{69}"));
+}
+
+function blank () {
+ return (checkline(" {69}"));
+}
+
+function ocaml () {
+ return (checkline(" {32}OCaml {32}") \
+ || checkline(" {35}OCaml {32}") \
+ || checkline(" ocamlbuild ") \
+ || checkline(" OCamldoc ") \
+ );
+}
+
+function any () {
+ return (checkline(".{69}"));
+}
+
+function copy1 () {
+ return (checkline(" Copyright +[-0-9]+ +Institut +National +de +Recherche +en +Informatique +et "));
+}
+
+function copy2 () {
+ return (checkline(" en Automatique"));
+}
+
+function err () {
+ printf ("File \"%s\", line %d:\n", FILENAME, FNR);
+ printf (" Error: line %d of header is wrong.\n", FNR + offset);
+ print $0;
+}
+
+function add_ignore_re (x) {
+ ignore_re[++ignore_re_index] = x;
+}
+
+function add_exception (x) {
+ exception[++exception_index] = x;
+}
+
+FNR == 1 {
+ offset = 0;
+ add_ignore_re("/\\.svn/");
+ add_ignore_re("/\\.depend(\\.nt)?$");
+ add_ignore_re("/\\.ignore$");
+ add_ignore_re("\\.gif$");
+ add_ignore_re("/[A-Z]*$");
+ add_ignore_re("/README\\.[^/]*$");
+ add_ignore_re("/Changes$");
+ add_ignore_re("\\.mlpack$");
+ add_ignore_re("\\.mllib$");
+ add_ignore_re("\\.mltop$");
+ add_ignore_re("\\.clib$");
+ add_ignore_re("\\.odocl$");
+ add_ignore_re("\\.itarget$");
+ add_ignore_re("^\\./boot/");
+ add_ignore_re("^\\./camlp4/test/");
+ add_ignore_re("^\\./camlp4/unmaintained/");
+ add_ignore_re("^\\./config/gnu/");
+ add_ignore_re("^\\./experimental/");
+ add_ignore_re("^\\./ocamlbuild/examples/");
+ add_ignore_re("^\\./ocamlbuild/test/");
+ add_ignore_re("^\\./testsuite/");
+ for (i in ignore_re){
+ if (FILENAME ~ ignore_re[i]) { nextfile; }
+ }
+ add_exception("./asmrun/m68k.S"); # obsolete
+ add_exception("./build/camlp4-bootstrap-recipe.txt");
+ add_exception("./build/new-build-system");
+ add_exception("./ocamlbuild/ChangeLog");
+ add_exception("./ocamlbuild/manual/myocamlbuild.ml"); # TeX input file ?
+ add_exception("./ocamlbuild/manual/trace.out"); # TeX input file
+ add_exception("./ocamldoc/Changes.txt");
+ add_exception("./ocamldoc/ocamldoc.sty"); # public domain
+ add_exception("./tools/objinfo_helper.c"); # non-INRIA
+ add_exception("./tools/magic"); # public domain ?
+ add_exception("./Upgrading");
+ add_exception("./win32caml/inriares.h"); # generated
+ add_exception("./win32caml/ocaml.rc"); # generated
+ add_exception("./win32caml/resource.h"); # generated
+ for (i in exception){
+ if (FILENAME == exception[i]) { nextfile; }
+ }
+}
+
+# 1 [!hrule] #!
+# 2 [!hrule] empty
+# 3 hrule
+# 4 [blank]
+# 5 ocaml title
+# 6 blank
+# 7 any author
+# 8 [!blank] author
+# 9 [!blank] author
+#10 blank
+#11 copy1 copyright
+#12 copy2 copyright
+#13 any copyright
+#14 [!blank] copyright
+#15 [!blank] copyright
+#16 blank
+#17 hrule
+
+FNR + offset == 1 && hrule() { ++offset; }
+FNR + offset == 2 && hrule() { ++offset; }
+FNR + offset == 3 && ! hrule() { err(); nextfile; }
+FNR + offset == 4 && ! blank() { ++offset; }
+FNR + offset == 5 && ! ocaml() { err(); nextfile; }
+FNR + offset == 6 && ! blank() { err(); nextfile; }
+FNR + offset == 7 && ! any() { err(); nextfile; }
+FNR + offset == 8 && blank() { ++offset; }
+FNR + offset == 9 && blank() { ++offset; }
+FNR + offset ==10 && ! blank() { err(); nextfile; }
+FNR + offset ==11 && ! copy1() { err(); nextfile; }
+FNR + offset ==12 && ! copy2() { err(); nextfile; }
+FNR + offset ==13 && ! any() { err(); nextfile; }
+FNR + offset ==14 && blank() { ++offset; }
+FNR + offset ==15 && blank() { ++offset; }
+FNR + offset ==16 && ! blank() { err(); nextfile; }
+FNR + offset ==17 && ! hrule() { err(); nextfile; }
+
+EOF
+done
--- /dev/null
+ROOT=../..
+OCAMLC=$(ROOT)/boot/ocamlrun $(ROOT)/ocamlc -I $(ROOT)/stdlib -I $(ROOT)/parsing -I $(ROOT)/utils -I $(ROOT)/tools -I $(ROOT)/typing -I $(ROOT)/driver -I $(ROOT)/toplevel -w A-4-9-42
+COMMON=$(ROOT)/compilerlibs/ocamlcommon.cma
+BYTECMP=$(ROOT)/compilerlibs/ocamlbytecomp.cma
+TOPLVL=$(ROOT)/compilerlibs/ocamltoplevel.cma
+
+clean:
+ rm -f *.exe *.cm* *~
+
+## Detecting unused exported values
+
+.PHONY: unused_exported_values
+unused_exported_values:
+ $(OCAMLC) -o unused_exported_values.exe $(COMMON) $(ROOT)/tools/tast_iter.cmo unused_exported_values.ml
+
+
+## Conditional compilation based on environment variables
+
+.PHONY: ifdef
+ifdef:
+ $(OCAMLC) -o ifdef.exe $(COMMON) ifdef.ml
+ $(OCAMLC) -o test_ifdef.exe -ppx ./ifdef.exe -dsource test_ifdef.ml
+ ./test_ifdef.exe
+
+## A proposal for replacing js_of_ocaml Camlp4 syntax extension with
+## a -ppx filter
+
+.PHONY: js_syntax
+js_syntax:
+ $(OCAMLC) -o js_syntax.exe $(COMMON) js_syntax.ml
+ $(OCAMLC) -o test_ifdef.exe -i -ppx ./js_syntax.exe test_js.ml
+
+
+## A "toy" ocamldoc clone based on .cmti files
+
+.PHONY: minidoc
+minidoc:
+ $(OCAMLC) -custom -o minidoc.exe $(COMMON) minidoc.ml
+ $(OCAMLC) -c -bin-annot testdoc.mli
+ ./minidoc.exe testdoc.cmti
+
+## Using the OCaml toplevel to evaluate expression during compilation
+
+.PHONY: eval
+eval:
+ $(OCAMLC) -linkall -o eval.exe $(COMMON) $(BYTECMP) $(TOPLVL) eval.ml
+ $(OCAMLC) -o test_eval.exe -ppx ./eval.exe test_eval.ml
+ ./test_eval.exe
+
+## Example of code generation based on type declarations
+
+.PHONY: ppx_builder
+ppx_builder:
+ $(OCAMLC) -linkall -o ppx_builder.exe $(COMMON) ppx_builder.ml
+ $(OCAMLC) -o test_builder.exe -ppx ./ppx_builder.exe -dsource test_builder.ml
+
+## Import type definitions from other source files (e.g. to avoid code
+## duplication between the .ml and .mli files)
+
+.PHONY: copy_typedef
+copy_typedef:
+ $(OCAMLC) -linkall -o copy_typedef.exe $(COMMON) copy_typedef.ml
+ $(OCAMLC) -c -ppx ./copy_typedef.exe test_copy_typedef.mli
+ $(OCAMLC) -o test_copy_typedef.exe -ppx ./copy_typedef.exe -dsource test_copy_typedef.ml
+
+
+## Create mli files from ml files
+
+.PHONY: nomli
+nomli:
+ $(OCAMLC) -linkall -o nomli.exe $(COMMON) $(BYTECMP) ../../tools/untypeast.cmo ../../tools/tast_iter.cmo nomli.ml
+ ./nomli.exe test_nomli.ml
+
+## A port of pa_matches
+
+.PHONY: matches
+matches:
+ $(OCAMLC) -linkall -o ppx_matches.exe $(COMMON) ppx_matches.ml
+ $(OCAMLC) -c -dsource -ppx ./ppx_matches.exe test_matches.ml
--- /dev/null
+(*
+ A -ppx rewriter to copy type definitions from the interface into
+ the implementation.
+
+ In an .ml file, you can write:
+
+ type t = [%copy_typedef]
+
+ and the concrete definition will be copied from the corresponding .mli
+ file (looking for the type name in the same path).
+
+ The same is available for module types:
+
+ module type S = [%copy_typedef]
+
+ You can also import a definition from an arbitrary .ml/.mli file.
+ Example:
+
+ type loc = [%copy_typedef "../../parsing/location.mli" t]
+
+ Note: the definitions are imported textually without any substitution.
+*)
+
+module Main : sig end = struct
+ open Asttypes
+ open! Location
+ open Parsetree
+
+ let fatal loc s =
+ Location.print_error Format.err_formatter loc;
+ prerr_endline ("** copy_typedef: " ^ Printexc.to_string s);
+ exit 2
+
+ class maintain_path = object(this)
+ inherit Ast_mapper.mapper as super
+
+ val path = []
+
+ method! module_binding m = {< path = m.pmb_name.txt :: path >} # super_module_binding m
+ method super_module_binding = super # module_binding
+
+ method! module_declaration m = {< path = m.pmd_name.txt :: path >} # super_module_declaration m
+ method super_module_declaration = super # module_declaration
+
+ method! module_type_declaration m = {< path = m.pmtd_name.txt :: path >} # super_module_type_declaration m
+ method super_module_type_declaration = super # module_type_declaration
+
+ method! structure_item s =
+ let s =
+ match s.pstr_desc with
+ | Pstr_type tdecls -> {s with pstr_desc=Pstr_type (List.map (this # tydecl) tdecls)}
+ | Pstr_modtype mtd -> {s with pstr_desc=Pstr_modtype (this # mtydecl mtd)}
+ | _ -> s
+ in
+ super # structure_item s
+
+ method! signature_item s =
+ let s =
+ match s.psig_desc with
+ | Psig_type tdecls -> {s with psig_desc=Psig_type (List.map (this # tydecl) tdecls)}
+ | Psig_modtype mtd -> {s with psig_desc=Psig_modtype (this # mtydecl mtd)}
+ | _ -> s
+ in
+ super # signature_item s
+
+ method tydecl x = x
+ method mtydecl x = x
+ end
+
+ let memoize f =
+ let h = Hashtbl.create 16 in
+ fun x ->
+ try Hashtbl.find h x
+ with Not_found ->
+ let r = f x in
+ Hashtbl.add h x r;
+ r
+
+ let from_file file =
+ let types = Hashtbl.create 16 in
+ let mtypes = Hashtbl.create 16 in
+ let collect = object
+ inherit maintain_path
+ method! tydecl x =
+ Hashtbl.add types (path, x.ptype_name.txt) x;
+ x
+ method! mtydecl x =
+ Hashtbl.add mtypes (path, x.pmtd_name.txt) x;
+ x
+ end
+ in
+ let ic = open_in file in
+ let lexbuf = Lexing.from_channel ic in
+ if Filename.check_suffix file ".ml"
+ then ignore (collect # structure (Parse.implementation lexbuf))
+ else if Filename.check_suffix file ".mli"
+ then ignore (collect # signature (Parse.interface lexbuf))
+ else failwith (Printf.sprintf "Unknown extension for %s" file);
+ close_in ic;
+ object
+ method tydecl path name =
+ try Hashtbl.find types (path, name)
+ with Not_found ->
+ failwith
+ (Printf.sprintf "Cannot find type %s in file %s\n%!"
+ (String.concat "." (List.rev (name :: path))) file)
+
+ method mtydecl path name =
+ try Hashtbl.find mtypes (path, name)
+ with Not_found ->
+ failwith
+ (Printf.sprintf "Cannot find module type %s in file %s\n%!"
+ (String.concat "." (List.rev (name :: path))) file)
+ end
+
+ let from_file = memoize from_file
+
+ let copy = object(this)
+ inherit maintain_path as super
+
+ val mutable file = ""
+
+ method source name = function
+ | PStr [] ->
+ let file =
+ if Filename.check_suffix file ".ml"
+ then (Filename.chop_suffix file ".ml") ^ ".mli"
+ else if Filename.check_suffix file ".mli"
+ then (Filename.chop_suffix file ".mli") ^ ".ml"
+ else failwith "Unknown source extension"
+ in
+ file, path, name
+ | PStr [{pstr_desc=Pstr_eval
+ ({pexp_desc=Pexp_apply
+ ({pexp_desc=Pexp_constant(Const_string (file, _)); _},
+ ["", {pexp_desc=Pexp_ident{txt=lid;_}; _}]); _}, _); _}] ->
+ begin match List.rev (Longident.flatten lid) with
+ | [] -> assert false
+ | name :: path -> file, path, name
+ end
+ | _ ->
+ failwith "Cannot parse argument"
+
+ method! tydecl = function
+ | {ptype_kind = Ptype_abstract;
+ ptype_manifest =
+ Some{ptyp_desc=Ptyp_extension({txt="copy_typedef";_}, arg); _};
+ ptype_name = name; ptype_loc = loc; _
+ } ->
+ begin try
+ let (file, path, x) = this # source name.txt arg in
+ {((from_file file) # tydecl path x)
+ with ptype_name = name; ptype_loc = loc}
+ with exn -> fatal loc exn
+ end
+ | td -> td
+
+ method! mtydecl = function
+ | {pmtd_type = Some{pmty_desc=Pmty_extension({txt="copy_typedef";_}, arg);
+ pmty_loc=loc; _};
+ pmtd_name = name; _
+ } ->
+ begin try
+ let (file, path, x) = this # source name.txt arg in
+ {((from_file file) # mtydecl path x)
+ with pmtd_name = name}
+ with exn -> fatal loc exn
+ end
+ | td -> td
+
+ method! implementation f x =
+ file <- f;
+ super # implementation f x
+
+ method! interface f x =
+ file <- f;
+ super # interface f x
+ end
+
+ let () = Ast_mapper.main copy
+end
--- /dev/null
+(* A -ppx rewriter which evaluates expressions at compile-time,
+ using the OCaml toplevel interpreter.
+
+ The following extensions are supported:
+
+ [%eval e] in expression context: the expression e will be evaluated
+ at compile time, and the resulting value will be inserted as a
+ constant literal.
+
+ [%%eval.start] as a structure item: forthcoming structure items
+ until the next [%%eval.stop] will be evaluated at compile time (the
+ result is ignored) only.
+
+ [%%eval.start both] as a structure item: forthcoming structure
+ items until the next [%%eval.stop] will be evaluated at compile
+ time (the result is ignored), but also kept in the compiled unit.
+
+ [%%eval.load "..."] as a structure item: load the specified
+ .cmo unit or .cma library, so that it can be used in the forthcoming
+ compile-time components.
+*)
+
+
+module Main : sig end = struct
+
+ open Location
+ open Parsetree
+ open Ast_helper
+ open Outcometree
+ open Ast_helper.Convenience
+
+ let rec lid_of_out_ident = function
+ | Oide_apply _ -> assert false
+ | Oide_dot (x, s) -> lid_of_out_ident x ^ "." ^ s
+ | Oide_ident s -> s
+
+ let rec exp_of_out_value = function
+ | Oval_string x -> str x
+ | Oval_int x -> int x
+ | Oval_char x -> char x
+ | Oval_float x -> Ast_helper.Convenience.float x
+ | Oval_list l -> list (List.map exp_of_out_value l)
+ | Oval_array l -> Exp.array (List.map exp_of_out_value l)
+ | Oval_constr (c, args) -> constr (lid_of_out_ident c) (List.map exp_of_out_value args)
+ | Oval_record l ->
+ record
+ (List.map
+ (fun (s, v) -> lid_of_out_ident s, exp_of_out_value v) l)
+ | v ->
+ Format.eprintf "[%%eval] cannot map value to expression:@.%a@."
+ !Toploop.print_out_value
+ v;
+ exit 2
+
+ let empty_str_item = Str.include_ (Mod.structure [])
+
+ let run phr =
+ try Toploop.execute_phrase true Format.err_formatter phr
+ with exn ->
+ Errors.report_error Format.err_formatter exn;
+ exit 2
+
+ let get_exp loc = function
+ | PStr [ {pstr_desc=Pstr_eval (e, _); _} ] -> e
+ | _ ->
+ Format.eprintf "%aExpression expected@."
+ Location.print_error loc;
+ exit 2
+
+ let eval _args =
+ let open Ast_mapper in
+ let eval_str_items = ref None in
+ let super = default_mapper in
+ let my_structure_item this i =
+ match i.pstr_desc with
+ | Pstr_extension(({txt="eval.load";loc}, e0), _) ->
+ let e0 = get_exp loc e0 in
+ let s =
+ match get_str e0 with
+ | Some s -> s
+ | None ->
+ Location.print_error Format.err_formatter e0.pexp_loc;
+ Format.eprintf "string literal expected";
+ exit 2
+ in
+ if not (Topdirs.load_file Format.err_formatter s) then begin
+ Location.print Format.err_formatter e0.pexp_loc;
+ exit 2;
+ end;
+ empty_str_item
+ | Pstr_extension(({txt="eval.start";_},
+ PStr [{pstr_desc=Pstr_eval (e, _);_}]
+ ), _) when get_lid e = Some "both" ->
+ eval_str_items := Some true;
+ empty_str_item
+ | Pstr_extension(({txt="eval.start";_}, PStr []), _) ->
+ eval_str_items := Some false;
+ empty_str_item
+ | Pstr_extension(({txt="eval.stop";_}, PStr []), _) ->
+ eval_str_items := None;
+ empty_str_item
+ | _ ->
+ let s = super.structure_item this i in
+ match !eval_str_items with
+ | None -> s
+ | Some both ->
+ if not (run (Ptop_def [s])) then begin
+ Location.print_error Format.err_formatter s.pstr_loc;
+ Format.eprintf "this structure item raised an exception@.";
+ exit 2
+ end;
+ if both then s else empty_str_item
+ in
+ let my_expr this e =
+ match e.pexp_desc with
+ | Pexp_extension({txt="eval";loc}, e0) ->
+ let e0 = get_exp loc e0 in
+ let last_result = ref None in
+ let pop = !Toploop.print_out_phrase in
+ Toploop.print_out_phrase := begin fun _ppf -> function
+ | Ophr_eval (v, _) -> last_result := Some v
+ | r ->
+ Location.print_error Format.err_formatter e.pexp_loc;
+ Format.eprintf "error while evaluating expression:@.%a@."
+ pop
+ r;
+ exit 2
+ end;
+ assert (run (Ptop_def [Str.eval e0]));
+ Toploop.print_out_phrase := pop;
+ let v = match !last_result with None -> assert false | Some v -> v in
+ with_default_loc e0.pexp_loc (fun () -> exp_of_out_value v)
+ | _ ->
+ super.expr this e
+ in
+ Toploop.initialize_toplevel_env ();
+ {super with expr = my_expr; structure_item = my_structure_item}
+
+
+ let () = Ast_mapper.run_main eval
+end
--- /dev/null
+This file describes the changes on the extension_points branch.
+
+
+=== Attributes
+
+Attributes are "decorations" of the syntax tree which are ignored by
+the type-checker. An attribute is made of an identifier (written id below)
+and a payload (written s below).
+
+ * The identifier 'id' can be a lowercase or uppercase identifier
+ (including OCaml keywords) or a sequence of such atomic identifiers
+ separated with a dots (whitespaces are allowed around the dots).
+ In the Parsetree, the identifier is represented as a single string
+ (without spaces).
+
+ * The payload 's' can be one of three things:
+
+ - An OCaml structure (i.e. a list of structure items). Note that a
+ structure can be empty or reduced to a single expression.
+
+ [@id]
+ [@id x + 3]
+ [@id type t = int]
+
+ - A type expression, prefixed with the ":" character.
+
+ [@id : TYP]
+
+ - A pattern, prefixed with the "?" character, and optionally followed
+ by a "when" clause:
+
+ [@id ? PAT]
+ [@id ? PAT when EXPR]
+
+
+Attributes on expressions, type expressions, module expressions, module type expressions,
+patterns, class expressions, class type expressions:
+
+ ... [@id s]
+
+The same syntax [@id s] is also available to add attributes on
+constructors and labels in type declarations:
+
+ type t =
+ | A [@id1]
+ | B [@id2] of int [@id3]
+
+Here, id1 (resp. id2) is attached to the constructor A (resp. B)
+and id3 is attached to the int type expression. Example on records:
+
+ type t =
+ {
+ x [@id1]: int;
+ mutable y [@id2] [@id3]: string [@id4];
+ }
+
+
+Attributes on items:
+
+ ... [@@id s]
+
+ Items designate:
+ - structure and signature items (for type declarations, recursive modules, class
+ declarations and class type declarations, each component has its own attributes)
+ - class fields and class type fields
+ - each binding in a let declaration (for let structure item, local let-bindings in
+ expression and class expressions)
+
+ For instance, consider:
+
+ type t1 = ... [@@id1] [@@id2] and t2 = ... [@@id3] [@@id4]
+
+ Here, the attributes on t1 are id1, id23; the attributes on
+ t2 are id3 and id4.
+
+ Similarly for:
+
+ let x1 = ... [@@id1] [@@id2] and x2 = ... [@@id3] [@@id4]
+
+
+Floating attributes:
+
+ The [@@@id s] form defines an attribute which stands as a
+ stand-alone signature or structure item (not attached to another
+ item).
+
+ Example:
+
+ module type S = sig
+ [@@id1]
+ type t
+ [@@id2]
+ [@@@id3] [@@@id4]
+ [@@@id5]
+ type s
+ [@@id6]
+ end
+
+ Here, id1, id3, id4, id5 are floating attributes, while
+ id2 is attached to the type t and id6 is attached to the type s.
+
+=== Extension nodes
+
+Extension nodes replace valid components in the syntax tree. They are
+normally interpreted and expanded by AST mapper. The type-checker
+fails when it encounters such an extension node. An extension node is
+made of an identifier (an "LIDENT", written id below) and an optional
+expression (written expr below).
+
+Two syntaxes exist for extension node:
+
+As expressions, type expressions, module expressions, module type expressions,
+patterns, class expressions, class type expressions:
+
+ [%id s]
+
+As structure item, signature item, class field, class type field:
+
+ [%%id s]
+
+As other structure item, signature item, class field or class type
+field, attributes can be attached to a [%%id s] extension node.
+
+
+
+=== Alternative syntax for attributes and extensions on specific kinds of nodes
+
+All expression constructions starting with a keyword (EXPR = KW REST) support an
+alternative syntax for attributes and/or extensions:
+
+ KW[@id s]...[@id s] REST
+ ---->
+ EXPR[@id s]...[@id s]
+
+ KW%id REST
+ ---->
+ [%id EXPR]
+
+ KW%id[@id s]...[@id s] REST
+ ---->
+ [%id EXPR[@id s]...[@id s]]
+
+
+where KW can stand for:
+ assert
+ begin
+ for
+ fun
+ function
+ if
+ lazy
+ let
+ let module
+ let open
+ match
+ new
+ object
+ try
+ while
+
+
+For instance:
+
+let[@foo] x = 2 in x + 1 ==== (let x = 2 in x + 1)[@foo]
+begin[@foo] ... end ==== (begin ... end)[@foo]
+match%foo e with ... ==== [%foo match e with ...]
+
+
+The let-binding form of structure items also supports this form:
+
+let%foo x = ... ==== [%%foo let x = ...]
+
+=== Quoted strings
+
+Quoted strings gives a different syntax to write string literals in
+OCaml code. This will typically be used to support embedding pieces
+of foreign syntax fragments (to be interpret by a -ppx filter or just
+a library) in OCaml code.
+
+The opening delimiter has the form {id| where id is a (possibly empty)
+sequence of lowercase letters. The corresponding closing delimiter is
+|id} (the same identifier). Contrary to regular OCaml string
+literals, quoted strings don't interpret any character in a special
+way.
+
+Example:
+
+String.length {|\"|} (* returns 2 *)
+String.length {foo|\"|foo} (* returns 2 *)
+
+
+The fact that a string literal comes from a quoted string is kept in
+the Parsetree representation. The Astypes.Const_string constructor is
+now defined as:
+
+ | Const_string of string * string option
+
+where the "string option" represents the delimiter (None for a string
+literal with the regular syntax).
+
+
+=== Representation of attributes in the Parsetree
+
+Attributes as standalone signature/structure items are represented
+by a new constructor:
+
+ | Psig_attribute of attribute
+ | Pstr_attribute of attribute
+
+Most other attributes are stored in an extra field in their record:
+
+and expression = {
+ ...
+ pexp_attributes: attribute list;
+ ...
+}
+and type_declaration = {
+ ...
+ ptype_attributes: attribute list;
+ ...
+}
+
+In a previous version, attributes on expressions (and types, patterns,
+etc) used to be stored as a new constructor. The current choice makes
+it easier to pattern match on structured AST fragments while ignoring
+attributes.
+
+For open/include signature/structure items and exception rebind
+structure item, the attributes are stored directly in the constructor
+of the item:
+
+ | Pstr_open of Longident.t loc * attribute list
+
+
+=== Attributes in the Typedtree
+
+The Typedtree representation has been updated to follow closely the
+Parsetree, and attributes are kept exactly as in the Parsetree. This
+can allow external tools to process .cmt/.cmti files and process
+attributes in them. An example of a mini-ocamldoc based on this
+technique is in experimental/frisch/minidoc.ml.
+
+
+=== Other changes to the parser and Parsetree
+
+--- Introducing Ast_helper module
+
+This module simplifies the creation of AST fragments, without having to
+touch the concrete type definitions of Parsetree. Record and sum types
+are encapsulated in builder functions, with some optional arguments, e.g.
+to represent attributes.
+
+--- Relaxing the syntax for signatures and structures
+
+It is now possible to start a signature or a structure with a ";;" token and to have two successive ";;" tokens.
+
+Rationale:
+ In an intermediate version of this branch, floating attributes shared
+ the same syntax as item attributes, with the constraints that they
+ had to appear either at the beginning of their structure or signature,
+ or after ";;". The relaxation above made is possible to always prefix
+ a floating attributes by ";;" independently of its context.
+
+ Floating attributes now have a custom syntax [@@@id], but this changes
+ is harmless, and the same argument holds for toplevel expressions:
+ it is always possile to write:
+
+ ;; print_endline "bla";;
+
+ without having to care about whether the previous structure item
+ ends with ";;" or not.
+
+
+-- Relaxing the syntax for exception declarations
+
+The parser now accepts the same syntax for exceptioon declarations as for constructor declarations,
+which permits the GADT syntax:
+
+ exception A : int -> foo
+
+The type-checker rejects this form. Note that it is also possible to
+define exception whose name is () or ::.
+
+Attributes can be put on the constructor or on the whole declaration:
+
+ exception A[@foo] of int [@@bar]
+
+Rationale:
+ One less notion in the Parsetree, more uniform parsing. Also
+ open the door to existentials in exception constructors.
+
+--- Relaxing the syntax for recursive modules
+
+Before:
+ module X1 : MT1 = M1 and ... and Xn : MTn = Mn
+
+Now:
+ module X1 = M1 and ... and Xn = Mn
+ (with the usual sugar that Xi = (Mi : MTi) can be written as Xi : MTi = Mi
+ which gives the old syntax)
+
+ The type-checker fails when a module expression is not of
+ the form (M : MT)
+
+
+Rationale:
+
+1. More uniform representation in the Parsetree.
+
+2. The type-checker can be made more clever in the future to support
+ other forms of module expressions (e.g. functions with an explicit
+ constraint on its result; or a structure with only type-level
+ components).
+
+
+--- Turning some tuple or n-ary constructors into records
+
+Before:
+
+ | Pstr_module of string loc * module_expr
+
+After:
+
+ | Pstr_module of module_binding
+...
+ and module_binding =
+ {
+ pmb_name: string loc;
+ pmb_expr: module_expr;
+ pmb_attributes: attribute list;
+ }
+
+
+
+Rationale:
+
+More self-documented, more robust to future additions (such as
+attributes), simplifies some code.
+
+
+--- Keeping names inside value_description and type_declaration
+
+Before:
+
+ | Psig_type of (string loc * type_declaration) list
+
+
+After:
+
+ | Psig_type of type_declaration list
+
+....
+and type_declaration =
+ { ptype_name: string loc;
+ ...
+ }
+
+Rationale:
+
+More self-documented, simplifies some code.
+
+
+--- Better representation of variance information on type parameters
+
+Introduced a new type Asttypes.variance to represent variance
+(Covariant/Contravariant/Invariant) and use it instead of bool * bool
+in Parsetree. Moreover, variance information is now attached
+directly to the parameters fields:
+
+ and type_declaration =
+ { ptype_name: string loc;
+- ptype_params: string loc option list;
++ ptype_params: (string loc option * variance) 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_attributes: attribute list;
+ ptype_loc: Location.t }
+
+
+--- Getting rid of 'Default' case in Astypes.rec_flag
+
+This constructor was used internally only during the compilation of
+default expression for optional arguments, in order to trigger a
+subsequent optimization (see PR#5975). This behavior is now
+implemented by creating an attribute internally (whose name "#default"
+cannot be used in real programs).
+
+Rationale:
+
+ - Attributes give a way to encode information local to the
+ type-checker without polluting the definition of the Parsetree.
+
+--- Simpler and more faithful representation of object types
+
+- | Ptyp_object of core_field_type list
++ | Ptyp_object of (string * core_type) list * closed_flag
+
+(and get rid of Parsetree.core_field_type)
+
+And same in the Typedtree.
+
+Rationale:
+
+ - More faithful representation of the syntax really supported
+ (i.e. the ".." can only be the last field).
+ - One less "concept" in the Parsetree.
+
+
+--- Do not require empty Ptyp_poly nodes in the Parsetree
+
+The type-checker automatically inserts Ptyp_poly node (with no
+variable) where needed. It is still allowed to put empty
+Ptyp_poly nodes in the Parsetree.
+
+Rationale:
+
+ - Less chance that Ast-related code forget to insert those nodes.
+
+To be discussed: should we segrate simple_poly_type from core_type in the
+Parsetree to prevent Ptyp_poly nodes to be inserted in the wrong place?
+
+
+--- Use constructor names closer to concrete syntax
+
+E.g. Pcf_cstr -> Pcf_constraint.
+
+Rationale:
+
+ - Make the Parsetree more self-documented.
+
+--- Merge concrete/virtual val and method constructors
+
+As in the Typedtree.
+
+- | 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_val of (string loc * mutable_flag * class_field_kind)
++ | Pcf_method of (string loc * private_flag * class_field_kind
+...
++and class_field_kind =
++ | Cfk_virtual of core_type
++ | Cfk_concrete of override_flag * expression
++
+
+--- Explicit representation of "when" guards
+
+Replaced the "(pattern * expression) list" argument of Pexp_function, Pexp_match, Pexp_try
+with "case list", with case defined as:
+
+ {
+ pc_lhs: pattern;
+ pc_guard: expression option;
+ pc_rhs: expression;
+ }
+
+and get rid of Pexp_when. Idem in the Typedtree.
+
+Rationale:
+
+ - Make it explicit when the guard can appear.
+
+--- Get rid of "fun p when guard -> e"
+
+See #5939, #5936.
+
+
+--- Get rid of the location argument on pci_params
+
+It was only used for error messages, and we get better location using
+the location of each parameter variable.
+
+--- More faithful representation of "with constraint"
+
+All kinds of "with constraints" used to be represented together with a
+Longident.t denoting the constrained identifier. Now, each constraint
+keeps its own constrainted identifier, which allows us to express more
+invariants in the Parsetree (such as: := constraints cannot be on qualified
+identifiers). Also, we avoid mixing in a single Longident.t identifier
+which can be LIDENT or UIDENT.
+
+--- Get rid of the "#c [> `A]" syntax
+
+See #5936, #5983.
+
+--- Keep interval patterns in the Parsetree
+
+They used to be expanded into or-patterns by the parser. It is better to do
+the expansion in the type-checker to allow -ppx rewriters to see the interval
+patterns.
+
+Note: Camlp4 parsers still expand interval patterns themselves (TODO?).
+
+--- Get rid of Pexp_assertfalse
+
+Do not treat specially "assert false" in the parser any more, but
+instead in the type-checker. This simplifies the Parsetree and avoids
+a potential source of confusion. Moreove, this ensures that
+attributes can be put (and used by ppx rewriters) on the "false"
+expressions. This is also more robust, since it checks that the
+condition is the constructor "false" after type-checking the condition:
+
+ - if "false" is redefined (as a constructor of a different sum type),
+ an error will be reported;
+
+ - "extra" layers which are represented as exp_extra in the typedtree
+ won't break the detection of the "false", e.g. the following will
+ be recognized as "assert false":
+
+ assert(false : bool)
+ assert(let open X in false)
+
+Note: Camlp4's AST still has a special representation for "assert false".
+
+--- Get rid of the "explicit arity" flag on Pexp_construct/Ppat_construct
+
+This Boolean was used (only by camlp5?) to indicate that the tuple
+(expression/pattern) used as the argument was intended to correspond
+to the arity of an n-ary constructor. In particular, this allowed
+the revised syntax to distinguish "A x y" from "A (x, y)" (the second one
+being wrapped in an extra fake tuple) and get a proper error message
+if "A (x, y)" was used with a constructor expecting two arguments.
+
+The feature has been preserved, but the information that a
+Pexp_construct/Ppat_constructo node has an "exact arity" is now
+propagated used as am attribute "ocaml.explicit_arity" on that node.
+
+--- Split Pexp_function into Pexp_function/Pexp_fun
+
+This reflects more closely the concrete syntax and removes cases of
+Parsetree fragments which don't correspond to concrete syntax.
+
+Typedtree has not been changed.
+
+Note: Camlp4's AST has not been adapted.
+
+--- Split Pexp_constraint into Pexp_constraint/Pexp_coerce
+
+Idem in the Typedtree.
+
+This reflects more closely the concrete syntax.
+
+Note: Camlp4's AST has not been adapted.
+
+--- Accept abstract module type declaration in structures
+
+Previously, we could declare:
+
+ module type S
+
+in signatures, but not implementations. To make the syntax, the Parsetree
+and the type-checker more uniform, this is now also allowed in structures
+(altough this is probably useless in practice).
+
+=== More TODOs
+
+- Adapt pprintast to print attributes and extension nodes.
+- Adapt Camlp4 (both its parser(s) and its internal representation of OCaml ASTs).
+- Consider adding hooks to the type-checker so that custom extension expanders can be registered (a la OCaml Templates).
+- Make the Ast_helper module more user-friendly (e.g. with optional arguments and good default values) and/or
+ expose higher-level convenience functions.
+- Document Ast_helper modules.
+
+=== Use cases
+
+From https://github.com/gasche/ocaml-syntax-extension-discussion/wiki/Use-Cases
+
+-- Bisect
+
+ let f x =
+ match List.map foo [x; a x; b x] with
+ | [y1; y2; y3] -> tata
+ | _ -> assert false [@bisect VISIT]
+
+;;[@@bisect IGNORE-BEGIN]
+let unused = ()
+;;[@@bisect IGNORE-END]
+
+-- OCamldoc
+
+val stats : ('a, 'b) t -> statistics
+[@@doc
+ "[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"]
+
+;;[@@doc section 6 "Functorial interface"]
+
+module type HashedType =
+ sig
+ type t
+ [@@doc "The type of the hashtable keys."]
+ val equal : t -> t -> bool
+ [@@doc "The equality predicate used to compare keys."]
+ end
+
+
+-- type-conv, deriving
+
+type t = {
+ x : int [@default 42];
+ y : int [@default 3] [@sexp_drop_default];
+ z : int [@default 3] [@sexp_drop_if z_test];
+} [@@sexp]
+
+
+type r1 = {
+ r1_l1 : int;
+ r1_l2 : int;
+} [@@deriving (Dump, Eq, Show, Typeable, Pickle, Functor)]
+
+-- camlp4 map/fold generators
+
+type variable = string
+ and term =
+ | Var of variable
+ | Lam of variable * term
+ | App of term * term
+
+
+class map = [%generate_map term]
+or:
+[%%generate_map map term]
+
+
+-- ocaml-rpc
+
+type t = { foo [@rpc "type"]: int; bar [@rpc "let"]: int }
+[@@ rpc]
+
+or:
+
+type t = { foo: int; bar: int }
+[@@ rpc ("foo" > "type"), ("bar" > "let")]
+
+
+
+-- pa_monad
+
+begin%monad
+ a <-- [1; 2; 3];
+ b <-- [3; 4; 5];
+ return (a + b)
+end
+
+-- pa_lwt
+
+let%lwt x = start_thread foo
+and y = start_other_thread foo in
+try%lwt
+ let%for_lwt (x, y) = waiting_threads in
+ compute blah
+with Killed -> bar
+
+-- Bolt
+
+let funct n =
+ [%log "funct(%d)" n LEVEL DEBUG];
+ for i = 1 to n do
+ print_endline "..."
+ done
+
+
+-- pre-polyrecord
+
+let r = [%polyrec x = 1; y = ref None]
+let () = [%polyrec r.y <- Some 2]
+
+-- orakuda
+
+function%regexp
+ | "$/^[0-9]+$/" as v -> `Int (int_of_string v#_0)
+ | "$/^[a-z][A-Za-z0-9_]*$" as v -> `Variable v#_0
+ | _ -> failwith "parse error"
+
+-- bitstring
+
+let bits = Bitstring.bitstring_of_file "/bin/ls" in
+match%bitstring bits with
+| [ 0x7f, 8; "ELF", 24, string; (* ELF magic number *)
+ e_ident, Mul(12,8), bitstring; (* ELF identifier *)
+ e_type, 16, littleendian; (* object file type *)
+ e_machine, 16, littleendian (* architecture *)
+ ] ->
+ printf "This is an ELF binary, type %d, arch %d\n"
+ e_type e_machine
+
+-- sedlex
+
+let rec token buf =
+ let%regexp ('a'..'z'|'A'..'Z') = letter in
+ match%sedlex buf with
+ | number -> Printf.printf "Number %s\n" (Sedlexing.Latin1.lexeme buf); token buf
+ | letter, Star ('A'..'Z' | 'a'..'z' | digit) -> Printf.printf "Ident %s\n" (Sedlexing.Latin1.lexeme buf); token buf
+ | Plus xml_blank -> token buf
+ | Plus (Chars "+*-/") -> Printf.printf "Op %s\n" (Sedlexing.Latin1.lexeme buf); token buf
+ | Range(128,255) -> print_endline "Non ASCII"
+ | eof -> print_endline "EOF"
+ | _ -> failwith "Unexpected character"
+
+
+-- cppo
+
+[%%ifdef DEBUG]
+[%%define debug(s) = Printf.eprintf "[%S %i] %s\n%!" __FILE__ __LINE__ s]
+[%%else]
+[%%define debug(s) = ()]
+[%%endif]
+
+debug("test")
+
+
+-- PG'OCaml
+
+let fetch_users dbh =
+ [%pgsql dbh "select id, name from users"]
+
+
+-- Macaque
+
+let names view = [%view {name = t.name}, t <- !view]"
+
+
+-- Cass
+
+let color1 = [%css{| black |}]
+let color2 = [%css{| gray |}]
+
+let button = [%css{|
+ .button {
+ $Css.gradient ~low:color2 ~high:color1$;
+ color: white;
+ $Css.top_rounded$;
+ |}]
--- /dev/null
+(* This filter implements the following extensions:
+
+ In structures:
+
+ [%%IFDEF X]
+ ... --> included if the environment variable X is defined
+ [%%ELSE]
+ ... --> included if the environment variable X is undefined
+ [%%END]
+
+
+ In expressions:
+
+ [%GETENV X] ---> the string literal representing the compile-time value
+ of environment variable X
+
+
+ In variant type declarations:
+
+ type t =
+ ..
+ | C [@IFDEF X] of ... --> the constructor is kept only if X is defined
+
+
+ In match clauses (function/match...with/try...with):
+
+
+ P when [%IFDEF X] -> E --> the case is kept only if X is defined
+
+*)
+
+open Ast_helper
+open! Asttypes
+open Parsetree
+open Longident
+
+let getenv loc arg =
+ match arg with
+ | PStr [{pstr_desc=Pstr_eval({pexp_desc = Pexp_construct ({txt = Lident sym; _}, None); _}, _); _}] ->
+ (try Sys.getenv sym with Not_found -> "")
+ | _ ->
+ Format.eprintf "%a** IFDEF: bad syntax."
+ Location.print_error loc;
+ exit 2
+
+let empty_str_item = Str.include_ (Mod.structure [])
+
+let ifdef _args =
+ let stack = ref [] in
+ let eval_attributes =
+ List.for_all
+ (function
+ | {txt="IFDEF"; loc}, arg -> getenv loc arg <> ""
+ | {txt="IFNDEF"; loc}, arg -> getenv loc arg = ""
+ | _ -> true)
+ in
+ let filter_constr cd = eval_attributes cd.pcd_attributes in
+ let open Ast_mapper in
+ let super = default_mapper in
+ {
+ super with
+
+ type_declaration =
+ (fun this td ->
+ let td =
+ match td with
+ | {ptype_kind = Ptype_variant cstrs; _} as td ->
+ {td
+ with ptype_kind = Ptype_variant(List.filter filter_constr cstrs)}
+ | td -> td
+ in
+ super.type_declaration this td
+ );
+
+ cases =
+ (fun this l ->
+ let l =
+ List.fold_right
+ (fun c rest ->
+ match c with
+ | {pc_guard=Some {pexp_desc=Pexp_extension({txt="IFDEF";loc}, arg); _}; _} ->
+ if getenv loc arg = "" then rest else {c with pc_guard=None} :: rest
+ | c -> c :: rest
+ ) l []
+ in
+ super.cases this l
+ );
+
+ structure_item =
+ (fun this i ->
+ match i.pstr_desc, !stack with
+ | Pstr_extension(({txt="IFDEF";loc}, arg), _), _ ->
+ stack := (getenv loc arg <> "") :: !stack;
+ empty_str_item
+ | Pstr_extension(({txt="ELSE";loc=_}, _), _), (hd :: tl) ->
+ stack := not hd :: tl;
+ empty_str_item
+ | Pstr_extension(({txt="END";loc=_}, _), _), _ :: tl ->
+ stack := tl;
+ empty_str_item
+ | Pstr_extension(({txt="ELSE"|"END";loc}, _), _), [] ->
+ Format.printf "%a** IFDEF: mo matching [%%%%IFDEF]"
+ Location.print_error loc;
+ exit 2
+ | _, (true :: _ | []) -> super.structure_item this i
+ | _, false :: _ -> empty_str_item
+ );
+
+ expr =
+ (fun this -> function
+ | {pexp_desc = Pexp_extension({txt="GETENV";loc=l}, arg);
+ pexp_loc = loc; _} ->
+ Exp.constant ~loc (Const_string (getenv l arg, None))
+ | x -> super.expr this x
+ );
+ }
+
+let () = Ast_mapper.run_main ifdef
--- /dev/null
+(* This example shows how the AST mapping approach could be used
+ instead of Camlp4 in order to give a nice syntax for js_of_ocaml
+ (properties and method calls). The code below overloads regular
+ syntax for field projection and assignment for Javascript
+ properties, and (currified) method call for Javascript method
+ calls. This is enabled under the scope of the [%js ...] extension:
+
+ Get property: [%js o.x]
+ Set property: [%js o.x <- e]
+ Method call: [%js o#x e1 e2]
+ *)
+
+open Asttypes
+open! Location
+open Parsetree
+open Longident
+open Ast_helper
+open Ast_helper.Convenience
+
+(* A few local helper functions to simplify the creation of AST nodes. *)
+let apply_ f l = app (evar f) l
+let oobject l = Typ.object_ l Open
+let annot e t = Exp.constraint_ e t
+
+
+let rnd = Random.State.make [|0x513511d4|]
+let random_var () = Format.sprintf "a%08Lx" (Random.State.int64 rnd 0x100000000L : Int64.t)
+let fresh_type () = Typ.var (random_var ())
+
+let unescape lab =
+ assert (lab <> "");
+ let lab =
+ if lab.[0] = '_' then String.sub lab 1 (String.length lab - 1) else lab
+ in
+ try
+ let i = String.rindex lab '_' in
+ if i = 0 then raise Not_found;
+ String.sub lab 0 i
+ with Not_found ->
+ lab
+
+let method_literal meth = str (unescape meth)
+
+let access_object loc e m m_typ f =
+ let open Exp in
+ with_default_loc loc
+ (fun () ->
+ let x = random_var () in
+ let obj_type = random_var () in
+ let obj = annot e Typ.(tconstr "Js.t" [alias (oobject []) obj_type]) in
+ let y = random_var () in
+ let o = annot (evar y) (Typ.var obj_type) in
+ let constr = lam (pvar y) (annot (send o m) m_typ) in
+ let_in [Vb.mk (pvar x) obj; Vb.mk (Pat.any ()) constr] (f (evar x))
+ )
+
+let method_call loc obj meth args =
+ let args = List.map (fun e -> (e, fresh_type ())) args in
+ let ret_type = fresh_type () in
+ let method_type =
+ List.fold_right
+ (fun (_, arg_ty) rem_ty -> Typ.arrow "" arg_ty rem_ty)
+ args
+ (tconstr "Js.meth" [ret_type])
+ in
+ access_object loc obj meth method_type
+ (fun x ->
+ let args =
+ List.map (fun (e, t) -> apply_ "Js.Unsafe.inject" [annot e t]) args
+ in
+ annot (apply_ "Js.Unsafe.meth_call" [x; method_literal meth; Exp.array args]) ret_type
+ )
+
+
+let mapper _args =
+ let open Ast_mapper in
+ let rec mk ~js =
+ let super = default_mapper in
+ let expr this e =
+ let loc = e.pexp_loc in
+ match e.pexp_desc with
+ | Pexp_extension({txt="js";_}, PStr [{pstr_desc=Pstr_eval (e, _);_}]) ->
+ let this = mk ~js:true in this.expr this e
+
+ | Pexp_field (o, {txt = Lident meth; loc = _}) when js ->
+ let o = this.expr this o in
+ let prop_type = fresh_type () in
+ let meth_type = tconstr "Js.gen_prop" [oobject ["get", prop_type]] in
+ access_object loc o meth meth_type
+ (fun x -> annot (apply_ "Js.Unsafe.get" [x; method_literal meth]) prop_type)
+
+ | Pexp_setfield (o, {txt = Lident meth; loc = _}, e) when js ->
+ let o = this.expr this o and e = this.expr this e in
+ let prop_type = fresh_type () in
+ let meth_type = tconstr "Js.gen_prop" [oobject ["set", Typ.arrow "" prop_type (tconstr "unit" [])]] in
+ access_object loc o meth meth_type
+ (fun x -> apply_ "Js.Unsafe.set" [x; method_literal meth; annot e prop_type])
+
+ | Pexp_apply ({pexp_desc = Pexp_send (o, meth); pexp_loc = loc; _}, args) when js ->
+ method_call loc o meth (List.map (this.expr this) (List.map snd args))
+
+ | Pexp_send (o, meth) when js ->
+ method_call loc o meth []
+
+ | _ ->
+ super.expr this e
+ in
+ {super with expr}
+ in
+ mk ~js:false
+
+let () = Ast_mapper.run_main mapper
--- /dev/null
+let loc1 = Location.in_file "111"
+let loc2 = Location.in_file "222"
+
+let x = [%expr foobar]
+let pat = [%pat? _ as x]
+
+let e = [%expr fun (x, [%p pat]) -> x + [%e x] + 1]
+let () = Format.printf "%a@." (Printast.expression 0) e
+
+;;[@@metaloc loc2]
+
+let e = [%expr fun (x, [%p pat]) -> x + [%e x] + 1] [@metaloc loc1]
+let () = Format.printf "%a@." (Printast.expression 0) e
+
+let e = [%expr fun (x, [%p pat]) -> x + [%e x] + 1]
+let () = Format.printf "%a@." (Printast.expression 0) e
+
+
+let mytype = [%type: int list]
+let s = [%str type t = A of [%t mytype] | B of string]
+let () = Format.printf "%a@." Printast.implementation s
+
+
+let f = function
+ | ([%expr [%e? x] + 1]
+ | [%expr 1 + [%e? x]]) as e0 -> [%expr succ [%e x]] [@metaloc e0.pexp_loc]
+ | e -> e
--- /dev/null
+open Asttypes
+open Parsetree
+open Typedtree
+open Longident
+
+let pendings = ref []
+
+let doc ppf = function
+ | ({txt="doc";_}, PStr [{pstr_desc=Pstr_eval(e, _); _}]) ->
+ begin match e.pexp_desc with
+ | Pexp_constant(Const_string (s, _)) ->
+ Format.fprintf ppf " --> %s@." s
+ | Pexp_apply({pexp_desc=Pexp_ident{txt=Lident "section"}},
+ ["", {pexp_desc=Pexp_constant(Const_string (s, _))}]) ->
+ Format.fprintf ppf " ==== %s ====@." s
+ | _ -> ()
+ end
+ | _ -> ()
+
+let rec signature path ppf sg =
+ List.iter (signature_item path ppf) sg.sig_items
+
+and signature_item path ppf si =
+ match si.sig_desc with
+ | Tsig_value x ->
+ Format.fprintf ppf " val %s: %a@." x.val_name.txt Printtyp.type_expr x.val_desc.ctyp_type;
+ List.iter (doc ppf) x.val_attributes
+ | Tsig_module x ->
+ begin match x.md_type.mty_desc with
+ | Tmty_ident (_, {txt=lid}) ->
+ Format.fprintf ppf " module %s: %a@." x.md_name.txt Printtyp.longident lid
+ | Tmty_signature sg ->
+ pendings := `Module (path ^ "." ^ x.md_name.txt, sg) :: !pendings;
+ Format.fprintf ppf " module %s: ... (see below)@." x.md_name.txt;
+ | _ ->
+ Format.fprintf ppf " module %s: ...@." x.md_name.txt;
+ end;
+ List.iter (doc ppf) x.md_attributes
+ | Tsig_type l ->
+ List.iter (type_declaration ppf) l
+ | Tsig_attribute x ->
+ doc ppf x
+ | _ ->
+ ()
+
+and type_declaration ppf x =
+ Format.fprintf ppf " type %s@." x.typ_name.txt;
+ List.iter (doc ppf) x.typ_attributes
+
+let component = function
+ | `Module (path, sg) ->
+ Format.printf "[[[ Interface for %s ]]]@.%a@."
+ path (signature path) sg
+
+let () =
+ let open Cmt_format in
+ for i = 1 to Array.length Sys.argv - 1 do
+ let fn = Sys.argv.(i) in
+ try
+ let {cmt_annots; cmt_modname; _} = read_cmt fn in
+ begin match cmt_annots with
+ | Interface sg -> component (`Module (cmt_modname, sg))
+ | _ -> ()
+ end;
+ while !pendings <> [] do
+ let l = List.rev !pendings in
+ pendings := [];
+ List.iter component l
+ done
+ with exn ->
+ Format.printf "Cannot read '%s': %s@." fn (Printexc.to_string exn)
+ done
--- /dev/null
+(** Creates an mli from an annotated ml file. *)
+
+open Path
+open Location
+open Longident
+open Misc
+open Parsetree
+open Types
+open! Typedtree
+open Ast_helper
+
+let mli_attr l = Convenience.find_attr "mli" l
+
+let map_flatten f l =
+ List.flatten (List.map f l)
+
+let is_abstract = function
+ | PStr [{pstr_desc=Pstr_eval({pexp_desc=Pexp_ident{txt=Lident "abstract"}},_)}] -> true
+ | _ -> false
+
+let explicit_type_of_expr = function
+ | {pexp_desc=Pexp_constraint({pexp_desc=Pexp_ident{txt=Lident id}}, t)} -> [id, t]
+ | _ -> []
+
+let explicit_type = function
+ | PStr [{pstr_desc=Pstr_eval({pexp_desc=Pexp_tuple el},_)}] -> map_flatten explicit_type_of_expr el
+ | PStr [{pstr_desc=Pstr_eval(e,_)}] -> explicit_type_of_expr e
+ | _ -> []
+
+let rec structure l : Parsetree.signature =
+ map_flatten (structure_item l.str_final_env) l.str_items
+
+and structure_item final_env x : Parsetree.signature =
+ match x.str_desc with
+ | Tstr_module {mb_name; mb_expr} ->
+ begin match module_expr mb_expr with
+ | Some mty -> [Sig.module_ (Md.mk mb_name mty)]
+ | None -> []
+ end
+ | Tstr_type l ->
+ begin match map_flatten type_declaration l with
+ | [] -> []
+ | l -> [Sig.type_ l]
+ end
+ | Tstr_value (_, l) ->
+ map_flatten (value_binding final_env) l
+ | _ ->
+ []
+
+and module_expr x : Parsetree.module_type option =
+ match x.mod_desc with
+ | Tmod_structure l ->
+ (* No explicit signature: use [@@mli] attributes in the sub-structure to define exported components. *)
+ begin match structure l with
+ | [] -> None
+ | l -> Some (Mty.signature l)
+ end
+ | Tmod_constraint (_, _, Tmodtype_explicit mty, _) ->
+ (* Explicit signature: if non-empty, use it for the mli; if empty, drop the sub-module *)
+ begin match Untypeast.untype_module_type mty with
+ | {pmty_desc=Pmty_signature []} -> None
+ | pmty -> Some pmty
+ end
+ | _ ->
+ None
+
+and type_declaration x : Parsetree.type_declaration list =
+ match mli_attr x.typ_attributes with
+ | None -> []
+ | Some attrs ->
+ let pdecl = Untypeast.untype_type_declaration x in
+ (* If the declaration is marked with [@@mli abstract], make it abstract *)
+ let pdecl = if is_abstract attrs then {pdecl with ptype_kind=Ptype_abstract} else pdecl in
+ [pdecl]
+
+and value_binding final_env x : Parsetree.signature =
+ match mli_attr x.vb_attributes with
+ | None -> []
+ | Some attrs ->
+ match explicit_type attrs with
+ | [] ->
+ (* No explicit type, use the inferred type for bound identifiers *)
+ let ids = let_bound_idents [x] in
+ List.map
+ (fun id ->
+ let ty = typ (Env.find_value (Pident id) final_env).val_type in
+ Sig.value (Val.mk (mknoloc (Ident.name id)) ty)
+ ) ids
+ | l ->
+ (* Explicit type given with the syntax [@@mli (x1 : ty1), ..., (xn : tyn)] *)
+ List.map (fun (id, ty) -> Sig.value (Val.mk (mknoloc id) ty)) l
+
+and typ x : Parsetree.core_type =
+ (* print the inferred type and parse the result again *)
+ let t = Printtyp.type_scheme Format.str_formatter x in
+ let s = Format.flush_str_formatter t in
+ Parse.core_type (Lexing.from_string s)
+
+let mli_of_ml ppf sourcefile =
+ Location.input_name := sourcefile;
+ Compmisc.init_path false;
+ let file = chop_extension_if_any sourcefile in
+ let modulename = String.capitalize(Filename.basename file) in
+ Env.set_unit_name modulename;
+ let inputfile = Pparse.preprocess sourcefile in
+ let env = Compmisc.initial_env() in
+ let ast = Pparse.file ppf inputfile Parse.implementation Config.ast_impl_magic_number in
+ let (str, _coerc) = Typemod.type_implementation sourcefile file modulename env ast in
+ let sg = structure str in
+ Format.printf "%a@." Pprintast.signature sg
+
+let () =
+ mli_of_ml Format.err_formatter Sys.argv.(1)
+
--- /dev/null
+(*
+ A toy -ppx rewriter which illustrates code generation based on type
+ declarations. Here, we create builder function from record and sum
+ type declarations annotated with attribute [@@builder]: one function
+ per record type, one function per constructor of a sum type.
+
+ We recognize some special attributes on record fields (or their associated
+ type) and on constructor argument types:
+
+ - [@label id]: specify a label for the parameter of the builder function
+ (for records, it is set automatically from the label name
+ but it can be overridden).
+
+ - [@opt]: the parameter is optional (this assume that the field/argument
+ has an option type).
+
+ - [@default expr]: the parameter is optional, with a default value
+ (cannot be used with [@opt]).
+*)
+
+module Main : sig end = struct
+ open Asttypes
+ open! Location
+ open Parsetree
+ open Ast_helper
+ open Ast_helper.Convenience
+
+ let fatal loc s =
+ Location.print_error Format.err_formatter loc;
+ prerr_endline s;
+ exit 2
+
+ let param named name loc attrs =
+ let default = find_attr_expr "default" attrs in
+ let opt = has_attr "opt" attrs in
+ let label =
+ match find_attr_expr "label" attrs with
+ | None -> if named then name else ""
+ | Some e ->
+ match get_lid e with
+ | Some s -> s
+ | None -> fatal e.pexp_loc "'label' attribute must be a string literal"
+ in
+ let label =
+ if default <> None || opt then
+ if label = "" then fatal loc "Optional arguments must be named" else "?" ^ label
+ else label
+ in
+ if default <> None && opt then fatal loc "Cannot have both 'opt' and 'default' attributes";
+ lam ~label ?default (pvar name), (name, evar name)
+
+ let gen_builder tdecl =
+ if has_attr "builder" tdecl.ptype_attributes then
+ match tdecl.ptype_kind with
+ | Ptype_record fields ->
+ let field pld =
+ param true pld.pld_name.txt pld.pld_loc (pld.pld_attributes @ pld.pld_type.ptyp_attributes)
+ in
+ let fields = List.map field fields in
+ let body = lam (punit()) (record (List.map snd fields)) in
+ let f = List.fold_right (fun (f, _) k -> f k) fields body in
+ let s = Str.value Nonrecursive [Vb.mk (pvar tdecl.ptype_name.txt) f] in
+ [s]
+ | Ptype_variant constrs ->
+ let constr {pcd_name={txt=name;_}; pcd_args=args; _} =
+ let arg i ty = param false (Printf.sprintf "x%i" i) ty.ptyp_loc ty.ptyp_attributes in
+ let args = List.mapi arg args in
+ let body = lam (punit()) (constr name (List.map (fun (_, (_, e)) -> e) args)) in
+ let f = List.fold_right (fun (f, _) k -> f k) args body in
+ let s = Str.value Nonrecursive [Vb.mk (pvar (tdecl.ptype_name.txt ^ "_" ^ name)) f] in
+ s
+ in
+ List.map constr constrs
+ | _ -> []
+ else
+ []
+
+ let gen_builder tdecl =
+ with_default_loc tdecl.ptype_loc (fun () -> gen_builder tdecl)
+
+ let builder _args =
+ let open Ast_mapper in
+ let super = default_mapper in
+ {super
+ with
+ structure =
+ (fun this l ->
+ List.flatten
+ (List.map
+ (function
+ | {pstr_desc = Pstr_type tdecls; _} as i ->
+ i :: (List.flatten (List.map gen_builder tdecls))
+ | i -> [this.structure_item this i]
+ ) l
+ )
+ )
+ }
+
+ let () = Ast_mapper.run_main builder
+end
--- /dev/null
+(*
+ Example : List.filter [%matches ? 'a' .. 'z' ] text
+ Output : List.filter (function 'a' .. 'z' -> true | _ -> false) text
+*)
+
+open Asttypes
+open Parsetree
+open Ast_helper
+
+let mapper _args =
+ let open Ast_mapper in
+ let super = default_mapper in
+ {super with
+ expr =
+ (fun this e ->
+ match e.pexp_desc with
+ | Pexp_extension({txt="matches";_}, PPat (p, guard)) ->
+ let p = this.pat this p in
+ let guard = Ast_mapper.map_opt (this.expr this) guard in
+ Exp.function_ ~loc:e.pexp_loc
+ [
+ Exp.case p ?guard (Convenience.constr "true" []);
+ Exp.case (Pat.any ()) (Convenience.constr "false" []);
+ ]
+ | _ -> super.expr this e
+ )
+ }
+
+let () = Ast_mapper.run_main mapper
--- /dev/null
+type t =
+ {
+ x: int;
+ y [@label foo]: int;
+ z [@default 3]: int;
+ } [@@builder]
+
+and s =
+ {
+ a: string;
+ b [@opt]: int option;
+ c: int [@default 2];
+ } [@@builder]
+
+and sum =
+ | A of int
+ | B of string * (string [@label str])
+ | C of (int [@label i] [@default 0]) * (string [@label s] [@default ""])
+ [@@builder]
--- /dev/null
+module type S = [%copy_typedef]
+
+module type T = sig
+ type t
+
+ module type M = [%copy_typedef]
+end
+
+module M = struct
+ type t = [%copy_typedef]
+end
+
+type t = [%copy_typedef]
+
+let _x = M.A
+let _y : t = [1; 2]
+
+
+type _loc = [%copy_typedef "../../parsing/location.mli" t]
--- /dev/null
+module type S = sig
+ type t
+ val x: int
+end
+
+module type T = sig
+ type t
+
+ module type M = sig
+ type t = A | B of t
+ end
+end
+
+module M : sig
+ type t =
+ | A
+ | B of string
+end
+
+type t = int list
--- /dev/null
+[%%eval.load "unix.cma"]
+
+[%%eval.start both]
+(* This type definition will be evaluated at compile time,
+ but it will be kept in the compiled unit as well. *)
+type t = A | B of string
+[%%eval.stop]
+
+[%%eval.start]
+(* This is going to be executed at compile time only. *)
+let () = print_endline "Now compiling..."
+[%%eval.stop]
+
+let () =
+ begin match [%eval B "x"] with
+ | A -> print_endline "A"
+ | B s -> Printf.printf "B %S\n%!" s
+ end;
+ Printf.printf "Home dir at compile time = %s\n" [%eval Sys.getenv "HOME"];
+ Printf.printf "Word-size = %i\n" [%eval Sys.word_size];
+ Array.iter (Printf.printf "%s;") [%eval Sys.readdir "."];
+ print_endline "";
+ [%eval print_endline "COUCOU"]
+
+let () =
+ let tm = [%eval Unix.(localtime (gettimeofday ()))] in
+ Printf.printf "This program was compiled in %i\n%!" (1900 + tm.Unix.tm_year)
+
+let () =
+ let debug =
+ [%eval try Some (Sys.getenv "DEBUG") with Not_found -> None]
+ in
+ match debug with
+ | Some x -> Printf.printf "DEBUG %s\n%!" x
+ | None -> Printf.printf "NODEBUG\n%!"
+
+
--- /dev/null
+type t =
+ | A
+ | DBG [@IFDEF DEBUG] of string
+ | B
+
+[%%IFDEF DEBUG]
+let debug s = prerr_endline ([%GETENV DEBUG] ^ ":" ^ s)
+let x = DBG "xxx"
+[%%ELSE]
+let debug _ = ()
+let x = A
+[%%END]
+
+let f = function
+ | A -> "A"
+ | DBG s when [%IFDEF DEBUG] -> "DEBUG:" ^ s
+ | B -> "B"
+
+let () = debug "ABC"
+
+let () =
+ Printf.printf "compiled by user %s in directory %s\n%!"
+ [%GETENV USER]
+ [%GETENV PWD]
+
--- /dev/null
+module Js = struct
+ type +'a t
+ type +'a gen_prop
+ type +'a meth
+ module Unsafe = struct
+ type any
+ let get (_o : 'a t) (_meth : string) = assert false
+ let set (_o : 'a t) (_meth : string) (_v : 'b) = ()
+ let meth_call (_ : 'a) (_ : string) (_ : any array) : 'b = assert false
+ let inject _ : any = assert false
+ end
+end
+
+let foo1 o =
+ if [%js o.bar] then [%js o.foo1.foo2] else [%js o.foo2]
+
+let foo2 o =
+ [%js o.x <- o.x + 1]
+
+
+let foo3 o a =
+ [%js o#x] + [%js o#y 1 a]
--- /dev/null
+let l = List.filter [%matches ? 'a'..'z'] ['a';'A';'X';'x']
+
+let f = [%matches ? Some i when i >= 0]
--- /dev/null
+type t = A | B
+ [@@mli]
+
+and s = C | D
+ [@@mli abstract]
+
+
+module X = struct
+ type t = X | Y
+ [@@mli]
+ and s
+
+ let id x = x
+ [@@mli]
+end
+
+module Y : sig type t type s end = struct
+ type t = X | Y
+ type s = A | B
+end
+
+let f x y = x + y
+ [@@mli]
+and g a b = (a, b)
+ [@@mli]
+and h a b = (a, b)
+ [@@mli (h : int -> int -> int * int)]
+
+let (x, y, z) = (1, 2, 3)
+ [@@mli (x : int), (y : int)]
--- /dev/null
+[@@doc section "First section"]
+
+module M : sig
+ [@@doc section "Public definitions"]
+
+ type t =
+ | A
+ | B
+
+ [@@doc section "Internal definitions"]
+
+ val zero: int
+ [@@doc "A very important integer."]
+end
+ [@@doc "This is an internal module."]
+
+val incr: int -> int
+ [@@doc "This function returns the next integer."]
+
+[@@doc section "Second section"]
+
+val decr: int -> int
+ [@@doc "This function returns the previous integer."]
+
+val is_a: M.t -> bool
+ [@@doc "This function checks whether its argument is the A constructor."]
+
+module X: Hashtbl.HashedType
+ [@@doc "An internal module"]
--- /dev/null
+(* This tool reports values exported by .mli files but never used in any other module.
+ It assumes that .mli files are compiled with -keep-locs and .ml files with -bin-annot.
+ This can be enforced by setting:
+
+ OCAMLPARAM=bin-annot=1,keep-locs=1,_
+*)
+
+
+open Types
+open Typedtree
+
+let vds = ref [] (* all exported value declarations *)
+let references = Hashtbl.create 256 (* all value references *)
+
+let unit fn =
+ Filename.chop_extension (Filename.basename fn)
+
+let rec collect_export fn = function
+ | Sig_value (_, {Types.val_loc; _}) when not val_loc.Location.loc_ghost ->
+ (* a .cmi file can contain locations from other files.
+ For instance:
+ module M : Set.S with type elt = int
+ will create value definitions whole locations is in set.mli
+ *)
+ if unit fn = unit val_loc.Location.loc_start.Lexing.pos_fname then
+ vds := val_loc :: !vds
+ | Sig_module (_, {Types.md_type=Mty_signature sg; _}, _) -> List.iter (collect_export fn) sg
+ | _ -> ()
+
+let collect_references = object
+ inherit Tast_iter.iter as super
+ method! expression = function
+ | {exp_desc = Texp_ident (_, _, {Types.val_loc; _}); exp_loc} -> Hashtbl.add references val_loc exp_loc
+ | e -> super # expression e
+end
+
+let rec load_file fn =
+ if Filename.check_suffix fn ".cmi"
+ && Sys.file_exists (Filename.chop_suffix fn ".cmi" ^ ".mli") then
+ (* only consider module with an explicit interface *)
+ let open Cmi_format in
+(* Printf.eprintf "Scanning %s\n%!" fn; *)
+ List.iter (collect_export fn) (read_cmi fn).cmi_sign
+ else if Filename.check_suffix fn ".cmt" then
+ let open Cmt_format in
+(* Printf.eprintf "Scanning %s\n%!" fn; *)
+ match read fn with
+ | (_, Some {cmt_annots = Implementation x; _}) -> collect_references # structure x
+ | _ -> () (* todo: support partial_implementation? *)
+ else if (try Sys.is_directory fn with _ -> false) then
+ Array.iter (fun s -> load_file (Filename.concat fn s)) (Sys.readdir fn)
+
+let report loc =
+ if not (Hashtbl.mem references loc) then
+ Format.printf "%a: unused exported value@." Location.print_loc loc
+
+let () =
+ try
+ for i = 1 to Array.length Sys.argv - 1 do load_file Sys.argv.(i) done;
+ List.iter report !vds
+ with exn ->
+ Location.report_exception Format.err_formatter exn;
+ exit 2
--- /dev/null
+*.out
+*.out2
--- /dev/null
+Index: byterun/intern.c
+===================================================================
+--- byterun/intern.c (revision 11929)
++++ byterun/intern.c (working copy)
+@@ -27,6 +27,7 @@
+ #include "memory.h"
+ #include "mlvalues.h"
+ #include "misc.h"
++#include "obj.h"
+ #include "reverse.h"
+
+ static unsigned char * intern_src;
+@@ -139,6 +140,14 @@
+ dest = (value *) (intern_dest + 1);
+ *intern_dest = Make_header(size, tag, intern_color);
+ intern_dest += 1 + size;
++ /* For objects, we need to freshen the oid */
++ if (tag == Object_tag) {
++ intern_rec(dest++);
++ intern_rec(dest++);
++ caml_set_oid((value)(dest-2));
++ size -= 2;
++ if (size == 0) return;
++ }
+ for(/*nothing*/; size > 1; size--, dest++)
+ intern_rec(dest);
+ goto tailcall;
+Index: byterun/obj.c
+===================================================================
+--- byterun/obj.c (revision 11929)
++++ byterun/obj.c (working copy)
+@@ -25,6 +25,7 @@
+ #include "minor_gc.h"
+ #include "misc.h"
+ #include "mlvalues.h"
++#include "obj.h"
+ #include "prims.h"
+
+ CAMLprim value caml_static_alloc(value size)
+@@ -212,6 +213,16 @@
+ return (tag == Field(meths,li) ? Field (meths, li-1) : 0);
+ }
+
++/* Generate ids on the C side, to avoid races */
++
++CAMLprim value caml_set_oid (value obj)
++{
++ static value last_oid = 1;
++ Field(obj,1) = last_oid;
++ last_oid += 2;
++ return obj;
++}
++
+ /* these two functions might be useful to an hypothetical JIT */
+
+ #ifdef CAML_JIT
+Index: byterun/obj.h
+===================================================================
+--- byterun/obj.h (revision 0)
++++ byterun/obj.h (revision 0)
+@@ -0,0 +1,28 @@
++/***********************************************************************/
++/* */
++/* OCaml */
++/* */
++/* Jacques Garrigue, 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$ */
++
++/* Primitives for the Obj and CamlinternalOO modules */
++
++#ifndef CAML_OBJ_H
++#define CAML_OBJ_H
++
++#include "misc.h"
++#include "mlvalues.h"
++
++/* Set the OID of an object to a fresh value */
++/* returns the same object as result */
++value caml_set_oid (value obj);
++
++#endif /* CAML_OBJ_H */
+Index: stdlib/camlinternalOO.ml
+===================================================================
+--- stdlib/camlinternalOO.ml (revision 11929)
++++ stdlib/camlinternalOO.ml (working copy)
+@@ -15,23 +15,15 @@
+
+ open Obj
+
+-(**** Object representation ****)
++(**** OID handling ****)
+
+-let last_id = ref 0
+-let new_id () =
+- let id = !last_id in incr last_id; id
++external set_oid : t -> t = "caml_set_oid" "noalloc"
+
+-let set_id o id =
+- let id0 = !id in
+- Array.unsafe_set (Obj.magic o : int array) 1 id0;
+- id := id0 + 1
+-
+ (**** Object copy ****)
+
+ let copy o =
+- let o = (Obj.obj (Obj.dup (Obj.repr o))) in
+- set_id o last_id;
+- o
++ let o = Obj.dup (Obj.repr o) in
++ Obj.obj (set_oid o)
+
+ (**** Compression options ****)
+ (* Parameters *)
+@@ -355,8 +347,7 @@
+ let obj = Obj.new_block Obj.object_tag table.size in
+ (* XXX Appel de [caml_modify] *)
+ Obj.set_field obj 0 (Obj.repr table.methods);
+- set_id obj last_id;
+- (Obj.obj obj)
++ Obj.obj (set_oid obj)
+
+ let create_object_opt obj_0 table =
+ if (Obj.magic obj_0 : bool) then obj_0 else begin
+@@ -364,8 +355,7 @@
+ let obj = Obj.new_block Obj.object_tag table.size in
+ (* XXX Appel de [caml_modify] *)
+ Obj.set_field obj 0 (Obj.repr table.methods);
+- set_id obj last_id;
+- (Obj.obj obj)
++ Obj.obj (set_oid obj)
+ end
+
+ let rec iter_f obj =
--- /dev/null
+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 ();
--- /dev/null
+let rec long_lines name n ic =
+ let l = input_line ic in
+ if String.length l > 80 then Printf.printf "%s: %d\n%!" name n;
+ long_lines name (n+1) ic
+
+let process_file name =
+ try
+ let ic = open_in name in
+ try long_lines name 1 ic
+ with End_of_file -> close_in ic
+ with _ ->()
+
+let () =
+ for i = 1 to Array.length Sys.argv - 1 do
+ process_file Sys.argv.(i)
+ done
--- /dev/null
+parsing typing bytecomp driver toplevel
--- /dev/null
+bytecomp byterun driver parsing stdlib tools toplevel typing utils
--- /dev/null
+(* 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
--- /dev/null
+Index: typing/env.ml
+===================================================================
+--- typing/env.ml (revision 11214)
++++ typing/env.ml (working copy)
+@@ -20,6 +20,7 @@
+ open Longident
+ open Path
+ open Types
++open Btype
+
+
+ type error =
+@@ -56,7 +57,7 @@
+ cltypes: (Path.t * cltype_declaration) Ident.tbl;
+ summary: summary;
+ local_constraints: bool;
+- level_map: (int * int) list;
++ gadt_instances: (int * TypeSet.t ref) list;
+ }
+
+ and module_components = module_components_repr Lazy.t
+@@ -96,7 +97,7 @@
+ modules = Ident.empty; modtypes = Ident.empty;
+ components = Ident.empty; classes = Ident.empty;
+ cltypes = Ident.empty;
+- summary = Env_empty; local_constraints = false; level_map = [] }
++ summary = Env_empty; local_constraints = false; gadt_instances = [] }
+
+ let diff_keys is_local tbl1 tbl2 =
+ let keys2 = Ident.keys tbl2 in
+@@ -286,13 +287,14 @@
+ (* the level is changed when updating newtype definitions *)
+ if !Clflags.principal then begin
+ match level, decl.type_newtype_level with
+- Some level, Some def_level when level < def_level -> raise Not_found
++ Some level, Some (_, exp_level) when level < exp_level -> raise Not_found
+ | _ -> ()
+ end;
+ 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
+@@ -308,7 +310,7 @@
+ 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 =
+@@ -453,32 +455,42 @@
+ and lookup_cltype =
+ lookup (fun env -> env.cltypes) (fun sc -> sc.comp_cltypes)
+
+-(* Level handling *)
++(* GADT instance tracking *)
+
+-(* The level map is a list of pairs describing separate segments (lv,lv'),
+- lv < lv', organized in decreasing order.
+- The definition level is obtained by mapping a level in a segment to the
+- high limit of this segment.
+- The definition level of a newtype should be greater or equal to
+- the highest level of the newtypes in its manifest type.
+- *)
++let add_gadt_instance_level lv env =
++ {env with
++ gadt_instances = (lv, ref TypeSet.empty) :: env.gadt_instances}
+
+-let rec map_level lv = function
+- | [] -> lv
+- | (lv1, lv2) :: rem ->
+- if lv > lv2 then lv else
+- if lv >= lv1 then lv2 else map_level lv rem
++let is_Tlink = function {desc = Tlink _} -> true | _ -> false
+
+-let map_newtype_level env lv = map_level lv env.level_map
++let gadt_instance_level env t =
++ let rec find_instance = function
++ [] -> None
++ | (lv, r) :: rem ->
++ if TypeSet.exists is_Tlink !r then
++ 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
+
+-(* precondition: lv < lv' *)
+-let rec add_level lv lv' = function
+- | [] -> [lv, lv']
+- | (lv1, lv2) :: rem as l ->
+- if lv2 < lv then (lv, lv') :: l else
+- if lv' < lv1 then (lv1, lv2) :: add_level lv lv' rem
+- else add_level (max lv lv1) (min lv' lv2) rem
++let add_gadt_instances env lv tl =
++ let r =
++ try List.assoc lv env.gadt_instances with Not_found -> assert false in
++ 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
++ r := TypeSet.add t !r;
++ match t.desc with
++ Tconstr (p, _, memo) ->
++ may add_instance (find_expans Private p !memo)
++ | _ -> ()
++ end
++ in add_instance t
+
+ (* Expand manifest module type names at the top of the given module type *)
+
+@@ -497,7 +509,7 @@
+ let constructors_of_type ty_path decl =
+ let handle_variants cstrs =
+ Datarepr.constructor_descrs
+- (Btype.newgenty (Tconstr(ty_path, decl.type_params, ref Mnil)))
++ (newgenty (Tconstr(ty_path, decl.type_params, ref Mnil)))
+ cstrs decl.type_private
+ in
+ match decl.type_kind with
+@@ -510,7 +522,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 -> []
+
+@@ -773,14 +785,13 @@
+ and add_cltype id ty env =
+ store_cltype id (Pident id) ty env
+
+-let add_local_constraint id info mlv env =
++let add_local_constraint id info elv env =
+ match info with
+- {type_manifest = Some ty; type_newtype_level = Some lv} ->
+- (* use the newtype level for this definition, lv is the old one *)
+- let env = add_type id {info with type_newtype_level = Some mlv} env in
+- let level_map =
+- if lv < mlv then add_level lv mlv env.level_map else env.level_map in
+- { env with local_constraints = true; level_map = level_map }
++ {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 *)
+Index: typing/typecore.ml
+===================================================================
+--- typing/typecore.ml (revision 11214)
++++ typing/typecore.ml (working copy)
+@@ -1989,6 +1989,7 @@
+ end
+ | Pexp_newtype(name, sbody) ->
+ (* Create a fake abstract type declaration for name. *)
++ let level = get_current_level () in
+ let decl = {
+ type_params = [];
+ type_arity = 0;
+@@ -1996,7 +1997,7 @@
+ type_private = Public;
+ type_manifest = None;
+ type_variance = [];
+- type_newtype_level = Some (get_current_level ());
++ type_newtype_level = Some (level, level);
+ }
+ in
+ let ty = newvar () in
+@@ -2421,6 +2422,7 @@
+ begin_def ();
+ Ident.set_current_time (get_current_level ());
+ let lev = Ident.current_time () in
++ let env = Env.add_gadt_instance_level lev env in
+ Ctype.init_def (lev+1000);
+ if !Clflags.principal then begin_def (); (* propagation of the argument *)
+ let ty_arg' = newvar () in
+Index: typing/typedecl.ml
+===================================================================
+--- typing/typedecl.ml (revision 11214)
++++ typing/typedecl.ml (working copy)
+@@ -404,7 +404,7 @@
+ else if to_check path' && not (List.mem path' prev_exp) then begin
+ try
+ (* Attempt expansion *)
+- let (params0, body0) = Env.find_type_expansion path' env in
++ let (params0, body0, _) = Env.find_type_expansion path' env in
+ let (params, body) =
+ Ctype.instance_parameterized_type params0 body0 in
+ begin
+Index: typing/types.mli
+===================================================================
+--- typing/types.mli (revision 11214)
++++ typing/types.mli (working copy)
+@@ -144,9 +144,9 @@
+ type_manifest: type_expr option;
+ type_variance: (bool * bool * bool) list;
+ (* covariant, contravariant, weakly contravariant *)
+- type_newtype_level: int option }
++ type_newtype_level: (int * int) option }
++ (* definition level * expansion level *)
+
+-
+ and type_kind =
+ Type_abstract
+ | Type_record of
+Index: typing/ctype.ml
+===================================================================
+--- typing/ctype.ml (revision 11214)
++++ typing/ctype.ml (working copy)
+@@ -470,7 +470,7 @@
+ 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 -> ()
+@@ -687,7 +687,7 @@
+ try
+ match (Env.find_type p env).type_newtype_level with
+ | None -> Path.binding_time p
+- | Some x -> x
++ | Some (x, _) -> x
+ with
+ | _ ->
+ (* no newtypes in predef *)
+@@ -696,9 +696,13 @@
+ let rec update_level env level ty =
+ let ty = repr ty in
+ if ty.level > level then begin
++ if !Clflags.principal && Env.has_local_constraints env then 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 < Env.map_newtype_level env (get_level env p) ->
++ 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; *)
+@@ -1025,7 +1029,7 @@
+ | Some (env, newtype_lev) ->
+ let existentials = List.map copy cstr.cstr_existentials in
+ let process existential =
+- let decl = new_declaration (Some newtype_lev) None in
++ let decl = new_declaration (Some (newtype_lev, newtype_lev)) None in
+ let (id, new_env) =
+ Env.enter_type (get_new_abstract_name ()) decl !env in
+ env := new_env;
+@@ -1271,7 +1275,7 @@
+ end;
+ ty
+ | None ->
+- let (params, body) =
++ let (params, body, lv) =
+ try find_type_expansion level path env with Not_found ->
+ raise Cannot_expand
+ in
+@@ -1284,6 +1288,15 @@
+ ty.desc <- Tvariant { row with row_name = Some (path, args) }
+ | _ -> ()
+ end;
++ (* For gadts, remember type as non exportable *)
++ if !Clflags.principal then begin
++ match lv with
++ Some lv -> Env.add_gadt_instances env lv [ty; ty']
++ | None ->
++ match Env.gadt_instance_level env ty with
++ Some lv -> Env.add_gadt_instances env lv [ty']
++ | None -> ()
++ end;
+ ty'
+ end
+ | _ ->
+@@ -1306,15 +1319,7 @@
+ let try_expand_once env ty =
+ let ty = repr ty in
+ match ty.desc with
+- Tconstr (p, _, _) ->
+- let ty' = repr (expand_abbrev env ty) in
+- if !Clflags.principal then begin
+- match (Env.find_type p env).type_newtype_level with
+- Some lv when ty.level < Env.map_newtype_level env lv ->
+- link_type ty ty'
+- | _ -> ()
+- end;
+- ty'
++ Tconstr (p, _, _) -> repr (expand_abbrev env ty)
+ | _ -> raise Cannot_expand
+
+ let _ = forward_try_expand_once := try_expand_once
+@@ -1324,11 +1329,16 @@
+ 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
++ let ty'' =
++ try try_expand_head env ty'
++ with Cannot_expand -> ty'
++ in
++ if !Clflags.principal then begin
++ match Env.gadt_instance_level env ty'' with
++ None -> ()
++ | Some lv -> Env.add_gadt_instance_chain env lv ty
++ end;
++ ty''
+
+ (* Expand once the head of a type *)
+ let expand_head_once env ty =
+@@ -1405,7 +1415,7 @@
+ *)
+ 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 ->
+@@ -1742,7 +1752,7 @@
+ let reify env t =
+ let newtype_level = get_newtype_level () in
+ let create_fresh_constr lev row =
+- let decl = new_declaration (Some (newtype_level)) None in
++ let decl = new_declaration (Some (newtype_level, newtype_level)) None in
+ let name =
+ let name = get_new_abstract_name () in
+ if row then name ^ "#row" else name
+@@ -2065,7 +2075,7 @@
+ update_level !env t1.level t2;
+ link_type t1 t2
+ | (Tconstr (p1, [], a1), Tconstr (p2, [], a2))
+- when Path.same p1 p2 && actual_mode !env = Old
++ 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. *)
+@@ -2091,6 +2101,15 @@
+ if unify_eq !env t1' t2' then () else
+
+ let t1 = repr t1 and t2 = repr t2 in
++ if !Clflags.principal then begin
++ match Env.gadt_instance_level !env t1',Env.gadt_instance_level !env t2' with
++ Some lv1, Some lv2 ->
++ if lv1 > lv2 then Env.add_gadt_instance_chain !env lv1 t2 else
++ if lv2 > lv2 then Env.add_gadt_instance_chain !env lv2 t1
++ | Some lv1, None -> Env.add_gadt_instance_chain !env lv1 t2
++ | None, Some lv2 -> Env.add_gadt_instance_chain !env lv2 t1
++ | None, None -> ()
++ end;
+ if unify_eq !env t1 t1' || not (unify_eq !env t2 t2') then
+ unify3 env t1 t1' t2 t2'
+ else
+Index: typing/env.mli
+===================================================================
+--- typing/env.mli (revision 11214)
++++ typing/env.mli (working copy)
+@@ -33,14 +33,19 @@
+ val find_cltype: Path.t -> t -> cltype_declaration
+
+ val find_type_expansion:
+- ?use_local:bool -> ?level:int -> Path.t -> t -> type_expr list * type_expr
+-val find_type_expansion_opt: Path.t -> t -> type_expr list * type_expr
++ ?use_local:bool -> ?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 has_local_constraints: t -> bool
+-val map_newtype_level: t -> int -> int
++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 *)
+
+Index: typing/types.ml
+===================================================================
+--- typing/types.ml (revision 11214)
++++ typing/types.ml (working copy)
+@@ -146,8 +146,8 @@
+ type_private: private_flag;
+ type_manifest: type_expr option;
+ type_variance: (bool * bool * bool) list;
+- type_newtype_level: int option }
+ (* covariant, contravariant, weakly contravariant *)
++ type_newtype_level: (int * int) option }
+
+ and type_kind =
+ Type_abstract
+Index: testsuite/tests/typing-gadts/test.ml
+===================================================================
+--- testsuite/tests/typing-gadts/test.ml (revision 11214)
++++ testsuite/tests/typing-gadts/test.ml (working copy)
+@@ -159,17 +159,21 @@
+
+ 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 -> a = fun x ->
+- let r = match x with Int -> ky (1 : a) 1
++ 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)
++ let r = match x with Int -> ky 1 (1 : a) (* fails *)
+ in r
+ ;;
+ let test : type a. a t -> a = fun x ->
+- let r = match x with Int -> (1 : a)
+- in r (* fails too *)
++ let r = match x with Int -> (1 : a) (* ok! *)
++ in r
+ ;;
+ let test : type a. a t -> a = fun x ->
+ let r : a = match x with Int -> 1
+@@ -178,7 +182,7 @@
+ 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 (* normalized to int option *)
++ !r (* ok *)
+ ;;
+ let test2 : type a. a t -> a option = fun x ->
+ let r : a option ref = ref None in
+@@ -190,19 +194,19 @@
+ let u = ref None in
+ begin match x with Int -> r := Some 1; u := !r end;
+ !u
+-;; (* fail *)
++;; (* 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
+-;; (* fail *)
++;; (* 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
+-;; (* fail *)
++;; (* ok *)
+ let test2 : type a. a t -> a option = fun x ->
+ let u = ref None in
+ let a =
+@@ -210,32 +214,32 @@
+ begin match x with Int -> r := Some 1; u := !r end;
+ !u
+ in a
+-;; (* fail *)
++;; (* ok *)
+
+ (* Effect of external consraints *)
+
+ let f (type a) (x : a t) y =
+ ignore (y : a);
+- let r = match x with Int -> (y : a) in (* fails *)
++ 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); (* fails *)
++ ignore (y : a); (* ok *)
+ r
+ ;;
+ let f (type a) (x : a t) y =
+ ignore (y : a);
+- let r = match x with Int -> y in
++ 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);
++ ignore (y : a); (* ok *)
+ r
+ ;;
+ let f (type a) (x : a t) (y : a) =
+- match x with Int -> y (* should return an int! *)
++ match x with Int -> y (* returns 'a *)
+ ;;
+
+ (* Pattern matching *)
+@@ -307,4 +311,4 @@
+ | {left=TE TC; right=D [|1.0|]} -> 14
+ | {left=TA; right=D 0} -> -1
+ | {left=TA; right=D z} -> z
+-;; (* warn *)
++;; (* ok *)
--- /dev/null
+Index: boot/ocamlc
+===================================================================
+Cannot display: file marked as a binary type.
+svn:mime-type = application/octet-stream
+Index: boot/ocamldep
+===================================================================
+Cannot display: file marked as a binary type.
+svn:mime-type = application/octet-stream
+Index: boot/ocamllex
+===================================================================
+Cannot display: file marked as a binary type.
+svn:mime-type = application/octet-stream
+Index: camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml
+===================================================================
+--- camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml (revision 14301)
++++ camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml (working copy)
+@@ -979,7 +979,7 @@
+ [ <: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 (with_loc n loc) (module_type nt) (module_type mt))
++ mkmty loc (Pmty_functor (with_loc n loc) (Some (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 []))
+@@ -1051,7 +1051,7 @@
+ | <: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 (with_loc n loc) (module_type mt) (module_expr me))
++ mkmod loc (Pmod_functor (with_loc n loc) (Some (module_type mt)) (module_expr me))
+ | <:module_expr@loc< struct $sl$ end >> ->
+ mkmod loc (Pmod_structure (str_item sl []))
+ | <:module_expr@loc< ($me$ : $mt$) >> ->
+Index: camlp4/Camlp4Top/Rprint.ml
+===================================================================
+--- camlp4/Camlp4Top/Rprint.ml (revision 14301)
++++ camlp4/Camlp4Top/Rprint.ml (working copy)
+@@ -362,7 +362,10 @@
+ | Omty_signature sg ->
+ fprintf ppf "@[<hv 2>sig@ %a@;<1 -2>end@]"
+ Toploop.print_out_signature.val sg
+- | Omty_functor name mty_arg mty_res ->
++ | Omty_functor _ None mty_res ->
++ fprintf ppf "@[<2>functor@ () ->@ %a@]"
++ print_out_module_type mty_res
++ | Omty_functor name (Some mty_arg) mty_res ->
+ fprintf ppf "@[<2>functor@ (%s : %a) ->@ %a@]" name
+ print_out_module_type mty_arg print_out_module_type mty_res
+ | Omty_abstract -> () ]
+Index: camlp4/boot/Camlp4.ml
+===================================================================
+--- camlp4/boot/Camlp4.ml (revision 14301)
++++ camlp4/boot/Camlp4.ml (working copy)
+@@ -15633,7 +15633,7 @@
+ | Ast.MtId (loc, i) -> mkmty loc (Pmty_ident (long_uident i))
+ | Ast.MtFun (loc, n, nt, mt) ->
+ mkmty loc
+- (Pmty_functor ((with_loc n loc), (module_type nt),
++ (Pmty_functor ((with_loc n loc), Some (module_type nt),
+ (module_type mt)))
+ | Ast.MtQuo (loc, _) ->
+ error loc "module type variable not allowed here"
+@@ -15775,7 +15775,7 @@
+ (Pmod_apply ((module_expr me1), (module_expr me2)))
+ | Ast.MeFun (loc, n, mt, me) ->
+ mkmod loc
+- (Pmod_functor ((with_loc n loc), (module_type mt),
++ (Pmod_functor ((with_loc n loc), Some (module_type mt),
+ (module_expr me)))
+ | Ast.MeStr (loc, sl) ->
+ mkmod loc (Pmod_structure (str_item sl []))
+Index: ocamldoc/odoc_ast.ml
+===================================================================
+--- ocamldoc/odoc_ast.ml (revision 14301)
++++ ocamldoc/odoc_ast.ml (working copy)
+@@ -1606,18 +1606,25 @@
+
+ | (Parsetree.Pmod_functor (_, pmodule_type, p_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 loc = match pmodule_type with None -> Location.none
++ | Some pmty -> pmty.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 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.mty_type
++ let mp_kind =
++ match pmodule_type, mtyp with
++ Some pmty, Some mty ->
++ Sig.analyse_module_type_kind env current_module_name pmty
++ mty.mty_type
++ | _ -> Module_type_struct []
+ in
+ let param =
+ {
+ mp_name = mp_name ;
+- mp_type = Odoc_env.subst_module_type env mtyp.mty_type ;
++ mp_type = Misc.may_map
++ (fun m -> Odoc_env.subst_module_type env m.mty_type) mtyp ;
+ mp_type_code = mp_type_code ;
+ mp_kind = mp_kind ;
+ }
+Index: ocamldoc/odoc_env.ml
+===================================================================
+--- ocamldoc/odoc_env.ml (revision 14301)
++++ ocamldoc/odoc_env.ml (working copy)
+@@ -223,7 +223,7 @@
+ | Types.Mty_signature _ ->
+ t
+ | Types.Mty_functor (id, mt1, mt2) ->
+- Types.Mty_functor (id, iter mt1, iter mt2)
++ Types.Mty_functor (id, Misc.may_map iter mt1, iter mt2)
+ in
+ iter t
+
+Index: ocamldoc/odoc_html.ml
+===================================================================
+--- ocamldoc/odoc_html.ml (revision 14301)
++++ ocamldoc/odoc_html.ml (working copy)
+@@ -1384,7 +1384,8 @@
+
+ (** Print html code to display the type of a module parameter.. *)
+ method html_of_module_parameter_type b m_name p =
+- self#html_of_module_type b m_name ~code: p.mp_type_code p.mp_type
++ match p.mp_type with None -> bs b "<code>()</code>"
++ | Some mty -> self#html_of_module_type b m_name ~code: p.mp_type_code mty
+
+ (** Generate a file containing the module type in the given file name. *)
+ method output_module_type in_title file mtyp =
+Index: ocamldoc/odoc_info.mli
+===================================================================
+--- ocamldoc/odoc_info.mli (revision 14301)
++++ ocamldoc/odoc_info.mli (working copy)
+@@ -434,7 +434,7 @@
+
+ and module_parameter = Odoc_module.module_parameter = {
+ mp_name : string ; (** the name *)
+- mp_type : Types.module_type ; (** the type *)
++ mp_type : Types.module_type option ; (** the type *)
+ mp_type_code : string ; (** the original code *)
+ mp_kind : module_type_kind ; (** the way the parameter was built *)
+ }
+Index: ocamldoc/odoc_man.ml
+===================================================================
+--- ocamldoc/odoc_man.ml (revision 14301)
++++ ocamldoc/odoc_man.ml (working copy)
+@@ -612,7 +612,7 @@
+ (fun (p, desc_opt) ->
+ bs b ".sp\n";
+ bs b ("\""^p.mp_name^"\"\n");
+- self#man_of_module_type b m_name p.mp_type;
++ Misc.may (self#man_of_module_type b m_name) p.mp_type;
+ bs b "\n";
+ (
+ match desc_opt with
+Index: ocamldoc/odoc_module.ml
+===================================================================
+--- ocamldoc/odoc_module.ml (revision 14301)
++++ ocamldoc/odoc_module.ml (working copy)
+@@ -46,7 +46,7 @@
+
+ and module_parameter = {
+ mp_name : string ; (** the name *)
+- mp_type : Types.module_type ; (** the type *)
++ mp_type : Types.module_type option ; (** the type *)
+ mp_type_code : string ; (** the original code *)
+ mp_kind : module_type_kind ; (** the way the parameter was built *)
+ }
+Index: ocamldoc/odoc_print.ml
+===================================================================
+--- ocamldoc/odoc_print.ml (revision 14301)
++++ ocamldoc/odoc_print.ml (working copy)
+@@ -62,7 +62,7 @@
+ | Some s -> raise (Use_code s)
+ )
+ | Types.Mty_functor (id, mt1, mt2) ->
+- Types.Mty_functor (id, iter mt1, iter mt2)
++ Types.Mty_functor (id, Misc.may_map iter mt1, iter mt2)
+ in
+ iter t
+
+Index: ocamldoc/odoc_sig.ml
+===================================================================
+--- ocamldoc/odoc_sig.ml (revision 14301)
++++ ocamldoc/odoc_sig.ml (working copy)
+@@ -1082,19 +1082,26 @@
+
+ | 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 loc = match pmodule_type2 with None -> Location.none
++ | Some pmty -> pmty.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 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.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
++ let mp_kind =
++ match pmodule_type2, param_module_type with
++ Some pmty, Some mty ->
++ analyse_module_type_kind env current_module_name pmty mty
++ | _ -> Module_type_struct []
+ in
+ let param =
+ {
+ mp_name = Name.from_ident ident ;
+- mp_type = Odoc_env.subst_module_type env param_module_type ;
++ mp_type =
++ Misc.may_map (Odoc_env.subst_module_type env)
++ param_module_type;
+ mp_type_code = mp_type_code ;
+ mp_kind = mp_kind ;
+ }
+@@ -1161,17 +1168,23 @@
+ (
+ match sig_module_type with
+ 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 loc = match pmodule_type2 with None -> Location.none
++ | Some pmty -> pmty.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 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_kind = analyse_module_type_kind env
+- current_module_name pmodule_type2 param_module_type
++ let mp_kind =
++ match pmodule_type2, param_module_type with
++ Some pmty, Some mty ->
++ analyse_module_type_kind env current_module_name pmty mty
++ | _ -> Module_type_struct []
+ in
+ let param =
+ {
+ mp_name = Name.from_ident ident ;
+- mp_type = Odoc_env.subst_module_type env param_module_type ;
++ mp_type = Misc.may_map
++ (Odoc_env.subst_module_type env) param_module_type ;
+ mp_type_code = mp_type_code ;
+ mp_kind = mp_kind ;
+ }
+Index: ocamldoc/odoc_to_text.ml
+===================================================================
+--- ocamldoc/odoc_to_text.ml (revision 14301)
++++ ocamldoc/odoc_to_text.ml (working copy)
+@@ -428,8 +428,11 @@
+ List
+ (List.map
+ (fun (p, desc_opt) ->
+- [Code (p.mp_name^" : ")] @
+- (self#text_of_module_type p.mp_type) @
++ begin match p.mp_type with None -> [Raw ""]
++ | Some mty ->
++ [Code (p.mp_name^" : ")] @
++ (self#text_of_module_type mty)
++ end @
+ (match desc_opt with
+ None -> []
+ | Some t -> (Raw " ") :: t)
+Index: parsing/ast_helper.mli
+===================================================================
+--- parsing/ast_helper.mli (revision 14301)
++++ parsing/ast_helper.mli (working copy)
+@@ -145,7 +145,8 @@
+
+ val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type
+ val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type
+- val functor_: ?loc:loc -> ?attrs:attrs -> str -> module_type -> module_type -> module_type
++ val functor_: ?loc:loc -> ?attrs:attrs ->
++ str -> module_type option -> module_type -> module_type
+ val with_: ?loc:loc -> ?attrs:attrs -> module_type -> with_constraint list -> module_type
+ val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type
+ val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_type
+@@ -159,7 +160,8 @@
+
+ val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr
+ val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr
+- val functor_: ?loc:loc -> ?attrs:attrs -> str -> module_type -> module_expr -> module_expr
++ val functor_: ?loc:loc -> ?attrs:attrs ->
++ str -> module_type option -> module_expr -> module_expr
+ val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr -> module_expr
+ val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type -> module_expr
+ val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr
+Index: parsing/ast_mapper.ml
+===================================================================
+--- parsing/ast_mapper.ml (revision 14301)
++++ parsing/ast_mapper.ml (working copy)
+@@ -161,7 +161,8 @@
+ | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s)
+ | Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg)
+ | Pmty_functor (s, mt1, mt2) ->
+- functor_ ~loc ~attrs (map_loc sub s) (sub.module_type sub mt1)
++ functor_ ~loc ~attrs (map_loc sub s)
++ (Misc.may_map (sub.module_type sub) mt1)
+ (sub.module_type sub mt2)
+ | Pmty_with (mt, l) ->
+ with_ ~loc ~attrs (sub.module_type sub mt)
+@@ -213,7 +214,8 @@
+ | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x)
+ | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str)
+ | Pmod_functor (arg, arg_ty, body) ->
+- functor_ ~loc ~attrs (map_loc sub arg) (sub.module_type sub arg_ty)
++ functor_ ~loc ~attrs (map_loc sub arg)
++ (Misc.may_map (sub.module_type sub) arg_ty)
+ (sub.module_expr sub body)
+ | Pmod_apply (m1, m2) ->
+ apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2)
+Index: parsing/parser.mly
+===================================================================
+--- parsing/parser.mly (revision 14301)
++++ parsing/parser.mly (working copy)
+@@ -541,9 +541,13 @@
+ | STRUCT structure error
+ { unclosed "struct" 1 "end" 3 }
+ | FUNCTOR LPAREN UIDENT COLON module_type RPAREN MINUSGREATER module_expr
+- { mkmod(Pmod_functor(mkrhs $3 3, $5, $8)) }
++ { mkmod(Pmod_functor(mkrhs $3 3, Some $5, $8)) }
++ | FUNCTOR LPAREN RPAREN MINUSGREATER module_expr
++ { mkmod(Pmod_functor(mkrhs "()" 3, None, $5)) }
+ | module_expr LPAREN module_expr RPAREN
+ { mkmod(Pmod_apply($1, $3)) }
++ | module_expr LPAREN RPAREN
++ { mkmod(Pmod_apply($1, mkmod (Pmod_structure []))) }
+ | module_expr LPAREN module_expr error
+ { unclosed "(" 2 ")" 4 }
+ | LPAREN module_expr COLON module_type RPAREN
+@@ -640,7 +644,9 @@
+ | COLON module_type EQUAL module_expr
+ { mkmod(Pmod_constraint($4, $2)) }
+ | LPAREN UIDENT COLON module_type RPAREN module_binding_body
+- { mkmod(Pmod_functor(mkrhs $2 2, $4, $6)) }
++ { mkmod(Pmod_functor(mkrhs $2 2, Some $4, $6)) }
++ | LPAREN RPAREN module_binding_body
++ { mkmod(Pmod_functor(mkrhs "()" 1, None, $3)) }
+ ;
+ module_bindings:
+ module_binding { [$1] }
+@@ -662,7 +668,10 @@
+ { unclosed "sig" 1 "end" 3 }
+ | FUNCTOR LPAREN UIDENT COLON module_type RPAREN MINUSGREATER module_type
+ %prec below_WITH
+- { mkmty(Pmty_functor(mkrhs $3 3, $5, $8)) }
++ { mkmty(Pmty_functor(mkrhs $3 3, Some $5, $8)) }
++ | FUNCTOR LPAREN RPAREN MINUSGREATER module_type
++ %prec below_WITH
++ { mkmty(Pmty_functor(mkrhs "()" 2, None, $5)) }
+ | module_type WITH with_constraints
+ { mkmty(Pmty_with($1, List.rev $3)) }
+ | MODULE TYPE OF module_expr %prec below_LBRACKETAT
+@@ -724,7 +733,9 @@
+ COLON module_type
+ { $2 }
+ | LPAREN UIDENT COLON module_type RPAREN module_declaration
+- { mkmty(Pmty_functor(mkrhs $2 2, $4, $6)) }
++ { mkmty(Pmty_functor(mkrhs $2 2, Some $4, $6)) }
++ | LPAREN RPAREN module_declaration
++ { mkmty(Pmty_functor(mkrhs "()" 1, None, $3)) }
+ ;
+ module_rec_declarations:
+ module_rec_declaration { [$1] }
+Index: parsing/parsetree.mli
+===================================================================
+--- parsing/parsetree.mli (revision 14301)
++++ parsing/parsetree.mli (working copy)
+@@ -543,7 +543,7 @@
+ (* S *)
+ | Pmty_signature of signature
+ (* sig ... end *)
+- | Pmty_functor of string loc * module_type * module_type
++ | Pmty_functor of string loc * module_type option * module_type
+ (* functor(X : MT1) -> MT2 *)
+ | Pmty_with of module_type * with_constraint list
+ (* MT with ... *)
+@@ -637,7 +637,7 @@
+ (* X *)
+ | Pmod_structure of structure
+ (* struct ... end *)
+- | Pmod_functor of string loc * module_type * module_expr
++ | Pmod_functor of string loc * module_type option * module_expr
+ (* functor(X : MT1) -> ME *)
+ | Pmod_apply of module_expr * module_expr
+ (* ME1(ME2) *)
+Index: parsing/pprintast.ml
+===================================================================
+--- parsing/pprintast.ml (revision 14301)
++++ parsing/pprintast.ml (working copy)
+@@ -834,7 +834,9 @@
+ | Pmty_signature (s) ->
+ pp f "@[<hv0>@[<hv2>sig@ %a@]@ end@]" (* "@[<hov>sig@ %a@ end@]" *)
+ (self#list self#signature_item ) s (* FIXME wrong indentation*)
+- | Pmty_functor (s, mt1, mt2) ->
++ | Pmty_functor (_, None, mt2) ->
++ pp f "@[<hov2>functor () ->@ %a@]" self#module_type mt2
++ | Pmty_functor (s, Some mt1, mt2) ->
+ pp f "@[<hov2>functor@ (%s@ :@ %a)@ ->@ %a@]" s.txt
+ self#module_type mt1 self#module_type mt2
+ | Pmty_with (mt, l) ->
+@@ -940,7 +942,9 @@
+ self#module_type mt
+ | Pmod_ident (li) ->
+ pp f "%a" self#longident_loc li;
+- | Pmod_functor (s, mt, me) ->
++ | Pmod_functor (_, None, me) ->
++ pp f "functor ()@;->@;%a" self#module_expr me
++ | Pmod_functor (s, Some mt, me) ->
+ pp f "functor@ (%s@ :@ %a)@;->@;%a"
+ s.txt self#module_type mt self#module_expr me
+ | Pmod_apply (me1, me2) ->
+@@ -1025,7 +1029,8 @@
+ | Pstr_module x ->
+ 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 ;
++ if mt = None then pp f "()"
++ else Misc.may (pp f "(%s:%a)" s.txt self#module_type) mt;
+ module_helper me
+ | _ -> me in
+ pp f "@[<hov2>module %s%a@]"
+Index: parsing/printast.ml
+===================================================================
+--- parsing/printast.ml (revision 14301)
++++ parsing/printast.ml (working copy)
+@@ -576,7 +576,7 @@
+ signature i ppf s;
+ | Pmty_functor (s, mt1, mt2) ->
+ line i ppf "Pmty_functor %a\n" fmt_string_loc s;
+- module_type i ppf mt1;
++ Misc.may (module_type i ppf) mt1;
+ module_type i ppf mt2;
+ | Pmty_with (mt, l) ->
+ line i ppf "Pmty_with\n";
+@@ -670,7 +670,7 @@
+ structure i ppf s;
+ | Pmod_functor (s, mt, me) ->
+ line i ppf "Pmod_functor %a\n" fmt_string_loc s;
+- module_type i ppf mt;
++ Misc.may (module_type i ppf) mt;
+ module_expr i ppf me;
+ | Pmod_apply (me1, me2) ->
+ line i ppf "Pmod_apply\n";
+Index: tools/depend.ml
+===================================================================
+--- tools/depend.ml (revision 14301)
++++ tools/depend.ml (working copy)
+@@ -201,7 +201,8 @@
+ 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.txt bv) mty2
++ Misc.may (add_modtype bv) mty1;
++ add_modtype (StringSet.add id.txt bv) mty2
+ | Pmty_with(mty, cstrl) ->
+ add_modtype bv mty;
+ List.iter
+@@ -258,7 +259,7 @@
+ Pmod_ident l -> addmodule bv l
+ | Pmod_structure s -> ignore (add_structure bv s)
+ | Pmod_functor(id, mty, modl) ->
+- add_modtype bv mty;
++ Misc.may (add_modtype bv) mty;
+ add_module (StringSet.add id.txt bv) modl
+ | Pmod_apply(mod1, mod2) ->
+ add_module bv mod1; add_module bv mod2
+Index: tools/tast_iter.ml
+===================================================================
+--- tools/tast_iter.ml (revision 14301)
++++ tools/tast_iter.ml (working copy)
+@@ -193,7 +193,7 @@
+ | Tmty_ident (_path, _) -> ()
+ | Tmty_signature sg -> sub # signature sg
+ | Tmty_functor (_id, _, mtype1, mtype2) ->
+- sub # module_type mtype1; sub # module_type mtype2
++ Misc.may (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
+@@ -212,7 +212,7 @@
+ | Tmod_ident (_p, _) -> ()
+ | Tmod_structure st -> sub # structure st
+ | Tmod_functor (_id, _, mtype, mexpr) ->
+- sub # module_type mtype;
++ Misc.may (sub # module_type) mtype;
+ sub # module_expr mexpr
+ | Tmod_apply (mexp1, mexp2, _) ->
+ sub # module_expr mexp1;
+Index: tools/untypeast.ml
+===================================================================
+--- tools/untypeast.ml (revision 14301)
++++ tools/untypeast.ml (working copy)
+@@ -376,7 +376,7 @@
+ 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,
++ Pmty_functor (name, Misc.may_map untype_module_type mtype1,
+ untype_module_type mtype2)
+ | Tmty_with (mtype, list) ->
+ Pmty_with (untype_module_type mtype,
+@@ -405,7 +405,7 @@
+ 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,
++ Pmod_functor (name, Misc.may_map untype_module_type mtype,
+ untype_module_expr mexpr)
+ | Tmod_apply (mexp1, mexp2, _) ->
+ Pmod_apply (untype_module_expr mexp1, untype_module_expr mexp2)
+Index: typing/btype.ml
+===================================================================
+--- typing/btype.ml (revision 14301)
++++ typing/btype.ml (working copy)
+@@ -56,6 +56,9 @@
+ let is_Tunivar = function {desc=Tunivar _} -> true | _ -> false
+
+ let dummy_method = "*dummy method*"
++let default_mty = function
++ Some mty -> mty
++ | None -> Mty_signature []
+
+ (**** Representative of a type ****)
+
+Index: typing/btype.mli
+===================================================================
+--- typing/btype.mli (revision 14301)
++++ typing/btype.mli (working copy)
+@@ -39,9 +39,12 @@
+ (* Return a fresh marked generic variable *)
+ *)
+
++(**** Types ****)
++
+ val is_Tvar: type_expr -> bool
+ val is_Tunivar: type_expr -> bool
+ val dummy_method: label
++val default_mty: module_type option -> module_type
+
+ val repr: type_expr -> type_expr
+ (* Return the canonical representative of a type. *)
+Index: typing/env.ml
+===================================================================
+--- typing/env.ml (revision 14301)
++++ typing/env.ml (working copy)
+@@ -201,7 +201,7 @@
+
+ and functor_components = {
+ fcomp_param: Ident.t; (* Formal parameter *)
+- fcomp_arg: module_type; (* Argument signature *)
++ fcomp_arg: module_type option; (* Argument signature *)
+ fcomp_res: module_type; (* Result signature *)
+ fcomp_env: t; (* Environment in which the result signature makes sense *)
+ fcomp_subst: Subst.t; (* Prefixing substitution for the result signature *)
+@@ -522,7 +522,7 @@
+ let (p2, {md_type=mty2}) = lookup_module l2 env in
+ begin match EnvLazy.force !components_of_module_maker' desc1 with
+ Functor_comps f ->
+- !check_modtype_inclusion env mty2 p2 f.fcomp_arg;
++ Misc.may (!check_modtype_inclusion env mty2 p2) f.fcomp_arg;
+ (Papply(p1, p2), !components_of_functor_appl' f p1 p2)
+ | Structure_comps c ->
+ raise Not_found
+@@ -562,7 +562,7 @@
+ let p = Papply(p1, p2) in
+ begin match EnvLazy.force !components_of_module_maker' desc1 with
+ Functor_comps f ->
+- !check_modtype_inclusion env mty2 p2 f.fcomp_arg;
++ Misc.may (!check_modtype_inclusion env mty2 p2) f.fcomp_arg;
+ let mty =
+ Subst.modtype (Subst.add_module f.fcomp_param p2 f.fcomp_subst)
+ f.fcomp_res in
+@@ -1120,7 +1120,7 @@
+ fcomp_param = param;
+ (* fcomp_arg must be prefixed eagerly, because it is interpreted
+ in the outer environment, not in env *)
+- fcomp_arg = Subst.modtype sub ty_arg;
++ fcomp_arg = may_map (Subst.modtype sub) ty_arg;
+ (* fcomp_res is prefixed lazily, because it is interpreted in env *)
+ fcomp_res = ty_res;
+ fcomp_env = env;
+Index: typing/includemod.ml
+===================================================================
+--- typing/includemod.ml (revision 14301)
++++ typing/includemod.ml (working copy)
+@@ -168,7 +168,13 @@
+ try_modtypes2 env cxt mty1 (Subst.modtype subst mty2)
+ | (Mty_signature sig1, Mty_signature sig2) ->
+ signatures env cxt subst sig1 sig2
+- | (Mty_functor(param1, arg1, res1), Mty_functor(param2, arg2, res2)) ->
++ | (Mty_functor(param1, None, res1), Mty_functor(param2, None, res2)) ->
++ begin match modtypes env (Body param1::cxt) subst res1 res2 with
++ Tcoerce_none -> Tcoerce_none
++ | cc -> Tcoerce_functor (Tcoerce_none, cc)
++ end
++ | (Mty_functor(param1, Some arg1, res1),
++ Mty_functor(param2, Some arg2, res2)) ->
+ let arg2' = Subst.modtype subst arg2 in
+ let cc_arg = modtypes env (Arg param1::cxt) Subst.identity arg2' arg1 in
+ let cc_res =
+Index: typing/mtype.ml
+===================================================================
+--- typing/mtype.ml (revision 14301)
++++ typing/mtype.ml (working copy)
+@@ -34,7 +34,8 @@
+ match scrape env mty with
+ Mty_signature sg ->
+ Mty_signature(strengthen_sig env sg p)
+- | Mty_functor(param, arg, res) when !Clflags.applicative_functors ->
++ | Mty_functor(param, arg, res)
++ when !Clflags.applicative_functors && Ident.name param <> "*" ->
+ Mty_functor(param, arg, strengthen env res (Papply(p, Pident param)))
+ | mty ->
+ mty
+@@ -105,8 +106,9 @@
+ | Mty_functor(param, arg, res) ->
+ let var_inv =
+ match va with Co -> Contra | Contra -> Co | Strict -> Strict in
+- Mty_functor(param, nondep_mty env var_inv arg,
+- nondep_mty (Env.add_module param arg env) va res)
++ Mty_functor(param, Misc.may_map (nondep_mty env var_inv) arg,
++ nondep_mty
++ (Env.add_module param (Btype.default_mty arg) env) va res)
+
+ and nondep_sig env va = function
+ [] -> []
+@@ -228,3 +230,34 @@
+ no_code_needed_sig env rem
+ | (Sig_exception _ | Sig_class _) :: rem ->
+ false
++
++
++(* Check whether a module type may return types *)
++
++let rec contains_type env = function
++ Mty_ident path ->
++ (try Misc.may (contains_type env) (Env.find_modtype path env).mtd_type
++ with Not_found -> raise Exit)
++ | Mty_signature sg ->
++ contains_type_sig env sg
++ | Mty_functor (_, _, body) ->
++ contains_type env body
++
++and contains_type_sig env = List.iter (contains_type_item env)
++
++and contains_type_item env = function
++ Sig_type (_,({type_manifest = None} |
++ {type_kind = Type_abstract; type_private = Private}),_)
++ | Sig_modtype _ ->
++ raise Exit
++ | Sig_module (_, {md_type = mty}, _) ->
++ contains_type env mty
++ | Sig_value _
++ | Sig_type _
++ | Sig_exception _
++ | Sig_class _
++ | Sig_class_type _ ->
++ ()
++
++let contains_type env mty =
++ try contains_type env mty; false with Exit -> true
+Index: typing/mtype.mli
+===================================================================
+--- typing/mtype.mli (revision 14301)
++++ typing/mtype.mli (working copy)
+@@ -36,3 +36,4 @@
+ val enrich_modtype: Env.t -> Path.t -> module_type -> module_type
+ val enrich_typedecl: Env.t -> Path.t -> type_declaration -> type_declaration
+ val type_paths: Env.t -> Path.t -> module_type -> Path.t list
++val contains_type: Env.t -> module_type -> bool
+Index: typing/oprint.ml
+===================================================================
+--- typing/oprint.ml (revision 14301)
++++ typing/oprint.ml (working copy)
+@@ -344,7 +344,9 @@
+ let rec print_out_module_type ppf =
+ function
+ Omty_abstract -> ()
+- | Omty_functor (name, mty_arg, mty_res) ->
++ | Omty_functor (_, None, mty_res) ->
++ fprintf ppf "@[<2>functor@ () ->@ %a@]" print_out_module_type mty_res
++ | Omty_functor (name, Some mty_arg, mty_res) ->
+ fprintf ppf "@[<2>functor@ (%s : %a) ->@ %a@]" name
+ print_out_module_type mty_arg print_out_module_type mty_res
+ | Omty_ident id -> fprintf ppf "%a" print_ident id
+Index: typing/outcometree.mli
+===================================================================
+--- typing/outcometree.mli (revision 14301)
++++ typing/outcometree.mli (working copy)
+@@ -75,7 +75,7 @@
+
+ type out_module_type =
+ | Omty_abstract
+- | Omty_functor of string * out_module_type * out_module_type
++ | Omty_functor of string * out_module_type option * out_module_type
+ | Omty_ident of out_ident
+ | Omty_signature of out_sig_item list
+ and out_sig_item =
+Index: typing/printtyp.ml
+===================================================================
+--- typing/printtyp.ml (revision 14301)
++++ typing/printtyp.ml (working copy)
+@@ -1116,9 +1116,12 @@
+ | Mty_signature sg ->
+ Omty_signature (tree_of_signature sg)
+ | Mty_functor(param, ty_arg, ty_res) ->
+- Omty_functor
+- (Ident.name param, tree_of_modtype ty_arg,
+- wrap_env (Env.add_module param ty_arg) tree_of_modtype ty_res)
++ let res =
++ match ty_arg with None -> tree_of_modtype ty_res
++ | Some mty ->
++ wrap_env (Env.add_module param mty) tree_of_modtype ty_res
++ in
++ Omty_functor (Ident.name param, may_map tree_of_modtype ty_arg, res)
+
+ and tree_of_signature sg =
+ wrap_env (fun env -> env) (tree_of_signature_rec !printing_env) sg
+Index: typing/printtyped.ml
+===================================================================
+--- typing/printtyped.ml (revision 14301)
++++ typing/printtyped.ml (working copy)
+@@ -562,7 +562,7 @@
+ signature i ppf s;
+ | Tmty_functor (s, _, mt1, mt2) ->
+ line i ppf "Pmty_functor \"%a\"\n" fmt_ident s;
+- module_type i ppf mt1;
++ Misc.may (module_type i ppf) mt1;
+ module_type i ppf mt2;
+ | Tmty_with (mt, l) ->
+ line i ppf "Pmty_with\n";
+@@ -651,7 +651,7 @@
+ structure i ppf s;
+ | Tmod_functor (s, _, mt, me) ->
+ line i ppf "Pmod_functor \"%a\"\n" fmt_ident s;
+- module_type i ppf mt;
++ Misc.may (module_type i ppf) mt;
+ module_expr i ppf me;
+ | Tmod_apply (me1, me2, _) ->
+ line i ppf "Pmod_apply\n";
+Index: typing/subst.ml
+===================================================================
+--- typing/subst.ml (revision 14301)
++++ typing/subst.ml (working copy)
+@@ -327,8 +327,8 @@
+ Mty_signature(signature s sg)
+ | Mty_functor(id, arg, res) ->
+ let id' = Ident.rename id in
+- Mty_functor(id', modtype s arg,
+- modtype (add_module id (Pident id') s) res)
++ Mty_functor(id', may_map (modtype s) arg,
++ modtype (add_module id (Pident id') s) res)
+
+ and signature s sg =
+ (* Components of signature may be mutually recursive (e.g. type declarations
+Index: typing/typedtree.ml
+===================================================================
+--- typing/typedtree.ml (revision 14301)
++++ typing/typedtree.ml (working copy)
+@@ -187,7 +187,7 @@
+ and module_expr_desc =
+ Tmod_ident of Path.t * Longident.t loc
+ | Tmod_structure of structure
+- | Tmod_functor of Ident.t * string loc * module_type * module_expr
++ | Tmod_functor of Ident.t * string loc * module_type option * module_expr
+ | Tmod_apply of module_expr * module_expr * module_coercion
+ | Tmod_constraint of
+ module_expr * Types.module_type * module_type_constraint * module_coercion
+@@ -253,7 +253,7 @@
+ and module_type_desc =
+ Tmty_ident of Path.t * Longident.t loc
+ | Tmty_signature of signature
+- | Tmty_functor of Ident.t * string loc * module_type * module_type
++ | Tmty_functor of Ident.t * string loc * module_type option * module_type
+ | Tmty_with of module_type * (Path.t * Longident.t loc * with_constraint) list
+ | Tmty_typeof of module_expr
+
+Index: typing/typedtree.mli
+===================================================================
+--- typing/typedtree.mli (revision 14301)
++++ typing/typedtree.mli (working copy)
+@@ -186,7 +186,7 @@
+ and module_expr_desc =
+ Tmod_ident of Path.t * Longident.t loc
+ | Tmod_structure of structure
+- | Tmod_functor of Ident.t * string loc * module_type * module_expr
++ | Tmod_functor of Ident.t * string loc * module_type option * module_expr
+ | Tmod_apply of module_expr * module_expr * module_coercion
+ | Tmod_constraint of
+ module_expr * Types.module_type * module_type_constraint * module_coercion
+@@ -252,7 +252,7 @@
+ and module_type_desc =
+ Tmty_ident of Path.t * Longident.t loc
+ | Tmty_signature of signature
+- | Tmty_functor of Ident.t * string loc * module_type * module_type
++ | Tmty_functor of Ident.t * string loc * module_type option * module_type
+ | Tmty_with of module_type * (Path.t * Longident.t loc * with_constraint) list
+ | Tmty_typeof of module_expr
+
+Index: typing/typedtreeIter.ml
+===================================================================
+--- typing/typedtreeIter.ml (revision 14301)
++++ typing/typedtreeIter.ml (working copy)
+@@ -383,7 +383,7 @@
+ Tmty_ident (path, _) -> ()
+ | Tmty_signature sg -> iter_signature sg
+ | Tmty_functor (id, _, mtype1, mtype2) ->
+- iter_module_type mtype1; iter_module_type mtype2
++ Misc.may iter_module_type mtype1; iter_module_type mtype2
+ | Tmty_with (mtype, list) ->
+ iter_module_type mtype;
+ List.iter (fun (path, _, withc) ->
+@@ -412,7 +412,7 @@
+ Tmod_ident (p, _) -> ()
+ | Tmod_structure st -> iter_structure st
+ | Tmod_functor (id, _, mtype, mexpr) ->
+- iter_module_type mtype;
++ Misc.may iter_module_type mtype;
+ iter_module_expr mexpr
+ | Tmod_apply (mexp1, mexp2, _) ->
+ iter_module_expr mexp1;
+Index: typing/typedtreeMap.ml
+===================================================================
+--- typing/typedtreeMap.ml (revision 14301)
++++ typing/typedtreeMap.ml (working copy)
+@@ -426,7 +426,7 @@
+ Tmty_ident (path, lid) -> mty.mty_desc
+ | Tmty_signature sg -> Tmty_signature (map_signature sg)
+ | Tmty_functor (id, name, mtype1, mtype2) ->
+- Tmty_functor (id, name, map_module_type mtype1,
++ Tmty_functor (id, name, Misc.may_map map_module_type mtype1,
+ map_module_type mtype2)
+ | Tmty_with (mtype, list) ->
+ Tmty_with (map_module_type mtype,
+@@ -456,7 +456,7 @@
+ Tmod_ident (p, lid) -> mexpr.mod_desc
+ | Tmod_structure st -> Tmod_structure (map_structure st)
+ | Tmod_functor (id, name, mtype, mexpr) ->
+- Tmod_functor (id, name, map_module_type mtype,
++ Tmod_functor (id, name, Misc.may_map map_module_type mtype,
+ map_module_expr mexpr)
+ | Tmod_apply (mexp1, mexp2, coercion) ->
+ Tmod_apply (map_module_expr mexp1, map_module_expr mexp2, coercion)
+Index: typing/typemod.ml
+===================================================================
+--- typing/typemod.ml (revision 14301)
++++ typing/typemod.ml (working copy)
+@@ -39,6 +39,7 @@
+ | Scoping_pack of Longident.t * type_expr
+ | Extension of string
+ | Recursive_module_require_explicit_type
++ | Apply_generative
+
+ exception Error of Location.t * Env.t * error
+
+@@ -299,8 +300,9 @@
+ | Pmty_signature ssg ->
+ Mty_signature(approx_sig env ssg)
+ | Pmty_functor(param, sarg, sres) ->
+- let arg = approx_modtype env sarg in
+- let (id, newenv) = Env.enter_module param.txt arg env in
++ let arg = may_map (approx_modtype env) sarg in
++ let (id, newenv) =
++ Env.enter_module param.txt (Btype.default_mty arg) env in
+ let res = approx_modtype newenv sres in
+ Mty_functor(id, arg, res)
+ | Pmty_with(sbody, constraints) ->
+@@ -472,11 +474,13 @@
+ mkmty (Tmty_signature sg) (Mty_signature sg.sig_type) env loc
+ smty.pmty_attributes
+ | Pmty_functor(param, sarg, sres) ->
+- let arg = transl_modtype env sarg in
+- let (id, newenv) = Env.enter_module param.txt arg.mty_type env in
++ let arg = Misc.may_map (transl_modtype env) sarg in
++ let ty_arg = Misc.may_map (fun m -> m.mty_type) arg in
++ let (id, newenv) =
++ Env.enter_module param.txt (Btype.default_mty ty_arg) env in
+ let res = transl_modtype newenv sres in
+ mkmty (Tmty_functor (id, param, arg, res))
+- (Mty_functor(id, arg.mty_type, res.mty_type)) env loc
++ (Mty_functor(id, ty_arg, res.mty_type)) env loc
+ smty.pmty_attributes
+ | Pmty_with(sbody, constraints) ->
+ let body = transl_modtype env sbody in
+@@ -949,11 +953,14 @@
+ mod_attributes = smod.pmod_attributes;
+ mod_loc = smod.pmod_loc }
+ | Pmod_functor(name, smty, sbody) ->
+- let mty = transl_modtype env smty in
+- let (id, newenv) = Env.enter_module name.txt mty.mty_type env in
+- let body = type_module sttn true None newenv sbody in
++ let mty = may_map (transl_modtype env) smty in
++ let ty_arg = may_map (fun m -> m.mty_type) mty in
++ let (id, newenv), funct_body =
++ match ty_arg with None -> (Ident.create "*", env), false
++ | Some mty -> Env.enter_module name.txt mty env, true in
++ let body = type_module sttn funct_body None newenv sbody in
+ rm { mod_desc = Tmod_functor(id, name, mty, body);
+- mod_type = Mty_functor(id, mty.mty_type, body.mod_type);
++ mod_type = Mty_functor(id, ty_arg, body.mod_type);
+ mod_env = env;
+ mod_attributes = smod.pmod_attributes;
+ mod_loc = smod.pmod_loc }
+@@ -964,6 +971,14 @@
+ type_module (sttn && path <> None) funct_body None env sfunct in
+ begin match Mtype.scrape env funct.mod_type with
+ Mty_functor(param, mty_param, mty_res) as mty_functor ->
++ let generative, mty_param =
++ (mty_param = None, Btype.default_mty mty_param) in
++ if generative then begin
++ if sarg.pmod_desc <> Pmod_structure [] then
++ raise (Error (sfunct.pmod_loc, env, Apply_generative));
++ if funct_body && Mtype.contains_type env funct.mod_type then
++ raise (Error (smod.pmod_loc, env, Not_allowed_in_functor_body));
++ end;
+ let coercion =
+ try
+ Includemod.modtypes env arg.mod_type mty_param
+@@ -975,6 +990,7 @@
+ Subst.modtype (Subst.add_module param path Subst.identity)
+ mty_res
+ | None ->
++ if generative then mty_res else
+ try
+ Mtype.nondep_supertype
+ (Env.add_module param arg.mod_type env) param mty_res
+@@ -999,8 +1015,6 @@
+ }
+
+ | Pmod_unpack sexp ->
+- if funct_body then
+- raise (Error (smod.pmod_loc, env, Not_allowed_in_functor_body));
+ if !Clflags.principal then Ctype.begin_def ();
+ let exp = Typecore.type_exp env sexp in
+ if !Clflags.principal then begin
+@@ -1025,6 +1039,8 @@
+ | _ ->
+ raise (Error(smod.pmod_loc, env, Not_a_packed_module exp.exp_type))
+ in
++ if funct_body && Mtype.contains_type env mty then
++ raise (Error (smod.pmod_loc, env, Not_allowed_in_functor_body));
+ rm { mod_desc = Tmod_unpack(exp, mty);
+ mod_type = mty;
+ mod_env = env;
+@@ -1549,7 +1565,8 @@
+ Location.print_filename intf_name
+ | Not_allowed_in_functor_body ->
+ fprintf ppf
+- "This kind of expression is not allowed within the body of a functor."
++ "@[This expression creates fresh types.@ %s@]"
++ "It is not allowed inside applicative functors."
+ | With_need_typeconstr ->
+ fprintf ppf
+ "Only type constructors with identical parameters can be substituted."
+@@ -1570,6 +1587,8 @@
+ fprintf ppf "Uninterpreted extension '%s'." s
+ | Recursive_module_require_explicit_type ->
+ fprintf ppf "Recursive modules require an explicit module type."
++ | Apply_generative ->
++ fprintf ppf "This is a generative functor. It can only be applied to ()"
+
+ let report_error env ppf err =
+ Printtyp.wrap_printing_env env (fun () -> report_error ppf err)
+Index: typing/typemod.mli
+===================================================================
+--- typing/typemod.mli (revision 14301)
++++ typing/typemod.mli (working copy)
+@@ -60,6 +60,7 @@
+ | Scoping_pack of Longident.t * type_expr
+ | Extension of string
+ | Recursive_module_require_explicit_type
++ | Apply_generative
+
+ exception Error of Location.t * Env.t * error
+
+Index: typing/types.ml
+===================================================================
+--- typing/types.ml (revision 14301)
++++ typing/types.ml (working copy)
+@@ -264,7 +264,7 @@
+ type module_type =
+ Mty_ident of Path.t
+ | Mty_signature of signature
+- | Mty_functor of Ident.t * module_type * module_type
++ | Mty_functor of Ident.t * module_type option * module_type
+
+ and signature = signature_item list
+
+Index: typing/types.mli
+===================================================================
+--- typing/types.mli (revision 14301)
++++ typing/types.mli (working copy)
+@@ -251,7 +251,7 @@
+ type module_type =
+ Mty_ident of Path.t
+ | Mty_signature of signature
+- | Mty_functor of Ident.t * module_type * module_type
++ | Mty_functor of Ident.t * module_type option * module_type
+
+ and signature = signature_item list
+
--- /dev/null
+Index: parsing/parser.mly
+===================================================================
+--- parsing/parser.mly (revision 14285)
++++ parsing/parser.mly (working copy)
+@@ -542,8 +542,12 @@
+ { unclosed "struct" 1 "end" 3 }
+ | FUNCTOR LPAREN UIDENT COLON module_type RPAREN MINUSGREATER module_expr
+ { mkmod(Pmod_functor(mkrhs $3 3, $5, $8)) }
++ | FUNCTOR LPAREN RPAREN MINUSGREATER module_expr
++ { mkmod(Pmod_functor(mkrhs "*" 3, mkmty (Pmty_signature []), $5)) }
+ | module_expr LPAREN module_expr RPAREN
+ { mkmod(Pmod_apply($1, $3)) }
++ | module_expr LPAREN RPAREN
++ { mkmod(Pmod_apply($1, mkmod (Pmod_structure []))) }
+ | module_expr LPAREN module_expr error
+ { unclosed "(" 2 ")" 4 }
+ | LPAREN module_expr COLON module_type RPAREN
+@@ -641,6 +645,8 @@
+ { mkmod(Pmod_constraint($4, $2)) }
+ | LPAREN UIDENT COLON module_type RPAREN module_binding_body
+ { mkmod(Pmod_functor(mkrhs $2 2, $4, $6)) }
++ | LPAREN RPAREN module_binding_body
++ { mkmod(Pmod_functor(mkrhs "*" 1, mkmty(Pmty_signature []), $3)) }
+ ;
+ module_bindings:
+ module_binding { [$1] }
+@@ -663,6 +669,9 @@
+ | FUNCTOR LPAREN UIDENT COLON module_type RPAREN MINUSGREATER module_type
+ %prec below_WITH
+ { mkmty(Pmty_functor(mkrhs $3 3, $5, $8)) }
++ | FUNCTOR LPAREN RPAREN MINUSGREATER module_type
++ %prec below_WITH
++ { mkmty(Pmty_functor(mkrhs "*" 2, mkmty(Pmty_signature []), $5)) }
+ | module_type WITH with_constraints
+ { mkmty(Pmty_with($1, List.rev $3)) }
+ | MODULE TYPE OF module_expr %prec below_LBRACKETAT
+@@ -725,6 +734,8 @@
+ { $2 }
+ | LPAREN UIDENT COLON module_type RPAREN module_declaration
+ { mkmty(Pmty_functor(mkrhs $2 2, $4, $6)) }
++ | LPAREN RPAREN module_declaration
++ { mkmty(Pmty_functor(mkrhs "*" 1, mkmty (Pmty_signature []), $3)) }
+ ;
+ module_rec_declarations:
+ module_rec_declaration { [$1] }
+Index: parsing/pprintast.ml
+===================================================================
+--- parsing/pprintast.ml (revision 14285)
++++ parsing/pprintast.ml (working copy)
+@@ -834,6 +834,8 @@
+ | Pmty_signature (s) ->
+ pp f "@[<hv0>@[<hv2>sig@ %a@]@ end@]" (* "@[<hov>sig@ %a@ end@]" *)
+ (self#list self#signature_item ) s (* FIXME wrong indentation*)
++ | Pmty_functor ({txt="*"}, mt1, mt2) ->
++ pp f "@[<hov2>functor () ->@ %a@]" self#module_type mt2
+ | Pmty_functor (s, mt1, mt2) ->
+ pp f "@[<hov2>functor@ (%s@ :@ %a)@ ->@ %a@]" s.txt
+ self#module_type mt1 self#module_type mt2
+@@ -940,6 +942,8 @@
+ self#module_type mt
+ | Pmod_ident (li) ->
+ pp f "%a" self#longident_loc li;
++ | Pmod_functor ({txt="*"}, mt, me) ->
++ pp f "functor ()@;->@;%a" self#module_expr me
+ | Pmod_functor (s, mt, me) ->
+ pp f "functor@ (%s@ :@ %a)@;->@;%a"
+ s.txt self#module_type mt self#module_expr me
+@@ -1025,7 +1029,8 @@
+ | Pstr_module x ->
+ 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 ;
++ if s.txt = "*" then pp f "()"
++ else pp f "(%s:%a)" s.txt self#module_type mt ;
+ module_helper me
+ | _ -> me in
+ pp f "@[<hov2>module %s%a@]"
+Index: typing/includemod.ml
+===================================================================
+--- typing/includemod.ml (revision 14285)
++++ typing/includemod.ml (working copy)
+@@ -35,6 +35,7 @@
+ Ident.t * class_declaration * class_declaration *
+ Ctype.class_match_failure list
+ | Unbound_modtype_path of Path.t
++ | Impure_functor
+
+ type pos =
+ Module of Ident.t | Modtype of Ident.t | Arg of Ident.t | Body of Ident.t
+@@ -165,6 +166,8 @@
+ | (Mty_signature sig1, Mty_signature sig2) ->
+ signatures env cxt subst sig1 sig2
+ | (Mty_functor(param1, arg1, res1), Mty_functor(param2, arg2, res2)) ->
++ if Ident.name param1 = "*" && Ident.name param2 <> "*" then
++ raise (Error [cxt, env, Impure_functor]);
+ let arg2' = Subst.modtype subst arg2 in
+ let cc_arg = modtypes env (Arg param1::cxt) Subst.identity arg2' arg1 in
+ let cc_res =
+@@ -422,6 +425,8 @@
+ Includeclass.report_error reason
+ | Unbound_modtype_path path ->
+ fprintf ppf "Unbound module type %a" Printtyp.path path
++ | Impure_functor ->
++ fprintf ppf "An impure functor cannot be made applicative"
+
+ let rec context ppf = function
+ Module id :: rem ->
+Index: typing/includemod.mli
+===================================================================
+--- typing/includemod.mli (revision 14285)
++++ typing/includemod.mli (working copy)
+@@ -40,6 +40,7 @@
+ Ident.t * class_declaration * class_declaration *
+ Ctype.class_match_failure list
+ | Unbound_modtype_path of Path.t
++ | Impure_functor
+
+ type pos =
+ Module of Ident.t | Modtype of Ident.t | Arg of Ident.t | Body of Ident.t
+Index: typing/mtype.ml
+===================================================================
+--- typing/mtype.ml (revision 14285)
++++ typing/mtype.ml (working copy)
+@@ -34,7 +34,8 @@
+ match scrape env mty with
+ Mty_signature sg ->
+ Mty_signature(strengthen_sig env sg p)
+- | Mty_functor(param, arg, res) when !Clflags.applicative_functors ->
++ | Mty_functor(param, arg, res)
++ when !Clflags.applicative_functors && Ident.name param <> "*" ->
+ Mty_functor(param, arg, strengthen env res (Papply(p, Pident param)))
+ | mty ->
+ mty
+Index: typing/oprint.ml
+===================================================================
+--- typing/oprint.ml (revision 14285)
++++ typing/oprint.ml (working copy)
+@@ -344,6 +344,8 @@
+ let rec print_out_module_type ppf =
+ function
+ Omty_abstract -> ()
++ | Omty_functor ("*", _, mty_res) ->
++ fprintf ppf "@[<2>functor@ () ->@ %a@]" print_out_module_type mty_res
+ | Omty_functor (name, mty_arg, mty_res) ->
+ fprintf ppf "@[<2>functor@ (%s : %a) ->@ %a@]" name
+ print_out_module_type mty_arg print_out_module_type mty_res
+Index: typing/typemod.ml
+===================================================================
+--- typing/typemod.ml (revision 14285)
++++ typing/typemod.ml (working copy)
+@@ -39,6 +39,7 @@
+ | Scoping_pack of Longident.t * type_expr
+ | Extension of string
+ | Recursive_module_require_explicit_type
++ | Apply_impure
+
+ exception Error of Location.t * Env.t * error
+
+@@ -950,8 +951,10 @@
+ mod_loc = smod.pmod_loc }
+ | Pmod_functor(name, smty, sbody) ->
+ let mty = transl_modtype env smty in
+- let (id, newenv) = Env.enter_module name.txt mty.mty_type env in
+- let body = type_module sttn true None newenv sbody in
++ let (id, newenv), funct_body =
++ if name.txt = "*" then (Ident.create "*", env), false else
++ Env.enter_module name.txt mty.mty_type env, true in
++ let body = type_module sttn funct_body None newenv sbody in
+ rm { mod_desc = Tmod_functor(id, name, mty, body);
+ mod_type = Mty_functor(id, mty.mty_type, body.mod_type);
+ mod_env = env;
+@@ -964,6 +967,13 @@
+ type_module (sttn && path <> None) funct_body None env sfunct in
+ begin match Mtype.scrape env funct.mod_type with
+ Mty_functor(param, mty_param, mty_res) as mty_functor ->
++ let impure = Ident.name param = "*" in
++ if impure then begin
++ if sarg.pmod_desc <> Pmod_structure [] then
++ raise (Error (sfunct.pmod_loc, env, Apply_impure));
++ if funct_body then
++ raise (Error (smod.pmod_loc, env, Not_allowed_in_functor_body));
++ end;
+ let coercion =
+ try
+ Includemod.modtypes env arg.mod_type mty_param
+@@ -975,6 +985,7 @@
+ Subst.modtype (Subst.add_module param path Subst.identity)
+ mty_res
+ | None ->
++ if impure then mty_res else
+ try
+ Mtype.nondep_supertype
+ (Env.add_module param arg.mod_type env) param mty_res
+@@ -1549,7 +1560,7 @@
+ Location.print_filename intf_name
+ | Not_allowed_in_functor_body ->
+ fprintf ppf
+- "This kind of expression is not allowed within the body of a functor."
++ "This kind of expression is only allowed inside impure functors."
+ | With_need_typeconstr ->
+ fprintf ppf
+ "Only type constructors with identical parameters can be substituted."
+@@ -1570,6 +1581,8 @@
+ fprintf ppf "Uninterpreted extension '%s'." s
+ | Recursive_module_require_explicit_type ->
+ fprintf ppf "Recursive modules require an explicit module type."
++ | Apply_impure ->
++ fprintf ppf "This functor is impure. It can only be applied to ()"
+
+ let report_error env ppf err =
+ Printtyp.wrap_printing_env env (fun () -> report_error ppf err)
+Index: typing/typemod.mli
+===================================================================
+--- typing/typemod.mli (revision 14285)
++++ typing/typemod.mli (working copy)
+@@ -60,6 +60,7 @@
+ | Scoping_pack of Longident.t * type_expr
+ | Extension of string
+ | Recursive_module_require_explicit_type
++ | Apply_impure
+
+ exception Error of Location.t * Env.t * error
+
--- /dev/null
+? 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
--- /dev/null
+Index: typing/includemod.ml
+===================================================================
+--- typing/includemod.ml (revision 11161)
++++ typing/includemod.ml (working copy)
+@@ -19,7 +19,7 @@
+ open Types
+ open Typedtree
+
+-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
+@@ -38,6 +38,10 @@
+ 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 * symptom
++
+ exception Error of error list
+
+ (* All functions "blah env x1 x2" check that x1 is included in x2,
+@@ -46,51 +50,52 @@
+
+ (* Inclusion between value descriptions *)
+
+-let value_descriptions env subst id vd1 vd2 =
++let value_descriptions env cxt subst id vd1 vd2 =
+ 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, 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 =
+ 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)])
++ if err <> [] then raise(Error[cxt, 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 =
+ 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, 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, 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, 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, Unbound_modtype_path path])
+
+ (* Extract name, kind and ident from a signature item *)
+
+@@ -128,28 +133,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, Module_types(mty1, Subst.modtype subst mty2)])
+ | Error reasons ->
+- raise(Error(Module_types(mty1, Subst.modtype subst mty2) :: reasons))
++ raise(Error((cxt, 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)
++ try_modtypes2 env cxt mty1 (Subst.modtype subst mty2)
+ | (Tmty_ident p1, _) ->
+- try_modtypes env subst (expand_module_path env p1) mty2
++ try_modtypes env cxt subst (expand_module_path env cxt p1) mty2
+ | (Tmty_signature sig1, Tmty_signature sig2) ->
+- signatures env subst sig1 sig2
++ signatures env cxt subst sig1 sig2
+ | (Tmty_functor(param1, arg1, res1), Tmty_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,19 +164,19 @@
+ | (_, _) ->
+ 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 ->
+ Tcoerce_none
+ | (_, Tmty_ident p2) ->
+- try_modtypes env Subst.identity mty1 (expand_module_path env 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
+@@ -202,7 +208,7 @@
+ let rec pair_components subst paired unpaired = function
+ [] ->
+ begin match unpaired with
+- [] -> signature_components new_env subst (List.rev paired)
++ [] -> signature_components new_env cxt subst (List.rev paired)
+ | _ -> raise(Error unpaired)
+ end
+ | item2 :: rem ->
+@@ -234,7 +240,7 @@
+ ((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, 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 *)
+@@ -242,65 +248,67 @@
+
+ (* 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
++ 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
++ type_declarations env cxt subst id1 tydecl1 tydecl2;
++ signature_components env cxt subst rem
+ | (Tsig_exception(id1, excdecl1), Tsig_exception(id2, excdecl2), pos)
+ :: rem ->
+- exception_declarations env subst id1 excdecl1 excdecl2;
+- (pos, Tcoerce_none) :: signature_components env subst rem
++ exception_declarations env cxt subst id1 excdecl1 excdecl2;
++ (pos, Tcoerce_none) :: signature_components env cxt subst rem
+ | (Tsig_module(id1, mty1, _), Tsig_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
++ modtypes env (Module id1::cxt) subst
++ (Mtype.strengthen env mty1 (Pident id1)) mty2 in
++ (pos, cc) :: signature_components env cxt subst rem
+ | (Tsig_modtype(id1, info1), Tsig_modtype(id2, info2), pos) :: rem ->
+- modtype_infos env subst id1 info1 info2;
+- signature_components env subst rem
++ modtype_infos env cxt subst id1 info1 info2;
++ signature_components env cxt 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
++ class_declarations env cxt subst id1 decl1 decl2;
++ (pos, Tcoerce_none) :: signature_components env cxt 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
++ 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
++ check_modtype_equiv env cxt' mty1 mty2
+ | (Tmodtype_abstract, Tmodtype_manifest mty2) ->
+- check_modtype_equiv env (Tmty_ident(Pident id)) mty2
++ check_modtype_equiv env cxt' (Tmty_ident(Pident id)) mty2
+ with Error reasons ->
+- raise(Error(Modtype_infos(id, info1, info2) :: reasons))
++ raise(Error((cxt, 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, 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,16 +320,16 @@
+
+ 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(([], 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 *)
+
+@@ -384,9 +392,62 @@
+ | 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 "@[<v>%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 "<here>"
++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 "@[<hv 2>At position@ %a@]@ " context cxt
++
++let include_err ppf (cxt, err) =
++ fprintf ppf "@[<v>%a%a@]" context (List.rev cxt) include_err err
++
++let max_size = 500
++let buffer = String.create max_size
++let is_big obj =
++ try ignore (Marshal.to_buffer buffer 0 max_size obj []); false
++ with _ -> true
++
++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 err =
++ if !Clflags.show_trace || not (is_big err) 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 "@[<v>%a%a@]" print_errs errs include_err err
+Index: typing/includemod.mli
+===================================================================
+--- typing/includemod.mli (revision 11161)
++++ typing/includemod.mli (working copy)
+@@ -24,7 +24,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
+@@ -43,6 +43,10 @@
+ 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 * symptom
++
+ exception Error of error list
+
+ val report_error: formatter -> error list -> unit
+Index: utils/clflags.ml
+===================================================================
+--- utils/clflags.ml (revision 11161)
++++ utils/clflags.ml (working copy)
+@@ -53,6 +53,7 @@
+ and dllpaths = ref ([] : string list) (* -dllpath *)
+ and make_package = ref false (* -pack *)
+ and for_package = ref (None: string option) (* -for-pack *)
++and show_trace = ref false (* -show-trace *)
+ let dump_parsetree = ref false (* -dparsetree *)
+ and dump_rawlambda = ref false (* -drawlambda *)
+ and dump_lambda = ref false (* -dlambda *)
+Index: utils/clflags.mli
+===================================================================
+--- utils/clflags.mli (revision 11161)
++++ utils/clflags.mli (working copy)
+@@ -50,6 +50,7 @@
+ val dllpaths : string list ref
+ val make_package : bool ref
+ val for_package : string option ref
++val show_trace : bool ref
+ val dump_parsetree : bool ref
+ val dump_rawlambda : bool ref
+ val dump_lambda : bool ref
--- /dev/null
+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> 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 "@[<hv 2>`%s%t%a@]" l pr_of (print_typlist print_out_type " &")
+- tyl
++ and pr_tp ppf (t1,t2) =
++ fprintf ppf "@[<hv 2>%a =@ %a@]"
++ print_out_type t1
++ print_out_type t2
++ in
++ fprintf ppf "@[<hv 2>`%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 "@[<hov1>Reither(%b,@,%a,@,%b,@,@[<1>ref%t@])@]" c
+- raw_type_list tl m
++ | Reither (c,tl,m,tpl,e) ->
++ fprintf ppf "@[<hov1>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)
--- /dev/null
+(* 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);;
--- /dev/null
+%!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<FFC0FF1C00181C00101C00101C00103800203800203800203800207000
+40700040700040700040E00080E00080E00080E00080E00100E00200E004006008003830
+000FC00018177E9618> 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<FC7E0FC0FD8730E03E07C0F03E07C0F03C
+0780F03C0780F03C0780F03C0780F03C0780F03C0780F03C0780F03C0780F03C0780F0FF
+1FE3FCFF1FE3FC1E0F7E8E23> 109 D<FC7C00FD8E003E0F003E0F003C0F003C0F003C0F
+003C0F003C0F003C0F003C0F003C0F003C0F00FF3FC0FF3FC0120F7E8E17> I
+E
+%EndDVIPSBitmapFont
+%DVIPSBitmapFont: Fd cmsy8 8 3
+/Fd 3 93 df<FFFFF0FFFFF014027D881B> 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<FE03FEFF03FEFF03FE1D8070
+1D80701DC0701CC0701CC0701CE0701CE0701C60701C70701C70701C30701C38701C3870
+1C18701C1C701C1C701C0C701C0E701C0E701C06701C06701C07701C03701C0370FF81F0
+FF81F0FF80F0171E7F9D1A> 78 D<03F8E00FFEE01FFFE03C07E07801E0F001E0E000E0
+E000E0E000E0E000007000007800003F80001FF80007FF00007FC00007E00000F0000070
+000038000038600038E00038E00038E00070F000F0FE01E0FFFFC0EFFF80E1FE00151E7E
+9D1A> 83 D<7FFFFEFFFFFEFFFFFEE0380EE0380EE0380EE0380E003800003800003800
+003800003800003800003800003800003800003800003800003800003800003800003800
+00380000380000380000380000380003FF8003FF8003FF80171E7F9D1A> I<FFFCFFFCFF
+FCE000E000E000E000E000E000E000E000E000E000E000E000E000E000E000E000E000E0
+00E000E000E000E000E000E000E000E000E000E000E000E000E000E000E000FFFCFFFCFF
+FC0E2776A21A> 91 D<FFFCFFFCFFFC001C001C001C001C001C001C001C001C001C001C
+001C001C001C001C001C001C001C001C001C001C001C001C001C001C001C001C001C001C
+001C001C001C001C001CFFFCFFFCFFFC0E277FA21A> 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<FF83FEFF83FEFF83FE380038
+3800381C00701C00701C00701C38701C7C701C7C700C6C600EEEE00EEEE00EEEE00EEEE0
+0EC6E006C6C007C7C00783C00783C017157F941A> 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<FFF0FFF0FFE00C037C8B11> 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<FFFFFF8000FFFFFFF00007F003FC0007F0007E0007F0003F0007F0001F
+8007F0000FC007F00007E007F00007E007F00007F007F00003F007F00003F007F00003F0
+07F00003F807F00003F807F00003F807F00003F807F00003F807F00003F807F00003F807
+F00003F807F00003F807F00003F007F00003F007F00003F007F00007E007F00007E007F0
+000FC007F0001F8007F0003F0007F0007E0007F003FC00FFFFFFF000FFFFFF800025227E
+A12B> 68 D<01FE0207FF861F01FE3C007E7C001E78000E78000EF80006F80006FC0006
+FC0000FF0000FFE0007FFF007FFFC03FFFF01FFFF80FFFFC03FFFE003FFE0003FE00007F
+00003F00003FC0001FC0001FC0001FE0001EE0001EF0003CFC003CFF00F8C7FFE080FF80
+18227DA11F> 83 D<7FFFFFFF807FFFFFFF807E03F80F807803F807807003F803806003
+F80180E003F801C0E003F801C0C003F800C0C003F800C0C003F800C0C003F800C00003F8
+00000003F800000003F800000003F800000003F800000003F800000003F800000003F800
+000003F800000003F800000003F800000003F800000003F800000003F800000003F80000
+0003F800000003F800000003F800000003F800000003F8000001FFFFF00001FFFFF00022
+227EA127> I<0FFC003FFF807E07C07E03E07E01E07E01F03C01F00001F00001F0003FF0
+03FDF01FC1F03F01F07E01F0FC01F0FC01F0FC01F0FC01F07E02F07E0CF81FF87F07E03F
+18167E951B> 97 D<FF000000FF0000001F0000001F0000001F0000001F0000001F0000
+001F0000001F0000001F0000001F0000001F0000001F0000001F0FE0001F3FF8001FE07C
+001F803E001F001F001F000F801F000F801F000FC01F000FC01F000FC01F000FC01F000F
+C01F000FC01F000FC01F000FC01F000F801F001F801F801F001FC03E001EE07C001C3FF8
+00180FC0001A237EA21F> 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<FF00FF001F001F001F001F00
+1F001F001F001F001F001F001F001F001F001F001F001F001F001F001F001F001F001F00
+1F001F001F001F001F001F001F001F001F00FFE0FFE00B237EA210> 108
+D<FF07F007F000FF1FFC1FFC001F303E303E001F403E403E001F801F801F001F801F801F
+001F001F001F001F001F001F001F001F001F001F001F001F001F001F001F001F001F001F
+001F001F001F001F001F001F001F001F001F001F001F001F001F001F001F001F001F001F
+001F001F001F001F001F001F00FFE0FFE0FFE0FFE0FFE0FFE02B167E9530> I<FF07E000
+FF1FF8001F307C001F403C001F803E001F803E001F003E001F003E001F003E001F003E00
+1F003E001F003E001F003E001F003E001F003E001F003E001F003E001F003E001F003E00
+1F003E00FFE1FFC0FFE1FFC01A167E951F> I<00FE0007FFC00F83E01E00F03E00F87C00
+7C7C007C7C007CFC007EFC007EFC007EFC007EFC007EFC007EFC007E7C007C7C007C3E00
+F81F01F00F83E007FFC000FE0017167E951C> I<FF0FE000FF3FF8001FE07C001F803E00
+1F001F001F001F801F001F801F000FC01F000FC01F000FC01F000FC01F000FC01F000FC0
+1F000FC01F000FC01F001F801F001F801F803F001FC03E001FE0FC001F3FF8001F0FC000
+1F0000001F0000001F0000001F0000001F0000001F0000001F0000001F000000FFE00000
+FFE000001A207E951F> I<0FF3003FFF00781F00600700E00300E00300F00300FC00007F
+E0007FF8003FFE000FFF0001FF00000F80C00780C00380E00380E00380F00700FC0E00EF
+FC00C7F00011167E9516> 115 D<01800001800001800001800003800003800007800007
+80000F80003F8000FFFF00FFFF000F80000F80000F80000F80000F80000F80000F80000F
+80000F80000F80000F80000F81800F81800F81800F81800F81800F830007C30003FE0000
+F80011207F9F16> I<FF01FE00FF01FE001F003E001F003E001F003E001F003E001F003E
+001F003E001F003E001F003E001F003E001F003E001F003E001F003E001F003E001F003E
+001F003E001F007E001F00FE000F81BE0007FF3FC001FC3FC01A167E951F> I<FFE07FC0
+FFE07FC00F801C0007C0380003E0700003F0600001F8C00000F98000007F8000003F0000
+001F0000001F8000003FC0000037C0000063E00000C1F00001C0F8000380FC0007007E00
+0E003E00FF80FFE0FF80FFE01B167F951E> 120 D<FFE01FE0FFE01FE01F8007000F8006
+000FC00E0007C00C0007E00C0003E0180003E0180001F0300001F0300000F8600000F860
+00007CC000007CC000007FC000003F8000003F8000001F0000001F0000000E0000000E00
+00000C0000000C00000018000078180000FC380000FC300000FC60000069C000007F8000
+001F0000001B207F951E> I E
+%EndDVIPSBitmapFont
+%DVIPSBitmapFont: Fj cmsy10 12 15
+/Fj 15 107 df<FFFFFFFCFFFFFFFC1E027C8C27> 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<C0C0C0C0C0C0C0C0E0E0
+C0C0C0C0C0C0C0C003127D9400> 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<F800000F000003800001C00000E00000E00000E00000E0
+0000E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000E0
+0000E000007000003800001E000003C0001E0000380000700000E00000E00000E00000E0
+0000E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000E0
+0000E00001C0000380000F0000F8000012317DA419> I<C0C0C0C0C0C0C0C0C0C0C0C0C0
+C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0
+02317AA40E> 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<FFF8FFF80D02808B10> 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<FFFFFFFEFFFFFFFE000000000000000000
+0000000000000000000000000000000000000000000000FFFFFFFEFFFFFFFE1F0C7D9126
+> 61 D<07E01838201C400E800FF00FF00FF00F000F000E001C00380030006000C000C0
+00800080018001000100010001000100010000000000000000000000038007C007C007C0
+038010237DA217> 63 D<0001800000018000000180000003C0000003C0000003C00000
+05E0000005E0000009F0000008F0000008F00000107800001078000010780000203C0000
+203C0000203C0000401E0000401E0000C01F0000800F0000800F0001FFFF800100078001
+000780020003C0020003C0020003C0040001E0040001E0040001E0080000F01C0000F03E
+0001F8FF800FFF20237EA225> 65 D<FFFFF8000F800E0007800780078003C0078003E0
+078001E0078001F0078001F0078001F0078001F0078001F0078001E0078003E0078007C0
+07800F8007803E0007FFFE0007800780078003C0078001E0078001F0078000F0078000F8
+078000F8078000F8078000F8078000F8078000F8078001F0078001F0078003E0078007C0
+0F800F00FFFFFC001D227EA123> I<0007E0100038183000E0063001C00170038000F007
+0000F00E0000701E0000701C0000303C0000303C0000307C0000107800001078000010F8
+000000F8000000F8000000F8000000F8000000F8000000F8000000F80000007800000078
+0000107C0000103C0000103C0000101C0000201E0000200E000040070000400380008001
+C0010000E0020000381C000007E0001C247DA223> I<FFFFF0000F801E00078007000780
+0380078001C0078000E0078000F007800078078000780780007C0780003C0780003C0780
+003C0780003E0780003E0780003E0780003E0780003E0780003E0780003E0780003E0780
+003E0780003C0780003C0780007C0780007807800078078000F0078000E0078001E00780
+03C0078007000F801E00FFFFF0001F227EA125> I<FFFFFFC00F8007C0078001C0078000
+C00780004007800040078000600780002007800020078000200780202007802000078020
+0007802000078060000780E00007FFE0000780E000078060000780200007802000078020
+000780200007800000078000000780000007800000078000000780000007800000078000
+00078000000FC00000FFFE00001B227EA120> 70 D<0007F008003C0C1800E0021801C0
+01B8038000F8070000780F0000381E0000381E0000183C0000183C0000187C0000087800
+000878000008F8000000F8000000F8000000F8000000F8000000F8000000F8000000F800
+1FFF780000F8780000787C0000783C0000783C0000781E0000781E0000780F0000780700
+0078038000B801C000B800E00318003C0C080007F00020247DA226> I<FFFC3FFF0FC003
+F0078001E0078001E0078001E0078001E0078001E0078001E0078001E0078001E0078001
+E0078001E0078001E0078001E0078001E0078001E007FFFFE0078001E0078001E0078001
+E0078001E0078001E0078001E0078001E0078001E0078001E0078001E0078001E0078001
+E0078001E0078001E0078001E00FC003F0FFFC3FFF20227EA125> I<FFFC0FC007800780
+078007800780078007800780078007800780078007800780078007800780078007800780
+07800780078007800780078007800780078007800FC0FFFC0E227EA112> I<FFFC00FF80
+0FC0007C0007800030000780002000078000400007800080000780010000078002000007
+80040000078008000007801000000780200000078040000007808000000781C000000783
+E000000785E000000788F000000790F0000007A078000007C03C000007803C000007801E
+000007800F000007800F00000780078000078007C000078003C000078001E000078001E0
+00078000F000078000F8000FC000FC00FFFC07FF8021227EA126> 75
+D<FFFC001F80000F00000F00000F00000F00000F00000F00000F00000F00000F00000F00
+000F00000F00000F00000F00000F00000F00000F00000F00000F00000F00000F00010F00
+010F00010F00010F00030F00030F00020F00060F00060F001E1F007EFFFFFE18227DA11E
+> I<FF8007FF07C000F807C0007005E0002004F0002004F0002004780020047C0020043C
+0020041E0020041F0020040F002004078020040780200403C0200401E0200401E0200400
+F0200400F8200400782004003C2004003E2004001E2004000F2004000F20040007A00400
+03E0040003E0040001E0040001E0040000E00E0000601F000060FFE0002020227EA125>
+78 D<000FE00000783C0000E00E0003C00780078003C00F0001E00E0000E01E0000F03C
+0000783C0000787C00007C7C00007C7800003C7800003CF800003EF800003EF800003EF8
+00003EF800003EF800003EF800003EF800003EF800003E7800003C7C00007C7C00007C3C
+0000783E0000F81E0000F00F0001E00F0001E0078003C003C0078000E00E0000783C0000
+0FE0001F247DA226> I<FFFFF0000F803C0007800F0007800780078007C0078003C00780
+03E0078003E0078003E0078003E0078003E0078003E0078003C0078007C0078007800780
+0F0007803C0007FFF0000780000007800000078000000780000007800000078000000780
+0000078000000780000007800000078000000780000007800000078000000FC00000FFFC
+00001B227EA121> I<FFFFE000000F803C000007800E00000780078000078007C0000780
+03C000078003E000078003E000078003E000078003E000078003E000078003C000078007
+C000078007800007800E000007803C000007FFE000000780700000078038000007801C00
+0007801E000007800E000007800F000007800F000007800F000007800F000007800F8000
+07800F800007800F800007800F808007800FC080078007C0800FC003C100FFFC01E20000
+00007C0021237EA124> 82 D<03F0200C0C601802603001E07000E0600060E00060E000
+60E00020E00020E00020F00000F000007800007F00003FF0001FFE000FFF0003FF80003F
+C00007E00001E00000F00000F0000070800070800070800070800070C00060C00060E000
+C0F000C0C80180C6070081FC0014247DA21B> I<7FFFFFF8780780786007801840078008
+4007800840078008C007800C800780048007800480078004800780040007800000078000
+000780000007800000078000000780000007800000078000000780000007800000078000
+000780000007800000078000000780000007800000078000000780000007800000078000
+00078000000FC00001FFFE001E227EA123> I<FFF0007FC01F80001F000F00000C000F80
+000C000780000800078000080003C000100003C000100003C000100001E000200001E000
+200001F000600000F000400000F000400000780080000078008000007C008000003C0100
+00003C010000001E020000001E020000001E020000000F040000000F040000000F8C0000
+000788000000078800000003D000000003D000000003F000000001E000000001E0000000
+00C000000000C000000000C0000022237FA125> 86 D<FFF03FFC03FE1F8007E000F80F
+0003C000700F0003C000200F0001E00020078001E00040078001E00040078003F0004003
+C002F0008003C002F0008003C002F0008003E00478018001E00478010001E00478010001
+E0083C010000F0083C020000F0083C020000F0101E02000078101E04000078101E040000
+78200F0400003C200F0800003C200F0800003C600F8800001E40079000001E4007900000
+1E4007D000001F8003F000000F8003E000000F8003E000000F0001E00000070001C00000
+070001C00000060000C0000002000080002F237FA132> I<FEFEC0C0C0C0C0C0C0C0C0C0
+C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0FE
+FE07317BA40E> 91 D<FEFE060606060606060606060606060606060606060606060606
+060606060606060606060606060606060606060606FEFE07317FA40E> 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<FF80FE1E00781E00300E00200E0020070040070040
+0780C003808003808001C10001C10000E20000E20000E200007400007400003800003800
+00380000100017157F941A> I<FF8FF87F3E01E03C1C01C0181C01E0180E01E0100E0260
+100E027010070270200704302007043820038438400388184003881C4001C81C8001D00C
+8001D00E8000F00F0000E0070000E00700006006000040020020157F9423> I<FF83FE1F
+00F00E00C007008007810003830001C20000E400007800007800003800003C00004E0000
+8F000187000103800201C00401E00C00E03E01F0FF03FE17157F941A> I<FF80FE1E0078
+1E00300E00200E00200700400700400780C003808003808001C10001C10000E20000E200
+00E200007400007400003800003800003800001000001000002000002000002000004000
+F04000F08000F180004300003C0000171F7F941A> I<3FFFC0380380300780200700600E
+00401C00403C0040380000700000E00001E00001C0000380400700400F00400E00C01C00
+80380080780180700780FFFF8012157F9416> I<FFFFFFFFFFFF3001808C31> 124
+D E
+%EndDVIPSBitmapFont
+%DVIPSBitmapFont: Fl cmbx12 14.4 19
+/Fl 19 118 df<00007FE0030007FFFC07001FFFFF0F007FF00F9F00FF0001FF01FC0000
+FF03F800007F07F000003F0FE000001F1FC000001F1FC000000F3F8000000F3F80000007
+7F800000077F800000077F00000000FF00000000FF00000000FF00000000FF00000000FF
+00000000FF00000000FF00000000FF00000000FF000000007F000000007F800000007F80
+0000073F800000073F800000071FC00000071FC000000E0FE000000E07F000001C03F800
+003C01FC00007800FF0001F0007FF007C0001FFFFF800007FFFE0000007FF00028297CA8
+31> 67 D<FFFFFC0000FFFFFC0000FFFFFC000003FC00000003FC00000003FC00000003
+FC00000003FC00000003FC00000003FC00000003FC00000003FC00000003FC00000003FC
+00000003FC00000003FC00000003FC00000003FC00000003FC00000003FC00000003FC00
+000003FC00000003FC00000003FC00000003FC0001C003FC0001C003FC0001C003FC0001
+C003FC0003C003FC00038003FC00038003FC00078003FC00078003FC000F8003FC000F80
+03FC001F8003FC007F8003FC01FF00FFFFFFFF00FFFFFFFF00FFFFFFFF0022297EA828>
+76 D<0000FFC00000000FFFFC0000003F807F000000FE001FC00001F80007E00003F000
+03F00007E00001F8000FE00001FC001FC00000FE001FC00000FE003F8000007F003F8000
+007F007F8000007F807F0000003F807F0000003F807F0000003F80FF0000003FC0FF0000
+003FC0FF0000003FC0FF0000003FC0FF0000003FC0FF0000003FC0FF0000003FC0FF0000
+003FC0FF0000003FC0FF0000003FC07F0000003F807F8000007F807F8000007F803F8000
+007F003F8000007F001FC00000FE001FC00000FE000FE00001FC0007F00003F80003F800
+07F00001FC000FE00000FE001FC000003FC0FF0000000FFFFC00000000FFC000002A297C
+A833> 79 D<FFFFF0007FFFFFFFF0007FFFFFFFF0007FFF03FE000001C001FE00000380
+01FE0000038001FF0000078000FF0000070000FF80000F00007F80000E00007FC0000E00
+003FC0001C00003FC0001C00003FE0003C00001FE0003800001FF0007800000FF0007000
+000FF80070000007F800E0000007F800E0000003FC01C0000003FC01C0000003FE03C000
+0001FE0380000001FF0780000000FF0700000000FF87000000007F8E000000007F8E0000
+00007FDE000000003FDC000000003FFC000000001FF8000000001FF8000000000FF00000
+00000FF0000000000FF00000000007E00000000007E00000000003C00000000003C00000
+30297FA833> 86 D<03FF80000FFFF0001F01FC003F80FE003F807F003F803F003F803F
+801F003F8000003F8000003F8000003F8000003F80003FFF8001FC3F800FE03F801F803F
+803F003F807E003F80FC003F80FC003F80FC003F80FC003F80FC005F807E00DF803F839F
+FC1FFE0FFC03FC03FC1E1B7E9A21> 97 D<FFE00000FFE00000FFE000000FE000000FE0
+00000FE000000FE000000FE000000FE000000FE000000FE000000FE000000FE000000FE0
+00000FE000000FE1FE000FEFFF800FFE07E00FF803F00FF001F80FE000FC0FE000FC0FE0
+007E0FE0007E0FE0007F0FE0007F0FE0007F0FE0007F0FE0007F0FE0007F0FE0007F0FE0
+007F0FE0007E0FE0007E0FE0007E0FE000FC0FE000FC0FF001F80FF803F00F9C0FE00F0F
+FF800E01FC00202A7EA925> I<00007FF000007FF000007FF0000007F0000007F0000007
+F0000007F0000007F0000007F0000007F0000007F0000007F0000007F0000007F0000007
+F0003F87F001FFF7F007F03FF00FC00FF01F8007F03F0007F03F0007F07E0007F07E0007
+F07E0007F0FE0007F0FE0007F0FE0007F0FE0007F0FE0007F0FE0007F0FE0007F0FE0007
+F07E0007F07E0007F03F0007F03F0007F01F800FF00FC01FF007E07FFF01FFE7FF007F87
+FF202A7EA925> 100 D<003FC00001FFF00003E07C000F803E001F801F001F001F003F00
+0F807E000F807E000FC07E000FC0FE0007C0FE0007C0FFFFFFC0FFFFFFC0FE000000FE00
+0000FE0000007E0000007E0000007F0000003F0001C01F0001C00F80038007C0070003F0
+1E0000FFFC00003FE0001A1B7E9A1F> I<0007F8003FFC007E3E01FC7F03F87F03F07F07
+F07F07F03E07F00007F00007F00007F00007F00007F00007F000FFFFC0FFFFC0FFFFC007
+F00007F00007F00007F00007F00007F00007F00007F00007F00007F00007F00007F00007
+F00007F00007F00007F00007F00007F00007F00007F00007F0007FFF807FFF807FFF8018
+2A7EA915> I<FFE00000FFE00000FFE000000FE000000FE000000FE000000FE000000FE0
+00000FE000000FE000000FE000000FE000000FE000000FE000000FE000000FE07E000FE1
+FF800FE30FC00FE40FE00FE807E00FF807F00FF007F00FF007F00FE007F00FE007F00FE0
+07F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE0
+07F00FE007F00FE007F00FE007F00FE007F0FFFE3FFFFFFE3FFFFFFE3FFF202A7DA925>
+104 D<07000F801FC03FE03FE03FE01FC00F8007000000000000000000000000000000FF
+E0FFE0FFE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00F
+E00FE00FE00FE00FE00FE0FFFEFFFEFFFE0F2B7EAA12> I<FFE0FFE0FFE00FE00FE00FE0
+0FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE0
+0FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE0FFFEFFFEFFFE
+0F2A7EA912> 108 D<FFC07E00FFC1FF80FFC30FC00FC40FE00FC807E00FD807F00FD007
+F00FD007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007
+F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007F0FFFE3F
+FFFFFE3FFFFFFE3FFF201B7D9A25> 110 D<003FE00001FFFC0003F07E000FC01F801F80
+0FC03F0007E03F0007E07E0003F07E0003F07E0003F0FE0003F8FE0003F8FE0003F8FE00
+03F8FE0003F8FE0003F8FE0003F8FE0003F87E0003F07E0003F03F0007E03F0007E01F80
+0FC00FC01F8007F07F0001FFFC00003FE0001D1B7E9A22> I<FFE1FE00FFEFFF80FFFE0F
+E00FF803F00FF001F80FE001FC0FE000FC0FE000FE0FE000FE0FE0007F0FE0007F0FE000
+7F0FE0007F0FE0007F0FE0007F0FE0007F0FE0007F0FE0007E0FE000FE0FE000FE0FE000
+FC0FE001FC0FF001F80FF807F00FFC0FE00FEFFF800FE1FC000FE000000FE000000FE000
+000FE000000FE000000FE000000FE000000FE000000FE00000FFFE0000FFFE0000FFFE00
+0020277E9A25> I<FFC1F0FFC7FCFFC63E0FCC7F0FD87F0FD07F0FD07F0FF03E0FE0000F
+E0000FE0000FE0000FE0000FE0000FE0000FE0000FE0000FE0000FE0000FE0000FE0000F
+E0000FE0000FE000FFFF00FFFF00FFFF00181B7F9A1B> 114 D<03FE300FFFF03E03F078
+00F07000F0F00070F00070F80070FE0000FFE0007FFF007FFFC03FFFE01FFFF007FFF800
+FFF80007FC0000FCE0007CE0003CF0003CF00038F80038FC0070FF01E0E7FFC0C1FF0016
+1B7E9A1B> I<00E00000E00000E00000E00001E00001E00001E00003E00003E00007E000
+0FE0001FFFE0FFFFE0FFFFE00FE0000FE0000FE0000FE0000FE0000FE0000FE0000FE000
+0FE0000FE0000FE0000FE0000FE0000FE0700FE0700FE0700FE0700FE0700FE0700FE070
+07F0E003F0C001FF80007F0014267FA51A> I<FFE07FF0FFE07FF0FFE07FF00FE007F00F
+E007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007F00F
+E007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE00FF00F
+E00FF007E017F003F067FF01FFC7FF007F87FF201B7D9A25> 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<FFFFFC000000FFFFFC00000003FE0000000001F80000000001
+F80000000001F80000000001F80000000001F80000000001F80000000001F80000000001
+F80000000001F80000000001F80000000001F80000000001F80000000001F80000000001
+F80000000001F80000000001F80000000001F80000000001F80000000001F80000000001
+F80000000001F80000000001F80000000001F80000000001F80000000001F80000000001
+F80000000001F80000000001F80000000001F80000000001F80000000001F80000000001
+F80000000001F80000000001F80000000001F80000006001F80000006001F80000006001
+F80000006001F80000006001F8000000E001F8000000C001F8000000C001F8000000C001
+F8000000C001F8000001C001F8000001C001F8000001C001F8000003C001F8000007C001
+F8000007C001F800000FC001F800003F8001F80000FF8003FC0007FF80FFFFFFFFFF80FF
+FFFFFFFF802B3B7CBA32> 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<FFFE000FFFFFFE000FFF07F00007F803E00003E003
+E00001C001F00001C001F000018001F800018000F800030000F8000300007C000600007C
+000600007E000600003E000C00003E000C00003F001C00001F001800001F001800000F80
+3000000F803000000FC070000007C060000007C060000003E0C0000003E0C0000003F1C0
+000001F180000001F180000000FB00000000FB00000000FF000000007E000000007E0000
+00003C000000003C000000003C0000000018000028257FA42A> 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(<fun>) 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(<fun>) 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(<fun>) 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(<fun>) 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
--- /dev/null
+Index: camlp4/Camlp4/Struct/Grammar/Delete.ml
+===================================================================
+--- camlp4/Camlp4/Struct/Grammar/Delete.ml (revision 14037)
++++ camlp4/Camlp4/Struct/Grammar/Delete.ml (working copy)
+@@ -35,17 +35,17 @@
+ open Structure;
+
+ value raise_rule_not_found entry symbols =
+- let to_string f x =
++ let to_string : !'a. (_ -> 'a -> _) -> 'a -> _ = fun [f -> fun [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))
++ }]] 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 *)
+Index: camlp4/boot/Camlp4.ml
+===================================================================
+--- camlp4/boot/Camlp4.ml (revision 14037)
++++ camlp4/boot/Camlp4.ml (working copy)
+@@ -18022,7 +18022,7 @@
+ open Structure
+
+ let raise_rule_not_found entry symbols =
+- let to_string f x =
++ let to_string : 'a. (_ -> 'a -> _) -> 'a -> _ = fun f x ->
+ let buff = Buffer.create 128 in
+ let ppf = Format.formatter_of_buffer buff
+ in
+Index: camlp4/Camlp4Filters/Camlp4FoldGenerator.ml
+===================================================================
+--- camlp4/Camlp4Filters/Camlp4FoldGenerator.ml (revision 14037)
++++ camlp4/Camlp4Filters/Camlp4FoldGenerator.ml (working copy)
+@@ -547,14 +547,18 @@
+
+ value processor =
+ let last = ref <:ctyp<>> in
+- let generate_class' generator default c s n =
++ let generate_class'
++ : !'a 'b. (_ -> 'a -> _ -> _ -> 'b) -> 'b -> 'a -> _ -> _ -> 'b =
++ fun generator default c s n ->
+ match s with
+ [ "Fold" -> generator Fold c last.val n
+ | "Map" -> generator Map c last.val n
+ | "FoldMap" -> generator Fold_map c last.val n
+ | _ -> default ]
+ in
+- let generate_class_from_module_name generator c default m =
++ let generate_class_from_module_name
++ : !'a 'b. (_ -> 'a -> _ -> _ -> 'b) -> 'a -> 'b -> _ -> 'b =
++ fun generator c default m ->
+ try Scanf.sscanf m "Camlp4%[^G]Generator" begin fun m' ->
+ try Scanf.sscanf m' "%[^0-9]%d" (generate_class' generator default c)
+ with [ End_of_file | Scanf.Scan_failure _ -> generate_class' generator default c m' 1 ]
+Index: stdlib/arg.ml
+===================================================================
+--- stdlib/arg.ml (revision 14037)
++++ stdlib/arg.ml (working copy)
+@@ -106,7 +106,7 @@
+ let l = Array.length argv in
+ let b = Buffer.create 200 in
+ let initpos = !current in
+- let stop error =
++ let stop : 'a. _ -> 'a = fun error ->
+ let progname = if initpos < l then argv.(initpos) else "(?)" in
+ begin match error with
+ | Unknown "-help" -> ()
+Index: stdlib/printf.ml
+===================================================================
+--- stdlib/printf.ml (revision 14037)
++++ stdlib/printf.ml (working copy)
+@@ -492,7 +492,7 @@
+ Don't do this at home, kids. *)
+ let scan_format fmt args n pos cont_s cont_a cont_t cont_f cont_m =
+
+- let get_arg spec n =
++ let get_arg : 'a. _ -> _ -> 'a = fun spec n ->
+ Obj.magic (args.(Sformat.int_of_index (get_index spec n))) in
+
+ let rec scan_positional n widths i =
+Index: stdlib/camlinternalOO.ml
+===================================================================
+--- stdlib/camlinternalOO.ml (revision 14037)
++++ stdlib/camlinternalOO.ml (working copy)
+@@ -349,7 +349,7 @@
+ init_table.env_init <- env_init
+
+ let dummy_class loc =
+- let undef = fun _ -> raise (Undefined_recursive_module loc) in
++ let undef : 'a 'b.'a -> 'b = fun _ -> raise (Undefined_recursive_module loc) in
+ (Obj.magic undef, undef, undef, Obj.repr 0)
+
+ (**** Objects ****)
+@@ -527,7 +527,7 @@
+ | Closure of closure
+
+ let method_impl table i arr =
+- let next () = incr i; magic arr.(!i) in
++ let next : 'a. unit -> 'a = fun () -> incr i; magic arr.(!i) in
+ match next() with
+ GetConst -> let x : t = next() in get_const x
+ | GetVar -> let n = next() in get_var n
+Index: stdlib/scanf.ml
+===================================================================
+--- stdlib/scanf.ml (revision 14037)
++++ stdlib/scanf.ml (working copy)
+@@ -1324,10 +1324,11 @@
+
+ let limr = Array.length rv - 1 in
+
+- 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 return : 'a 'b 'c. ('a -> 'b) -> 'c = fun v -> Obj.magic v () in
++ let delay : 'a 'b. ('a -> 'b) -> 'a -> unit -> 'b = fun f x () -> f x in
++ let stack : 'a 'b 'd 'e. ('a -> 'b) -> 'd -> unit -> 'e =
++ fun f -> delay (return f) in
++ let no_stack : 'a 'b. 'a -> 'b -> 'a = fun f _x -> f in
+
+ let rec scan fmt =
+
+@@ -1380,7 +1381,8 @@
+ 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 stack : 'b 'd. (unit -> 'b) -> 'd -> unit -> 'b =
++ if skip then no_stack else stack 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
+Index: typing/typemod.ml
+===================================================================
+--- typing/typemod.ml (revision 14037)
++++ typing/typemod.ml (working copy)
+@@ -420,7 +420,7 @@
+
+ (* let signature sg = List.map (fun item -> item.sig_type) sg *)
+
+-let rec transl_modtype env smty =
++let rec transl_modtype env smty : Typedtree.module_type =
+ let loc = smty.pmty_loc in
+ match smty.pmty_desc with
+ Pmty_ident lid ->
+@@ -609,7 +609,7 @@
+ List.fold_left
+ (fun env (id, _, mty) -> Env.add_module id mty.mty_type env)
+ env curr in
+- let transition env_c curr =
++ let transition : 'a. _ -> (_ * _ * 'a) list -> _ = fun env_c curr ->
+ List.map2
+ (fun (_,smty) (id,id_loc,mty) -> (id, id_loc, transl_modtype env_c smty))
+ sdecls curr in
+Index: typing/typecore.ml
+===================================================================
+--- typing/typecore.ml (revision 14037)
++++ typing/typecore.ml (working copy)
+@@ -1373,9 +1373,9 @@
+
+ let ty_arrow gty ty = newty (Tarrow ("", instance_def gty, ty, Cok)) in
+
+- let bad_conversion fmt i c =
++ let bad_conversion : 'a. string -> int -> char -> 'a = fun fmt i c ->
+ raise (Error (loc, Env.empty, Bad_conversion (fmt, i, c))) in
+- let incomplete_format fmt =
++ let incomplete_format : 'a. string -> 'a = fun fmt ->
+ raise (Error (loc, Env.empty, Incomplete_format fmt)) in
+
+ let rec type_in_format fmt =
+@@ -3238,7 +3238,7 @@
+
+ (* Typing of let bindings *)
+
+-and type_let ?(check = fun s -> Warnings.Unused_var s)
++and type_let ?(global=false) ?(check = fun s -> Warnings.Unused_var s)
+ ?(check_strict = fun s -> Warnings.Unused_var_strict s)
+ env rec_flag spat_sexp_list scope allow =
+ begin_def();
+@@ -3368,7 +3368,7 @@
+ )
+ pat_list
+ in
+- let exp_list =
++ let exp_gen_list =
+ List.map2
+ (fun (spat, sexp) (pat, slot) ->
+ let sexp =
+@@ -3386,9 +3386,12 @@
+ let exp = type_expect exp_env sexp ty' in
+ end_def ();
+ check_univars env true "definition" exp pat.pat_type vars;
+- {exp with exp_type = instance env exp.exp_type}
+- | _ -> type_expect exp_env sexp pat.pat_type)
++ {exp with exp_type = instance env exp.exp_type}, true
++ | _ ->
++ type_expect exp_env sexp pat.pat_type,
++ match sexp.pexp_desc with Pexp_ident _ -> true | _ -> false)
+ spat_sexp_list pat_slot_list in
++ let exp_list, gen_list = List.split exp_gen_list in
+ current_slot := None;
+ if is_recursive && not !rec_needed
+ && Warnings.is_active Warnings.Unused_rec_flag then
+@@ -3399,10 +3402,12 @@
+ pat_list exp_list;
+ end_def();
+ List.iter2
+- (fun pat exp ->
+- if not (is_nonexpansive exp) then
++ (fun pat (exp, gen) ->
++ if not (global || gen) then
++ iter_pattern (fun pat -> generalize_structure pat.pat_type) pat
++ else if not (is_nonexpansive exp) then
+ iter_pattern (fun pat -> generalize_expansive env pat.pat_type) pat)
+- pat_list exp_list;
++ pat_list exp_gen_list;
+ List.iter
+ (fun pat -> iter_pattern (fun pat -> generalize pat.pat_type) pat)
+ pat_list;
+@@ -3413,7 +3418,7 @@
+ let type_binding env rec_flag spat_sexp_list scope =
+ Typetexp.reset_type_variables();
+ let (pat_exp_list, new_env, unpacks) =
+- type_let
++ type_let ~global:true
+ ~check:(fun s -> Warnings.Unused_value_declaration s)
+ ~check_strict:(fun s -> Warnings.Unused_value_declaration s)
+ env rec_flag spat_sexp_list scope false
+Index: typing/includecore.ml
+===================================================================
+--- typing/includecore.ml (revision 14037)
++++ typing/includecore.ml (working copy)
+@@ -123,7 +123,8 @@
+ | Record_representation of bool
+
+ let report_type_mismatch0 first second decl ppf err =
+- let pr fmt = Format.fprintf ppf fmt in
++ let pr : 'a. ('a, Format.formatter, unit) format -> 'a
++ = fun fmt -> Format.fprintf ppf fmt in
+ match err with
+ Arity -> pr "They have different arities"
+ | Privacy -> pr "A private type would be revealed"
+Index: ocamldoc/odoc_html.ml
+===================================================================
+--- ocamldoc/odoc_html.ml (revision 14037)
++++ ocamldoc/odoc_html.ml (working copy)
+@@ -508,7 +508,7 @@
+ bs b "</table>\n"
+
+ method html_of_Index_list b =
+- let index_if_not_empty l url m =
++ let index_if_not_empty : 'a. 'a list -> _ = fun l url m ->
+ match l with
+ [] -> ()
+ | _ -> bp b "<li><a href=\"%s\">%s</a></li>\n" url m
+@@ -977,7 +977,7 @@
+ (** A function to build the header of pages. *)
+ method prepare_header module_list =
+ let f b ?(nav=None) ?(comments=[]) t =
+- let link_if_not_empty l m url =
++ let link_if_not_empty : 'a. 'a list -> _ = fun l m url ->
+ match l with
+ [] -> ()
+ | _ ->
+Index: bytecomp/translmod.ml
+===================================================================
+--- bytecomp/translmod.ml (revision 14037)
++++ bytecomp/translmod.ml (working copy)
+@@ -773,7 +773,8 @@
+ Lprim(Psetglobal target_name, [Lprim(Pmakeblock(0, Immutable), components)])
+
+ let transl_store_package component_names target_name coercion =
+- let rec make_sequence fn pos arg =
++ let rec make_sequence : 'a. (int -> 'a -> _) -> int -> 'a list -> _ =
++ fun fn pos arg ->
+ match arg with
+ [] -> lambda_unit
+ | hd :: tl -> Lsequence(fn pos hd, make_sequence fn (pos + 1) tl) in
+Index: otherlibs/labltk/jpf/jpf_font.ml
+===================================================================
+--- otherlibs/labltk/jpf/jpf_font.ml (revision 14037)
++++ otherlibs/labltk/jpf/jpf_font.ml (working copy)
+@@ -131,7 +131,7 @@
+ }
+
+ let string_of_pattern =
+- let pat f = function
++ let pat : 'a. ('a -> string) -> 'a option -> string = fun f -> function
+ Some x -> f x
+ | None -> "*"
+ in
+Index: otherlibs/labltk/browser/searchid.ml
+===================================================================
+--- otherlibs/labltk/browser/searchid.ml (revision 14037)
++++ otherlibs/labltk/browser/searchid.ml (working copy)
+@@ -396,7 +396,7 @@
+ let search_string_symbol text =
+ if text = "" then [] else
+ let lid = snd (longident_of_string text) [] in
+- let try_lookup f k =
++ let try_lookup : 'a. _ -> 'a -> (_ * 'a) list = fun f k ->
+ try let _ = f lid Env.initial in [lid, k]
+ with Not_found | Env.Error _ -> []
+ in
+Index: otherlibs/labltk/browser/setpath.ml
+===================================================================
+--- otherlibs/labltk/browser/setpath.ml (revision 14037)
++++ otherlibs/labltk/browser/setpath.ml (working copy)
+@@ -117,12 +117,12 @@
+ bind_space_toggle dirbox;
+ bind_space_toggle pathbox;
+
+- let add_paths _ =
++ let add_paths : 'a. 'a -> unit = fun _ ->
+ add_to_path pathbox ~base:!current_dir
+ ~dirs:(List.map (Listbox.curselection dirbox)
+ ~f:(fun x -> Listbox.get dirbox ~index:x));
+ Listbox.selection_clear dirbox ~first:(`Num 0) ~last:`End
+- and remove_paths _ =
++ and remove_paths : 'a. 'a -> unit = fun _ ->
+ remove_path pathbox
+ ~dirs:(List.map (Listbox.curselection pathbox)
+ ~f:(fun x -> Listbox.get pathbox ~index:x))
+Index: otherlibs/labltk/browser/viewer.ml
+===================================================================
+--- otherlibs/labltk/browser/viewer.ml (revision 14037)
++++ otherlibs/labltk/browser/viewer.ml (working copy)
+@@ -507,7 +507,8 @@
+ if i < 3 then Listbox.delete box ~first:(`Num 0) ~last:`End
+ else destroy fm
+ done;
+- let rec firsts n = function [] -> []
++ let rec firsts : 'a. int -> 'a list -> 'a list = fun n -> function
++ [] -> []
+ | a :: l -> if n > 0 then a :: firsts (pred n) l else [] in
+ shown_paths <- firsts (n-1) shown_paths;
+ boxes <- firsts (max 3 n) boxes
+Index: otherlibs/labltk/frx/frx_req.ml
+===================================================================
+--- otherlibs/labltk/frx/frx_req.ml (revision 14037)
++++ otherlibs/labltk/frx/frx_req.ml (working copy)
+@@ -40,7 +40,7 @@
+ let e =
+ Entry.create t [Relief Sunken; TextVariable memory; TextWidth len] in
+
+- let activate _ =
++ let activate : 'a. 'a -> unit = fun _ ->
+ let v = Entry.get e in
+ Grab.release t; (* because of wm *)
+ destroy t; (* so action can call open_simple *)
+@@ -77,7 +77,7 @@
+
+ let waiting = Textvariable.create_temporary t in
+
+- let activate _ =
++ let activate : 'a. 'a -> unit = fun _ ->
+ Grab.release t; (* because of wm *)
+ destroy t; (* so action can call open_simple *)
+ Textvariable.set waiting "1" in
+@@ -125,7 +125,7 @@
+ Listbox.insert lb End elements;
+
+ (* activation: we have to break() because we destroy the requester *)
+- let activate _ =
++ let activate : 'a. 'a -> unit = fun _ ->
+ let l = List.map (Listbox.get lb) (Listbox.curselection lb) in
+ Grab.release t;
+ destroy t;
+Index: otherlibs/labltk/support/rawwidget.ml
+===================================================================
+--- otherlibs/labltk/support/rawwidget.ml (revision 14037)
++++ otherlibs/labltk/support/rawwidget.ml (working copy)
+@@ -67,7 +67,7 @@
+ (* This one is always created by opentk *)
+ let default_toplevel =
+ let wname = "." in
+- let w = Typed (wname, "toplevel") in
++ let w : 'a. 'a raw_widget = Typed (wname, "toplevel") in
+ Hashtbl.add table wname w;
+ w
+
+@@ -145,7 +145,7 @@
+ then "." ^ name
+ else parentpath ^ "." ^ name
+ in
+- let w = Typed(path,clas) in
++ let w :'a. 'a raw_widget = Typed(path,clas) in
+ Hashtbl.add table path w;
+ w
+
+Index: ocamlbuild/rule.ml
+===================================================================
+--- ocamlbuild/rule.ml (revision 14037)
++++ ocamlbuild/rule.ml (working copy)
+@@ -260,7 +260,8 @@
+ which is deprecated and ignored."
+ name
+ in
+- let res_add import xs xopt =
++ let res_add : 'b. ('a -> 'b) -> 'a list -> 'a option -> 'b list =
++ fun import xs xopt ->
+ let init =
+ match xopt with
+ | None -> []
+Index: ocamlbuild/main.ml
+===================================================================
+--- ocamlbuild/main.ml (revision 14037)
++++ ocamlbuild/main.ml (working copy)
+@@ -50,7 +50,7 @@
+ let show_documentation () =
+ let rules = Rule.get_rules () in
+ let flags = Flags.get_flags () in
+- let pp fmt = Log.raw_dprintf (-1) fmt in
++ let pp : 'a. ('a,_,_) format -> 'a = fun fmt -> Log.raw_dprintf (-1) fmt in
+ List.iter begin fun rule ->
+ pp "%a@\n@\n" (Rule.pretty_print Resource.print_pattern) rule
+ end rules;
--- /dev/null
+? 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@[<hv>@[<hv>%a@]%a ]@]" (if non_gen then "_" else "")
++ fprintf ppf "%s[%s@[<hv>@[<hv>%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
--- /dev/null
+(* 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)))
--- /dev/null
+Index: parsing/parser.mly
+===================================================================
+--- parsing/parser.mly (revision 11929)
++++ parsing/parser.mly (working copy)
+@@ -319,6 +319,11 @@
+ let polyvars, core_type = varify_constructors newtypes core_type in
+ (exp, ghtyp(Ptyp_poly(polyvars,core_type)))
+
++let no_lessminus =
++ List.map (fun (p,e,b) ->
++ match b with None -> (p,e)
++ | Some loc -> raise (Syntaxerr.Error (Syntaxerr.Other loc)))
++
+ %}
+
+ /* Tokens */
+@@ -597,8 +602,9 @@
+ structure_item:
+ LET rec_flag let_bindings
+ { match $3 with
+- [{ ppat_desc = Ppat_any; ppat_loc = _ }, exp] -> mkstr(Pstr_eval exp)
+- | _ -> mkstr(Pstr_value($2, List.rev $3)) }
++ [{ ppat_desc = Ppat_any; ppat_loc = _ }, exp, None] ->
++ mkstr(Pstr_eval exp)
++ | _ -> mkstr(Pstr_value($2, no_lessminus (List.rev $3))) }
+ | EXTERNAL val_ident COLON core_type EQUAL primitive_declaration
+ { mkstr(Pstr_primitive($2, {pval_type = $4; pval_prim = $6})) }
+ | TYPE type_declarations
+@@ -744,7 +750,7 @@
+ | class_simple_expr simple_labeled_expr_list
+ { mkclass(Pcl_apply($1, List.rev $2)) }
+ | LET rec_flag let_bindings IN class_expr
+- { mkclass(Pcl_let ($2, List.rev $3, $5)) }
++ { mkclass(Pcl_let ($2, no_lessminus (List.rev $3), $5)) }
+ ;
+ class_simple_expr:
+ LBRACKET core_type_comma_list RBRACKET class_longident
+@@ -981,9 +987,15 @@
+ | simple_expr simple_labeled_expr_list
+ { mkexp(Pexp_apply($1, List.rev $2)) }
+ | LET rec_flag let_bindings IN seq_expr
+- { mkexp(Pexp_let($2, List.rev $3, $5)) }
++ { match $3 with
++ | [pat, expr, Some loc] when $2 = Nonrecursive ->
++ mkexp(Pexp_apply(
++ {pexp_desc = Pexp_ident(Lident "bind"); pexp_loc = loc},
++ ["", expr; "", ghexp(Pexp_function("", None, [pat, $5]))]))
++ | bindings ->
++ mkexp(Pexp_let($2, no_lessminus (List.rev $3), $5)) }
+ | LET DOT simple_expr let_binding IN seq_expr
+- { let (pat, expr) = $4 in
++ { let (pat, expr, _) = $4 in
+ mkexp(Pexp_apply($3, ["", expr; "", ghexp(Pexp_function("", None, [pat, $6]))])) }
+ | LET MODULE UIDENT module_binding IN seq_expr
+ { mkexp(Pexp_letmodule($3, $4, $6)) }
+@@ -1197,14 +1209,17 @@
+ ;
+ let_binding:
+ val_ident fun_binding
+- { (mkpatvar $1 1, $2) }
++ { (mkpatvar $1 1, $2, None) }
+ | val_ident COLON typevar_list DOT core_type EQUAL seq_expr
+- { (ghpat(Ppat_constraint(mkpatvar $1 1, ghtyp(Ptyp_poly($3,$5)))), $7) }
++ { (ghpat(Ppat_constraint(mkpatvar $1 1, ghtyp(Ptyp_poly($3,$5)))), $7,
++ None) }
+ | 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) }
++ (ghpat(Ppat_constraint(mkpatvar $1 1, poly)), exp, None) }
+ | pattern EQUAL seq_expr
+- { ($1, $3) }
++ { ($1, $3, None) }
++ | pattern LESSMINUS seq_expr
++ { ($1, $3, Some (rhs_loc 2)) }
+ ;
+ fun_binding:
+ strict_binding
--- /dev/null
+Index: typing/typecore.ml
+===================================================================
+--- typing/typecore.ml (revision 13003)
++++ typing/typecore.ml (working copy)
+@@ -61,6 +61,7 @@
+ | Not_a_packed_module of type_expr
+ | Recursive_local_constraint of (type_expr * type_expr) list
+ | Unexpected_existential
++ | Pattern_newtype_non_closed of string * type_expr
+
+ exception Error of Location.t * error
+
+@@ -121,7 +122,7 @@
+ | Pexp_function (_, eo, pel) ->
+ may expr eo; List.iter (fun (_, e) -> expr e) pel
+ | Pexp_apply (e, lel) -> expr e; List.iter (fun (_, e) -> expr e) lel
+- | Pexp_let (_, pel, e)
++ | Pexp_let (_, pel, e) -> expr e; List.iter (fun (_, e) -> expr e) pel
+ | Pexp_match (e, pel)
+ | Pexp_try (e, pel) -> expr e; List.iter (fun (_, e) -> expr e) pel
+ | Pexp_array el
+@@ -1454,7 +1455,7 @@
+
+ let duplicate_ident_types loc caselist env =
+ let caselist =
+- List.filter (fun (pat, _) -> contains_gadt env pat) caselist in
++ List.filter (fun ((_,pat), _) -> contains_gadt env pat) caselist in
+ let idents = all_idents (List.map snd caselist) in
+ List.fold_left
+ (fun env s ->
+@@ -1552,7 +1553,7 @@
+ exp_env = env }
+ | Pexp_let(Nonrecursive, [spat, sval], sbody) when contains_gadt env spat ->
+ type_expect ?in_function env
+- {sexp with pexp_desc = Pexp_match (sval, [spat, sbody])}
++ {sexp with pexp_desc = Pexp_match (sval, [([],spat), sbody])}
+ ty_expected
+ | Pexp_let(rec_flag, spat_sexp_list, sbody) ->
+ let scp =
+@@ -1572,20 +1573,21 @@
+ exp_env = env }
+ | Pexp_function (l, Some default, [spat, sbody]) ->
+ let default_loc = default.pexp_loc in
+- let scases = [
++ let scases = [([],
+ {ppat_loc = default_loc;
+ ppat_desc =
+ Ppat_construct
+ (mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))),
+ Some {ppat_loc = default_loc;
+ ppat_desc = Ppat_var (mknoloc "*sth*")},
+- false)},
++ false)}),
+ {pexp_loc = default_loc;
+ pexp_desc = Pexp_ident(mknoloc (Longident.Lident "*sth*"))};
++ ([],
+ {ppat_loc = default_loc;
+ ppat_desc = Ppat_construct
+ (mknoloc (Longident.(Ldot (Lident "*predef*", "None"))),
+- None, false)},
++ None, false)}),
+ default;
+ ] in
+ let smatch = {
+@@ -1603,10 +1605,10 @@
+ pexp_desc =
+ Pexp_function (
+ l, None,
+- [ {ppat_loc = loc;
+- ppat_desc = Ppat_var (mknoloc "*opt*")},
++ [ ([], {ppat_loc = loc;
++ ppat_desc = Ppat_var (mknoloc "*opt*")}),
+ {pexp_loc = loc;
+- pexp_desc = Pexp_let(Default, [spat, smatch], sbody);
++ pexp_desc = Pexp_let(Default, [snd spat, smatch], sbody);
+ }
+ ]
+ )
+@@ -2733,10 +2735,10 @@
+ and type_cases ?in_function env ty_arg ty_res partial_flag loc caselist =
+ (* ty_arg is _fully_ generalized *)
+ let dont_propagate, has_gadts =
+- let patterns = List.map fst caselist in
++ let patterns = List.map (fun ((_,p),_) -> p) caselist in
+ List.exists contains_polymorphic_variant patterns,
+- List.exists (contains_gadt env) patterns in
+-(* prerr_endline ( if has_gadts then "contains gadt" else "no gadt"); *)
++ List.exists (contains_gadt env) patterns ||
++ List.exists (fun ((l,_),_) -> l <> []) caselist in
+ let ty_arg, ty_res, env =
+ if has_gadts && not !Clflags.principal then
+ correct_levels ty_arg, correct_levels ty_res,
+@@ -2761,9 +2763,21 @@
+ Printtyp.raw_type_expr ty_arg; *)
+ let pat_env_list =
+ List.map
+- (fun (spat, sexp) ->
++ (fun ((stypes,spat), sexp) ->
+ let loc = sexp.pexp_loc in
+ if !Clflags.principal then begin_def (); (* propagation of pattern *)
++ (* For local types *)
++ if stypes <> [] then begin_def ();
++ let lev' = get_current_level () in
++ let types = List.map (fun name -> name, newvar ~name ()) stypes in
++ let env =
++ List.fold_left (fun env (name, manifest) ->
++ (* "Vanishing" definition *)
++ let decl = new_declaration ~manifest (lev',lev') in
++ snd (Env.enter_type name decl env))
++ env types
++ in
++ (* Type the pattern itself *)
+ let scope = Some (Annot.Idef loc) in
+ let (pat, ext_env, force, unpacks) =
+ let partial =
+@@ -2773,14 +2787,42 @@
+ in type_pattern ~lev env spat scope ty_arg
+ in
+ pattern_force := force @ !pattern_force;
++ (* For local types *)
++ let ext_env =
++ List.fold_left (fun env (name, ty) ->
++ let ty = expand_head env ty in
++ match ty.desc with
++ Tconstr ((Path.Pident id as p), [], _) when
++ let decl = Env.find_type p env in
++ decl.type_newtype_level = Some (lev, lev) &&
++ decl.type_kind = Type_abstract ->
++ let (id', env) =
++ Env.enter_type name (new_declaration (lev, lev)) env in
++ let manifest = newconstr (Path.Pident id') [] in
++ (* Make previous existential "vanish" *)
++ Env.add_type id (new_declaration ~manifest (lev',lev')) env
++ | _ ->
++ if free_variables ty <> [] then
++ raise (Error (spat.ppat_loc,
++ Pattern_newtype_non_closed (name,ty)));
++ let manifest = correct_levels ty in
++ let decl = new_declaration ~manifest (lev, lev) in
++ snd (Env.enter_type name decl env))
++ ext_env types
++ in
++ if stypes <> [] then begin
++ end_def ();
++ iter_pattern (fun p -> unify_pat ext_env p (newvar())) pat;
++ end;
++ (* Principality *)
+ let pat =
+ if !Clflags.principal then begin
+ end_def ();
+ iter_pattern (fun {pat_type=t} -> generalize_structure t) pat;
+- { pat with pat_type = instance env pat.pat_type }
++ { pat with pat_type = instance ext_env pat.pat_type }
+ end else pat
+ in
+- unify_pat env pat ty_arg';
++ unify_pat ext_env pat ty_arg';
+ (pat, (ext_env, unpacks)))
+ caselist in
+ (* Check for polymorphic variants to close *)
+@@ -2802,7 +2844,7 @@
+ let in_function = if List.length caselist = 1 then in_function else None in
+ let cases =
+ List.map2
+- (fun (pat, (ext_env, unpacks)) (spat, sexp) ->
++ (fun (pat, (ext_env, unpacks)) ((stypes,spat), sexp) ->
+ let sexp = wrap_unpacks sexp unpacks in
+ let ty_res' =
+ if !Clflags.principal then begin
+@@ -2811,8 +2853,8 @@
+ end_def ();
+ generalize_structure ty; ty
+ end
+- else if contains_gadt env spat then correct_levels ty_res
+- else ty_res in
++ else if contains_gadt env spat || stypes <> []
++ then correct_levels ty_res else ty_res in
+ (* Format.printf "@[%i %i, ty_res' =@ %a@]@." lev (get_current_level())
+ Printtyp.raw_type_expr ty_res'; *)
+ let exp = type_expect ?in_function ext_env sexp ty_res' in
+@@ -3218,6 +3260,11 @@
+ | Unexpected_existential ->
+ fprintf ppf
+ "Unexpected existential"
++ | Pattern_newtype_non_closed (name, ty) ->
++ reset_and_mark_loops ty;
++ fprintf ppf
++ "@[In this pattern, local type %s has been inferred as@ %a@ %s@]"
++ name type_expr ty "It should not contain variables."
+
+ let () =
+ Env.add_delayed_check_forward := add_delayed_check
+Index: typing/ctype.mli
+===================================================================
+--- typing/ctype.mli (revision 13003)
++++ typing/ctype.mli (working copy)
+@@ -140,6 +140,9 @@
+ the parameters [pi] and returns the corresponding instance of
+ [t]. Exception [Cannot_apply] is raised in case of failure. *)
+
++val new_declaration:
++ ?manifest:type_expr -> ?loc:Location.t -> (int * int) -> type_declaration
++
+ val expand_head_once: Env.t -> type_expr -> type_expr
+ val expand_head: Env.t -> type_expr -> type_expr
+ val try_expand_once_opt: Env.t -> type_expr -> type_expr
+Index: typing/typeclass.ml
+===================================================================
+--- typing/typeclass.ml (revision 13003)
++++ typing/typeclass.ml (working copy)
+@@ -347,8 +347,8 @@
+ let mkid s = mkloc s self_loc in
+ { pexp_desc =
+ Pexp_function ("", None,
+- [mkpat (Ppat_alias (mkpat (Ppat_var (mkid "self-*")),
+- mkid ("self-" ^ cl_num))),
++ [([],mkpat (Ppat_alias (mkpat (Ppat_var (mkid "self-*")),
++ mkid ("self-" ^ cl_num)))),
+ expr]);
+ pexp_loc = expr.pexp_loc }
+
+@@ -836,15 +836,15 @@
+ | Pcl_fun (l, Some default, spat, sbody) ->
+ let loc = default.pexp_loc in
+ let scases =
+- [{ppat_loc = loc; ppat_desc = Ppat_construct (
++ [([], {ppat_loc = loc; ppat_desc = Ppat_construct (
+ mknoloc (Longident.(Ldot (Lident"*predef*", "Some"))),
+ Some{ppat_loc = loc; ppat_desc = Ppat_var (mknoloc "*sth*")},
+- false)},
++ false)}),
+ {pexp_loc = loc; pexp_desc =
+ Pexp_ident(mknoloc (Longident.Lident"*sth*"))};
+- {ppat_loc = loc; ppat_desc =
++ ([], {ppat_loc = loc; ppat_desc =
+ Ppat_construct(mknoloc (Longident.(Ldot (Lident"*predef*", "None"))),
+- None, false)},
++ None, false)}),
+ default] in
+ let smatch =
+ {pexp_loc = loc; pexp_desc =
+Index: typing/ctype.ml
+===================================================================
+--- typing/ctype.ml (revision 13003)
++++ typing/ctype.ml (working copy)
+@@ -696,6 +696,7 @@
+ Path.binding_time p
+
+ let rec update_level env level ty =
++ (* Format.eprintf "update_level %d %a@." level !Btype.print_raw ty; *)
+ let ty = repr ty in
+ if ty.level > level then begin
+ if Env.has_local_constraints env then begin
+@@ -1043,7 +1044,7 @@
+ reified_var_counter := Vars.add s index !reified_var_counter;
+ Printf.sprintf "%s#%d" s index
+
+-let new_declaration newtype manifest =
++let new_declaration ?manifest ?(loc=Location.none) newtype =
+ {
+ type_params = [];
+ type_arity = 0;
+@@ -1051,7 +1052,7 @@
+ type_private = Public;
+ type_manifest = manifest;
+ type_variance = [];
+- type_newtype_level = newtype;
++ type_newtype_level = Some newtype;
+ type_loc = Location.none;
+ }
+
+@@ -1060,7 +1061,7 @@
+ | None -> ()
+ | Some (env, newtype_lev) ->
+ let process existential =
+- let decl = new_declaration (Some (newtype_lev, newtype_lev)) None in
++ let decl = new_declaration (newtype_lev, newtype_lev) in
+ let name =
+ match repr existential with
+ {desc = Tvar (Some name)} -> name
+@@ -1808,7 +1809,7 @@
+ 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 decl = new_declaration (newtype_level, newtype_level) 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
+@@ -2039,7 +2040,7 @@
+ 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 decl = new_declaration ~manifest:destination source_lev in
+ let newtype_level = get_newtype_level () in
+ env := Env.add_local_constraint source decl newtype_level !env;
+ cleanup_abbrev ()
+Index: typing/typecore.mli
+===================================================================
+--- typing/typecore.mli (revision 13003)
++++ typing/typecore.mli (working copy)
+@@ -103,6 +103,7 @@
+ | Not_a_packed_module of type_expr
+ | Recursive_local_constraint of (type_expr * type_expr) list
+ | Unexpected_existential
++ | Pattern_newtype_non_closed of string * type_expr
+
+ exception Error of Location.t * error
+
+Index: testsuite/tests/typing-gadts/test.ml.reference
+===================================================================
+--- testsuite/tests/typing-gadts/test.ml.reference (revision 13003)
++++ testsuite/tests/typing-gadts/test.ml.reference (working copy)
+@@ -293,4 +293,18 @@
+ # type 'a ty = Int : int -> int ty
+ # val f : 'a ty -> 'a = <fun>
+ # val g : 'a ty -> 'a = <fun>
++# - : unit -> unit list = <fun>
++# - : unit list = []
++# Characters 17-19:
++ function type a. () -> ();; (* fail *)
++ ^^
++Error: In this pattern, local type a has been inferred as 'a
++ It should not contain variables.
++# type t = D : 'a * ('a -> int) -> t
++# val f : t -> int = <fun>
++# Characters 42-43:
++ let f = function type b. D ((x:b), f) -> (f:t->int) x;; (* fail *)
++ ^
++Error: This expression has type b -> int
++ but an expression was expected of type t -> int
+ #
+Index: testsuite/tests/typing-gadts/test.ml
+===================================================================
+--- testsuite/tests/typing-gadts/test.ml (revision 13003)
++++ testsuite/tests/typing-gadts/test.ml (working copy)
+@@ -512,3 +512,15 @@
+ let g : type a. a ty -> a =
+ let () = () in
+ fun x -> match x with Int y -> y;;
++
++(* Implicit type declarations in patterns *)
++
++(* alias *)
++function type a. (() : a) -> ([] : a list);;
++(function type a. (() : a) -> ([] : a list)) ();;
++function type a. () -> ();; (* fail *)
++
++(* existential *)
++type t = D : 'a * ('a -> int) -> t;;
++let f = function type b. D ((x:b), f) -> (f:b->int) x;;
++let f = function type b. D ((x:b), f) -> (f:t->int) x;; (* fail *)
+Index: testsuite/tests/typing-gadts/test.ml.principal.reference
+===================================================================
+--- testsuite/tests/typing-gadts/test.ml.principal.reference (revision 13003)
++++ testsuite/tests/typing-gadts/test.ml.principal.reference (working copy)
+@@ -306,4 +306,18 @@
+ # type 'a ty = Int : int -> int ty
+ # val f : 'a ty -> 'a = <fun>
+ # val g : 'a ty -> 'a = <fun>
++# - : unit -> unit list = <fun>
++# - : unit list = []
++# Characters 17-19:
++ function type a. () -> ();; (* fail *)
++ ^^
++Error: In this pattern, local type a has been inferred as 'a
++ It should not contain variables.
++# type t = D : 'a * ('a -> int) -> t
++# val f : t -> int = <fun>
++# Characters 42-43:
++ let f = function type b. D ((x:b), f) -> (f:t->int) x;; (* fail *)
++ ^
++Error: This expression has type b -> int
++ but an expression was expected of type t -> int
+ #
+Index: parsing/parser.mly
+===================================================================
+--- parsing/parser.mly (revision 13003)
++++ parsing/parser.mly (working copy)
+@@ -967,7 +967,7 @@
+ | FUNCTION opt_bar match_cases
+ { 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])) }
++ { let (l,o,p) = $2 in mkexp(Pexp_function(l, o, [([],p), $3])) }
+ | FUN LPAREN TYPE LIDENT RPAREN fun_def
+ { mkexp(Pexp_newtype($4, $6)) }
+ | MATCH seq_expr WITH opt_bar match_cases
+@@ -1187,18 +1187,18 @@
+ EQUAL seq_expr
+ { $2 }
+ | labeled_simple_pattern fun_binding
+- { let (l, o, p) = $1 in ghexp(Pexp_function(l, o, [p, $2])) }
++ { let (l, o, p) = $1 in ghexp(Pexp_function(l, o, [([],p), $2])) }
+ | LPAREN TYPE LIDENT RPAREN fun_binding
+ { mkexp(Pexp_newtype($3, $5)) }
+ ;
+ match_cases:
+- pattern match_action { [$1, $2] }
+- | match_cases BAR pattern match_action { ($3, $4) :: $1 }
++ match_pattern match_action { [$1, $2] }
++ | match_cases BAR match_pattern match_action { ($3, $4) :: $1 }
+ ;
+ fun_def:
+ match_action { $1 }
+ | labeled_simple_pattern fun_def
+- { let (l,o,p) = $1 in ghexp(Pexp_function(l, o, [p, $2])) }
++ { let (l,o,p) = $1 in ghexp(Pexp_function(l, o, [([],p), $2])) }
+ | LPAREN TYPE LIDENT RPAREN fun_def
+ { mkexp(Pexp_newtype($3, $5)) }
+ ;
+@@ -1245,6 +1245,10 @@
+
+ /* Patterns */
+
++match_pattern:
++ pattern { [], $1 }
++ | TYPE lident_list DOT pattern { $2, $4 }
++;
+ pattern:
+ simple_pattern
+ { $1 }
+Index: parsing/parsetree.mli
+===================================================================
+--- parsing/parsetree.mli (revision 13003)
++++ parsing/parsetree.mli (working copy)
+@@ -90,10 +90,11 @@
+ 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_function of
++ label * expression option * ((string list * 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_match of expression * ((string list * pattern) * expression) list
++ | Pexp_try of expression * ((string list * pattern) * expression) list
+ | Pexp_tuple of expression list
+ | Pexp_construct of Longident.t loc * expression option * bool
+ | Pexp_variant of label * expression option
+@@ -104,7 +105,8 @@
+ | 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_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
+Index: parsing/printast.ml
+===================================================================
+--- parsing/printast.ml (revision 13003)
++++ parsing/printast.ml (working copy)
+@@ -686,8 +686,9 @@
+ line i ppf "%a\n" fmt_longident li;
+ pattern (i+1) ppf p;
+
+-and pattern_x_expression_case i ppf (p, e) =
++and pattern_x_expression_case i ppf ((l,p), e) =
+ line i ppf "<case>\n";
++ list (i+1) string ppf l;
+ pattern (i+1) ppf p;
+ expression (i+1) ppf e;
+
--- /dev/null
+(* $Id$ *)
+
+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
--- /dev/null
+Index: Changes
+===================================================================
+--- Changes (revision 13157)
++++ Changes (working copy)
+@@ -1,6 +1,11 @@
+ Next version
+ ------------
+
++Type system:
++- Propagate type information towards pattern-matching, even in the presence
++ of polymorphic variants (discarding only information about possibly-present
++ constructors)
++
+ Compilers:
+ - PR#5861: raise an error when multiple private keywords are used in type declarations
+ - PR#5634: parsetree rewriter (-ppx flag)
+Index: typing/typecore.ml
+===================================================================
+--- typing/typecore.ml (revision 13157)
++++ typing/typecore.ml (working copy)
+@@ -326,7 +326,7 @@
+ | _ -> assert false
+ in
+ begin match row_field tag row with
+- | Rabsent -> assert false
++ | 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 ->
+@@ -1657,6 +1657,28 @@
+ sexp unpacks
+
+ (* Helpers for type_cases *)
++
++let contains_variant_either ty =
++ let rec loop ty =
++ let ty = repr ty in
++ if ty.level >= lowest_level then begin
++ mark_type_node ty;
++ match ty.desc with
++ Tvariant row ->
++ let row = row_repr row in
++ if not row.row_fixed then
++ List.iter
++ (fun (_,f) ->
++ match row_field_repr f with Reither _ -> raise Exit | _ -> ())
++ row.row_fields;
++ iter_row loop row
++ | _ ->
++ iter_type_expr loop ty
++ end
++ in
++ try loop ty; unmark_type ty; false
++ with Exit -> unmark_type ty; true
++
+ let iter_ppat f p =
+ match p.ppat_desc with
+ | Ppat_any | Ppat_var _ | Ppat_constant _
+@@ -1690,6 +1712,24 @@
+ in
+ try loop p; false with Exit -> true
+
++let check_absent_variant env =
++ iter_pattern
++ (function {pat_desc = Tpat_variant (s, arg, row)} as pat ->
++ let row = row_repr !row in
++ if List.exists (fun (s',fi) -> s = s' && row_field_repr fi <> Rabsent)
++ row.row_fields
++ then () else
++ let ty_arg =
++ match arg with None -> [] | Some p -> [correct_levels p.pat_type] in
++ let row' = {row_fields = [s, Reither(arg=None,ty_arg,true,ref None)];
++ row_more = newvar (); row_bound = ();
++ row_closed = false; row_fixed = false; row_name = None} in
++ (* Should fail *)
++ unify_pat env {pat with pat_type = newty (Tvariant row')}
++ (correct_levels pat.pat_type)
++ | _ -> ())
++
++
+ let dummy_expr = {pexp_desc = Pexp_tuple []; pexp_loc = Location.none}
+
+ (* Duplicate types of values in the environment *)
+@@ -3037,16 +3077,20 @@
+
+ and type_cases ?in_function env ty_arg ty_res partial_flag loc caselist =
+ (* ty_arg is _fully_ generalized *)
+- let dont_propagate, has_gadts =
+- let patterns = List.map fst caselist in
+- List.exists contains_polymorphic_variant patterns,
+- List.exists (contains_gadt env) patterns in
++ let patterns = List.map fst caselist in
++ let erase_either =
++ List.exists contains_polymorphic_variant patterns
++ && contains_variant_either ty_arg
++ and has_gadts = List.exists (contains_gadt env) patterns in
+ (* prerr_endline ( if has_gadts then "contains gadt" else "no gadt"); *)
+- let ty_arg, ty_res, env =
++ let ty_arg =
++ if (has_gadts || erase_either) && not !Clflags.principal
++ then correct_levels ty_arg else ty_arg
++ and ty_res, env =
+ if has_gadts && not !Clflags.principal then
+- correct_levels ty_arg, correct_levels ty_res,
+- duplicate_ident_types loc caselist env
+- else ty_arg, ty_res, env in
++ correct_levels ty_res, duplicate_ident_types loc caselist env
++ else ty_res, env
++ in
+ let lev, env =
+ if has_gadts then begin
+ (* raise level for existentials *)
+@@ -3072,10 +3116,10 @@
+ let scope = Some (Annot.Idef loc) in
+ let (pat, ext_env, force, unpacks) =
+ let partial =
+- if !Clflags.principal then Some false else None in
+- let ty_arg =
+- if dont_propagate then newvar () else instance ?partial env ty_arg
+- in type_pattern ~lev env spat scope ty_arg
++ if !Clflags.principal || erase_either
++ then Some false else None in
++ let ty_arg = instance ?partial env ty_arg in
++ type_pattern ~lev env spat scope ty_arg
+ in
+ pattern_force := force @ !pattern_force;
+ let pat =
+@@ -3134,7 +3178,11 @@
+ else
+ Partial
+ in
+- add_delayed_check (fun () -> Parmatch.check_unused env cases);
++ add_delayed_check
++ (fun () ->
++ List.iter (fun (pat, (env, _)) -> check_absent_variant env pat)
++ pat_env_list;
++ Parmatch.check_unused env cases);
+ if has_gadts then begin
+ end_def ();
+ (* Ensure that existential types do not escape *)
+Index: typing/ctype.ml
+===================================================================
+--- typing/ctype.ml (revision 13157)
++++ typing/ctype.ml (working copy)
+@@ -981,6 +981,25 @@
+ if keep then more else newty more.desc
+ | _ -> assert false
+ 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 *)
+Index: testsuite/tests/typing-gadts/test.ml.reference
+===================================================================
+--- testsuite/tests/typing-gadts/test.ml.reference (revision 13157)
++++ testsuite/tests/typing-gadts/test.ml.reference (working copy)
+@@ -62,11 +62,11 @@
+ ^^^^^^^^
+ Error: This pattern matches values of type int t
+ but a pattern was expected which matches values of type s t
+-# Characters 224-237:
+- | `A, BoolLit _ -> ()
+- ^^^^^^^^^^^^^
+-Error: This pattern matches values of type ([? `A ] as 'a) * bool t
+- but a pattern was expected which matches values of type 'a * int t
++# 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
+Index: testsuite/tests/typing-gadts/test.ml.principal.reference
+===================================================================
+--- testsuite/tests/typing-gadts/test.ml.principal.reference (revision 13157)
++++ testsuite/tests/typing-gadts/test.ml.principal.reference (working copy)
+@@ -62,11 +62,11 @@
+ ^^^^^^^^
+ Error: This pattern matches values of type int t
+ but a pattern was expected which matches values of type s t
+-# Characters 224-237:
+- | `A, BoolLit _ -> ()
+- ^^^^^^^^^^^^^
+-Error: This pattern matches values of type ([? `A ] as 'a) * bool t
+- but a pattern was expected which matches values of type 'a * int t
++# 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
+ ^
--- /dev/null
+Index: parsing/printast.mli
+===================================================================
+--- parsing/printast.mli (revision 13955)
++++ parsing/printast.mli (working copy)
+@@ -16,3 +16,4 @@
+ val interface : formatter -> signature_item list -> unit;;
+ val implementation : formatter -> structure_item list -> unit;;
+ val top_phrase : formatter -> toplevel_phrase -> unit;;
++val string_of_kind : ident_kind -> string;;
+Index: parsing/pprintast.ml
+===================================================================
+--- parsing/pprintast.ml (revision 13955)
++++ parsing/pprintast.ml (working copy)
+@@ -1192,8 +1192,10 @@
+ | 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))
++ | Pdir_ident {txt=li} -> pp f "@ %a" self#longident li
++ | Pdir_bool (b) -> pp f "@ %s" (string_of_bool b)
++ | Pdir_show (k, {txt=li}) ->
++ pp f "@ %s %a" (Printast.string_of_kind k) self#longident li)
+
+ method toplevel_phrase f x =
+ match x with
+Index: parsing/parser.mly
+===================================================================
+--- parsing/parser.mly (revision 13955)
++++ parsing/parser.mly (working copy)
+@@ -516,9 +516,9 @@
+ | SEMISEMI EOF { [] }
+ | 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 }
+- | toplevel_directive use_file_tail { $1 :: $2 }
++ | SEMISEMI toplevel_directive SEMISEMI use_file_tail { $2 :: $4 }
++ | toplevel_directive SEMISEMI use_file_tail { $1 :: $3 }
+ ;
+
+ /* Module expressions */
+@@ -1779,16 +1779,26 @@
+ | FALSE { Lident "false" }
+ | TRUE { Lident "true" }
+ ;
++ident_kind:
++ VAL { Pkind_val }
++ | TYPE { Pkind_type }
++ | EXCEPTION { Pkind_exception }
++ | MODULE { Pkind_module }
++ | MODULE TYPE { Pkind_modtype }
++ | CLASS { Pkind_class }
++ | CLASS TYPE { Pkind_cltype }
++;
+
+ /* Toplevel directives */
+
+ toplevel_directive:
+- SHARP ident { Ptop_dir($2, Pdir_none) }
+- | SHARP ident STRING { Ptop_dir($2, Pdir_string $3) }
+- | SHARP ident INT { Ptop_dir($2, Pdir_int $3) }
+- | SHARP ident val_longident { Ptop_dir($2, Pdir_ident $3) }
+- | SHARP ident FALSE { Ptop_dir($2, Pdir_bool false) }
+- | SHARP ident TRUE { Ptop_dir($2, Pdir_bool true) }
++ SHARP ident { Ptop_dir($2, Pdir_none) }
++ | SHARP ident STRING { Ptop_dir($2, Pdir_string $3) }
++ | SHARP ident INT { Ptop_dir($2, Pdir_int $3) }
++ | SHARP ident val_longident { Ptop_dir($2, Pdir_ident (mkrhs $3 3)) }
++ | SHARP ident ident_kind any_longident { Ptop_dir($2, Pdir_show ($3, mkrhs $4 4)) }
++ | SHARP ident FALSE { Ptop_dir($2, Pdir_bool false) }
++ | SHARP ident TRUE { Ptop_dir($2, Pdir_bool true) }
+ ;
+
+ /* Miscellaneous */
+Index: parsing/parsetree.mli
+===================================================================
+--- parsing/parsetree.mli (revision 13955)
++++ parsing/parsetree.mli (working copy)
+@@ -294,6 +294,15 @@
+
+ (* Toplevel phrases *)
+
++type ident_kind =
++ Pkind_val
++ | Pkind_type
++ | Pkind_exception
++ | Pkind_module
++ | Pkind_modtype
++ | Pkind_class
++ | Pkind_cltype
++
+ type toplevel_phrase =
+ Ptop_def of structure
+ | Ptop_dir of string * directive_argument
+@@ -302,5 +311,6 @@
+ Pdir_none
+ | Pdir_string of string
+ | Pdir_int of int
+- | Pdir_ident of Longident.t
++ | Pdir_ident of Longident.t Location.loc
++ | Pdir_show of ident_kind * Longident.t Location.loc
+ | Pdir_bool of bool
+Index: parsing/printast.ml
+===================================================================
+--- parsing/printast.ml (revision 13955)
++++ parsing/printast.ml (working copy)
+@@ -737,6 +737,16 @@
+ core_type (i+1) ppf ct
+ ;;
+
++let string_of_kind = function
++ Pkind_val -> "val"
++ | Pkind_type -> "type"
++ | Pkind_exception -> "exception"
++ | Pkind_module -> "module"
++ | Pkind_modtype -> "module type"
++ | Pkind_class -> "class"
++ | Pkind_cltype -> "class type"
++;;
++
+ let rec toplevel_phrase i ppf x =
+ match x with
+ | Ptop_def (s) ->
+@@ -751,7 +761,9 @@
+ | Pdir_none -> line i ppf "Pdir_none\n"
+ | Pdir_string (s) -> line i ppf "Pdir_string \"%s\"\n" s;
+ | Pdir_int (i) -> line i ppf "Pdir_int %d\n" i;
+- | Pdir_ident (li) -> line i ppf "Pdir_ident %a\n" fmt_longident li;
++ | Pdir_ident {txt=li} -> line i ppf "Pdir_ident %a\n" fmt_longident li;
++ | Pdir_show (kind,{txt=li}) ->
++ line i ppf "Pdir_show %s %a\n" (string_of_kind kind) fmt_longident li;
+ | Pdir_bool (b) -> line i ppf "Pdir_bool %s\n" (string_of_bool b);
+ ;;
+
+Index: toplevel/opttoploop.ml
+===================================================================
+--- toplevel/opttoploop.ml (revision 13955)
++++ toplevel/opttoploop.ml (working copy)
+@@ -53,6 +53,7 @@
+ | Directive_string of (string -> unit)
+ | Directive_int of (int -> unit)
+ | Directive_ident of (Longident.t -> unit)
++ | Directive_show of (ident_kind -> Longident.t -> unit)
+ | Directive_bool of (bool -> unit)
+
+
+@@ -270,6 +271,7 @@
+ | (Directive_string f, Pdir_string s) -> f s; true
+ | (Directive_int f, Pdir_int n) -> f n; true
+ | (Directive_ident f, Pdir_ident lid) -> f lid; true
++ | (Directive_show f, Pdir_show (kind,lid)) -> f kind lid; true
+ | (Directive_bool f, Pdir_bool b) -> f b; true
+ | (_, _) ->
+ fprintf ppf "Wrong type of argument for directive `%s'.@." dir_name;
+Index: toplevel/topdirs.ml
+===================================================================
+--- toplevel/topdirs.ml (revision 13955)
++++ toplevel/topdirs.ml (working copy)
+@@ -15,6 +15,7 @@
+ open Format
+ open Misc
+ open Longident
++open Parsetree
+ open Types
+ open Cmo_format
+ open Trace
+@@ -191,9 +192,9 @@
+ Ctype.generalize ty_arg;
+ ty_arg
+
+-let find_printer_type ppf lid =
++let find_printer_type ppf {Location.loc; txt=lid} =
+ try
+- let (path, desc) = Env.lookup_value lid !toplevel_env in
++ let (path, desc) = Typetexp.find_value !toplevel_env loc lid in
+ let (ty_arg, is_old_style) =
+ try
+ (match_printer_type ppf desc "printer_type_new", false)
+@@ -201,12 +202,12 @@
+ (match_printer_type ppf desc "printer_type_old", true) in
+ (ty_arg, path, is_old_style)
+ with
+- | Not_found ->
+- fprintf ppf "Unbound value %a.@." Printtyp.longident lid;
++ Typetexp.Error _ as exn ->
++ Errors.report_error ppf exn;
+ raise Exit
+ | Ctype.Unify _ ->
+ fprintf ppf "%a has a wrong type for a printing function.@."
+- Printtyp.longident lid;
++ Printtyp.longident lid;
+ raise Exit
+
+ let dir_install_printer ppf lid =
+@@ -227,7 +228,7 @@
+ begin try
+ remove_printer path
+ with Not_found ->
+- fprintf ppf "No printer named %a.@." Printtyp.longident lid
++ fprintf ppf "No printer named %a.@." Printtyp.longident lid.Location.txt
+ end
+ with Exit -> ()
+
+@@ -244,9 +245,9 @@
+ get_code_pointer
+ (Obj.repr (fun arg -> Trace.print_trace (current_environment()) arg))
+
+-let dir_trace ppf lid =
++let dir_trace ppf {Location.loc; txt=lid} =
+ try
+- let (path, desc) = Env.lookup_value lid !toplevel_env in
++ let (path, desc) = Typetexp.find_value !toplevel_env loc lid in
+ (* Check if this is a primitive *)
+ match desc.val_kind with
+ | Val_prim p ->
+@@ -278,11 +279,11 @@
+ fprintf ppf "%a is now traced.@." Printtyp.longident lid
+ end else fprintf ppf "%a is not a function.@." Printtyp.longident lid
+ with
+- | Not_found -> fprintf ppf "Unbound value %a.@." Printtyp.longident lid
++ Typetexp.Error _ as exn -> Errors.report_error ppf exn
+
+-let dir_untrace ppf lid =
++let dir_untrace ppf {Location.loc; txt=lid} =
+ try
+- let (path, desc) = Env.lookup_value lid !toplevel_env in
++ let (path, desc) = Typetexp.find_value !toplevel_env loc lid in
+ let rec remove = function
+ | [] ->
+ fprintf ppf "%a was not traced.@." Printtyp.longident lid;
+@@ -295,7 +296,7 @@
+ end else f :: remove rem in
+ traced_functions := remove !traced_functions
+ with
+- | Not_found -> fprintf ppf "Unbound value %a.@." Printtyp.longident lid
++ Typetexp.Error _ as exn -> Errors.report_error ppf exn
+
+ let dir_untrace_all ppf () =
+ List.iter
+@@ -305,10 +306,74 @@
+ !traced_functions;
+ traced_functions := []
+
++(* Warnings *)
++
+ let parse_warnings ppf iserr s =
+ try Warnings.parse_options iserr s
+ with Arg.Bad err -> fprintf ppf "%s.@." err
+
++(* Typing information *)
++
++let rec trim_modtype = function
++ Mty_signature _ -> Mty_signature []
++ | Mty_functor (id, mty, mty') ->
++ Mty_functor (id, mty, trim_modtype mty')
++ | Mty_ident _ as mty -> mty
++
++let trim_signature = function
++ Mty_signature sg ->
++ Mty_signature
++ (List.map
++ (function
++ Sig_module (id, mty, rs) ->
++ Sig_module (id, trim_modtype mty, rs)
++ (*| Sig_modtype (id, Modtype_manifest mty) ->
++ Sig_modtype (id, Modtype_manifest (trim_modtype mty))*)
++ | item -> item)
++ sg)
++ | mty -> mty
++
++let dir_show ppf kind {Location.loc; txt=lid} =
++ let env = !Toploop.toplevel_env in
++ try
++ let id =
++ let s = match lid with
++ Longident.Lident s -> s
++ | Longident.Ldot (_,s) -> s
++ | Longident.Lapply _ -> failwith "invalid"
++ in Ident.create_persistent s
++ in
++ let item =
++ match kind with
++ Pkind_val ->
++ let path, desc = Typetexp.find_value env loc lid in
++ Sig_value (id, desc)
++ | Pkind_type ->
++ let path, desc = Typetexp.find_type env loc lid in
++ Sig_type (id, desc, Trec_not)
++ | Pkind_exception ->
++ let desc = Typetexp.find_constructor env loc lid in
++ Sig_exception (id, {exn_args=desc.cstr_args; exn_loc=Location.none})
++ | Pkind_module ->
++ let path, desc = Typetexp.find_module env loc lid in
++ Sig_module (id, trim_signature desc, Trec_not)
++ | Pkind_modtype ->
++ let path, desc = Typetexp.find_modtype env loc lid in
++ Sig_modtype (id, desc)
++ | Pkind_class ->
++ let path, desc = Typetexp.find_class env loc lid in
++ Sig_class (id, desc, Trec_not)
++ | Pkind_cltype ->
++ let path, desc = Typetexp.find_class_type env loc lid in
++ Sig_class_type (id, desc, Trec_not)
++ in
++ fprintf ppf "%a@." Printtyp.signature [item]
++ with
++ Not_found ->
++ fprintf ppf "Unknown %s.@." (Printast.string_of_kind kind)
++ | Failure "invalid" ->
++ fprintf ppf "Invalid path %a@." Printtyp.longident lid
++
+ let _ =
+ Hashtbl.add directive_table "trace" (Directive_ident (dir_trace std_out));
+ Hashtbl.add directive_table "untrace" (Directive_ident (dir_untrace std_out));
+@@ -337,4 +402,7 @@
+ (Directive_string (parse_warnings std_out false));
+
+ Hashtbl.add directive_table "warn_error"
+- (Directive_string (parse_warnings std_out true))
++ (Directive_string (parse_warnings std_out true));
++
++ Hashtbl.add directive_table "show"
++ (Directive_show (dir_show std_out))
+Index: toplevel/toploop.ml
+===================================================================
+--- toplevel/toploop.ml (revision 13955)
++++ toplevel/toploop.ml (working copy)
+@@ -25,7 +25,8 @@
+ | Directive_none of (unit -> unit)
+ | Directive_string of (string -> unit)
+ | Directive_int of (int -> unit)
+- | Directive_ident of (Longident.t -> unit)
++ | Directive_ident of (Longident.t Location.loc -> unit)
++ | Directive_show of (ident_kind -> Longident.t Location.loc -> unit)
+ | Directive_bool of (bool -> unit)
+
+ (* The table of toplevel value bindings and its accessors *)
+@@ -280,6 +281,7 @@
+ | (Directive_string f, Pdir_string s) -> f s; true
+ | (Directive_int f, Pdir_int n) -> f n; true
+ | (Directive_ident f, Pdir_ident lid) -> f lid; true
++ | (Directive_show f, Pdir_show (kind,lid)) -> f kind lid; true
+ | (Directive_bool f, Pdir_bool b) -> f b; true
+ | (_, _) ->
+ fprintf ppf "Wrong type of argument for directive `%s'.@." dir_name;
+Index: toplevel/topdirs.mli
+===================================================================
+--- toplevel/topdirs.mli (revision 13955)
++++ toplevel/topdirs.mli (working copy)
+@@ -20,11 +20,12 @@
+ val dir_cd : string -> unit
+ val dir_load : formatter -> string -> unit
+ val dir_use : formatter -> string -> unit
+-val dir_install_printer : formatter -> Longident.t -> unit
+-val dir_remove_printer : formatter -> Longident.t -> unit
+-val dir_trace : formatter -> Longident.t -> unit
+-val dir_untrace : formatter -> Longident.t -> unit
++val dir_install_printer : formatter -> Longident.t Location.loc -> unit
++val dir_remove_printer : formatter -> Longident.t Location.loc -> unit
++val dir_trace : formatter -> Longident.t Location.loc -> unit
++val dir_untrace : formatter -> Longident.t Location.loc -> unit
+ val dir_untrace_all : formatter -> unit -> unit
++val dir_show : formatter -> Parsetree.ident_kind -> Longident.t Location.loc -> unit
+
+ type 'a printer_type_new = Format.formatter -> 'a -> unit
+ type 'a printer_type_old = 'a -> unit
+Index: toplevel/toploop.mli
+===================================================================
+--- toplevel/toploop.mli (revision 13955)
++++ toplevel/toploop.mli (working copy)
+@@ -37,7 +37,8 @@
+ | Directive_none of (unit -> unit)
+ | Directive_string of (string -> unit)
+ | Directive_int of (int -> unit)
+- | Directive_ident of (Longident.t -> unit)
++ | Directive_ident of (Longident.t Location.loc -> unit)
++ | Directive_show of (Parsetree.ident_kind -> Longident.t Location.loc -> unit)
+ | Directive_bool of (bool -> unit)
+
+ val directive_table : (string, directive_fun) Hashtbl.t
+Index: tools/Makefile.shared
+===================================================================
+--- tools/Makefile.shared (revision 13955)
++++ tools/Makefile.shared (working copy)
+@@ -210,6 +210,7 @@
+ ../parsing/location.cmo \
+ ../parsing/longident.cmo \
+ ../parsing/lexer.cmo \
++ ../parsing/printast.cmo \
+ ../parsing/pprintast.cmo \
+ ../typing/ident.cmo \
+ ../typing/path.cmo \
+Index: camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml
+===================================================================
+--- camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml (revision 13955)
++++ camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml (working copy)
+@@ -1229,7 +1229,7 @@
+ | ExInt _ i -> Pdir_int (int_of_string i)
+ | <:expr< True >> -> Pdir_bool True
+ | <:expr< False >> -> Pdir_bool False
+- | e -> Pdir_ident (ident_noloc (ident_of_expr e)) ]
++ | e -> Pdir_ident (ident (ident_of_expr e)) ]
+ ;
+
+ value phrase =
+Index: camlp4/boot/Camlp4.ml
+===================================================================
+--- camlp4/boot/Camlp4.ml (revision 13955)
++++ camlp4/boot/Camlp4.ml (working copy)
+@@ -15686,7 +15686,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_noloc (ident_of_expr e))
++ | e -> Pdir_ident (ident (ident_of_expr e))
+
+ let phrase =
+ function
--- /dev/null
+(* $Id$ *)
+
+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"
--- /dev/null
+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 ]
+ ;
+
--- /dev/null
+Index: VERSION
+===================================================================
+--- VERSION (リビジョン 11207)
++++ VERSION (作æ¥ã‚³ãƒ”ー)
+@@ -1,4 +1,4 @@
+-3.13.0+dev6 (2011-07-29)
++3.13.0+dev7 (2011-09-22)
+
+ # The version string is the first line of this file.
+ # It must be in the format described in stdlib/sys.mli
+Index: typing/typemod.ml
+===================================================================
+--- typing/typemod.ml (リビジョン 11207)
++++ typing/typemod.ml (作æ¥ã‚³ãƒ”ー)
+@@ -764,7 +764,7 @@
+ Location.prerr_warning smod.pmod_loc
+ (Warnings.Not_principal "this module unpacking");
+ modtype_of_package env smod.pmod_loc p nl tl
+- | {desc = Tvar} ->
++ | {desc = Tvar _} ->
+ raise (Typecore.Error
+ (smod.pmod_loc, Typecore.Cannot_infer_signature))
+ | _ ->
+Index: typing/typetexp.ml
+===================================================================
+--- typing/typetexp.ml (リビジョン 11207)
++++ typing/typetexp.ml (作æ¥ã‚³ãƒ”ー)
+@@ -150,7 +150,7 @@
+ if strict then raise Already_bound;
+ v
+ with Not_found ->
+- let v = new_global_var() in
++ let v = new_global_var ~name () in
+ type_variables := Tbl.add name v !type_variables;
+ v
+
+@@ -165,8 +165,8 @@
+ Tpoly _ -> ty
+ | _ -> Ctype.newty (Tpoly (ty, []))
+
+-let new_pre_univar () =
+- let v = newvar () in pre_univars := v :: !pre_univars; v
++let new_pre_univar ?name () =
++ let v = newvar ?name () in pre_univars := v :: !pre_univars; v
+
+ let rec swap_list = function
+ x :: y :: l -> y :: x :: swap_list l
+@@ -190,7 +190,8 @@
+ instance (fst(Tbl.find name !used_variables))
+ with Not_found ->
+ let v =
+- if policy = Univars then new_pre_univar () else newvar () in
++ if policy = Univars then new_pre_univar ~name () else newvar ~name ()
++ in
+ used_variables := Tbl.add name (v, styp.ptyp_loc) !used_variables;
+ v
+ end
+@@ -333,7 +334,14 @@
+ end_def ();
+ generalize_structure t;
+ end;
+- instance t
++ let t = instance t in
++ let px = Btype.proxy t in
++ begin match px.desc with
++ | Tvar None -> Btype.log_type px; px.desc <- Tvar (Some alias)
++ | Tunivar None -> Btype.log_type px; px.desc <- Tunivar (Some alias)
++ | _ -> ()
++ end;
++ t
+ end
+ | Ptyp_variant(fields, closed, present) ->
+ let name = ref None in
+@@ -388,7 +396,7 @@
+ {desc=Tvariant row}, _ when Btype.static_row row ->
+ let row = Btype.row_repr row in
+ row.row_fields
+- | {desc=Tvar}, Some(p, _) ->
++ | {desc=Tvar _}, Some(p, _) ->
+ raise(Error(sty.ptyp_loc, Unbound_type_constructor_2 p))
+ | _ ->
+ raise(Error(sty.ptyp_loc, Not_a_variant ty))
+@@ -431,7 +439,7 @@
+ newty (Tvariant row)
+ | Ptyp_poly(vars, st) ->
+ begin_def();
+- let new_univars = List.map (fun name -> name, newvar()) vars in
++ let new_univars = List.map (fun name -> name, newvar ~name ()) vars in
+ let old_univars = !univars in
+ univars := new_univars @ !univars;
+ let ty = transl_type env policy st in
+@@ -443,10 +451,12 @@
+ (fun tyl (name, ty1) ->
+ let v = Btype.proxy ty1 in
+ if deep_occur v ty then begin
+- if v.level <> Btype.generic_level || v.desc <> Tvar then
+- raise (Error (styp.ptyp_loc, Cannot_quantify (name, v)));
+- v.desc <- Tunivar;
+- v :: tyl
++ match v.desc with
++ Tvar name when v.level = Btype.generic_level ->
++ v.desc <- Tunivar name;
++ v :: tyl
++ | _ ->
++ raise (Error (styp.ptyp_loc, Cannot_quantify (name, v)))
+ end else tyl)
+ [] new_univars
+ in
+@@ -483,7 +493,7 @@
+ match ty.desc with
+ | Tvariant row ->
+ let row = Btype.row_repr row in
+- if (Btype.row_more row).desc = Tunivar then
++ if Btype.is_Tunivar (Btype.row_more row) then
+ ty.desc <- Tvariant
+ {row with row_fixed=true;
+ row_fields = List.map
+@@ -512,7 +522,7 @@
+ then try
+ r := (loc, v, Tbl.find name !type_variables) :: !r
+ with Not_found ->
+- if fixed && (repr ty).desc = Tvar then
++ if fixed && Btype.is_Tvar (repr ty) then
+ raise(Error(loc, Unbound_type_variable ("'"^name)));
+ let v2 = new_global_var () in
+ r := (loc, v, v2) :: !r;
+@@ -552,8 +562,10 @@
+ List.fold_left
+ (fun acc v ->
+ let v = repr v in
+- if v.level <> Btype.generic_level || v.desc <> Tvar then acc
+- else (v.desc <- Tunivar ; v :: acc))
++ match v.desc with
++ Tvar name when v.level = Btype.generic_level ->
++ v.desc <- Tunivar name; v :: acc
++ | _ -> acc)
+ [] !pre_univars
+ in
+ make_fixed_univars typ;
+@@ -635,8 +647,8 @@
+ fprintf ppf "The type variable name %s is not allowed in programs" name
+ | Cannot_quantify (name, v) ->
+ fprintf ppf "This type scheme cannot quantify '%s :@ %s." name
+- (if v.desc = Tvar then "it escapes this scope" else
+- if v.desc = Tunivar then "it is aliased to another variable"
++ (if Btype.is_Tvar v then "it escapes this scope" else
++ if Btype.is_Tunivar v then "it is aliased to another variable"
+ else "it is not a variable")
+ | Multiple_constraints_on_type s ->
+ fprintf ppf "Multiple constraints for type %s" s
+Index: typing/btype.ml
+===================================================================
+--- typing/btype.ml (リビジョン 11207)
++++ typing/btype.ml (作æ¥ã‚³ãƒ”ー)
+@@ -35,9 +35,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 }
+@@ -46,6 +46,11 @@
+ { 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
++
+ (**** Representative of a type ****)
+
+ let rec field_kind_repr =
+@@ -139,7 +144,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
+@@ -180,13 +185,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 _ ->
+ 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
+@@ -198,7 +203,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
+
+@@ -239,13 +244,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
++ Tvar _ -> Tvar None (* forget the name *)
+ | 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)
+@@ -258,7 +263,7 @@
+ | Tnil -> Tnil
+ | Tlink ty -> copy_type_desc f ty.desc
+ | Tsubst ty -> assert false
+- | Tunivar -> Tunivar
++ | Tunivar _ as ty -> ty (* keep the name *)
+ | Tpoly (ty, tyl) ->
+ let tyl = List.map (fun x -> norm_univar (f x)) tyl in
+ Tpoly (f ty, tyl)
+@@ -447,7 +452,7 @@
+ | Cuniv of type_expr option ref * type_expr option
+
+ 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
+@@ -474,7 +479,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 =
+Index: typing/typecore.ml
+===================================================================
+--- typing/typecore.ml (リビジョン 11207)
++++ typing/typecore.ml (作æ¥ã‚³ãƒ”ー)
+@@ -633,7 +633,7 @@
+ List.iter generalize vars;
+ let instantiated tv =
+ let tv = expand_head !env tv in
+- tv.desc <> Tvar || tv.level <> generic_level in
++ not (is_Tvar tv) || tv.level <> generic_level in
+ if List.exists instantiated vars then
+ raise (Error(loc, Polymorphic_label (lid_of_label label)))
+ end;
+@@ -1126,7 +1126,7 @@
+ Tarrow (l, _, ty_res, _) ->
+ list_labels_aux env (ty::visited) (l::ls) ty_res
+ | _ ->
+- List.rev ls, ty.desc = Tvar
++ List.rev ls, is_Tvar ty
+
+ let list_labels env ty = list_labels_aux env [] [] ty
+
+@@ -1142,9 +1142,10 @@
+ (fun t ->
+ let t = repr t in
+ generalize t;
+- if t.desc = Tvar && t.level = generic_level then
+- (log_type t; t.desc <- Tunivar; true)
+- else false)
++ match t.desc with
++ Tvar name when t.level = generic_level ->
++ log_type t; t.desc <- Tunivar name; true
++ | _ -> false)
+ vars in
+ if List.length vars = List.length vars' then () else
+ let ty = newgenty (Tpoly(repr exp.exp_type, vars'))
+@@ -1158,7 +1159,7 @@
+ match (expand_head env exp.exp_type).desc with
+ | Tarrow _ ->
+ Location.prerr_warning exp.exp_loc Warnings.Partial_application
+- | Tvar -> ()
++ | Tvar _ -> ()
+ | Tconstr (p, _, _) when Path.same p Predef.path_unit -> ()
+ | _ ->
+ if statement then
+@@ -1742,7 +1743,7 @@
+ let (id, typ) =
+ filter_self_method env met Private meths privty
+ in
+- if (repr typ).desc = Tvar then
++ if is_Tvar (repr typ) then
+ Location.prerr_warning loc
+ (Warnings.Undeclared_virtual_method met);
+ (Texp_send(obj, Tmeth_val id), typ)
+@@ -1797,7 +1798,7 @@
+ Location.prerr_warning loc
+ (Warnings.Not_principal "this use of a polymorphic method");
+ snd (instance_poly false tl ty)
+- | {desc = Tvar} as ty ->
++ | {desc = Tvar _} as ty ->
+ let ty' = newvar () in
+ unify env (instance ty) (newty(Tpoly(ty',[])));
+ (* if not !Clflags.nolabels then
+@@ -1979,7 +1980,7 @@
+ end_def ();
+ check_univars env false "method" exp ty_expected vars;
+ re { exp with exp_type = instance ty }
+- | Tvar ->
++ | Tvar _ ->
+ let exp = type_exp env sbody in
+ let exp = {exp with exp_type = newty (Tpoly (exp.exp_type, []))} in
+ unify_exp env exp ty;
+@@ -2038,7 +2039,7 @@
+ Location.prerr_warning loc
+ (Warnings.Not_principal "this module packing");
+ (p, nl, tl)
+- | {desc = Tvar} ->
++ | {desc = Tvar _} ->
+ raise (Error (loc, Cannot_infer_signature))
+ | _ ->
+ raise (Error (loc, Not_a_packed_module ty_expected))
+@@ -2128,7 +2129,7 @@
+ ty_fun
+ | Tarrow (l,_,ty_res',_) when l = "" || !Clflags.classic ->
+ args, ty_fun, no_labels ty_res'
+- | Tvar -> args, ty_fun, false
++ | Tvar _ -> args, ty_fun, false
+ | _ -> [], texp.exp_type, false
+ in
+ let args, ty_fun', simple_res = make_args [] texp.exp_type in
+@@ -2192,7 +2193,7 @@
+ let (ty1, ty2) =
+ let ty_fun = expand_head env ty_fun in
+ match ty_fun.desc with
+- Tvar ->
++ Tvar _ ->
+ let t1 = newvar () and t2 = newvar () in
+ let not_identity = function
+ Texp_ident(_,{val_kind=Val_prim
+@@ -2335,7 +2336,7 @@
+ begin match (expand_head env exp.exp_type).desc with
+ | Tarrow _ ->
+ Location.prerr_warning exp.exp_loc Warnings.Partial_application
+- | Tvar ->
++ | Tvar _ ->
+ add_delayed_check (fun () -> check_application_result env false exp)
+ | _ -> ()
+ end;
+@@ -2404,9 +2405,9 @@
+ | Tarrow _ ->
+ Location.prerr_warning loc Warnings.Partial_application
+ | Tconstr (p, _, _) when Path.same p Predef.path_unit -> ()
+- | Tvar when ty.level > tv.level ->
++ | Tvar _ when ty.level > tv.level ->
+ Location.prerr_warning loc Warnings.Nonreturning_statement
+- | Tvar ->
++ | Tvar _ ->
+ add_delayed_check (fun () -> check_application_result env true exp)
+ | _ ->
+ Location.prerr_warning loc Warnings.Statement_type
+Index: typing/btype.mli
+===================================================================
+--- typing/btype.mli (リビジョン 11207)
++++ typing/btype.mli (作æ¥ã‚³ãƒ”ー)
+@@ -23,7 +23,7 @@
+ (* 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 +33,9 @@
+ (* Return a fresh marked generic variable *)
+ *)
+
++val is_Tvar: type_expr -> bool
++val is_Tunivar: type_expr -> bool
++
+ val repr: type_expr -> type_expr
+ (* Return the canonical representative of a type. *)
+
+Index: typing/ctype.mli
+===================================================================
+--- typing/ctype.mli (リビジョン 11207)
++++ typing/ctype.mli (作æ¥ã‚³ãƒ”ー)
+@@ -41,9 +41,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
+Index: typing/datarepr.ml
+===================================================================
+--- typing/datarepr.ml (リビジョン 11207)
++++ typing/datarepr.ml (作æ¥ã‚³ãƒ”ー)
+@@ -28,7 +28,7 @@
+ if ty.level >= lowest_level then begin
+ ty.level <- pivot_level - ty.level;
+ match ty.desc with
+- | Tvar ->
++ | Tvar _ ->
+ ret := TypeSet.add ty !ret
+ | Tvariant row ->
+ let row = row_repr row in
+Index: typing/typeclass.ml
+===================================================================
+--- typing/typeclass.ml (リビジョン 11207)
++++ typing/typeclass.ml (作æ¥ã‚³ãƒ”ー)
+@@ -532,7 +532,7 @@
+ (Typetexp.transl_simple_type val_env false sty) ty
+ end;
+ begin match (Ctype.repr ty).desc with
+- Tvar ->
++ Tvar _ ->
+ let ty' = Ctype.newvar () in
+ Ctype.unify val_env (Ctype.newty (Tpoly (ty', []))) ty;
+ Ctype.unify val_env (type_approx val_env sbody) ty'
+Index: typing/typedecl.ml
+===================================================================
+--- typing/typedecl.ml (リビジョン 11207)
++++ typing/typedecl.ml (作æ¥ã‚³ãƒ”ー)
+@@ -111,7 +111,7 @@
+ | _ ->
+ raise (Error (loc, Bad_fixed_type "is not an object or variant"))
+ in
+- if rv.desc <> Tvar then
++ if not (Btype.is_Tvar rv) then
+ raise (Error (loc, Bad_fixed_type "has no row variable"));
+ rv.desc <- Tconstr (p, decl.type_params, ref Mnil)
+
+@@ -503,7 +503,7 @@
+ compute_same row.row_more
+ | Tpoly (ty, _) ->
+ compute_same ty
+- | Tvar | Tnil | Tlink _ | Tunivar -> ()
++ | Tvar _ | Tnil | Tlink _ | Tunivar _ -> ()
+ | Tpackage (_, _, tyl) ->
+ List.iter (compute_variance_rec true true true) tyl
+ end
+@@ -546,7 +546,7 @@
+ in
+ List.iter2
+ (fun (ty, co, cn, ct) (c, n) ->
+- if ty.desc <> Tvar then begin
++ if not (Btype.is_Tvar ty) then begin
+ co := c; cn := n; ct := n;
+ compute_variance env tvl2 c n n ty
+ end)
+@@ -571,7 +571,7 @@
+
+ let rec anonymous env ty =
+ match (Ctype.expand_head env ty).desc with
+- | Tvar -> false
++ | Tvar _ -> false
+ | Tobject (fi, _) ->
+ let _, rv = Ctype.flatten_fields fi in anonymous env rv
+ | Tvariant row ->
+Index: typing/types.mli
+===================================================================
+--- typing/types.mli (リビジョン 11207)
++++ typing/types.mli (作æ¥ã‚³ãƒ”ー)
+@@ -24,7 +24,7 @@
+ mutable id: int }
+
+ and type_desc =
+- Tvar
++ Tvar of string option
+ | Tarrow of label * type_expr * type_expr * commutable
+ | Ttuple of type_expr list
+ | Tconstr of Path.t * type_expr list * abbrev_memo ref
+@@ -34,7 +34,7 @@
+ | Tlink of type_expr
+ | Tsubst of type_expr (* for copying *)
+ | Tvariant of row_desc
+- | Tunivar
++ | Tunivar of string option
+ | Tpoly of type_expr * type_expr list
+ | Tpackage of Path.t * string list * type_expr list
+
+Index: typing/ctype.ml
+===================================================================
+--- typing/ctype.ml (リビジョン 11207)
++++ typing/ctype.ml (作æ¥ã‚³ãƒ”ー)
+@@ -153,9 +153,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))
+
+@@ -297,14 +297,12 @@
+
+ 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
++ | Tvar _ -> false
+ | _ -> true
+
+ (**** Close an object ****)
+@@ -313,7 +311,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
+@@ -329,7 +327,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
+@@ -434,7 +432,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
+@@ -468,7 +466,7 @@
+ 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
+@@ -639,7 +637,7 @@
+ 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
+ set_level ty generic_level;
+@@ -858,7 +856,7 @@
+ 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)
++ 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
+@@ -913,7 +911,7 @@
+ if keep then ty.level else !current_level
+ else generic_level
+ in
+- if forget <> generic_level then newty2 forget Tvar else
++ if forget <> generic_level then newty2 forget (Tvar None) else
+ let desc = ty.desc in
+ save_desc ty desc;
+ let t = newvar() in (* Stub *)
+@@ -959,7 +957,7 @@
+ | Tconstr _ ->
+ 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
+@@ -1117,7 +1115,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
+@@ -1134,14 +1132,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
+@@ -1395,7 +1393,7 @@
+ let rec 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
+@@ -1570,8 +1568,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
+@@ -1620,7 +1618,7 @@
+ 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, _) ->
+@@ -1784,7 +1782,7 @@
+ t
+ end;
+ iter_type_expr (iterator visited) ty
+- | Tvar ->
++ | Tvar _ ->
+ let t = create_fresh_constr ty.level false in
+ link_type ty t
+ | _ ->
+@@ -1862,8 +1860,8 @@
+ let t2 = repr t2 in
+ if t1 == t2 then () else
+ match (t1.desc, t2.desc) with
+- | (Tvar, _)
+- | (_, Tvar) ->
++ | (Tvar _, _)
++ | (_, Tvar _) ->
+ fatal_error "types should not include variables"
+ | (Tconstr (p1, [], _), Tconstr (p2, [], _)) when Path.same p1 p2 ->
+ ()
+@@ -1877,7 +1875,7 @@
+ with Not_found ->
+ TypePairs.add type_pairs (t1', t2') ();
+ match (t1'.desc, t2'.desc) with
+- (Tvar, Tvar) ->
++ (Tvar _, Tvar _) ->
+ fatal_error "types should not include variables"
+ | (Tarrow (l1, t1, u1, _), Tarrow (l2, t2, u2, _)) when l1 = l2
+ || !Clflags.classic && not (is_optional l1 || is_optional l2) ->
+@@ -1903,7 +1901,7 @@
+ | (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
+ enter_poly env univar_pairs t1 tl1 t2 tl2
+ (mcomp type_pairs subst env)
+- | (Tunivar, Tunivar) ->
++ | (Tunivar _, Tunivar _) ->
+ unify_univar t1' t2' !univar_pairs
+ | (_, _) ->
+ raise (Unify [])
+@@ -2048,21 +2046,21 @@
+ try
+ type_changed := true;
+ match (t1.desc, t2.desc) with
+- (Tvar, Tconstr _) when deep_occur t1 t2 ->
++ (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, _) ->
++ | (Tvar _, _) ->
+ occur !env t1 t2;
+ occur_univar !env t2;
+ link_type t1 t2;
+ update_level !env t1.level t2
+- | (_, Tvar) ->
++ | (_, Tvar _) ->
+ occur !env t2 t1;
+ occur_univar !env t1;
+ link_type t2 t1;
+ update_level !env t2.level t1
+- | (Tunivar, Tunivar) ->
++ | (Tunivar _, Tunivar _) ->
+ unify_univar t1 t2 !univar_pairs;
+ update_level !env t1.level t2;
+ link_type t1 t2
+@@ -2104,7 +2102,7 @@
+ (* Assumes either [t1 == t1'] or [t2 != t2'] *)
+ let d1 = t1'.desc and d2 = t2'.desc in
+ match (d1, d2) with (* handle univars specially *)
+- (Tunivar, Tunivar) ->
++ (Tunivar _, Tunivar _) ->
+ unify_univar t1' t2' !univar_pairs;
+ update_level !env t1'.level t2';
+ link_type t1' t2'
+@@ -2127,12 +2125,12 @@
+ | Old -> f () (* old_link was already called *)
+ in
+ match d1, d2 with
+- | Tvar,_ ->
++ | Tvar _, _ ->
+ occur !env t1 t2';
+ occur_univar !env t2;
+ update_level !env t1'.level t2;
+ link_type t1' t2;
+- | _, Tvar ->
++ | _, Tvar _ ->
+ occur !env t2 t1';
+ occur_univar !env t1;
+ update_level !env t2'.level t1;
+@@ -2149,8 +2147,8 @@
+ add_type_equality t1' t2' end;
+ try
+ begin match (d1, d2) with
+- | (Tvar, _)
+- | (_, Tvar) ->
++ | (Tvar _, _)
++ | (_, Tvar _) ->
+ (* cases taken care of *)
+ assert false
+ | (Tarrow (l1, t1, u1, c1), Tarrow (l2, t2, u2, c2)) when l1 = l2
+@@ -2214,8 +2212,9 @@
+ (* 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 (_, {contents = Some (_, va::_)}) when
++ (match (repr va).desc with
++ Tvar _|Tunivar _|Tnil -> true | _ -> false) ->
+ ()
+ | Tobject (_, nm2) ->
+ set_name nm2 !nm1
+@@ -2290,16 +2289,32 @@
+ 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;
+@@ -2390,7 +2405,7 @@
+ 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
++ if is_Tvar rm then link_type rm row0.row_more else
+ unify env rm row0.row_more
+ else
+ let ty = newty2 generic_level (Tvariant {row0 with row_fields = rest}) in
+@@ -2489,7 +2504,7 @@
+ let t1 = repr t1 and t2 = repr t2 in
+ if t1 == t2 then () else
+ match t1.desc with
+- Tvar ->
++ Tvar _ ->
+ begin try
+ occur env t1 t2;
+ update_level env t1.level t2;
+@@ -2527,7 +2542,7 @@
+ let rec filter_arrow env t l =
+ let t = expand_head_unif env t in
+ match t.desc with
+- Tvar ->
++ 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
+@@ -2543,7 +2558,7 @@
+ let rec filter_method_field env name priv ty =
+ let ty = repr 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,
+@@ -2570,7 +2585,7 @@
+ let rec filter_method env name priv ty =
+ let ty = expand_head_unif env ty in
+ match ty.desc with
+- Tvar ->
++ Tvar _ ->
+ let ty1 = newvar () in
+ let ty' = newobj ty1 in
+ update_level env ty.level ty';
+@@ -2606,7 +2621,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 ->
+@@ -2636,7 +2651,7 @@
+
+ try
+ 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;
+ occur env t1 t2;
+ link_type t1 t2
+@@ -2653,7 +2668,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
+@@ -2684,7 +2699,7 @@
+ | (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
+ enter_poly env univar_pairs t1 tl1 t2 tl2
+ (moregen inst_nongen type_pairs env)
+- | (Tunivar, Tunivar) ->
++ | (Tunivar _, Tunivar _) ->
+ unify_univar t1' t2' !univar_pairs
+ | (_, _) ->
+ raise (Unify [])
+@@ -2725,7 +2740,7 @@
+ 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 in
+ let r1, r2, pairs = merge_row_fields row1.row_fields row2.row_fields in
+ let r1, r2 =
+ if row2.row_closed then
+@@ -2735,9 +2750,9 @@
+ 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 ->
+@@ -2828,13 +2843,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.row_fixed 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;
+@@ -2857,7 +2872,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' =
+@@ -2901,7 +2916,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 [])
+@@ -2922,7 +2937,7 @@
+ 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 [])
+@@ -2956,7 +2971,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 [])
+@@ -3405,7 +3420,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
+@@ -3454,13 +3469,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);
+@@ -3559,7 +3574,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 =
+@@ -3623,7 +3638,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) ->
+@@ -3659,7 +3674,7 @@
+ | (Tconstr(p1, tl1, _), _) when private_abbrev env p1 ->
+ subtype_rec env trace (expand_abbrev_opt env t1) 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, _)) ->
+@@ -3731,7 +3746,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 _), (Tvar _|Tconstr _)
+ when row1.row_closed && r1 = [] ->
+ List.fold_left
+ (fun cstrs (_,f1,f2) ->
+@@ -3745,7 +3760,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
+@@ -3789,19 +3804,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
+@@ -3875,7 +3890,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)
+@@ -3917,7 +3932,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 ->
+@@ -3987,7 +4002,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
+Index: typing/printtyp.ml
+===================================================================
+--- typing/printtyp.ml (リビジョン 11207)
++++ typing/printtyp.ml (作æ¥ã‚³ãƒ”ー)
+@@ -109,6 +109,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 +123,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 "@[<hov1>Tarrow(%s,@,%a,@,%a,@,%s)@]"
+ l raw_type t1 raw_type t2
+@@ -143,7 +147,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 "@[<hov1>Tpoly(@,%a,@,%a)@]"
+ raw_type t
+@@ -189,28 +193,61 @@
+
+ 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
++ 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
+ 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)
+@@ -225,9 +262,13 @@
+ 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 | _ -> true
+
+ let namable_row row =
+ row.row_name <> None &&
+@@ -245,7 +286,7 @@
+ 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
+@@ -290,7 +331,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;
+@@ -322,7 +363,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 =
+@@ -387,16 +428,22 @@
+ | 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) ->
+ Otyp_module (Path.name p, n, tree_of_typlist sch tyl)
+@@ -446,13 +493,13 @@
+ 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)"
+@@ -564,7 +611,7 @@
+ let vari =
+ List.map2
+ (fun ty (co,cn,ct) ->
+- if abstr || (repr ty).desc <> Tvar then (co,cn) else (true,true))
++ if abstr || not (is_Tvar (repr ty)) then (co,cn) else (true,true))
+ decl.type_params decl.type_variance
+ in
+ (Ident.name id,
+@@ -645,16 +692,18 @@
+
+ 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
+
+@@ -662,7 +711,7 @@
+ | Tcty_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
+@@ -675,7 +724,7 @@
+ 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) ->
+ mark_loops ty;
+@@ -686,7 +735,7 @@
+ | Tcty_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
+@@ -743,7 +792,7 @@
+ (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
+@@ -890,7 +939,7 @@
+ | {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') =
+@@ -913,9 +962,9 @@
+ let has_explanation unif t3 t4 =
+ match t3.desc, t4.desc with
+ Tfield _, _ | _, Tfield _
+- | Tunivar, Tvar | Tvar, Tunivar
++ | Tunivar _, Tvar _ | Tvar _, Tunivar _
+ | Tvariant _, Tvariant _ -> true
+- | Tconstr (p, _, _), Tvar | Tvar, Tconstr (p, _, _) ->
++ | Tconstr (p, _, _), Tvar _ | Tvar _, Tconstr (p, _, _) ->
+ unif && min t3.level t4.level < Path.binding_time p
+ | _ -> false
+
+@@ -931,21 +980,21 @@
+
+ let explanation unif t3 t4 ppf =
+ match t3.desc, t4.desc with
+- | Tfield _, Tvar | Tvar, Tfield _ ->
++ | Tfield _, Tvar _ | Tvar _, Tfield _ ->
+ fprintf ppf "@,Self type cannot escape its class"
+- | Tconstr (p, tl, _), Tvar
++ | Tconstr (p, tl, _), Tvar _
+ when unif && (tl = [] || t4.level < Path.binding_time p) ->
+ fprintf ppf
+ "@,@[The type constructor@;<1 2>%a@ would escape its scope@]"
+ path p
+- | Tvar, Tconstr (p, tl, _)
++ | Tvar _, Tconstr (p, tl, _)
+ when unif && (tl = [] || 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)
+ | Tfield (lab, _, _, _), _
+ | _, Tfield (lab, _, _, _) when lab = dummy_method ->
+ fprintf ppf
+Index: typing/includecore.ml
+===================================================================
+--- typing/includecore.ml (リビジョン 11207)
++++ typing/includecore.ml (作æ¥ã‚³ãƒ”ー)
+@@ -61,7 +61,7 @@
+ 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) &&
++ (match row1.row_more with {desc=Tvar _|Tconstr _} -> true | _ -> false) &&
+ 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 =
+@@ -251,7 +251,7 @@
+ 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
+
+Index: typing/subst.ml
+===================================================================
+--- typing/subst.ml (リビジョン 11207)
++++ typing/subst.ml (作æ¥ã‚³ãƒ”ー)
+@@ -71,16 +71,19 @@
+ let reset_for_saving () = new_id := -1
+
+ let newpersty desc =
+- decr new_id; { desc = desc; level = generic_level; id = !new_id }
++ decr new_id;
++ { desc = desc; level = generic_level; id = !new_id }
+
+ (* Similar to [Ctype.nondep_type_rec]. *)
+ let rec typexp s ty =
+ let ty = repr ty in
+ match ty.desc with
+- Tvar | Tunivar ->
++ Tvar _ | Tunivar _ ->
+ if s.for_saving || ty.id < 0 then
++ let desc = match ty.desc with (* Tvar _ -> Tvar None *) | d -> d in
+ let ty' =
+- if s.for_saving then newpersty ty.desc else newty2 ty.level ty.desc
++ if s.for_saving then newpersty desc
++ else newty2 ty.level desc
+ in
+ save_desc ty ty.desc; ty.desc <- Tsubst ty'; ty'
+ else ty
+@@ -94,7 +97,7 @@
+ let desc = ty.desc in
+ save_desc ty desc;
+ (* Make a stub *)
+- let ty' = if s.for_saving then newpersty Tvar else newgenvar () in
++ let ty' = if s.for_saving then newpersty (Tvar None) else newgenvar () in
+ ty.desc <- Tsubst ty';
+ ty'.desc <-
+ begin match desc with
+@@ -127,10 +130,10 @@
+ match more.desc with
+ Tsubst ty -> ty
+ | Tconstr _ -> typexp s more
+- | Tunivar | Tvar ->
++ | Tunivar _ | Tvar _ ->
+ save_desc more more.desc;
+ if s.for_saving then newpersty more.desc else
+- if dup && more.desc <> Tunivar then newgenvar () else more
++ if dup && is_Tvar more then newgenty more.desc else more
+ | _ -> assert false
+ in
+ (* Register new type first for recursion *)
+Index: typing/types.ml
+===================================================================
+--- typing/types.ml (リビジョン 11207)
++++ typing/types.ml (作æ¥ã‚³ãƒ”ー)
+@@ -25,7 +25,7 @@
+ mutable id: int }
+
+ and type_desc =
+- Tvar
++ Tvar of string option
+ | Tarrow of label * type_expr * type_expr * commutable
+ | Ttuple of type_expr list
+ | Tconstr of Path.t * type_expr list * abbrev_memo ref
+@@ -35,7 +35,7 @@
+ | Tlink of type_expr
+ | Tsubst of type_expr (* for copying *)
+ | Tvariant of row_desc
+- | Tunivar
++ | Tunivar of string option
+ | Tpoly of type_expr * type_expr list
+ | Tpackage of Path.t * string list * type_expr list
+
+Index: ocamldoc/odoc_str.ml
+===================================================================
+--- ocamldoc/odoc_str.ml (リビジョン 11207)
++++ ocamldoc/odoc_str.ml (作æ¥ã‚³ãƒ”ー)
+@@ -31,7 +31,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 +43,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 =
+Index: ocamldoc/odoc_value.ml
+===================================================================
+--- ocamldoc/odoc_value.ml (リビジョン 11207)
++++ ocamldoc/odoc_value.ml (作æ¥ã‚³ãƒ”ー)
+@@ -77,13 +77,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 _ ->
+ []
+Index: ocamldoc/odoc_misc.ml
+===================================================================
+--- ocamldoc/odoc_misc.ml (リビジョン 11207)
++++ ocamldoc/odoc_misc.ml (作æ¥ã‚³ãƒ”ー)
+@@ -478,8 +478,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 _
+Index: bytecomp/typeopt.ml
+===================================================================
+--- bytecomp/typeopt.ml (リビジョン 11207)
++++ bytecomp/typeopt.ml (作æ¥ã‚³ãƒ”ー)
+@@ -50,7 +50,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
+Index: bytecomp/translcore.ml
+===================================================================
+--- bytecomp/translcore.ml (リビジョン 11207)
++++ bytecomp/translcore.ml (作æ¥ã‚³ãƒ”ー)
+@@ -780,12 +780,13 @@
+ 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(_,_,_) ->
+Index: testsuite/tests/lib-hashtbl/htbl.ml
+===================================================================
+--- testsuite/tests/lib-hashtbl/htbl.ml (リビジョン 11207)
++++ testsuite/tests/lib-hashtbl/htbl.ml (作æ¥ã‚³ãƒ”ー)
+@@ -76,7 +76,7 @@
+ struct
+ type key = M.key
+ type 'a t = (key, 'a) Hashtbl.t
+- let create = Hashtbl.create
++ let create s = Hashtbl.create s
+ let clear = Hashtbl.clear
+ let copy = Hashtbl.copy
+ let add = Hashtbl.add
+Index: toplevel/genprintval.ml
+===================================================================
+--- toplevel/genprintval.ml (リビジョン 11207)
++++ toplevel/genprintval.ml (作æ¥ã‚³ãƒ”ー)
+@@ -180,7 +180,7 @@
+ find_printer env ty obj
+ with Not_found ->
+ match (Ctype.repr ty).desc with
+- | Tvar ->
++ | Tvar _ | Tunivar _ ->
+ Oval_stuff "<poly>"
+ | Tarrow(_, ty1, ty2, _) ->
+ Oval_stuff "<fun>"
+@@ -327,8 +327,6 @@
+ fatal_error "Printval.outval_of_value"
+ | Tpoly (ty, _) ->
+ tree_of_val (depth - 1) obj ty
+- | Tunivar ->
+- Oval_stuff "<poly>"
+ | Tpackage _ ->
+ Oval_stuff "<module>"
+ end
+Index: otherlibs/labltk/browser/searchid.ml
+===================================================================
+--- otherlibs/labltk/browser/searchid.ml (リビジョン 11207)
++++ otherlibs/labltk/browser/searchid.ml (作æ¥ã‚³ãƒ”ー)
+@@ -101,7 +101,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 +144,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
--- /dev/null
+let f (x : < a:int; .. > as 'me1) = (x : < b:bool; .. > as 'me2);;
+let f (x : < a:int; .. > as 'me1) = (x : < a:int; b:bool; .. > as 'me2);;
+let f (x : [> `A of int] as 'me1) = (x : [> `B of bool] as 'me2);;
+let f (x : [> `A of int] as 'me1) = (x : [`A of int | `B of 'me2] as 'me2);;
--- /dev/null
+(* 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))
--- /dev/null
+Index: typing/typemod.ml
+===================================================================
+--- typing/typemod.ml (revision 13947)
++++ typing/typemod.ml (working copy)
+@@ -80,6 +80,9 @@
+ Typedtree.module_expr * Types.module_type) ref
+ = ref (fun env m -> assert false)
+
++let transl_modtype_fwd =
++ ref (fun env m -> (assert false : Typedtree.module_type))
++
+ (* Merge one "with" constraint in a signature *)
+
+ let rec add_rec_types env = function
+@@ -191,6 +194,21 @@
+ merge env (extract_sig env loc mty) namelist None in
+ (path_concat id path, lid, tcstr),
+ Sig_module(id, Mty_signature newsg, rs) :: rem
++ | (Sig_modtype(id, mtd) :: rem, [s], Pwith_modtype pmty)
++ when Ident.name id = s ->
++ let mty = !transl_modtype_fwd initial_env pmty in
++ let mtd' = Modtype_manifest mty.mty_type in
++ Includemod.modtype_declarations env id mtd' mtd;
++ (Pident id, lid, Twith_modtype (Tmodtype_manifest mty)),
++ Sig_modtype(id, mtd') :: rem
++ | (Sig_modtype(id, mtd) :: rem, [s], Pwith_modtypesubst pmty)
++ when Ident.name id = s ->
++ let mty = !transl_modtype_fwd initial_env pmty in
++ let mtd' = Modtype_manifest mty.mty_type in
++ Includemod.modtype_declarations env id mtd' mtd;
++ real_id := Some id;
++ (Pident id, lid, Twith_modtypesubst (Tmodtype_manifest mty)),
++ rem
+ | (item :: rem, _, _) ->
+ let (cstr, items) = merge (Env.add_item item env) rem namelist row_id
+ in
+@@ -233,6 +251,12 @@
+ let (path, _) = Typetexp.find_module initial_env loc lid.txt in
+ let sub = Subst.add_module id path Subst.identity in
+ Subst.signature sub sg
++ | [s], Pwith_modtypesubst pmty ->
++ let id =
++ match !real_id with None -> assert false | Some id -> id in
++ let mty = !transl_modtype_fwd initial_env pmty in
++ let sub = Subst.add_modtype id mty.mty_type Subst.identity in
++ Subst.signature sub sg
+ | _ ->
+ sg
+ in
+@@ -649,6 +673,8 @@
+ check_recmod_typedecls env2 sdecls dcl2;
+ (dcl2, env2)
+
++let () = transl_modtype_fwd := transl_modtype
++
+ (* Try to convert a module expression to a module path. *)
+
+ exception Not_a_path
+Index: typing/typedtreeMap.ml
+===================================================================
+--- typing/typedtreeMap.ml (revision 13947)
++++ typing/typedtreeMap.ml (working copy)
+@@ -457,6 +457,9 @@
+ | Twith_typesubst decl -> Twith_typesubst (map_type_declaration decl)
+ | Twith_module (path, lid) -> cstr
+ | Twith_modsubst (path, lid) -> cstr
++ | Twith_modtype decl -> Twith_modtype (map_modtype_declaration decl)
++ | Twith_modtypesubst decl ->
++ Twith_modtypesubst (map_modtype_declaration decl)
+ in
+ Map.leave_with_constraint cstr
+
+Index: typing/typedtree.ml
+===================================================================
+--- typing/typedtree.ml (revision 13947)
++++ typing/typedtree.ml (working copy)
+@@ -255,6 +255,8 @@
+ | Twith_module of Path.t * Longident.t loc
+ | Twith_typesubst of type_declaration
+ | Twith_modsubst of Path.t * Longident.t loc
++ | Twith_modtype of modtype_declaration
++ | Twith_modtypesubst of modtype_declaration
+
+ and core_type =
+ (* mutable because of [Typeclass.declare_method] *)
+Index: typing/typedtree.mli
+===================================================================
+--- typing/typedtree.mli (revision 13947)
++++ typing/typedtree.mli (working copy)
+@@ -254,6 +254,8 @@
+ | Twith_module of Path.t * Longident.t loc
+ | Twith_typesubst of type_declaration
+ | Twith_modsubst of Path.t * Longident.t loc
++ | Twith_modtype of modtype_declaration
++ | Twith_modtypesubst of modtype_declaration
+
+ and core_type =
+ (* mutable because of [Typeclass.declare_method] *)
+Index: typing/includemod.ml
+===================================================================
+--- typing/includemod.ml (revision 13947)
++++ typing/includemod.ml (working copy)
+@@ -346,10 +346,10 @@
+
+ (* 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 type_declarations env id decl1 decl2 =
+- type_declarations env [] Subst.identity id decl1 decl2
++let modtypes env = modtypes env [] Subst.identity
++let signatures env = signatures env [] Subst.identity
++let type_declarations env = type_declarations env [] Subst.identity
++let modtype_declarations env = modtype_infos env [] Subst.identity
+
+ (* Error report *)
+
+Index: typing/typedtreeIter.ml
+===================================================================
+--- typing/typedtreeIter.ml (revision 13947)
++++ typing/typedtreeIter.ml (working copy)
+@@ -408,6 +408,8 @@
+ | Twith_module _ -> ()
+ | Twith_typesubst decl -> iter_type_declaration decl
+ | Twith_modsubst _ -> ()
++ | Twith_modtype decl -> iter_modtype_declaration decl
++ | Twith_modtypesubst decl -> iter_modtype_declaration decl
+ end;
+ Iter.leave_with_constraint cstr;
+
+Index: typing/includemod.mli
+===================================================================
+--- typing/includemod.mli (revision 13947)
++++ typing/includemod.mli (working copy)
+@@ -21,6 +21,8 @@
+ val compunit: string -> signature -> string -> signature -> module_coercion
+ val type_declarations:
+ Env.t -> Ident.t -> type_declaration -> type_declaration -> unit
++val modtype_declarations:
++ Env.t -> Ident.t -> modtype_declaration -> modtype_declaration -> unit
+
+ type symptom =
+ Missing_field of Ident.t
+Index: typing/printtyped.ml
+===================================================================
+--- typing/printtyped.ml (revision 13947)
++++ typing/printtyped.ml (working copy)
+@@ -608,6 +608,12 @@
+ 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;
++ | Twith_modtype (td) ->
++ line i ppf "Pwith_modtype\n";
++ modtype_declaration (i+1) ppf td;
++ | Twith_modtypesubst (td) ->
++ line i ppf "Pwith_modtypesubst\n";
++ modtype_declaration (i+1) ppf td;
+
+ and module_expr i ppf x =
+ line i ppf "module_expr %a\n" fmt_location x.mod_loc;
+Index: experimental/garrigue/with-module-type.diffs
+===================================================================
+--- experimental/garrigue/with-module-type.diffs (revision 13947)
++++ experimental/garrigue/with-module-type.diffs (working copy)
+@@ -1,95 +1,53 @@
+-Index: parsing/parser.mly
+-===================================================================
+---- parsing/parser.mly (revision 12005)
+-+++ parsing/parser.mly (working copy)
+-@@ -1504,6 +1504,10 @@
+- { ($2, Pwith_module $4) }
+- | MODULE mod_longident COLONEQUAL mod_ext_longident
+- { ($2, Pwith_modsubst $4) }
+-+ | MODULE TYPE mod_longident EQUAL module_type
+-+ { ($3, Pwith_modtype $5) }
+-+ | MODULE TYPE mod_longident COLONEQUAL module_type
+-+ { ($3, Pwith_modtypesubst $5) }
+- ;
+- with_type_binder:
+- EQUAL { Public }
+-Index: parsing/parsetree.mli
+-===================================================================
+---- parsing/parsetree.mli (revision 12005)
+-+++ parsing/parsetree.mli (working copy)
+-@@ -239,6 +239,8 @@
+- | Pwith_module of Longident.t
+- | Pwith_typesubst of type_declaration
+- | Pwith_modsubst of Longident.t
+-+ | Pwith_modtype of module_type
+-+ | Pwith_modtypesubst of module_type
+-
+- (* Value expressions for the module language *)
+-
+-Index: parsing/printast.ml
+-===================================================================
+---- parsing/printast.ml (revision 12005)
+-+++ parsing/printast.ml (working copy)
+-@@ -575,6 +575,12 @@
+- 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_modtype (mty) ->
+-+ line i ppf "Pwith_modtype\n";
+-+ module_type (i+1) ppf mty;
+-+ | Pwith_modtypesubst (mty) ->
+-+ line i ppf "Pwith_modtype\n";
+-+ module_type (i+1) ppf mty;
+-
+- and module_expr i ppf x =
+- line i ppf "module_expr %a\n" fmt_location x.pmod_loc;
+ Index: typing/typemod.ml
+ ===================================================================
+---- typing/typemod.ml (revision 12005)
++--- typing/typemod.ml (revision 13947)
+ +++ typing/typemod.ml (working copy)
+-@@ -74,6 +74,8 @@
+- : (Env.t -> Parsetree.module_expr -> module_type) ref
++@@ -80,6 +80,9 @@
++ Typedtree.module_expr * Types.module_type) ref
+ = ref (fun env m -> assert false)
+
+-+let transl_modtype_fwd = ref (fun env m -> assert false)
+++let transl_modtype_fwd =
+++ ref (fun env m -> (assert false : Typedtree.module_type))
+ +
+ (* Merge one "with" constraint in a signature *)
+
+ let rec add_rec_types env = function
+-@@ -163,6 +165,19 @@
+- ignore(Includemod.modtypes env newmty mty);
+- real_id := Some id;
+- make_next_first rs rem
+-+ | (Tsig_modtype(id, mtd) :: rem, [s], Pwith_modtype pmty)
++@@ -191,6 +194,21 @@
++ merge env (extract_sig env loc mty) namelist None in
++ (path_concat id path, lid, tcstr),
++ Sig_module(id, Mty_signature newsg, rs) :: rem
+++ | (Sig_modtype(id, mtd) :: rem, [s], Pwith_modtype pmty)
+ + when Ident.name id = s ->
+ + let mty = !transl_modtype_fwd initial_env pmty in
+-+ let mtd' = Tmodtype_manifest mty in
+++ let mtd' = Modtype_manifest mty.mty_type in
+ + Includemod.modtype_declarations env id mtd' mtd;
+-+ Tsig_modtype(id, mtd') :: rem
+-+ | (Tsig_modtype(id, mtd) :: rem, [s], Pwith_modtypesubst pmty)
+++ (Pident id, lid, Twith_modtype (Tmodtype_manifest mty)),
+++ Sig_modtype(id, mtd') :: rem
+++ | (Sig_modtype(id, mtd) :: rem, [s], Pwith_modtypesubst pmty)
+ + when Ident.name id = s ->
+ + let mty = !transl_modtype_fwd initial_env pmty in
+-+ let mtd' = Tmodtype_manifest mty in
+++ let mtd' = Modtype_manifest mty.mty_type in
+ + Includemod.modtype_declarations env id mtd' mtd;
+ + real_id := Some id;
+++ (Pident id, lid, Twith_modtypesubst (Tmodtype_manifest mty)),
+ + rem
+- | (Tsig_module(id, mty, rs) :: rem, s :: namelist, _)
+- when Ident.name id = s ->
+- let newsg = merge env (extract_sig env loc mty) namelist None in
+-@@ -200,6 +215,12 @@
+- let (path, _) = Typetexp.find_module initial_env loc lid in
++ | (item :: rem, _, _) ->
++ let (cstr, items) = merge (Env.add_item item env) rem namelist row_id
++ in
++@@ -233,6 +251,12 @@
++ let (path, _) = Typetexp.find_module initial_env loc lid.txt in
+ let sub = Subst.add_module id path Subst.identity in
+ Subst.signature sub sg
+ + | [s], Pwith_modtypesubst pmty ->
+ + let id =
+ + match !real_id with None -> assert false | Some id -> id in
+ + let mty = !transl_modtype_fwd initial_env pmty in
+-+ let sub = Subst.add_modtype id mty Subst.identity in
+++ let sub = Subst.add_modtype id mty.mty_type Subst.identity in
+ + Subst.signature sub sg
+ | _ ->
+- sg
+- with Includemod.Error explanation ->
+-@@ -499,6 +520,8 @@
++ sg
++ in
++@@ -649,6 +673,8 @@
+ check_recmod_typedecls env2 sdecls dcl2;
+ (dcl2, env2)
+
+@@ -98,11 +56,51 @@
+ (* Try to convert a module expression to a module path. *)
+
+ exception Not_a_path
++Index: typing/typedtreeMap.ml
++===================================================================
++--- typing/typedtreeMap.ml (revision 13947)
+++++ typing/typedtreeMap.ml (working copy)
++@@ -457,6 +457,9 @@
++ | Twith_typesubst decl -> Twith_typesubst (map_type_declaration decl)
++ | Twith_module (path, lid) -> cstr
++ | Twith_modsubst (path, lid) -> cstr
+++ | Twith_modtype decl -> Twith_modtype (map_modtype_declaration decl)
+++ | Twith_modtypesubst decl ->
+++ Twith_modtypesubst (map_modtype_declaration decl)
++ in
++ Map.leave_with_constraint cstr
++
++Index: typing/typedtree.ml
++===================================================================
++--- typing/typedtree.ml (revision 13947)
+++++ typing/typedtree.ml (working copy)
++@@ -255,6 +255,8 @@
++ | Twith_module of Path.t * Longident.t loc
++ | Twith_typesubst of type_declaration
++ | Twith_modsubst of Path.t * Longident.t loc
+++ | Twith_modtype of modtype_declaration
+++ | Twith_modtypesubst of modtype_declaration
++
++ and core_type =
++ (* mutable because of [Typeclass.declare_method] *)
++Index: typing/typedtree.mli
++===================================================================
++--- typing/typedtree.mli (revision 13947)
+++++ typing/typedtree.mli (working copy)
++@@ -254,6 +254,8 @@
++ | Twith_module of Path.t * Longident.t loc
++ | Twith_typesubst of type_declaration
++ | Twith_modsubst of Path.t * Longident.t loc
+++ | Twith_modtype of modtype_declaration
+++ | Twith_modtypesubst of modtype_declaration
++
++ and core_type =
++ (* mutable because of [Typeclass.declare_method] *)
+ Index: typing/includemod.ml
+ ===================================================================
+---- typing/includemod.ml (revision 12005)
++--- typing/includemod.ml (revision 13947)
+ +++ typing/includemod.ml (working copy)
+-@@ -326,10 +326,10 @@
++@@ -346,10 +346,10 @@
+
+ (* Hide the context and substitution parameters to the outside world *)
+
+@@ -117,11 +115,24 @@
+
+ (* Error report *)
+
++Index: typing/typedtreeIter.ml
++===================================================================
++--- typing/typedtreeIter.ml (revision 13947)
+++++ typing/typedtreeIter.ml (working copy)
++@@ -408,6 +408,8 @@
++ | Twith_module _ -> ()
++ | Twith_typesubst decl -> iter_type_declaration decl
++ | Twith_modsubst _ -> ()
+++ | Twith_modtype decl -> iter_modtype_declaration decl
+++ | Twith_modtypesubst decl -> iter_modtype_declaration decl
++ end;
++ Iter.leave_with_constraint cstr;
++
+ Index: typing/includemod.mli
+ ===================================================================
+---- typing/includemod.mli (revision 12005)
++--- typing/includemod.mli (revision 13947)
+ +++ typing/includemod.mli (working copy)
+-@@ -23,6 +23,8 @@
++@@ -21,6 +21,8 @@
+ val compunit: string -> signature -> string -> signature -> module_coercion
+ val type_declarations:
+ Env.t -> Ident.t -> type_declaration -> type_declaration -> unit
+@@ -130,53 +141,20 @@
+
+ type symptom =
+ Missing_field of Ident.t
+-Index: testsuite/tests/typing-modules/Test.ml.reference
++Index: typing/printtyped.ml
+ ===================================================================
+---- testsuite/tests/typing-modules/Test.ml.reference (revision 12005)
+-+++ testsuite/tests/typing-modules/Test.ml.reference (working copy)
+-@@ -6,4 +6,12 @@
+- # type -'a t
+- class type c = object method m : [ `A ] t end
+- # module M : sig val v : (#c as 'a) -> 'a end
+-+# module type S = sig module type T module F : functor (X : T) -> T end
+-+# module type T0 = sig type t end
+-+# module type S1 = sig module type T = T0 module F : functor (X : T) -> T end
+-+# module type S2 = sig module F : functor (X : T0) -> T0 end
+-+# module type S3 =
+-+ sig
+-+ module F : functor (X : sig type t = int end) -> sig type t = int end
+-+ end
+- #
+-Index: testsuite/tests/typing-modules/Test.ml.principal.reference
+-===================================================================
+---- testsuite/tests/typing-modules/Test.ml.principal.reference (revision 12005)
+-+++ testsuite/tests/typing-modules/Test.ml.principal.reference (working copy)
+-@@ -6,4 +6,12 @@
+- # type -'a t
+- class type c = object method m : [ `A ] t end
+- # module M : sig val v : (#c as 'a) -> 'a end
+-+# module type S = sig module type T module F : functor (X : T) -> T end
+-+# module type T0 = sig type t end
+-+# module type S1 = sig module type T = T0 module F : functor (X : T) -> T end
+-+# module type S2 = sig module F : functor (X : T0) -> T0 end
+-+# module type S3 =
+-+ sig
+-+ module F : functor (X : sig type t = int end) -> sig type t = int end
+-+ end
+- #
+-Index: testsuite/tests/typing-modules/Test.ml
+-===================================================================
+---- testsuite/tests/typing-modules/Test.ml (revision 12005)
+-+++ testsuite/tests/typing-modules/Test.ml (working copy)
+-@@ -9,3 +9,11 @@
+- 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;;
+-+
+-+(* 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;;
++--- typing/printtyped.ml (revision 13947)
+++++ typing/printtyped.ml (working copy)
++@@ -608,6 +608,12 @@
++ 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;
+++ | Twith_modtype (td) ->
+++ line i ppf "Pwith_modtype\n";
+++ modtype_declaration (i+1) ppf td;
+++ | Twith_modtypesubst (td) ->
+++ line i ppf "Pwith_modtypesubst\n";
+++ modtype_declaration (i+1) ppf td;
++
++ and module_expr i ppf x =
++ line i ppf "module_expr %a\n" fmt_location x.mod_loc;
+Index: parsing/pprintast.ml
+===================================================================
+--- parsing/pprintast.ml (revision 13947)
++++ parsing/pprintast.ml (working copy)
+@@ -847,18 +847,28 @@
+ (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;
++ 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
++ pp f "module %a :=@ %a"
++ self#longident_loc li self#longident_loc li2
++ | Pwith_modtype mty ->
++ pp f "module type %a =@ %a"
++ self#longident_loc li self#module_type mty
++ | Pwith_modtypesubst mty ->
++ pp f "module type %a :=@ %a"
++ self#longident_loc li self#module_type mty
++ in
+ (match l with
+ | [] -> pp f "@[<hov2>%a@]" self#module_type mt
+ | _ -> pp f "@[<hov2>(%a@ with@ %a)@]"
+- self#module_type mt (self#list longident_x_with_constraint ~sep:"@ and@ ") l )
++ self#module_type mt
++ (self#list longident_x_with_constraint ~sep:"@ and@ ") l )
+ | Pmty_typeof me ->
+ pp f "@[<hov2>module@ type@ of@ %a@]"
+ self#module_expr me
+Index: parsing/parser.mly
+===================================================================
+--- parsing/parser.mly (revision 13947)
++++ parsing/parser.mly (working copy)
+@@ -1506,6 +1506,10 @@
+ { (mkrhs $2 2, Pwith_module (mkrhs $4 4)) }
+ | MODULE UIDENT COLONEQUAL mod_ext_longident
+ { (mkrhs (Lident $2) 2, Pwith_modsubst (mkrhs $4 4)) }
++ | MODULE TYPE mty_longident EQUAL module_type
++ { (mkrhs $3 3, Pwith_modtype $5) }
++ | MODULE TYPE ident COLONEQUAL module_type
++ { (mkrhs (Lident $3) 3, Pwith_modtypesubst $5) }
+ ;
+ with_type_binder:
+ EQUAL { Public }
+Index: parsing/ast_mapper.ml
+===================================================================
+--- parsing/ast_mapper.ml (revision 13947)
++++ parsing/ast_mapper.ml (working copy)
+@@ -164,6 +164,8 @@
+ | 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)
++ | Pwith_modtype m -> Pwith_modtype (sub # module_type m)
++ | Pwith_modtypesubst m -> Pwith_modtypesubst (sub # module_type m)
+
+ let mk_item ?(loc = Location.none) x = {psig_desc = x; psig_loc = loc}
+
+Index: parsing/parsetree.mli
+===================================================================
+--- parsing/parsetree.mli (revision 13947)
++++ parsing/parsetree.mli (working copy)
+@@ -256,6 +256,8 @@
+ | Pwith_module of Longident.t loc
+ | Pwith_typesubst of type_declaration
+ | Pwith_modsubst of Longident.t loc
++ | Pwith_modtype of module_type
++ | Pwith_modtypesubst of module_type
+
+ (* Value expressions for the module language *)
+
+Index: parsing/printast.ml
+===================================================================
+--- parsing/printast.ml (revision 13947)
++++ parsing/printast.ml (working copy)
+@@ -590,6 +590,12 @@
+ type_declaration (i+1) ppf td;
+ | 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;
++ | Pwith_modtype (mty) ->
++ line i ppf "Pwith_modtype\n";
++ module_type (i+1) ppf mty;
++ | Pwith_modtypesubst (mty) ->
++ line i ppf "Pwith_modtype\n";
++ module_type (i+1) ppf mty;
+
+ and module_expr i ppf x =
+ line i ppf "module_expr %a\n" fmt_location x.pmod_loc;
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
+output.cmi : syntax.cmi lexgen.cmi compact.cmi common.cmi
parser.cmi : syntax.cmi
syntax.cmi : cset.cmi
table.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
+output.cmo : lexgen.cmi compact.cmi common.cmi output.cmi
+output.cmx : lexgen.cmx compact.cmx common.cmx output.cmi
parser.cmo : syntax.cmi cset.cmi parser.cmi
parser.cmx : syntax.cmx cset.cmx parser.cmi
syntax.cmo : cset.cmi syntax.cmi
#########################################################################
# The lexer generator
-CAMLC=../boot/ocamlrun ../boot/ocamlc -strict-sequence -nostdlib -I ../boot
-CAMLOPT=../boot/ocamlrun ../ocamlopt -nostdlib -I ../stdlib
+include ../config/Makefile
+CAMLRUN ?= ../boot/ocamlrun
+CAMLYACC ?= ../boot/ocamlyacc
+
+CAMLC=$(CAMLRUN) ../boot/ocamlc -strict-sequence -nostdlib -I ../boot
+CAMLOPT=$(CAMLRUN) ../ocamlopt -nostdlib -I ../stdlib
COMPFLAGS=-w +33..39 -warn-error A -bin-annot -safe-string
-CAMLYACC=../boot/ocamlyacc
+LINKFLAGS=
YACCFLAGS=-v
-CAMLLEX=../boot/ocamlrun ../boot/ocamllex
-CAMLDEP=../boot/ocamlrun ../tools/ocamldep
+CAMLLEX=$(CAMLRUN) ../boot/ocamllex
+CAMLDEP=$(CAMLRUN) ../tools/ocamldep
OBJS=cset.cmo syntax.cmo parser.cmo lexer.cmo table.cmo lexgen.cmo \
# The lexer generator
include ../config/Makefile
+CAMLRUN ?= ../boot/ocamlrun
+CAMLYACC ?= ../boot/ocamlyacc
-CAMLC=../boot/ocamlrun ../boot/ocamlc -I ../boot
-CAMLOPT=../boot/ocamlrun ../ocamlopt -I ../stdlib
+CAMLC=$(CAMLRUN) ../boot/ocamlc -I ../boot
+CAMLOPT=$(CAMLRUN) ../ocamlopt -I ../stdlib
COMPFLAGS=-warn-error A
LINKFLAGS=
-CAMLYACC=../boot/ocamlyacc
YACCFLAGS=-v
-CAMLLEX=../boot/ocamlrun ../boot/ocamllex
-CAMLDEP=../boot/ocamlrun ../tools/ocamldep
+CAMLLEX=$(CAMLRUN) ../boot/ocamllex
+CAMLDEP=$(CAMLRUN) ../tools/ocamldep
DEPFLAGS=
OBJS=cset.cmo syntax.cmo parser.cmo lexer.cmo table.cmo lexgen.cmo \
.BR + ,
it is taken relative to the
standard library directory. For instance,
-.B \-I\ +camlp4
+.B \-I\ +compiler-libs
adds the subdirectory
-.B camlp4
+.B compiler-libs
of the standard library to the search path.
.IP
Directories can also be added to the search path once the toplevel
options as if they had been provided on the
command line, unless the
.B -noautolink
-option is given.
-.TP
+option is given. Additionally, a substring
+.B $CAMLORIGIN
+inside a
+.BR \ \-ccopt
+options will be replaced by the full path to the .cma library,
+excluding the filename.
.B \-absname
Show absolute filenames in error messages.
.TP
.BR + ,
it is taken relative to the
standard library directory. For instance,
-.B \-I\ +camlp4
+.B \-I\ +compiler-libs
adds the subdirectory
-.B camlp4
+.B compiler-libs
of the standard library to the search path.
.TP
.BI \-impl \ filename
.I string
as interface files (instead of the default .mli).
.TP
+.B \-keep-docs
+Keep documentation strings in generated .cmi files.
+.TP
.B \-keep-locs
Keep locations in generated .cmi files.
.TP
\ \ Non-returning statement.
22
-\ \ Camlp4 warning.
+\ \ Preprocessor warning.
23
\ \ Useless record
45
\ \ Open statement shadows an already defined label or constructor.
+46
+\ \ Error in environment variable.
+
+47
+\ \ Illegal attribute payload.
+
+48
+\ \ Implicit elimination of optional arguments.
+
+49
+\ \ Missing cmi file when looking up module alias.
+
+50
+\ \ Unexpected documentation comment.
+
The letters stand for the following sets of warnings. Any letter not
mentioned here corresponds to the empty set.
.IP
The default setting is
-.BR \-w\ +a\-4\-6\-7\-9\-27\-29\-32..39\-41..42\-44\-45 .
+.BR \-w\ +a\-4\-6\-7\-9\-27\-29\-32..39\-41\-42\-44\-45\-48\-50 .
Note that warnings
.BR 5 \ and \ 10
are not always triggered, depending on the internals of the type checker.
warnings or modify existing warnings.
The default setting is
-.B \-warn\-error\ -a (all warnings are non-fatal).
+.B \-warn\-error \-a
+(all warnings are non-fatal).
.TP
.B \-warn\-help
Show the description of all available warning numbers.
options as if they had been provided on the
command line, unless the
.B \-noautolink
-option is given.
+option is given. Additionally, a substring
+.B $CAMLORIGIN
+inside a
+.BR \ \-ccopt
+options will be replaced by the full path to the .cma library,
+excluding the filename.
.TP
.B \-absname
Show absolute filenames in error messages.
.BR + ,
it is taken relative to the
standard library directory. For instance,
-.B \-I\ +camlp4
+.B \-I\ +compiler-libs
adds the subdirectory
-.B camlp4
+.B compiler-libs
of the standard library to the search path.
.TP
.BI \-impl \ filename
as interface files (instead of the default .mli).
.TP
.B \-keep-locs
+Keep documentation strings in generated .cmi files.
+.TP
+.B \-keep-locs
Keep locations in generated .cmi files.
.TP
.B \-labels
warnings or modify existing warnings.
The default setting is
-.B \-warn\-error\ -a (all warnings are non-fatal).
+.B \-warn\-error \-a
+(all warnings are non-fatal).
.TP
.B \-warn\-help
Show the description of all available warning numbers.
Startup messages (loading the bytecode executable file, resolving
shared libraries).
+.BR 0x200
+Computation of compaction-triggering condition.
+
The multiplier is
.BR k ,
.BR M ,\ or
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
+glob.cmi : signatures.cmi glob_ast.cmi bool.cmi
hooks.cmi :
hygiene.cmi : slurp.cmi
lexers.cmi : loc.cmi glob.cmi
my_std.cmi : signatures.cmi
my_unix.cmi :
ocaml_arch.cmi : signatures.cmi command.cmi
+ocamlbuild_executor.cmi :
+ocamlbuildlight.cmi :
+ocamlbuild.cmi :
+ocamlbuild_plugin.cmi :
+ocamlbuild_unix_plugin.cmi :
+ocamlbuild_where.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 loc.cmi
pathname.cmi : signatures.cmi
findlib.cmi
flags.cmo : tags.cmi param_tags.cmi log.cmi command.cmi bool.cmi flags.cmi
flags.cmx : tags.cmx param_tags.cmx log.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.cmx glob_ast.cmx bool.cmx glob.cmi
glob_ast.cmo : bool.cmi glob_ast.cmi
glob_ast.cmx : bool.cmx glob_ast.cmi
glob_lexer.cmo : glob_ast.cmi bool.cmi glob_lexer.cmi
glob_lexer.cmx : glob_ast.cmx bool.cmx glob_lexer.cmi
+glob.cmo : my_std.cmi glob_lexer.cmi glob_ast.cmi bool.cmi glob.cmi
+glob.cmx : my_std.cmx glob_lexer.cmx glob_ast.cmx bool.cmx glob.cmi
hooks.cmo : hooks.cmi
hooks.cmx : hooks.cmi
hygiene.cmo : slurp.cmi shell.cmi pathname.cmi options.cmi my_std.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
+ocamlbuild_config.cmo :
+ocamlbuild_config.cmx :
+ocamlbuild_executor.cmo : ocamlbuild_executor.cmi
+ocamlbuild_executor.cmx : ocamlbuild_executor.cmi
+ocamlbuildlight.cmo : ocamlbuildlight.cmi
+ocamlbuildlight.cmx : ocamlbuildlight.cmi
+ocamlbuild.cmo : ocamlbuild_unix_plugin.cmi ocamlbuild.cmi
+ocamlbuild.cmx : ocamlbuild_unix_plugin.cmx ocamlbuild.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_config.cmo ocamlbuild_where.cmi
+ocamlbuild_where.cmx : ocamlbuild_config.cmx ocamlbuild_where.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_utils.cmx : tools.cmx tags.cmx pathname.cmx param_tags.cmx options.cmx \
my_std.cmx log.cmx lexers.cmx flags.cmx const.cmx command.cmx \
ocaml_utils.cmi
-ocamlbuild.cmo : ocamlbuild_unix_plugin.cmi ocamlbuild.cmi
-ocamlbuild.cmx : ocamlbuild_unix_plugin.cmx ocamlbuild.cmi
-ocamlbuild_config.cmo :
-ocamlbuild_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_config.cmo ocamlbuild_where.cmi
-ocamlbuild_where.cmx : ocamlbuild_config.cmx ocamlbuild_where.cmi
-ocamlbuildlight.cmo : ocamlbuildlight.cmi
-ocamlbuildlight.cmx : ocamlbuildlight.cmi
options.cmo : shell.cmi ocamlbuild_where.cmi ocamlbuild_config.cmo \
my_std.cmi log.cmi lexers.cmi const.cmo command.cmi options.cmi
options.cmx : shell.cmx ocamlbuild_where.cmx ocamlbuild_config.cmx \
#########################################################################
include ../config/Makefile
+CAMLRUN ?= ../boot/ocamlrun
+CAMLYACC ?= ../boot/ocamlyacc
ROOTDIR = ..
-OCAMLRUN = $(ROOTDIR)/boot/ocamlrun
-OCAMLC = $(OCAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib
-OCAMLOPT = $(OCAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib
-OCAMLDEP = $(OCAMLRUN) $(ROOTDIR)/tools/ocamldep
-OCAMLLEX = $(OCAMLRUN) $(ROOTDIR)/boot/ocamllex
+OCAMLC = $(CAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib
+OCAMLOPT = $(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib
+OCAMLDEP = $(CAMLRUN) $(ROOTDIR)/tools/ocamldep
+OCAMLLEX = $(CAMLRUN) $(ROOTDIR)/boot/ocamllex
CP = cp
COMPFLAGS= -warn-error A -w L -w R -w Z -I ../otherlibs/$(UNIXLIB) -safe-string
LINKFLAGS= -I ../otherlibs/$(UNIXLIB)
# The packs
-ocamlbuild_pack.cmo ocamlbuild_pack.cmi: $(PACK_CMO)
+ocamlbuild_pack.cmo: $(PACK_CMO)
$(OCAMLC) -pack $(PACK_CMO) -o ocamlbuild_pack.cmo
+ocamlbuild_pack.cmi: ocamlbuild_pack.cmo
+
ocamlbuild_pack.cmx: $(PACK_CMX)
$(OCAMLOPT) -pack $(PACK_CMX) -o ocamlbuild_pack.cmx
ocamlbuild_config.ml: ../config/Makefile
(echo 'let bindir = "$(BINDIR)"'; \
- echo 'let libdir = "$(LIBDIR)"'; \
- echo 'let supports_shared_libraries = $(SUPPORTS_SHARED_LIBRARIES)';\
- echo 'let a = "$(A)"'; \
- echo 'let o = "$(O)"'; \
- echo 'let so = "$(SO)"'; \
- echo 'let exe = "$(EXE)"'; \
- ) > ocamlbuild_config.ml
+ echo 'let libdir = "$(LIBDIR)"'; \
+ echo 'let supports_shared_libraries = $(SUPPORTS_SHARED_LIBRARIES)';\
+ echo 'let a = "$(A)"'; \
+ echo 'let o = "$(O)"'; \
+ echo 'let so = "$(SO)"'; \
+ echo 'let ext_dll = "$(EXT_DLL)"'; \
+ echo 'let exe = "$(EXE)"'; \
+ ) > ocamlbuild_config.ml
clean::
rm -f ocamlbuild_config.ml
beforedepend:: ocamlbuild_config.ml
+++ /dev/null
-#(***********************************************************************)
-#(* *)
-#(* 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
-##########################
-
-ROOTDIR = ..
-OCAMLRUN = $(ROOTDIR)/boot/ocamlrun
-OCAMLC = $(OCAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib
-OCAMLOPT = $(OCAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib
-OCAMLDEP = $(OCAMLRUN) $(ROOTDIR)/tools/ocamldep
-OCAMLLEX = $(OCAMLRUN) $(ROOTDIR)/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=$(DESTDIR)$(OCAMLLIB)/ocamlbuild
-INSTALL_CUSTOMDIR=$(INSTALL_LIBDIR)/custom
-INSTALL_BINDIR=$(DESTDIR)$(OCAMLBIN)
-
-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/$(UNIXLIB)
-
-INCLUDES=$(INCLUDES_DEP) $(INCLUDES_NODEP)
-
-COMPFLAGS=$(INCLUDES) -warn-error A -safe-string
-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
(* 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"))
+ sys_file_exists file || ((Sys.win32 || Sys.cygwin) && sys_file_exists (file ^ ".exe"))
let search_in_path cmd =
(* Try to find [cmd] in path [path]. *)
Param_tags.declare ptag
(fun param -> dep (Param_tags.make ptag param :: tags) (deps param))
+let list_all_deps () =
+ !all_deps_of_tags
+
(*
let to_string_for_digest x =
let rec cmd_of_spec =
val pdep : Tags.elt list -> Tags.elt -> (string -> pathname list) -> unit
+val list_all_deps : unit -> (Tags.t * pathname list) list
+
val file_or_exe_exists: string -> bool
let check_tags_usage useful_tags =
let check_tag (tag, loc) =
if not (Tags.mem tag useful_tags) then
- Log.eprintf "%aWarning: the tag %S is not used in any flag declaration, \
- so it will have no effect; it may be a typo. Otherwise use \
- `mark_tag_used` in your myocamlbuild.ml to disable \
- this warning."
+
+ Log.eprintf "%aWarning: the tag %S is not used in any flag or dependency \
+ declaration, so it will have no effect; it may be a typo. \
+ Otherwise you can use `mark_tag_used` in your myocamlbuild.ml \
+ to disable this warning."
Loc.print_loc loc tag
in
let check_conf (_, values) =
exception Exit_silently
let clean () =
- Log.finish ();
Shell.rm_rf !Options.build_dir;
if !Options.make_links then begin
let entry =
in
Slurp.force (Resource.clean_up_links entry)
end;
+ Log.finish ();
raise Exit_silently
;;
they should be marked as useful, to avoid the "unused tag" warning. *)
let builtin_useful_tags =
Tags.of_list [
- "include"; "traverse"; "not_hygienic";
+ "include"; "traverse"; "not_hygienic"; "precious";
"pack"; "ocamlmklib"; "native"; "thread";
"nopervasives"; "use_menhir"; "ocamldep";
"thread";
let proceed () =
Hooks.call_hook Hooks.Before_options;
Options.init ();
+ Options.include_dirs := List.map Pathname.normalize !Options.include_dirs;
+ Options.exclude_dirs := List.map Pathname.normalize !Options.exclude_dirs;
if !Options.must_clean then clean ();
Hooks.call_hook Hooks.After_options;
let options_wd = Sys.getcwd () in
(* 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
<**/*.cmo>: ocaml, byte\n\
<**/*.cmi>: ocaml, byte, native\n\
<**/*.cmx>: ocaml, native\n\
+ <**/*.mly>: infer\n\
+ <**/.svn>|\".bzr\"|\".hg\"|\".git\"|\"_darcs\": -traverse\n\
";
List.iter
raise Exit_silently
end;
- let all_tags = Tags.union builtin_useful_tags (Flags.get_used_tags ()) in
+ let all_tags =
+ let builtin = builtin_useful_tags in
+ let used_in_flags = Flags.get_used_tags () in
+ let used_in_deps =
+ List.fold_left (fun acc (tags, _deps) -> Tags.union acc tags)
+ Tags.empty (Command.list_all_deps ())
+ in
+ Tags.union builtin (Tags.union used_in_flags used_in_deps) in
Configuration.check_tags_usage all_tags;
Digest_cache.init ();
else
()
with
- | Ocaml_dependencies.Circular_dependencies(seen, p) ->
+ | Ocaml_dependencies.Circular_dependencies(cycle, p) ->
raise
(Exit_build_error
- (sbprintf "@[<2>Circular dependencies: %S already seen in@ %a@]@." p pp_l seen))
+ (sbprintf "@[<2>Circular dependencies: %S already seen in@ %a@]@." p pp_l cycle))
;;
open Exit_codes;;
if sys_file_exists x then
try
let y = readlinkcmd x in
+ let y =
+ if Filename.is_relative y then
+ Filename.concat (Filename.dirname x) y
+ else
+ y
+ in
if (lstat y).stat_file_kind = FK_dir then raise Link_to_directories_not_supported else y
with Failure(_) -> raise Not_a_link
else raise No_such_file
let compile_ocaml_interf mli cmi env build =
let mli = env mli and cmi = env cmi in
prepare_compile build mli;
- let tags = tags_of_pathname mli++"interf" in
+ let tags = tags_of_pathname mli++"interf" in
let comp_c = if Tags.mem "native" tags then ocamlopt_c else ocamlc_c in
comp_c tags mli cmi
let byte_output_obj = byte_link_gen ocamlc_link_prog
(fun tags -> tags++"ocaml"++"link"++"byte"++"output_obj")
+let byte_output_shared = byte_link_gen ocamlc_link_prog
+ (fun tags -> tags++"ocaml"++"link"++"byte"++"output_obj"++"output_shared")
+
let byte_library_link = byte_link_gen byte_lib_linker byte_lib_linker_tags
let byte_debug_link_gen =
let native_output_obj x = native_link_gen ocamlopt_link_prog
(fun tags -> tags++"ocaml"++"link"++"native"++"output_obj") x
+let native_output_shared x = native_link_gen ocamlopt_link_prog
+ (fun tags -> tags++"ocaml"++"link"++"native"++"output_obj"++"output_shared") x
+
let native_library_link x =
native_link_gen native_lib_linker native_lib_linker_tags x
string -> string -> Rule.action
val byte_link : string -> string -> Rule.action
val byte_output_obj : string -> string -> Rule.action
+val byte_output_shared : 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_output_shared : 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
let dependencies_of x =
try SMap.find x !*dependencies with Not_found -> Resources.empty in
- let needed = ref [] in
- let seen = ref [] in
+ let refine_cycle files starting_file =
+ (* We are looking for a cycle starting from [fn], included in
+ [files]; we'll simply use a DFS which builds a path until it
+ finds a circularity.
+
+ Note that if there is at least one cycle going through [fn],
+ calling [dfs path fn] will return it no matter what [path] is
+ (it may just not be the shortest possible cycle). This means
+ that if [dfs path fn] returns [None], [fn] is a dead-end that
+ should never be explored again.
+ *)
+ let dead_ends = ref Resources.empty in
+ let rec dfs path fn =
+ let through_dep f = function
+ | Some _ as cycle -> cycle
+ | None ->
+ if List.mem f path
+ then (* we have found a cycle *)
+ Some (List.rev path)
+ else if not (Resources.mem f files)
+ then
+ (* the neighbor is not in the set of paths known to have a cycle *)
+ None
+ else
+ (* look for cycles going through this neighbor *)
+ dfs (f :: path) f
+ in
+ if Resources.mem fn !dead_ends then None
+ else match Resources.fold through_dep (dependencies_of fn) None with
+ | Some _ as cycle -> cycle
+ | None -> dead_ends := Resources.add fn !dead_ends; None
+ in
+ match dfs [] starting_file with
+ | None -> Resources.elements files
+ | Some cycle -> cycle
+ in
+
+ let needed_in_order = ref [] in
+ let needed = ref Resources.empty in
+ let seen = ref Resources.empty in
let rec aux fn =
- if sys_file_exists fn && not (List.mem fn !needed) then begin
- if List.mem fn !seen then raise (Circular_dependencies (!seen, fn));
- seen := fn :: !seen;
+ if sys_file_exists fn && not (Resources.mem fn !needed) then begin
+ if Resources.mem fn !seen then
+ raise (Circular_dependencies (refine_cycle !seen fn, fn));
+ seen := Resources.add fn !seen;
Resources.iter begin fun f ->
if sys_file_exists f then
if Filename.check_suffix f ".cmi" then
else ()
else aux f
end (dependencies_of fn);
- needed := fn :: !needed
+ needed := Resources.add fn !needed;
+ needed_in_order := fn :: !needed_in_order
end
in
List.iter aux fns;
- mydprintf "caml_transitive_closure:@ %a ->@ %a" pp_l fns pp_l !needed;
- List.rev !needed
+ mydprintf "caml_transitive_closure:@ %a ->@ %a"
+ pp_l fns pp_l !needed_in_order;
+ List.rev !needed_in_order
+
end
(* -output-obj targets *)
let x_byte_c = "%.byte.c";;
let x_byte_o = "%.byte"-.-ext_obj;;
+let x_byte_so = "%.byte"-.-ext_dll;;
let x_native_o = "%.native"-.-ext_obj;;
+let x_native_so = "%.native"-.-ext_dll;;
rule "target files"
~dep:"%.itarget"
~dep:"%.cmo"
(Ocaml_compiler.byte_output_obj "%.cmo" x_byte_c);;
+rule "ocaml: cmo* -> byte.(so|dll|dylib)"
+ ~prod:x_byte_so
+ ~dep:"%.cmo"
+ ~doc:"The foo.byte.so target, or foo.byte.dll under Windows, \
+ or foo.byte.dylib under Mac OS X will produce a shared library file
+ by passing the -output-obj and -cclib -shared options \
+ to the OCaml compiler. See also foo.native.{so,dll,dylib}."
+ (Ocaml_compiler.byte_output_shared "%.cmo" x_byte_so);;
+
rule "ocaml: p.cmx* & p.o* -> p.native"
~prod:"%.p.native"
~deps:["%.p.cmx"; x_p_o]
~deps:["%.cmx"; x_o]
(Ocaml_compiler.native_output_obj "%.cmx" x_native_o);;
+rule "ocaml: cmx* & o* -> native.(so|dll|dylib)"
+ ~prod:x_native_so
+ ~deps:["%.cmx"; x_o]
+ (Ocaml_compiler.native_output_shared "%.cmx" x_native_so);;
+
rule "ocaml: mllib & d.cmo* -> d.cma"
~prod:"%.d.cma"
~dep:"%.mllib"
flag ["ocaml"; "ocamlyacc"] (atomize !Options.ocaml_yaccflags);;
flag ["ocaml"; "menhir"] (atomize !Options.ocaml_yaccflags);;
flag ["ocaml"; "doc"] (atomize !Options.ocaml_docflags);;
+flag ["ocaml"; "ocamllex"] (atomize !Options.ocaml_lexflags);;
(* Tell menhir to explain conflicts *)
flag [ "ocaml" ; "menhir" ; "explain" ] (S[A "--explain"]);;
+flag [ "ocaml" ; "menhir" ; "infer" ] (S[A "--infer"]);;
-flag ["ocaml"; "ocamllex"] (atomize !Options.ocaml_lexflags);;
+(* Define two ocamlbuild flags [only_tokens] and [external_tokens(Foo)]
+ which correspond to menhir's [--only-tokens] and [--external-tokens Foo].
+ When they are used, these flags should be passed both to [menhir] and to
+ [menhir --raw-depend]. *)
+let () =
+ List.iter begin fun mode ->
+ flag [ mode; "only_tokens" ] (S[A "--only-tokens"]);
+ pflag [ mode ] "external_tokens" (fun name ->
+ S[A "--external-tokens"; A name]);
+ end [ "menhir"; "menhir_ocamldep" ];;
(* Tell ocamllex to generate ml code *)
flag [ "ocaml" ; "ocamllex" ; "generate_ml" ] (S[A "-ml"]);;
(* Ocamlfind will link the archives for us. *)
flag ["ocaml"; "link"; "program"] & A"-linkpkg";
flag ["ocaml"; "link"; "toplevel"] & A"-linkpkg";
+ flag ["ocaml"; "link"; "output_obj"] & A"-linkpkg";
+
+ (* "program" will make sure that -linkpkg is passed when compiling
+ whole-programs (.byte and .native); but it is occasionally
+ useful to pass -linkpkg when building archives for example
+ (.cma and .cmxa); the "linkpkg" flag allows user to request it
+ explicitly. *)
+ flag ["ocaml"; "link"; "linkpkg"] & A"-linkpkg";
+ pflag ["ocaml"; "link"] "dontlink" (fun pkg -> S[A"-dontlink"; A pkg]);
let all_tags = [
["ocaml"; "byte"; "compile"];
(fun param -> S [A "-open"; A param]);
pflag ["ocaml"; "compile"] "open"
(fun param -> S [A "-open"; A param]);
+ pflag ["ocaml"; "link"] "runtime_variant"
+ (fun param -> S [A "-runtime-variant"; A param]);
()
let camlp4_flags camlp4s =
flag ["ocaml"; "debug"; "compile"; "native"] (A "-g");;
flag ["ocaml"; "debug"; "link"; "native"; "program"] (A "-g");;
flag ["ocaml"; "debug"; "pack"; "native"] (A "-g");;
+flag ["c"; "debug"; "compile"] (A "-g");
+flag ["c"; "debug"; "link"] (A "-g");
flag ["ocaml"; "link"; "native"; "output_obj"] (A"-output-obj");;
flag ["ocaml"; "link"; "byte"; "output_obj"] (A"-output-obj");;
+flag ["ocaml"; "link"; "output_shared"] & (S[A"-cclib"; A"-shared"]);;
flag ["ocaml"; "dtypes"; "compile"] (A "-dtypes");;
flag ["ocaml"; "annot"; "compile"] (A "-annot");;
flag ["ocaml"; "annot"; "pack"] (A "-annot");;
flag ["ocaml"; "compile"; "strict_formats";] (A "-strict-formats");;
flag ["ocaml"; "native"; "compile"; "opaque";] (A "-opaque");;
flag ["ocaml"; "native"; "compile"; "no_float_const_prop";] (A "-no-float-const-prop");
+flag ["ocaml"; "compile"; "keep_docs";] (A "-keep-docs");
flag ["ocaml"; "compile"; "keep_locs";] (A "-keep-locs");
flag ["ocaml"; "absname"; "compile"] (A "-absname");;
flag ["ocaml"; "absname"; "infer_interface"] (A "-absname");;
let tags = tags++"ocaml"++"parser"++"menhir" in
Cmd(S[menhir ;
A "--ocamlc"; Quote(S[!Options.ocamlc; T ocamlc_tags; ocaml_include_flags mlypack]);
- T tags ; A "--infer" ; A "--base" ; Px menhir_base ; atomize_paths files])
+ T tags ; A "--base" ; Px menhir_base ; atomize_paths files])
let ocamldep_command arg out env _build =
let arg = env arg and out = env out in
let menhir mly env build =
let mly = env mly in
+ let ml = Pathname.update_extension "ml" 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
+ let ocamlc_tags = tags_of_pathname ml ++"ocaml"++"byte"++"compile" in
+ let menhir_tags = tags_of_pathname mly ++"ocaml"++"parser"++"menhir" in
Ocaml_compiler.prepare_compile build mly;
Cmd(S[menhir;
A"--ocamlc"; Quote(S[!Options.ocamlc; T ocamlc_tags; ocaml_include_flags mly]);
- T menhir_tags; A"--infer"; Px mly])
+ T menhir_tags; Px mly])
let ocamldoc_c tags arg odoc =
let tags = tags++"ocaml" in
in
Ocamlbuild_executor.execute ~exit
+(* Ocamlbuild code assumes throughout that [readlink] will return a file name
+ relative to the current directory. Let's make it so. *)
+let myunixreadlink x =
+ let y = Unix.readlink x in
+ if Filename.is_relative y then
+ Filename.concat (Filename.dirname x) y
+ else
+ y
+
let setup () =
implem.is_degraded <- false;
implem.stdout_isatty <- stdout_isatty;
implem.gettimeofday <- Unix.gettimeofday;
implem.report_error <- report_error;
implem.execute_many <- execute_many;
- implem.readlink <- Unix.readlink;
+ implem.readlink <- myunixreadlink;
implem.run_and_open <- run_and_open;
implem.at_exit_once <- at_exit_once;
implem.is_link <- is_link;
let recursive = ref false
let ext_lib = ref Ocamlbuild_config.a
let ext_obj = ref Ocamlbuild_config.o
-let ext_dll = ref Ocamlbuild_config.so
+let ext_dll =
+ let s = Ocamlbuild_config.ext_dll in
+ ref (String.sub s 1 (String.length s - 1))
let exe = ref Ocamlbuild_config.exe
let targets_internal = ref []
--- /dev/null
+ _____ _ ____
+|_ _|__ ___| |_|___ \
+ | |/ _ \/ __| __| __) |
+ | | __/\__ \ |_ / __/
+ |_|\___||___/\__|_____|
+
+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.opt -modules vivi.ml > vivi.ml.depends
+ocamlc.opt -c -o tyty.cmi tyty.mli
+ocamlc.opt -c -pp camlp4o.opt -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.opt -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: /home/danmey/src/ocaml-trunk/ocamlbuild/test/test2/_build/toto.native: Hello world!!!
+Tutu.tutu => 1
+Tata.tata => "TATA2"
+[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.opt -modules vivi.ml > vivi.ml.depends
+[cache hit] ocamlc.opt -c -pp camlp4o.opt -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.opt -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: /home/danmey/src/ocaml-trunk/ocamlbuild/test/test2/_build/toto.native: Hello world!!!
+Tutu.tutu => 1
+Tata.tata => "TATA2"
+ocamldep.opt -pp camlp4o.opt -modules vivi.ml > vivi.ml.depends
+ocamlc.opt -c -pp camlp4o.opt -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.opt -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: /home/danmey/src/ocaml-trunk/ocamlbuild/test/test2/_build/toto.native: Hello world!!!
+Tutu.tutu => 1
+Tata.tata => "TATA2"
+[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.opt -modules vivi.ml > vivi.ml.depends
+[cache hit] ocamlc.opt -c -pp camlp4o.opt -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.opt -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: /home/danmey/src/ocaml-trunk/ocamlbuild/test/test2/_build/toto.native: Hello world!!!
+Tutu.tutu => 1
+Tata.tata => "TATA2"
+ocamldep.opt -pp camlp4o.opt -modules vivi.ml > vivi.ml.depends
+ocamlc.opt -c -pp camlp4o.opt -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.opt -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: /home/danmey/src/ocaml-trunk/ocamlbuild/test/test2/_build/toto.native: Hello world!!!
+Tutu.tutu => 2
+Tata.tata => "TATA2"
+[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.opt -modules vivi.ml > vivi.ml.depends
+[cache hit] ocamlc.opt -c -pp camlp4o.opt -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.opt -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: /home/danmey/src/ocaml-trunk/ocamlbuild/test/test2/_build/toto.native: Hello world!!!
+Tutu.tutu => 2
+Tata.tata => "TATA2"
+ _____ _ _____
+|_ _|__ ___| |_|___ /
+ | |/ _ \/ __| __| |_ \
+ | | __/\__ \ |_ ___) |
+ |_|\___||___/\__|____/
+
+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
+[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
+ _____ _ _ _
+|_ _|__ ___| |_| || |
+ | |/ _ \/ __| __| || |_
+ | | __/\__ \ |_|__ _|
+ |_|\___||___/\__| |_|
+
+aa.mli.depends
+aa.mli
+aa.ml.depends
+bb.ml.depends
+bb.ml
+aa.ml
+aa.byte
+bb.ml
+aa.ml
+aa.native
+[cache hit] aa.mli.depends
+[cache hit] aa.mli
+[cache hit] aa.ml.depends
+[cache hit] bb.ml.depends
+[cache hit] bb.ml
+[cache hit] aa.ml
+[cache hit] aa.byte
+[cache hit] bb.ml
+[cache hit] aa.ml
+[cache hit] aa.native
+ _____ _ ____
+|_ _|__ ___| |_| ___|
+ | |/ _ \/ __| __|___ \
+ | | __/\__ \ |_ ___) |
+ |_|\___||___/\__|____/
+
+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
++ /home/danmey/src/ocaml-trunk/bin/ocamlc.opt stack.cmo c.cmo d.cmo -o d.byte
+File "stack.cmo", line 1:
+Warning 31: files stack.cmo and /home/danmey/src/ocaml-trunk/lib/ocaml/stdlib.cma(Stack) both define a module named Stack
+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
+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
+[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] 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
+ _____ _ __
+|_ _|__ ___| |_ / /_
+ | |/ _ \/ __| __| '_ \
+ | | __/\__ \ |_| (_) |
+ |_|\___||___/\__|\___/
+
+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
+[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
+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
++ /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules b.mli > b.mli.depends
+File "b.mli", line 13, characters 0-2:
+Error: Syntax error
+Command exited with code 2.
+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
+[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
+PASS
+ _____ _ _____
+|_ _|__ ___| ||___ |
+ | |/ _ \/ __| __| / /
+ | | __/\__ \ |_ / /
+ |_|\___||___/\__/_/
+
+ocamlbuild.cmx -o myocamlbuild
+/home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules bb.mli > bb.mli.depends
+/home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o bb.cmi bb.mli
+/home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules bb.ml > bb.ml.depends
+/home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules cc.ml > cc.ml.depends
+/home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules aa.ml > aa.ml.depends
+/home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules c2.mli > c2.mli.depends
+/home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o aa.cmo aa.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o c2.cmi c2.mli
+/home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o bb.cmo bb.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o cc.cmo cc.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlc.opt -a bb.cmo cc.cmo -o bbcc.cma
+/home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules main.ml > main.ml.depends
+/home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules c3.ml > c3.ml.depends
+/home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o c3.cmo c3.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o main.cmo main.ml
+/home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules cool_plugin.ml > cool_plugin.ml.depends
+/home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o cool_plugin.cmo cool_plugin.ml
+/home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules c2.ml > c2.ml.depends
+/home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o c2.cmo c2.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlc.opt aa.cmo c2.cmo bbcc.cma c3.cmo main.cmo cool_plugin.cmo -o main.byte
+/home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o bb.cmx bb.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o aa.cmx aa.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o c2.cmx c2.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o cc.cmx cc.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -a bb.cmx cc.cmx -o bbcc.cmxa
+/home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o c3.cmx c3.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o main.cmx main.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlopt.opt aa.cmx c2.cmx bbcc.cmxa c3.cmx main.cmx -o main.native
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules bb.mli > bb.mli.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o bb.cmi bb.mli
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules bb.ml > bb.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o bb.cmo bb.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules cc.ml > cc.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules aa.ml > aa.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o aa.cmo aa.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules c2.mli > c2.mli.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o c2.cmi c2.mli
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o cc.cmo cc.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -a bb.cmo cc.cmo -o bbcc.cma
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules main.ml > main.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules c3.ml > c3.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o c3.cmo c3.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o main.cmo main.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules cool_plugin.ml > cool_plugin.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o cool_plugin.cmo cool_plugin.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules c2.ml > c2.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o c2.cmo c2.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt aa.cmo c2.cmo bbcc.cma c3.cmo main.cmo cool_plugin.cmo -o main.byte
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o bb.cmx bb.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o aa.cmx aa.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o c2.cmx c2.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o cc.cmx cc.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -a bb.cmx cc.cmx -o bbcc.cmxa
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o c3.cmx c3.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o main.cmx main.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt aa.cmx c2.cmx bbcc.cmxa c3.cmx main.cmx -o main.native
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules bb.mli > bb.mli.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o bb.cmi bb.mli
+/home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules bb.ml > bb.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules cc.ml > cc.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules aa.ml > aa.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o aa.cmo aa.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules c2.mli > c2.mli.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o c2.cmi c2.mli
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o cc.cmo cc.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o bb.cmo bb.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlc.opt -a bb.cmo cc.cmo -o bbcc.cma
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules main.ml > main.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules c3.ml > c3.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o c3.cmo c3.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o main.cmo main.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules cool_plugin.ml > cool_plugin.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o cool_plugin.cmo cool_plugin.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules c2.ml > c2.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o c2.cmo c2.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlc.opt aa.cmo c2.cmo bbcc.cma c3.cmo main.cmo cool_plugin.cmo -o main.byte
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o aa.cmx aa.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o bb.cmx bb.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o c2.cmx c2.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o cc.cmx cc.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -a bb.cmx cc.cmx -o bbcc.cmxa
+/home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o c3.cmx c3.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o main.cmx main.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlopt.opt aa.cmx c2.cmx bbcc.cmxa c3.cmx main.cmx -o main.native
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules bb.mli > bb.mli.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o bb.cmi bb.mli
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules bb.ml > bb.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o bb.cmo bb.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules cc.ml > cc.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules aa.ml > aa.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o aa.cmo aa.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules c2.mli > c2.mli.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o c2.cmi c2.mli
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o cc.cmo cc.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -a bb.cmo cc.cmo -o bbcc.cma
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules main.ml > main.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules c3.ml > c3.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o c3.cmo c3.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o main.cmo main.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules cool_plugin.ml > cool_plugin.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o cool_plugin.cmo cool_plugin.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules c2.ml > c2.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o c2.cmo c2.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt aa.cmo c2.cmo bbcc.cma c3.cmo main.cmo cool_plugin.cmo -o main.byte
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o bb.cmx bb.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o aa.cmx aa.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o c2.cmx c2.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o cc.cmx cc.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -a bb.cmx cc.cmx -o bbcc.cmxa
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o c3.cmx c3.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o main.cmx main.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt aa.cmx c2.cmx bbcc.cmxa c3.cmx main.cmx -o main.native
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules bb.mli > bb.mli.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o bb.cmi bb.mli
+/home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules bb.ml > bb.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules cc.ml > cc.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules aa.ml > aa.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o aa.cmo aa.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules c2.mli > c2.mli.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o c2.cmi c2.mli
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o cc.cmo cc.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o bb.cmo bb.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlc.opt -a bb.cmo cc.cmo -o bbcc.cma
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules main.ml > main.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules c3.ml > c3.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o c3.cmo c3.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o main.cmo main.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules cool_plugin.ml > cool_plugin.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o cool_plugin.cmo cool_plugin.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules c2.ml > c2.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o c2.cmo c2.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlc.opt aa.cmo c2.cmo bbcc.cma c3.cmo main.cmo cool_plugin.cmo -o main.byte
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o aa.cmx aa.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o bb.cmx bb.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o c2.cmx c2.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o cc.cmx cc.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -a bb.cmx cc.cmx -o bbcc.cmxa
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o c3.cmx c3.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o main.cmx main.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlopt.opt aa.cmx c2.cmx bbcc.cmxa c3.cmx main.cmx -o main.native
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules bb.mli > bb.mli.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o bb.cmi bb.mli
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules bb.ml > bb.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o bb.cmo bb.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules cc.ml > cc.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules aa.ml > aa.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o aa.cmo aa.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules c2.mli > c2.mli.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o c2.cmi c2.mli
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o cc.cmo cc.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -a bb.cmo cc.cmo -o bbcc.cma
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules main.ml > main.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules c3.ml > c3.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o c3.cmo c3.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o main.cmo main.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules cool_plugin.ml > cool_plugin.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o cool_plugin.cmo cool_plugin.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules c2.ml > c2.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o c2.cmo c2.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt aa.cmo c2.cmo bbcc.cma c3.cmo main.cmo cool_plugin.cmo -o main.byte
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o bb.cmx bb.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o aa.cmx aa.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o c2.cmx c2.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o cc.cmx cc.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -a bb.cmx cc.cmx -o bbcc.cmxa
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o c3.cmx c3.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o main.cmx main.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt aa.cmx c2.cmx bbcc.cmxa c3.cmx main.cmx -o main.native
+ _____ _ ___
+|_ _|__ ___| |_( _ )
+ | |/ _ \/ __| __/ _ \
+ | | __/\__ \ || (_) |
+ |_|\___||___/\__\___/
+
+ocamlbuild.cmx -o myocamlbuild
+/home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules a.ml > a.ml.depends
+/home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules myconfig.ml > myconfig.ml.depends
+/home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o myconfig.cmo myconfig.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o a.cmo a.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlc.opt myconfig.cmo a.cmo -o a.byte
+/home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o myconfig.cmx myconfig.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o a.cmx a.ml
+/home/danmey/src/ocaml-trunk/bin/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
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules a.ml > a.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules myconfig.ml > myconfig.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o myconfig.cmo myconfig.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -o a.cmo a.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt myconfig.cmo a.cmo -o a.byte
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o myconfig.cmx myconfig.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -o a.cmx a.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/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
+ _____ _ ___
+|_ _|__ ___| |_ / _ \
+ | |/ _ \/ __| __| (_) |
+ | | __/\__ \ |_ \__, |
+ |_|\___||___/\__| /_/
+
+Globexp for "\"hello\"" OK
+Globexp for "<hello>" OK
+Globexp for "<hel*lo>" OK
+Globexp for "<a> and <b> or <c>" OK
+Globexp for "<a> 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>" "hello" = true OK
+Glob.eval "<hello>" "helli" = false OK
+Glob.eval "<hello>" "hello" = true OK
+Glob.eval "<hello>" "helli" = false OK
+Glob.eval "<hello>" "hello" = true OK
+Glob.eval "<hello>" "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 "<a*b>" "ab" = true OK
+Glob.eval "<a*b>" "acb" = true OK
+Glob.eval "<a*b>" "axxxxxb" = true OK
+Glob.eval "<a*b>" "ababbababb" = true OK
+Glob.eval "<a*b>" "abx" = false OK
+Glob.eval "<a*b>" "xxxxxab" = false OK
+Glob.eval "<a*b>" "xab" = false OK
+Glob.eval "<a*b>" "ab" = true OK
+Glob.eval "<a*b>" "acb" = true OK
+Glob.eval "<a*b>" "axxxxxb" = true OK
+Glob.eval "<a*b>" "ababbababb" = true OK
+Glob.eval "<a*b>" "abx" = false OK
+Glob.eval "<a*b>" "xxxxxab" = false OK
+Glob.eval "<a*b>" "xab" = false OK
+Glob.eval "<a*b>" "ab" = true OK
+Glob.eval "<a*b>" "acb" = true OK
+Glob.eval "<a*b>" "axxxxxb" = true OK
+Glob.eval "<a*b>" "ababbababb" = true OK
+Glob.eval "<a*b>" "abx" = false OK
+Glob.eval "<a*b>" "xxxxxab" = false OK
+Glob.eval "<a*b>" "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>" "a" = true OK
+Glob.eval "<a>" "" = false OK
+Glob.eval "<a>" "aa" = false OK
+Glob.eval "<a>" "ba" = false OK
+Glob.eval "<a>" "ab" = false OK
+Glob.eval "<a>" "abaa" = false OK
+Glob.eval "<a>" "a" = true OK
+Glob.eval "<a>" "" = false OK
+Glob.eval "<a>" "aa" = false OK
+Glob.eval "<a>" "ba" = false OK
+Glob.eval "<a>" "ab" = false OK
+Glob.eval "<a>" "abaa" = false OK
+Glob.eval "<a>" "a" = true OK
+Glob.eval "<a>" "" = false OK
+Glob.eval "<a>" "aa" = false OK
+Glob.eval "<a>" "ba" = false OK
+Glob.eval "<a>" "ab" = false OK
+Glob.eval "<a>" "abaa" = false OK
+Glob.eval "<ab>" "ab" = true OK
+Glob.eval "<ab>" "" = false OK
+Glob.eval "<ab>" "abab" = false OK
+Glob.eval "<ab>" "aba" = false OK
+Glob.eval "<ab>" "abx" = false OK
+Glob.eval "<ab>" "ab" = true OK
+Glob.eval "<ab>" "" = false OK
+Glob.eval "<ab>" "abab" = false OK
+Glob.eval "<ab>" "aba" = false OK
+Glob.eval "<ab>" "abx" = false OK
+Glob.eval "<ab>" "ab" = true OK
+Glob.eval "<ab>" "" = false OK
+Glob.eval "<ab>" "abab" = false OK
+Glob.eval "<ab>" "aba" = false OK
+Glob.eval "<ab>" "abx" = false OK
+Glob.eval "<ab?c>" "abac" = true OK
+Glob.eval "<ab?c>" "abxc" = true OK
+Glob.eval "<ab?c>" "abab" = false OK
+Glob.eval "<ab?c>" "ababab" = false OK
+Glob.eval "<ab?c>" "ababa" = false OK
+Glob.eval "<ab?c>" "abac" = true OK
+Glob.eval "<ab?c>" "abxc" = true OK
+Glob.eval "<ab?c>" "abab" = false OK
+Glob.eval "<ab?c>" "ababab" = false OK
+Glob.eval "<ab?c>" "ababa" = false OK
+Glob.eval "<ab?c>" "abac" = true OK
+Glob.eval "<ab?c>" "abxc" = true OK
+Glob.eval "<ab?c>" "abab" = false OK
+Glob.eval "<ab?c>" "ababab" = false OK
+Glob.eval "<ab?c>" "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 "<b*>" "bxx" = true OK
+Glob.eval "<b*>" "bx" = true OK
+Glob.eval "<b*>" "aaab" = false OK
+Glob.eval "<b*>" "" = false OK
+Glob.eval "<b*>" "bxx" = true OK
+Glob.eval "<b*>" "bx" = true OK
+Glob.eval "<b*>" "aaab" = false OK
+Glob.eval "<b*>" "" = false OK
+Glob.eval "<b*>" "bxx" = true OK
+Glob.eval "<b*>" "bx" = true OK
+Glob.eval "<b*>" "aaab" = false OK
+Glob.eval "<b*>" "" = 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,mli}>" "toto.ml" = true OK
+Glob.eval "<toto.{ml,mli}>" "toto.mli" = true OK
+Glob.eval "<toto.{ml,mli}>" "toto." = false OK
+Glob.eval "<toto.{ml,mli}>" "toto.mll" = false OK
+Glob.eval "<toto.{ml,mli}>" "toto.ml" = true OK
+Glob.eval "<toto.{ml,mli}>" "toto.mli" = true OK
+Glob.eval "<toto.{ml,mli}>" "toto." = false OK
+Glob.eval "<toto.{ml,mli}>" "toto.mll" = false OK
+Glob.eval "<toto.{ml,mli}>" "toto.ml" = true OK
+Glob.eval "<toto.{ml,mli}>" "toto.mli" = true OK
+Glob.eval "<toto.{ml,mli}>" "toto." = false OK
+Glob.eval "<toto.{ml,mli}>" "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>" "alpha/beta" = true OK
+Glob.eval "<alpha/**/beta>" "alpha/gamma/beta" = true OK
+Glob.eval "<alpha/**/beta>" "alpha/gamma/delta/beta" = true OK
+Glob.eval "<alpha/**/beta>" "alpha" = false OK
+Glob.eval "<alpha/**/beta>" "beta" = false OK
+Glob.eval "<alpha/**/beta>" "gamma/delta" = false OK
+Glob.eval "<alpha/**/beta>" "alpha/beta" = true OK
+Glob.eval "<alpha/**/beta>" "alpha/gamma/beta" = true OK
+Glob.eval "<alpha/**/beta>" "alpha/gamma/delta/beta" = true OK
+Glob.eval "<alpha/**/beta>" "alpha" = false OK
+Glob.eval "<alpha/**/beta>" "beta" = false OK
+Glob.eval "<alpha/**/beta>" "gamma/delta" = false OK
+Glob.eval "<alpha/**/beta>" "alpha/beta" = true OK
+Glob.eval "<alpha/**/beta>" "alpha/gamma/beta" = true OK
+Glob.eval "<alpha/**/beta>" "alpha/gamma/delta/beta" = true OK
+Glob.eval "<alpha/**/beta>" "alpha" = false OK
+Glob.eval "<alpha/**/beta>" "beta" = false OK
+Glob.eval "<alpha/**/beta>" "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/**>" "toto/" = true OK
+Glob.eval "<toto/**>" "toto/tata" = true OK
+Glob.eval "<toto/**>" "toto/alpha/gamma/delta/beta.ml" = true OK
+Glob.eval "<toto/**>" "toto" = true OK
+Glob.eval "<toto/**>" "toto2/tata" = false OK
+Glob.eval "<toto/**>" "tata/titi" = false OK
+Glob.eval "<toto/**>" "toto/" = true OK
+Glob.eval "<toto/**>" "toto/tata" = true OK
+Glob.eval "<toto/**>" "toto/alpha/gamma/delta/beta.ml" = true OK
+Glob.eval "<toto/**>" "toto" = true OK
+Glob.eval "<toto/**>" "toto2/tata" = false OK
+Glob.eval "<toto/**>" "tata/titi" = false OK
+Glob.eval "<toto/**>" "toto/" = true OK
+Glob.eval "<toto/**>" "toto/tata" = true OK
+Glob.eval "<toto/**>" "toto/alpha/gamma/delta/beta.ml" = true OK
+Glob.eval "<toto/**>" "toto" = true OK
+Glob.eval "<toto/**>" "toto2/tata" = false OK
+Glob.eval "<toto/**>" "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
+ _____ _ _ ___
+|_ _|__ ___| |_/ |/ _ \
+ | |/ _ \/ __| __| | | | |
+ | | __/\__ \ |_| | |_| |
+ |_|\___||___/\__|_|\___/
+
+Globexp for "\"hello\"" OK
+Globexp for "<hello>" OK
+Globexp for "<hel*lo>" OK
+Globexp for "<a> and <b> or <c>" OK
+Globexp for "<a> 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>" "hello" = true OK
+Glob.eval "<hello>" "helli" = false OK
+Glob.eval "<hello>" "hello" = true OK
+Glob.eval "<hello>" "helli" = false OK
+Glob.eval "<hello>" "hello" = true OK
+Glob.eval "<hello>" "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 "<a*b>" "ab" = true OK
+Glob.eval "<a*b>" "acb" = true OK
+Glob.eval "<a*b>" "axxxxxb" = true OK
+Glob.eval "<a*b>" "ababbababb" = true OK
+Glob.eval "<a*b>" "abx" = false OK
+Glob.eval "<a*b>" "xxxxxab" = false OK
+Glob.eval "<a*b>" "xab" = false OK
+Glob.eval "<a*b>" "ab" = true OK
+Glob.eval "<a*b>" "acb" = true OK
+Glob.eval "<a*b>" "axxxxxb" = true OK
+Glob.eval "<a*b>" "ababbababb" = true OK
+Glob.eval "<a*b>" "abx" = false OK
+Glob.eval "<a*b>" "xxxxxab" = false OK
+Glob.eval "<a*b>" "xab" = false OK
+Glob.eval "<a*b>" "ab" = true OK
+Glob.eval "<a*b>" "acb" = true OK
+Glob.eval "<a*b>" "axxxxxb" = true OK
+Glob.eval "<a*b>" "ababbababb" = true OK
+Glob.eval "<a*b>" "abx" = false OK
+Glob.eval "<a*b>" "xxxxxab" = false OK
+Glob.eval "<a*b>" "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>" "a" = true OK
+Glob.eval "<a>" "" = false OK
+Glob.eval "<a>" "aa" = false OK
+Glob.eval "<a>" "ba" = false OK
+Glob.eval "<a>" "ab" = false OK
+Glob.eval "<a>" "abaa" = false OK
+Glob.eval "<a>" "a" = true OK
+Glob.eval "<a>" "" = false OK
+Glob.eval "<a>" "aa" = false OK
+Glob.eval "<a>" "ba" = false OK
+Glob.eval "<a>" "ab" = false OK
+Glob.eval "<a>" "abaa" = false OK
+Glob.eval "<a>" "a" = true OK
+Glob.eval "<a>" "" = false OK
+Glob.eval "<a>" "aa" = false OK
+Glob.eval "<a>" "ba" = false OK
+Glob.eval "<a>" "ab" = false OK
+Glob.eval "<a>" "abaa" = false OK
+Glob.eval "<ab>" "ab" = true OK
+Glob.eval "<ab>" "" = false OK
+Glob.eval "<ab>" "abab" = false OK
+Glob.eval "<ab>" "aba" = false OK
+Glob.eval "<ab>" "abx" = false OK
+Glob.eval "<ab>" "ab" = true OK
+Glob.eval "<ab>" "" = false OK
+Glob.eval "<ab>" "abab" = false OK
+Glob.eval "<ab>" "aba" = false OK
+Glob.eval "<ab>" "abx" = false OK
+Glob.eval "<ab>" "ab" = true OK
+Glob.eval "<ab>" "" = false OK
+Glob.eval "<ab>" "abab" = false OK
+Glob.eval "<ab>" "aba" = false OK
+Glob.eval "<ab>" "abx" = false OK
+Glob.eval "<ab?c>" "abac" = true OK
+Glob.eval "<ab?c>" "abxc" = true OK
+Glob.eval "<ab?c>" "abab" = false OK
+Glob.eval "<ab?c>" "ababab" = false OK
+Glob.eval "<ab?c>" "ababa" = false OK
+Glob.eval "<ab?c>" "abac" = true OK
+Glob.eval "<ab?c>" "abxc" = true OK
+Glob.eval "<ab?c>" "abab" = false OK
+Glob.eval "<ab?c>" "ababab" = false OK
+Glob.eval "<ab?c>" "ababa" = false OK
+Glob.eval "<ab?c>" "abac" = true OK
+Glob.eval "<ab?c>" "abxc" = true OK
+Glob.eval "<ab?c>" "abab" = false OK
+Glob.eval "<ab?c>" "ababab" = false OK
+Glob.eval "<ab?c>" "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 "<b*>" "bxx" = true OK
+Glob.eval "<b*>" "bx" = true OK
+Glob.eval "<b*>" "aaab" = false OK
+Glob.eval "<b*>" "" = false OK
+Glob.eval "<b*>" "bxx" = true OK
+Glob.eval "<b*>" "bx" = true OK
+Glob.eval "<b*>" "aaab" = false OK
+Glob.eval "<b*>" "" = false OK
+Glob.eval "<b*>" "bxx" = true OK
+Glob.eval "<b*>" "bx" = true OK
+Glob.eval "<b*>" "aaab" = false OK
+Glob.eval "<b*>" "" = 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,mli}>" "toto.ml" = true OK
+Glob.eval "<toto.{ml,mli}>" "toto.mli" = true OK
+Glob.eval "<toto.{ml,mli}>" "toto." = false OK
+Glob.eval "<toto.{ml,mli}>" "toto.mll" = false OK
+Glob.eval "<toto.{ml,mli}>" "toto.ml" = true OK
+Glob.eval "<toto.{ml,mli}>" "toto.mli" = true OK
+Glob.eval "<toto.{ml,mli}>" "toto." = false OK
+Glob.eval "<toto.{ml,mli}>" "toto.mll" = false OK
+Glob.eval "<toto.{ml,mli}>" "toto.ml" = true OK
+Glob.eval "<toto.{ml,mli}>" "toto.mli" = true OK
+Glob.eval "<toto.{ml,mli}>" "toto." = false OK
+Glob.eval "<toto.{ml,mli}>" "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>" "alpha/beta" = true OK
+Glob.eval "<alpha/**/beta>" "alpha/gamma/beta" = true OK
+Glob.eval "<alpha/**/beta>" "alpha/gamma/delta/beta" = true OK
+Glob.eval "<alpha/**/beta>" "alpha" = false OK
+Glob.eval "<alpha/**/beta>" "beta" = false OK
+Glob.eval "<alpha/**/beta>" "gamma/delta" = false OK
+Glob.eval "<alpha/**/beta>" "alpha/beta" = true OK
+Glob.eval "<alpha/**/beta>" "alpha/gamma/beta" = true OK
+Glob.eval "<alpha/**/beta>" "alpha/gamma/delta/beta" = true OK
+Glob.eval "<alpha/**/beta>" "alpha" = false OK
+Glob.eval "<alpha/**/beta>" "beta" = false OK
+Glob.eval "<alpha/**/beta>" "gamma/delta" = false OK
+Glob.eval "<alpha/**/beta>" "alpha/beta" = true OK
+Glob.eval "<alpha/**/beta>" "alpha/gamma/beta" = true OK
+Glob.eval "<alpha/**/beta>" "alpha/gamma/delta/beta" = true OK
+Glob.eval "<alpha/**/beta>" "alpha" = false OK
+Glob.eval "<alpha/**/beta>" "beta" = false OK
+Glob.eval "<alpha/**/beta>" "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/**>" "toto/" = true OK
+Glob.eval "<toto/**>" "toto/tata" = true OK
+Glob.eval "<toto/**>" "toto/alpha/gamma/delta/beta.ml" = true OK
+Glob.eval "<toto/**>" "toto" = true OK
+Glob.eval "<toto/**>" "toto2/tata" = false OK
+Glob.eval "<toto/**>" "tata/titi" = false OK
+Glob.eval "<toto/**>" "toto/" = true OK
+Glob.eval "<toto/**>" "toto/tata" = true OK
+Glob.eval "<toto/**>" "toto/alpha/gamma/delta/beta.ml" = true OK
+Glob.eval "<toto/**>" "toto" = true OK
+Glob.eval "<toto/**>" "toto2/tata" = false OK
+Glob.eval "<toto/**>" "tata/titi" = false OK
+Glob.eval "<toto/**>" "toto/" = true OK
+Glob.eval "<toto/**>" "toto/tata" = true OK
+Glob.eval "<toto/**>" "toto/alpha/gamma/delta/beta.ml" = true OK
+Glob.eval "<toto/**>" "toto" = true OK
+Glob.eval "<toto/**>" "toto2/tata" = false OK
+Glob.eval "<toto/**>" "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
+ _____ _ _ _
+|_ _|__ ___| |_/ / |
+ | |/ _ \/ __| __| | |
+ | | __/\__ \ |_| | |
+ |_|\___||___/\__|_|_|
+
+ocamlbuild.cmx -o myocamlbuild
+/home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules a/aa.mli > a/aa.mli.depends
+/home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -I a -I b -o a/aa.cmi a/aa.mli
+/home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules a/aa.ml > a/aa.ml.depends
+/home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules b/bb.ml > b/bb.ml.depends
+/home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -I b -I a -o b/bb.cmo b/bb.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -I a -I b -o a/aa.cmo a/aa.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlc.opt -a b/bb.cmo -o b/libb.cma
+/home/danmey/src/ocaml-trunk/bin/ocamlc.opt b/libb.cma a/aa.cmo -o a/aa.byte
+/home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -I b -I a -o b/bb.cmx b/bb.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -I a -I b -o a/aa.cmx a/aa.ml
+/home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -a b/bb.cmx -o b/libb.cmxa
+/home/danmey/src/ocaml-trunk/bin/ocamlopt.opt b/libb.cmxa a/aa.cmx -o a/aa.native
+looks if libs are there
+_build/b/libb.a
+_build/b/libb.cma
+_build/b/libb.cmxa
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules a/aa.mli > a/aa.mli.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -I a -I b -o a/aa.cmi a/aa.mli
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules a/aa.ml > a/aa.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamldep.opt -modules b/bb.ml > b/bb.ml.depends
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -I b -I a -o b/bb.cmo b/bb.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -c -I a -I b -o a/aa.cmo a/aa.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt -a b/bb.cmo -o b/libb.cma
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlc.opt b/libb.cma a/aa.cmo -o a/aa.byte
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -I b -I a -o b/bb.cmx b/bb.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -c -I a -I b -o a/aa.cmx a/aa.ml
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt -a b/bb.cmx -o b/libb.cmxa
+[cache hit] /home/danmey/src/ocaml-trunk/bin/ocamlopt.opt b/libb.cmxa a/aa.cmx -o a/aa.native
+ _____ _ _ ____
+|_ _|__ ___| |_/ |___ \
+ | |/ _ \/ __| __| | __) |
+ | | __/\__ \ |_| |/ __/
+ |_|\___||___/\__|_|_____|
+
+ocamldep.opt -modules Main.ml > Main.ml.depends
+Packed.ml.depends
+Lib.mli.depends
+Lib.mli
+Packed.ml
+Packed.cmo -o Pack.cmo
+ocamlc.opt -c -I lib -o Main.cmo Main.ml
+Lib.ml.depends
+Lib.ml
+Packed.ml
+Packed.cmx -o Pack.cmx ; then rm -f Pack.mli ; else rm -f Pack.mli ; exit 1; fi
+ocamlopt.opt -c -I lib -o Main.cmx Main.ml
+Lib.cmx Pack.cmx Main.cmx -o Main.native
+Lib.ml
+Lib.cmo Pack.cmo Main.cmo -o Main.byte
+looks if executable are there
+_build/Main.byte
+_build/Main.byte
+_build/Main.native
+ _____ _ __ ___ _ _
+|_ _|__ ___| |_ \ \ / (_)_ __| |_ _ _ __ _| |
+ | |/ _ \/ __| __| \ \ / /| | '__| __| | | |/ _` | |
+ | | __/\__ \ |_ \ V / | | | | |_| |_| | (_| | |
+ |_|\___||___/\__| \_/ |_|_| \__|\__,_|\__,_|_|
+
+ _____ _
+|_ _|_ _ _ __ __ _ ___| |_ ___
+ | |/ _` | '__/ _` |/ _ \ __/ __|
+ | | (_| | | | (_| | __/ |_\__ \
+ |_|\__,_|_| \__, |\___|\__|___/
+ |___/
--- /dev/null
+#########################################################################
+# #
+# OCaml #
+# #
+# 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. #
+# #
+#########################################################################
+
+#!/bin/sh
+set -e
+cd `dirname $0`
+
+export OCB=$PWD/../../_build/ocamlbuild/ocamlbuild.native
+
+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 Test10
+./test10/test.sh $@
+$BANNER Test11
+./test11/test.sh $@
+$BANNER Test12
+./test12/test.sh $@
+$BANNER Test Virtual Targets
+./test_virtual/test.sh $@
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(***********************************************************************)
+
+module MA1 = A1
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(***********************************************************************)
+
+#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";;
--- /dev/null
+#########################################################################
+# #
+# OCaml #
+# #
+# 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. #
+# #
+#########################################################################
+
+#!/bin/sh
+set -e
+set -x
+cd `dirname $0`/../..
+$OCB -quiet -build-dir _buildtest -no-links test/test9/testglob.native
+./_buildtest/test/test9/testglob.native
--- /dev/null
+#########################################################################
+# #
+# OCaml #
+# #
+# 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. #
+# #
+#########################################################################
+
+# a comment
+"a/aa.byte" or "a/aa.native": use_libb
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 bar = 3 + List.length Bb.foo
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 bar : int
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 foo = [2.2]
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 Ocamlbuild_plugin;;
+dispatch begin function
+| After_rules -> ocaml_lib "b/libb"
+| _ -> ()
+end
--- /dev/null
+#########################################################################
+# #
+# OCaml #
+# #
+# 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. #
+# #
+#########################################################################
+
+#!/bin/sh
+cd `dirname $0`
+set -e
+set -x
+CMDOTPS="" # -- command args
+BUILD="$OCB -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
--- /dev/null
+#########################################################################
+# #
+# OCaml #
+# #
+# 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. #
+# #
+#########################################################################
+
+"vivi.ml": camlp4o
+
+# , some_useless_tag, \ more_useless_tags
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 tata = "TATA2"
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(***********************************************************************)
+
+(* a comment *)
+val tata : string
--- /dev/null
+#########################################################################
+# #
+# OCaml #
+# #
+# 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. #
+# #
+#########################################################################
+
+#!/bin/sh
+cd `dirname $0`
+set -e
+set -x
+CMDOPTS="-- -help"
+BUILD="$OCB 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
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 titi = []
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 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
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 tutu = (Array.length Vivi.vivi : Tyty.t)
+let tutu' = 2.0 +. float_of_int tutu
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(***********************************************************************)
+
+(* a comment *)
+val tutu : int
+val tutu' : float
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 t = int
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 rec p i = [< '1; '2; p (i + 1) >]
+let vivi = [|2|]
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 rec p i = [< '1; '2; p (i + 1) >]
+let vivi = [|3|]
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 rec p i = [< '1; '2; p (i + 1) >]
+let vivi = [|2.1; 1.1|]
--- /dev/null
+#########################################################################
+# #
+# OCaml #
+# #
+# 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. #
+# #
+#########################################################################
+
+"a.byte" or "a.native": use_unix
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(***********************************************************************)
+
+module X = B
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(***********************************************************************)
+
+(* Nothing *)
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(***********************************************************************)
+
+module X = C
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(***********************************************************************)
+
+(* nothing *)
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(***********************************************************************)
+
+module X = D
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(***********************************************************************)
+
+(* nothing *)
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(***********************************************************************)
+
+module X = E
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(***********************************************************************)
+
+(* nothing *)
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(***********************************************************************)
+
+module X = F
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(***********************************************************************)
+
+(* nothing *)
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(***********************************************************************)
+
+(* nothing *)
+let _ = Unix.stat
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(***********************************************************************)
+
+(* nothing *)
--- /dev/null
+A B C D E F
--- /dev/null
+#########################################################################
+# #
+# OCaml #
+# #
+# 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. #
+# #
+#########################################################################
+
+#!/bin/sh
+cd `dirname $0`
+set -e
+set -x
+CMDOTPS="" # -- command args
+BUILD="$OCB 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
--- /dev/null
+#########################################################################
+# #
+# OCaml #
+# #
+# 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. #
+# #
+#########################################################################
+
+# a comment
+"a/aa.byte" or "a/aa.native": use_str
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 bar = 3 + List.length Bb.foo
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 bar : int
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 r = Str.regexp "r"
+let foo = [2.2]
--- /dev/null
+#########################################################################
+# #
+# OCaml #
+# #
+# 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. #
+# #
+#########################################################################
+
+#!/bin/sh
+cd `dirname $0`
+set -e
+set -x
+CMDOTPS="" # -- command args
+BUILD="$OCB -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
--- /dev/null
+#########################################################################
+# #
+# OCaml #
+# #
+# 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. #
+# #
+#########################################################################
+
+"a.cmx" or "b.cmx": for-pack(C)
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 a = 42 + Stack.stack
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 a : int
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 b = A.a + 1
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(***********************************************************************)
+
+Format.printf "C.B.b = %d@." C.B.b
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 stack = 42
--- /dev/null
+#########################################################################
+# #
+# OCaml #
+# #
+# 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. #
+# #
+#########################################################################
+
+#!/bin/sh
+cd `dirname $0`
+set -e
+set -x
+CMDOPTS="" # -- command args
+BUILD="$OCB 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
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 a = B.b
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 a : 'a -> 'a
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 b = D.d
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 b : 'a -> 'a
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 b : 'a -> 'a
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 b : 'a -> 'a
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 t
+let d x = x
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 d : 'a -> 'a
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 t
+val d : 'a -> 'a
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 d : 'a -> 'a
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(***********************************************************************)
+
+A.a 2. +. D.d 1.
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(***********************************************************************)
+
+(* nothing *)
--- /dev/null
+#########################################################################
+# #
+# OCaml #
+# #
+# 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. #
+# #
+#########################################################################
+
+#!/bin/sh
+cd `dirname $0`
+set -x
+rm -rf _build
+CMDOPTS="" # -- command args
+BUILD="$OCB -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
--- /dev/null
+#########################################################################
+# #
+# OCaml #
+# #
+# 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. #
+# #
+#########################################################################
+
+"main.byte": my_cool_plugin
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 aa = "aa"
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 bb : int
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 bb = 43
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 bb = 43
+let f x = x + 1
+let () = incr (ref 0)
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 bb = 43
+let f x = x + 1
+let () = incr (ref 1)
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 c2 = 12
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 c2 : int
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 c3 = Bb.bb + 13
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 cc = (String.length Aa.aa) + Bb.bb + C2.c2
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(***********************************************************************)
+
+print_endline "I am a cool plugin"
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 main = String.length Aa.aa - Bb.bb - C3.c3 - Cc.cc - 1
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 Ocamlbuild_plugin;;
+dispatch begin function
+| After_rules ->
+ use_lib "main" "bbcc";
+ dep ["ocaml"; "link"; "byte"; "my_cool_plugin"] ["cool_plugin.cmo"];
+| _ -> ()
+end
--- /dev/null
+#########################################################################
+# #
+# OCaml #
+# #
+# 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. #
+# #
+#########################################################################
+
+#!/bin/sh
+cd `dirname $0`
+set -e
+set -x
+CMDOPTS="" # -- command args
+BUILD="$OCB 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
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(***********************************************************************)
+
+print_endline Myconfig.version;;
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 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
--- /dev/null
+#########################################################################
+# #
+# OCaml #
+# #
+# 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. #
+# #
+#########################################################################
+
+#!/bin/sh
+cd `dirname $0`
+set -e
+set -x
+CMDOPTS="" # -- command args
+BUILD="$OCB 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
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(***********************************************************************)
+
+#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;;
--- /dev/null
+#########################################################################
+# #
+# OCaml #
+# #
+# 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. #
+# #
+#########################################################################
+
+#!/bin/sh
+set -e
+set -x
+cd `dirname $0`/../..
+$OCB -quiet -build-dir _buildtest -no-links test/test9/testglob.native $@
+./_buildtest/test/test9/testglob.native
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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. *)
+(* *)
+(***********************************************************************)
+
+(* Testglob *)
+
+open Bool;;
+open Glob;;
+
+let yep f x =
+ try
+ ignore (f x);
+ true
+ with
+ | _ -> false
+;;
+
+let tests1 = [
+ "\"hello\"", true;
+ "<hello>", true;
+ "<hel*lo>", true;
+ "<a> and <b> or <c>", true;
+ "<a> 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>", ["hello"], ["helli"];
+ "\"hello\"", ["hello"], ["heidi"];
+ "<*>", ["";"a";"ax"], [];
+ "<a*b>", ["ab";"acb";"axxxxxb";"ababbababb"], ["abx";"xxxxxab";"xab"];
+ "<*.ml>", ["hello.ml";".ml"], ["ml"; ""; "toto.mli"];
+ "<a>", ["a"], ["";"aa";"ba";"ab";"abaa"];
+ "<ab>", ["ab"], ["";"abab";"aba";"abx"];
+ "<ab?c>", ["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"];
+ "<b*>", ["bxx";"bx"], ["aaab";""];
+ "<*>", ["";"a";"aaa";"aaaaa"], [];
+ "<?>", ["a"],["";"aaa";"aaaaa"];
+ "<{a,b}>", ["a";"b"],["";"aa";"ab";"ba";"bb";"c"];
+ "<toto.{ml,mli}>", ["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/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/";"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
+;;
--- /dev/null
+(***********************************************************************)
+(* *)
+(* 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 Ocamlbuild_plugin;;
+dispatch begin function
+ | After_rules ->
+ rule "copy foo"
+ ~prod:"bar"
+ ~dep:"foo.otarget"
+ begin fun _env _build ->
+ cp "foo" "bar"
+ end
+ | _ -> ()
+end
--- /dev/null
+#########################################################################
+# #
+# OCaml #
+# #
+# 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. #
+# #
+#########################################################################
+
+#!/bin/sh
+cd `dirname $0`
+set -e
+set -x
+CMDOPTS="" # -- command args
+BUILD="$OCB 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
~tree:[T.f "hello.ml" ~content:"print_endline \"Hello, World!\""]
~targets:("hello.byte.o",["hello.byte.c";"hello.native.o"]) ();;
+let () = test "OutputShared"
+ ~options:[`no_ocamlfind]
+ ~description:"output_shared targets for native and bytecode (PR #6733)"
+ ~tree:[T.f "hello.ml" ~content:"print_endline \"Hello, World!\"";
+ T.f "_tags" ~content:"<*.so>: runtime_variant(_pic)"]
+ ~targets:("hello.byte.so",["hello.native.so"]) ();;
+
let () = test "StrictSequenceFlag"
~options:[`no_ocamlfind; `quiet]
~description:"strict_sequence tag"
-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/types.cmi \
../typing/typemod.cmi ../typing/typedtree.cmi ../parsing/syntaxerr.cmi \
../driver/pparse.cmi ../parsing/parse.cmi odoc_types.cmi odoc_text.cmi \
odoc_parameter.cmo odoc_name.cmi
odoc_class.cmx : ../typing/types.cmx odoc_value.cmx odoc_types.cmx \
odoc_parameter.cmx odoc_name.cmx
+odoc_comments_global.cmo : odoc_comments_global.cmi
+odoc_comments_global.cmx : odoc_comments_global.cmi
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_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_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.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_module.cmo : ../typing/types.cmi odoc_value.cmo odoc_types.cmi \
odoc_type.cmo odoc_name.cmi odoc_extension.cmo odoc_exception.cmo \
odoc_class.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_lexer.cmo : odoc_text_parser.cmi odoc_misc.cmi
+odoc_text_lexer.cmx : odoc_text_parser.cmx odoc_misc.cmx
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.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_args.cmi : odoc_gen.cmi
odoc_ast.cmi : ../typing/types.cmi ../typing/typedtree.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_comments.cmi : odoc_types.cmi odoc_module.cmo
odoc_config.cmi :
odoc_cross.cmi : odoc_types.cmi odoc_module.cmo
odoc_dag2html.cmi : odoc_info.cmi
#(***********************************************************************)
include ../config/Makefile
+CAMLRUN ?= ../boot/ocamlrun
+CAMLYACC ?= ../boot/ocamlyacc
# Various commands and dir
##########################
ROOTDIR = ..
-OCAMLRUN = $(ROOTDIR)/boot/ocamlrun
-OCAMLC = $(OCAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib
-OCAMLOPT = $(OCAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib
-OCAMLDEP = $(OCAMLRUN) $(ROOTDIR)/tools/ocamldep
-OCAMLLEX = $(OCAMLRUN) $(ROOTDIR)/boot/ocamllex
-OCAMLYACC = $(ROOTDIR)/yacc/ocamlyacc
+OCAMLC = $(CAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib
+OCAMLOPT = $(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib
+OCAMLDEP = $(CAMLRUN) $(ROOTDIR)/tools/ocamldep
+OCAMLLEX = $(CAMLRUN) $(ROOTDIR)/boot/ocamllex
OCAMLLIB = $(LIBDIR)
OCAMLBIN = $(BINDIR)
$(OCAMLLEX) $<
.mly.ml:
- $(OCAMLYACC) -v $<
+ $(CAMLYACC) -v $<
.mly.mli:
- $(OCAMLYACC) -v $<
+ $(CAMLYACC) -v $<
# Installation targets
######################
@rm -f generators/*.cm[aiox] generators/*.$(A) generators/*.$(O) generators/*.cmx[as]
depend::
- $(OCAMLYACC) odoc_text_parser.mly
- $(OCAMLYACC) odoc_parser.mly
+ $(CAMLYACC) odoc_text_parser.mly
+ $(CAMLYACC) odoc_parser.mly
$(OCAMLLEX) odoc_text_lexer.mll
$(OCAMLLEX) odoc_lexer.mll
$(OCAMLLEX) odoc_ocamlhtml.mll
#(***********************************************************************)
include ../config/Makefile
+CAMLRUN ?= ../boot/ocamlrun
+CAMLYACC ?= ../boot/ocamlyacc
# Various commands and dir
##########################
ROOTDIR = ..
-OCAMLRUN = $(ROOTDIR)/boot/ocamlrun
-OCAMLC = $(OCAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib
-OCAMLOPT = $(OCAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib
-OCAMLDEP = $(OCAMLRUN) $(ROOTDIR)/tools/ocamldep
-OCAMLLEX = $(OCAMLRUN) $(ROOTDIR)/boot/ocamllex
-OCAMLYACC = $(ROOTDIR)/yacc/ocamlyacc
+OCAMLC = $(CAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib
+OCAMLOPT = $(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib
+OCAMLDEP = $(CAMLRUN) $(ROOTDIR)/tools/ocamldep
+OCAMLLEX = $(CAMLRUN) $(ROOTDIR)/boot/ocamllex
OCAMLLIB = $(LIBDIR)
OCAMLBIN = $(BINDIR)
$(OCAMLLEX) $<
.mly.ml:
- $(OCAMLYACC) -v $<
+ $(CAMLYACC) -v $<
.mly.mli:
- $(OCAMLYACC) -v $<
+ $(CAMLYACC) -v $<
# Installation targets
######################
@rm -f generators/*.cm[aiox] generators/*.$(A) generators/*.$(O) generators/*.cmx[as]
depend::
- $(OCAMLYACC) odoc_text_parser.mly
- $(OCAMLYACC) odoc_parser.mly
+ $(CAMLYACC) odoc_text_parser.mly
+ $(CAMLYACC) odoc_parser.mly
$(OCAMLLEX) odoc_text_lexer.mll
$(OCAMLLEX) odoc_lexer.mll
$(OCAMLLEX) odoc_ocamlhtml.mll
| Parsetree.Pstr_type name_typedecl_list ->
(* of (string * type_declaration) list *)
- (* we start by extending the environment *)
- let new_env =
+ let extended_env =
List.fold_left
(fun acc_env {Parsetree.ptype_name = { txt = name }} ->
let complete_name = Name.concat current_module_name name in
env
name_typedecl_list
in
+ let env =
+ let is_nonrec =
+ List.exists
+ (fun td ->
+ List.exists (fun (n, _) -> n.txt = "nonrec")
+ td.Parsetree.ptype_attributes)
+ name_typedecl_list
+ in
+ if is_nonrec then env else extended_env
+ in
let rec f ?(first=false) maybe_more_acc last_pos name_type_decl_list =
match name_type_decl_list with
[] -> (maybe_more_acc, [])
get_comments_in_module last_pos loc_start
in
let kind = Sig.get_type_kind
- new_env name_comment_list
+ env name_comment_list
tt_type_decl.Types.type_kind
in
let new_end = loc_end + maybe_more in
List.map2
(fun p v ->
let (co, cn) = Types.Variance.get_upper v in
- (Odoc_env.subst_type new_env p, co, cn))
+ (Odoc_env.subst_type env p, co, cn))
tt_type_decl.Types.type_params
tt_type_decl.Types.type_variance ;
ty_kind = kind ;
(match tt_type_decl.Types.type_manifest with
None -> None
| Some t ->
- Some (Sig.manifest_structure new_env name_comment_list t));
+ Some (Sig.manifest_structure env name_comment_list t));
ty_loc = { loc_impl = Some loc ; loc_inter = None } ;
ty_code =
(
(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)
+ (maybe_more, extended_env, eles)
| Parsetree.Pstr_typext tyext ->
(* we get the extension declaration in the typed tree *)
}
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, _))
+ | (Parsetree.Pmod_ident longident,
+ Typedtree.Tmod_constraint
+ ({Typedtree.mod_desc = 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 ; } }
(*DEBUG*) | Parsetree.Pmod_apply _ -> "Pmod_apply"
(*DEBUG*) | Parsetree.Pmod_constraint _ -> "Pmod_constraint"
(*DEBUG*) | Parsetree.Pmod_unpack _ -> "Pmod_unpack"
+ (*DEBUG*) | Parsetree.Pmod_extension _ -> "Pmod_extension"
(*DEBUG*)in
(*DEBUG*)let s_typed =
(*DEBUG*) match typedtree with
':' ;
'~' ;
'!' ;
+ '#' ;
]
type t = string
(maybe_more, new_env, [ Element_exception e ])
| Parsetree.Psig_type name_type_decl_list ->
- (* we start by extending the environment *)
- let new_env =
+ let extended_env =
List.fold_left
(fun acc_env td ->
let complete_name = Name.concat current_module_name td.Parsetree.ptype_name.txt in
env
name_type_decl_list
in
+ let env =
+ let is_nonrec =
+ List.exists
+ (fun td ->
+ List.exists (fun (n, _) -> n.txt = "nonrec")
+ td.Parsetree.ptype_attributes)
+ name_type_decl_list
+ in
+ if is_nonrec then env else extended_env
+ in
let rec f ?(first=false) acc_maybe_more last_pos name_type_decl_list =
match name_type_decl_list with
[] ->
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
+ let type_kind = get_type_kind env name_comment_list sig_type_decl.Types.type_kind in
let loc_start = type_decl.Parsetree.ptype_loc.Location.loc_start.Lexing.pos_cnum in
let new_end = type_decl.Parsetree.ptype_loc.Location.loc_end.Lexing.pos_cnum + maybe_more in
(* associate the comments to each constructor and build the [Type.t_type] *)
ty_parameters =
List.map2 (fun p v ->
let (co, cn) = Types.Variance.get_upper v in
- (Odoc_env.subst_type new_env p,co, cn))
+ (Odoc_env.subst_type env p,co, cn))
sig_type_decl.Types.type_params
sig_type_decl.Types.type_variance;
ty_kind = type_kind;
(new_maybe_more, (ele_comments @ [Element_type new_type]) @ eles)
in
let (maybe_more, types) = f ~first: true 0 pos_start_ele name_type_decl_list in
- (maybe_more, new_env, types)
+ (maybe_more, extended_env, types)
| Parsetree.Psig_open _ -> (* A VOIR *)
let ele_comments = match comment_opt with
# Common Makefile for otherlibs on the Unix ports
-CAMLC=$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib
-CAMLOPT=$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/ocamlopt -nostdlib \
+CAMLC=$(CAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib
+CAMLOPT=$(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib \
-I $(ROOTDIR)/stdlib
-CFLAGS=-I$(ROOTDIR)/byterun -O $(SHAREDCCCOMPOPTS) $(EXTRACFLAGS)
+CFLAGS=-I$(ROOTDIR)/byterun $(SHAREDCCCOMPOPTS) $(EXTRACFLAGS)
include ../Makefile.shared
# Note .. is the current directory (this makefile is included from
ROOTDIR=../..
include $(ROOTDIR)/config/Makefile
+CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun
+CAMLYACC ?= $(ROOTDIR)/boot/ocamlyacc
# Compilation options
CC=$(BYTECC)
-CAMLRUN=$(ROOTDIR)/boot/ocamlrun
COMPFLAGS=-w +33..39 -warn-error A -bin-annot -g -safe-string $(EXTRACAMLFLAGS)
MKLIB=$(CAMLRUN) $(ROOTDIR)/tools/ocamlmklib
-bigarray_stubs.o: bigarray_stubs.c ../../byterun/alloc.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../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/hash.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.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 \
- ../../byterun/custom.h ../../byterun/mlvalues.h ../../byterun/fail.h \
- ../../byterun/io.h ../../byterun/sys.h ../../byterun/signals.h
-mmap_win32.o: mmap_win32.c bigarray.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../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_stubs.o: bigarray_stubs.c ../../byterun/caml/alloc.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/mlvalues.h bigarray.h ../../byterun/caml/config.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/custom.h \
+ ../../byterun/caml/fail.h ../../byterun/caml/intext.h \
+ ../../byterun/caml/io.h ../../byterun/caml/hash.h \
+ ../../byterun/caml/memory.h ../../byterun/caml/gc.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h
+mmap_unix.o: mmap_unix.c bigarray.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/config.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/custom.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/fail.h \
+ ../../byterun/caml/io.h ../../byterun/caml/sys.h \
+ ../../byterun/caml/signals.h
+mmap_win32.o: mmap_win32.c bigarray.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/config.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/custom.h \
+ ../../byterun/caml/fail.h ../../byterun/caml/sys.h ../unix/unixsupport.h
bigarray.cmi :
bigarray.cmo : bigarray.cmi
bigarray.cmx : bigarray.cmi
include ../Makefile
depend:
- gcc -MM $(CFLAGS) *.c > .depend
- ../../boot/ocamlrun ../../tools/ocamldep *.mli *.ml >> .depend
+ $(CC) -MM $(CFLAGS) *.c > .depend
+ $(CAMLRUN) ../../tools/ocamldep *.mli *.ml >> .depend
include .depend
include ../Makefile.nt
depend:
- gcc -MM $(CFLAGS) *.c > .depend
- ../../boot/ocamlrun ../../tools/ocamldep *.mli *.ml >> .depend
+ $(CC) -MM $(CFLAGS) *.c > .depend
+ $(CAMLRUN) ../../tools/ocamldep *.mli *.ml >> .depend
include .depend
#define CAML_BIGARRAY_H
#ifndef CAML_NAME_SPACE
-#include "compatibility.h"
+#include "caml/compatibility.h"
#endif
-#include "config.h"
-#include "mlvalues.h"
+#include "caml/config.h"
+#include "caml/mlvalues.h"
typedef signed char caml_ba_int8;
typedef unsigned char caml_ba_uint8;
#define CAMLBAextern CAMLextern
#endif
+#ifdef __cplusplus
+extern "C" {
+#endif
+
CAMLBAextern value
caml_ba_alloc(int flags, int num_dims, void * data, intnat * dim);
CAMLBAextern value caml_ba_alloc_dims(int flags, int num_dims, void * data,
... /*dimensions, with type intnat */);
CAMLBAextern uintnat caml_ba_byte_size(struct caml_ba_array * b);
+#ifdef __cplusplus
+}
#endif
+
+#endif /* CAML_BIGARRAY_H */
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. *)
+ file is shrunk.
+
+ This function raises [Sys_error] in the case of any errors from the
+ underlying system calls. [Invalid_argument] or [Failure] may be
+ raised in cases where argument validation fails. *)
end
#include <stddef.h>
#include <stdarg.h>
#include <string.h>
-#include "alloc.h"
+#include "caml/alloc.h"
#include "bigarray.h"
-#include "custom.h"
-#include "fail.h"
-#include "intext.h"
-#include "hash.h"
-#include "memory.h"
-#include "mlvalues.h"
+#include "caml/custom.h"
+#include "caml/fail.h"
+#include "caml/intext.h"
+#include "caml/hash.h"
+#include "caml/memory.h"
+#include "caml/mlvalues.h"
#define int8 caml_ba_int8
#define uint8 caml_ba_uint8
#include <stddef.h>
#include <string.h>
#include "bigarray.h"
-#include "custom.h"
-#include "fail.h"
-#include "io.h"
-#include "mlvalues.h"
-#include "sys.h"
-#include "signals.h"
+#include "caml/custom.h"
+#include "caml/fail.h"
+#include "caml/io.h"
+#include "caml/mlvalues.h"
+#include "caml/sys.h"
+#include "caml/signals.h"
extern int caml_ba_element_size[]; /* from bigarray_stubs.c */
#include <stdio.h>
#include <string.h>
#include "bigarray.h"
-#include "alloc.h"
-#include "custom.h"
-#include "fail.h"
-#include "mlvalues.h"
-#include "sys.h"
+#include "caml/alloc.h"
+#include "caml/custom.h"
+#include "caml/fail.h"
+#include "caml/mlvalues.h"
+#include "caml/sys.h"
#include "unixsupport.h"
extern int caml_ba_element_size[]; /* from bigarray_stubs.c */
# Makefile for the dynamic link library
+# FIXME reduce redundancy by including ../Makefile
+
include ../../config/Makefile
+CAMLRUN ?= ../../boot/ocamlrun
+CAMLYACC ?= ../../boot/ocamlyacc
ROOTDIR = ../..
-OCAMLRUN = $(ROOTDIR)/boot/ocamlrun
-OCAMLC = $(OCAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib
-OCAMLOPT = $(OCAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib
+OCAMLC = $(CAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib
+OCAMLOPT = $(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib
INCLUDES=-I ../../utils -I ../../typing -I ../../bytecomp -I ../../asmcomp
-COMPFLAGS=-w +33..39 -warn-error A -bin-annot -safe-string \
+COMPFLAGS=-w +33..39 -warn-error A -bin-annot -g -safe-string \
-I ../../stdlib $(INCLUDES)
OBJS=dynlinkaux.cmo dynlink.cmo
../../utils/terminfo.cmo ../../utils/warnings.cmo \
../../parsing/asttypes.cmi \
../../parsing/location.cmo ../../parsing/longident.cmo \
- ../../parsing/ast_helper.cmo \
+ ../../parsing/docstrings.cmo ../../parsing/ast_helper.cmo \
../../parsing/ast_mapper.cmo \
../../typing/ident.cmo ../../typing/path.cmo \
../../typing/primitive.cmo ../../typing/types.cmo \
rm -f dynlink.mlopt
extract_crc: dynlink.cma extract_crc.cmo
- $(OCAMLC) $(COMPFLAGS) -o extract_crc dynlink.cma extract_crc.cmo
+ $(OCAMLC) -o extract_crc dynlink.cma extract_crc.cmo
INSTALL_LIBDIR=$(DESTDIR)$(LIBDIR)
-color.o: color.c libgraph.h \
- \
- \
- \
- ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h \
-
-draw.o: draw.c libgraph.h \
- \
- \
- \
- ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h
-dump_img.o: dump_img.c libgraph.h \
- \
- \
- \
- ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h image.h \
- ../../byterun/alloc.h ../../byterun/mlvalues.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h
-events.o: events.c libgraph.h \
- \
- \
- \
- ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h ../../byterun/signals.h
-fill.o: fill.c libgraph.h \
- \
- \
- \
- ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h
-image.o: image.c libgraph.h \
- \
- \
- \
- ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h image.h \
- ../../byterun/alloc.h ../../byterun/mlvalues.h ../../byterun/custom.h
-make_img.o: make_img.c libgraph.h \
- \
- \
- \
- ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h image.h \
- ../../byterun/memory.h ../../byterun/gc.h ../../byterun/mlvalues.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h
-open.o: open.c libgraph.h \
- \
- \
- \
- ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h ../../byterun/callback.h ../../byterun/fail.h \
- ../../byterun/memory.h ../../byterun/gc.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h
-point_col.o: point_col.c libgraph.h \
- \
- \
- \
- ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h
-sound.o: sound.c libgraph.h \
- \
- \
- \
- ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h
-subwindow.o: subwindow.c libgraph.h \
- \
- \
- \
- ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h
-text.o: text.c libgraph.h \
- \
- \
- \
- ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h
+color.o: color.c libgraph.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h
+draw.o: draw.c libgraph.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h
+dump_img.o: dump_img.c libgraph.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h image.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/major_gc.h \
+ ../../byterun/caml/freelist.h ../../byterun/caml/minor_gc.h \
+ ../../byterun/caml/address_class.h
+events.o: events.c libgraph.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/signals.h
+fill.o: fill.c libgraph.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h
+image.o: image.c libgraph.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h image.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/custom.h
+make_img.o: make_img.c libgraph.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h image.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h
+open.o: open.c libgraph.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/callback.h \
+ ../../byterun/caml/fail.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/major_gc.h \
+ ../../byterun/caml/freelist.h ../../byterun/caml/minor_gc.h \
+ ../../byterun/caml/address_class.h
+point_col.o: point_col.c libgraph.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h
+sound.o: sound.c libgraph.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h
+subwindow.o: subwindow.c libgraph.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h
+text.o: text.c libgraph.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h
graphics.cmi :
graphicsX11.cmi :
graphics.cmo : graphics.cmi
include ../Makefile
depend:
- gcc -MM $(CFLAGS) *.c | sed -e 's, /[^ ]*\.h,,g' > .depend
- ../../boot/ocamlrun ../../tools/ocamldep *.mli *.ml >> .depend
+ $(CC) -MM $(CFLAGS) *.c | sed -e 's, /[^ ]*\.h,,g' > .depend
+ $(CAMLRUN) ../../tools/ocamldep *.mli *.ml >> .depend
include .depend
/***********************************************************************/
#include "libgraph.h"
-#include <alloc.h>
+#include <caml/alloc.h>
value caml_gr_plot(value vx, value vy)
{
#include "libgraph.h"
#include "image.h"
-#include <alloc.h>
-#include <memory.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
value caml_gr_dump_image(value image)
{
#include <signal.h>
#include "libgraph.h"
-#include <alloc.h>
-#include <signals.h>
+#include <caml/alloc.h>
+#include <caml/signals.h>
#include <sys/types.h>
#include <sys/time.h>
#ifdef HAS_SYS_SELECT_H
/***********************************************************************/
#include "libgraph.h"
-#include <memory.h>
+#include <caml/memory.h>
value caml_gr_fill_rect(value vx, value vy, value vw, value vh)
{
#include "libgraph.h"
#include "image.h"
-#include <alloc.h>
-#include <custom.h>
+#include <caml/alloc.h>
+#include <caml/custom.h>
static void caml_gr_free_image(value im)
{
#include <stdio.h>
#include <X11/Xlib.h>
#include <X11/Xutil.h>
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
struct canvas {
int w, h; /* Dimensions of the drawable */
#include "libgraph.h"
#include "image.h"
-#include <memory.h>
+#include <caml/memory.h>
value caml_gr_make_image(value m)
{
#include <fcntl.h>
#include <signal.h>
#include "libgraph.h"
-#include <alloc.h>
-#include <callback.h>
-#include <fail.h>
-#include <memory.h>
+#include <caml/alloc.h>
+#include <caml/callback.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
#ifdef HAS_UNISTD
#include <unistd.h>
#endif
/***********************************************************************/
#include "libgraph.h"
-#include <alloc.h>
+#include <caml/alloc.h>
XFontStruct * caml_gr_font = NULL;
-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_amd64.o: bng_amd64.c
bng_arm64.o: bng_arm64.c
+bng.o: bng.c bng.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/compatibility.h bng_amd64.c bng_digit.c
bng_digit.o: bng_digit.c
bng_ia32.o: bng_ia32.c
bng_ppc.o: bng_ppc.c
bng_sparc.o: bng_sparc.c
-nat_stubs.o: nat_stubs.c ../../byterun/alloc.h \
- ../../byterun/compatibility.h ../../byterun/misc.h \
- ../../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/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
+nat_stubs.o: nat_stubs.c ../../byterun/caml/alloc.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
+ ../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
+ ../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/config.h ../../byterun/caml/custom.h \
+ ../../byterun/caml/intext.h ../../byterun/caml/io.h \
+ ../../byterun/caml/fail.h ../../byterun/caml/hash.h \
+ ../../byterun/caml/memory.h ../../byterun/caml/gc.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/mlvalues.h bng.h nat.h
arith_flags.cmi :
arith_status.cmi :
big_int.cmi : nat.cmi
bng_amd64.c bng_ia32.c bng_ppc.c bng_sparc.c
depend:
- gcc -MM $(CFLAGS) *.c > .depend
- ../../boot/ocamlrun ../../tools/ocamldep *.mli *.ml >> .depend
+ $(CC) -MM $(CFLAGS) *.c > .depend
+ $(CAMLRUN) ../../tools/ocamldep *.mli *.ml >> .depend
include .depend
/* $Id$ */
#include "bng.h"
-#include "config.h"
+#include "caml/config.h"
#if defined(__GNUC__) && BNG_ASM_LEVEL > 0
#if defined(BNG_ARCH_ia32)
/* $Id$ */
#include <string.h>
-#include "config.h"
+#include "caml/config.h"
typedef uintnat bngdigit;
typedef bngdigit * bng;
A la fin de la boucle i-1 est la plus grande puissance de la base qui tient
sur un seul digit et j est la plus grande puissance de la base qui tient
sur un int.
+
+ This function returns [(pmax, pint)] where:
+ [pmax] is the index of the digit of [power_base] that contains the
+ the maximum power of [base] that fits in a digit. This is also one
+ less than the exponent of that power.
+ [pint] is the exponent of the maximum power of [base] that fits in an [int].
*)
let make_power_base base power_base =
let i = ref 0
power_base (pred !i) 1
power_base 0)
done;
- while !j <= !i && is_digit_int power_base !j do incr j done;
+ while !j < !i - 1 && is_digit_int power_base !j do incr j done;
(!i - 2, !j)
(*
/* $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"
+#include "caml/alloc.h"
+#include "caml/config.h"
+#include "caml/custom.h"
+#include "caml/intext.h"
+#include "caml/fail.h"
+#include "caml/hash.h"
+#include "caml/memory.h"
+#include "caml/mlvalues.h"
#include "bng.h"
#include "nat.h"
| Big_int bi as n -> n
| Ratio r -> num_of_big_int (floor_ratio r)
-(* The function [quo_num] is equivalent to
-
- let quo_num x y = floor_num (div_num x y);;
+(* Coercion with ratio type *)
+let ratio_of_num = function
+ Int i -> ratio_of_int i
+| Big_int bi -> ratio_of_big_int bi
+| Ratio r -> r
+;;
- However, this definition is vastly inefficient (cf PR #3473):
- we define here a better way of computing the same thing.
- *)
-let quo_num n1 n2 =
- match n1 with
- | Int i1 ->
- begin match n2 with
- | Int i2 -> Int (i1 / i2)
- | Big_int bi2 -> num_of_big_int (div_big_int (big_int_of_int i1) bi2)
- | Ratio r2 -> num_of_big_int (floor_ratio (div_int_ratio i1 r2)) end
+(* Euclidean division and remainder. The specification is:
- | Big_int bi1 ->
- begin match n2 with
- | Int i2 -> num_of_big_int (div_big_int bi1 (big_int_of_int i2))
- | Big_int bi2 -> num_of_big_int (div_big_int bi1 bi2)
- | Ratio r2 -> num_of_big_int (floor_ratio (div_big_int_ratio bi1 r2)) end
+ a = b * quo_num a b + mod_num a b
+ quo_num a b is an integer (Z)
+ 0 <= mod_num a b < |b|
- | Ratio r1 ->
- begin match n2 with
- | Int i2 -> num_of_big_int (floor_ratio (div_ratio_int r1 i2))
- | Big_int bi2 -> num_of_big_int (floor_ratio (div_ratio_big_int r1 bi2))
- | Ratio r2 -> num_of_big_int (floor_ratio (div_ratio r1 r2)) end
-;;
+A correct but slow implementation is:
-(* The function [mod_num] is equivalent to:
+ quo_num a b =
+ if b >= 0 then floor_num (div_num a b)
+ else minus_num (floor_num (div_num a (minus_num b)))
- let mod_num x y = sub_num x (mult_num y (quo_num x y));;
+ mod_num a b =
+ sub_num a (mult_num b (quo_num a b))
- However, as for [quo_num] above, this definition is inefficient:
+ However, this definition is vastly inefficient (cf PR #3473):
we define here a better way of computing the same thing.
- *)
-let mod_num n1 n2 =
- match n1 with
- | Int i1 ->
- begin match n2 with
- | Int i2 -> Int (i1 mod i2)
- | Big_int bi2 -> num_of_big_int (mod_big_int (big_int_of_int i1) bi2)
- | Ratio _r2 -> sub_num n1 (mult_num n2 (quo_num n1 n2)) end
- | Big_int bi1 ->
- begin match n2 with
- | Int i2 -> num_of_big_int (mod_big_int bi1 (big_int_of_int i2))
- | Big_int bi2 -> num_of_big_int (mod_big_int bi1 bi2)
- | Ratio _r2 -> sub_num n1 (mult_num n2 (quo_num n1 n2)) end
+ PR#6753: the previous implementation was based on
+ quo_num a b = floor_num (div_num a b)
+ which is incorrect for negative b.
+*)
- | Ratio _r1 -> sub_num n1 (mult_num n2 (quo_num n1 n2))
-;;
+let quo_num n1 n2 =
+ match n1, n2 with
+ | Int i1, Int i2 ->
+ let q = i1 / i2 and r = i1 mod i2 in
+ Int (if r >= 0 then q else if i2 > 0 then q - 1 else q + 1)
+ | Int i1, Big_int bi2 ->
+ num_of_big_int (div_big_int (big_int_of_int i1) bi2)
+ | Int i1, Ratio r2 ->
+ num_of_big_int (report_sign_ratio r2
+ (floor_ratio (div_int_ratio i1 (abs_ratio r2))))
+ | Big_int bi1, Int i2 ->
+ num_of_big_int (div_big_int bi1 (big_int_of_int i2))
+ | Big_int bi1, Big_int bi2 ->
+ num_of_big_int (div_big_int bi1 bi2)
+ | Big_int bi1, Ratio r2 ->
+ num_of_big_int (report_sign_ratio r2
+ (floor_ratio (div_big_int_ratio bi1 (abs_ratio r2))))
+ | Ratio r1, _ ->
+ let r2 = ratio_of_num n2 in
+ num_of_big_int (report_sign_ratio r2
+ (floor_ratio (div_ratio r1 (abs_ratio r2))))
+
+let mod_num n1 n2 =
+ match n1, n2 with
+ | Int i1, Int i2 ->
+ let r = i1 mod i2 in
+ Int (if r >= 0 then r else if i2 > 0 then r + i2 else r - i2)
+ | Int i1, Big_int bi2 ->
+ num_of_big_int (mod_big_int (big_int_of_int i1) bi2)
+ | Big_int bi1, Int i2 ->
+ num_of_big_int (mod_big_int bi1 (big_int_of_int i2))
+ | Big_int bi1, Big_int bi2 ->
+ num_of_big_int (mod_big_int bi1 bi2)
+ | _, _ ->
+ sub_num n1 (mult_num n2 (quo_num n1 n2))
let power_num_int a b = match (a,b) with
((Int i), n) ->
| Big_int bi -> bi
| Ratio r -> big_int_of_ratio r
-(* Coercion with ratio type *)
-let ratio_of_num = function
- Int i -> ratio_of_int i
-| Big_int bi -> ratio_of_big_int bi
-| Ratio r -> r
-;;
-
let string_of_big_int_for_num bi =
if !approx_printing_flag
then approx_big_int !floating_precision bi
-strstubs.o: strstubs.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../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
+strstubs.o: strstubs.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/major_gc.h \
+ ../../byterun/caml/freelist.h ../../byterun/caml/minor_gc.h \
+ ../../byterun/caml/address_class.h ../../byterun/caml/fail.h
str.cmi :
str.cmo : str.cmi
str.cmx : str.cmi
str.cmx: str.cmi
depend:
- gcc -MM $(CFLAGS) *.c > .depend
- ../../boot/ocamlrun ../../tools/ocamldep *.mli *.ml >> .depend
+ $(CC) -MM $(CFLAGS) *.c > .depend
+ $(CAMLRUN) ../../tools/ocamldep *.mli *.ml >> .depend
include .depend
#include <string.h>
#include <ctype.h>
-#include <mlvalues.h>
-#include <alloc.h>
-#include <memory.h>
-#include <fail.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
/* The backtracking NFA interpreter */
-st_stubs.o: st_stubs.c ../../byterun/alloc.h \
- ../../byterun/compatibility.h ../../byterun/misc.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/backtrace.h ../../byterun/callback.h \
- ../../byterun/custom.h ../../byterun/fail.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/printexc.h ../../byterun/roots.h \
- ../../byterun/memory.h ../../byterun/signals.h ../../byterun/stacks.h \
- ../../byterun/sys.h threads.h st_posix.h
+st_stubs.o: st_stubs.c ../../byterun/caml/alloc.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
+ ../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
+ ../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/backtrace.h ../../byterun/caml/callback.h \
+ ../../byterun/caml/custom.h ../../byterun/caml/fail.h \
+ ../../byterun/caml/io.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/major_gc.h \
+ ../../byterun/caml/freelist.h ../../byterun/caml/minor_gc.h \
+ ../../byterun/caml/address_class.h ../../byterun/caml/misc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/printexc.h \
+ ../../byterun/caml/roots.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/signals.h ../../byterun/caml/stacks.h \
+ ../../byterun/caml/sys.h threads.h st_posix.h
condition.cmi : mutex.cmi
event.cmi :
mutex.cmi :
#########################################################################
include ../../config/Makefile
+CAMLRUN ?= ../../boot/ocamlrun
+CAMLYACC ?= ../../boot/ocamlyacc
ROOTDIR=../..
-CAMLC=$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/ocamlc -nostdlib \
+CAMLC=$(CAMLRUN) $(ROOTDIR)/ocamlc -nostdlib \
-I $(ROOTDIR)/stdlib -I $(ROOTDIR)/otherlibs/unix
-CAMLOPT=$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/ocamlopt -nostdlib \
+CAMLOPT=$(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib \
-I $(ROOTDIR)/stdlib -I $(ROOTDIR)/otherlibs/unix
-MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib
+MKLIB=$(CAMLRUN) ../../tools/ocamlmklib
COMPFLAGS=-w +33..39 -warn-error A -g -bin-annot -safe-string
BYTECODE_C_OBJS=st_stubs_b.o
$(MKLIB) -o threads $(BYTECODE_C_OBJS) $(PTHREAD_LINK)
st_stubs_b.o: st_stubs.c st_posix.h
- $(BYTECC) -O -I../../byterun $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) \
+ $(BYTECC) -I../../byterun $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) \
-c st_stubs.c
mv st_stubs.o st_stubs_b.o
$(AR) rc libthreadsnat.a $(NATIVECODE_C_OBJS)
st_stubs_n.o: st_stubs.c st_posix.h
- $(NATIVECC) -O -I../../asmrun -I../../byterun $(NATIVECCCOMPOPTS) \
+ $(NATIVECC) -I../../asmrun -I../../byterun $(NATIVECCCOMPOPTS) \
$(SHAREDCCCOMPOPTS) -DNATIVE_CODE -DTARGET_$(ARCH) \
-DSYS_$(SYSTEM) -c st_stubs.c
mv st_stubs.o st_stubs_n.o
$(CAMLOPT) -c $(COMPFLAGS) $<
depend: $(GENFILES)
- -gcc -MM -I../../byterun *.c > .depend
- ../../boot/ocamlrun ../../tools/ocamldep *.mli *.ml >> .depend
+ -$(CC) -MM -I../../byterun *.c > .depend
+ $(CAMLRUN) ../../tools/ocamldep *.mli *.ml >> .depend
include .depend
#########################################################################
include ../../config/Makefile
+CAMLRUN ?= ../../boot/ocamlrun
+CAMLYACC ?= ../../boot/ocamlyacc
# Compilation options
-CAMLC=../../boot/ocamlrun ../../ocamlc -I ../../stdlib -I ../win32unix
-CAMLOPT=../../boot/ocamlrun ../../ocamlopt -I ../../stdlib -I ../win32unix
+CAMLC=$(CAMLRUN) ../../ocamlc -I ../../stdlib -I ../win32unix
+CAMLOPT=$(CAMLRUN) ../../ocamlopt -I ../../stdlib -I ../win32unix
COMPFLAGS=-w +33 -warn-error A -g
-MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib
+MKLIB=$(CAMLRUN) ../../tools/ocamlmklib
CFLAGS=-I../../byterun $(EXTRACFLAGS)
CAMLOBJS=thread.cmo mutex.cmo condition.cmo event.cmo threadUnix.cmo
allopt: lib$(LIBNAME).$(A) $(LIBNAME).cmxa $(LIBNAME).cmxs $(CMIFILES)
$(LIBNAME).cma: $(CAMLOBJS)
- $(MKLIB) -o $(LIBNAME) -ocamlc "../../boot/ocamlrun ../../ocamlc" \
+ $(MKLIB) -o $(LIBNAME) -ocamlc "$(CAMLRUN) ../../ocamlc" \
-linkall $(CAMLOBJS) $(LINKOPTS)
lib$(LIBNAME).$(A): $(COBJS)
$(LIBNAME).cmxa: $(CAMLOBJS:.cmo=.cmx)
$(MKLIB) -o $(LIBNAME)nat \
- -ocamlopt "../../boot/ocamlrun ../../ocamlopt" -linkall \
+ -ocamlopt "$(CAMLRUN) ../../ocamlopt" -linkall \
$(CAMLOBJS:.cmo=.cmx) $(LINKOPTS)
mv $(LIBNAME)nat.cmxa $(LIBNAME).cmxa
mv $(LIBNAME)nat.$(A) $(LIBNAME).$(A)
static void st_thread_kill(st_thread_id thr)
{
+#if !defined(__ANDROID__)
+ /* pthread_cancel is unsafe, as it does not allow the thread an opportunity
+ to free shared resources such as mutexes. Thus, it is not implemented
+ in Android's libc. */
pthread_cancel(thr);
+#endif
}
/* Scheduling hints */
/* Block all signals so that we don't try to execute an OCaml signal handler*/
sigfillset(&mask);
pthread_sigmask(SIG_BLOCK, &mask, NULL);
+#if !defined(__ANDROID__)
/* Allow async cancellation */
pthread_setcanceltype(PTHREAD_CANCEL_ASYNCHRONOUS, NULL);
+#endif
while(1) {
/* select() seems to be the most efficient way to suspend the
thread for sub-second intervals */
/* "At fork" processing */
+#if defined(__ANDROID__)
+/* Android's libc does not include declaration of pthread_atfork;
+ however, it implements it since API level 10 (Gingerbread).
+ The reason for the omission is that Android (GUI) applications
+ are not supposed to fork at all, however this workaround is still
+ included in case OCaml is used for an Android CLI utility. */
+int pthread_atfork(void (*prepare)(void), void (*parent)(void), void (*child)(void));
+#endif
+
static int st_atfork(void (*fn)(void))
{
return pthread_atfork(NULL, NULL, fn);
/* */
/***********************************************************************/
-#include "alloc.h"
-#include "backtrace.h"
-#include "callback.h"
-#include "custom.h"
-#include "fail.h"
-#include "io.h"
-#include "memory.h"
-#include "misc.h"
-#include "mlvalues.h"
-#include "printexc.h"
-#include "roots.h"
-#include "signals.h"
+#include "caml/alloc.h"
+#include "caml/backtrace.h"
+#include "caml/callback.h"
+#include "caml/custom.h"
+#include "caml/fail.h"
+#include "caml/io.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/printexc.h"
+#include "caml/roots.h"
+#include "caml/signals.h"
#ifdef NATIVE_CODE
#include "stack.h"
#else
-#include "stacks.h"
+#include "caml/stacks.h"
#endif
-#include "sys.h"
+#include "caml/sys.h"
#include "threads.h"
/* Initial size of bytecode stack when a thread is created (4 Ko) */
#ifndef CAML_THREADS_H
#define CAML_THREADS_H
+#ifdef __cplusplus
+extern "C" {
+#endif
+
CAMLextern void caml_enter_blocking_section (void);
CAMLextern void caml_leave_blocking_section (void);
#define caml_acquire_runtime_system caml_leave_blocking_section
Both functions return 1 on success, 0 on error.
*/
+#ifdef __cplusplus
+}
+#endif
+
#endif /* CAML_THREADS_H */
-scheduler.o: scheduler.c ../../byterun/alloc.h \
- ../../byterun/compatibility.h ../../byterun/misc.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/backtrace.h ../../byterun/callback.h \
- ../../byterun/config.h ../../byterun/fail.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/printexc.h ../../byterun/roots.h \
- ../../byterun/memory.h ../../byterun/signals.h ../../byterun/stacks.h \
- ../../byterun/sys.h
+scheduler.o: scheduler.c ../../byterun/caml/alloc.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
+ ../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
+ ../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/backtrace.h ../../byterun/caml/callback.h \
+ ../../byterun/caml/config.h ../../byterun/caml/fail.h \
+ ../../byterun/caml/io.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/major_gc.h \
+ ../../byterun/caml/freelist.h ../../byterun/caml/minor_gc.h \
+ ../../byterun/caml/address_class.h ../../byterun/caml/misc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/printexc.h \
+ ../../byterun/caml/roots.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/signals.h ../../byterun/caml/stacks.h \
+ ../../byterun/caml/sys.h
condition.cmi : mutex.cmi
event.cmi :
mutex.cmi :
# #
#########################################################################
+# FIXME reduce redundancy by including ../Makefile
+
include ../../config/Makefile
+CAMLRUN ?= ../../boot/ocamlrun
+CAMLYACC ?= ../../boot/ocamlyacc
CC=$(BYTECC)
-CFLAGS=-I../../byterun -O $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) -g
+CFLAGS=-I../../byterun $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) -g
ROOTDIR=../..
-CAMLC=$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/ocamlc -nostdlib \
+CAMLC=$(CAMLRUN) $(ROOTDIR)/ocamlc -nostdlib \
-I $(ROOTDIR)/stdlib -I $(ROOTDIR)/otherlibs/unix
-MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib
-COMPFLAGS=-w +33..39 -warn-error A -bin-annot -safe-string
+MKLIB=$(CAMLRUN) ../../tools/ocamlmklib
+COMPFLAGS=-w +33..39 -warn-error A -bin-annot -g -safe-string
C_OBJS=scheduler.o
$(CAMLC) -c $(COMPFLAGS) $<
depend:
- gcc -MM $(CFLAGS) *.c > .depend
- ../../boot/ocamlrun ../../tools/ocamldep *.mli *.ml >> .depend
+ $(CC) -MM $(CFLAGS) *.c > .depend
+ $(CAMLRUN) ../../tools/ocamldep *.mli *.ml >> .depend
include .depend
#include <stdlib.h>
#include <stdio.h>
-#include "alloc.h"
-#include "backtrace.h"
-#include "callback.h"
-#include "config.h"
-#include "fail.h"
-#include "io.h"
-#include "memory.h"
-#include "misc.h"
-#include "mlvalues.h"
-#include "printexc.h"
-#include "roots.h"
-#include "signals.h"
-#include "stacks.h"
-#include "sys.h"
+#include "caml/alloc.h"
+#include "caml/backtrace.h"
+#include "caml/callback.h"
+#include "caml/config.h"
+#include "caml/fail.h"
+#include "caml/io.h"
+#include "caml/memory.h"
+#include "caml/misc.h"
+#include "caml/mlvalues.h"
+#include "caml/printexc.h"
+#include "caml/roots.h"
+#include "caml/signals.h"
+#include "caml/stacks.h"
+#include "caml/sys.h"
#if ! (defined(HAS_SELECT) && \
defined(HAS_SETITIMER) && \
-accept.o: accept.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h ../../byterun/fail.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h \
- socketaddr.h ../../byterun/misc.h
-access.o: access.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../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/signals.h unixsupport.h
-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/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 \
- ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
-bind.o: bind.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h unixsupport.h socketaddr.h \
- ../../byterun/misc.h
-chdir.o: chdir.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.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/signals.h unixsupport.h
-chmod.o: chmod.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.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/signals.h unixsupport.h
-chown.o: chown.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.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/signals.h unixsupport.h
-chroot.o: chroot.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.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/signals.h unixsupport.h
-close.o: close.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h \
- ../../byterun/signals.h ../../byterun/mlvalues.h unixsupport.h
-closedir.o: closedir.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.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/signals.h unixsupport.h
-connect.o: connect.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h ../../byterun/signals.h unixsupport.h \
- socketaddr.h ../../byterun/misc.h
-cst2constr.o: cst2constr.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 \
- cst2constr.h
-cstringv.o: cstringv.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h unixsupport.h
-dup.o: dup.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
-dup2.o: dup2.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
-envir.o: envir.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h
-errmsg.o: errmsg.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h
-execv.o: execv.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h unixsupport.h
-execve.o: execve.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h unixsupport.h
-execvp.o: execvp.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h unixsupport.h
-exit.o: exit.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
-fchmod.o: fchmod.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h ../../byterun/signals.h unixsupport.h
-fchown.o: fchown.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h ../../byterun/signals.h unixsupport.h
-fcntl.o: fcntl.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h unixsupport.h
-fork.o: fork.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h \
- ../../byterun/debugger.h ../../byterun/mlvalues.h unixsupport.h
-ftruncate.o: ftruncate.c ../../byterun/fail.h \
- ../../byterun/compatibility.h ../../byterun/misc.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h ../../byterun/io.h ../../byterun/signals.h \
- unixsupport.h
-getaddrinfo.o: getaddrinfo.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/misc.h ../../byterun/signals.h \
- unixsupport.h cst2constr.h socketaddr.h
-getcwd.o: getcwd.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h ../../byterun/fail.h unixsupport.h
-getegid.o: getegid.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h unixsupport.h
-geteuid.o: geteuid.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h unixsupport.h
-getgid.o: getgid.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
-getgr.o: getgr.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/alloc.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h unixsupport.h
-getgroups.o: getgroups.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h unixsupport.h
-gethost.o: gethost.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h \
- socketaddr.h ../../byterun/misc.h
-gethostname.o: gethostname.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h unixsupport.h
-getlogin.o: getlogin.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- unixsupport.h
-getnameinfo.o: getnameinfo.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h \
- socketaddr.h ../../byterun/misc.h
-getpeername.o: getpeername.c ../../byterun/fail.h \
- ../../byterun/compatibility.h ../../byterun/misc.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h unixsupport.h socketaddr.h \
- ../../byterun/misc.h
-getpid.o: getpid.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
-getppid.o: getppid.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h unixsupport.h
-getproto.o: getproto.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h unixsupport.h
-getpw.o: getpw.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../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 unixsupport.h
-getserv.o: getserv.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h unixsupport.h
-getsockname.o: getsockname.c ../../byterun/fail.h \
- ../../byterun/compatibility.h ../../byterun/misc.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h unixsupport.h socketaddr.h \
- ../../byterun/misc.h
-gettimeofday.o: gettimeofday.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h unixsupport.h
-getuid.o: getuid.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
-gmtime.o: gmtime.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h ../../byterun/fail.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h unixsupport.h
-initgroups.o: initgroups.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h unixsupport.h
-isatty.o: isatty.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
-itimer.o: itimer.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h ../../byterun/fail.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h unixsupport.h
-kill.o: kill.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 unixsupport.h ../../byterun/signals.h
-link.o: link.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.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/signals.h unixsupport.h
-listen.o: listen.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h unixsupport.h
-lockf.o: lockf.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h ../../byterun/signals.h unixsupport.h
-lseek.o: lseek.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h ../../byterun/io.h ../../byterun/signals.h \
- unixsupport.h
-mkdir.o: mkdir.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.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/signals.h unixsupport.h
-mkfifo.o: mkfifo.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h
-nice.o: nice.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
-open.o: open.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../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/misc.h ../../byterun/signals.h \
- unixsupport.h
-opendir.o: opendir.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.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/alloc.h \
- ../../byterun/signals.h unixsupport.h
-pipe.o: pipe.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h unixsupport.h
-putenv.o: putenv.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/memory.h ../../byterun/gc.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h \
- ../../byterun/mlvalues.h unixsupport.h
-read.o: read.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.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/signals.h unixsupport.h
-readdir.o: readdir.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/alloc.h ../../byterun/signals.h unixsupport.h
-readlink.o: readlink.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.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/alloc.h \
- ../../byterun/fail.h ../../byterun/signals.h unixsupport.h
-rename.o: rename.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.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/signals.h unixsupport.h
-rewinddir.o: rewinddir.c ../../byterun/fail.h \
- ../../byterun/compatibility.h ../../byterun/misc.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h unixsupport.h
-rmdir.o: rmdir.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.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/signals.h unixsupport.h
-select.o: select.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h ../../byterun/fail.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h
-sendrecv.o: sendrecv.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h \
- socketaddr.h ../../byterun/misc.h
-setgid.o: setgid.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
-setgroups.o: setgroups.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h unixsupport.h
-setsid.o: setsid.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h unixsupport.h
-setuid.o: setuid.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
-shutdown.o: shutdown.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h unixsupport.h
-signals.o: signals.c ../../byterun/alloc.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/mlvalues.h \
- ../../byterun/signals.h unixsupport.h
-sleep.o: sleep.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h \
- ../../byterun/signals.h ../../byterun/mlvalues.h unixsupport.h
-socket.o: socket.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h unixsupport.h
-socketaddr.o: socketaddr.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../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 unixsupport.h \
- socketaddr.h ../../byterun/misc.h
-socketpair.o: socketpair.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h unixsupport.h
-sockopt.o: sockopt.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.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/alloc.h \
- ../../byterun/fail.h unixsupport.h socketaddr.h ../../byterun/misc.h
-stat.o: stat.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.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/alloc.h \
- ../../byterun/signals.h unixsupport.h cst2constr.h ../../byterun/io.h
-strofaddr.o: strofaddr.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h unixsupport.h socketaddr.h ../../byterun/misc.h
-symlink.o: symlink.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h
-termios.o: termios.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h unixsupport.h
-time.o: time.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h unixsupport.h
-times.o: times.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../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 unixsupport.h
-truncate.o: truncate.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.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 \
- ../../byterun/signals.h ../../byterun/io.h unixsupport.h
-umask.o: umask.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
-unixsupport.o: unixsupport.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/callback.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/fail.h unixsupport.h \
- cst2constr.h
-unlink.o: unlink.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.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/signals.h unixsupport.h
-utimes.o: utimes.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h
-wait.o: wait.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h ../../byterun/fail.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h
-write.o: write.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.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/signals.h unixsupport.h
-unix.cmi :
+accept.o: accept.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/fail.h \
+ ../../byterun/caml/memory.h ../../byterun/caml/gc.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/signals.h unixsupport.h socketaddr.h \
+ ../../byterun/caml/misc.h
+access.o: access.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/major_gc.h \
+ ../../byterun/caml/freelist.h ../../byterun/caml/minor_gc.h \
+ ../../byterun/caml/address_class.h ../../byterun/caml/signals.h \
+ unixsupport.h
+addrofstr.o: addrofstr.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/fail.h unixsupport.h socketaddr.h \
+ ../../byterun/caml/misc.h
+alarm.o: alarm.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h unixsupport.h
+bind.o: bind.c ../../byterun/caml/fail.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
+ ../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
+ ../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/mlvalues.h unixsupport.h socketaddr.h \
+ ../../byterun/caml/misc.h
+chdir.o: chdir.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/signals.h unixsupport.h
+chmod.o: chmod.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/signals.h unixsupport.h
+chown.o: chown.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/signals.h unixsupport.h
+chroot.o: chroot.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/signals.h unixsupport.h
+close.o: close.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/signals.h \
+ ../../byterun/caml/mlvalues.h unixsupport.h
+closedir.o: closedir.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/signals.h unixsupport.h
+connect.o: connect.c ../../byterun/caml/fail.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
+ ../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
+ ../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/signals.h unixsupport.h \
+ socketaddr.h ../../byterun/caml/misc.h
+cst2constr.o: cst2constr.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/fail.h \
+ ../../byterun/caml/mlvalues.h cst2constr.h
+cstringv.o: cstringv.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ unixsupport.h
+dup2.o: dup2.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h unixsupport.h
+dup.o: dup.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h unixsupport.h
+envir.o: envir.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h
+errmsg.o: errmsg.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h
+execv.o: execv.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ unixsupport.h
+execve.o: execve.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ unixsupport.h
+execvp.o: execvp.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ unixsupport.h
+exit.o: exit.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h unixsupport.h
+fchmod.o: fchmod.c ../../byterun/caml/fail.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
+ ../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
+ ../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/signals.h unixsupport.h
+fchown.o: fchown.c ../../byterun/caml/fail.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
+ ../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
+ ../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/signals.h unixsupport.h
+fcntl.o: fcntl.c ../../byterun/caml/fail.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
+ ../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
+ ../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/mlvalues.h unixsupport.h
+fork.o: fork.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/debugger.h \
+ ../../byterun/caml/mlvalues.h unixsupport.h
+ftruncate.o: ftruncate.c ../../byterun/caml/fail.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
+ ../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
+ ../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/io.h \
+ ../../byterun/caml/signals.h unixsupport.h
+getaddrinfo.o: getaddrinfo.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/fail.h \
+ ../../byterun/caml/memory.h ../../byterun/caml/gc.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/signals.h unixsupport.h \
+ cst2constr.h socketaddr.h
+getcwd.o: getcwd.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/fail.h unixsupport.h
+getegid.o: getegid.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h unixsupport.h
+geteuid.o: geteuid.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h unixsupport.h
+getgid.o: getgid.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h unixsupport.h
+getgr.o: getgr.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/fail.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/memory.h ../../byterun/caml/gc.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ unixsupport.h
+getgroups.o: getgroups.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/fail.h unixsupport.h
+gethost.o: gethost.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/fail.h \
+ ../../byterun/caml/memory.h ../../byterun/caml/gc.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/signals.h unixsupport.h socketaddr.h \
+ ../../byterun/caml/misc.h
+gethostname.o: gethostname.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/fail.h unixsupport.h
+getlogin.o: getlogin.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h unixsupport.h
+getnameinfo.o: getnameinfo.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/fail.h \
+ ../../byterun/caml/memory.h ../../byterun/caml/gc.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/signals.h unixsupport.h socketaddr.h \
+ ../../byterun/caml/misc.h
+getpeername.o: getpeername.c ../../byterun/caml/fail.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
+ ../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
+ ../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/mlvalues.h unixsupport.h socketaddr.h \
+ ../../byterun/caml/misc.h
+getpid.o: getpid.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h unixsupport.h
+getppid.o: getppid.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h unixsupport.h
+getproto.o: getproto.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/fail.h \
+ ../../byterun/caml/memory.h ../../byterun/caml/gc.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ unixsupport.h
+getpw.o: getpw.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/major_gc.h \
+ ../../byterun/caml/freelist.h ../../byterun/caml/minor_gc.h \
+ ../../byterun/caml/address_class.h ../../byterun/caml/fail.h \
+ unixsupport.h
+getserv.o: getserv.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/fail.h \
+ ../../byterun/caml/memory.h ../../byterun/caml/gc.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ unixsupport.h
+getsockname.o: getsockname.c ../../byterun/caml/fail.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
+ ../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
+ ../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/mlvalues.h unixsupport.h socketaddr.h \
+ ../../byterun/caml/misc.h
+gettimeofday.o: gettimeofday.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/fail.h unixsupport.h
+getuid.o: getuid.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h unixsupport.h
+gmtime.o: gmtime.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/fail.h \
+ ../../byterun/caml/memory.h ../../byterun/caml/gc.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ unixsupport.h
+initgroups.o: initgroups.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/fail.h unixsupport.h
+isatty.o: isatty.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h unixsupport.h
+itimer.o: itimer.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/fail.h \
+ ../../byterun/caml/memory.h ../../byterun/caml/gc.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ unixsupport.h
+kill.o: kill.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/fail.h \
+ ../../byterun/caml/mlvalues.h unixsupport.h ../../byterun/caml/signals.h
+link.o: link.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/signals.h unixsupport.h
+listen.o: listen.c ../../byterun/caml/fail.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
+ ../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
+ ../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/mlvalues.h unixsupport.h
+lockf.o: lockf.c ../../byterun/caml/fail.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
+ ../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
+ ../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/signals.h unixsupport.h
+lseek.o: lseek.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/io.h \
+ ../../byterun/caml/signals.h unixsupport.h
+mkdir.o: mkdir.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/signals.h unixsupport.h
+mkfifo.o: mkfifo.c ../../byterun/caml/fail.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
+ ../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
+ ../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/major_gc.h \
+ ../../byterun/caml/freelist.h ../../byterun/caml/minor_gc.h \
+ ../../byterun/caml/address_class.h ../../byterun/caml/signals.h \
+ unixsupport.h
+nice.o: nice.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h unixsupport.h
+open.o: open.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/major_gc.h \
+ ../../byterun/caml/freelist.h ../../byterun/caml/minor_gc.h \
+ ../../byterun/caml/address_class.h ../../byterun/caml/misc.h \
+ ../../byterun/caml/signals.h unixsupport.h
+opendir.o: opendir.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/alloc.h ../../byterun/caml/signals.h unixsupport.h
+pipe.o: pipe.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h unixsupport.h
+putenv.o: putenv.c ../../byterun/caml/fail.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
+ ../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
+ ../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/memory.h ../../byterun/caml/gc.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/mlvalues.h unixsupport.h
+read.o: read.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/signals.h unixsupport.h
+readdir.o: readdir.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/fail.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/signals.h unixsupport.h
+readlink.o: readlink.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/alloc.h ../../byterun/caml/fail.h \
+ ../../byterun/caml/signals.h unixsupport.h
+rename.o: rename.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/signals.h unixsupport.h
+rewinddir.o: rewinddir.c ../../byterun/caml/fail.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
+ ../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
+ ../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/mlvalues.h unixsupport.h
+rmdir.o: rmdir.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/signals.h unixsupport.h
+select.o: select.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/fail.h \
+ ../../byterun/caml/memory.h ../../byterun/caml/gc.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/signals.h unixsupport.h
+sendrecv.o: sendrecv.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/fail.h \
+ ../../byterun/caml/memory.h ../../byterun/caml/gc.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/signals.h unixsupport.h socketaddr.h \
+ ../../byterun/caml/misc.h
+setgid.o: setgid.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h unixsupport.h
+setgroups.o: setgroups.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/fail.h \
+ ../../byterun/caml/memory.h ../../byterun/caml/gc.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ unixsupport.h
+setsid.o: setsid.c ../../byterun/caml/fail.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
+ ../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
+ ../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/mlvalues.h unixsupport.h
+setuid.o: setuid.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h unixsupport.h
+shutdown.o: shutdown.c ../../byterun/caml/fail.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
+ ../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
+ ../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/mlvalues.h unixsupport.h
+signals.o: signals.c ../../byterun/caml/alloc.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
+ ../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
+ ../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/fail.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/major_gc.h \
+ ../../byterun/caml/freelist.h ../../byterun/caml/minor_gc.h \
+ ../../byterun/caml/address_class.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/signals.h unixsupport.h
+sleep.o: sleep.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/signals.h \
+ ../../byterun/caml/mlvalues.h unixsupport.h
+socketaddr.o: socketaddr.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/major_gc.h \
+ ../../byterun/caml/freelist.h ../../byterun/caml/minor_gc.h \
+ ../../byterun/caml/address_class.h unixsupport.h socketaddr.h \
+ ../../byterun/caml/misc.h
+socket.o: socket.c ../../byterun/caml/fail.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
+ ../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
+ ../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/mlvalues.h unixsupport.h
+socketpair.o: socketpair.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/fail.h unixsupport.h
+sockopt.o: sockopt.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/alloc.h ../../byterun/caml/fail.h unixsupport.h \
+ socketaddr.h ../../byterun/caml/misc.h
+stat.o: stat.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/alloc.h ../../byterun/caml/signals.h \
+ ../../byterun/caml/io.h unixsupport.h cst2constr.h nanosecond_stat.h
+strofaddr.o: strofaddr.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/fail.h unixsupport.h \
+ socketaddr.h ../../byterun/caml/misc.h
+symlink.o: symlink.c ../../byterun/caml/fail.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
+ ../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
+ ../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/major_gc.h \
+ ../../byterun/caml/freelist.h ../../byterun/caml/minor_gc.h \
+ ../../byterun/caml/address_class.h ../../byterun/caml/signals.h \
+ unixsupport.h
+termios.o: termios.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/fail.h unixsupport.h
+time.o: time.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h unixsupport.h
+times.o: times.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/major_gc.h \
+ ../../byterun/caml/freelist.h ../../byterun/caml/minor_gc.h \
+ ../../byterun/caml/address_class.h unixsupport.h
+truncate.o: truncate.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/fail.h ../../byterun/caml/signals.h \
+ ../../byterun/caml/io.h unixsupport.h
+umask.o: umask.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h unixsupport.h
+unixsupport.o: unixsupport.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/callback.h \
+ ../../byterun/caml/memory.h ../../byterun/caml/gc.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/fail.h unixsupport.h cst2constr.h
+unlink.o: unlink.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/signals.h unixsupport.h
+utimes.o: utimes.c ../../byterun/caml/fail.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
+ ../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
+ ../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/major_gc.h \
+ ../../byterun/caml/freelist.h ../../byterun/caml/minor_gc.h \
+ ../../byterun/caml/address_class.h ../../byterun/caml/signals.h \
+ unixsupport.h
+wait.o: wait.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
+ ../../byterun/caml/mlvalues.h ../../byterun/caml/fail.h \
+ ../../byterun/caml/memory.h ../../byterun/caml/gc.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/signals.h unixsupport.h
+write.o: write.c ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
+ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
+ ../../byterun/caml/misc.h ../../byterun/caml/memory.h \
+ ../../byterun/caml/gc.h ../../byterun/caml/mlvalues.h \
+ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
+ ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
+ ../../byterun/caml/signals.h unixsupport.h
unixLabels.cmi : unix.cmi
-unix.cmo : unix.cmi
-unix.cmx : unix.cmi
+unix.cmi :
unixLabels.cmo : unix.cmi unixLabels.cmi
unixLabels.cmx : unix.cmx unixLabels.cmi
+unix.cmo : unix.cmi
+unix.cmx : unix.cmi
include ../Makefile
depend:
- gcc -MM $(CFLAGS) *.c > .depend
- ../../boot/ocamlrun ../../tools/ocamldep *.mli *.ml >> .depend
+ $(CC) -MM $(CFLAGS) *.c > .depend
+ $(CAMLRUN) ../../tools/ocamldep *.mli *.ml >> .depend
include .depend
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
-#include <fail.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#ifdef HAS_SOCKETS
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#ifdef HAS_UNISTD
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <memory.h>
-#include <fail.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
#include "unixsupport.h"
#ifdef HAS_SOCKETS
/* */
/***********************************************************************/
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
CAMLprim value unix_alarm(value t)
/* */
/***********************************************************************/
-#include <fail.h>
-#include <mlvalues.h>
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
#ifdef HAS_SOCKETS
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "unixsupport.h"
CAMLprim value unix_chdir(value path)
#include <sys/types.h>
#include <sys/stat.h>
-#include <mlvalues.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "unixsupport.h"
CAMLprim value unix_chmod(value path, value perm)
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "unixsupport.h"
CAMLprim value unix_chown(value path, value uid, value gid)
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "unixsupport.h"
CAMLprim value unix_chroot(value path)
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/signals.h>
#include "unixsupport.h"
CAMLprim value unix_close(value fd)
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#include <errno.h>
#include <sys/types.h>
/* */
/***********************************************************************/
-#include <fail.h>
-#include <mlvalues.h>
-#include <signals.h>
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#ifdef HAS_SOCKETS
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <fail.h>
+#include <caml/mlvalues.h>
+#include <caml/fail.h>
#include "cst2constr.h"
value cst_to_constr(int n, int *tbl, int size, int deflt)
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <memory.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
#include "unixsupport.h"
char ** cstringvect(value arg)
/* */
/***********************************************************************/
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
CAMLprim value unix_dup(value fd)
/* */
/***********************************************************************/
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
#ifdef HAS_DUP2
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
#ifndef _WIN32
extern char ** environ;
#include <errno.h>
#include <string.h>
-#include <mlvalues.h>
-#include <alloc.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
extern int error_table[];
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <memory.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
#include "unixsupport.h"
extern char ** cstringvect();
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <memory.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
#include "unixsupport.h"
extern char ** cstringvect();
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <memory.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
#include "unixsupport.h"
extern char ** cstringvect();
/* */
/***********************************************************************/
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
CAMLprim value unix_exit(value n)
#include <sys/types.h>
#include <sys/stat.h>
-#include <fail.h>
-#include <mlvalues.h>
-#include <signals.h>
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#ifdef HAS_FCHMOD
/* */
/***********************************************************************/
-#include <fail.h>
-#include <mlvalues.h>
-#include <signals.h>
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#ifdef HAS_FCHMOD
/* */
/***********************************************************************/
-#include <fail.h>
-#include <mlvalues.h>
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
#ifdef HAS_UNISTD
#include <unistd.h>
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <debugger.h>
+#include <caml/mlvalues.h>
+#include <caml/debugger.h>
#include "unixsupport.h"
CAMLprim value unix_fork(value unit)
/***********************************************************************/
#include <sys/types.h>
-#include <fail.h>
-#include <mlvalues.h>
-#include <io.h>
-#include <signals.h>
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
+#include <caml/io.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#ifdef HAS_UNISTD
#include <unistd.h>
/***********************************************************************/
#include <string.h>
-#include <mlvalues.h>
-#include <alloc.h>
-#include <fail.h>
-#include <memory.h>
-#include <misc.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/misc.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#include "cst2constr.h"
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
-#include <fail.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
#include "unixsupport.h"
#if !defined (_WIN32) && !macintosh
/* */
/***********************************************************************/
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
CAMLprim value unix_getegid(value unit)
/* */
/***********************************************************************/
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
CAMLprim value unix_geteuid(value unit)
/* */
/***********************************************************************/
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
CAMLprim value unix_getgid(value unit)
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <fail.h>
-#include <alloc.h>
-#include <memory.h>
+#include <caml/mlvalues.h>
+#include <caml/fail.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
#include "unixsupport.h"
#include <stdio.h>
#include <grp.h>
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
-#include <fail.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
#ifdef HAS_GETGROUPS
/***********************************************************************/
#include <string.h>
-#include <mlvalues.h>
-#include <alloc.h>
-#include <fail.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#ifdef HAS_SOCKETS
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
-#include <fail.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
#ifndef _WIN32
#include <sys/param.h>
#endif
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
#include "unixsupport.h"
#include <errno.h>
/***********************************************************************/
#include <string.h>
-#include <mlvalues.h>
-#include <alloc.h>
-#include <fail.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#if defined(HAS_SOCKETS) && defined(HAS_IPV6)
/* */
/***********************************************************************/
-#include <fail.h>
-#include <mlvalues.h>
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
#ifdef HAS_SOCKETS
/* */
/***********************************************************************/
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
CAMLprim value unix_getpid(value unit)
/* */
/***********************************************************************/
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
CAMLprim value unix_getppid(value unit)
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
-#include <fail.h>
-#include <memory.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
#include "unixsupport.h"
#ifdef HAS_SOCKETS
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
-#include <memory.h>
-#include <fail.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
#include "unixsupport.h"
#include <pwd.h>
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
-#include <fail.h>
-#include <memory.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
#include "unixsupport.h"
#ifdef HAS_SOCKETS
/* */
/***********************************************************************/
-#include <fail.h>
-#include <mlvalues.h>
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
#ifdef HAS_SOCKETS
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
-#include <fail.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
#include "unixsupport.h"
#ifdef HAS_GETTIMEOFDAY
/* */
/***********************************************************************/
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
CAMLprim value unix_getuid(value unit)
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
-#include <fail.h>
-#include <memory.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
#include "unixsupport.h"
#include <time.h>
#include <errno.h>
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
-#include <fail.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
#ifdef HAS_INITGROUPS
/* */
/***********************************************************************/
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
CAMLprim value unix_isatty(value fd)
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
-#include <fail.h>
-#include <memory.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
#include "unixsupport.h"
#ifdef HAS_SETITIMER
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <fail.h>
+#include <caml/mlvalues.h>
+#include <caml/fail.h>
#include "unixsupport.h"
#include <signal.h>
-#include <signals.h>
+#include <caml/signals.h>
CAMLprim value unix_kill(value pid, value signal)
{
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "unixsupport.h"
CAMLprim value unix_link(value path1, value path2)
/* */
/***********************************************************************/
-#include <fail.h>
-#include <mlvalues.h>
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
#ifdef HAS_SOCKETS
#include <errno.h>
#include <fcntl.h>
-#include <fail.h>
-#include <mlvalues.h>
-#include <signals.h>
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#if defined(F_GETLK) && defined(F_SETLK) && defined(F_SETLKW)
#include <errno.h>
#include <sys/types.h>
-#include <mlvalues.h>
-#include <alloc.h>
-#include <io.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/io.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#ifdef HAS_UNISTD
#include <sys/types.h>
#include <sys/stat.h>
-#include <mlvalues.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "unixsupport.h"
CAMLprim value unix_mkdir(value path, value perm)
#include <sys/types.h>
#include <sys/stat.h>
-#include <fail.h>
-#include <mlvalues.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#ifdef HAS_MKFIFO
--- /dev/null
+/***********************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Jeremie Dimino, Jane Street Group, LLC */
+/* */
+/* Copyright 2015 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 is used by the configure test program nanosecond_stat.c
+ and stat.c in this directory */
+
+#if HAS_NANOSECOND_STAT == 1
+# define NSEC(buf, field) buf->st_##field##tim.tv_nsec
+#elif HAS_NANOSECOND_STAT == 2
+# define NSEC(buf, field) buf->st_##field##timespec.tv_nsec
+#elif HAS_NANOSECOND_STAT == 3
+# define NSEC(buf, field) buf->st_##field##timensec
+#else
+# define NSEC(buf, field) 0
+#endif
/* */
/***********************************************************************/
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
#include <errno.h>
#ifdef HAS_UNISTD
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
-#include <memory.h>
-#include <misc.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/misc.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#include <string.h>
#ifdef HAS_UNISTD
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <memory.h>
-#include <alloc.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#include <sys/types.h>
#ifdef HAS_DIRENT
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
#include "unixsupport.h"
CAMLprim value unix_pipe(value unit)
#include <stdlib.h>
#include <string.h>
-#include <fail.h>
-#include <memory.h>
-#include <mlvalues.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
/***********************************************************************/
#include <string.h>
-#include <mlvalues.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "unixsupport.h"
CAMLprim value unix_read(value fd, value buf, value ofs, value len)
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <fail.h>
-#include <alloc.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/fail.h>
+#include <caml/alloc.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#include <errno.h>
#include <sys/types.h>
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <memory.h>
-#include <alloc.h>
-#include <fail.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/signals.h>
#ifdef HAS_SYMLINK
/***********************************************************************/
#include <stdio.h>
-#include <mlvalues.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "unixsupport.h"
CAMLprim value unix_rename(value path1, value path2)
/* */
/***********************************************************************/
-#include <fail.h>
-#include <mlvalues.h>
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
#include <errno.h>
#include <sys/types.h>
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "unixsupport.h"
CAMLprim value unix_rmdir(value path)
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
-#include <fail.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#ifdef HAS_SELECT
/***********************************************************************/
#include <string.h>
-#include <mlvalues.h>
-#include <alloc.h>
-#include <fail.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#ifdef HAS_SOCKETS
/* */
/***********************************************************************/
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
CAMLprim value unix_setgid(value gid)
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
-#include <fail.h>
-#include <memory.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
#ifdef HAS_SETGROUPS
/* */
/***********************************************************************/
-#include <fail.h>
-#include <mlvalues.h>
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
#ifdef HAS_UNISTD
#include <unistd.h>
/* */
/***********************************************************************/
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
CAMLprim value unix_setuid(value uid)
/* */
/***********************************************************************/
-#include <fail.h>
-#include <mlvalues.h>
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
#ifdef HAS_SOCKETS
#include <errno.h>
#include <signal.h>
-#include <alloc.h>
-#include <fail.h>
-#include <memory.h>
-#include <mlvalues.h>
-#include <signals.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#ifndef NSIG
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/signals.h>
#include "unixsupport.h"
CAMLprim value unix_sleep(value t)
/* */
/***********************************************************************/
-#include <fail.h>
-#include <mlvalues.h>
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
#ifdef HAS_SOCKETS
/***********************************************************************/
#include <string.h>
-#include <mlvalues.h>
-#include <alloc.h>
-#include <memory.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
#include <errno.h>
#include "unixsupport.h"
/* */
/***********************************************************************/
-#include "misc.h"
+#ifndef CAML_SOCKETADDR_H
+#define CAML_SOCKETADDR_H
+
+#include "caml/misc.h"
#include <sys/types.h>
#include <sys/socket.h>
#include <sys/un.h>
typedef int socklen_param_type;
#endif
+#ifdef __cplusplus
+extern "C" {
+#endif
+
extern void get_sockaddr (value mladdr,
union sock_addr_union * addr /*out*/,
socklen_param_type * addr_len /*out*/);
CAMLexport value alloc_inet6_addr (struct in6_addr * inaddr);
#define GET_INET6_ADDR(v) (*((struct in6_addr *) (v)))
#endif
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_SOCKETADDR_H */
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
-#include <fail.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
#include "unixsupport.h"
#ifdef HAS_SOCKETS
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <memory.h>
-#include <alloc.h>
-#include <fail.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
#include "unixsupport.h"
#ifdef HAS_SOCKETS
switch (ty) {
case TYPE_BOOL:
+ return Val_bool(optval.i);
case TYPE_INT:
return Val_int(optval.i);
case TYPE_LINGER:
/***********************************************************************/
#include <errno.h>
-#include <mlvalues.h>
-#include <memory.h>
-#include <alloc.h>
-#include <signals.h>
-#include "unixsupport.h"
-#include "cst2constr.h"
#include <sys/types.h>
#include <sys/stat.h>
-#include <io.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/signals.h>
+#include <caml/io.h>
+#include "unixsupport.h"
+#include "cst2constr.h"
#ifndef S_IFLNK
#define S_IFLNK 0
CAMLparam0();
CAMLlocal5(atime, mtime, ctime, offset, v);
- atime = copy_double((double) buf->st_atime);
- mtime = copy_double((double) buf->st_mtime);
- ctime = copy_double((double) buf->st_ctime);
+ #include "nanosecond_stat.h"
+ atime = caml_copy_double((double) buf->st_atime + (NSEC(buf, a) / 1000000000.0));
+ mtime = caml_copy_double((double) buf->st_mtime + (NSEC(buf, m) / 1000000000.0));
+ ctime = caml_copy_double((double) buf->st_ctime + (NSEC(buf, c) / 1000000000.0));
+ #undef NSEC
offset = use_64 ? Val_file_offset(buf->st_size) : Val_int (buf->st_size);
v = alloc_small(12, 0);
Field (v, 0) = Val_int (buf->st_dev);
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
-#include <fail.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
#include "unixsupport.h"
#ifdef HAS_SOCKETS
/* */
/***********************************************************************/
-#include <fail.h>
-#include <mlvalues.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#ifdef HAS_SYMLINK
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
-#include <fail.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
#include "unixsupport.h"
#ifdef HAS_TERMIOS
#undef cflags
#undef lflags
-struct speedtable_entry ;
-
static struct {
speed_t speed;
int baud;
} speedtable[] = {
+
+ /* standard speeds */
+ {B0, 0},
{B50, 50},
{B75, 75},
{B110, 110},
{B134, 134},
{B150, 150},
+#ifdef B200
+ /* Shouldn't need to be ifdef'd but I'm not sure it's available everywhere. */
+ {B200, 200},
+#endif
{B300, 300},
{B600, 600},
{B1200, 1200},
{B9600, 9600},
{B19200, 19200},
{B38400, 38400},
+
+ /* usual extensions */
#ifdef B57600
{B57600, 57600},
#endif
#ifdef B230400
{B230400, 230400},
#endif
- {B0, 0}
+
+ /* Linux extensions */
+#ifdef B460800
+ {B460800, 460800},
+#endif
+#ifdef B500000
+ {B500000, 500000},
+#endif
+#ifdef B576000
+ {B576000, 576000},
+#endif
+#ifdef B921600
+ {B921600, 921600},
+#endif
+#ifdef B1000000
+ {B1000000, 1000000},
+#endif
+#ifdef B1152000
+ {B1152000, 1152000},
+#endif
+#ifdef B1500000
+ {B1500000, 1500000},
+#endif
+#ifdef B2000000
+ {B2000000, 2000000},
+#endif
+#ifdef B2500000
+ {B2500000, 2500000},
+#endif
+#ifdef B3000000
+ {B3000000, 3000000},
+#endif
+#ifdef B3500000
+ {B3500000, 3500000},
+#endif
+#ifdef B4000000
+ {B4000000, 4000000},
+#endif
+
+ /* MacOS extensions */
+#ifdef B7200
+ {B7200, 7200},
+#endif
+#ifdef B14400
+ {B14400, 14400},
+#endif
+#ifdef B28800
+ {B28800, 28800},
+#endif
+#ifdef B76800
+ {B76800, 76800},
+#endif
+
+ /* Cygwin extensions (in addition to the Linux ones) */
+#ifdef B128000
+ {B128000, 128000},
+#endif
+#ifdef B256000
+ {B256000, 256000},
+#endif
};
#define NSPEEDS (sizeof(speedtable) / sizeof(speedtable[0]))
/***********************************************************************/
#include <time.h>
-#include <mlvalues.h>
-#include <alloc.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
#include "unixsupport.h"
CAMLprim value unix_time(value unit)
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
-#include <memory.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
#include "unixsupport.h"
#include <time.h>
#include <sys/types.h>
/***********************************************************************/
#include <sys/types.h>
-#include <mlvalues.h>
-#include <memory.h>
-#include <fail.h>
-#include <signals.h>
-#include <io.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
+#include <caml/signals.h>
+#include <caml/io.h>
#include "unixsupport.h"
#ifdef HAS_UNISTD
#include <unistd.h>
#include <sys/types.h>
#include <sys/stat.h>
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
CAMLprim value unix_umask(value perm)
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
-#include <callback.h>
-#include <memory.h>
-#include <fail.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/callback.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
#include "unixsupport.h"
#include "cst2constr.h"
#include <errno.h>
/* */
/***********************************************************************/
+#ifndef CAML_UNIXSUPPORT_H
+#define CAML_UNIXSUPPORT_H
+
#ifdef HAS_UNISTD
#include <unistd.h>
#endif
+#ifdef __cplusplus
+extern "C" {
+#endif
+
#define Nothing ((value) 0)
extern value unix_error_of_code (int errcode);
#define UNIX_BUFFER_SIZE 65536
#define DIR_Val(v) *((DIR **) &Field(v, 0))
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_UNIXSUPPORT_H */
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "unixsupport.h"
CAMLprim value unix_unlink(value path)
/* */
/***********************************************************************/
-#include <fail.h>
-#include <mlvalues.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/fail.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#ifdef HAS_UTIME
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
-#include <fail.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#include <sys/types.h>
#include <errno.h>
#include <string.h>
-#include <mlvalues.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#ifndef EAGAIN
#include <windows.h>
-#include <memory.h>
+#include <caml/memory.h>
#include <string.h>
-#include <io.h>
+#include <caml/io.h>
#include <stdio.h>
// Size of window extra bytes (we store a handle to a PALINFO structure).
/***********************************************************************/
#include <math.h>
-#include "mlvalues.h"
-#include "alloc.h"
-#include "fail.h"
+#include "caml/mlvalues.h"
+#include "caml/alloc.h"
+#include "caml/fail.h"
#include "libgraph.h"
-#include "custom.h"
-#include "memory.h"
+#include "caml/custom.h"
+#include "caml/memory.h"
HDC gcMetaFile;
int grdisplay_mode;
/* */
/***********************************************************************/
-#include "mlvalues.h"
-#include "alloc.h"
+#include "caml/mlvalues.h"
+#include "caml/alloc.h"
#include "libgraph.h"
#include <windows.h>
#include <fcntl.h>
#include <signal.h>
-#include "mlvalues.h"
-#include "fail.h"
+#include "caml/mlvalues.h"
+#include "caml/fail.h"
#include "libgraph.h"
-#include "callback.h"
+#include "caml/callback.h"
#include <windows.h>
static value gr_reset(void);
WNDCLASS wc;
memset(&wc,0,sizeof(WNDCLASS));
- wc.style = CS_HREDRAW|CS_VREDRAW |CS_DBLCLKS|CS_OWNDC ;
+ wc.style = CS_HREDRAW|CS_VREDRAW|CS_OWNDC ;
wc.lpfnWndProc = (WNDPROC)GraphicsWndProc;
wc.hInstance = hInst;
wc.hbrBackground = (HBRUSH)(COLOR_WINDOW+1);
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#include <mswsock.h> // for SO_OPENTYPE and SO_SYNCHRONOUS_NONALERT
#include "socketaddr.h"
/* */
/***********************************************************************/
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
#include "socketaddr.h"
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
-#include <io.h>
-#include <memory.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/io.h>
+#include <caml/memory.h>
#include "unixsupport.h"
#include <fcntl.h>
/* */
/***********************************************************************/
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
-#include <io.h>
+#include <caml/io.h>
extern int _close(int);
/* */
/***********************************************************************/
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
#include <windows.h>
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#include "socketaddr.h"
/* */
/***********************************************************************/
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
#include <windows.h>
-#include <osdeps.h>
+#include <caml/osdeps.h>
static int win_has_console(void);
/* */
/***********************************************************************/
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
CAMLprim value unix_dup(value fd)
/* */
/***********************************************************************/
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
extern int _dup2(int, int);
#include <stdio.h>
#include <errno.h>
#include <string.h>
-#include <mlvalues.h>
-#include <alloc.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
#include "unixsupport.h"
extern int error_table[];
/* */
/***********************************************************************/
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
#include "socketaddr.h"
/* */
/***********************************************************************/
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
extern value val_process_id;
/* */
/***********************************************************************/
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
#include "socketaddr.h"
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
#include <time.h>
#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;
+/* Unix epoch as a Windows timestamp in hundreds of ns */
+#define epoch_ft 116444736000000000.0;
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 +
- (double) (tickcount - initial_tickcount) * 1e-3);
- }
+ FILETIME ft;
+ double tm;
+ GetSystemTimeAsFileTime(&ft);
+ tm = *(uint64 *)&ft - epoch_ft; /* shift to Epoch-relative time */
+ return copy_double(tm * 1e-7); /* tm is in 100ns */
}
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <fail.h>
+#include <caml/mlvalues.h>
+#include <caml/fail.h>
#include "unixsupport.h"
#include <windows.h>
/* */
/***********************************************************************/
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
CAMLprim value unix_listen(sock, backlog)
#include <errno.h>
#include <fcntl.h>
-#include <mlvalues.h>
-#include <memory.h>
-#include <fail.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
#include "unixsupport.h"
#include <stdio.h>
-#include <signals.h>
+#include <caml/signals.h>
#ifndef INVALID_SET_FILE_POINTER
#define INVALID_SET_FILE_POINTER (-1)
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
#include "unixsupport.h"
#ifdef HAS_UNISTD
/* */
/***********************************************************************/
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
CAMLprim value unix_mkdir(path, perm)
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/signals.h>
#include "unixsupport.h"
CAMLprim value unix_set_nonblock(socket)
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
#include "unixsupport.h"
#include <fcntl.h>
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <memory.h>
-#include <alloc.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
#include "unixsupport.h"
#include <fcntl.h>
/***********************************************************************/
#include <string.h>
-#include <mlvalues.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "unixsupport.h"
CAMLprim value unix_read(value fd, value buf, value ofs, value vlen)
/***********************************************************************/
#include <stdio.h>
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
CAMLprim value unix_rename(value path1, value path2)
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
-#include <memory.h>
-#include <fail.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
+#include <caml/signals.h>
#include "winworker.h"
#include <stdio.h>
#include "windbug.h"
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#include "socketaddr.h"
/* */
/***********************************************************************/
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
static int shutdown_command_table[] = {
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/signals.h>
#include "unixsupport.h"
CAMLprim value unix_sleep(t)
/* */
/***********************************************************************/
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "unixsupport.h"
#include <mswsock.h> // for SO_OPENTYPE and SO_SYNCHRONOUS_NONALERT
/* */
/***********************************************************************/
-#include "misc.h"
+#ifndef CAML_SOCKETADDR_H
+#define CAML_SOCKETADDR_H
+
+#include "caml/misc.h"
union sock_addr_union {
struct sockaddr s_gen;
typedef int socklen_param_type;
#endif
+#ifdef __cplusplus
+extern "C" {
+#endif
+
extern void get_sockaddr (value mladdr,
union sock_addr_union * addr /*out*/,
socklen_param_type * addr_len /*out*/);
CAMLexport value alloc_inet6_addr (struct in6_addr * inaddr);
#define GET_INET6_ADDR(v) (*((struct in6_addr *) (v)))
#endif
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_SOCKETADDR_H */
/***********************************************************************/
#include <errno.h>
-#include <mlvalues.h>
-#include <memory.h>
-#include <alloc.h>
-#include <fail.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
#include "unixsupport.h"
#include "socketaddr.h"
#include <stdio.h>
#include <fcntl.h>
#include <stdlib.h>
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include "winworker.h"
#include "windbug.h"
/***********************************************************************/
#include <errno.h>
-#include <mlvalues.h>
-#include <memory.h>
-#include <alloc.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
#include "unixsupport.h"
#include "cst2constr.h"
#define _INTEGRAL_MAX_BITS 64
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <memory.h>
-#include <alloc.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#include <process.h>
#include <stdio.h>
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
#include "unixsupport.h"
#include <windows.h>
/***********************************************************************/
#include <stddef.h>
-#include <mlvalues.h>
-#include <callback.h>
-#include <alloc.h>
-#include <memory.h>
-#include <fail.h>
-#include <custom.h>
+#include <caml/mlvalues.h>
+#include <caml/callback.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
+#include <caml/custom.h>
#include "unixsupport.h"
#include "cst2constr.h"
#include <errno.h>
/* */
/***********************************************************************/
+#ifndef CAML_UNIXSUPPORT_H
+#define CAML_UNIXSUPPORT_H
+
#define WIN32_LEAN_AND_MEAN
#include <wtypes.h>
#include <winbase.h>
#include <wspiapi.h>
#endif
+#ifdef __cplusplus
+extern "C" {
+#endif
+
struct filedescr {
union {
HANDLE handle;
#define FLAGS_FD_IS_BLOCKING (1<<0)
#define UNIX_BUFFER_SIZE 65536
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* CAML_UNIXSUPPORT_H */
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <memory.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
#include <errno.h>
-#include <alloc.h>
-#include <fail.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
#include "unixsupport.h"
CAMLprim value win_findfirst(name)
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "unixsupport.h"
#include <windows.h>
#include <sys/types.h>
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <alloc.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "winworker.h"
#include "winlist.h"
#include "windbug.h"
#include <errno.h>
#include <string.h>
-#include <mlvalues.h>
-#include <memory.h>
-#include <signals.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
#include "unixsupport.h"
CAMLprim value unix_write(value fd, value buf, value vofs, value vlen)
open Asttypes
open Parsetree
+open Docstrings
type lid = Longident.t loc
type str = string loc
let class_type ?loc a = mk ?loc (Psig_class_type a)
let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs))
let attribute ?loc a = mk ?loc (Psig_attribute a)
+ let text txt =
+ List.map
+ (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds))
+ txt
end
module Str = struct
let include_ ?loc a = mk ?loc (Pstr_include a)
let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs))
let attribute ?loc a = mk ?loc (Pstr_attribute a)
+ let text txt =
+ List.map
+ (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds))
+ txt
end
module Cl = struct
end
module Ctf = struct
- let mk ?(loc = !default_loc) ?(attrs = []) d =
+ let mk ?(loc = !default_loc) ?(attrs = [])
+ ?(docs = empty_docs) d =
{
pctf_desc = d;
pctf_loc = loc;
- pctf_attributes = attrs;
+ pctf_attributes = add_docs_attrs docs attrs;
}
- let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]}
let inherit_ ?loc ?attrs a = mk ?loc ?attrs (Pctf_inherit a)
let val_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_val (a, b, c, d))
let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b))
let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a)
let attribute ?loc a = mk ?loc (Pctf_attribute a)
+ let text txt =
+ List.map
+ (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds))
+ txt
+
+ let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]}
+
end
module Cf = struct
- let mk ?(loc = !default_loc) ?(attrs = []) d =
+ let mk ?(loc = !default_loc) ?(attrs = [])
+ ?(docs = empty_docs) d =
{
pcf_desc = d;
pcf_loc = loc;
- pcf_attributes = attrs;
+ pcf_attributes = add_docs_attrs docs attrs;
}
- let attr d a = {d with pcf_attributes = d.pcf_attributes @ [a]}
let inherit_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_inherit (a, b, c))
let val_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_val (a, b, c))
let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a)
let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a)
let attribute ?loc a = mk ?loc (Pcf_attribute a)
+ let text txt =
+ List.map
+ (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds))
+ txt
let virtual_ ct = Cfk_virtual ct
let concrete o e = Cfk_concrete (o, e)
+
+ let attr d a = {d with pcf_attributes = d.pcf_attributes @ [a]}
+
end
module Val = struct
- let mk ?(loc = !default_loc) ?(attrs = []) ?(prim = []) name typ =
+ let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs)
+ ?(prim = []) name typ =
{
pval_name = name;
pval_type = typ;
- pval_attributes = attrs;
+ pval_attributes = add_docs_attrs docs attrs;
pval_loc = loc;
pval_prim = prim;
}
end
module Md = struct
- let mk ?(loc = !default_loc) ?(attrs = []) name typ =
+ let mk ?(loc = !default_loc) ?(attrs = [])
+ ?(docs = empty_docs) ?(text = []) name typ =
{
pmd_name = name;
pmd_type = typ;
- pmd_attributes = attrs;
+ pmd_attributes =
+ add_text_attrs text (add_docs_attrs docs attrs);
pmd_loc = loc;
}
end
module Mtd = struct
- let mk ?(loc = !default_loc) ?(attrs = []) ?typ name =
+ let mk ?(loc = !default_loc) ?(attrs = [])
+ ?(docs = empty_docs) ?(text = []) ?typ name =
{
pmtd_name = name;
pmtd_type = typ;
- pmtd_attributes = attrs;
+ pmtd_attributes =
+ add_text_attrs text (add_docs_attrs docs attrs);
pmtd_loc = loc;
}
end
module Mb = struct
- let mk ?(loc = !default_loc) ?(attrs = []) name expr =
+ let mk ?(loc = !default_loc) ?(attrs = [])
+ ?(docs = empty_docs) ?(text = []) name expr =
{
pmb_name = name;
pmb_expr = expr;
- pmb_attributes = attrs;
+ pmb_attributes =
+ add_text_attrs text (add_docs_attrs docs attrs);
pmb_loc = loc;
}
end
module Opn = struct
- let mk ?(loc = !default_loc) ?(attrs = []) ?(override = Fresh) lid =
+ let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs)
+ ?(override = Fresh) lid =
{
popen_lid = lid;
popen_override = override;
popen_loc = loc;
- popen_attributes = attrs;
+ popen_attributes = add_docs_attrs docs attrs;
}
end
module Incl = struct
- let mk ?(loc = !default_loc) ?(attrs = []) mexpr =
+ let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) mexpr =
{
pincl_mod = mexpr;
pincl_loc = loc;
- pincl_attributes = attrs;
+ pincl_attributes = add_docs_attrs docs attrs;
}
+
end
module Vb = struct
- let mk ?(loc = !default_loc) ?(attrs = []) pat expr =
+ let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs)
+ ?(text = []) pat expr =
{
pvb_pat = pat;
pvb_expr = expr;
- pvb_attributes = attrs;
+ pvb_attributes =
+ add_text_attrs text (add_docs_attrs docs attrs);
pvb_loc = loc;
}
end
module Ci = struct
- let mk ?(loc = !default_loc) ?(attrs = []) ?(virt = Concrete) ?(params = [])
- name expr =
+ let mk ?(loc = !default_loc) ?(attrs = [])
+ ?(docs = empty_docs) ?(text = [])
+ ?(virt = Concrete) ?(params = []) name expr =
{
pci_virt = virt;
pci_params = params;
pci_name = name;
pci_expr = expr;
- pci_attributes = attrs;
+ pci_attributes =
+ add_text_attrs text (add_docs_attrs docs attrs);
pci_loc = loc;
}
end
module Type = struct
let mk ?(loc = !default_loc) ?(attrs = [])
+ ?(docs = empty_docs) ?(text = [])
?(params = [])
?(cstrs = [])
?(kind = Ptype_abstract)
ptype_kind = kind;
ptype_private = priv;
ptype_manifest = manifest;
- ptype_attributes = attrs;
+ ptype_attributes =
+ add_text_attrs text (add_docs_attrs docs attrs);
ptype_loc = loc;
}
- let constructor ?(loc = !default_loc) ?(attrs = []) ?(args = []) ?res name =
+ let constructor ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info)
+ ?(args = []) ?res name =
{
pcd_name = name;
pcd_args = args;
pcd_res = res;
pcd_loc = loc;
- pcd_attributes = attrs;
+ pcd_attributes = add_info_attrs info attrs;
}
- let field ?(loc = !default_loc) ?(attrs = []) ?(mut = Immutable) name typ =
+ let field ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info)
+ ?(mut = Immutable) name typ =
{
pld_name = name;
pld_mutable = mut;
pld_type = typ;
pld_loc = loc;
- pld_attributes = attrs;
+ pld_attributes = add_info_attrs info attrs;
}
+
end
(** Type extensions *)
module Te = struct
- let mk ?(attrs = []) ?(params = []) ?(priv = Public) path constructors =
+ let mk ?(attrs = []) ?(docs = empty_docs)
+ ?(params = []) ?(priv = Public) path constructors =
{
ptyext_path = path;
ptyext_params = params;
ptyext_constructors = constructors;
ptyext_private = priv;
- ptyext_attributes = attrs;
+ ptyext_attributes = add_docs_attrs docs attrs;
}
- let constructor ?(loc = !default_loc) ?(attrs = []) name kind =
+ let constructor ?(loc = !default_loc) ?(attrs = [])
+ ?(docs = empty_docs) ?(info = empty_info) name kind =
{
pext_name = name;
pext_kind = kind;
pext_loc = loc;
- pext_attributes = attrs;
+ pext_attributes = add_docs_attrs docs (add_info_attrs info attrs);
}
- let decl ?(loc = !default_loc) ?(attrs = []) ?(args = []) ?res name =
+ let decl ?(loc = !default_loc) ?(attrs = [])
+ ?(docs = empty_docs) ?(info = empty_info) ?(args = []) ?res name =
{
pext_name = name;
pext_kind = Pext_decl(args, res);
pext_loc = loc;
- pext_attributes = attrs;
+ pext_attributes = add_docs_attrs docs (add_info_attrs info attrs);
}
- let rebind ?(loc = !default_loc) ?(attrs = []) name lid =
+ let rebind ?(loc = !default_loc) ?(attrs = [])
+ ?(docs = empty_docs) ?(info = empty_info) name lid =
{
pext_name = name;
pext_kind = Pext_rebind lid;
pext_loc = loc;
- pext_attributes = attrs;
+ pext_attributes = add_docs_attrs docs (add_info_attrs info attrs);
}
-end
+end
module Csig = struct
let mk self fields =
pcstr_fields = fields;
}
end
+
open Parsetree
open Asttypes
+open Docstrings
type lid = Longident.t loc
type str = string loc
val default_loc: loc ref
(** Default value for all optional location arguments. *)
+
val with_default_loc: loc -> (unit -> 'a) -> 'a
(** Set the [default_loc] within the scope of the execution
of the provided function. *)
(** Value declarations *)
module Val:
sig
- val mk: ?loc:loc -> ?attrs:attrs -> ?prim:string list -> str -> core_type -> value_description
+ val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs ->
+ ?prim:string list -> str -> core_type -> value_description
end
(** Type declarations *)
module Type:
sig
- val mk: ?loc:loc -> ?attrs:attrs -> ?params:(core_type * variance) list -> ?cstrs:(core_type * core_type * loc) list -> ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str -> type_declaration
-
- val constructor: ?loc:loc -> ?attrs:attrs -> ?args:core_type list -> ?res:core_type -> str -> constructor_declaration
- val field: ?loc:loc -> ?attrs:attrs -> ?mut:mutable_flag -> str -> core_type -> label_declaration
+ val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
+ ?params:(core_type * variance) list -> ?cstrs:(core_type * core_type * loc) list ->
+ ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str ->
+ type_declaration
+
+ val constructor: ?loc:loc -> ?attrs:attrs -> ?info:info ->
+ ?args:core_type list -> ?res:core_type -> str -> constructor_declaration
+ val field: ?loc:loc -> ?attrs:attrs -> ?info:info ->
+ ?mut:mutable_flag -> str -> core_type -> label_declaration
end
(** Type extensions *)
module Te:
sig
- val mk: ?attrs:attrs -> ?params:(core_type * variance) list -> ?priv:private_flag -> lid -> extension_constructor list -> type_extension
+ val mk: ?attrs:attrs -> ?docs:docs ->
+ ?params:(core_type * variance) list -> ?priv:private_flag ->
+ lid -> extension_constructor list -> type_extension
- val constructor: ?loc:loc -> ?attrs:attrs -> str -> extension_constructor_kind -> extension_constructor
+ val constructor: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info ->
+ str -> extension_constructor_kind -> extension_constructor
- val decl: ?loc:loc -> ?attrs:attrs -> ?args:core_type list -> ?res:core_type -> str -> extension_constructor
- val rebind: ?loc:loc -> ?attrs:attrs -> str -> lid -> extension_constructor
+ val decl: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info ->
+ ?args:core_type list -> ?res:core_type -> str -> extension_constructor
+ val rebind: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info ->
+ str -> lid -> extension_constructor
end
(** {2 Module language} *)
val class_type: ?loc:loc -> class_type_declaration list -> signature_item
val extension: ?loc:loc -> ?attrs:attrs -> extension -> signature_item
val attribute: ?loc:loc -> attribute -> signature_item
+ val text: text -> signature_item list
end
(** Structure items *)
val include_: ?loc:loc -> include_declaration -> structure_item
val extension: ?loc:loc -> ?attrs:attrs -> extension -> structure_item
val attribute: ?loc:loc -> attribute -> structure_item
+ val text: text -> structure_item list
end
(** Module declarations *)
module Md:
sig
- val mk: ?loc:loc -> ?attrs:attrs -> str -> module_type -> module_declaration
+ val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
+ str -> module_type -> module_declaration
end
(** Module type declarations *)
module Mtd:
sig
- val mk: ?loc:loc -> ?attrs:attrs -> ?typ:module_type -> str -> module_type_declaration
+ val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
+ ?typ:module_type -> str -> module_type_declaration
end
(** Module bindings *)
module Mb:
sig
- val mk: ?loc:loc -> ?attrs:attrs -> str -> module_expr -> module_binding
+ val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
+ str -> module_expr -> module_binding
end
(* Opens *)
module Opn:
sig
- val mk: ?loc: loc -> ?attrs:attrs -> ?override:override_flag -> lid -> open_description
+ val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs ->
+ ?override:override_flag -> lid -> open_description
end
(* Includes *)
module Incl:
sig
- val mk: ?loc: loc -> ?attrs:attrs -> 'a -> 'a include_infos
+ val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> 'a -> 'a include_infos
end
(** Value bindings *)
module Vb:
sig
- val mk: ?loc: loc -> ?attrs:attrs -> pattern -> expression -> value_binding
+ val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
+ pattern -> expression -> value_binding
end
(** Class type fields *)
module Ctf:
sig
- val mk: ?loc:loc -> ?attrs:attrs -> class_type_field_desc -> class_type_field
+ val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs ->
+ class_type_field_desc -> class_type_field
val attr: class_type_field -> attribute -> class_type_field
val inherit_: ?loc:loc -> ?attrs:attrs -> class_type -> class_type_field
val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> class_type_field
val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type_field
val attribute: ?loc:loc -> attribute -> class_type_field
+ val text: text -> class_type_field list
end
(** Class expressions *)
(** Class fields *)
module Cf:
sig
- val mk: ?loc:loc -> ?attrs:attrs -> class_field_desc -> class_field
+ val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_field_desc -> class_field
val attr: class_field -> attribute -> class_field
val inherit_: ?loc:loc -> ?attrs:attrs -> override_flag -> class_expr -> string option -> class_field
val initializer_: ?loc:loc -> ?attrs:attrs -> expression -> class_field
val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_field
val attribute: ?loc:loc -> attribute -> class_field
+ val text: text -> class_field list
val virtual_: core_type -> class_field_kind
val concrete: override_flag -> expression -> class_field_kind
+
end
(** Classes *)
module Ci:
sig
- val mk: ?loc:loc -> ?attrs:attrs -> ?virt:virtual_flag -> ?params:(core_type * variance) list -> str -> 'a -> 'a class_infos
+ val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
+ ?virt:virtual_flag -> ?params:(core_type * variance) list ->
+ str -> 'a -> 'a class_infos
end
(** Class signatures *)
let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} =
let open Cty in
let loc = sub.location sub loc in
+ let attrs = sub.attributes sub attrs in
match desc with
| Pcty_constr (lid, tys) ->
constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys)
=
let open Ctf in
let loc = sub.location sub loc in
+ let attrs = sub.attributes sub attrs in
match desc with
| Pctf_inherit ct -> inherit_ ~loc ~attrs (sub.class_type sub ct)
| Pctf_val (s, m, v, t) -> val_ ~loc ~attrs s m v (sub.typ sub t)
let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} =
let open Cl in
let loc = sub.location sub loc in
+ let attrs = sub.attributes sub attrs in
match desc with
| Pcl_constr (lid, tys) ->
constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys)
let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} =
let open Cf in
let loc = sub.location sub loc in
+ let attrs = sub.attributes sub attrs in
match desc with
| Pcf_inherit (o, ce, s) -> inherit_ ~loc ~attrs o (sub.class_expr sub ce) s
| Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k)
--- /dev/null
+(***********************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Leo White *)
+(* *)
+(* 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 Location
+
+(* Docstrings *)
+
+(* A docstring is "attached" if it has been inserted in the AST. This
+ is used for generating unexpected docstring warnings. *)
+type ds_attached =
+ | Unattached (* Not yet attached anything.*)
+ | Info (* Attached to a field or constructor. *)
+ | Docs (* Attached to an item or as floating text. *)
+
+(* A docstring is "associated" with an item if there are no blank lines between
+ them. This is used for generating docstring ambiguity warnings. *)
+type ds_associated =
+ | Zero (* Not associated with an item *)
+ | One (* Associated with one item *)
+ | Many (* Associated with multiple items (ambiguity) *)
+
+type docstring =
+ { ds_body: string;
+ ds_loc: Location.t;
+ mutable ds_attached: ds_attached;
+ mutable ds_associated: ds_associated; }
+
+(* List of docstrings *)
+
+let docstrings : docstring list ref = ref []
+
+(* Warn for unused and ambiguous docstrings *)
+
+let warn_bad_docstrings () =
+ if Warnings.is_active (Warnings.Bad_docstring true) then begin
+ List.iter
+ (fun ds ->
+ match ds.ds_attached with
+ | Info -> ()
+ | Unattached ->
+ prerr_warning ds.ds_loc (Warnings.Bad_docstring true)
+ | Docs ->
+ match ds.ds_associated with
+ | Zero | One -> ()
+ | Many ->
+ prerr_warning ds.ds_loc (Warnings.Bad_docstring false))
+ (List.rev !docstrings)
+end
+
+(* Docstring constructors and descturctors *)
+
+let docstring body loc =
+ let ds =
+ { ds_body = body;
+ ds_loc = loc;
+ ds_attached = Unattached;
+ ds_associated = Zero; }
+ in
+ docstrings := ds :: !docstrings;
+ ds
+
+let docstring_body ds = ds.ds_body
+
+let docstring_loc ds = ds.ds_loc
+
+(* Docstrings attached to items *)
+
+type docs =
+ { docs_pre: docstring option;
+ docs_post: docstring option; }
+
+let empty_docs = { docs_pre = None; docs_post = None }
+
+let doc_loc = {txt = "ocaml.doc"; loc = Location.none}
+
+let docs_attr ds =
+ let open Asttypes in
+ let open Parsetree in
+ let exp =
+ { pexp_desc = Pexp_constant (Const_string(ds.ds_body, None));
+ pexp_loc = ds.ds_loc;
+ pexp_attributes = []; }
+ in
+ let item =
+ { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc }
+ in
+ (doc_loc, PStr [item])
+
+let add_docs_attrs docs attrs =
+ let attrs =
+ match docs.docs_pre with
+ | None -> attrs
+ | Some ds -> docs_attr ds :: attrs
+ in
+ let attrs =
+ match docs.docs_post with
+ | None -> attrs
+ | Some ds -> attrs @ [docs_attr ds]
+ in
+ attrs
+
+(* Docstrings attached to consturctors or fields *)
+
+type info = docstring option
+
+let empty_info = None
+
+let info_attr = docs_attr
+
+let add_info_attrs info attrs =
+ let attrs =
+ match info with
+ | None -> attrs
+ | Some ds -> attrs @ [info_attr ds]
+ in
+ attrs
+
+(* Docstrings not attached to a specifc item *)
+
+type text = docstring list
+
+let empty_text = []
+
+let text_loc = {txt = "ocaml.text"; loc = Location.none}
+
+let text_attr ds =
+ let open Asttypes in
+ let open Parsetree in
+ let exp =
+ { pexp_desc = Pexp_constant (Const_string(ds.ds_body, None));
+ pexp_loc = ds.ds_loc;
+ pexp_attributes = []; }
+ in
+ let item =
+ { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc }
+ in
+ (text_loc, PStr [item])
+
+let add_text_attrs dsl attrs =
+ (List.map text_attr dsl) @ attrs
+
+(* Find the first non-info docstring in a list, attach it and return it *)
+let get_docstring ~info dsl =
+ let rec loop = function
+ | [] -> None
+ | {ds_attached = Info; _} :: rest -> loop rest
+ | ds :: rest ->
+ ds.ds_attached <- if info then Info else Docs;
+ Some ds
+ in
+ loop dsl
+
+(* Find all the non-info docstrings in a list, attach them and return them *)
+let get_docstrings dsl =
+ let rec loop acc = function
+ | [] -> List.rev acc
+ | {ds_attached = Info; _} :: rest -> loop acc rest
+ | ds :: rest ->
+ ds.ds_attached <- Docs;
+ loop (ds :: acc) rest
+ in
+ loop [] dsl
+
+(* "Associate" all the docstrings in a list *)
+let associate_docstrings dsl =
+ List.iter
+ (fun ds ->
+ match ds.ds_associated with
+ | Zero -> ds.ds_associated <- One
+ | (One | Many) -> ds.ds_associated <- Many)
+ dsl
+
+(* Map from positions to pre docstrings *)
+
+let pre_table : (Lexing.position, docstring list) Hashtbl.t =
+ Hashtbl.create 50
+
+let set_pre_docstrings pos dsl =
+ if dsl <> [] then Hashtbl.add pre_table pos dsl
+
+let get_pre_docs pos =
+ try
+ let dsl = Hashtbl.find pre_table pos in
+ associate_docstrings dsl;
+ get_docstring ~info:false dsl
+ with Not_found -> None
+
+let mark_pre_docs pos =
+ try
+ let dsl = Hashtbl.find pre_table pos in
+ associate_docstrings dsl
+ with Not_found -> ()
+
+(* Map from positions to post docstrings *)
+
+let post_table : (Lexing.position, docstring list) Hashtbl.t =
+ Hashtbl.create 50
+
+let set_post_docstrings pos dsl =
+ if dsl <> [] then Hashtbl.add post_table pos dsl
+
+let get_post_docs pos =
+ try
+ let dsl = Hashtbl.find post_table pos in
+ associate_docstrings dsl;
+ get_docstring ~info:false dsl
+ with Not_found -> None
+
+let mark_post_docs pos =
+ try
+ let dsl = Hashtbl.find post_table pos in
+ associate_docstrings dsl
+ with Not_found -> ()
+
+let get_info pos =
+ try
+ let dsl = Hashtbl.find post_table pos in
+ get_docstring ~info:true dsl
+ with Not_found -> None
+
+(* Map from positions to floating docstrings *)
+
+let floating_table : (Lexing.position, docstring list) Hashtbl.t =
+ Hashtbl.create 50
+
+let set_floating_docstrings pos dsl =
+ if dsl <> [] then Hashtbl.add floating_table pos dsl
+
+let get_text pos =
+ try
+ let dsl = Hashtbl.find floating_table pos in
+ get_docstrings dsl
+ with Not_found -> []
+
+(* Maps from positions to extra docstrings *)
+
+let pre_extra_table : (Lexing.position, docstring list) Hashtbl.t =
+ Hashtbl.create 50
+
+let set_pre_extra_docstrings pos dsl =
+ if dsl <> [] then Hashtbl.add pre_extra_table pos dsl
+
+let get_pre_extra_text pos =
+ try
+ let dsl = Hashtbl.find pre_extra_table pos in
+ get_docstrings dsl
+ with Not_found -> []
+
+let post_extra_table : (Lexing.position, docstring list) Hashtbl.t =
+ Hashtbl.create 50
+
+let set_post_extra_docstrings pos dsl =
+ if dsl <> [] then Hashtbl.add post_extra_table pos dsl
+
+let get_post_extra_text pos =
+ try
+ let dsl = Hashtbl.find post_extra_table pos in
+ get_docstrings dsl
+ with Not_found -> []
+
+(* Docstrings from parser actions *)
+
+let symbol_docs () =
+ { docs_pre = get_pre_docs (Parsing.symbol_start_pos ());
+ docs_post = get_post_docs (Parsing.symbol_end_pos ()); }
+
+let symbol_docs_lazy () =
+ let p1 = Parsing.symbol_start_pos () in
+ let p2 = Parsing.symbol_end_pos () in
+ lazy { docs_pre = get_pre_docs p1;
+ docs_post = get_post_docs p2; }
+
+let rhs_docs pos1 pos2 =
+ { docs_pre = get_pre_docs (Parsing.rhs_start_pos pos1);
+ docs_post = get_post_docs (Parsing.rhs_end_pos pos2); }
+
+let rhs_docs_lazy pos1 pos2 =
+ let p1 = Parsing.rhs_start_pos pos1 in
+ let p2 = Parsing.rhs_end_pos pos2 in
+ lazy { docs_pre = get_pre_docs p1;
+ docs_post = get_post_docs p2; }
+
+let mark_symbol_docs () =
+ mark_pre_docs (Parsing.symbol_start_pos ());
+ mark_post_docs (Parsing.symbol_end_pos ())
+
+let mark_rhs_docs pos1 pos2 =
+ mark_pre_docs (Parsing.rhs_start_pos pos1);
+ mark_post_docs (Parsing.rhs_end_pos pos2)
+
+let symbol_info () =
+ get_info (Parsing.symbol_end_pos ())
+
+let rhs_info pos =
+ get_info (Parsing.rhs_end_pos pos)
+
+let symbol_text () =
+ get_text (Parsing.symbol_start_pos ())
+
+let symbol_text_lazy () =
+ let pos = Parsing.symbol_start_pos () in
+ lazy (get_text pos)
+
+let rhs_text pos =
+ get_text (Parsing.rhs_start_pos pos)
+
+let rhs_text_lazy pos =
+ let pos = Parsing.rhs_start_pos pos in
+ lazy (get_text pos)
+
+let symbol_pre_extra_text () =
+ get_pre_extra_text (Parsing.symbol_start_pos ())
+
+let symbol_post_extra_text () =
+ get_post_extra_text (Parsing.symbol_end_pos ())
+
+let rhs_pre_extra_text pos =
+ get_pre_extra_text (Parsing.rhs_start_pos pos)
+
+let rhs_post_extra_text pos =
+ get_post_extra_text (Parsing.rhs_end_pos pos)
+
+
+(* (Re)Initialise all comment state *)
+
+let init () =
+ docstrings := [];
+ Hashtbl.reset pre_table;
+ Hashtbl.reset post_table;
+ Hashtbl.reset floating_table;
+ Hashtbl.reset pre_extra_table;
+ Hashtbl.reset post_extra_table
+
+
+
--- /dev/null
+(***********************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Leo White *)
+(* *)
+(* 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. *)
+(* *)
+(***********************************************************************)
+
+(** (Re)Initialise all docstring state *)
+val init : unit -> unit
+
+(** Emit warnings for unattached and ambiguous docstrings *)
+val warn_bad_docstrings : unit -> unit
+
+(** {3 Docstrings} *)
+
+(** Documentation comments *)
+type docstring
+
+(** Create a docstring *)
+val docstring : string -> Location.t -> docstring
+
+(** Get the text of a docstring *)
+val docstring_body : docstring -> string
+
+(** Get the location of a docstring *)
+val docstring_loc : docstring -> Location.t
+
+(** {3 Set functions}
+
+ These functions are used by the lexer to associate docstrings to
+ the locations of tokens. *)
+
+(** Docstrings immediately preceding a token *)
+val set_pre_docstrings : Lexing.position -> docstring list -> unit
+
+(** Docstrings immediately following a token *)
+val set_post_docstrings : Lexing.position -> docstring list -> unit
+
+(** Docstrings not immediately adjacent to a token *)
+val set_floating_docstrings : Lexing.position -> docstring list -> unit
+
+(** Docstrings immediately following the token which precedes this one *)
+val set_pre_extra_docstrings : Lexing.position -> docstring list -> unit
+
+(** Docstrings immediately preceding the token which follows this one *)
+val set_post_extra_docstrings : Lexing.position -> docstring list -> unit
+
+(** {3 Items}
+
+ The {!docs} type represents documentation attached to an item. *)
+
+type docs =
+ { docs_pre: docstring option;
+ docs_post: docstring option; }
+
+val empty_docs : docs
+
+val docs_attr : docstring -> Parsetree.attribute
+
+(** Convert item documentation to attributes and add them to an
+ attribute list *)
+val add_docs_attrs : docs -> Parsetree.attributes -> Parsetree.attributes
+
+(** Fetch the item documentation for the current symbol. This also
+ marks this documentation (for ambiguity warnings). *)
+val symbol_docs : unit -> docs
+val symbol_docs_lazy : unit -> docs Lazy.t
+
+(** Fetch the item documentation for the symbols between two
+ positions. This also marks this documentation (for ambiguity
+ warnings). *)
+val rhs_docs : int -> int -> docs
+val rhs_docs_lazy : int -> int -> docs Lazy.t
+
+(** Mark the item documentation for the current symbol (for ambiguity
+ warnings). *)
+val mark_symbol_docs : unit -> unit
+
+(** Mark as associated the item documentation for the symbols between
+ two positions (for ambiguity warnings) *)
+val mark_rhs_docs : int -> int -> unit
+
+(** {3 Fields and constructors}
+
+ The {!info} type represents documentation attached to a field or
+ constructor. *)
+
+type info = docstring option
+
+val empty_info : info
+
+val info_attr : docstring -> Parsetree.attribute
+
+(** Convert field info to attributes and add them to an
+ attribute list *)
+val add_info_attrs : info -> Parsetree.attributes -> Parsetree.attributes
+
+(** Fetch the field info for the current symbol. *)
+val symbol_info : unit -> info
+
+(** Fetch the field info following the symbol at a given position. *)
+val rhs_info : int -> info
+
+(** {3 Unattached comments}
+
+ The {!text} type represents documentation which is not attached to
+ anything. *)
+
+type text = docstring list
+
+val empty_text : text
+
+val text_attr : docstring -> Parsetree.attribute
+
+(** Convert text to attributes and add them to an attribute list *)
+val add_text_attrs : text -> Parsetree.attributes -> Parsetree.attributes
+
+(** Fetch the text preceding the current symbol. *)
+val symbol_text : unit -> text
+val symbol_text_lazy : unit -> text Lazy.t
+
+(** Fetch the text preceding the symbol at the given position. *)
+val rhs_text : int -> text
+val rhs_text_lazy : int -> text Lazy.t
+
+(** {3 Extra text}
+
+ There may be additional text attached to the delimiters of a block
+ (e.g. [struct] and [end]). This is fetched by the following
+ functions, which are applied to the contents of the block rather
+ than the delimiters. *)
+
+(** Fetch additional text preceding the current symbol *)
+val symbol_pre_extra_text : unit -> text
+
+(** Fetch additional text following the current symbol *)
+val symbol_post_extra_text : unit -> text
+
+(** Fetch additional text preceding the symbol at the given position *)
+val rhs_pre_extra_text : int -> text
+
+(** Fetch additional text following the symbol at the given position *)
+val rhs_post_extra_text : int -> text
lexing function.
When a preprocessor is configured by calling [set_preprocessor], the lexer
-changes its behavior:
-- It accepts backslash-newline as a token-separating blank.
-- It emits an EOL token for every newline except those preceeded by backslash
- and those in strings or comments.
+changes its behavior to accept backslash-newline as a token-separating blank.
*)
val set_preprocessor :
"module", MODULE;
"mutable", MUTABLE;
"new", NEW;
+ "nonrec", NONREC;
"object", OBJECT;
"of", OF;
"open", OPEN;
let in_string () = !is_in_string
let print_warnings = ref true
+let with_comment_buffer comment 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 ();
+ let loc = { start_loc with Location.loc_end = end_loc.Location.loc_end } in
+ s, loc
+
(* To translate escape sequences *)
let char_for_backslash = function
let preprocessor = ref None
+let escaped_newlines = ref false
+
(* Warn about Latin-1 characters used in idents *)
let warn_latin1 lexbuf =
(Warnings.Deprecated "ISO-Latin1 characters in identifiers")
;;
+let comment_list = ref []
+
+let add_comment com =
+ comment_list := com :: !comment_list
+
+let add_docstring_comment ds =
+ let com = (Docstrings.docstring_body ds, Docstrings.docstring_loc ds) in
+ add_comment com
+
+let comments () = List.rev !comment_list
+
(* Error report *)
open Format
rule token = parse
| "\\" newline {
- match !preprocessor with
- | None ->
+ if not !escaped_newlines then
raise (Error(Illegal_character (Lexing.lexeme_char lexbuf 0),
- Location.curr lexbuf))
- | Some _ ->
- update_loc lexbuf None 1 false 0;
- token lexbuf }
+ Location.curr lexbuf));
+ update_loc lexbuf None 1 false 0;
+ token lexbuf }
| newline
{ update_loc lexbuf None 1 false 0;
- match !preprocessor with
- | None -> token lexbuf
- | Some _ -> EOL
- }
+ EOL }
| blank +
{ token lexbuf }
| "_"
raise (Error(Illegal_escape esc, Location.curr 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 s, loc = with_comment_buffer comment lexbuf in
+ COMMENT (s, loc) }
+ | "(**"
+ { let s, loc = with_comment_buffer comment lexbuf in
+ DOCSTRING (Docstrings.docstring s loc) }
+ | "(**" ('*'+) as stars
+ { let s, loc =
+ with_comment_buffer
+ (fun lexbuf ->
+ store_string ("*" ^ stars);
+ comment lexbuf)
+ lexbuf
+ in
+ COMMENT (s, loc) }
| "(*)"
- { 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 })
- }
+ { if !print_warnings then
+ Location.prerr_warning (Location.curr lexbuf) Warnings.Comment_start;
+ let s, loc = with_comment_buffer comment lexbuf in
+ COMMENT (s, loc) }
+ | "(*" ('*'*) as stars "*)"
+ { COMMENT (stars, Location.curr lexbuf) }
| "*)"
{ let loc = Location.curr lexbuf in
Location.prerr_warning loc Warnings.Comment_not_end;
| '%' { PERCENT }
| ['*' '/' '%'] symbolchar *
{ INFIXOP3(Lexing.lexeme lexbuf) }
+ | '#' (symbolchar | '#') +
+ { SHARPOP(Lexing.lexeme lexbuf) }
| eof { EOF }
| _
{ raise (Error(Illegal_character (Lexing.lexeme_char lexbuf 0),
| None -> token lexbuf
| Some (_init, preprocess) -> preprocess token lexbuf
- 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
+ type newline_state =
+ | NoLine (* There have been no blank lines yet. *)
+ | NewLine
+ (* There have been no blank lines, and the previous
+ token was a newline. *)
+ | BlankLine (* There have been blank lines. *)
+
+ type doc_state =
+ | Initial (* There have been no docstrings yet *)
+ | After of docstring list
+ (* There have been docstrings, none of which were
+ preceeded by a blank line *)
+ | Before of docstring list * docstring list * docstring list
+ (* There have been docstrings, some of which were
+ preceeded by a blank line *)
+
+ and docstring = Docstrings.docstring
+
+ let token lexbuf =
+ let post_pos = lexeme_end_p lexbuf in
+ let attach lines docs pre_pos =
+ let open Docstrings in
+ match docs, lines with
+ | Initial, _ -> ()
+ | After a, (NoLine | NewLine) ->
+ set_post_docstrings post_pos (List.rev a);
+ set_pre_docstrings pre_pos a;
+ | After a, BlankLine ->
+ set_post_docstrings post_pos (List.rev a);
+ set_pre_extra_docstrings pre_pos (List.rev a)
+ | Before(a, f, b), (NoLine | NewLine) ->
+ set_post_docstrings post_pos (List.rev a);
+ set_post_extra_docstrings post_pos
+ (List.rev_append f (List.rev b));
+ set_floating_docstrings pre_pos (List.rev f);
+ set_pre_extra_docstrings pre_pos (List.rev a);
+ set_pre_docstrings pre_pos b
+ | Before(a, f, b), BlankLine ->
+ set_post_docstrings post_pos (List.rev a);
+ set_post_extra_docstrings post_pos
+ (List.rev_append f (List.rev b));
+ set_floating_docstrings pre_pos
+ (List.rev_append f (List.rev b));
+ set_pre_extra_docstrings pre_pos (List.rev a)
+ in
+ let rec loop lines docs lexbuf =
+ match token_with_comments lexbuf with
+ | COMMENT (s, loc) ->
+ add_comment (s, loc);
+ let lines' =
+ match lines with
+ | NoLine -> NoLine
+ | NewLine -> NoLine
+ | BlankLine -> BlankLine
+ in
+ loop lines' docs lexbuf
+ | EOL ->
+ let lines' =
+ match lines with
+ | NoLine -> NewLine
+ | NewLine -> BlankLine
+ | BlankLine -> BlankLine
+ in
+ loop lines' docs lexbuf
+ | DOCSTRING doc ->
+ add_docstring_comment doc;
+ let docs' =
+ match docs, lines with
+ | Initial, (NoLine | NewLine) -> After [doc]
+ | Initial, BlankLine -> Before([], [], [doc])
+ | After a, (NoLine | NewLine) -> After (doc :: a)
+ | After a, BlankLine -> Before (a, [], [doc])
+ | Before(a, f, b), (NoLine | NewLine) -> Before(a, f, doc :: b)
+ | Before(a, f, b), BlankLine -> Before(a, b @ f, [doc])
+ in
+ loop NoLine docs' lexbuf
+ | tok ->
+ attach lines docs (lexeme_start_p lexbuf);
+ tok
+ in
+ loop NoLine Initial lexbuf
let init () =
is_in_string := false;
- last_comments := [];
comment_start_loc := [];
+ comment_list := [];
match !preprocessor with
| None -> ()
| Some (init, _preprocess) -> init ()
let set_preprocessor init preprocess =
+ escaped_newlines := true;
preprocessor := Some (init, preprocess)
}
let num_loc_lines = ref 0 (* number of lines already printed after input *)
+let print_updating_num_loc_lines ppf f arg =
+ let open Format in
+ let out_functions = pp_get_formatter_out_functions ppf () in
+ let out_string str start len =
+ let rec count i c =
+ if i = start + len then c
+ else if String.get str i = '\n' then count (succ i) (succ c)
+ else count (succ i) c in
+ num_loc_lines := !num_loc_lines + count start 0 ;
+ out_functions.out_string str start len in
+ pp_set_formatter_out_functions ppf
+ { out_functions with out_string } ;
+ f ppf arg ;
+ pp_print_flush ppf ();
+ pp_set_formatter_out_functions ppf out_functions
+
(* Highlight the locations using standout mode. *)
let highlight_terminfo ppf num_lines lb locs =
let print_error_cur_file ppf = print_error ppf (in_file !input_name);;
-let print_warning loc ppf w =
+let default_warning_printer loc ppf w =
if Warnings.is_active w then begin
- let printw ppf w =
- let n = Warnings.print ppf w in
- num_loc_lines := !num_loc_lines + n
- in
print ppf loc;
- fprintf ppf "Warning %a@." printw w;
- pp_print_flush ppf ();
- incr num_loc_lines;
+ fprintf ppf "Warning %a@." Warnings.print w
end
;;
-let prerr_warning loc w = print_warning loc err_formatter w;;
+let warning_printer = ref default_warning_printer ;;
+
+let print_warning loc ppf w =
+ print_updating_num_loc_lines ppf (!warning_printer loc) w
+;;
+
+let formatter_for_warnings = ref err_formatter;;
+let prerr_warning loc w = print_warning loc !formatter_for_warnings w;;
let echo_eof () =
print_newline ();
in
loop !error_of_exn
-let rec report_error ppf ({loc; msg; sub; if_highlight} as err) =
+let rec default_error_reporter ppf ({loc; msg; sub; if_highlight} as err) =
let highlighted =
if if_highlight <> "" then
let rec collect_locs locs {loc; sub; if_highlight; _} =
else begin
print ppf loc;
Format.pp_print_string ppf msg;
- List.iter (fun err -> Format.fprintf ppf "@\n@[<2>%a@]" report_error err)
+ List.iter (fun err -> Format.fprintf ppf "@\n@[<2>%a@]" default_error_reporter err)
sub
end
+let error_reporter = ref default_error_reporter
+
+let report_error ppf err =
+ print_updating_num_loc_lines ppf !error_reporter err
+;;
+
let error_of_printer loc print x =
let buf = Buffer.create 64 in
let ppf = Format.formatter_of_buffer buf in
val none : t
(** An arbitrary value of type [t]; describes an empty ghost range. *)
-val in_file : string -> t;;
+
+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 print_error: formatter -> t -> unit
val print_error_cur_file: formatter -> unit
val print_warning: t -> formatter -> Warnings.t -> unit
+val formatter_for_warnings : formatter ref
val prerr_warning: t -> Warnings.t -> unit
val echo_eof: unit -> unit
val reset: unit -> unit
+val warning_printer : (t -> formatter -> Warnings.t -> unit) ref
+(** Hook for intercepting warnings. *)
+
+val default_warning_printer : t -> formatter -> Warnings.t -> unit
+(** Original warning printer for use in hooks. *)
+
val highlight_locations: formatter -> t list -> bool
type 'a loc = {
val report_error: formatter -> error -> unit
+val error_reporter : (formatter -> error -> unit) ref
+(** Hook for intercepting error reports. *)
+
+val default_error_reporter : formatter -> error -> unit
+(** Original error reporter for use in hooks. *)
+
val report_exception: formatter -> exn -> unit
(* Reraise the exception if it is unknown. *)
let wrap parsing_fun lexbuf =
try
+ Docstrings.init ();
Lexer.init ();
let ast = parsing_fun Lexer.token lexbuf in
Parsing.clear_parser();
+ Docstrings.warn_bad_docstrings ();
ast
with
| Lexer.Error(Lexer.Illegal_character _, _) as err
open Longident
open Parsetree
open Ast_helper
+open Docstrings
let mktyp d = Typ.mk ~loc:(symbol_rloc()) d
let mkpat d = Pat.mk ~loc:(symbol_rloc()) d
let mkstr d = Str.mk ~loc:(symbol_rloc()) d
let mkclass d = Cl.mk ~loc:(symbol_rloc()) d
let mkcty d = Cty.mk ~loc:(symbol_rloc()) d
-let mkctf d = Ctf.mk ~loc:(symbol_rloc()) d
-let mkcf d = Cf.mk ~loc:(symbol_rloc()) d
+let mkctf ?attrs ?docs d =
+ Ctf.mk ~loc:(symbol_rloc()) ?attrs ?docs d
+let mkcf ?attrs ?docs d =
+ Cf.mk ~loc:(symbol_rloc()) ?attrs ?docs d
let mkrhs rhs pos = mkloc rhs (rhs_loc pos)
let mkoption d =
let mkexp_attrs d attrs =
wrap_exp_attrs (mkexp d) attrs
-let mkcf_attrs d attrs =
- Cf.mk ~loc:(symbol_rloc()) ~attrs d
-
-let mkctf_attrs d attrs =
- Ctf.mk ~loc:(symbol_rloc()) ~attrs d
+let text_str pos = Str.text (rhs_text pos)
+let text_sig pos = Sig.text (rhs_text pos)
+let text_cstr pos = Cf.text (rhs_text pos)
+let text_csig pos = Ctf.text (rhs_text pos)
+let text_def pos = [Ptop_def (Str.text (rhs_text pos))]
+
+let extra_text text pos items =
+ let pre_extras = rhs_pre_extra_text pos in
+ let post_extras = rhs_post_extra_text pos in
+ text pre_extras @ items @ text post_extras
+
+let extra_str pos items = extra_text Str.text pos items
+let extra_sig pos items = extra_text Sig.text pos items
+let extra_cstr pos items = extra_text Cf.text pos items
+let extra_csig pos items = extra_text Ctf.text pos items
+let extra_def pos items =
+ extra_text (fun txt -> [Ptop_def (Str.text txt)]) pos items
+
+let add_nonrec rf attrs pos =
+ match rf with
+ | Recursive -> attrs
+ | Nonrecursive ->
+ let name = { txt = "nonrec"; loc = rhs_loc pos } in
+ (name, PStr []) :: attrs
+
+type let_binding =
+ { lb_pattern: pattern;
+ lb_expression: expression;
+ lb_attributes: attributes;
+ lb_docs: docs Lazy.t;
+ lb_text: text Lazy.t;
+ lb_loc: Location.t; }
+
+type let_bindings =
+ { lbs_bindings: let_binding list;
+ lbs_rec: rec_flag;
+ lbs_extension: string Asttypes.loc option;
+ lbs_attributes: attributes;
+ lbs_loc: Location.t }
+
+let mklb (p, e) attrs =
+ { lb_pattern = p;
+ lb_expression = e;
+ lb_attributes = attrs;
+ lb_docs = symbol_docs_lazy ();
+ lb_text = symbol_text_lazy ();
+ lb_loc = symbol_rloc (); }
+
+let mklbs (ext, attrs) rf lb =
+ { lbs_bindings = [lb];
+ lbs_rec = rf;
+ lbs_extension = ext ;
+ lbs_attributes = attrs;
+ lbs_loc = symbol_rloc (); }
+
+let addlb lbs lb =
+ { lbs with lbs_bindings = lb :: lbs.lbs_bindings }
+
+let val_of_let_bindings lbs =
+ let str =
+ match lbs.lbs_bindings with
+ | [ {lb_pattern = { ppat_desc = Ppat_any; ppat_loc = _ }; _} as lb ] ->
+ let exp = wrap_exp_attrs lb.lb_expression
+ (None, lbs.lbs_attributes) in
+ mkstr (Pstr_eval (exp, lb.lb_attributes))
+ | bindings ->
+ if lbs.lbs_attributes <> [] then
+ raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "attributes")));
+ let bindings =
+ List.map
+ (fun lb ->
+ Vb.mk ~loc:lb.lb_loc ~attrs:lb.lb_attributes
+ ~docs:(Lazy.force lb.lb_docs)
+ ~text:(Lazy.force lb.lb_text)
+ lb.lb_pattern lb.lb_expression)
+ bindings
+ in
+ mkstr(Pstr_value(lbs.lbs_rec, List.rev bindings))
+ in
+ match lbs.lbs_extension with
+ | None -> str
+ | Some id -> ghstr (Pstr_extension((id, PStr [str]), []))
+
+let expr_of_let_bindings lbs body =
+ let bindings =
+ List.map
+ (fun lb ->
+ if lb.lb_attributes <> [] then
+ raise Syntaxerr.(Error(Not_expecting(lb.lb_loc, "item attribute")));
+ Vb.mk ~loc:lb.lb_loc lb.lb_pattern lb.lb_expression)
+ lbs.lbs_bindings
+ in
+ mkexp_attrs (Pexp_let(lbs.lbs_rec, List.rev bindings, body))
+ (lbs.lbs_extension, lbs.lbs_attributes)
+
+let class_of_let_bindings lbs body =
+ let bindings =
+ List.map
+ (fun lb ->
+ if lb.lb_attributes <> [] then
+ raise Syntaxerr.(Error(Not_expecting(lb.lb_loc, "item attribute")));
+ Vb.mk ~loc:lb.lb_loc lb.lb_pattern lb.lb_expression)
+ lbs.lbs_bindings
+ in
+ if lbs.lbs_extension <> None then
+ raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "extension")));
+ if lbs.lbs_attributes <> [] then
+ raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "attributes")));
+ mkclass(Pcl_let (lbs.lbs_rec, List.rev bindings, body))
%}
%token MUTABLE
%token <nativeint> NATIVEINT
%token NEW
+%token NONREC
%token OBJECT
%token OF
%token OPEN
%token SEMI
%token SEMISEMI
%token SHARP
+%token <string> SHARPOP
%token SIG
%token STAR
%token <string * string option> STRING
%token WHILE
%token WITH
%token <string * Location.t> COMMENT
+%token <Docstrings.docstring> DOCSTRING
%token EOL
%nonassoc prec_constr_appl /* above AS BAR COLONCOLON COMMA */
%nonassoc below_SHARP
%nonassoc SHARP /* simple_expr/toplevel_directive */
+%left SHARPOP
%nonassoc below_DOT
%nonassoc DOT
/* Finally, the first tokens of simple_expr are above everything else. */
/* Entry points */
implementation:
- structure EOF { $1 }
+ structure EOF { extra_str 1 $1 }
;
interface:
- signature EOF { $1 }
+ signature EOF { extra_sig 1 $1 }
;
toplevel_phrase:
- top_structure SEMISEMI { Ptop_def $1 }
+ top_structure SEMISEMI { Ptop_def (extra_str 1 $1) }
| toplevel_directive SEMISEMI { $1 }
| EOF { raise End_of_file }
;
top_structure:
- seq_expr post_item_attributes { [mkstrexp $1 $2] }
- | top_structure_tail { $1 }
+ seq_expr post_item_attributes
+ { (text_str 1) @ [mkstrexp $1 $2] }
+ | top_structure_tail
+ { $1 }
;
top_structure_tail:
/* empty */ { [] }
- | structure_item top_structure_tail { $1 :: $2 }
+ | structure_item top_structure_tail { (text_str 1) @ $1 :: $2 }
;
use_file:
+ use_file_body { extra_def 1 $1 }
+;
+use_file_body:
use_file_tail { $1 }
| seq_expr post_item_attributes use_file_tail
- { Ptop_def[mkstrexp $1 $2] :: $3 }
+ { (text_def 1) @ Ptop_def[mkstrexp $1 $2] :: $3 }
;
use_file_tail:
- EOF { [] }
- | SEMISEMI EOF { [] }
+ EOF
+ { [] }
+ | SEMISEMI EOF
+ { text_def 1 }
| SEMISEMI seq_expr post_item_attributes use_file_tail
- { Ptop_def[mkstrexp $2 $3] :: $4 }
- | 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 }
- | toplevel_directive use_file_tail { $1 :: $2 }
+ { mark_rhs_docs 2 3;
+ (text_def 1) @ (text_def 2) @ Ptop_def[mkstrexp $2 $3] :: $4 }
+ | SEMISEMI structure_item use_file_tail
+ { (text_def 1) @ (text_def 2) @ Ptop_def[$2] :: $3 }
+ | SEMISEMI toplevel_directive use_file_tail
+ { mark_rhs_docs 2 3;
+ (text_def 1) @ (text_def 2) @ $2 :: $3 }
+ | structure_item use_file_tail
+ { (text_def 1) @ Ptop_def[$1] :: $2 }
+ | toplevel_directive use_file_tail
+ { mark_rhs_docs 1 1;
+ (text_def 1) @ $1 :: $2 }
;
parse_core_type:
core_type EOF { $1 }
mod_longident
{ mkmod(Pmod_ident (mkrhs $1 1)) }
| STRUCT structure END
- { mkmod(Pmod_structure($2)) }
+ { mkmod(Pmod_structure(extra_str 2 $2)) }
| STRUCT structure error
{ unclosed "struct" 1 "end" 3 }
| FUNCTOR functor_args MINUSGREATER module_expr
;
structure:
- seq_expr post_item_attributes structure_tail { mkstrexp $1 $2 :: $3 }
+ seq_expr post_item_attributes structure_tail
+ { mark_rhs_docs 1 2;
+ (text_str 1) @ mkstrexp $1 $2 :: $3 }
| structure_tail { $1 }
;
structure_tail:
/* empty */ { [] }
- | SEMISEMI structure { $2 }
- | structure_item structure_tail { $1 :: $2 }
+ | SEMISEMI structure { (text_str 1) @ $2 }
+ | structure_item structure_tail { (text_str 1) @ $1 :: $2 }
;
structure_item:
- LET ext_attributes rec_flag let_bindings
- {
- match $4 with
- [ {pvb_pat = { ppat_desc = Ppat_any; ppat_loc = _ };
- pvb_expr = exp; pvb_attributes = attrs}] ->
- let exp = wrap_exp_attrs exp $2 in
- mkstr(Pstr_eval (exp, attrs))
- | l ->
- let str = mkstr(Pstr_value($3, List.rev l)) in
- let (ext, attrs) = $2 in
- if attrs <> [] then not_expecting 2 "attribute";
- match ext with
- | None -> str
- | Some id -> ghstr (Pstr_extension((id, PStr [str]), []))
- }
- | EXTERNAL val_ident COLON core_type EQUAL primitive_declaration
- post_item_attributes
- { mkstr
- (Pstr_primitive (Val.mk (mkrhs $2 2) $4
- ~prim:$6 ~attrs:$7 ~loc:(symbol_rloc ()))) }
- | TYPE type_declarations
- { mkstr(Pstr_type (List.rev $2) ) }
- | TYPE str_type_extension
- { mkstr(Pstr_typext $2) }
- | EXCEPTION str_exception_declaration
- { mkstr(Pstr_exception $2) }
- | MODULE module_binding
- { mkstr(Pstr_module $2) }
- | MODULE REC module_bindings
- { mkstr(Pstr_recmodule(List.rev $3)) }
- | MODULE TYPE ident post_item_attributes
- { mkstr(Pstr_modtype (Mtd.mk (mkrhs $3 3)
- ~attrs:$4 ~loc:(symbol_rloc()))) }
- | MODULE TYPE ident EQUAL module_type post_item_attributes
- { mkstr(Pstr_modtype (Mtd.mk (mkrhs $3 3)
- ~typ:$5 ~attrs:$6 ~loc:(symbol_rloc()))) }
+ let_bindings
+ { val_of_let_bindings $1 }
+ | primitive_declaration
+ { mkstr (Pstr_primitive $1) }
+ | type_declarations
+ { mkstr(Pstr_type (List.rev $1)) }
+ | str_type_extension
+ { mkstr(Pstr_typext $1) }
+ | str_exception_declaration
+ { mkstr(Pstr_exception $1) }
+ | module_binding
+ { mkstr(Pstr_module $1) }
+ | rec_module_bindings
+ { mkstr(Pstr_recmodule(List.rev $1)) }
+ | module_type_declaration
+ { mkstr(Pstr_modtype $1) }
| open_statement { mkstr(Pstr_open $1) }
- | CLASS class_declarations
- { mkstr(Pstr_class (List.rev $2)) }
- | CLASS TYPE class_type_declarations
- { mkstr(Pstr_class_type (List.rev $3)) }
- | INCLUDE module_expr post_item_attributes
- { mkstr(Pstr_include (Incl.mk $2 ~attrs:$3 ~loc:(symbol_rloc()))) }
+ | class_declarations
+ { mkstr(Pstr_class (List.rev $1)) }
+ | class_type_declarations
+ { mkstr(Pstr_class_type (List.rev $1)) }
+ | str_include_statement
+ { mkstr(Pstr_include $1) }
| item_extension post_item_attributes
- { mkstr(Pstr_extension ($1, $2)) }
+ { mkstr(Pstr_extension ($1, (add_docs_attrs (symbol_docs ()) $2))) }
| floating_attribute
- { mkstr(Pstr_attribute $1) }
+ { mark_symbol_docs ();
+ mkstr(Pstr_attribute $1) }
+;
+str_include_statement:
+ INCLUDE module_expr post_item_attributes
+ { Incl.mk $2 ~attrs:$3
+ ~loc:(symbol_rloc()) ~docs:(symbol_docs ()) }
;
module_binding_body:
EQUAL module_expr
| functor_arg module_binding_body
{ mkmod(Pmod_functor(fst $1, snd $1, $2)) }
;
-module_bindings:
- module_binding { [$1] }
- | module_bindings AND module_binding { $3 :: $1 }
-;
module_binding:
- UIDENT module_binding_body post_item_attributes
- { Mb.mk (mkrhs $1 1) $2 ~attrs:$3 ~loc:(symbol_rloc ()) }
+ MODULE UIDENT module_binding_body post_item_attributes
+ { Mb.mk (mkrhs $2 2) $3 ~attrs:$4
+ ~loc:(symbol_rloc ()) ~docs:(symbol_docs ()) }
+;
+rec_module_bindings:
+ rec_module_binding { [$1] }
+ | rec_module_bindings and_module_binding { $2 :: $1 }
+;
+rec_module_binding:
+ MODULE REC UIDENT module_binding_body post_item_attributes
+ { Mb.mk (mkrhs $3 3) $4 ~attrs:$5
+ ~loc:(symbol_rloc ()) ~docs:(symbol_docs ()) }
+;
+and_module_binding:
+ AND UIDENT module_binding_body post_item_attributes
+ { Mb.mk (mkrhs $2 2) $3 ~attrs:$4 ~loc:(symbol_rloc ())
+ ~text:(symbol_text ()) ~docs:(symbol_docs ()) }
;
/* Module types */
mty_longident
{ mkmty(Pmty_ident (mkrhs $1 1)) }
| SIG signature END
- { mkmty(Pmty_signature $2) }
+ { mkmty(Pmty_signature (extra_sig 2 $2)) }
| SIG signature error
{ unclosed "sig" 1 "end" 3 }
| FUNCTOR functor_args MINUSGREATER module_type
;
signature:
/* empty */ { [] }
- | SEMISEMI signature { $2 }
- | signature_item signature { $1 :: $2 }
+ | SEMISEMI signature { (text_sig 1) @ $2 }
+ | signature_item signature { (text_sig 1) @ $1 :: $2 }
;
signature_item:
- VAL val_ident COLON core_type post_item_attributes
- { mksig(Psig_value
- (Val.mk (mkrhs $2 2) $4 ~attrs:$5 ~loc:(symbol_rloc()))) }
- | EXTERNAL val_ident COLON core_type EQUAL primitive_declaration
- post_item_attributes
- { mksig(Psig_value
- (Val.mk (mkrhs $2 2) $4 ~prim:$6 ~attrs:$7
- ~loc:(symbol_rloc()))) }
- | TYPE type_declarations
- { mksig(Psig_type (List.rev $2)) }
- | TYPE sig_type_extension
- { mksig(Psig_typext $2) }
- | EXCEPTION sig_exception_declaration
- { mksig(Psig_exception $2) }
- | MODULE UIDENT module_declaration post_item_attributes
- { mksig(Psig_module (Md.mk (mkrhs $2 2)
- $3 ~attrs:$4 ~loc:(symbol_rloc()))) }
- | MODULE UIDENT EQUAL mod_longident post_item_attributes
- { mksig(Psig_module (Md.mk (mkrhs $2 2)
- (Mty.alias ~loc:(rhs_loc 4) (mkrhs $4 4))
- ~attrs:$5
- ~loc:(symbol_rloc())
- )) }
- | MODULE REC module_rec_declarations
- { mksig(Psig_recmodule (List.rev $3)) }
- | MODULE TYPE ident post_item_attributes
- { mksig(Psig_modtype (Mtd.mk (mkrhs $3 3)
- ~attrs:$4 ~loc:(symbol_rloc()))) }
- | MODULE TYPE ident EQUAL module_type post_item_attributes
- { mksig(Psig_modtype (Mtd.mk (mkrhs $3 3) ~typ:$5
- ~loc:(symbol_rloc())
- ~attrs:$6)) }
+ value_description
+ { mksig(Psig_value $1) }
+ | primitive_declaration
+ { mksig(Psig_value $1) }
+ | type_declarations
+ { mksig(Psig_type (List.rev $1)) }
+ | sig_type_extension
+ { mksig(Psig_typext $1) }
+ | sig_exception_declaration
+ { mksig(Psig_exception $1) }
+ | module_declaration
+ { mksig(Psig_module $1) }
+ | module_alias
+ { mksig(Psig_module $1) }
+ | rec_module_declarations
+ { mksig(Psig_recmodule (List.rev $1)) }
+ | module_type_declaration
+ { mksig(Psig_modtype $1) }
| open_statement
{ mksig(Psig_open $1) }
- | INCLUDE module_type post_item_attributes %prec below_WITH
- { mksig(Psig_include (Incl.mk $2 ~attrs:$3 ~loc:(symbol_rloc()))) }
- | CLASS class_descriptions
- { mksig(Psig_class (List.rev $2)) }
- | CLASS TYPE class_type_declarations
- { mksig(Psig_class_type (List.rev $3)) }
+ | sig_include_statement
+ { mksig(Psig_include $1) }
+ | class_descriptions
+ { mksig(Psig_class (List.rev $1)) }
+ | class_type_declarations
+ { mksig(Psig_class_type (List.rev $1)) }
| item_extension post_item_attributes
- { mksig(Psig_extension ($1, $2)) }
+ { mksig(Psig_extension ($1, (add_docs_attrs (symbol_docs ()) $2))) }
| floating_attribute
- { mksig(Psig_attribute $1) }
+ { mark_symbol_docs ();
+ mksig(Psig_attribute $1) }
;
open_statement:
| OPEN override_flag mod_longident post_item_attributes
- { Opn.mk (mkrhs $3 3) ~override:$2 ~attrs:$4 ~loc:(symbol_rloc()) }
+ { Opn.mk (mkrhs $3 3) ~override:$2 ~attrs:$4
+ ~loc:(symbol_rloc()) ~docs:(symbol_docs ()) }
;
-module_declaration:
+sig_include_statement:
+ INCLUDE module_type post_item_attributes %prec below_WITH
+ { Incl.mk $2 ~attrs:$3
+ ~loc:(symbol_rloc()) ~docs:(symbol_docs ()) }
+;
+module_declaration_body:
COLON module_type
{ $2 }
- | LPAREN UIDENT COLON module_type RPAREN module_declaration
+ | LPAREN UIDENT COLON module_type RPAREN module_declaration_body
{ mkmty(Pmty_functor(mkrhs $2 2, Some $4, $6)) }
- | LPAREN RPAREN module_declaration
+ | LPAREN RPAREN module_declaration_body
{ mkmty(Pmty_functor(mkrhs "*" 1, None, $3)) }
;
-module_rec_declarations:
- module_rec_declaration { [$1] }
- | module_rec_declarations AND module_rec_declaration { $3 :: $1 }
-;
-module_rec_declaration:
- UIDENT COLON module_type post_item_attributes
- { Md.mk (mkrhs $1 1) $3 ~attrs:$4 ~loc:(symbol_rloc()) }
+module_declaration:
+ MODULE UIDENT module_declaration_body post_item_attributes
+ { Md.mk (mkrhs $2 2) $3 ~attrs:$4
+ ~loc:(symbol_rloc()) ~docs:(symbol_docs ()) }
+;
+module_alias:
+ MODULE UIDENT EQUAL mod_longident post_item_attributes
+ { Md.mk (mkrhs $2 2)
+ (Mty.alias ~loc:(rhs_loc 4) (mkrhs $4 4)) ~attrs:$5
+ ~loc:(symbol_rloc()) ~docs:(symbol_docs ()) }
+;
+rec_module_declarations:
+ rec_module_declaration { [$1] }
+ | rec_module_declarations and_module_declaration { $2 :: $1 }
+;
+rec_module_declaration:
+ MODULE REC UIDENT COLON module_type post_item_attributes
+ { Md.mk (mkrhs $3 3) $5 ~attrs:$6
+ ~loc:(symbol_rloc()) ~docs:(symbol_docs ()) }
+;
+and_module_declaration:
+ AND UIDENT COLON module_type post_item_attributes
+ { Md.mk (mkrhs $2 2) $4 ~attrs:$5 ~loc:(symbol_rloc())
+ ~text:(symbol_text()) ~docs:(symbol_docs()) }
+;
+module_type_declaration_body:
+ /* empty */ { None }
+ | EQUAL module_type { Some $2 }
+;
+module_type_declaration:
+ MODULE TYPE ident module_type_declaration_body post_item_attributes
+ { Mtd.mk (mkrhs $3 3) ?typ:$4 ~attrs:$5
+ ~loc:(symbol_rloc()) ~docs:(symbol_docs ()) }
;
-
/* Class expressions */
class_declarations:
- class_declarations AND class_declaration { $3 :: $1 }
- | class_declaration { [$1] }
+ class_declaration { [$1] }
+ | class_declarations and_class_declaration { $2 :: $1 }
;
class_declaration:
- virtual_flag class_type_parameters LIDENT class_fun_binding
+ CLASS virtual_flag class_type_parameters LIDENT class_fun_binding
post_item_attributes
- {
- Ci.mk (mkrhs $3 3) $4
- ~virt:$1 ~params:$2
- ~attrs:$5 ~loc:(symbol_rloc ())
- }
+ { Ci.mk (mkrhs $4 4) $5 ~virt:$2 ~params:$3 ~attrs:$6
+ ~loc:(symbol_rloc ()) ~docs:(symbol_docs ()) }
+;
+and_class_declaration:
+ AND virtual_flag class_type_parameters LIDENT class_fun_binding
+ post_item_attributes
+ { Ci.mk (mkrhs $4 4) $5 ~virt:$2 ~params:$3
+ ~attrs:$6 ~loc:(symbol_rloc ())
+ ~text:(symbol_text ()) ~docs:(symbol_docs ()) }
;
class_fun_binding:
EQUAL class_expr
{ $2 }
| class_simple_expr simple_labeled_expr_list
{ mkclass(Pcl_apply($1, List.rev $2)) }
- | LET rec_flag let_bindings_no_attrs IN class_expr
- { mkclass(Pcl_let ($2, List.rev $3, $5)) }
+ | let_bindings IN class_expr
+ { class_of_let_bindings $1 $3 }
| class_expr attribute
{ Cl.attr $1 $2 }
| extension
| class_longident
{ mkclass(Pcl_constr(mkrhs $1 1, [])) }
| OBJECT class_structure END
- { mkclass(Pcl_structure($2)) }
+ { mkclass(Pcl_structure $2) }
| OBJECT class_structure error
{ unclosed "object" 1 "end" 3 }
| LPAREN class_expr COLON class_type RPAREN
{ unclosed "(" 1 ")" 3 }
;
class_structure:
- class_self_pattern class_fields
- { Cstr.mk $1 (List.rev $2) }
+ | class_self_pattern class_fields
+ { Cstr.mk $1 (extra_cstr 2 (List.rev $2)) }
;
class_self_pattern:
LPAREN pattern RPAREN
/* empty */
{ [] }
| class_fields class_field
- { $2 :: $1 }
+ { $2 :: (text_cstr 2) @ $1 }
;
class_field:
| INHERIT override_flag class_expr parent_binder post_item_attributes
- { mkcf_attrs (Pcf_inherit ($2, $3, $4)) $5 }
+ { mkcf (Pcf_inherit ($2, $3, $4)) ~attrs:$5 ~docs:(symbol_docs ()) }
| VAL value post_item_attributes
- { mkcf_attrs (Pcf_val $2) $3 }
+ { mkcf (Pcf_val $2) ~attrs:$3 ~docs:(symbol_docs ()) }
| METHOD method_ post_item_attributes
- { mkcf_attrs (Pcf_method $2) $3 }
+ { mkcf (Pcf_method $2) ~attrs:$3 ~docs:(symbol_docs ()) }
| CONSTRAINT constrain_field post_item_attributes
- { mkcf_attrs (Pcf_constraint $2) $3 }
+ { mkcf (Pcf_constraint $2) ~attrs:$3 ~docs:(symbol_docs ()) }
| INITIALIZER seq_expr post_item_attributes
- { mkcf_attrs (Pcf_initializer $2) $3 }
+ { mkcf (Pcf_initializer $2) ~attrs:$3 ~docs:(symbol_docs ()) }
| item_extension post_item_attributes
- { mkcf_attrs (Pcf_extension $1) $2 }
+ { mkcf (Pcf_extension $1) ~attrs:$2 ~docs:(symbol_docs ()) }
| floating_attribute
- { mkcf (Pcf_attribute $1) }
+ { mark_symbol_docs ();
+ mkcf (Pcf_attribute $1) }
;
parent_binder:
AS LIDENT
;
class_sig_body:
class_self_type class_sig_fields
- { Csig.mk $1 (List.rev $2) }
+ { Csig.mk $1 (extra_csig 2 (List.rev $2)) }
;
class_self_type:
LPAREN core_type RPAREN
;
class_sig_fields:
/* empty */ { [] }
-| class_sig_fields class_sig_field { $2 :: $1 }
+| class_sig_fields class_sig_field { $2 :: (text_csig 2) @ $1 }
;
class_sig_field:
INHERIT class_signature post_item_attributes
- { mkctf_attrs (Pctf_inherit $2) $3 }
+ { mkctf (Pctf_inherit $2) ~attrs:$3 ~docs:(symbol_docs ()) }
| VAL value_type post_item_attributes
- { mkctf_attrs (Pctf_val $2) $3 }
+ { mkctf (Pctf_val $2) ~attrs:$3 ~docs:(symbol_docs ()) }
| METHOD private_virtual_flags label COLON poly_type post_item_attributes
{
let (p, v) = $2 in
- mkctf_attrs (Pctf_method ($3, p, v, $5)) $6
+ mkctf (Pctf_method ($3, p, v, $5)) ~attrs:$6 ~docs:(symbol_docs ())
}
| CONSTRAINT constrain_field post_item_attributes
- { mkctf_attrs (Pctf_constraint $2) $3 }
+ { mkctf (Pctf_constraint $2) ~attrs:$3 ~docs:(symbol_docs ()) }
| item_extension post_item_attributes
- { mkctf_attrs (Pctf_extension $1) $2 }
+ { mkctf (Pctf_extension $1) ~attrs:$2 ~docs:(symbol_docs ()) }
| floating_attribute
- { mkctf(Pctf_attribute $1) }
+ { mark_symbol_docs ();
+ mkctf(Pctf_attribute $1) }
;
value_type:
VIRTUAL mutable_flag label COLON core_type
core_type EQUAL core_type { $1, $3 }
;
class_descriptions:
- class_descriptions AND class_description { $3 :: $1 }
- | class_description { [$1] }
+ class_description { [$1] }
+ | class_descriptions and_class_description { $2 :: $1 }
;
class_description:
- virtual_flag class_type_parameters LIDENT COLON class_type
+ CLASS virtual_flag class_type_parameters LIDENT COLON class_type
post_item_attributes
- {
- Ci.mk (mkrhs $3 3) $5
- ~virt:$1 ~params:$2
- ~attrs:$6 ~loc:(symbol_rloc ())
- }
+ { Ci.mk (mkrhs $4 4) $6 ~virt:$2 ~params:$3 ~attrs:$7
+ ~loc:(symbol_rloc ()) ~docs:(symbol_docs ()) }
+;
+and_class_description:
+ AND virtual_flag class_type_parameters LIDENT COLON class_type
+ post_item_attributes
+ { Ci.mk (mkrhs $4 4) $6 ~virt:$2 ~params:$3
+ ~attrs:$7 ~loc:(symbol_rloc ())
+ ~text:(symbol_text ()) ~docs:(symbol_docs ()) }
;
class_type_declarations:
- class_type_declarations AND class_type_declaration { $3 :: $1 }
- | class_type_declaration { [$1] }
+ class_type_declaration { [$1] }
+ | class_type_declarations and_class_type_declaration { $2 :: $1 }
;
class_type_declaration:
- virtual_flag class_type_parameters LIDENT EQUAL class_signature
- post_item_attributes
- {
- Ci.mk (mkrhs $3 3) $5
- ~virt:$1 ~params:$2
- ~attrs:$6 ~loc:(symbol_rloc ())
- }
+ CLASS TYPE virtual_flag class_type_parameters LIDENT EQUAL
+ class_signature post_item_attributes
+ { Ci.mk (mkrhs $5 5) $7 ~virt:$3 ~params:$4 ~attrs:$8
+ ~loc:(symbol_rloc ()) ~docs:(symbol_docs ()) }
+;
+and_class_type_declaration:
+ AND virtual_flag class_type_parameters LIDENT EQUAL
+ class_signature post_item_attributes
+ { Ci.mk (mkrhs $4 4) $6 ~virt:$2 ~params:$3
+ ~attrs:$7 ~loc:(symbol_rloc ())
+ ~text:(symbol_text ()) ~docs:(symbol_docs ()) }
;
/* Core expressions */
{ $1 }
| simple_expr simple_labeled_expr_list
{ mkexp(Pexp_apply($1, List.rev $2)) }
- | LET ext_attributes rec_flag let_bindings_no_attrs IN seq_expr
- { mkexp_attrs (Pexp_let($3, List.rev $4, $6)) $2 }
+ | let_bindings IN seq_expr
+ { expr_of_let_bindings $1 $3 }
| LET MODULE ext_attributes UIDENT module_binding_body IN seq_expr
{ mkexp_attrs (Pexp_letmodule(mkrhs $4 4, $5, $7)) $3 }
| LET OPEN override_flag ext_attributes mod_longident IN seq_expr
{ unclosed "{<" 3 ">}" 6 }
| simple_expr SHARP label
{ mkexp(Pexp_send($1, $3)) }
+ | simple_expr SHARPOP simple_expr
+ { mkinfix $1 $2 $3 }
| LPAREN MODULE module_expr RPAREN
{ mkexp (Pexp_pack $3) }
| LPAREN MODULE module_expr COLON package_type RPAREN
label_ident:
LIDENT { ($1, mkexp(Pexp_ident(mkrhs (Lident $1) 1))) }
;
-let_bindings:
- let_binding { [$1] }
- | let_bindings AND let_binding { $3 :: $1 }
-;
-let_bindings_no_attrs:
- let_bindings {
- let l = $1 in
- List.iter
- (fun vb ->
- if vb.pvb_attributes <> [] then
- raise Syntaxerr.(Error(Not_expecting(vb.pvb_loc,"item attribute")))
- )
- l;
- l
- }
-
lident_list:
LIDENT { [$1] }
| LIDENT lident_list { $1 :: $2 }
;
-let_binding:
- let_binding_ post_item_attributes {
- let (p, e) = $1 in Vb.mk ~loc:(symbol_rloc()) ~attrs:$2 p e
- }
-;
-let_binding_:
+let_binding_body:
val_ident fun_binding
{ (mkpatvar $1 1, $2) }
| val_ident COLON typevar_list DOT core_type EQUAL seq_expr
| simple_pattern_not_ident COLON core_type EQUAL seq_expr
{ (ghpat(Ppat_constraint($1, $3)), $5) }
;
+let_bindings:
+ let_binding { $1 }
+ | let_bindings and_let_binding { addlb $1 $2 }
+;
+let_binding:
+ LET ext_attributes rec_flag let_binding_body post_item_attributes
+ { mklbs $2 $3 (mklb $4 $5) }
+;
+and_let_binding:
+ AND let_binding_body post_item_attributes
+ { mklb $2 $3 }
+;
fun_binding:
strict_binding
{ $1 }
{ (mkrhs $1 1, pat_of_label $1 1) }
;
+/* Value descriptions */
+
+value_description:
+ VAL val_ident COLON core_type post_item_attributes
+ { Val.mk (mkrhs $2 2) $4 ~attrs:$5
+ ~loc:(symbol_rloc()) ~docs:(symbol_docs ()) }
+;
+
/* Primitive declarations */
-primitive_declaration:
+primitive_declaration_body:
STRING { [fst $1] }
- | STRING primitive_declaration { fst $1 :: $2 }
+ | STRING primitive_declaration_body { fst $1 :: $2 }
+;
+primitive_declaration:
+ EXTERNAL val_ident COLON core_type EQUAL primitive_declaration_body
+ post_item_attributes
+ { Val.mk (mkrhs $2 2) $4 ~prim:$6 ~attrs:$7
+ ~loc:(symbol_rloc ()) ~docs:(symbol_docs ()) }
;
/* Type declarations */
type_declarations:
type_declaration { [$1] }
- | type_declarations AND type_declaration { $3 :: $1 }
+ | type_declarations and_type_declaration { $2 :: $1 }
;
type_declaration:
- optional_type_parameters LIDENT type_kind constraints post_item_attributes
- { let (kind, priv, manifest) = $3 in
- Type.mk (mkrhs $2 2)
- ~params:$1 ~cstrs:(List.rev $4)
- ~kind ~priv ?manifest ~attrs:$5 ~loc:(symbol_rloc())
- }
+ TYPE nonrec_flag optional_type_parameters LIDENT type_kind constraints
+ post_item_attributes
+ { let (kind, priv, manifest) = $5 in
+ Type.mk (mkrhs $4 4) ~params:$3 ~cstrs:(List.rev $6) ~kind
+ ~priv ?manifest ~attrs:(add_nonrec $2 $7 2)
+ ~loc:(symbol_rloc ()) ~docs:(symbol_docs ()) }
+;
+and_type_declaration:
+ AND optional_type_parameters LIDENT type_kind constraints
+ post_item_attributes
+ { let (kind, priv, manifest) = $4 in
+ Type.mk (mkrhs $3 3) ~params:$2 ~cstrs:(List.rev $5)
+ ~kind ~priv ?manifest ~attrs:$6 ~loc:(symbol_rloc ())
+ ~text:(symbol_text ()) ~docs:(symbol_docs ()) }
;
constraints:
constraints CONSTRAINT constrain { $3 :: $1 }
{ (Ptype_variant(List.rev $2), Public, None) }
| EQUAL PRIVATE constructor_declarations
{ (Ptype_variant(List.rev $3), Private, None) }
- | EQUAL private_flag BAR constructor_declarations
- { (Ptype_variant(List.rev $4), $2, None) }
| EQUAL DOTDOT
{ (Ptype_open, Public, None) }
- | EQUAL private_flag LBRACE label_declarations opt_semi RBRACE
- { (Ptype_record(List.rev $4), $2, None) }
- | EQUAL core_type EQUAL private_flag opt_bar constructor_declarations
- { (Ptype_variant(List.rev $6), $4, Some $2) }
+ | EQUAL private_flag LBRACE label_declarations RBRACE
+ { (Ptype_record $4, $2, None) }
+ | EQUAL core_type EQUAL private_flag constructor_declarations
+ { (Ptype_variant(List.rev $5), $4, Some $2) }
| EQUAL core_type EQUAL DOTDOT
{ (Ptype_open, Public, Some $2) }
- | EQUAL core_type EQUAL private_flag LBRACE label_declarations opt_semi RBRACE
- { (Ptype_record(List.rev $6), $4, Some $2) }
+ | EQUAL core_type EQUAL private_flag LBRACE label_declarations RBRACE
+ { (Ptype_record $6, $4, Some $2) }
;
optional_type_parameters:
/*empty*/ { [] }
| type_parameter_list COMMA type_parameter { $3 :: $1 }
;
constructor_declarations:
- constructor_declaration { [$1] }
- | constructor_declarations BAR constructor_declaration { $3 :: $1 }
+ constructor_declaration { [$1] }
+ | bar_constructor_declaration { [$1] }
+ | constructor_declarations bar_constructor_declaration { $2 :: $1 }
;
constructor_declaration:
- | constr_ident attributes generalized_constructor_arguments
+ | constr_ident generalized_constructor_arguments attributes
{
- let args,res = $3 in
- Type.constructor (mkrhs $1 1) ~args ?res ~loc:(symbol_rloc()) ~attrs:$2
+ let args,res = $2 in
+ Type.constructor (mkrhs $1 1) ~args ?res ~attrs:$3
+ ~loc:(symbol_rloc()) ~info:(symbol_info ())
}
;
-str_exception_declaration:
- | extension_constructor_declaration post_item_attributes
+bar_constructor_declaration:
+ | BAR constr_ident generalized_constructor_arguments attributes
{
- let ext = $1 in
- {ext with pext_attributes = ext.pext_attributes @ $2}
- }
- | extension_constructor_rebind post_item_attributes
- {
- let ext = $1 in
- {ext with pext_attributes = ext.pext_attributes @ $2}
+ let args,res = $3 in
+ Type.constructor (mkrhs $2 2) ~args ?res ~attrs:$4
+ ~loc:(symbol_rloc()) ~info:(symbol_info ())
}
;
+str_exception_declaration:
+ | sig_exception_declaration { $1 }
+ | EXCEPTION constr_ident EQUAL constr_longident attributes
+ post_item_attributes
+ { Te.rebind (mkrhs $2 2) (mkrhs $4 4) ~attrs:($5 @ $6)
+ ~loc:(symbol_rloc()) ~docs:(symbol_docs ()) }
+;
sig_exception_declaration:
- | extension_constructor_declaration post_item_attributes
- {
- let ext = $1 in
- {ext with pext_attributes = ext.pext_attributes @ $2}
- }
+ | EXCEPTION constr_ident generalized_constructor_arguments attributes
+ post_item_attributes
+ { let args, res = $3 in
+ Te.decl (mkrhs $2 2) ~args ?res ~attrs:($4 @ $5)
+ ~loc:(symbol_rloc()) ~docs:(symbol_docs ()) }
;
generalized_constructor_arguments:
/*empty*/ { ([],None) }
- | OF core_type_list { (List.rev $2,None) }
- | COLON core_type_list MINUSGREATER simple_core_type
+ | OF core_type_list_no_attr { (List.rev $2,None) }
+ | COLON core_type_list_no_attr MINUSGREATER simple_core_type_no_attr
{ (List.rev $2,Some $4) }
- | COLON simple_core_type
+ | COLON simple_core_type_no_attr
{ ([],Some $2) }
;
label_declarations:
label_declaration { [$1] }
- | label_declarations SEMI label_declaration { $3 :: $1 }
+ | label_declaration_semi { [$1] }
+ | label_declaration_semi label_declarations { $1 :: $2 }
;
label_declaration:
- mutable_flag label attributes COLON poly_type
+ mutable_flag label COLON poly_type_no_attr attributes
{
- Type.field (mkrhs $2 2) $5 ~mut:$1 ~attrs:$3 ~loc:(symbol_rloc())
+ Type.field (mkrhs $2 2) $4 ~mut:$1 ~attrs:$5
+ ~loc:(symbol_rloc()) ~info:(symbol_info ())
+ }
+;
+label_declaration_semi:
+ mutable_flag label COLON poly_type_no_attr attributes SEMI attributes
+ {
+ let info =
+ match rhs_info 5 with
+ | Some _ as info_before_semi -> info_before_semi
+ | None -> symbol_info ()
+ in
+ Type.field (mkrhs $2 2) $4 ~mut:$1 ~attrs:($5 @ $7)
+ ~loc:(symbol_rloc()) ~info
}
;
/* Type Extensions */
str_type_extension:
- optional_type_parameters type_longident
- PLUSEQ private_flag opt_bar str_extension_constructors post_item_attributes
- { Te.mk (mkrhs $2 2) (List.rev $6)
- ~params:$1 ~priv:$4 ~attrs:$7 }
+ TYPE nonrec_flag optional_type_parameters type_longident
+ PLUSEQ private_flag str_extension_constructors post_item_attributes
+ { if $2 <> Recursive then not_expecting 2 "nonrec flag";
+ Te.mk (mkrhs $4 4) (List.rev $7) ~params:$3 ~priv:$6
+ ~attrs:$8 ~docs:(symbol_docs ()) }
;
sig_type_extension:
- optional_type_parameters type_longident
- PLUSEQ private_flag opt_bar sig_extension_constructors post_item_attributes
- { Te.mk (mkrhs $2 2) (List.rev $6)
- ~params:$1 ~priv:$4 ~attrs:$7 }
+ TYPE nonrec_flag optional_type_parameters type_longident
+ PLUSEQ private_flag sig_extension_constructors post_item_attributes
+ { if $2 <> Recursive then not_expecting 2 "nonrec flag";
+ Te.mk (mkrhs $4 4) (List.rev $7) ~params:$3 ~priv:$6
+ ~attrs:$8 ~docs:(symbol_docs ()) }
;
str_extension_constructors:
extension_constructor_declaration { [$1] }
+ | bar_extension_constructor_declaration { [$1] }
| extension_constructor_rebind { [$1] }
- | str_extension_constructors BAR extension_constructor_declaration
- { $3 :: $1 }
- | str_extension_constructors BAR extension_constructor_rebind
- { $3 :: $1 }
+ | bar_extension_constructor_rebind { [$1] }
+ | str_extension_constructors bar_extension_constructor_declaration
+ { $2 :: $1 }
+ | str_extension_constructors bar_extension_constructor_rebind
+ { $2 :: $1 }
;
sig_extension_constructors:
extension_constructor_declaration { [$1] }
- | sig_extension_constructors BAR extension_constructor_declaration
- { $3 :: $1 }
+ | bar_extension_constructor_declaration { [$1] }
+ | sig_extension_constructors bar_extension_constructor_declaration
+ { $2 :: $1 }
;
extension_constructor_declaration:
- | constr_ident attributes generalized_constructor_arguments
+ | constr_ident generalized_constructor_arguments attributes
+ { let args, res = $2 in
+ Te.decl (mkrhs $1 1) ~args ?res ~attrs:$3
+ ~loc:(symbol_rloc()) ~info:(symbol_info ()) }
+;
+bar_extension_constructor_declaration:
+ | BAR constr_ident generalized_constructor_arguments attributes
{ let args, res = $3 in
- Te.decl (mkrhs $1 1) ~args ?res ~loc:(symbol_rloc()) ~attrs:$2 }
+ Te.decl (mkrhs $2 2) ~args ?res ~attrs:$4
+ ~loc:(symbol_rloc()) ~info:(symbol_info ()) }
;
extension_constructor_rebind:
- | constr_ident attributes EQUAL constr_longident
- { Te.rebind (mkrhs $1 1) (mkrhs $4 4) ~loc:(symbol_rloc()) ~attrs:$2 }
+ | constr_ident EQUAL constr_longident attributes
+ { Te.rebind (mkrhs $1 1) (mkrhs $3 3) ~attrs:$4
+ ~loc:(symbol_rloc()) ~info:(symbol_info ()) }
+;
+bar_extension_constructor_rebind:
+ | BAR constr_ident EQUAL constr_longident attributes
+ { Te.rebind (mkrhs $2 2) (mkrhs $4 4) ~attrs:$5
+ ~loc:(symbol_rloc()) ~info:(symbol_info ()) }
;
/* "with" constraints (additional type equations over signature components) */
| with_constraints AND with_constraint { $3 :: $1 }
;
with_constraint:
- TYPE type_parameters label_longident with_type_binder core_type constraints
+ TYPE type_parameters label_longident with_type_binder core_type_no_attr constraints
{ Pwith_type
(mkrhs $3 3,
(Type.mk (mkrhs (Longident.last $3) 3)
~loc:(symbol_rloc()))) }
/* used label_longident instead of type_longident to disallow
functor applications in type path */
- | TYPE type_parameters label COLONEQUAL core_type
+ | TYPE type_parameters label COLONEQUAL core_type_no_attr
{ Pwith_typesubst
(Type.mk (mkrhs $3 3)
~params:$2
| typevar_list DOT core_type
{ mktyp(Ptyp_poly(List.rev $1, $3)) }
;
+poly_type_no_attr:
+ core_type_no_attr
+ { $1 }
+ | typevar_list DOT core_type_no_attr
+ { mktyp(Ptyp_poly(List.rev $1, $3)) }
+;
/* Core types */
core_type:
+ core_type_no_attr
+ { $1 }
+ | core_type attribute
+ { Typ.attr $1 $2 }
+;
+core_type_no_attr:
core_type2
{ $1 }
| core_type2 AS QUOTE ident
{ $1 }
| LPAREN core_type_comma_list RPAREN %prec below_SHARP
{ match $2 with [sty] -> sty | _ -> raise Parse_error }
- | simple_core_type attribute
- { Typ.attr $1 $2 }
;
simple_core_type_no_attr:
| simple_core_type { Rinherit $1 }
;
tag_field:
- name_tag attributes OF opt_ampersand amper_type_list
- { Rtag ($1, $2, $4, List.rev $5) }
+ name_tag OF opt_ampersand amper_type_list attributes
+ { Rtag ($1, $5, $3, List.rev $4) }
| name_tag attributes
{ Rtag ($1, $2, true, []) }
;
| /* empty */ { false }
;
amper_type_list:
- core_type { [$1] }
- | amper_type_list AMPERSAND core_type { $3 :: $1 }
+ core_type_no_attr { [$1] }
+ | amper_type_list AMPERSAND core_type_no_attr { $3 :: $1 }
;
name_tag_list:
name_tag { [$1] }
| DOTDOT { [], Open }
;
field:
- label attributes COLON poly_type { ($1, $2, $4) }
+ label COLON poly_type_no_attr attributes { ($1, $4, $3) }
;
label:
LIDENT { $1 }
| INFIXOP2 { $1 }
| INFIXOP3 { $1 }
| INFIXOP4 { $1 }
+ | SHARPOP { $1 }
| BANG { "!" }
| PLUS { "+" }
| PLUSDOT { "+." }
/* empty */ { Nonrecursive }
| REC { Recursive }
;
+nonrec_flag:
+ /* empty */ { Recursive }
+ | NONREC { Nonrecursive }
+;
direction_flag:
TO { Upto }
| DOWNTO { Downto }
and payload =
| PStr of structure
| PTyp of core_type (* : T *)
- | PPat of pattern * expression option (* : P or : P when E *)
+ | PPat of pattern * expression option (* ? P or ? P when E *)
(** {2 Core language} *)
| Virtual -> pp f "virtual@;"
(* trailing space added *)
- method rec_flag f = function
+ method rec_flag f rf =
+ match rf with
| Nonrecursive -> ()
| Recursive -> pp f "rec "
+ method nonrec_flag f rf =
+ match rf with
+ | Nonrecursive -> pp f "nonrec "
+ | Recursive -> ()
method direction_flag f = function
| Upto -> pp f "to@ "
| Downto -> pp f "downto@ "
| Ptyp_variant (l, closed, low) ->
let type_variant_helper f x =
match x with
- | Rtag (l, attrs, _, ctl) -> pp f "@[<2>%a%a%a@]" self#string_quot l
- self#attributes attrs
+ | Rtag (l, attrs, _, ctl) -> pp f "@[<2>%a%a@;%a@]" self#string_quot l
(fun f l -> match l with
|[] -> ()
| _ -> pp f "@;of@;%a"
(self#list self#core_type ~sep:"&") ctl) ctl
+ self#attributes attrs
| Rinherit ct -> self#core_type f ct in
pp f "@[<2>[%a%a]@]"
(fun f l
| 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
+ if x.ppat_attributes <> [] then self#pattern f x
+ else match x.ppat_desc with
| Ppat_construct (({txt=Lident ("()"|"[]" as x);_}), _) -> pp f "%s" x
| Ppat_any -> pp f "_";
| Ppat_var ({txt = txt;_}) -> protect_ident f txt
pp f "@[<2>(lazy@;%a)@]" self#pattern1 p
| Ppat_exception p ->
pp f "@[<2>exception@;%a@]" self#pattern1 p
+ | Ppat_extension e -> self#extension f e
| _ -> self#paren true self#pattern f x
method label_exp f (l,opt,p) =
pp f "@[<hov2>assert@ %a@]" self#simple_expr e
| Pexp_lazy (e) ->
pp f "@[<hov2>lazy@ %a@]" self#simple_expr e
- (* Pexp_poly: impossible but we should print it anyway, rather than assert false *)
+ (* Pexp_poly: impossible but we should print it anyway, rather than assert false *)
| Pexp_poly (e, None) ->
pp f "@[<hov2>!poly!@ %a@]" self#simple_expr e
| Pexp_poly (e, Some ct) ->
[] -> ()
| l -> pp f "%a " (self#list self#type_param ~first:"(" ~last:")" ~sep:",") l
method type_def_list f l =
- let type_decl kwd f x =
+ let rf =
+ let is_nonrec =
+ List.exists
+ (fun td ->
+ List.exists (fun (n, _) -> n.txt = "nonrec")
+ td.ptype_attributes)
+ l
+ in
+ if is_nonrec then Nonrecursive else Recursive
+ in
+ let type_decl kwd rf f x =
let eq =
if (x.ptype_kind = Ptype_abstract)
&& (x.ptype_manifest = None) then ""
else " ="
in
- pp f "@[<2>%s %a%s%s%a@]%a" kwd
+ pp f "@[<2>%s %a%a%s%s%a@]%a" kwd
+ self#nonrec_flag rf
self#type_params x.ptype_params
x.ptype_name.txt eq
self#type_declaration x
in
match l with
| [] -> assert false
- | [x] -> type_decl "type" f x
+ | [x] -> type_decl "type" rf f x
| x :: xs -> pp f "@[<v>%a@,%a@]"
- (type_decl "type") x
- (self#list ~sep:"@," (type_decl "and")) xs
+ (type_decl "type" rf) x
+ (self#list ~sep:"@," (type_decl "and" Recursive)) xs
method type_declaration f x =
let priv f =
match x.ptype_private with
| Some y -> pp f "@;%a" self#core_type y
in
let constructor_declaration f pcd =
- match pcd.pcd_res with
- | None ->
+ match pcd.pcd_args, pcd.pcd_res with
+ | _, None ->
pp f "|@;%s%a%a" pcd.pcd_name.txt
- self#attributes pcd.pcd_attributes
(fun f -> function
| [] -> ()
| l -> pp f "@;of@;%a" (self#list self#core_type1 ~sep:"*@;") l)
pcd.pcd_args
- | Some x ->
- pp f "|@;%s%a:@;%a" pcd.pcd_name.txt
self#attributes pcd.pcd_attributes
- (self#list self#core_type1 ~sep:"@;->@;") (pcd.pcd_args@[x])
+ | [], Some x ->
+ pp f "|@;%s:@;%a%a" pcd.pcd_name.txt
+ self#core_type1 x
+ self#attributes pcd.pcd_attributes
+ | args, Some x ->
+ pp f "|@;%s:@;%a@;->@;%a%a" pcd.pcd_name.txt
+ (self#list self#core_type1 ~sep:"*@;") args
+ self#core_type1 x
+ self#attributes pcd.pcd_attributes
in
let label_declaration f pld =
- pp f "@[<2>%a%s%a:@;%a;@]"
+ pp f "@[<2>%a%s:@;%a%a;@]"
self#mutable_flag pld.pld_mutable
pld.pld_name.txt
- self#attributes pld.pld_attributes
self#core_type pld.pld_type
+ self#attributes pld.pld_attributes
in
let repr f =
let intro f =
let constraints f =
self#list ~first:"@ "
(fun f (ct1,ct2,_) ->
- pp f "@[<hov2>constraint@ %a@ =@ %a@]"
+ pp f "@[<hov2> constraint@ %a@ =@ %a@]"
self#core_type ct1 self#core_type ct2)
f x.ptype_cstrs
in
method payload : Format.formatter -> Parsetree.payload -> unit
method private_flag : Format.formatter -> Asttypes.private_flag -> unit
method rec_flag : Format.formatter -> Asttypes.rec_flag -> unit
+ method nonrec_flag : Format.formatter -> Asttypes.rec_flag -> unit
method reset : 'b
method reset_semi : 'b
| Psig_value vd ->
line i ppf "Psig_value\n";
value_description i ppf vd;
- | Psig_type (l) ->
+ | Psig_type l ->
line i ppf "Psig_type\n";
list i type_declaration ppf l;
| Psig_typext te ->
match x with
| Pdir_none -> line i ppf "Pdir_none\n"
| Pdir_string (s) -> line i ppf "Pdir_string \"%s\"\n" s;
- | Pdir_int (i) -> line i ppf "Pdir_int %d\n" i;
+ | Pdir_int (n) -> line i ppf "Pdir_int %d\n" n;
| Pdir_ident (li) -> line i ppf "Pdir_ident %a\n" fmt_longident li;
| Pdir_bool (b) -> line i ppf "Pdir_bool %s\n" (string_of_bool b);
;;
arg.cmi :
-array.cmi :
arrayLabels.cmi :
+array.cmi :
buffer.cmi :
-bytes.cmi :
bytesLabels.cmi :
+bytes.cmi :
callback.cmi :
-camlinternalFormat.cmi : camlinternalFormatBasics.cmi buffer.cmi
camlinternalFormatBasics.cmi :
+camlinternalFormat.cmi : camlinternalFormatBasics.cmi buffer.cmi
camlinternalLazy.cmi :
camlinternalMod.cmi : obj.cmi
camlinternalOO.cmi : obj.cmi
int64.cmi :
lazy.cmi :
lexing.cmi :
-list.cmi :
listLabels.cmi :
+list.cmi :
map.cmi :
marshal.cmi :
moreLabels.cmi : set.cmi map.cmi hashtbl.cmi
stdLabels.cmi : stringLabels.cmi listLabels.cmi bytesLabels.cmi \
arrayLabels.cmi
stream.cmi :
-string.cmi :
stringLabels.cmi :
+string.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
+array.cmo : array.cmi
+array.cmx : array.cmi
buffer.cmo : sys.cmi string.cmi bytes.cmi buffer.cmi
buffer.cmx : sys.cmx string.cmx bytes.cmx buffer.cmi
-bytes.cmo : pervasives.cmi list.cmi char.cmi bytes.cmi
-bytes.cmx : pervasives.cmx list.cmx char.cmx bytes.cmi
bytesLabels.cmo : bytes.cmi bytesLabels.cmi
bytesLabels.cmx : bytes.cmx bytesLabels.cmi
+bytes.cmo : pervasives.cmi list.cmi char.cmi bytes.cmi
+bytes.cmx : pervasives.cmx list.cmx char.cmx bytes.cmi
callback.cmo : obj.cmi callback.cmi
callback.cmx : obj.cmx callback.cmi
+camlinternalFormatBasics.cmo : camlinternalFormatBasics.cmi
+camlinternalFormatBasics.cmx : camlinternalFormatBasics.cmi
camlinternalFormat.cmo : sys.cmi string.cmi char.cmi \
camlinternalFormatBasics.cmi bytes.cmi buffer.cmi camlinternalFormat.cmi
camlinternalFormat.cmx : sys.cmx string.cmx char.cmx \
camlinternalFormatBasics.cmx bytes.cmx buffer.cmx camlinternalFormat.cmi
-camlinternalFormatBasics.cmo : camlinternalFormatBasics.cmi
-camlinternalFormatBasics.cmx : camlinternalFormatBasics.cmi
camlinternalLazy.cmo : obj.cmi camlinternalLazy.cmi
camlinternalLazy.cmx : obj.cmx camlinternalLazy.cmi
camlinternalMod.cmo : obj.cmi camlinternalOO.cmi array.cmi \
lazy.cmx : obj.cmx camlinternalLazy.cmx lazy.cmi
lexing.cmo : sys.cmi string.cmi bytes.cmi array.cmi lexing.cmi
lexing.cmx : sys.cmx string.cmx bytes.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
+list.cmo : list.cmi
+list.cmx : list.cmi
map.cmo : map.cmi
map.cmx : map.cmi
marshal.cmo : bytes.cmi marshal.cmi
sort.cmx : array.cmx sort.cmi
stack.cmo : list.cmi stack.cmi
stack.cmx : list.cmx stack.cmi
+std_exit.cmo :
+std_exit.cmx :
stdLabels.cmo : stringLabels.cmi listLabels.cmi bytesLabels.cmi \
arrayLabels.cmi stdLabels.cmi
stdLabels.cmx : stringLabels.cmx listLabels.cmx bytesLabels.cmx \
arrayLabels.cmx stdLabels.cmi
-std_exit.cmo :
-std_exit.cmx :
stream.cmo : string.cmi obj.cmi list.cmi lazy.cmi bytes.cmi stream.cmi
stream.cmx : string.cmx obj.cmx list.cmx lazy.cmx bytes.cmx stream.cmi
-string.cmo : pervasives.cmi list.cmi bytes.cmi string.cmi
-string.cmx : pervasives.cmx list.cmx bytes.cmx string.cmi
stringLabels.cmo : string.cmi stringLabels.cmi
stringLabels.cmx : string.cmx stringLabels.cmi
+string.cmo : pervasives.cmi list.cmi bytes.cmi string.cmi
+string.cmx : pervasives.cmx list.cmx bytes.cmx string.cmi
sys.cmo : sys.cmi
sys.cmx : sys.cmi
weak.cmo : sys.cmi obj.cmi hashtbl.cmi array.cmi weak.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
+array.cmo : array.cmi
+array.p.cmx : array.cmi
buffer.cmo : sys.cmi string.cmi bytes.cmi buffer.cmi
buffer.p.cmx : sys.p.cmx string.p.cmx bytes.p.cmx buffer.cmi
-bytes.cmo : pervasives.cmi list.cmi char.cmi bytes.cmi
-bytes.p.cmx : pervasives.p.cmx list.p.cmx char.p.cmx bytes.cmi
bytesLabels.cmo : bytes.cmi bytesLabels.cmi
bytesLabels.p.cmx : bytes.p.cmx bytesLabels.cmi
+bytes.cmo : pervasives.cmi list.cmi char.cmi bytes.cmi
+bytes.p.cmx : pervasives.p.cmx list.p.cmx char.p.cmx bytes.cmi
callback.cmo : obj.cmi callback.cmi
callback.p.cmx : obj.p.cmx callback.cmi
+camlinternalFormatBasics.cmo : camlinternalFormatBasics.cmi
+camlinternalFormatBasics.p.cmx : camlinternalFormatBasics.cmi
camlinternalFormat.cmo : sys.cmi string.cmi char.cmi \
camlinternalFormatBasics.cmi bytes.cmi buffer.cmi camlinternalFormat.cmi
camlinternalFormat.p.cmx : sys.p.cmx string.p.cmx char.p.cmx \
camlinternalFormatBasics.p.cmx bytes.p.cmx buffer.p.cmx camlinternalFormat.cmi
-camlinternalFormatBasics.cmo : camlinternalFormatBasics.cmi
-camlinternalFormatBasics.p.cmx : camlinternalFormatBasics.cmi
camlinternalLazy.cmo : obj.cmi camlinternalLazy.cmi
camlinternalLazy.p.cmx : obj.p.cmx camlinternalLazy.cmi
camlinternalMod.cmo : obj.cmi camlinternalOO.cmi array.cmi \
lazy.p.cmx : obj.p.cmx camlinternalLazy.p.cmx lazy.cmi
lexing.cmo : sys.cmi string.cmi bytes.cmi array.cmi lexing.cmi
lexing.p.cmx : sys.p.cmx string.p.cmx bytes.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
+list.cmo : list.cmi
+list.p.cmx : list.cmi
map.cmo : map.cmi
map.p.cmx : map.cmi
marshal.cmo : bytes.cmi marshal.cmi
sort.p.cmx : array.p.cmx sort.cmi
stack.cmo : list.cmi stack.cmi
stack.p.cmx : list.p.cmx stack.cmi
+std_exit.cmo :
+std_exit.p.cmx :
stdLabels.cmo : stringLabels.cmi listLabels.cmi bytesLabels.cmi \
arrayLabels.cmi stdLabels.cmi
stdLabels.p.cmx : stringLabels.p.cmx listLabels.p.cmx bytesLabels.p.cmx \
arrayLabels.p.cmx stdLabels.cmi
-std_exit.cmo :
-std_exit.p.cmx :
stream.cmo : string.cmi obj.cmi list.cmi lazy.cmi bytes.cmi stream.cmi
stream.p.cmx : string.p.cmx obj.p.cmx list.p.cmx lazy.p.cmx bytes.p.cmx stream.cmi
-string.cmo : pervasives.cmi list.cmi bytes.cmi string.cmi
-string.p.cmx : pervasives.p.cmx list.p.cmx bytes.p.cmx string.cmi
stringLabels.cmo : string.cmi stringLabels.cmi
stringLabels.p.cmx : string.p.cmx stringLabels.cmi
+string.cmo : pervasives.cmi list.cmi bytes.cmi string.cmi
+string.p.cmx : pervasives.p.cmx list.p.cmx bytes.p.cmx string.cmi
sys.cmo : sys.cmi
sys.p.cmx : sys.cmi
weak.cmo : sys.cmi obj.cmi hashtbl.cmi array.cmi weak.cmi
camlheader
+target_camlheader
camlheaderd
+target_camlheaderd
camlheader_ur
labelled-*
caml
stdlib.p.cmxa: $(OBJS:.cmo=.p.cmx)
$(CAMLOPT) -a -o stdlib.p.cmxa $(OBJS:.cmo=.p.cmx)
-camlheader camlheaderd camlheader_ur: header.c ../config/Makefile
+camlheader target_camlheader camlheaderd target_camlheaderd camlheader_ur: \
+ header.c ../config/Makefile
if $(SHARPBANGSCRIPTS); then \
echo '#!$(BINDIR)/ocamlrun' > camlheader && \
+ echo '#!$(TARGET_BINDIR)/ocamlrun' > target_camlheader && \
echo '#!$(BINDIR)/ocamlrund' > camlheaderd && \
+ echo '#!$(TARGET_BINDIR)/ocamlrund' > target_camlheaderd && \
echo '#!' | tr -d '\012' > camlheader_ur; \
else \
- $(BYTECC) $(BYTECCCOMPOPTS) $(BYTECCLINKOPTS) \
- -DRUNTIME_NAME='"$(BINDIR)/ocamlrun"' \
- header.c -o tmpheader$(EXE) && \
- strip tmpheader$(EXE) && \
- mv tmpheader$(EXE) camlheader && \
- cp camlheader camlheader_ur && \
- $(BYTECC) $(BYTECCCOMPOPTS) $(BYTECCLINKOPTS) \
- -DRUNTIME_NAME='"$(BINDIR)/ocamlrund"' \
- header.c -o tmpheader$(EXE) && \
- strip tmpheader$(EXE) && \
- mv tmpheader$(EXE) camlheaderd; \
+ for suff in '' d; do \
+ $(BYTECC) $(BYTECCCOMPOPTS) $(BYTECCLINKOPTS) \
+ -DRUNTIME_NAME='"$(BINDIR)/ocamlrun'$$suff'"' \
+ header.c -o tmpheader$(EXE) && \
+ strip tmpheader$(EXE) && \
+ mv tmpheader$(EXE) camlheader$$suff && \
+ $(BYTECC) $(BYTECCCOMPOPTS) $(BYTECCLINKOPTS) \
+ -DRUNTIME_NAME='"$(TARGET_BINDIR)/ocamlrun'$$suff'"' \
+ header.c -o tmpheader$(EXE) && \
+ strip tmpheader$(EXE) && \
+ mv tmpheader$(EXE) target_camlheader$$suff; \
+ done && \
+ cp camlheader camlheader_ur; \
fi
.PHONY: all allopt allopt-noprof allopt-prof install installopt
installopt:
cp stdlib.cmxa stdlib.$(A) std_exit.$(O) *.cmx $(INSTALL_LIBDIR)
-camlheader camlheader_ur: headernt.c ../config/Makefile
+camlheader target_camlheader camlheader_ur: headernt.c ../config/Makefile
$(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 target_camlheader
cp camlheader camlheader_ur
-camlheaderd: headernt.c ../config/Makefile
+camlheaderd target_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
+ cp camlheaderd target_camlheaderd
# TODO: do not call flexlink to build tmpheader.exe (we don't need
# the export table)
#########################################################################
include ../config/Makefile
-RUNTIME=../boot/ocamlrun
+CAMLRUN ?= ../boot/ocamlrun
+CAMLYACC ?= ../boot/ocamlyacc
+TARGET_BINDIR ?= $(BINDIR)
+
COMPILER=../ocamlc
-CAMLC=$(RUNTIME) $(COMPILER)
+CAMLC=$(CAMLRUN) $(COMPILER)
COMPFLAGS=-strict-sequence -w +33..39 -g -warn-error A -bin-annot -nostdlib \
-safe-string
OPTCOMPILER=../ocamlopt
-CAMLOPT=$(RUNTIME) $(OPTCOMPILER)
-CAMLDEP=../boot/ocamlrun ../tools/ocamldep
+CAMLOPT=$(CAMLRUN) $(OPTCOMPILER)
+CAMLDEP=$(CAMLRUN) ../tools/ocamldep
OBJS=camlinternalFormatBasics.cmo pervasives.cmo $(OTHERS)
OTHERS=array.cmo list.cmo char.cmo bytes.cmo string.cmo sys.cmo \
arrayLabels.cmo listLabels.cmo bytesLabels.cmo \
stringLabels.cmo moreLabels.cmo stdLabels.cmo
-all: stdlib.cma std_exit.cmo camlheader camlheader_ur
+all: stdlib.cma std_exit.cmo camlheader target_camlheader camlheader_ur
INSTALL_LIBDIR=$(DESTDIR)$(LIBDIR)
install: install-$(RUNTIMED)
- cp stdlib.cma std_exit.cmo *.cmi *.mli *.ml camlheader camlheader_ur \
+ cp stdlib.cma std_exit.cmo *.cmi *.mli *.ml camlheader_ur \
$(INSTALL_LIBDIR)
+ cp target_camlheader $(INSTALL_LIBDIR)/camlheader
install-noruntimed:
.PHONY: install-noruntimed
-install-runtimed: camlheaderd
- cp camlheaderd $(INSTALL_LIBDIR)
+install-runtimed: target_camlheaderd
+ cp target_camlheaderd $(INSTALL_LIBDIR)/camlheaderd
.PHONY: install-runtimed
stdlib.cma: $(OBJS)
rm -f sys.ml
clean::
- rm -f camlheader camlheader_ur camlheaderd
+ rm -f camlheader target_camlheader camlheader_ur target_camlheaderd
.SUFFIXES: .mli .ml .cmi .cmo .cmx .p.cmx
let init l f =
if l = 0 then [||] else
+ if l < 0 then invalid_arg "Array.init"
+ (* See #6575. We could also check for maximum array size, but this depends
+ on whether we create a float array or a regular one... *)
+ else
let res = create l (f 0) in
for i = 1 to pred l do
unsafe_set res i (f i)
external make_float: int -> float array = "caml_make_float_vect"
(** [Array.make_float n] returns a fresh float array of length [n],
- with uninitialized data. *)
+ with uninitialized data.
+ @since 4.02 *)
(** {6 Sorting} *)
(** Return the length (number of elements) of the given array. *)
external get : 'a array -> int -> 'a = "%array_safe_get"
-(** [Array.get a n] returns the element number [n] of array [a].
+(** [ArrayLabels.get a n] returns the element number [n] of array [a].
The first element has number 0.
- The last element has number [Array.length a - 1].
- You can also write [a.(n)] instead of [Array.get a n].
+ The last element has number [ArrayLabels.length a - 1].
+ You can also write [a.(n)] instead of [ArrayLabels.get a n].
Raise [Invalid_argument "index out of bounds"]
- if [n] is outside the range 0 to [(Array.length a - 1)]. *)
+ if [n] is outside the range 0 to [(ArrayLabels.length a - 1)]. *)
external set : 'a array -> int -> 'a -> unit = "%array_safe_set"
-(** [Array.set a n x] modifies array [a] in place, replacing
+(** [ArrayLabels.set a n x] modifies array [a] in place, replacing
element number [n] with [x].
- You can also write [a.(n) <- x] instead of [Array.set a n x].
+ You can also write [a.(n) <- x] instead of [ArrayLabels.set a n x].
Raise [Invalid_argument "index out of bounds"]
- if [n] is outside the range 0 to [Array.length a - 1]. *)
+ if [n] is outside the range 0 to [ArrayLabels.length a - 1]. *)
external make : int -> 'a -> 'a array = "caml_make_vect"
-(** [Array.make n x] returns a fresh array of length [n],
+(** [ArrayLabels.make n x] returns a fresh array of length [n],
initialized with [x].
All the elements of this new array are initially
physically equal to [x] (in the sense of the [==] predicate).
(** @deprecated [ArrayLabels.create] is an alias for {!ArrayLabels.make}. *)
val init : int -> f:(int -> 'a) -> 'a array
-(** [Array.init n f] returns a fresh array of length [n],
+(** [ArrayLabels.init n f] returns a fresh array of length [n],
with element number [i] initialized to the result of [f i].
- In other terms, [Array.init n f] tabulates the results of [f]
+ In other terms, [ArrayLabels.init n f] tabulates the results of [f]
applied to the integers [0] to [n-1].
Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length].
size is only [Sys.max_array_length / 2].*)
val make_matrix : dimx:int -> dimy:int -> 'a -> 'a array array
-(** [Array.make_matrix dimx dimy e] returns a two-dimensional array
+(** [ArrayLabels.make_matrix dimx dimy e] returns a two-dimensional array
(an array of arrays) with first dimension [dimx] and
second dimension [dimy]. All the elements of this new matrix
are initially physically equal to [e].
{!ArrayLabels.make_matrix}. *)
val append : 'a array -> 'a array -> 'a array
-(** [Array.append v1 v2] returns a fresh array containing the
+(** [ArrayLabels.append v1 v2] returns a fresh array containing the
concatenation of the arrays [v1] and [v2]. *)
val concat : 'a array list -> 'a array
-(** Same as [Array.append], but concatenates a list of arrays. *)
+(** Same as [ArrayLabels.append], but concatenates a list of arrays. *)
val sub : 'a array -> pos:int -> len:int -> 'a array
-(** [Array.sub a start len] returns a fresh array of length [len],
+(** [ArrayLabels.sub a start len] returns a fresh array of length [len],
containing the elements number [start] to [start + len - 1]
of array [a].
Raise [Invalid_argument "Array.sub"] if [start] and [len] do not
designate a valid subarray of [a]; that is, if
- [start < 0], or [len < 0], or [start + len > Array.length a]. *)
+ [start < 0], or [len < 0], or [start + len > ArrayLabels.length a]. *)
val copy : 'a array -> 'a array
-(** [Array.copy a] returns a copy of [a], that is, a fresh array
+(** [ArrayLabels.copy a] returns a copy of [a], that is, a fresh array
containing the same elements as [a]. *)
val fill : 'a array -> pos:int -> len:int -> 'a -> unit
-(** [Array.fill a ofs len x] modifies the array [a] in place,
+(** [ArrayLabels.fill a ofs len x] modifies the array [a] in place,
storing [x] in elements number [ofs] to [ofs + len - 1].
Raise [Invalid_argument "Array.fill"] if [ofs] and [len] do not
val blit :
src:'a array -> src_pos:int -> dst:'a array -> dst_pos:int -> len:int ->
unit
-(** [Array.blit v1 o1 v2 o2 len] copies [len] elements
+(** [ArrayLabels.blit v1 o1 v2 o2 len] copies [len] elements
from array [v1], starting at element number [o1], to array [v2],
starting at element number [o2]. It works correctly even if
[v1] and [v2] are the same array, and the source and
designate a valid subarray of [v2]. *)
val to_list : 'a array -> 'a list
-(** [Array.to_list a] returns the list of all the elements of [a]. *)
+(** [ArrayLabels.to_list a] returns the list of all the elements of [a]. *)
val of_list : 'a list -> 'a array
-(** [Array.of_list l] returns a fresh array containing the elements
+(** [ArrayLabels.of_list l] returns a fresh array containing the elements
of [l]. *)
val iter : f:('a -> unit) -> 'a array -> unit
-(** [Array.iter f a] applies function [f] in turn to all
+(** [ArrayLabels.iter f a] applies function [f] in turn to all
the elements of [a]. It is equivalent to
- [f a.(0); f a.(1); ...; f a.(Array.length a - 1); ()]. *)
+ [f a.(0); f a.(1); ...; f a.(ArrayLabels.length a - 1); ()]. *)
val map : f:('a -> 'b) -> 'a array -> 'b array
-(** [Array.map f a] applies function [f] to all the elements of [a],
+(** [ArrayLabels.map f a] applies function [f] to all the elements of [a],
and builds an array with the results returned by [f]:
- [[| f a.(0); f a.(1); ...; f a.(Array.length a - 1) |]]. *)
+ [[| f a.(0); f a.(1); ...; f a.(ArrayLabels.length a - 1) |]]. *)
val iteri : f:(int -> 'a -> unit) -> 'a array -> unit
(** Same as {!ArrayLabels.iter}, but the
and the element itself as second argument. *)
val fold_left : f:('a -> 'b -> 'a) -> init:'a -> 'b array -> 'a
-(** [Array.fold_left f x a] computes
+(** [ArrayLabels.fold_left f x a] computes
[f (... (f (f x a.(0)) a.(1)) ...) a.(n-1)],
where [n] is the length of the array [a]. *)
val fold_right : f:('b -> 'a -> 'a) -> 'b array -> init:'a -> 'a
-(** [Array.fold_right f a x] computes
+(** [ArrayLabels.fold_right f a x] computes
[f a.(0) (f a.(1) ( ... (f a.(n-1) x) ...))],
where [n] is the length of the array [a]. *)
and a negative integer if the first is smaller (see below for a
complete specification). For example, {!Pervasives.compare} is
a suitable comparison function, provided there are no floating-point
- NaN values in the data. After calling [Array.sort], the
+ NaN values in the data. After calling [ArrayLabels.sort], the
array is sorted in place in increasing order.
- [Array.sort] is guaranteed to run in constant heap space
+ [ArrayLabels.sort] is guaranteed to run in constant heap space
and (at most) logarithmic stack space.
The current implementation uses Heap Sort. It runs in constant
- [cmp x y] > 0 if and only if [cmp y x] < 0
- if [cmp x y] >= 0 and [cmp y z] >= 0 then [cmp x z] >= 0
- When [Array.sort] returns, [a] contains the same elements as before,
+ When [ArrayLabels.sort] returns, [a] contains the same elements as before,
reordered in such a way that for all i and j valid indices of [a] :
- [cmp a.(i) a.(j)] >= 0 if and only if i >= j
*)
*)
val fast_sort : cmp:('a -> 'a -> int) -> 'a array -> unit
-(** Same as {!Array.sort} or {!Array.stable_sort}, whichever is faster
- on typical input.
+(** Same as {!ArrayLabels.sort} or {!ArrayLabels.stable_sort}, whichever is
+ faster on typical input.
*)
val contents : t -> string
(** Return a copy of the current contents of the buffer.
- The buffer itself is unchanged. *)
+ The buffer itself is unchanged. *)
val to_bytes : t -> bytes
(** Return a copy of the current contents of the buffer.
- The buffer itself is unchanged. *)
+ The buffer itself is unchanged.
+ @since 4.02 *)
val sub : t -> int -> int -> string
(** [Buffer.sub b off len] returns (a copy of) the bytes from the
(** [add_string b s] appends the string [s] at the end of the buffer [b]. *)
val add_bytes : t -> bytes -> unit
-(** [add_string b s] appends the string [s] at the end of the buffer [b]. *)
+(** [add_string b s] appends the string [s] at the end of the buffer [b].
+ @since 4.02 *)
val add_substring : t -> string -> int -> int -> unit
(** [add_substring b s ofs len] takes [len] characters from offset
val add_subbytes : t -> bytes -> int -> int -> unit
(** [add_substring b s ofs len] takes [len] characters from offset
- [ofs] in byte sequence [s] and appends them at the end of the buffer [b]. *)
+ [ofs] in byte sequence [s] and appends them at the end of the buffer [b].
+ @since 4.02 *)
val add_substitute : t -> (string -> string) -> string -> unit
(** [add_substitute b f s] appends the string pattern [s] at the end
(* *)
(***********************************************************************)
-(** Byte sequence operations. *)
+(** Byte sequence operations.
+ @since 4.02.0
+ *)
external length : bytes -> int = "%string_length"
(** Return the length (number of bytes) of the argument. *)
| Bool_ty rest -> buffer_add_string buf "%B"; bprint_fmtty buf rest;
| Alpha_ty rest -> buffer_add_string buf "%a"; bprint_fmtty buf rest;
| Theta_ty rest -> buffer_add_string buf "%t"; bprint_fmtty buf rest;
+ | Any_ty rest -> buffer_add_string buf "%?"; bprint_fmtty buf rest;
| Reader_ty rest -> buffer_add_string buf "%r"; bprint_fmtty buf rest;
| Ignored_reader_ty rest ->
(***)
+let rec int_of_custom_arity : type a b c .
+ (a, b, c) custom_arity -> int =
+ function
+ | Custom_zero -> 0
+ | Custom_succ x -> 1 + int_of_custom_arity x
+
(* Print a complete format in a buffer. *)
let bprint_fmt buf fmt =
let rec fmtiter : type a b c d e f .
| Theta rest ->
buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
buffer_add_char buf 't'; fmtiter rest false;
+ | Custom (arity, _, rest) ->
+ for _i = 1 to int_of_custom_arity arity do
+ buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+ buffer_add_char buf '?';
+ done;
+ fmtiter rest false;
| Reader rest ->
buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
buffer_add_char buf 'r'; fmtiter rest false;
| String_ty rest -> String_ty (symm rest)
| Theta_ty rest -> Theta_ty (symm rest)
| Alpha_ty rest -> Alpha_ty (symm rest)
+ | Any_ty rest -> Any_ty (symm rest)
| Reader_ty rest -> Reader_ty (symm rest)
| Ignored_reader_ty rest -> Ignored_reader_ty (symm rest)
| Format_arg_ty (ty, rest) ->
(fun Refl -> let Refl = fa Refl in Refl),
(fun Refl -> let Refl = af Refl in Refl),
ed, de
+ | Any_ty rest ->
+ let fa, af, ed, de = fmtty_rel_det rest in
+ (fun Refl -> let Refl = fa Refl in Refl),
+ (fun Refl -> let Refl = af Refl in Refl),
+ ed, de
| Reader_ty rest ->
let fa, af, ed, de = fmtty_rel_det rest in
(fun Refl -> let Refl = fa Refl in Refl),
| Theta_ty _, _ -> assert false
| _, Theta_ty _ -> assert false
+ | Any_ty rest1, Any_ty rest2 -> Any_ty (trans rest1 rest2)
+ | Any_ty _, _ -> assert false
+ | _, Any_ty _ -> assert false
+
| Reader_ty rest1, Reader_ty rest2 -> Reader_ty (trans rest1 rest2)
| Reader_ty _, _ -> assert false
| _, Reader_ty _ -> assert false
| Bool rest -> Bool_ty (fmtty_of_fmt rest)
| Alpha rest -> Alpha_ty (fmtty_of_fmt rest)
| Theta rest -> Theta_ty (fmtty_of_fmt rest)
+ | Custom (arity, _, rest) -> fmtty_of_custom arity (fmtty_of_fmt rest)
| Reader rest -> Reader_ty (fmtty_of_fmt rest)
| Format_arg (_, ty, rest) ->
| End_of_format -> End_of_fmtty
+and fmtty_of_custom : type x y a b c d e f .
+ (a, x, y) custom_arity -> (a, b, c, d, e, f) fmtty ->
+ (y, b, c, d, e, f) fmtty =
+fun arity fmtty -> match arity with
+ | Custom_zero -> fmtty
+ | Custom_succ arity -> Any_ty (fmtty_of_custom arity fmtty)
+
(* Extract the fmtty of an ignored parameter followed by the rest of
the format. *)
and fmtty_of_ignored_format : type x y a b c d e f .
(* Generate the format_float first argument form a float_conv. *)
let format_of_fconv fconv prec =
- let prec = abs prec in
- let symb = if fconv = Float_F then 'g' else char_of_fconv fconv in
- let buf = buffer_create 16 in
- buffer_add_char buf '%';
- bprint_fconv_flag buf fconv;
- buffer_add_char buf '.';
- buffer_add_string buf (string_of_int prec);
- buffer_add_char buf symb;
- buffer_contents buf
+ if fconv = Float_F then "%.12g" else
+ let prec = abs prec in
+ let symb = char_of_fconv fconv in
+ let buf = buffer_create 16 in
+ buffer_add_char buf '%';
+ bprint_fconv_flag buf fconv;
+ buffer_add_char buf '.';
+ buffer_add_string buf (string_of_int prec);
+ buffer_add_char buf symb;
+ buffer_contents buf
(* Convert an integer to a string according to a conversion. *)
let convert_int iconv n = format_int (format_of_iconv iconv) n
fun f x -> make_printf k o (Acc_delay (acc, fun o -> f o x)) rest
| Theta rest ->
fun f -> make_printf k o (Acc_delay (acc, f)) rest
+ | Custom (arity, f, rest) ->
+ make_custom k o acc rest arity (f ())
| Reader _ ->
(* This case is impossible, by typing of formats. *)
(* Indeed, since printf and co. take a format4 as argument, the 'd and 'e
| Bool_ty rest -> fun _ -> make_from_fmtty k o acc rest fmt
| Alpha_ty rest -> fun _ _ -> make_from_fmtty k o acc rest fmt
| Theta_ty rest -> fun _ -> make_from_fmtty k o acc rest fmt
+ | Any_ty rest -> fun _ -> make_from_fmtty k o acc rest fmt
| Reader_ty _ -> assert false
| Ignored_reader_ty _ -> assert false
| Format_arg_ty (_, rest) -> fun _ -> make_from_fmtty k o acc rest fmt
let str = fix_padding padty w (convert_float fconv p x) in
make_printf k o (Acc_data_string (acc, str)) fmt
+and make_custom : type x y a b c d e f .
+ (b -> (b, c) acc -> f) -> b -> (b, c) acc ->
+ (a, b, c, d, e, f) fmt ->
+ (a, x, y) custom_arity -> x -> y =
+ fun k o acc rest arity f -> match arity with
+ | Custom_zero -> make_printf k o (Acc_data_string (acc, f)) rest
+ | Custom_succ arity ->
+ fun x ->
+ make_custom k o acc rest arity (f x)
+
(******************************************************************************)
(* Continuations for make_printf *)
let legacy_behavior = match legacy_behavior with
| Some flag -> flag
| None -> true
- (** When this flag is enabled, the format parser tries to behave as
+ (* When this flag is enabled, the format parser tries to behave as
the <4.02 implementations, in particular it ignores most benine
nonsensical format. When the flag is disabled, it will reject any
format that is not accepted by the specification.
only accept an optional number as precision option (no extra argument) *)
type prec_option = int option
+(* see the Custom format combinator *)
+type ('a, 'b, 'c) custom_arity =
+ | Custom_zero : ('a, string, 'a) custom_arity
+ | Custom_succ : ('a, 'b, 'c) custom_arity ->
+ ('a, 'x -> 'b, 'x -> 'c) custom_arity
+
(***)
(* Relational format types
'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
(('b1 -> 'c1) -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
('b2 -> 'c2) -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+ | Any_ty : (* Used for custom formats *)
+ ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+ 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+ ('x -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+ 'x -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
(* Scanf specific constructor. *)
| Reader_ty : (* %r *)
('a, 'b, 'c, 'd, 'y, 'x) ignored * ('x, 'b, 'c, 'y, 'e, 'f) fmt ->
('a, 'b, 'c, 'd, 'e, 'f) fmt
+ (* Custom printing format (PR#6452, GPR#140)
+
+ We include a type Custom of "custom converters", where an
+ arbitrary function can be used to convert one or more
+ arguments. There is no syntax for custom converters, it is only
+ inteded for custom processors that wish to rely on the
+ stdlib-defined format GADTs.
+
+ For instance a pre-processor could choose to interpret strings
+ prefixed with ["!"] as format strings where [%{{ ... }}] is
+ a special form to pass a to_string function, so that one could
+ write:
+
+ {[
+ type t = { x : int; y : int }
+
+ let string_of_t t = Printf.sprintf "{ x = %d; y = %d }" t.x t.y
+
+ Printf.printf !"t = %{{string_of_t}}" { x = 42; y = 42 }
+ ]}
+ *)
+ | Custom :
+ ('a, 'x, 'y) custom_arity * (unit -> 'x) * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+ ('y, 'b, 'c, 'd, 'e, 'f) fmt
+
+ (* end of a format specification *)
| End_of_format :
('f, 'b, 'c, 'e, 'e, 'f) fmt
Alpha_ty (erase_rel rest)
| Theta_ty rest ->
Theta_ty (erase_rel rest)
+ | Any_ty rest ->
+ Any_ty (erase_rel rest)
| Reader_ty rest ->
Reader_ty (erase_rel rest)
| Ignored_reader_ty rest ->
Alpha_ty (concat_fmtty rest fmtty2)
| Theta_ty rest ->
Theta_ty (concat_fmtty rest fmtty2)
+ | Any_ty rest ->
+ Any_ty (concat_fmtty rest fmtty2)
| Reader_ty rest ->
Reader_ty (concat_fmtty rest fmtty2)
| Ignored_reader_ty rest ->
Alpha (concat_fmt rest fmt2)
| Theta rest ->
Theta (concat_fmt rest fmt2)
+ | Custom (arity, f, rest) ->
+ Custom (arity, f, concat_fmt rest fmt2)
| Reader rest ->
Reader (concat_fmt rest fmt2)
| Flush rest ->
type prec_option = int option
+type ('a, 'b, 'c) custom_arity =
+ | Custom_zero : ('a, string, 'a) custom_arity
+ | Custom_succ : ('a, 'b, 'c) custom_arity ->
+ ('a, 'x -> 'b, 'x -> 'c) custom_arity
+
type block_type = Pp_hbox | Pp_vbox | Pp_hvbox | Pp_hovbox | Pp_box | Pp_fits
type formatting_lit =
'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
(('b1 -> 'c1) -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
('b2 -> 'c2) -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Any_ty : (* Used for custom formats *)
+ ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+ 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+ ('x -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+ 'x -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
(* Scanf specific constructor. *)
| Reader_ty : (* %r *)
('a, 'b, 'c, 'd, 'y, 'x) ignored * ('x, 'b, 'c, 'y, 'e, 'f) fmt ->
('a, 'b, 'c, 'd, 'e, 'f) fmt
+(* Custom printing format *)
+| Custom :
+ ('a, 'x, 'y) custom_arity * (unit -> 'x) * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+ ('y, 'b, 'c, 'd, 'e, 'f) fmt
+
| End_of_format :
('f, 'b, 'c, 'e, 'e, 'f) fmt
let file filename =
let ic = open_in_bin filename in
- let d = channel ic (-1) in
- close_in ic;
- d
+ match channel ic (-1) with
+ | d -> close_in ic; d
+ | exception e -> close_in ic; raise e
let output chan digest =
output_string chan digest
(** Return the digest of the given string. *)
val bytes : bytes -> t
-(** Return the digest of the given byte sequence. *)
+(** Return the digest of the given byte sequence.
+ @since 4.02.0 *)
val substring : string -> int -> int -> t
(** [Digest.substring s ofs len] returns the digest of the substring
val subbytes : bytes -> int -> int -> t
(** [Digest.subbytes s ofs len] returns the digest of the subsequence
- of [s] starting at index [ofs] and containing [len] bytes. *)
+ of [s] starting at index [ofs] and containing [len] bytes.
+ @since 4.02.0 *)
external channel : in_channel -> int -> t = "caml_md5_chan"
(** If [len] is nonnegative, [Digest.channel ic len] reads [len]
s
;;
+let flush_buf_formatter buf ppf =
+ pp_flush_queue ppf false;
+ let s = Buffer.contents buf in
+ Buffer.reset buf;
+ s
+
(**************************************************************
Basic functions on the standard formatter
let eprintf fmt = fprintf err_formatter fmt
let ksprintf k (Format (fmt, _)) =
+ let b = Buffer.create 512 in
+ let ppf = formatter_of_buffer b in
let k' () acc =
- let b = Buffer.create 512 in
- let ppf = formatter_of_buffer b in
strput_acc ppf acc;
- pp_flush_queue ppf false;
- k (Buffer.contents b) in
+ k (flush_buf_formatter b ppf) in
make_printf k' () End_of_acc fmt
let sprintf fmt =
= fun ppf acc ->
output_acc ppf acc;
pp_flush_queue ppf false;
- Buffer.contents b in
+ flush_buf_formatter b ppf in
make_printf k' ppf End_of_acc fmt
(**************************************************************
(** {6 Boxes} *)
-val open_box : int -> unit;;
+val open_box : int -> unit
(** [open_box d] opens a new pretty-printing box
with offset [d].
This box is the general purpose pretty-printing box.
When a new line is printed in the box, [d] is added to the
current indentation. *)
-val close_box : unit -> unit;;
+val close_box : unit -> unit
(** Closes the most recently opened pretty-printing box. *)
(** {6 Formatting functions} *)
-val print_string : string -> unit;;
+val print_string : string -> unit
(** [print_string str] prints [str] in the current box. *)
-val print_as : int -> string -> unit;;
+val print_as : int -> string -> unit
(** [print_as len str] prints [str] in the
current box. The pretty-printer formats [str] as if
it were of length [len]. *)
-val print_int : int -> unit;;
+val print_int : int -> unit
(** Prints an integer in the current box. *)
-val print_float : float -> unit;;
+val print_float : float -> unit
(** Prints a floating point number in the current box. *)
-val print_char : char -> unit;;
+val print_char : char -> unit
(** Prints a character in the current box. *)
-val print_bool : bool -> unit;;
+val print_bool : bool -> unit
(** Prints a boolean in the current box. *)
(** {6 Break hints} *)
-val print_space : unit -> unit;;
+val print_space : unit -> unit
(** [print_space ()] is used to separate items (typically to print
a space between two words).
It indicates that the line may be split at this
point. It either prints one space or splits the line.
It is equivalent to [print_break 1 0]. *)
-val print_cut : unit -> unit;;
+val print_cut : unit -> unit
(** [print_cut ()] is used to mark a good break position.
It indicates that the line may be split at this
point. It either prints nothing or splits the line.
point, without printing spaces or adding indentation.
It is equivalent to [print_break 0 0]. *)
-val print_break : int -> int -> unit;;
+val print_break : int -> int -> unit
(** Inserts a break hint in a pretty-printing box.
[print_break nspaces offset] indicates that the line may
be split (a newline character is printed) at this point,
the current indentation. If the line is not split,
[nspaces] spaces are printed. *)
-val print_flush : unit -> unit;;
+val print_flush : unit -> unit
(** Flushes the pretty printer: all opened boxes are closed,
and all pending text is displayed. *)
-val print_newline : unit -> unit;;
+val print_newline : unit -> unit
(** Equivalent to [print_flush] followed by a new line. *)
-val force_newline : unit -> unit;;
+val force_newline : unit -> unit
(** Forces a newline in the current box. Not the normal way of
pretty-printing, you should prefer break hints. *)
-val print_if_newline : unit -> unit;;
+val print_if_newline : unit -> unit
(** Executes the next formatting command if the preceding line
has just been split. Otherwise, ignore the next formatting
command. *)
(** {6 Margin} *)
-val set_margin : int -> unit;;
+val set_margin : int -> unit
(** [set_margin d] sets the value of the right margin
to [d] (in characters): this value is used to detect line
overflows that leads to split lines.
If [d] is too large, the right margin is set to the maximum
admissible value (which is greater than [10^9]). *)
-val get_margin : unit -> int;;
+val get_margin : unit -> int
(** Returns the position of the right margin. *)
(** {6 Maximum indentation limit} *)
-val set_max_indent : int -> unit;;
+val set_max_indent : int -> unit
(** [set_max_indent d] sets the value of the maximum
indentation limit to [d] (in characters):
once this limit is reached, boxes are rejected to the left,
If [d] is too large, the limit is set to the maximum
admissible value (which is greater than [10^9]). *)
-val get_max_indent : unit -> int;;
+val get_max_indent : unit -> int
(** Return the value of the maximum indentation limit (in characters). *)
(** {6 Formatting depth: maximum number of boxes allowed before ellipsis} *)
-val set_max_boxes : int -> unit;;
+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 ()]).
Nothing happens if [max] is smaller than 2. *)
-val get_max_boxes : unit -> int;;
+val get_max_boxes : unit -> int
(** Returns the maximum number of boxes allowed before ellipsis. *)
-val over_max_boxes : unit -> bool;;
+val over_max_boxes : unit -> bool
(** Tests if the maximum number of boxes allowed have already been opened. *)
(** {6 Advanced formatting} *)
-val open_hbox : unit -> unit;;
+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
(new lines may still occur inside boxes nested deeper). *)
-val open_vbox : int -> unit;;
+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
When a new line is printed in the box, [d] is added to the
current indentation. *)
-val open_hvbox : int -> unit;;
+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
When a new line is printed in the box, [d] is added to the
current indentation. *)
-val open_hovbox : int -> unit;;
+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
(** {6 Tabulations} *)
-val open_tbox : unit -> unit;;
+val open_tbox : unit -> unit
(** Opens a tabulation box. *)
-val close_tbox : unit -> unit;;
+val close_tbox : unit -> unit
(** Closes the most recently opened tabulation box. *)
-val print_tbreak : int -> int -> unit;;
+val print_tbreak : int -> int -> unit
(** Break hint in a tabulation box.
[print_tbreak spaces offset] moves the insertion point to
the next tabulation ([spaces] being added to this position).
If a new line is printed, [offset] is added to the current
indentation. *)
-val set_tab : unit -> unit;;
+val set_tab : unit -> unit
(** Sets a tabulation mark at the current insertion point. *)
-val print_tab : unit -> unit;;
+val print_tab : unit -> unit
(** [print_tab ()] is equivalent to [print_tbreak 0 0]. *)
(** {6 Ellipsis} *)
-val set_ellipsis_text : string -> unit;;
+val set_ellipsis_text : string -> unit
(** Set the text of the ellipsis printed when too many boxes
are opened (a single dot, [.], by default). *)
-val get_ellipsis_text : unit -> string;;
+val get_ellipsis_text : unit -> string
(** Return the text of the ellipsis. *)
(** {6:tags Semantics Tags} *)
-type tag = string;;
+type tag = string
(** {i Semantics tags} (or simply {e tags}) are used to decorate printed
entities for user's defined purposes, e.g. setting font and giving size
Tag marking and tag printing functions are user definable and can
be set by calling [set_formatter_tag_functions]. *)
-val open_tag : tag -> unit;;
+val open_tag : tag -> unit
(** [open_tag t] opens the tag named [t]; the [print_open_tag]
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;;
+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
with [t] as argument. The marker [mark_close_tag t] will be flushed
into the output device of the formatter. *)
-val set_tags : bool -> unit;;
+val set_tags : bool -> unit
(** [set_tags b] turns on or off the treatment of tags (default is off). *)
-val set_print_tags : bool -> unit;;
-val set_mark_tags : bool -> unit;;
-(** [set_print_tags b] turns on or off the printing of tags, while
- [set_mark_tags b] turns on or off the output of tag markers. *)
-val get_print_tags : unit -> bool;;
-val get_mark_tags : unit -> bool;;
-(** Return the current status of tags printing and tags marking. *)
+
+val set_print_tags : bool -> unit
+(**[set_print_tags b] turns on or off the printing of tags. *)
+
+val set_mark_tags : bool -> unit
+(** [set_mark_tags b] turns on or off the output of tag markers. *)
+
+val get_print_tags : unit -> bool
+(** Return the current status of tags printing. *)
+
+val get_mark_tags : unit -> bool
+(** Return the current status of tags marking. *)
(** {6 Redirecting the standard formatter output} *)
-val set_formatter_out_channel : Pervasives.out_channel -> unit;;
+val set_formatter_out_channel : Pervasives.out_channel -> unit
(** Redirect the pretty-printer output to the given channel.
(All the output functions of the standard formatter are set to the
default output functions printing to the given channel.) *)
val set_formatter_output_functions :
(string -> int -> int -> unit) -> (unit -> unit) -> unit
-;;
(** [set_formatter_output_functions out flush] redirects the
pretty-printer output functions to the functions [out] and
[flush].
val get_formatter_output_functions :
unit -> (string -> int -> int -> unit) * (unit -> unit)
-;;
(** Return the current output functions of the pretty-printer. *)
(** {6:meaning Changing the meaning of standard formatter pretty printing} *)
out_newline : unit -> unit;
out_spaces : int -> unit;
}
-;;
-val set_formatter_out_functions : formatter_out_functions -> unit;;
+
+val set_formatter_out_functions : formatter_out_functions -> unit
(** [set_formatter_out_functions f]
Redirect the pretty-printer output to the functions [f.out_string]
and [f.out_flush] as described in
default values for [f.out_space] and [f.out_newline] are
[f.out_string (String.make n ' ') 0 n] and [f.out_string "\n" 0 1]. *)
-val get_formatter_out_functions : unit -> formatter_out_functions;;
+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. *)
print_open_tag : tag -> unit;
print_close_tag : tag -> unit;
}
-;;
(** The tag handling functions specific to a formatter:
[mark] versions are the 'tag marking' functions that associate a string
marker to a tag in order for the pretty-printing engine to flush
[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].
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} *)
-type formatter;;
+type formatter
(** Abstract data corresponding to a pretty-printer (also called a
formatter) and all its machinery.
(convenient to output material to strings for instance).
*)
-val formatter_of_out_channel : out_channel -> formatter;;
+val formatter_of_out_channel : out_channel -> formatter
(** [formatter_of_out_channel oc] returns a new formatter that
writes to the corresponding channel [oc]. *)
-val std_formatter : formatter;;
+val std_formatter : formatter
(** The standard formatter used by the formatting functions
above. It is defined as [formatter_of_out_channel stdout]. *)
-val err_formatter : formatter;;
+val err_formatter : formatter
(** A formatter to use with formatting functions below for
output to standard error. It is defined as
[formatter_of_out_channel stderr]. *)
-val formatter_of_buffer : Buffer.t -> formatter;;
+val formatter_of_buffer : Buffer.t -> formatter
(** [formatter_of_buffer b] returns a new formatter writing to
buffer [b]. As usual, the formatter has to be flushed at
the end of pretty printing, using [pp_print_flush] or
[pp_print_newline], to display all the pending material. *)
-val stdbuf : Buffer.t;;
+val stdbuf : Buffer.t
(** The string buffer in which [str_formatter] writes. *)
-val str_formatter : formatter;;
+val str_formatter : formatter
(** A formatter to use with formatting functions below for
output to the [stdbuf] string buffer.
[str_formatter] is defined as [formatter_of_buffer stdbuf]. *)
-val flush_str_formatter : unit -> string;;
+val flush_str_formatter : unit -> string
(** Returns the material printed with [str_formatter], flushes
the formatter and resets the corresponding buffer. *)
val make_formatter :
(string -> int -> int -> unit) -> (unit -> unit) -> formatter
-;;
(** [make_formatter out flush] returns a new formatter that writes according
to the output function [out], and the flushing function [flush]. For
instance, a formatter to the [Pervasives.out_channel] [oc] is returned by
(** {6 Basic functions to use with formatters} *)
-val pp_open_hbox : formatter -> unit -> unit;;
-val pp_open_vbox : formatter -> int -> unit;;
-val pp_open_hvbox : formatter -> int -> unit;;
-val pp_open_hovbox : formatter -> int -> unit;;
-val pp_open_box : formatter -> int -> unit;;
-val pp_close_box : formatter -> unit -> unit;;
-val pp_open_tag : formatter -> string -> unit;;
-val pp_close_tag : formatter -> unit -> unit;;
-val pp_print_string : formatter -> string -> unit;;
-val pp_print_as : formatter -> int -> string -> unit;;
-val pp_print_int : formatter -> int -> unit;;
-val pp_print_float : formatter -> float -> unit;;
-val pp_print_char : formatter -> char -> unit;;
-val pp_print_bool : formatter -> bool -> unit;;
-val pp_print_break : formatter -> int -> int -> unit;;
-val pp_print_cut : formatter -> unit -> unit;;
-val pp_print_space : formatter -> unit -> unit;;
-val pp_force_newline : formatter -> unit -> unit;;
-val pp_print_flush : formatter -> unit -> unit;;
-val pp_print_newline : formatter -> unit -> unit;;
-val pp_print_if_newline : formatter -> unit -> unit;;
-val pp_open_tbox : formatter -> unit -> unit;;
-val pp_close_tbox : formatter -> unit -> unit;;
-val pp_print_tbreak : formatter -> int -> int -> unit;;
-val pp_set_tab : formatter -> unit -> unit;;
-val pp_print_tab : formatter -> unit -> unit;;
-val pp_set_tags : formatter -> bool -> unit;;
-val pp_set_print_tags : formatter -> bool -> unit;;
-val pp_set_mark_tags : formatter -> bool -> unit;;
-val pp_get_print_tags : formatter -> unit -> bool;;
-val pp_get_mark_tags : formatter -> unit -> bool;;
-val pp_set_margin : formatter -> int -> unit;;
-val pp_get_margin : formatter -> unit -> int;;
-val pp_set_max_indent : formatter -> int -> unit;;
-val pp_get_max_indent : formatter -> unit -> int;;
-val pp_set_max_boxes : formatter -> int -> unit;;
-val pp_get_max_boxes : formatter -> unit -> int;;
-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_open_hbox : formatter -> unit -> unit
+val pp_open_vbox : formatter -> int -> unit
+val pp_open_hvbox : formatter -> int -> unit
+val pp_open_hovbox : formatter -> int -> unit
+val pp_open_box : formatter -> int -> unit
+val pp_close_box : formatter -> unit -> unit
+val pp_open_tag : formatter -> string -> unit
+val pp_close_tag : formatter -> unit -> unit
+val pp_print_string : formatter -> string -> unit
+val pp_print_as : formatter -> int -> string -> unit
+val pp_print_int : formatter -> int -> unit
+val pp_print_float : formatter -> float -> unit
+val pp_print_char : formatter -> char -> unit
+val pp_print_bool : formatter -> bool -> unit
+val pp_print_break : formatter -> int -> int -> unit
+val pp_print_cut : formatter -> unit -> unit
+val pp_print_space : formatter -> unit -> unit
+val pp_force_newline : formatter -> unit -> unit
+val pp_print_flush : formatter -> unit -> unit
+val pp_print_newline : formatter -> unit -> unit
+val pp_print_if_newline : formatter -> unit -> unit
+val pp_open_tbox : formatter -> unit -> unit
+val pp_close_tbox : formatter -> unit -> unit
+val pp_print_tbreak : formatter -> int -> int -> unit
+val pp_set_tab : formatter -> unit -> unit
+val pp_print_tab : formatter -> unit -> unit
+val pp_set_tags : formatter -> bool -> unit
+val pp_set_print_tags : formatter -> bool -> unit
+val pp_set_mark_tags : formatter -> bool -> unit
+val pp_get_print_tags : formatter -> unit -> bool
+val pp_get_mark_tags : formatter -> unit -> bool
+val pp_set_margin : formatter -> int -> unit
+val pp_get_margin : formatter -> unit -> int
+val pp_set_max_indent : formatter -> int -> unit
+val pp_get_max_indent : formatter -> unit -> int
+val pp_set_max_boxes : formatter -> int -> unit
+val pp_get_max_boxes : formatter -> unit -> int
+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_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_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,
(** {6 [printf] like functions for pretty-printing.} *)
-val fprintf : formatter -> ('a, formatter, unit) format -> 'a;;
+val fprintf : formatter -> ('a, formatter, unit) format -> 'a
(** [fprintf ff fmt arg1 ... argN] formats the arguments [arg1] to [argN]
according to the format string [fmt], and outputs the resulting string on
*)
-val printf : ('a, formatter, unit) format -> 'a;;
+val printf : ('a, formatter, unit) format -> 'a
(** Same as [fprintf] above, but output on [std_formatter]. *)
-val eprintf : ('a, formatter, unit) format -> 'a;;
+val eprintf : ('a, formatter, unit) format -> 'a
(** Same as [fprintf] above, but output on [err_formatter]. *)
-val sprintf : ('a, unit, string) format -> 'a;;
+val sprintf : ('a, unit, string) format -> 'a
(** Same as [printf] above, but instead of printing on a formatter,
returns a string containing the result of formatting the arguments.
Note that the pretty-printer queue is flushed at the end of {e each
pretty-printing returns the desired string.
*)
-val asprintf : ('a, formatter, unit, string) format4 -> 'a;;
+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]
@since 4.01.0
*)
-val ifprintf : formatter -> ('a, formatter, unit) format -> 'a;;
+val ifprintf : formatter -> ('a, formatter, unit) format -> 'a
(** Same as [fprintf] above, but does not print anything.
Useful to ignore some material when conditionally printing.
@since 3.10.0
val kfprintf : (formatter -> 'a) -> formatter ->
('b, formatter, unit, 'a) format4 -> 'b
-;;
(** Same as [fprintf] above, but instead of returning immediately,
passes the formatter to its first argument at the end of printing. *)
val ikfprintf : (formatter -> 'a) -> formatter ->
('b, formatter, unit, 'a) format4 -> 'b
-;;
(** Same as [kfprintf] above, but does not print anything.
Useful to ignore some material when conditionally printing.
@since 3.12.0
*)
-val ksprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b;;
+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. *)
val bprintf : Buffer.t -> ('a, formatter, unit) format -> 'a
[@@ocaml.deprecated]
-;;
(** @deprecated This function is error prone. Do not use it.
If you need to print to some buffer [b], you must first define a
val kprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b
[@@ocaml.deprecated "Use Format.ksprintf instead."]
-;;
(** @deprecated An alias for [ksprintf]. *)
val set_all_formatter_output_functions :
spaces:(int -> unit) ->
unit
[@@ocaml.deprecated "Use Format.set_formatter_out_functions instead."]
-;;
-(** @deprecated Subsumed by [set_formatter_out_functions].
-*)
+(** @deprecated Subsumed by [set_formatter_out_functions]. *)
val get_all_formatter_output_functions :
unit ->
(unit -> unit) *
(int -> unit)
[@@ocaml.deprecated "Use Format.get_formatter_out_functions instead."]
-;;
-(** @deprecated Subsumed by [get_formatter_out_functions].
-*)
+(** @deprecated Subsumed by [get_formatter_out_functions]. *)
+
val pp_set_all_formatter_output_functions :
formatter -> out:(string -> int -> int -> unit) -> flush:(unit -> unit) ->
newline:(unit -> unit) -> spaces:(int -> unit) -> unit
[@@ocaml.deprecated "Use Format.pp_set_formatter_out_functions instead."]
-;;
-(** @deprecated Subsumed by [pp_set_formatter_out_functions].
-*)
+(** @deprecated Subsumed by [pp_set_formatter_out_functions]. *)
val pp_get_all_formatter_output_functions :
formatter -> unit ->
(string -> int -> int -> unit) * (unit -> unit) * (unit -> unit) *
(int -> unit)
[@@ocaml.deprecated "Use Format.pp_get_formatter_out_functions instead."]
-;;
-(** @deprecated Subsumed by [pp_get_formatter_out_functions].
-*)
+(** @deprecated Subsumed by [pp_get_formatter_out_functions]. *)
- [0x020] Change of GC parameters.
- [0x040] Computation of major GC slice size.
- [0x080] Calling of finalisation functions.
- - [0x100] Bytecode executable search at start-up.
- - [0x200] Computation of compaction triggering condition.
+ - [0x100] Bytecode executable and shared library search at start-up.
+ - [0x200] Computation of compaction-triggering condition.
Default: 0. *)
mutable max_overhead : int;
Anything reachable from the closure of finalisation functions
is considered reachable, so the following code will not work
as expected:
- - [ let v = ... in Gc.finalise (fun x -> ...) v ]
+ - [ let v = ... in Gc.finalise (fun x -> ... v ...) v ]
- Instead you should write:
+ Instead you should make sure that [v] is not in the closure of
+ the finalisation function by writing:
- [ let f = fun x -> ... ;; let v = ... in Gc.finalise f v ]
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
+ encountered. If [total] as specified by the user exceeds a certain
+ value, currently 256, then it is capped to that value.
+ 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,
#include <fcntl.h>
#include <sys/types.h>
#include <sys/stat.h>
-#include "../byterun/mlvalues.h"
-#include "../byterun/exec.h"
+#include "../byterun/caml/mlvalues.h"
+#include "../byterun/caml/exec.h"
char * default_runtime_path = RUNTIME_NAME;
#define SEEK_END 2
#endif
-#ifndef __CYGWIN32__
+#ifndef __CYGWIN__
/* Normal Unix search path function */
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
-#include "mlvalues.h"
-#include "exec.h"
+#include "caml/mlvalues.h"
+#include "caml/exec.h"
#ifndef __MINGW32__
#pragma comment(linker , "/entry:headerentry")
on typical input. *)
val sort_uniq : ('a -> 'a -> int) -> 'a list -> 'a list
-(** Same as {!List.sort}, but also remove duplicates. *)
+(** Same as {!List.sort}, but also remove duplicates.
+ @since 4.02.0 *)
val merge : ('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
(** Merge two lists:
operator is not tail-recursive either. *)
val rev_append : 'a list -> 'a list -> 'a list
-(** [List.rev_append l1 l2] reverses [l1] and concatenates it to [l2].
+(** [ListLabels.rev_append l1 l2] reverses [l1] and concatenates it to [l2].
This is equivalent to {!ListLabels.rev}[ l1 @ l2], but [rev_append] is
tail-recursive and more efficient. *)
val iter : f:('a -> unit) -> 'a list -> unit
-(** [List.iter f [a1; ...; an]] applies function [f] in turn to
+(** [ListLabels.iter f [a1; ...; an]] applies function [f] in turn to
[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
+(** Same as {!ListLabels.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],
+(** [ListLabels.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
+(** Same as {!ListLabels.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_map f l] gives the same result as
{!ListLabels.rev}[ (]{!ListLabels.map}[ f l)], but is tail-recursive and
more efficient. *)
val fold_left : f:('a -> 'b -> 'a) -> init:'a -> 'b list -> 'a
-(** [List.fold_left f a [b1; ...; bn]] is
+(** [ListLabels.fold_left f a [b1; ...; bn]] is
[f (... (f (f a b1) b2) ...) bn]. *)
val fold_right : f:('a -> 'b -> 'b) -> 'a list -> init:'b -> 'b
-(** [List.fold_right f [a1; ...; an] b] is
+(** [ListLabels.fold_right f [a1; ...; an] b] is
[f a1 (f a2 (... (f an b) ...))]. Not tail-recursive. *)
val iter2 : f:('a -> 'b -> unit) -> 'a list -> 'b list -> unit
-(** [List.iter2 f [a1; ...; an] [b1; ...; bn]] calls in turn
+(** [ListLabels.iter2 f [a1; ...; an] [b1; ...; bn]] calls in turn
[f a1 b1; ...; f an bn].
Raise [Invalid_argument] if the two lists have
different lengths. *)
val map2 : f:('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
-(** [List.map2 f [a1; ...; an] [b1; ...; bn]] is
+(** [ListLabels.map2 f [a1; ...; an] [b1; ...; bn]] is
[[f a1 b1; ...; f an bn]].
Raise [Invalid_argument] if the two lists have
different lengths. Not tail-recursive. *)
val rev_map2 : f:('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
-(** [List.rev_map2 f l1 l2] gives the same result as
+(** [ListLabels.rev_map2 f l1 l2] gives the same result as
{!ListLabels.rev}[ (]{!ListLabels.map2}[ f l1 l2)], but is tail-recursive and
more efficient. *)
val fold_left2 :
f:('a -> 'b -> 'c -> 'a) -> init:'a -> 'b list -> 'c list -> 'a
-(** [List.fold_left2 f a [b1; ...; bn] [c1; ...; cn]] is
+(** [ListLabels.fold_left2 f a [b1; ...; bn] [c1; ...; cn]] is
[f (... (f (f a b1 c1) b2 c2) ...) bn cn].
Raise [Invalid_argument] if the two lists have
different lengths. *)
val fold_right2 :
f:('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> init:'c -> 'c
-(** [List.fold_right2 f [a1; ...; an] [b1; ...; bn] c] is
+(** [ListLabels.fold_right2 f [a1; ...; an] [b1; ...; bn] c] is
[f a1 b1 (f a2 b2 (... (f an bn c) ...))].
Raise [Invalid_argument] if the two lists have
different lengths. Not tail-recursive. *)
a complete specification). For example,
{!Pervasives.compare} is a suitable comparison function.
The resulting list is sorted in increasing order.
- [List.sort] is guaranteed to run in constant heap space
+ [ListLabels.sort] is guaranteed to run in constant heap space
(in addition to the size of the result list) and logarithmic
stack space.
*)
val fast_sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list
-(** Same as {!List.sort} or {!List.stable_sort}, whichever is faster
- on typical input. *)
+(** Same as {!ListLabels.sort} or {!ListLabels.stable_sort}, whichever is
+ faster on typical input. *)
val merge : cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
(** Merge two lists:
(** [Marshal.to_bytes v flags] returns a byte sequence containing
the representation of [v].
The [flags] argument has the same meaning as for
- {!Marshal.to_channel}. *)
+ {!Marshal.to_channel}.
+ @since 4.02.0 *)
external to_string :
'a -> extern_flags list -> string = "caml_output_value_to_string"
like {!Marshal.from_channel} does, except that the byte
representation is not read from a channel, but taken from
the byte sequence [buff], starting at position [ofs].
- The byte sequence is not mutated. *)
+ The byte sequence is not mutated.
+ @since 4.02.0 *)
val from_string : string -> int -> 'a
(** Same as [from_bytes] but take a string as argument instead of a
let unmarshal str pos =
(Marshal.from_bytes str pos, pos + Marshal.total_size str pos)
+let first_non_constant_constructor_tag = 0
+let last_non_constant_constructor_tag = 245
+
let lazy_tag = 246
let closure_tag = 247
let object_tag = 248
external add_offset : t -> Int32.t -> t = "caml_obj_add_offset"
(* @since 3.12.0 *)
+val first_non_constant_constructor_tag : int
+val last_non_constant_constructor_tag : int
+
val lazy_tag : int
val closure_tag : int
val object_tag : int
external __LOC__ : string = "%loc_LOC"
(** [__LOC__] returns the location at which this expression appears in
the file currently being parsed by the compiler, with the standard
- error format of OCaml: "File %S, line %d, characters %d-%d" *)
+ error format of OCaml: "File %S, line %d, characters %d-%d".
+ @since 4.02.0
+ *)
external __FILE__ : string = "%loc_FILE"
(** [__FILE__] returns the name of the file currently being
- parsed by the compiler. *)
+ parsed by the compiler.
+ @since 4.02.0
+*)
external __LINE__ : int = "%loc_LINE"
(** [__LINE__] returns the line number at which this expression
- appears in the file currently being parsed by the compiler. *)
+ appears in the file currently being parsed by the compiler.
+ @since 4.02.0
+ *)
external __MODULE__ : string = "%loc_MODULE"
(** [__MODULE__] returns the module name of the file being
- parsed by the compiler. *)
+ parsed by the compiler.
+ @since 4.02.0
+ *)
external __POS__ : string * int * int * int = "%loc_POS"
(** [__POS__] returns a tuple [(file,lnum,cnum,enum)], corresponding
to the location at which this expression appears in the file
currently being parsed by the compiler. [file] is the current
filename, [lnum] the line number, [cnum] the character position in
- the line and [enum] the last character position in the line. *)
+ the line and [enum] the last character position in the line.
+ @since 4.02.0
+ *)
external __LOC_OF__ : 'a -> string * 'a = "%loc_LOC"
(** [__LOC_OF__ expr] returns a pair [(loc, expr)] where [loc] is the
location of [expr] in the file currently being parsed by the
compiler, with the standard error format of OCaml: "File %S, line
- %d, characters %d-%d" *)
+ %d, characters %d-%d".
+ @since 4.02.0
+ *)
external __LINE_OF__ : 'a -> int * 'a = "%loc_LINE"
(** [__LINE__ expr] returns a pair [(line, expr)], where [line] is the
line number at which the expression [expr] appears in the file
- currently being parsed by the compiler. *)
+ currently being parsed by the compiler.
+ @since 4.02.0
+ *)
external __POS_OF__ : 'a -> (string * int * int * int) * 'a = "%loc_POS"
-(** [__POS_OF__ expr] returns a pair [(expr,loc)], where [loc] is a
+(** [__POS_OF__ expr] returns a pair [(loc,expr)], where [loc] is a
tuple [(file,lnum,cnum,enum)] corresponding to the location at
which the expression [expr] appears in the file currently being
parsed by the compiler. [file] is the current filename, [lnum] the
line number, [cnum] the character position in the line and [enum]
- the last character position in the line. *)
+ the last character position in the line.
+ @since 4.02.0
+ *)
(** {6 Composition operators} *)
(** Print a string on standard output. *)
val print_bytes : bytes -> unit
-(** Print a byte sequence on standard output. *)
+(** Print a byte sequence on standard output.
+ @since 4.02.0 *)
val print_int : int -> unit
(** Print an integer, in decimal, on standard output. *)
(** Print a string on standard error. *)
val prerr_bytes : bytes -> unit
-(** Print a byte sequence on standard error. *)
+(** Print a byte sequence on standard error.
+ @since 4.02.0 *)
val prerr_int : int -> unit
(** Print an integer, in decimal, on standard error. *)
(** Write the string on the given output channel. *)
val output_bytes : out_channel -> bytes -> unit
-(** Write the byte sequence on the given output channel. *)
+(** Write the byte sequence on the given output channel.
+ @since 4.02.0 *)
val output : out_channel -> bytes -> int -> int -> unit
(** [output oc buf pos len] writes [len] characters from byte sequence [buf],
val output_substring : out_channel -> string -> int -> int -> unit
(** Same as [output] but take a string as argument instead of
- a byte sequence. *)
+ a byte sequence.
+ @since 4.02.0 *)
val output_byte : out_channel -> int -> unit
(** Write one 8-bit integer (as the single character with that code)
(** [really_input_string ic len] reads [len] characters from channel [ic]
and returns them in a new string.
Raise [End_of_file] if the end of file is reached before [len]
- characters have been read. *)
+ characters have been read.
+ @since 4.02.0 *)
val input_byte : in_channel -> int
(** Same as {!Pervasives.input_char}, but return the 8-bit integer representing
{!Pervasives.at_exit} have already been called. Because of this you must
make sure any output channel [fn] writes on is flushed.
- If [fn] raises an exception, it is ignored.
+ Also note that exceptions raised by user code in the interactive toplevel
+ are not passed to this function as they are caught by the toplevel itself.
+
+ If [fn] raises an exception, both the exceptions passed to [fn] and raised
+ by [fn] will be printed with their respective backtrace.
@since 4.02.0
*)
debug information ([-g])
- the program is a bytecode program that has not been linked with
debug information enabled ([ocamlc -g])
+
+ @since 4.02.0
*)
type location = {
elements are equal, then they represent the same source location
(the converse is not necessarily true in presence of inlining,
for example).
+
+ @since 4.02.0
*)
val raw_backtrace_length : raw_backtrace -> int
(** Formatted output functions with continuations. *)
val kfprintf : (out_channel -> 'a) -> out_channel ->
- ('b, out_channel, unit, 'a) format4 -> 'b;;
+ ('b, out_channel, unit, 'a) format4 -> 'b
(** Same as [fprintf], but instead of returning immediately,
passes the out channel to its first argument at the end of printing.
@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;;
+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.
@since 3.09.0
*)
val kbprintf : (Buffer.t -> 'a) -> Buffer.t ->
- ('b, Buffer.t, unit, 'a) format4 -> 'b;;
+ ('b, Buffer.t, unit, 'a) format4 -> 'b
(** Same as [bprintf], but instead of returning immediately,
passes the buffer to its first argument at the end of printing.
@since 3.10.0
| Flush rest -> take_format_readers k rest
| String_literal (_, rest) -> take_format_readers k rest
| Char_literal (_, rest) -> take_format_readers k rest
+ | Custom (_, _, rest) -> take_format_readers k rest
| Scan_char_set (_, _, rest) -> take_format_readers k rest
| Scan_get_counter (_, rest) -> take_format_readers k rest
| Bool_ty rest -> take_fmtty_format_readers k rest fmt
| Alpha_ty rest -> take_fmtty_format_readers k rest fmt
| Theta_ty rest -> take_fmtty_format_readers k rest fmt
+ | Any_ty rest -> take_fmtty_format_readers k rest fmt
| Format_arg_ty (_, rest) -> take_fmtty_format_readers k rest fmt
| End_of_fmtty -> take_format_readers k fmt
| Format_subst_ty (ty1, ty2, rest) ->
let scan width _ ib = scan_string (Some stp) width ib in
let str_rest = String_literal (str, rest) in
pad_prec_scanf ib str_rest readers pad No_precision scan token_string
+ | String (pad, Formatting_gen (Open_tag (Format (fmt', _)), rest)) ->
+ let scan width _ ib = scan_string (Some '{') width ib in
+ pad_prec_scanf ib (concat_fmt fmt' rest) readers pad No_precision scan token_string
+ | String (pad, Formatting_gen (Open_box (Format (fmt', _)), rest)) ->
+ let scan width _ ib = scan_string (Some '[') width ib in
+ pad_prec_scanf ib (concat_fmt fmt' rest) readers pad No_precision scan token_string
| String (pad, rest) ->
let scan width _ ib = scan_string None width ib in
pad_prec_scanf ib rest readers pad No_precision scan token_string
invalid_arg "scanf: bad conversion \"%a\""
| Theta _ ->
invalid_arg "scanf: bad conversion \"%t\""
+ | Custom _ ->
+ invalid_arg "scanf: bad conversion \"%?\" (custom converter)"
| Reader fmt_rest ->
let Cons (reader, readers_rest) = readers in
let x = reader ib in
module Scanning : sig
-type in_channel;;
+type in_channel
(** 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.
@since 3.12.0
*)
-type scanbuf = in_channel;;
+type scanbuf = in_channel
(** The type of scanning buffers. A scanning buffer is the source from which a
formatted input function gets characters. The scanning buffer holds the
current state of the scan, plus a function to get the next char from the
character yet to be read.
*)
-val stdin : in_channel;;
+val stdin : in_channel
(** The standard input notion for the [Scanf] module.
[Scanning.stdin] is the formatted input channel attached to
[Pervasives.stdin].
@since 3.12.0
*)
-type file_name = string;;
+type file_name = string
(** A convenient alias to designate a file name.
@since 4.00.0
*)
-val open_in : file_name -> in_channel;;
+val open_in : file_name -> in_channel
(** [Scanning.open_in fname] returns a formatted input channel for bufferized
reading in text mode from file [fname].
@since 3.12.0
*)
-val open_in_bin : file_name -> in_channel;;
+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;;
+val close_in : in_channel -> unit
(** Closes the [Pervasives.in_channel] associated with the given
[Scanning.in_channel] formatted input channel.
@since 3.12.0
*)
-val from_file : file_name -> in_channel;;
+val from_file : file_name -> in_channel
(** An alias for [open_in] above. *)
-val from_file_bin : string -> in_channel;;
+
+val from_file_bin : string -> in_channel
(** An alias for [open_in_bin] above. *)
-val from_string : string -> in_channel;;
+val from_string : string -> in_channel
(** [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.
*)
-val from_function : (unit -> char) -> in_channel;;
+val from_function : (unit -> char) -> in_channel
(** [Scanning.from_function f] returns a formatted input channel with the
given function as its reading method.
end-of-input condition by raising the exception [End_of_file].
*)
-val from_channel : Pervasives.in_channel -> in_channel;;
+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.
*)
-val end_of_input : in_channel -> bool;;
+val end_of_input : in_channel -> bool
(** [Scanning.end_of_input ic] tests the end-of-input condition of the given
formatted input channel.
*)
-val beginning_of_input : in_channel -> bool;;
+val beginning_of_input : in_channel -> bool
(** [Scanning.beginning_of_input ic] tests the beginning of input condition of
the given formatted input channel.
*)
-val name_of_input : in_channel -> string;;
+val name_of_input : in_channel -> string
(** [Scanning.name_of_input ic] returns the name of the character source
for the formatted input channel [ic].
@since 3.09.0
*)
-val stdib : in_channel;;
+val stdib : in_channel
(** A deprecated alias for [Scanning.stdin], the scanning buffer reading from
[Pervasives.stdin].
*)
-end;;
+end
(** {6 Type of formatted input functions} *)
type ('a, 'b, 'c, 'd) scanner =
- ('a, Scanning.in_channel, 'b, 'c, 'a -> 'd, 'd) format6 -> 'c;;
+ ('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
@since 3.10.0
*)
-exception Scan_failure of string;;
+exception Scan_failure of string
(** The exception that formatted input functions raise when the input cannot
be read according to the given format.
*)
(** {6 The general formatted input function} *)
-val bscanf : Scanning.in_channel -> ('a, 'b, 'c, 'd) scanner;;
+val bscanf : Scanning.in_channel -> ('a, 'b, 'c, 'd) scanner
(** [bscanf ic fmt r1 ... rN f] reads arguments for the function [f], from the
formatted input channel [ic], according to the format string [fmt], and
applies [f] to these values.
(** {6 Specialised formatted input functions} *)
-val fscanf : Pervasives.in_channel -> ('a, 'b, 'c, 'd) scanner;;
+val fscanf : Pervasives.in_channel -> ('a, 'b, 'c, 'd) scanner
(** Same as {!Scanf.bscanf}, but reads from the given regular input channel.
Warning: since all formatted input functions operate from a {e formatted
scanning from the same regular input channel.
*)
-val sscanf : string -> ('a, 'b, 'c, 'd) scanner;;
+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;;
+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].
*)
val kscanf :
Scanning.in_channel -> (Scanning.in_channel -> exn -> 'd) ->
- ('a, 'b, 'c, 'd) scanner;;
+ ('a, 'b, 'c, 'd) scanner
(** Same as {!Scanf.bscanf}, but takes an additional function argument
[ef] that is called in case of error: if the scanning process or
some conversion fails, the scanning function aborts and calls the
val ksscanf :
string -> (Scanning.in_channel -> exn -> 'd) ->
('a, 'b, 'c, 'd) scanner
-(** Same as {!Scanf.kscanf} but reads from the given string. *)
+(** Same as {!Scanf.kscanf} but reads from the given string.
+ @since 4.02.0 *)
val kfscanf :
Pervasives.in_channel -> (Scanning.in_channel -> exn -> 'd) ->
('a, 'b, 'c, 'd) scanner
-(** Same as {!Scanf.kscanf}, but reads from the given regular input channel. *)
+(** Same as {!Scanf.kscanf}, but reads from the given regular input channel.
+ @since 4.02.0 *)
(** {6 Reading format strings from input} *)
val bscanf_format :
Scanning.in_channel -> ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
- (('a, 'b, 'c, 'd, 'e, 'f) format6 -> 'g) -> 'g;;
+ (('a, 'b, 'c, 'd, 'e, 'f) format6 -> 'g) -> 'g
(** [bscanf_format ic fmt f] reads a format string token from the formatted
input channel [ic], according to the given format string [fmt], and
applies [f] to the resulting format string value.
val sscanf_format :
string -> ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
- (('a, 'b, 'c, 'd, 'e, 'f) format6 -> 'g) -> 'g;;
+ (('a, 'b, 'c, 'd, 'e, 'f) format6 -> 'g) -> 'g
(** Same as {!Scanf.bscanf_format}, but reads from the given string.
@since 3.09.0
*)
val format_from_string :
string ->
- ('a, 'b, 'c, 'd, 'e, 'f) format6 -> ('a, 'b, 'c, 'd, 'e, 'f) format6;;
+ ('a, 'b, 'c, 'd, 'e, 'f) format6 -> ('a, 'b, 'c, 'd, 'e, 'f) format6
(** [format_from_string s fmt] converts a string argument to a format string,
according to the given format string [fmt].
Raise [Scan_failure] if [s], considered as a format string, does not
@since 3.10.0
*)
-val unescaped : string -> string;;
+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
(** Return the stream of the characters of the string parameter. *)
val of_bytes : bytes -> char t
-(** Return the stream of the characters of the bytes parameter. *)
+(** Return the stream of the characters of the bytes parameter.
+ @since 4.02.0 *)
val of_channel : in_channel -> char t
(** Return the stream of the characters read from the input channel. *)
@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) \
+ $(OCAMLOPT) $(ADD_COMPFLAGS) $(ADD_OPTCOMPFLAGS) \
+ -o program.native$(EXE) $(O_FILES) \
$(CMXA_FILES) $(CMX_FILES) $(ADD_CMX_FILES) \
$(MAIN_MODULE).cmx; \
fi
default:
@for file in *.ml; do \
- $(OCAML) $(TOPFLAGS) <$$file 2>&1 \
+ TERM=dumb $(OCAML) $(TOPFLAGS) <$$file 2>&1 \
| grep -v '^ OCaml version' > $$file.result; \
if [ -f $$file.principal.reference ]; then \
- $(OCAML) $(TOPFLAGS) -principal <$$file 2>&1 \
+ TERM=dumb $(OCAML) $(TOPFLAGS) -principal <$$file 2>&1 \
| grep -v '^ OCaml version' > $$file.principal.result; \
fi; \
done
#include <stdlib.h>
#include <string.h>
-#include "../../../byterun/config.h"
+#include "../../../byterun/caml/config.h"
#define FMT ARCH_INTNAT_PRINTF_FORMAT
void caml_ml_array_bound_error(void)
/* */
/***********************************************************************/
-#if defined(SYS_solaris) || defined(SYS_elf)
+#if defined(SYS_solaris) || defined(SYS_linux)
#define Call_gen_code call_gen_code
#define Caml_c_call caml_c_call
#else
/* */
/***********************************************************************/
-#include "mlvalues.h"
+#include "caml/mlvalues.h"
#include "stdio.h"
value manyargs(value a, value b, value c, value d, value e, value f,
end
let _ =
+ printf "1 int\n"; WithInt.do_test 1 (fun x -> x / 1)(fun x -> x mod 1);
printf "2 int\n"; WithInt.do_test 2 (fun x -> x / 2)(fun x -> x mod 2);
printf "3 int\n"; WithInt.do_test 3 (fun x -> x / 3)(fun x -> x mod 3);
printf "4 int\n"; WithInt.do_test 4 (fun x -> x / 4)(fun x -> x mod 4);
printf "55 int\n"; WithInt.do_test 55 (fun x -> x / 55)(fun x -> x mod 55);
printf "125 int\n"; WithInt.do_test 125 (fun x -> x / 125)(fun x -> x mod 125);
printf "625 int\n"; WithInt.do_test 625 (fun x -> x / 625)(fun x -> x mod 625);
+ printf "-1 int\n"; WithInt.do_test (-1) (fun x -> x / (-1))(fun x -> x mod (-1));
printf "-2 int\n"; WithInt.do_test (-2) (fun x -> x / (-2))(fun x -> x mod (-2));
printf "-3 int\n"; WithInt.do_test (-3) (fun x -> x / (-3))(fun x -> x mod (-3));
+ printf "1 nat\n"; WithNat.do_test 1 (fun x -> Nativeint.div x 1n)(fun x -> Nativeint.rem x 1n);
printf "2 nat\n"; WithNat.do_test 2 (fun x -> Nativeint.div x 2n)(fun x -> Nativeint.rem x 2n);
printf "3 nat\n"; WithNat.do_test 3 (fun x -> Nativeint.div x 3n)(fun x -> Nativeint.rem x 3n);
printf "4 nat\n"; WithNat.do_test 4 (fun x -> Nativeint.div x 4n)(fun x -> Nativeint.rem x 4n);
printf "55 nat\n"; WithNat.do_test 55 (fun x -> Nativeint.div x 55n)(fun x -> Nativeint.rem x 55n);
printf "125 nat\n"; WithNat.do_test 125 (fun x -> Nativeint.div x 125n)(fun x -> Nativeint.rem x 125n);
printf "625 nat\n"; WithNat.do_test 625 (fun x -> Nativeint.div x 625n)(fun x -> Nativeint.rem x 625n);
+ printf "-1 nat\n"; WithNat.do_test (-1) (fun x -> Nativeint.div x (-1n))(fun x -> Nativeint.rem x (-1n));
printf "-2 nat\n"; WithNat.do_test (-2) (fun x -> Nativeint.div x (-2n))(fun x -> Nativeint.rem x (-2n));
printf "-3 nat\n"; WithNat.do_test (-3) (fun x -> Nativeint.div x (-3n))(fun x -> Nativeint.rem x (-3n));
if !error then printf "TEST FAILED.\n" else printf "Test passed.\n"
+(* PR#6879 *)
+let f n = assert (1 mod n = 0)
+let () = f 1
+1 int
2 int
3 int
4 int
55 int
125 int
625 int
+-1 int
-2 int
-3 int
+1 nat
2 nat
3 nat
4 nat
55 nat
125 nat
625 nat
+-1 nat
-2 nat
-3 nat
Test passed.
run-byte: common
@printf " ... testing 'bytecode':"
@$(OCAMLC) $(COMPFLAGS) -c tcallback.ml
- @$(OCAMLC) $(COMPFLAGS) -o ./program -custom unix.cma \
+ @$(OCAMLC) $(COMPFLAGS) -o ./program$(EXE) -custom unix.cma \
callbackprim.$(O) tcallback.cmo
- @./program >bytecode.result
+ @./program$(EXE) >bytecode.result
@$(DIFF) reference bytecode.result \
&& echo " => passed" || echo " => failed"
@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; \
+ $(OCAMLOPT) $(COMPFLAGS) -o ./program$(EXE) unix.cmxa \
+ callbackprim.$(O) tcallback.cmx; \
+ ./program$(EXE) >native.result; \
$(DIFF) reference native.result \
&& echo " => passed" || echo " => failed"; \
fi
.PHONY: clean
clean: defaultclean
- @rm -f *.result ./program
+ @rm -f *.result ./program$(EXE)
include $(BASEDIR)/makefiles/Makefile.common
/* */
/***********************************************************************/
-#include "mlvalues.h"
-#include "memory.h"
-#include "callback.h"
+#include "caml/mlvalues.h"
+#include "caml/memory.h"
+#include "caml/callback.h"
value mycallback1(value fun, value arg)
{
$(MAKE) run
.PHONY: compile
-compile: caml
- @$(OCAMLC) -ccopt -I -ccopt . cmstub.c
- @$(OCAMLC) -ccopt -I -ccopt . cmmain.c
+compile:
+ @$(OCAMLC) -ccopt -I -ccopt $(CTOPDIR)/byterun cmstub.c
+ @$(OCAMLC) -ccopt -I -ccopt $(CTOPDIR)/byterun cmmain.c
@$(OCAMLC) -c cmcaml.ml
@$(OCAMLC) -custom -o program cmstub.$(O) cmcaml.cmo cmmain.$(O)
-caml:
- @mkdir -p caml || :
- @cp -f $(TOPDIR)/byterun/*.h caml/
-
.PHONY: run
run:
@printf " ... testing 'cmmain':"
.PHONY: clean
clean: defaultclean
@rm -f *.result program
- @rm -rf caml
include $(BASEDIR)/makefiles/Makefile.common
--- /dev/null
+BASEDIR=../..
+MODULES=
+MAIN_MODULE=float_subst_boxed_number
+ADD_OPTCOMPFLAGS=-inline 20
+
+include $(BASEDIR)/makefiles/Makefile.one
+include $(BASEDIR)/makefiles/Makefile.common
--- /dev/null
+module PR_6686 = struct
+ type t =
+ | A of float
+ | B of (int * int)
+
+ let rec foo = function
+ | A x -> x
+ | B (x, y) -> float x +. float y
+
+ let (_ : float) = foo (A 4.)
+end
+
+module PR_6770 = struct
+ type t =
+ | Constant of float
+ | Exponent of (float * float)
+
+ let to_string = function
+ | Exponent (_b, _e) ->
+ ignore _b;
+ ignore _e;
+ ""
+ | Constant _ -> ""
+
+ let _ = to_string (Constant 4.)
+end
/* For testing global root registration */
-#include "mlvalues.h"
-#include "memory.h"
-#include "alloc.h"
-#include "gc.h"
+#include "caml/mlvalues.h"
+#include "caml/memory.h"
+#include "caml/alloc.h"
+#include "caml/gc.h"
struct block { value header; value v; };
/***********************************************************************/
#include <stdio.h>
-#include <mlvalues.h>
+#include <caml/mlvalues.h>
#include <bigarray.h>
extern void filltab_(void);
fi
.PHONY: compile
-compile: caml
+compile:
@$(OCAMLC) -c registry.ml
@for file in stub*.c; do \
- $(OCAMLC) -ccopt -I -ccopt . -c $$file; \
+ $(OCAMLC) -ccopt -I -ccopt $(CTOPDIR)/byterun/caml -c $$file; \
$(OCAMLMKLIB) -o `echo $$file | sed -e 's/stub/plug/' -e 's/\.c//'` \
`basename $$file c`$(O); \
done
@$(OCAMLC) -o custom$(EXE) -custom -linkall registry.cmo plug2.cma \
plug1.cma -I .
-caml:
- @mkdir -p caml || :
- @cp -f $(TOPDIR)/byterun/*.h caml/
-
.PHONY: run
run:
@printf " ... testing 'main'"
.PHONY: clean
clean: defaultclean
@rm -f main static custom custom.exe *.result marshal.data
- @rm -rf caml
include $(BASEDIR)/makefiles/Makefile.common
mylib.cmxa: plugin.cmx plugin2.cmx
@$(OCAMLOPT) $(COMPFLAGS) -a -o mylib.cmxa plugin.cmx plugin2.cmx
-factorial.$(O): factorial.c caml
- @$(OCAMLOPT) -c -ccopt "$(SHAREDCCCOMPOPTS)" -ccopt -I -ccopt . \
+factorial.$(O): factorial.c
+ @$(OCAMLOPT) -c -ccopt "$(SHAREDCCCOMPOPTS)" -ccopt -I \
+ -ccopt $(TOPDIR)/byterun/caml \
factorial.c
-caml:
- @mkdir -p caml || :
- @cp $(TOPDIR)/byterun/*.h caml/
-
.PHONY: promote
promote:
@cp result reference
@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 $(BASEDIR)/makefiles/Makefile.common
--- /dev/null
+let f = Format.sprintf "[%i]";;
+print_endline (f 1);;
+print_endline (f 2);;
+
+let f = Format.asprintf "[%i]";;
+print_endline (f 1);;
+print_endline (f 2);;
--- /dev/null
+[1]
+[2]
+[1]
+[2]
+
+All tests succeeded.
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
+ try file_data "../../LICENSE" with Sys_error _ -> string_data in
printf "-- Strings, generic interface\n%!";
TS1.test d;
printf "-- Strings, functorial interface\n%!";
/* */
/***********************************************************************/
-#include <mlvalues.h>
-#include <intext.h>
+#include <caml/mlvalues.h>
+#include <caml/intext.h>
value marshal_to_block(value vbuf, value vlen, value v, value vflags)
{
sscanf "Hello\nWorld!" "%s\n%s%!" (fun s1 s2 ->
s1 = "Hello" && s2 = "World!") &&
sscanf "Hello\nWorld!" "%s\n%s@!%!" (fun s1 s2 ->
- s1 = "Hello" && s2 = "World")
+ s1 = "Hello" && s2 = "World") &&
+ (* PR#6791 *)
+ sscanf "Hello{foo}" "%s@{%s" (fun s1 s2 ->
+ s1 = "Hello" && s2 = "foo}") &&
+ sscanf "Hello[foo]" "%s@[%s" (fun s1 s2 ->
+ s1 = "Hello" && s2 = "foo]")
;;
test (test52 ())
--- /dev/null
+(*************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Damien Doligez, Jane Street Group, LLC *)
+(* *)
+(* Copyright 2015 Institut National de 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 12345;;
+
+let size = 1000;;
+
+type block = int array;;
+
+type objdata =
+ | Present of block
+ | Absent of int (* GC count at time of erase *)
+;;
+
+type bunch = {
+ objs : objdata array;
+ wp : block Weak.t;
+};;
+
+let data =
+ Array.init size (fun i ->
+ let n = 1 + Random.int size in
+ {
+ objs = Array.make n (Absent 0);
+ wp = Weak.create n;
+ }
+ )
+;;
+
+let gccount () = (Gc.quick_stat ()).Gc.major_collections;;
+
+(* Check the correctness condition on the data at (i,j):
+ 1. if the block is present, the weak pointer must be full
+ 2. if the block was removed at GC n, and the weak pointer is still
+ full, then the current GC must be at most n+1.
+
+ Then modify the data in one of the following ways:
+ 1. if the block and weak pointer are absent, fill them
+ 2. if the block and weak pointer are present, randomly erase the block
+*)
+let check_and_change i j =
+ let gc1 = gccount () in
+ match data.(i).objs.(j), Weak.check data.(i).wp j with
+ | Present x, false -> assert false
+ | Absent n, true -> assert (gc1 <= n+1)
+ | Absent _, false ->
+ let x = Array.make (1 + Random.int 10) 42 in
+ data.(i).objs.(j) <- Present x;
+ Weak.set data.(i).wp j (Some x);
+ | Present _, true ->
+ if Random.int 10 = 0 then begin
+ data.(i).objs.(j) <- Absent gc1;
+ let gc2 = gccount () in
+ if gc1 <> gc2 then data.(i).objs.(j) <- Absent gc2;
+ end
+;;
+
+let dummy = ref [||];;
+
+while gccount () < 20 do
+ dummy := Array.make (Random.int 300) 0;
+ let i = Random.int size in
+ let j = Random.int (Array.length data.(i).objs) in
+ check_and_change i j;
+done
assert_bound_check3 caml_bigstring_set_32 empty_s 0 0l;
assert_bound_check3 caml_bigstring_set_64 empty_s 0 0L
+external bswap16: int -> int = "%bswap16"
+external bswap32: int32 -> int32 = "%bswap_int32"
+external bswap64: int64 -> int64 = "%bswap_int64"
+let swap16 x =
+ if Sys.big_endian
+ then bswap16 x
+ else x
+
+let swap32 x =
+ if Sys.big_endian
+ then bswap32 x
+ else x
+
+let swap64 x =
+ if Sys.big_endian
+ then bswap64 x
+ else x
let () =
- caml_bigstring_set_16 s 0 0x1234;
+ caml_bigstring_set_16 s 0 (swap16 0x1234);
Printf.printf "%x %x %x\n%!"
- (caml_bigstring_get_16 s 0)
- (caml_bigstring_get_16 s 1)
- (caml_bigstring_get_16 s 2);
- caml_bigstring_set_16 s 0 0xFEDC;
+ (swap16 (caml_bigstring_get_16 s 0))
+ (swap16 (caml_bigstring_get_16 s 1))
+ (swap16 (caml_bigstring_get_16 s 2));
+ caml_bigstring_set_16 s 0 (swap16 0xFEDC);
Printf.printf "%x %x %x\n%!"
- (caml_bigstring_get_16 s 0)
- (caml_bigstring_get_16 s 1)
- (caml_bigstring_get_16 s 2)
+ (swap16 (caml_bigstring_get_16 s 0))
+ (swap16 (caml_bigstring_get_16 s 1))
+ (swap16 (caml_bigstring_get_16 s 2))
let () =
- caml_bigstring_set_32 s 0 0x12345678l;
+ caml_bigstring_set_32 s 0 (swap32 0x12345678l);
Printf.printf "%lx %lx %lx\n%!"
- (caml_bigstring_get_32 s 0)
- (caml_bigstring_get_32 s 1)
- (caml_bigstring_get_32 s 2);
- caml_bigstring_set_32 s 0 0xFEDCBA09l;
+ (swap32 (caml_bigstring_get_32 s 0))
+ (swap32 (caml_bigstring_get_32 s 1))
+ (swap32 (caml_bigstring_get_32 s 2));
+ caml_bigstring_set_32 s 0 (swap32 0xFEDCBA09l);
Printf.printf "%lx %lx %lx\n%!"
- (caml_bigstring_get_32 s 0)
- (caml_bigstring_get_32 s 1)
- (caml_bigstring_get_32 s 2)
+ (swap32 (caml_bigstring_get_32 s 0))
+ (swap32 (caml_bigstring_get_32 s 1))
+ (swap32 (caml_bigstring_get_32 s 2))
let () =
- caml_bigstring_set_64 s 0 0x1234567890ABCDEFL;
+ caml_bigstring_set_64 s 0 (swap64 0x1234567890ABCDEFL);
Printf.printf "%Lx %Lx %Lx\n%!"
- (caml_bigstring_get_64 s 0)
- (caml_bigstring_get_64 s 1)
- (caml_bigstring_get_64 s 2);
- caml_bigstring_set_64 s 0 0xFEDCBA0987654321L;
+ (swap64 (caml_bigstring_get_64 s 0))
+ (swap64 (caml_bigstring_get_64 s 1))
+ (swap64 (caml_bigstring_get_64 s 2));
+ caml_bigstring_set_64 s 0 (swap64 0xFEDCBA0987654321L);
Printf.printf "%Lx %Lx %Lx\n%!"
- (caml_bigstring_get_64 s 0)
- (caml_bigstring_get_64 s 1)
- (caml_bigstring_get_64 s 2)
+ (swap64 (caml_bigstring_get_64 s 0))
+ (swap64 (caml_bigstring_get_64 s 1))
+ (swap64 (caml_bigstring_get_64 s 2))
assert_bound_check3 caml_string_set_32 empty_s 0 0l;
assert_bound_check3 caml_string_set_64 empty_s 0 0L
+external bswap16: int -> int = "%bswap16"
+external bswap32: int32 -> int32 = "%bswap_int32"
+external bswap64: int64 -> int64 = "%bswap_int64"
+let swap16 x =
+ if Sys.big_endian
+ then bswap16 x
+ else x
+
+let swap32 x =
+ if Sys.big_endian
+ then bswap32 x
+ else x
+
+let swap64 x =
+ if Sys.big_endian
+ then bswap64 x
+ else x
let () =
- caml_string_set_16 s 0 0x1234;
+ caml_string_set_16 s 0 (swap16 0x1234);
Printf.printf "%x %x %x\n%!"
- (caml_string_get_16 s 0)
- (caml_string_get_16 s 1)
- (caml_string_get_16 s 2);
- caml_string_set_16 s 0 0xFEDC;
+ (swap16 (caml_string_get_16 s 0))
+ (swap16 (caml_string_get_16 s 1))
+ (swap16 (caml_string_get_16 s 2));
+ caml_string_set_16 s 0 (swap16 0xFEDC);
Printf.printf "%x %x %x\n%!"
- (caml_string_get_16 s 0)
- (caml_string_get_16 s 1)
- (caml_string_get_16 s 2)
+ (swap16 (caml_string_get_16 s 0))
+ (swap16 (caml_string_get_16 s 1))
+ (swap16 (caml_string_get_16 s 2))
let () =
- caml_string_set_32 s 0 0x12345678l;
+ caml_string_set_32 s 0 (swap32 0x12345678l);
Printf.printf "%lx %lx %lx\n%!"
- (caml_string_get_32 s 0)
- (caml_string_get_32 s 1)
- (caml_string_get_32 s 2);
- caml_string_set_32 s 0 0xFEDCBA09l;
+ (swap32 (caml_string_get_32 s 0))
+ (swap32 (caml_string_get_32 s 1))
+ (swap32 (caml_string_get_32 s 2));
+ caml_string_set_32 s 0 (swap32 0xFEDCBA09l);
Printf.printf "%lx %lx %lx\n%!"
- (caml_string_get_32 s 0)
- (caml_string_get_32 s 1)
- (caml_string_get_32 s 2)
+ (swap32 (caml_string_get_32 s 0))
+ (swap32 (caml_string_get_32 s 1))
+ (swap32 (caml_string_get_32 s 2))
let () =
- caml_string_set_64 s 0 0x1234567890ABCDEFL;
+ caml_string_set_64 s 0 (swap64 0x1234567890ABCDEFL);
Printf.printf "%Lx %Lx %Lx\n%!"
- (caml_string_get_64 s 0)
- (caml_string_get_64 s 1)
- (caml_string_get_64 s 2);
- caml_string_set_64 s 0 0xFEDCBA0987654321L;
+ (swap64 (caml_string_get_64 s 0))
+ (swap64 (caml_string_get_64 s 1))
+ (swap64 (caml_string_get_64 s 2));
+ caml_string_set_64 s 0 (swap64 0xFEDCBA0987654321L);
Printf.printf "%Lx %Lx %Lx\n%!"
- (caml_string_get_64 s 0)
- (caml_string_get_64 s 1)
- (caml_string_get_64 s 2)
+ (swap64 (caml_string_get_64 s 0))
+ (swap64 (caml_string_get_64 s 1))
+ (swap64 (caml_string_get_64 s 2))
type bar += Bar of int (* Error: type is not open *)
^^^^^^^^^^
Error: Cannot extend type definition bar
-# Characters 6-20:
+# Characters 1-20:
type baz = bar = .. (* Error: type kinds don't match *)
- ^^^^^^^^^^^^^^
+ ^^^^^^^^^^^^^^^^^^^
Error: This variant or record definition does not match that of type bar
Their kinds differ.
# type 'a foo = ..
-# Characters 6-32:
+# Characters 1-32:
type ('a, 'b) bar = 'a foo = .. (* Error: arrities do not match *)
- ^^^^^^^^^^^^^^^^^^^^^^^^^^
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This variant or record definition does not match that of type 'a foo
They have different arities.
# type ('a, 'b) foo = ..
-# Characters 6-38:
+# Characters 1-38:
type ('a, 'b) bar = ('a, 'a) foo = .. (* Error: constraints do not match *)
- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This variant or record definition does not match that of type
('a, 'a) foo
Their constraints differ.
Warning 8: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
_
-Matching over values of open types must include
+Matching over values of extensible variant types must include
a wild card pattern in order to be exhaustive.
type foo = ..
type foo += Foo
-# Characters 92-115:
+# Characters 88-115:
type _ t = T : 'a -> 'a s t
- ^^^^^^^^^^^^^^^^^^^^^^^
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: In this definition, a type variable cannot be deduced
from the type parameters.
# * * * Characters 140-141:
module F (S : sig type #'a s end) = struct
^
Error: Syntax error
-# * * * * * Characters 296-374:
- ........['a] c x =
+# * * * * * Characters 290-374:
+ ..class ['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.
-# Characters 83-128:
+# Characters 79-128:
type 'x t = A of 'a constraint 'x = [< `X of 'a ] ;; (* fail *)
- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: In this definition, a type variable cannot be deduced
from the type parameters.
# Characters 36-37:
let A x = A x in
^
Error: Unbound constructor A
-# Characters 4-37:
+# Characters 0-37:
type 'a t = A : 'a -> [< `X of 'a ] t;; (* fail *)
- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: In this definition, a type variable cannot be deduced
from the type parameters.
# type (_, _) eq = Eq : ('a, 'a) eq
# val eq : 'a = <poly>
# val eq : ('a Queue.t, 'b Queue.t) eq = Eq
-# Characters 4-33:
+# Characters 0-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:
+# * * * * Characters 250-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:
^
Error: Syntax error
# * * * * type 'a q = Q
-# Characters 5-36:
+# Characters 0-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:
+# Characters 0-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 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:
+# Characters 0-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.
method virtual add : 'a -> unit
end
# type +'a t = unit constraint 'a = 'b list
-# Characters 4-27:
+# Characters 0-27:
type _ g = G : 'a -> 'a t g;; (* fail *)
- ^^^^^^^^^^^^^^^^^^^^^^^
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: In this definition, a type variable cannot be deduced
from the type parameters.
#
--- /dev/null
+type 'a visit_action
+
+type insert
+
+type 'a local_visit_action
+
+type ('a, 'result, 'visit_action) context =
+ | Local : ('a, ('a * insert) as 'result, 'a local_visit_action) context
+ | Global : ('a, 'a, 'a visit_action) context
+;;
+
+let vexpr (type visit_action) : (_, _, visit_action) context -> _ -> visit_action =
+ function
+ | Local -> fun _ -> raise Exit
+ | Global -> fun _ -> raise Exit
+;;
+
+let vexpr (type visit_action) : ('a, 'result, visit_action) context -> 'a -> visit_action =
+ function
+ | Local -> fun _ -> raise Exit
+ | Global -> fun _ -> raise Exit
+;;
+
+let vexpr (type result) (type visit_action) : (unit, result, visit_action) context -> unit -> visit_action =
+ function
+ | Local -> fun _ -> raise Exit
+ | Global -> fun _ -> raise Exit
+;;
--- /dev/null
+
+# type 'a visit_action
+type insert
+type 'a local_visit_action
+type ('a, 'result, 'visit_action) context =
+ Local : ('a, 'a * insert, 'a local_visit_action) context
+ | Global : ('a, 'a, 'a visit_action) context
+# Characters 133-139:
+ | Global -> fun _ -> raise Exit
+ ^^^^^^
+Error: This pattern matches values of type (ex#1, ex#1, visit_action) context
+ but a pattern was expected which matches values of type
+ (ex#0, ex#0 * insert, visit_action) context
+ Type ex#1 is not compatible with type ex#0
+# Characters 141-147:
+ | Global -> fun _ -> raise Exit
+ ^^^^^^
+Error: This pattern matches values of type (ex#3, ex#3, visit_action) context
+ but a pattern was expected which matches values of type
+ (ex#2, ex#2 * insert, visit_action) context
+ Type ex#3 is not compatible with type ex#2
+# val vexpr : (unit, 'a, 'b) context -> unit -> 'b = <fun>
+#
--- /dev/null
+
+# type 'a visit_action
+type insert
+type 'a local_visit_action
+type ('a, 'result, 'visit_action) context =
+ Local : ('a, 'a * insert, 'a local_visit_action) context
+ | Global : ('a, 'a, 'a visit_action) context
+# Characters 11-162:
+ ..........(type visit_action) : (_, _, visit_action) context -> _ -> visit_action =
+ function
+ | Local -> fun _ -> raise Exit
+ | Global -> fun _ -> raise Exit
+Error: This expression has type (ex#0, ex#0 * insert, 'a) context -> 'b -> 'a
+ but an expression was expected of type
+ (ex#0, ex#0 * insert, 'a) context -> 'b -> 'a
+ The type constructor ex#0 would escape its scope
+# Characters 11-170:
+ ..........(type visit_action) : ('a, 'result, visit_action) context -> 'a -> visit_action =
+ function
+ | Local -> fun _ -> raise Exit
+ | Global -> fun _ -> raise Exit
+Error: This expression has type (a#0, a#0 * insert, 'a) context -> a#0 -> 'a
+ but an expression was expected of type
+ (a#0, a#0 * insert, 'a) context -> a#0 -> 'a
+ The type constructor a#0 would escape its scope
+# val vexpr : (unit, 'a, 'b) context -> unit -> 'b = <fun>
+#
--- /dev/null
+module A = struct
+ type nil = Cstr
+ end
+open A
+;;
+
+type _ s =
+ | Nil : nil s
+ | Cons : 't s -> ('h -> 't) s
+
+type ('stack, 'typ) var =
+ | Head : (('typ -> _) s, 'typ) var
+ | Tail : ('tail s, 'typ) var -> ((_ -> 'tail) s, 'typ) var
+
+type _ lst =
+ | CNil : nil lst
+ | CCons : 'h * ('t lst) -> ('h -> 't) lst
+;;
+
+let rec get_var : type stk ret. (stk s, ret) var -> stk lst -> ret = fun n s ->
+ match n, s with
+ | Head, CCons (h, _) -> h
+ | Tail n', CCons (_, t) -> get_var n' t
+;;
--- /dev/null
+
+# module A : sig type nil = Cstr end
+# type _ s = Nil : A.nil s | Cons : 't s -> ('h -> 't) s
+type ('stack, 'typ) var =
+ Head : (('typ -> 'a) s, 'typ) var
+ | Tail : ('tail s, 'typ) var -> (('b -> 'tail) s, 'typ) var
+type _ lst = CNil : A.nil lst | CCons : 'h * 't lst -> ('h -> 't) lst
+# val get_var : ('stk s, 'ret) var -> 'stk lst -> 'ret = <fun>
+#
end
;;
+module PR6862 = struct
+ class c (Some x) = object method x : int = x end
+ type _ opt = Just : 'a -> 'a opt | Nothing : 'a opt
+ class d (Just x) = object method x : int = x end
+end;;
+
module Existential_escape =
struct
type _ t = C : int -> int t
let f = function A -> 1 | B -> 2
end;;
+module PR6849 = struct
+ type 'a t = Foo : int t
+
+ let f : int -> int = function
+ Foo -> 5
+end;;
+
type _ t = Int : int t ;;
let ky x y = ignore (x = y); x ;;
type 'a v = Foo : t -> t v | Bar : u -> u v
val same_type : 's v * 's v -> bool
end
+# Characters 34-42:
+ class c (Some x) = object method x : int = x end
+ ^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+None
+Characters 139-147:
+ class d (Just x) = object method x : int = x end
+ ^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+Nothing
+module PR6862 :
+ sig
+ class c : int option -> object method x : int end
+ type _ opt = Just : 'a -> 'a opt | Nothing : 'a opt
+ class d : int opt -> object method x : int end
+ end
# Characters 118-119:
let eval (D x) = x
^
^
Error: This pattern matches values of type b
but a pattern was expected which matches values of type a
+# Characters 89-92:
+ Foo -> 5
+ ^^^
+Error: This pattern matches values of type 'a t
+ but a pattern was expected which matches values of type int
# type _ t = Int : int t
# val ky : 'a -> 'a -> 'a = <fun>
# val test : 'a t -> 'a = <fun>
type 'a v = Foo : t -> t v | Bar : u -> u v
val same_type : 's v * 's v -> bool
end
+# Characters 34-42:
+ class c (Some x) = object method x : int = x end
+ ^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+None
+Characters 139-147:
+ class d (Just x) = object method x : int = x end
+ ^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+Nothing
+module PR6862 :
+ sig
+ class c : int option -> object method x : int end
+ type _ opt = Just : 'a -> 'a opt | Nothing : 'a opt
+ class d : int opt -> object method x : int end
+ end
# Characters 118-119:
let eval (D x) = x
^
^
Error: This variant pattern is expected to have type a
The constructor B does not belong to type a
+# Characters 89-92:
+ Foo -> 5
+ ^^^
+Error: This pattern matches values of type 'a t
+ but a pattern was expected which matches values of type int
# type _ t = Int : int t
# val ky : 'a -> 'a -> 'a = <fun>
# val test : 'a t -> 'a = <fun>
let f (Refl : (a T.t, b T.t) eq) = (x :> b)
^^^^^^^^
Error: Type a is not a subtype of b
-# Characters 36-67:
+# Characters 31-67:
type (_, +_) eq = Refl : ('a, 'a) eq
- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: In this GADT definition, the variance of some parameter
cannot be checked
# Characters 115-175:
let f (Refl : (a T.t, b T.t) eq) = (x :> b)
^^^^^^^^
Error: Type a is not a subtype of b
-# Characters 36-67:
+# Characters 31-67:
type (_, +_) eq = Refl : ('a, 'a) eq
- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: In this GADT definition, the variance of some parameter
cannot be checked
# Characters 115-175:
[ `A of 'a ] t t as 'a
should be an instance of
([ `A of 'b t t ] as 'b) t
-# Characters 5-27:
+# Characters 1-27:
type 'a t = [`A of 'a t t];; (* fails *)
- ^^^^^^^^^^^^^^^^^^^^^^
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: In the definition of t, type 'a t t should be 'a t
# type 'a t = [ `A of 'a t t ] constraint 'a = 'a t
# type 'a t = [ `A of 'a t ] constraint 'a = 'a t
# type 'a t = 'a constraint 'a = [ `A of 'a ]
-# Characters 47-52:
+# Characters 43-52:
type 'a v = [`A of u v] constraint 'a = t and t = u and u = t;; (* fails *)
- ^^^^^
+ ^^^^^^^^^
Error: The type abbreviation t is cyclic
# type 'a t = 'a
# Characters 11-21:
but is used as an instance of type 'a
The type variable 'a occurs inside 'a
# val f : 'a t -> 'a -> bool = <fun>
-# Characters 83-122:
+# Characters 80-122:
and 'o abs constraint 'o = 'o is_an_object
- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: The definition of abs contains a cycle:
'a is_an_object as '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 *)
+
+(* PR#6787 *)
+let revapply x f = f x;;
+
+let f x (g : [< `Foo]) =
+ let y = `Bar x, g in
+ revapply y (fun ((`Bar i), _) -> i);;
+(* f : 'a -> [< `Foo ] -> 'a *)
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
-#
+# val revapply : 'a -> ('a -> 'b) -> 'b = <fun>
+# val f : 'a -> [< `Foo ] -> 'a = <fun>
+#
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
-#
+# val revapply : 'a -> ('a -> 'b) -> 'b = <fun>
+# val f : 'a -> [< `Foo ] -> 'a = <fun>
+#
--- /dev/null
+(* PR#6768 *)
+
+type _ prod = Prod : ('a * 'y) prod;;
+
+let f : type t. t prod -> _ = function Prod ->
+ let module M =
+ struct
+ type d = d * d
+ end
+ in ()
+;;
--- /dev/null
+
+# type _ prod = Prod : ('a * 'y) prod
+# Characters 82-96:
+ type d = d * d
+ ^^^^^^^^^^^^^^
+Error: The type abbreviation d is cyclic
+#
--- /dev/null
+
+# type _ prod = Prod : ('a * 'y) prod
+# Characters 82-96:
+ type d = d * d
+ ^^^^^^^^^^^^^^
+Error: The type abbreviation d is cyclic
+#
# val get_x : < get_x : 'a; .. > -> 'a = <fun>
# val set_x : < set_x : 'a; .. > -> 'a = <fun>
# - : int list = [10; 5]
-# Characters 7-96:
- ......ref x_init = object
+# Characters 1-96:
+ class ref x_init = object
val mutable x = x_init
method get = x
method set y = x <- y
# val get_x : < get_x : 'a; .. > -> 'a = <fun>
# val set_x : < set_x : 'a; .. > -> 'a = <fun>
# - : int list = [10; 5]
-# Characters 7-96:
- ......ref x_init = object
+# Characters 1-96:
+ class ref x_init = object
val mutable x = x_init
method get = x
method set y = x <- y
= <fun>
# 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
+# Characters 234-275:
+ ....and d () = object
inherit ['a] c ()
end..
Error: Some type variables are unbound in this type:
# * class ['a] c :
'a -> object ('a) constraint 'a = < f : 'a; .. > method f : 'a end
# - : ('a c as 'a) -> 'a = <fun>
-# * Characters 134-176:
- ......x () = object
+# * Characters 128-176:
+ class x () = object
method virtual f : int
end..
Error: This class should be virtual. The following methods are undefined : f
^^^^^^^^
Error: This pattern cannot match self: it only matches values of type
< f : int >
-# Characters 38-110:
- ......['a] c () = object
+# Characters 32-110:
+ class ['a] c () = object
constraint 'a = int
method f x = (x : bool c)
end..
method f : 'a -> 'b -> unit
end
# val x : '_a list ref = {contents = []}
-# Characters 6-50:
- ......['a] c () = object
+# Characters 0-50:
+ class ['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:
+# Characters 20-52:
type 'a c = <f : 'a c; g : 'a d>
- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
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 >
and 'a d = < f : int c >
# type 'a u = < x : 'a >
and 'a t = 'a t u
-# Characters 18-32:
+# Characters 15-32:
and 'a t = 'a t u;;
- ^^^^^^^^^^^^^^
+ ^^^^^^^^^^^^^^^^^
Error: The type abbreviation t is cyclic
# type 'a u = 'a
-# Characters 5-18:
+# Characters 0-18:
type t = t u * t u;;
- ^^^^^^^^^^^^^
+ ^^^^^^^^^^^^^^^^^^
Error: The type abbreviation t is cyclic
# type t = < x : 'a > as 'a
# type 'a u = 'a
# * * * * * * * * * * * * * * * * * * * * * 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-154:
- ......virtual ['a] matrix (sz, init : int * 'a) = object
+# Characters 1-154:
+ class virtual ['a] matrix (sz, init : int * 'a) = object
val m = Array.make_matrix sz sz init
method add (mtx : 'a matrix) = (mtx#m.(0).(0) : 'a)
end..
= <fun>
# class ['a] c : unit -> object constraint 'a = int method f : 'a c end
and ['a] d : unit -> object constraint 'a = int method f : 'a c end
-# Characters 238-275:
- ........d () = object
+# Characters 234-275:
+ ....and d () = object
inherit ['a] c ()
end..
Error: Some type variables are unbound in this type:
# * class ['a] c :
'a -> object ('a) constraint 'a = < f : 'a; .. > method f : 'a end
# - : ('a c as 'a) -> 'a = <fun>
-# * Characters 134-176:
- ......x () = object
+# * Characters 128-176:
+ class x () = object
method virtual f : int
end..
Error: This class should be virtual. The following methods are undefined : f
^^^^^^^^
Error: This pattern cannot match self: it only matches values of type
< f : int >
-# Characters 38-110:
- ......['a] c () = object
+# Characters 32-110:
+ class ['a] c () = object
constraint 'a = int
method f x = (x : bool c)
end..
method f : 'a -> 'b -> unit
end
# val x : '_a list ref = {contents = []}
-# Characters 6-50:
- ......['a] c () = object
+# Characters 0-50:
+ class ['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:
+# Characters 20-52:
type 'a c = <f : 'a c; g : 'a d>
- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
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 >
and 'a d = < f : int c >
# type 'a u = < x : 'a >
and 'a t = 'a t u
-# Characters 18-32:
+# Characters 15-32:
and 'a t = 'a t u;;
- ^^^^^^^^^^^^^^
+ ^^^^^^^^^^^^^^^^^
Error: The type abbreviation t is cyclic
# type 'a u = 'a
-# Characters 5-18:
+# Characters 0-18:
type t = t u * t u;;
- ^^^^^^^^^^^^^
+ ^^^^^^^^^^^^^^^^^^
Error: The type abbreviation t is cyclic
# type t = < x : 'a > as 'a
# type 'a u = 'a
# * * * * * * * * * * * * * * * * * * * * * 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-154:
- ......virtual ['a] matrix (sz, init : int * 'a) = object
+# Characters 1-154:
+ class virtual ['a] matrix (sz, init : int * 'a) = object
val m = Array.make_matrix sz sz init
method add (mtx : 'a matrix) = (mtx#m.(0).(0) : 'a)
end..
# class c : object method m : #id -> int * bool end
# class id2 : object method id : 'a -> 'a method mono : int -> int end
# val app : int * bool = (1, true)
-# Characters 4-25:
+# Characters 0-25:
type 'a foo = 'a foo list
- ^^^^^^^^^^^^^^^^^^^^^
+ ^^^^^^^^^^^^^^^^^^^^^^^^^
Error: The type abbreviation foo is cyclic
# class ['a] bar : 'a -> object end
# type 'a foo = 'a foo bar
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:
+# Characters 15-25:
type t = u and u = t;;
- ^^^^^
+ ^^^^^^^^^^
Error: The type abbreviation t is cyclic
# class ['a] a : object constraint 'a = [> `A of 'a a ] end
type t = [ `A of t a ]
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 = g
-# Characters 38-58:
+# Characters 34-58:
type 'a u = < m : 'a v > and 'a v = 'a list u;;
- ^^^^^^^^^^^^^^^^^^^^
+ ^^^^^^^^^^^^^^^^^^^^^^^^
Error: In the definition of v, type 'a list u should be 'a u
# type 'a t = 'a
type 'a u = A of 'a t
^^^
Warning 11: this match case is unused.
- : int * [< `B ] -> int = <fun>
-# Characters 69-135:
+# Characters 64-135:
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
# Exception: Pervasives.Exit.
# Exception: Pervasives.Exit.
# Exception: Pervasives.Exit.
-# Characters 20-44:
+# Characters 16-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) = <fun>
# - : ('a -> 'a) * ('b -> 'b) = (<fun>, <fun>)
# class c : object method m : #id -> int * bool end
# class id2 : object method id : 'a -> 'a method mono : int -> int end
# val app : int * bool = (1, true)
-# Characters 4-25:
+# Characters 0-25:
type 'a foo = 'a foo list
- ^^^^^^^^^^^^^^^^^^^^^
+ ^^^^^^^^^^^^^^^^^^^^^^^^^
Error: The type abbreviation foo is cyclic
# class ['a] bar : 'a -> object end
# type 'a foo = 'a foo bar
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:
+# Characters 15-25:
type t = u and u = t;;
- ^^^^^
+ ^^^^^^^^^^
Error: The type abbreviation t is cyclic
# class ['a] a : object constraint 'a = [> `A of 'a a ] end
type t = [ `A of t a ]
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 = g
-# Characters 38-58:
+# Characters 34-58:
type 'a u = < m : 'a v > and 'a v = 'a list u;;
- ^^^^^^^^^^^^^^^^^^^^
+ ^^^^^^^^^^^^^^^^^^^^^^^^
Error: In the definition of v, type 'a list u should be 'a u
# type 'a t = 'a
type 'a u = A of 'a t
^^^
Warning 11: this match case is unused.
- : int * [< `B ] -> int = <fun>
-# Characters 69-135:
+# Characters 64-135:
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
# Exception: Pervasives.Exit.
# Exception: Pervasives.Exit.
# Exception: Pervasives.Exit.
-# Characters 20-44:
+# Characters 16-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) = <fun>
# - : ('a -> 'a) * ('b -> 'b) = (<fun>, <fun>)
# 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 26-44:
+# Characters 21-44:
type t = M.t = T of int
- ^^^^^^^^^^^^^^^^^^
+ ^^^^^^^^^^^^^^^^^^^^^^^
Error: This variant or record definition does not match that of type M.t
A private type would be revealed.
# module M5 : sig type t = M.t = private T of int val mk : int -> t end
# 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 26-44:
+# Characters 21-44:
type t = M.t = T of int
- ^^^^^^^^^^^^^^^^^^
+ ^^^^^^^^^^^^^^^^^^^^^^^
Error: This variant or record definition does not match that of type M.t
A private type would be revealed.
# module M5 : sig type t = M.t = private T of int val mk : int -> t end
--- /dev/null
+module type T = sig type 'a t end
+module Fix (T : T) = struct type r = ('r T.t as 'r) end
--- /dev/null
+type t = [`A | `B];;
+type 'a u = t;;
+let a : [< int u] = `A;;
+
+type 'a s = 'a;;
+let b : [< t s] = `B;;
--- /dev/null
+
+# type t = [ `A | `B ]
+# type 'a u = t
+# val a : [< int u > `A ] = `A
+# type 'a s = 'a
+# val b : [< t > `B ] = `B
+#
module type PR6566 = sig type t = string end;;
module PR6566 = struct type t = int end;;
module PR6566' : PR6566 = PR6566;;
+
+module A = struct module B = struct type t = T end end;;
+module M2 = struct type u = A.B.t type foo = int type v = A.B.t end;;
type t = int
is not included in
type t = bytes
+# module A : sig module B : sig type t = T end end
+# module M2 : sig type u = A.B.t type foo = int type v = u end
#
--- /dev/null
+exception A;;
+type a = A;;
+
+A;;
+raise A;;
+fun (A : a) -> ();;
+function Not_found -> 1 | A -> 2 | _ -> 3;;
+try raise A with A -> 2;;
+
--- /dev/null
+
+# exception A
+# type a = A
+# Characters 1-2:
+ A;;
+ ^
+Warning 41: A belongs to several types: a exn
+The first one was selected. Please disambiguate if this is wrong.
+- : a = A
+# Characters 6-7:
+ raise A;;
+ ^
+Warning 42: this use of A required disambiguation.
+Exception: A.
+# - : a -> unit = <fun>
+# Characters 26-27:
+ function Not_found -> 1 | A -> 2 | _ -> 3;;
+ ^
+Warning 41: A belongs to several types: a exn
+The first one was selected. Please disambiguate if this is wrong.
+Characters 26-27:
+ function Not_found -> 1 | A -> 2 | _ -> 3;;
+ ^
+Error: This pattern matches values of type a
+ but a pattern was expected which matches values of type exn
+# Characters 10-11:
+ try raise A with A -> 2;;
+ ^
+Warning 42: this use of A required disambiguation.
+Characters 17-18:
+ try raise A with A -> 2;;
+ ^
+Warning 42: this use of A required disambiguation.
+- : int = 2
+#
--- /dev/null
+
+# exception A
+# type a = A
+# Characters 1-2:
+ A;;
+ ^
+Warning 41: A belongs to several types: a exn
+The first one was selected. Please disambiguate if this is wrong.
+- : a = A
+# Characters 6-7:
+ raise A;;
+ ^
+Warning 42: this use of A required disambiguation.
+Exception: A.
+# - : a -> unit = <fun>
+# Characters 26-27:
+ function Not_found -> 1 | A -> 2 | _ -> 3;;
+ ^
+Warning 42: this use of A required disambiguation.
+- : exn -> int = <fun>
+# Characters 10-11:
+ try raise A with A -> 2;;
+ ^
+Warning 42: this use of A required disambiguation.
+Characters 17-18:
+ try raise A with A -> 2;;
+ ^
+Warning 42: this use of A required disambiguation.
+- : int = 2
+#
--- /dev/null
+module Unused : sig
+end = struct
+ type unused = int
+end
+;;
+
+module Unused_nonrec : sig
+end = struct
+ type nonrec used = int
+ type nonrec unused = used
+end
+;;
+
+module Unused_rec : sig
+end = struct
+ type unused = A of unused
+end
+;;
--- /dev/null
+
+# Characters 35-52:
+ type unused = int
+ ^^^^^^^^^^^^^^^^^
+Warning 34: unused type unused.
+module Unused : sig end
+# Characters 68-93:
+ type nonrec unused = used
+ ^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 34: unused type unused.
+module Unused_nonrec : sig end
+# Characters 40-65:
+ type unused = A of unused
+ ^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 34: unused type unused.
+Characters 40-65:
+ type unused = A of unused
+ ^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 37: unused constructor A.
+module Unused_rec : sig end
+#
include $(BASEDIR)/makefiles/Makefile.several
include $(BASEDIR)/makefiles/Makefile.common
+
+BYTECODE_ONLY=true
../parsing/parse.cmx ../utils/misc.cmx ../parsing/longident.cmx \
../parsing/location.cmx depend.cmx ../utils/config.cmx \
../driver/compenv.cmx ../utils/clflags.cmx
-ocamlmklib.cmo : ocamlmklibconfig.cmo
-ocamlmklib.cmx : ocamlmklibconfig.cmx
ocamlmklibconfig.cmo :
ocamlmklibconfig.cmx :
+ocamlmklib.cmo : ocamlmklibconfig.cmo
+ocamlmklib.cmx : ocamlmklibconfig.cmx
ocamlmktop.cmo : ../utils/ccomp.cmi
ocamlmktop.cmx : ../utils/ccomp.cmx
ocamloptp.cmo : ../driver/main_args.cmi
#########################################################################
include ../config/Makefile
+CAMLRUN ?= ../boot/ocamlrun
+CAMLYACC ?= ../boot/ocamlyacc
-CAMLRUN=../boot/ocamlrun
CAMLC=$(CAMLRUN) ../boot/ocamlc -nostdlib -I ../boot
CAMLOPT=$(CAMLRUN) ../ocamlopt -nostdlib -I ../stdlib
CAMLLEX=$(CAMLRUN) ../boot/ocamllex
CAMLDEP_OBJ=depend.cmo ocamldep.cmo
CAMLDEP_IMPORTS=misc.cmo config.cmo clflags.cmo terminfo.cmo \
- warnings.cmo location.cmo longident.cmo \
+ warnings.cmo location.cmo longident.cmo docstrings.cmo \
syntaxerr.cmo ast_helper.cmo parser.cmo lexer.cmo parse.cmo \
ccomp.cmo ast_mapper.cmo pparse.cmo compenv.cmo
CSLPROF=ocamlprof.cmo
CSLPROF_IMPORTS=misc.cmo config.cmo clflags.cmo terminfo.cmo \
- warnings.cmo location.cmo longident.cmo \
+ warnings.cmo location.cmo longident.cmo docstrings.cmo \
syntaxerr.cmo ast_helper.cmo parser.cmo lexer.cmo parse.cmo
ocamlprof: $(CSLPROF) profiling.cmo
# Insert labels following an interface file (upgrade 3.02 to 3.03)
ADDLABELS_IMPORTS=misc.cmo config.cmo clflags.cmo terminfo.cmo \
- warnings.cmo location.cmo longident.cmo \
+ warnings.cmo location.cmo longident.cmo docstrings.cmo \
syntaxerr.cmo ast_helper.cmo parser.cmo lexer.cmo parse.cmo
addlabels: addlabels.cmo
../utils/clflags.cmo \
../parsing/location.cmo \
../parsing/longident.cmo \
+ ../parsing/docstrings.cmo \
../parsing/lexer.cmo \
../parsing/pprintast.cmo \
../parsing/ast_helper.cmo \
clean::
rm -f dumpobj
-opnames.ml: ../byterun/instruct.h
+opnames.ml: ../byterun/caml/instruct.h
unset LC_ALL || : ; \
unset LC_CTYPE || : ; \
unset LC_COLLATE LANG || : ; \
-e 's/.*};$$/ |]/' \
-e 's/\([A-Z][A-Z_0-9a-z]*\)/"\1"/g' \
-e 's/,/;/g' \
- ../byterun/instruct.h > opnames.ml
+ ../byterun/caml/instruct.h > opnames.ml
clean::
rm -f opnames.ml
# Display info on compiled files
+ifeq "$(CCOMPTYPE)" "msvc"
+CCOUT = -Fe
+else
+EMPTY =
+CCOUT = -o $(EMPTY)
+endif
+
objinfo_helper$(EXE): objinfo_helper.c ../config/s.h
- $(BYTECC) -o objinfo_helper$(EXE) $(BYTECCCOMPOPTS) \
+ $(BYTECC) $(CCOUT)objinfo_helper$(EXE) $(BYTECCCOMPOPTS) \
objinfo_helper.c $(LIBBFD_LINK)
OBJINFO=../compilerlibs/ocamlcommon.cma \
| (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) ->
+ | (Pstr_type (a0, a1), Pstr_type (b0, b1)) ->
+ (Asttypes.eq_rec_flag (a0, b0)) &&
eq_list
(fun ((a0, a1), (b0, b1)) ->
(Asttypes.eq_loc eq_string (a0, b0)) &&
(eq_type_declaration (a1, b1)))
- (a0, b0)
+ (a1, b1)
| (Pstr_exception (a0, a1), Pstr_exception (b0, b1)) ->
(Asttypes.eq_loc eq_string (a0, b0)) &&
(eq_exception_declaration (a1, b1))
| (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) ->
+ | (Psig_type (a0, a1), Psig_type (b0, b1)) ->
+ (Asttypes.eq_rec_flag (a0, b0)) &&
eq_list
(fun ((a0, a1), (b0, b1)) ->
(Asttypes.eq_loc eq_string (a0, b0)) &&
(eq_type_declaration (a1, b1)))
- (a0, b0)
+ (a1, b1)
| (Psig_exception (a0, a1), Psig_exception (b0, b1)) ->
(Asttypes.eq_loc eq_string (a0, b0)) &&
(eq_exception_declaration (a1, b1))
/***********************************************************************/
#include "../config/s.h"
-#include "../byterun/mlvalues.h"
-#include "../byterun/alloc.h"
+#include "../byterun/caml/mlvalues.h"
+#include "../byterun/caml/alloc.h"
#include <stdio.h>
#ifdef HAS_LIBBFD
#include <bfd.h>
#undef PACKAGE
+#ifdef __APPLE__
+#define plugin_header_sym "_caml_plugin_header"
+#else
+#define plugin_header_sym "caml_plugin_header"
+#endif
+
int main(int argc, char ** argv)
{
bfd *fd;
sym_count = bfd_canonicalize_dynamic_symtab (fd, symbol_table);
for (i = 0; i < sym_count; i++) {
- if (strcmp(symbol_table[i]->name, "caml_plugin_header") == 0) {
+ if (strcmp(symbol_table[i]->name, plugin_header_sym) == 0) {
printf("%ld\n", (long) (offset + symbol_table[i]->value));
bfd_close(fd);
return 0;
}
}
- fprintf(stderr, "Error: missing symbol caml_plugin_header\n");
+ fprintf(stderr, "Error: missing symbol %s\n", plugin_header_sym);
bfd_close(fd);
return 2;
}
let _impl s = with_impl := true; option_with_arg "-impl" s
let _intf s = with_intf := true; option_with_arg "-intf" s
let _intf_suffix s = option_with_arg "-intf-suffix" s
+ let _keep_docs = option "-keep-docs"
let _keep_locs = option "-keep-locs"
let _labels = option "-labels"
let _linkall = option "-linkall"
let _make_runtime = option "-make-runtime"
let _no_alias_deps = option "-no-alias-deps"
let _no_app_funct = option "-no-app-funct"
+ let _no_check_prims = option "-no-check-prims"
let _noassert = option "-noassert"
let _nolabels = option "-nolabels"
let _noautolink = option "-noautolink"
let _o s = option_with_arg "-o" s
let _open s = option_with_arg "-open" s
let _output_obj = option "-output-obj"
+ let _output_complete_obj = option "-output-complete-obj"
let _pack = option "-pack"
let _pp _s = incompatible "-pp"
let _ppx _s = incompatible "-ppx"
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 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 ocamlc_opts = ref [] (* options to pass only to ocamlc *)
and ocamlopt = ref (compiler_path "ocamlopt")
+and ocamlopt_opts = ref [] (* options to pass only to ocamlc *)
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 debug = ref false (* -g option *)
and verbose = ref false
let starts_with s pref =
caml_opts := next_arg () :: "-I" :: !caml_opts
else if s = "-failsafe" then
failsafe := true
+ else if s = "-g" then
+ debug := true
else if s = "-h" || s = "-help" || s = "--help" then
raise (Bad_argument "")
else if s = "-ldopt" then
(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 = "-ocamlcflags" then
+ ocamlc_opts := next_arg () :: !ocamlc_opts
else if s = "-ocamlc" then
ocamlc := next_arg ()
else if s = "-ocamlopt" then
ocamlopt := next_arg ()
+ else if s = "-ocamloptflags" then
+ ocamlopt_opts := next_arg () :: !ocamlopt_opts
else if s = "-o" then
output := next_arg()
else if s = "-oc" then
\nOptions are:\
\n -cclib <lib> C library passed to ocamlc -a or ocamlopt -a only\
\n -ccopt <opt> C option passed to ocamlc -a or ocamlopt -a only\
-\n -custom disable dynamic loading\
+\n -custom Disable dynamic loading\
+\n -g Build with debug information\
\n -dllpath <dir> Add <dir> to the run-time search path for DLLs\
\n -F<dir> Specify a framework directory (MacOSX)\
\n -framework <name> Use framework <name> (MacOSX)\
\n -l<lib> Specify a dependent C library\
\n -L<dir> Add <dir> to the path searched for C libraries\
\n -ocamlc <cmd> Use <cmd> in place of \"ocamlc\"\
+\n -ocamlcflags <opt> Pass <opt> to ocamlc\
\n -ocamlopt <cmd> Use <cmd> in place of \"ocamlopt\"\
+\n -ocamloptflags <opt> Pass <opt> to ocamlopt\
\n -o <name> Generated OCaml library is named <name>.cma or <name>.cmxa\
\n -oc <name> Generated C library is named dll<name>.so or lib<name>.a\
\n -rpath <dir> Same as -dllpath <dir>\
if !c_objs <> [] then begin
if !dynlink then begin
let retcode = command
- (Printf.sprintf "%s -o %s %s %s %s %s %s"
+ (Printf.sprintf "%s %s -o %s %s %s %s %s %s"
mkdll
+ (if !debug then "-g" else "")
(prepostfix "dll" !output_c ext_dll)
(String.concat " " !c_objs)
(String.concat " " !c_opts)
end;
if !bytecode_objs <> [] then
scommand
- (sprintf "%s -a %s -o %s.cma %s %s -dllib -l%s -cclib -l%s %s %s %s %s"
+ (sprintf "%s -a %s %s %s -o %s.cma %s %s -dllib -l%s -cclib -l%s %s %s %s %s"
(transl_path !ocamlc)
+ (if !debug then "-g" else "")
(if !dynlink then "" else "-custom")
+ (String.concat " " !ocamlc_opts)
!output
(String.concat " " !caml_opts)
(String.concat " " !bytecode_objs)
(String.concat " " !caml_libs));
if !native_objs <> [] then
scommand
- (sprintf "%s -a -o %s.cmxa %s %s -cclib -l%s %s %s %s %s"
+ (sprintf "%s -a %s %s -o %s.cmxa %s %s -cclib -l%s %s %s %s %s"
(transl_path !ocamlopt)
+ (if !debug then "-g" else "")
+ (String.concat " " !ocamlopt_opts)
!output
(String.concat " " !caml_opts)
(String.concat " " !native_objs)
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 _keep_docs = option "-keep-docs"
let _keep_locs = option "-keep-locs"
let _labels = option "-labels"
let _linkall = option "-linkall"
let _o s = option_with_arg "-o" s
let _open s = option_with_arg "-open" s
let _output_obj = option "-output-obj"
+ let _output_complete_obj = option "-output-complete-obj"
let _p = option "-p"
let _pack = option "-pack"
let _pp _s = incompatible "-pp"
in
let exp = remove_fun_self exp in
Pcf_method (lab, priv, Cfk_concrete (o, untype_expression exp))
- | Tcf_initializer exp ->
+ | Tcf_initializer exp ->
let remove_fun_self = function
| { exp_desc = Texp_function("", [case], _) } when is_self_pat case.c_lhs && case.c_guard = None -> case.c_rhs
| e -> e
val same_value: valu -> valu -> bool
end
+type ('a, 'b) gen_printer =
+ | Zero of 'b
+ | Succ of ('a -> ('a, 'b) gen_printer)
+
module type S =
sig
type t
val install_printer :
Path.t -> Types.type_expr -> (formatter -> t -> unit) -> unit
+ val install_generic_printer :
+ Path.t -> Path.t ->
+ (int -> (int -> t -> Outcometree.out_value,
+ t -> Outcometree.out_value) gen_printer) ->
+ unit
+ val install_generic_printer' :
+ Path.t -> Path.t ->
+ (formatter -> t -> unit,
+ formatter -> t -> unit) gen_printer ->
+ unit
val remove_printer : Path.t -> unit
val outval_of_untyped_exception : t -> Outcometree.out_value
val outval_of_value :
Env.t -> t -> type_expr -> Outcometree.out_value
end
-module ObjTbl = Hashtbl.Make(struct
- type t = Obj.t
+module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
+
+ type t = O.t
+
+ module ObjTbl = Hashtbl.Make(struct
+ type t = O.t
let equal = (==)
let hash x =
try
with exn -> 0
end)
-module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
-
- type t = O.t
(* Given an exception value, we cannot recover its type,
hence we cannot print its arguments in general.
(* The user-defined printers. Also used for some builtin types. *)
+ type printer =
+ | Simple of Types.type_expr * (O.t -> Outcometree.out_value)
+ | Generic of Path.t * (int -> (int -> O.t -> Outcometree.out_value,
+ O.t -> Outcometree.out_value) gen_printer)
+
let printers = ref ([
- Pident(Ident.create "print_int"), Predef.type_int,
- (fun x -> Oval_int (O.obj x : int));
- Pident(Ident.create "print_float"), Predef.type_float,
- (fun x -> Oval_float (O.obj x : float));
- Pident(Ident.create "print_char"), Predef.type_char,
- (fun x -> Oval_char (O.obj x : char));
- Pident(Ident.create "print_string"), Predef.type_string,
- (fun x -> Oval_string (O.obj x : string));
- Pident(Ident.create "print_int32"), Predef.type_int32,
- (fun x -> Oval_int32 (O.obj x : int32));
- Pident(Ident.create "print_nativeint"), Predef.type_nativeint,
- (fun x -> Oval_nativeint (O.obj x : nativeint));
- Pident(Ident.create "print_int64"), Predef.type_int64,
- (fun x -> Oval_int64 (O.obj x : int64))
- ] : (Path.t * type_expr * (O.t -> Outcometree.out_value)) list)
+ ( Pident(Ident.create "print_int"),
+ Simple (Predef.type_int,
+ (fun x -> Oval_int (O.obj x : int))) );
+ ( Pident(Ident.create "print_float"),
+ Simple (Predef.type_float,
+ (fun x -> Oval_float (O.obj x : float))) );
+ ( Pident(Ident.create "print_char"),
+ Simple (Predef.type_char,
+ (fun x -> Oval_char (O.obj x : char))) );
+ ( Pident(Ident.create "print_string"),
+ Simple (Predef.type_string,
+ (fun x -> Oval_string (O.obj x : string))) );
+ ( Pident(Ident.create "print_int32"),
+ Simple (Predef.type_int32,
+ (fun x -> Oval_int32 (O.obj x : int32))) );
+ ( Pident(Ident.create "print_nativeint"),
+ Simple (Predef.type_nativeint,
+ (fun x -> Oval_nativeint (O.obj x : nativeint))) );
+ ( Pident(Ident.create "print_int64"),
+ Simple (Predef.type_int64,
+ (fun x -> Oval_int64 (O.obj x : int64)) ))
+ ] : (Path.t * printer) list)
+
+ let exn_printer ppf path =
+ fprintf ppf "<printer %a raised an exception>" Printtyp.path path
+
+ let out_exn path =
+ Oval_printer (fun ppf -> exn_printer ppf path)
let install_printer path ty fn =
let print_val ppf obj =
- try fn ppf obj with
- | exn ->
- fprintf ppf "<printer %a raised an exception>" Printtyp.path path in
+ try fn ppf obj with exn -> exn_printer ppf path in
let printer obj = Oval_printer (fun ppf -> print_val ppf obj) in
- printers := (path, ty, printer) :: !printers
+ printers := (path, Simple (ty, printer)) :: !printers
+
+ let install_generic_printer function_path constr_path fn =
+ printers := (function_path, Generic (constr_path, fn)) :: !printers
+
+ let install_generic_printer' function_path ty_path fn =
+ let rec build gp depth =
+ match gp with
+ | Zero fn ->
+ let out_printer obj =
+ let printer ppf =
+ try fn ppf obj with _ -> exn_printer ppf function_path in
+ Oval_printer printer in
+ Zero out_printer
+ | Succ fn ->
+ let print_val fn_arg =
+ let print_arg ppf o =
+ !Oprint.out_value ppf (fn_arg (depth+1) o) in
+ build (fn print_arg) depth in
+ Succ print_val in
+ printers := (function_path, Generic (ty_path, build fn)) :: !printers
let remove_printer path =
let rec remove = function
| [] -> raise Not_found
- | (p, ty, fn as printer) :: rem ->
+ | ((p, _) as printer) :: rem ->
if Path.same p path then rem else printer :: remove rem in
printers := remove !printers
- let find_printer env ty =
- let rec find = function
- | [] -> raise Not_found
- | (name, sch, printer) :: remainder ->
- if Ctype.moregeneral env false sch ty
- then printer
- else find remainder
- in find !printers
-
(* Print a constructor or label, giving it the same prefix as the type
it comes from. Attempt to omit the prefix if the type comes from
a module that has been opened. *)
let nested_values = ObjTbl.create 8 in
let nest_gen err f depth obj ty =
- let repr = Obj.repr obj in
- if not (Obj.is_block repr) then
+ let repr = obj in
+ if not (O.is_block repr) then
f depth obj ty
else
if ObjTbl.mem nested_values repr then
if !printer_steps < 0 || depth < 0 then Oval_ellipsis
else begin
try
- find_printer env ty obj
+ find_printer depth env ty obj
with Not_found ->
match (Ctype.repr ty).desc with
| Tvar _ | Tunivar _ ->
Oval_array []
| Tconstr (path, [ty_arg], _)
when Path.same path Predef.path_lazy_t ->
- if Lazy.is_val (O.obj obj)
- then let v =
- nest tree_of_val depth (Lazy.force (O.obj obj)) ty_arg
- in
- Oval_constr (Oide_ident "lazy", [v])
- else Oval_stuff "<lazy>"
+ let obj_tag = O.tag obj in
+ (* Lazy values are represented in three possible ways:
+
+ 1. a lazy thunk that is not yet forced has tag
+ Obj.lazy_tag
+
+ 2. a lazy thunk that has just been forced has tag
+ Obj.forward_tag; its first field is the forced
+ result, which we can print
+
+ 3. when the GC moves a forced trunk with forward_tag,
+ or when a thunk is directly created from a value,
+ we get a third representation where the value is
+ directly exposed, without the Obj.forward_tag
+ (if its own tag is not ambiguous, that is neither
+ lazy_tag nor forward_tag)
+
+ Note that using Lazy.is_val and Lazy.force would be
+ unsafe, because they use the Obj.* functions rather
+ than the O.* functions of the functor argument, and
+ would thus crash if called from the toplevel
+ (debugger/printval instantiates Genprintval.Make with
+ an Obj module talking over a socket).
+ *)
+ if obj_tag = Obj.lazy_tag then Oval_stuff "<lazy>"
+ else begin
+ let forced_obj =
+ if obj_tag = Obj.forward_tag then O.field obj 0 else obj
+ in
+ (* calling oneself recursively on forced_obj risks
+ having a false positive for cycle detection;
+ indeed, in case (3) above, the value is stored
+ as-is instead of being wrapped in a forward
+ pointer. It means that, for (lazy "foo"), we have
+ forced_obj == obj
+ and it is easy to wrongly print (lazy <cycle>) in such
+ a case (PR#6669).
+
+ Unfortunately, there is a corner-case that *is*
+ a real cycle: using -rectypes one can define
+ let rec x = lazy x
+ which creates a Forward_tagged block that points to
+ itself. For this reason, we still "nest"
+ (detect head cycles) on forward tags.
+ *)
+ let v =
+ if obj_tag = Obj.forward_tag
+ then nest tree_of_val depth forced_obj ty_arg
+ else tree_of_val depth forced_obj ty_arg
+ in
+ Oval_constr (Oide_ident "lazy", [v])
+ end
| Tconstr(path, ty_list, _) -> begin
try
let decl = Env.find_type path env in
| None ->
Oval_stuff "<extension>"
+ and find_printer depth env ty =
+ let rec find = function
+ | [] -> raise Not_found
+ | (name, Simple (sch, printer)) :: remainder ->
+ if Ctype.moregeneral env false sch ty
+ then printer
+ else find remainder
+ | (name, Generic (path, fn)) :: remainder ->
+ begin match (Ctype.expand_head env ty).desc with
+ | Tconstr (p, args, _) when Path.same p path ->
+ begin try apply_generic_printer path (fn depth) args
+ with _ -> (fun obj -> out_exn path) end
+ | _ -> find remainder end in
+ find !printers
+
+ and apply_generic_printer path printer args =
+ match (printer, args) with
+ | (Zero fn, []) -> (fun (obj : O.t)-> try fn obj with _ -> out_exn path)
+ | (Succ fn, arg :: args) ->
+ let printer = fn (fun depth obj -> tree_of_val depth obj arg) in
+ apply_generic_printer path printer args
+ | _ ->
+ (fun obj ->
+ let printer ppf =
+ fprintf ppf "<internal error: incorrect arity for '%a'>"
+ Printtyp.path path in
+ Oval_printer printer)
+
+
in nest tree_of_val max_depth obj ty
end
val same_value: valu -> valu -> bool
end
+type ('a, 'b) gen_printer =
+ | Zero of 'b
+ | Succ of ('a -> ('a, 'b) gen_printer)
+
module type S =
sig
type t
val install_printer :
Path.t -> Types.type_expr -> (formatter -> t -> unit) -> unit
+ val install_generic_printer :
+ Path.t -> Path.t ->
+ (int -> (int -> t -> Outcometree.out_value,
+ t -> Outcometree.out_value) gen_printer) ->
+ unit
+ val install_generic_printer' :
+ Path.t -> Path.t ->
+ (formatter -> t -> unit,
+ formatter -> t -> unit) gen_printer ->
+ unit
+ (** [install_generic_printer' function_path constructor_path printer]
+ function_path is used to remove the printer. *)
+
val remove_printer : Path.t -> unit
val outval_of_untyped_exception : t -> Outcometree.out_value
val outval_of_value :
else Filename.temp_file ("caml" ^ !phrase_name) ext_dll
in
let fn = Filename.chop_extension dll in
- Asmgen.compile_implementation ~toplevel:need_symbol fn ppf (size, lam);
+ Asmgen.compile_implementation ~toplevel:need_symbol fn ppf (size, slam);
Asmlink.call_linker_shared [fn ^ ext_obj] dll;
Sys.remove (fn ^ ext_obj);
(* Install, remove a printer *)
+let filter_arrow ty =
+ let ty = Ctype.expand_head !toplevel_env ty in
+ match ty.desc with
+ | Tarrow (lbl, l, r, _) when not (Btype.is_optional lbl) -> Some (l, r)
+ | _ -> None
+
+let rec extract_last_arrow desc =
+ match filter_arrow desc with
+ | None -> raise (Ctype.Unify [])
+ | Some (_, r as res) ->
+ try extract_last_arrow r
+ with Ctype.Unify _ -> res
+
+let extract_target_type ty = fst (extract_last_arrow ty)
+let extract_target_parameters ty =
+ let ty = extract_target_type ty |> Ctype.expand_head !toplevel_env in
+ match ty.desc with
+ | Tconstr (path, (_ :: _ as args), _)
+ when Ctype.all_distinct_vars !toplevel_env args -> Some (path, args)
+ | _ -> None
+
type 'a printer_type_new = Format.formatter -> 'a -> unit
type 'a printer_type_old = 'a -> unit
-let match_printer_type ppf desc typename =
+let printer_type ppf typename =
let (printer_type, _) =
try
Env.lookup_type (Ldot(Lident "Topdirs", typename)) !toplevel_env
with Not_found ->
fprintf ppf "Cannot find type Topdirs.%s.@." typename;
raise Exit in
- Ctype.init_def(Ident.current_time());
+ printer_type
+
+let match_simple_printer_type ppf desc printer_type =
Ctype.begin_def();
let ty_arg = Ctype.newvar() in
Ctype.unify !toplevel_env
(Ctype.instance_def desc.val_type);
Ctype.end_def();
Ctype.generalize ty_arg;
- ty_arg
+ (ty_arg, None)
+
+let match_generic_printer_type ppf desc path args printer_type =
+ Ctype.begin_def();
+ let args = List.map (fun _ -> Ctype.newvar ()) args in
+ let ty_target = Ctype.newty (Tconstr (path, args, ref Mnil)) in
+ let ty_args =
+ List.map (fun ty_var -> Ctype.newconstr printer_type [ty_var]) args in
+ let ty_expected =
+ List.fold_right
+ (fun ty_arg ty -> Ctype.newty (Tarrow ("", ty_arg, ty, Cunknown)))
+ ty_args (Ctype.newconstr printer_type [ty_target]) in
+ Ctype.unify !toplevel_env
+ ty_expected
+ (Ctype.instance_def desc.val_type);
+ Ctype.end_def();
+ Ctype.generalize ty_expected;
+ if not (Ctype.all_distinct_vars !toplevel_env args) then
+ raise (Ctype.Unify []);
+ (ty_expected, Some (path, ty_args))
+
+let match_printer_type ppf desc =
+ let printer_type_new = printer_type ppf "printer_type_new" in
+ let printer_type_old = printer_type ppf "printer_type_old" in
+ Ctype.init_def(Ident.current_time());
+ match extract_target_parameters desc.val_type with
+ | None ->
+ (try
+ (match_simple_printer_type ppf desc printer_type_new, false)
+ with Ctype.Unify _ ->
+ (match_simple_printer_type ppf desc printer_type_old, true))
+ | Some (path, args) ->
+ (* only 'new' style is available for generic printers *)
+ match_generic_printer_type ppf desc path args printer_type_new, false
let find_printer_type ppf lid =
try
let (path, desc) = Env.lookup_value lid !toplevel_env in
- let (ty_arg, is_old_style) =
- try
- (match_printer_type ppf desc "printer_type_new", false)
- with Ctype.Unify _ ->
- (match_printer_type ppf desc "printer_type_old", true) in
+ let (ty_arg, is_old_style) = match_printer_type ppf desc in
(ty_arg, path, is_old_style)
with
| Not_found ->
let dir_install_printer ppf lid =
try
- let (ty_arg, path, is_old_style) = find_printer_type ppf lid in
+ let ((ty_arg, ty), path, is_old_style) =
+ find_printer_type ppf lid in
let v = eval_path !toplevel_env path in
- let print_function =
- if is_old_style then
- (fun formatter repr -> Obj.obj v (Obj.obj repr))
- else
- (fun formatter repr -> Obj.obj v formatter (Obj.obj repr)) in
- install_printer path ty_arg print_function
+ match ty with
+ | None ->
+ let print_function =
+ if is_old_style then
+ (fun formatter repr -> Obj.obj v (Obj.obj repr))
+ else
+ (fun formatter repr -> Obj.obj v formatter (Obj.obj repr)) in
+ install_printer path ty_arg print_function
+ | Some (ty_path, ty_args) ->
+ let rec build v = function
+ | [] ->
+ let print_function =
+ if is_old_style then
+ (fun formatter repr -> Obj.obj v (Obj.obj repr))
+ else
+ (fun formatter repr -> Obj.obj v formatter (Obj.obj repr)) in
+ Zero print_function
+ | _ :: args ->
+ Succ
+ (fun fn -> build ((Obj.obj v : _ -> Obj.t) fn) args) in
+ install_generic_printer' path ty_path (build v ty_args)
with Exit -> ()
let dir_remove_printer ppf lid =
in
let id = Ident.create_persistent s in
let sg = to_sig env loc id lid in
- fprintf ppf "@[%a@]@." Printtyp.signature sg
+ Printtyp.wrap_printing_env env
+ (fun () -> fprintf ppf "@[%a@]@." Printtyp.signature sg)
with
| Not_found ->
fprintf ppf "@[Unknown element.@]@."
let print_value env obj ppf ty =
!print_out_value ppf (outval_of_value env obj ty)
+type ('a, 'b) gen_printer = ('a, 'b) Genprintval.gen_printer =
+ | Zero of 'b
+ | Succ of ('a -> ('a, 'b) gen_printer)
+
let install_printer = Printer.install_printer
+let install_generic_printer = Printer.install_generic_printer
+let install_generic_printer' = Printer.install_generic_printer'
let remove_printer = Printer.remove_printer
(* Hooks for parsing functions *)
exception PPerror
let loop ppf =
+ Location.formatter_for_warnings := ppf;
fprintf ppf " OCaml version %s@.@." Config.version;
initialize_toplevel_env ();
let lb = Lexing.from_function refill_lexbuf in
val print_value: Env.t -> Obj.t -> formatter -> Types.type_expr -> unit
val print_untyped_exception: formatter -> Obj.t -> unit
+type ('a, 'b) gen_printer =
+ | Zero of 'b
+ | Succ of ('a -> ('a, 'b) gen_printer)
+
val install_printer :
Path.t -> Types.type_expr -> (formatter -> Obj.t -> unit) -> unit
+val install_generic_printer :
+ Path.t -> Path.t ->
+ (int -> (int -> Obj.t -> Outcometree.out_value,
+ Obj.t -> Outcometree.out_value) gen_printer) -> unit
+val install_generic_printer' :
+ Path.t -> Path.t -> (formatter -> Obj.t -> unit,
+ formatter -> Obj.t -> unit) gen_printer -> unit
val remove_printer : Path.t -> unit
val max_printer_depth: int ref
(* 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) ->
+ Some (free_univars, false) ->
+ let more' =
+ if more.id != more'.id then more' else
+ let lv = if keep then more.level else !current_level in
+ newty2 lv (Tvar None)
+ in
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})
+ if row.row_closed && not row.row_fixed
+ && TypeSet.is_empty (free_univars ty)
+ && not (List.for_all not_reither row.row_fields) then
+ (more',
+ {row_fields = List.filter not_reither row.row_fields;
+ row_more = more'; row_bound = ();
+ row_closed = false; row_fixed = false; row_name = None})
+ else (more', row)
| _ -> (more', row)
in
(* Register new type first for recursion *)
let rec occur_rec env visited ty0 ty =
if ty == ty0 then raise Occur;
+ let occur_ok = !Clflags.recursive_types && is_contractive env ty in
match ty.desc with
Tconstr(p, tl, abbrev) ->
begin try
- if List.memq ty visited || !Clflags.recursive_types then raise Occur;
+ if occur_ok || List.memq ty visited then raise Occur;
iter_type_expr (occur_rec env (ty::visited) ty0) ty
with Occur -> try
let ty' = try_expand_head try_expand_once env ty in
match ty'.desc with
Tobject _ | Tvariant _ -> ()
| _ ->
- if not !Clflags.recursive_types then
+ if not (!Clflags.recursive_types && is_contractive env ty') then
iter_type_expr (occur_rec env (ty'::visited) ty0) ty'
with Cannot_expand ->
- if not !Clflags.recursive_types then raise Occur
+ if not occur_ok then raise Occur
end
| Tobject _ | Tvariant _ ->
()
| _ ->
- if not !Clflags.recursive_types then
+ if not occur_ok then
iter_type_expr (occur_rec env visited ty0) ty
let type_changed = ref false (* trace possible changes to the studied type *)
| (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 [])
+ begin try
+ let decl = Env.find_type p env in
+ if non_aliasable p decl || is_datatype decl then raise (Unify [])
+ with Not_found -> ()
+ end
(*
| (Tpackage (p1, n1, tl1), Tpackage (p2, n2, tl2)) when n1 = n2 ->
mcomp_list type_pairs env tl1 tl2
val expand_head_opt: Env.t -> type_expr -> type_expr
(** 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
| Inconsistent_import of string * string * string
| Need_recursive_types of string * string
| Missing_module of Location.t * Path.t * Path.t
+ | Illegal_value_name of Location.t * string
exception Error of error
val force : ('a -> 'b) -> ('a,'b) t -> 'b
val create : 'a -> ('a,'b) t
val is_val : ('a,'b) t -> bool
+ val get_arg : ('a,'b) t -> 'a option
end = struct
let is_val x =
match !x with Done _ -> true | _ -> false
+ let get_arg x =
+ match !x with Thunk a -> Some a | _ -> None
+
let create x =
let x = ref (Thunk x) in
x
(* Reading persistent structures from .cmi files *)
+let save_pers_struct crc ps =
+ let modname = ps.ps_name in
+ Hashtbl.add persistent_structures modname (Some ps);
+ Consistbl.set crc_units modname crc ps.ps_filename;
+ add_import modname
+
let read_pers_struct modname filename =
let cmi = read_cmi filename in
let name = cmi.cmi_name in
| Some None -> raise Not_found
| Some (Some sg) -> sg
| None ->
+ (* PR#6843: record the weak dependency ([add_import]) even if
+ the [find_in_path_uncap] call below fails to find the .cmi,
+ to help make builds more deterministic. *)
+ add_import name;
let filename =
try find_in_path_uncap !load_path (name ^ ".cmi")
with Not_found ->
let set_unit_name name =
current_unit := name
+let get_unit_name () =
+ !current_unit
+
(* Lookup by identifier *)
let rec find_module_descr path env =
let (p, desc) = EnvTbl.find_same id env.components
in desc
with Not_found ->
- if Ident.persistent id
+ if Ident.persistent id && not (Ident.name id = !current_unit)
then (find_pers_struct (Ident.name id)).ps_comps
else raise Not_found
end
let (p, data) = EnvTbl.find_same id env.modules
in data
with Not_found ->
- if Ident.persistent id then
+ if Ident.persistent id && not (Ident.name id = !current_unit) then
let ps = find_pers_struct (Ident.name id) in
md (Mty_signature(ps.ps_sig))
else raise Not_found
(* Iter on an environment (ignoring the body of functors and
not yet evaluated structures) *)
-let iter_env proj1 proj2 f env =
+type iter_cont = unit -> unit
+let iter_env_cont = ref []
+
+let rec scrape_alias_safe env mty =
+ match mty with
+ | Mty_alias (Pident id) when Ident.persistent id -> false
+ | Mty_alias path -> (* PR#6600: find_module may raise Not_found *)
+ scrape_alias_safe env (find_module path env).md_type
+ | _ -> true
+
+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 _ -> ()
+ let cont () =
+ let safe =
+ match EnvLazy.get_arg mcomps with
+ None -> true
+ | Some (env, sub, path, mty) ->
+ try scrape_alias_safe env mty with Not_found -> false
+ in
+ if not safe then () else
+ 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 iter_env_cont := (path, cont) :: !iter_env_cont
in
Hashtbl.iter
(fun s pso ->
(fun id ((path, comps), _) -> iter_components (Pident id) path comps)
env.components
+let run_iter_cont l =
+ iter_env_cont := [];
+ List.iter (fun c -> c ()) l;
+ let cont = List.rev !iter_env_cont in
+ iter_env_cont := [];
+ cont
+
let iter_types f = iter_env (fun env -> env.types) (fun sc -> sc.comp_types) f
let same_types env1 env2 =
(fun () -> if not !used then Location.prerr_warning loc (warn name))
end;
+and check_value_name name loc =
+ (* Note: we could also check here general validity of the
+ identifier, to protect against bad identifiers forged by -pp or
+ -ppx preprocessors. *)
+
+ if String.length name > 0 && (name.[0] = '#') then
+ for i = 1 to String.length name - 1 do
+ if name.[i] = '#' then
+ raise (Error(Illegal_value_name(loc, name)))
+ done
+
+
and store_value ?check slot id path decl env renv =
+ check_value_name (Ident.name id) decl.val_loc;
may (fun f -> check_usage decl.val_loc id f value_declarations) check;
{ env with
values = EnvTbl.add "value" slot id (path, decl) env.values renv.values;
ps_flags = cmi.cmi_flags;
ps_crcs_checked = false;
} in
- Hashtbl.add persistent_structures modname (Some ps);
- Consistbl.set crc_units modname crc filename;
- add_import modname;
+ save_pers_struct crc ps;
sg
with exn ->
close_out oc;
fprintf ppf "@]@ @[%s@ %s@ %s.@]@]"
"The compiled interface for module" (Ident.name (Path.head path2))
"was not found"
+ | Illegal_value_name(_loc, name) ->
+ fprintf ppf "'%s' is not a valid value identifier."
+ name
let () =
Location.register_error_of_exn
(function
- | Error (Missing_module (loc, _, _) as err) when loc <> Location.none ->
+ | Error (Missing_module (loc, _, _)
+ | Illegal_value_name (loc, _)
+ as err) when loc <> Location.none ->
Some (Location.error_of_printer loc report_error err)
| Error err -> Some (Location.error_of_printer_file report_error err)
| _ -> None
constructor_description list * label_description list
(* For short-paths *)
+type iter_cont
val iter_types:
(Path.t -> Path.t * (type_declaration * type_descriptions) -> unit) ->
- t -> unit
+ t -> iter_cont
+val run_iter_cont: iter_cont list -> (Path.t * iter_cont) list
val same_types: t -> t -> bool
val used_persistent: unit -> Concr.t
val find_shadowed_types: Path.t -> t -> Path.t list
(* Remember the name of the current compilation unit. *)
val set_unit_name: string -> unit
+val get_unit_name: unit -> string
(* Read, save a signature to/from a file *)
| Inconsistent_import of string * string * string
| Need_recursive_types of string * string
| Missing_module of Location.t * Path.t * Path.t
+ | Illegal_value_name of Location.t * string
exception Error of error
(** Utilities *)
val scrape_alias: t -> module_type -> module_type
+val check_value_name: string -> Location.t -> unit
name !out_module_type mty
| Osig_type(td, rs) ->
print_out_type_decl
- (if rs = Orec_next then "and" else "type")
+ (match rs with
+ | Orec_not -> "type nonrec"
+ | Orec_first -> "type"
+ | Orec_next -> "and")
ppf td
| Osig_value (name, ty, prims) ->
let kwd = if prims = [] then "val" else "external" in
| _ -> pretty_val ppf v
and pretty_arg ppf v = match v.pat_desc with
-| Tpat_construct (_,_,_::_) -> fprintf ppf "(%a)" pretty_val v
+| Tpat_construct (_,_,_::_)
+| Tpat_variant (_, Some _, _) -> fprintf ppf "(%a)" pretty_val v
| _ -> pretty_val ppf v
and pretty_or ppf v = match v.pat_desc with
let errmsg =
match v.pat_desc with
Tpat_construct (_, {cstr_name="*extension*"}, _) ->
- "_\nMatching over values of open types must include\n\
- a wild card pattern in order to be exhaustive."
+ "_\nMatching over values of extensible variant types must include\n\
+ a wild card pattern in order to be exhaustive."
| _ -> try
let buf = Buffer.create 16 in
let fmt = formatter_of_buffer buf in
pattern -> constructor_tag list -> constructor_description list
val pressure_variants: Env.t -> pattern list -> unit
-val check_partial: Location.t -> case list -> partial
val check_partial_gadt:
((string, constructor_description) Hashtbl.t ->
(string, label_description) Hashtbl.t ->
type param_subst = Id | Nth of int | Map of int list
+let is_nth = function
+ Nth _ -> true
+ | _ -> false
+
let compose l1 = function
| Id -> Map l1
| Map l2 -> Map (List.map (List.nth l1) l2)
type best_path = Paths of Path.t list | Best of Path.t
let printing_env = ref Env.empty
+let printing_depth = ref 0
+let printing_cont = ref ([] : Env.iter_cont list)
let printing_old = ref Env.empty
let printing_pers = ref Concr.empty
module Path2 = struct
| _ -> Pervasives.compare p1 p2
end
module PathMap = Map.Make(Path2)
-let printing_map = ref (Lazy.from_val PathMap.empty)
+let printing_map = ref PathMap.empty
let same_type t t' = repr t == repr t'
(* 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
+ printing_map := PathMap.empty;
+ printing_depth := 0;
+ (* printf "Recompute printing_map.@."; *)
+ let cont =
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
+ let r = PathMap.find p1 !printing_map in
match !r with
Paths l -> r := Paths (p :: l)
- | Best _ -> assert false
+ | Best p' -> r := Paths [p; p'] (* assert false *)
with Not_found ->
- map := PathMap.add p1 (ref (Paths [p])) !map)
- env;
- !map
- end
+ printing_map := PathMap.add p1 (ref (Paths [p])) !printing_map)
+ env in
+ printing_cont := [cont];
end
let wrap_printing_env env f =
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
+ let get_path () = get_best_path (PathMap.find p' !printing_map) in
+ while !printing_cont <> [] &&
+ try ignore (get_path ()); false with Not_found -> true
+ do
+ printing_cont := List.map snd (Env.run_iter_cont !printing_cont);
+ incr printing_depth;
+ done;
+ let p'' = try get_path () with Not_found -> p' in
(* Format.eprintf "%a = %a -> %a@." path p path p' path p''; *)
(p'', s)
match ty.desc with
Tvar _ | Tunivar _ | Tpoly _ -> false
| Tconstr (p, _, _) ->
- (match best_type_path p with (_, Nth _) -> false | _ -> true)
+ not (is_nth (snd (best_type_path p)))
| _ -> true
let namable_row row =
| Ttuple tyl ->
Otyp_tuple (tree_of_typlist sch tyl)
| Tconstr(p, tyl, abbrev) ->
- 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
+ let p', s = best_type_path p in
+ let tyl' = apply_subst s tyl in
+ if is_nth s then tree_of_typexp sch (List.hd tyl') else
+ Otyp_constr (tree_of_path p', tree_of_typlist sch tyl')
| Tvariant row ->
let row = row_repr row in
let fields =
begin match row.row_name with
| Some(p, tyl) when namable_row row ->
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
+ let args = tree_of_typlist sch (apply_subst s tyl) in
if row.row_closed && all_present then
- Otyp_constr (id, args)
+ if is_nth s then List.hd args else 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(id, args),
- row.row_closed, tags)
+ let inh =
+ match args with
+ [Otyp_constr (i, a)] when is_nth s -> Ovar_name (i, a)
+ | _ ->
+ (* fallback case, should change outcometree... *)
+ Ovar_name (tree_of_path p, tree_of_typlist sch tyl)
+ in
+ Otyp_variant (non_gen, inh, row.row_closed, tags)
| _ ->
let non_gen =
not (row.row_closed && all_present) && is_non_gen sch px in
let hide_rec_items = function
| Sig_type(id, decl, rs) ::rem
- when rs <> Trec_next && not !Clflags.real_paths ->
+ when rs = Trec_first && not !Clflags.real_paths ->
let rec get_ids = function
Sig_type (id, _, Trec_next) :: rem ->
id :: get_ids rem
Omty_alias (tree_of_path p)
and tree_of_signature sg =
- wrap_env (fun env -> env) (tree_of_signature_rec !printing_env) sg
+ wrap_env (fun env -> env) (tree_of_signature_rec !printing_env false) sg
-and tree_of_signature_rec env' = function
+and tree_of_signature_rec env' in_type_group = function
[] -> []
| item :: rem ->
- begin match item with
- Sig_type (_, _, rs) when rs <> Trec_next -> ()
- | _ -> set_printing_env env'
- end;
+ let in_type_group =
+ match in_type_group, item with
+ true, Sig_type (_, _, Trec_next) -> true
+ | _, Sig_type (_, _, (Trec_not | Trec_first)) -> set_printing_env env'; true
+ | _ -> set_printing_env env'; false
+ in
let (sg, rem) = filter_rem_sig item rem in
let trees =
match item with
[tree_of_cltype_declaration id decl rs]
in
let env' = Env.add_signature (item :: sg) env' in
- trees @ tree_of_signature_rec env' rem
+ trees @ tree_of_signature_rec env' in_type_group rem
and tree_of_modtype_declaration id decl =
let mty =
| Some filename -> open_out filename in
sort_filter_phrases ();
ignore (List.fold_left (print_info pp) Location.none info);
+ begin match filename with
+ | None -> ()
+ | Some _ -> close_out pp
+ end;
phrases := [];
end else begin
annotations := [];
let open Ast_mapper in
{default_mapper with location = (fun _this _loc -> Location.none)}
-let attrs s x =
- if s.for_saving && not !Clflags.keep_locs
- then remove_loc.Ast_mapper.attributes remove_loc x
- else x
+let is_not_doc = function
+ | ({Location.txt = "ocaml.doc"}, _) -> false
+ | ({Location.txt = "ocaml.text"}, _) -> false
+ | ({Location.txt = "doc"}, _) -> false
+ | ({Location.txt = "text"}, _) -> false
+ | _ -> true
+let attrs s x =
+ let x =
+ if s.for_saving && not !Clflags.keep_docs then
+ List.filter is_not_doc x
+ else x
+ in
+ if s.for_saving && not !Clflags.keep_locs
+ then remove_loc.Ast_mapper.attributes remove_loc x
+ else x
let rec module_path s = function
Pident id as p ->
ext_args = List.map (typexp s) ext.ext_args;
ext_ret_type = may_map (typexp s) ext.ext_ret_type;
ext_private = ext.ext_private;
- ext_attributes = ext.ext_attributes;
+ ext_attributes = attrs s ext.ext_attributes;
ext_loc = if s.for_saving then Location.none else ext.ext_loc; }
in
cleanup_types ();
val signature: t -> signature -> signature
val modtype_declaration: t -> modtype_declaration -> modtype_declaration
val module_declaration: t -> module_declaration -> module_declaration
+val typexp : t -> Types.type_expr -> Types.type_expr
+val class_signature: t -> class_signature -> class_signature
(* Composition of substitutions:
apply (compose s1 s2) x = apply s2 (apply s1 x) *)
| _ -> true
in
let partial =
- Parmatch.check_partial pat.pat_loc
+ Typecore.check_partial val_env pat.pat_type pat.pat_loc
[{c_lhs=pat;
c_guard=None;
c_rhs = (* Dummy expression *)
let extract_concrete_variant env ty =
match extract_concrete_typedecl env ty with
(p0, p, {type_kind=Type_variant cstrs}) -> (p0, p, cstrs)
+ | (p0, p, {type_kind=Type_open}) -> (p0, p, [])
| _ -> raise Not_found
let extract_label_names sexp env ty =
| Tconstr(p,args,m) ->
ty_res.desc <- Tconstr(p,List.map (fun _ -> newvar ()) args,m);
enforce_constraints env ty_res;
- unify_pat_types loc env ty ty_res
+ unify_pat_types loc env ty_res ty
| _ -> assert false
(* Typing of patterns *)
backtrack snap;
None
+let check_partial ?(lev=get_current_level ()) env expected_ty =
+ Parmatch.check_partial_gadt (partial_pred ~lev env expected_ty)
+
let rec iter3 f lst1 lst2 lst3 =
match lst1,lst2,lst3 with
| x1::xs1,x2::xs2,x3::xs3 ->
| Bool_ty rest -> mk_constr "Bool_ty" [ mk_fmtty rest ]
| Alpha_ty rest -> mk_constr "Alpha_ty" [ mk_fmtty rest ]
| Theta_ty rest -> mk_constr "Theta_ty" [ mk_fmtty rest ]
+ | Any_ty rest -> mk_constr "Any_ty" [ mk_fmtty rest ]
| Reader_ty rest -> mk_constr "Reader_ty" [ mk_fmtty rest ]
| Ignored_reader_ty rest ->
mk_constr "Ignored_reader_ty" [ mk_fmtty rest ]
mk_constr "Ignored_param" [ mk_ignored ign; mk_fmt rest ]
| End_of_format ->
mk_constr "End_of_format" []
+ | Custom _ ->
+ (* Custom formatters have no syntax so they will never appear
+ in formats parsed from strings. *)
+ assert false
in
let legacy_behavior = not !Clflags.strict_formats in
let Fmt_EBB fmt = fmt_ebb_of_string ~legacy_behavior str in
end;
let partial =
if partial_flag then
- Parmatch.check_partial_gadt (partial_pred ~lev env ty_arg) loc cases
+ check_partial ~lev env ty_arg loc cases
else
Partial
in
Location.prerr_warning (List.hd spat_sexp_list).pvb_pat.ppat_loc
Warnings.Unused_rec_flag;
List.iter2
- (fun pat exp -> ignore(Parmatch.check_partial pat.pat_loc [case pat exp]))
+ (fun pat exp ->
+ ignore(check_partial env pat.pat_type pat.pat_loc [case pat exp]))
pat_list exp_list;
end_def();
List.iter2
(Ident.t * Asttypes.mutable_flag * Asttypes.virtual_flag * type_expr)
Vars.t ref *
Env.t * Env.t * Env.t
+val check_partial:
+ ?lev:int -> Env.t -> type_expr ->
+ Location.t -> Typedtree.case list -> Typedtree.partial
val type_expect:
?in_function:(Location.t * type_expr) ->
Env.t -> Parsetree.expression -> type_expr -> Typedtree.expression
(* Will be detected by check_recursion *)
Btype.backtrack snap
in
- check ty TypeSet.empty ty
+ Ctype.wrap_trace_gadt_instances env (check ty TypeSet.empty) ty
let check_well_founded_manifest env loc path decl =
if decl.type_manifest = None then () else
else decl
| _ -> decl
-(* Translate a set of mutually recursive type declarations *)
-let transl_type_decl env sdecl_list =
+(* Translate a set of type declarations, mutually recursive or not *)
+let transl_type_decl env rec_flag sdecl_list =
(* Add dummy types for fixed rows *)
let fixed_types = List.filter is_fixed_type sdecl_list in
let sdecl_list =
Ctype.init_def(Ident.current_time());
Ctype.begin_def();
(* Enter types. *)
- let temp_env = List.fold_left2 enter_type env sdecl_list id_list in
+ let temp_env =
+ match rec_flag with
+ | Asttypes.Nonrecursive -> env
+ | Asttypes.Recursive -> List.fold_left2 enter_type env sdecl_list id_list
+ in
(* Translate each declaration. *)
let current_slot = ref None in
let warn_unused = Warnings.is_active (Warnings.Unused_type_declaration "") in
let id_slots id =
- if not warn_unused then id, None
- else
- (* See typecore.ml for a description of the algorithm used
- to detect unused declarations in a set of recursive definitions. *)
- let slot = ref [] in
- let td = Env.find_type (Path.Pident id) temp_env in
- let name = Ident.name id in
- Env.set_type_used_callback
- name td
- (fun old_callback ->
- match !current_slot with
- | Some slot -> slot := (name, td) :: !slot
- | None ->
- List.iter (fun (name, d) -> Env.mark_type_used env name d)
- (get_ref slot);
- old_callback ()
- );
- id, Some slot
+ match rec_flag with
+ | Asttypes.Recursive when warn_unused ->
+ (* See typecore.ml for a description of the algorithm used
+ to detect unused declarations in a set of recursive definitions. *)
+ let slot = ref [] in
+ let td = Env.find_type (Path.Pident id) temp_env in
+ let name = Ident.name id in
+ Env.set_type_used_callback
+ name td
+ (fun old_callback ->
+ match !current_slot with
+ | Some slot -> slot := (name, td) :: !slot
+ | None ->
+ List.iter (fun (name, d) -> Env.mark_type_used env name d)
+ (get_ref slot);
+ old_callback ()
+ );
+ id, Some slot
+ | Asttypes.Recursive | Asttypes.Nonrecursive ->
+ id, None
in
let transl_declaration name_sdecl (id, slot) =
current_slot := slot; transl_declaration temp_env name_sdecl id in
decls env
in
(* Update stubs *)
- List.iter2
- (fun id sdecl -> update_type temp_env newenv id sdecl.ptype_loc)
- id_list sdecl_list;
+ begin match rec_flag with
+ | Asttypes.Nonrecursive -> ()
+ | Asttypes.Recursive ->
+ List.iter2
+ (fun id sdecl -> update_type temp_env newenv id sdecl.ptype_loc)
+ id_list sdecl_list
+ end;
(* Generalize type declarations. *)
Ctype.end_def();
List.iter (fun (_, decl) -> generalize_decl decl) decls;
open Format
val transl_type_decl:
- Env.t -> Parsetree.type_declaration list ->
+ Env.t -> Asttypes.rec_flag -> Parsetree.type_declaration list ->
Typedtree.type_declaration list * Env.t
val transl_exception:
val enter_structure : structure -> unit
val enter_value_description : value_description -> unit
- val enter_type_declaration : type_declaration -> unit
val enter_type_extension : type_extension -> unit
val enter_extension_constructor : extension_constructor -> unit
val enter_pattern : pattern -> unit
val leave_structure : structure -> unit
val leave_value_description : value_description -> unit
- val leave_type_declaration : type_declaration -> unit
val leave_type_extension : type_extension -> unit
val leave_extension_constructor : extension_constructor -> unit
val leave_pattern : pattern -> unit
val leave_binding : value_binding -> unit
val leave_bindings : rec_flag -> unit
+ val enter_type_declarations : rec_flag -> unit
+ val enter_type_declaration : type_declaration -> unit
+ val leave_type_declaration : type_declaration -> unit
+ val leave_type_declarations : rec_flag -> unit
+
end
module MakeIterator(Iter : IteratorArgument) : sig
| Tstr_value (rec_flag, list) ->
iter_bindings rec_flag list
| Tstr_primitive vd -> iter_value_description vd
- | Tstr_type list -> List.iter iter_type_declaration list
+ | Tstr_type list -> iter_type_declarations list
| Tstr_typext tyext -> iter_type_extension tyext
| Tstr_exception ext -> iter_extension_constructor ext
| Tstr_module x -> iter_module_binding x
option iter_core_type decl.typ_manifest;
Iter.leave_type_declaration decl
+ and iter_type_declarations decls =
+ let rec_flag =
+ let is_nonrec =
+ List.exists
+ (fun td ->
+ List.exists (fun (n, _) -> n.txt = "nonrec")
+ td.typ_attributes)
+ decls
+ in
+ if is_nonrec then Nonrecursive else Recursive
+ in
+ Iter.enter_type_declarations rec_flag;
+ List.iter iter_type_declaration decls;
+ Iter.leave_type_declarations rec_flag
+
and iter_extension_constructor ext =
Iter.enter_extension_constructor ext;
begin match ext.ext_kind with
Tsig_value vd ->
iter_value_description vd
| Tsig_type list ->
- List.iter iter_type_declaration list
+ iter_type_declarations list
| Tsig_exception ext ->
iter_extension_constructor ext
| Tsig_typext tyext ->
let enter_structure _ = ()
let enter_value_description _ = ()
- let enter_type_declaration _ = ()
let enter_type_extension _ = ()
let enter_extension_constructor _ = ()
let enter_pattern _ = ()
let leave_structure _ = ()
let leave_value_description _ = ()
- let leave_type_declaration _ = ()
let leave_type_extension _ = ()
let leave_extension_constructor _ = ()
let leave_pattern _ = ()
let enter_bindings _ = ()
let leave_bindings _ = ()
- end
+ let enter_type_declaration _ = ()
+ let leave_type_declaration _ = ()
+
+ let enter_type_declarations _ = ()
+ let leave_type_declarations _ = ()
+end
module type IteratorArgument = sig
val enter_structure : structure -> unit
val enter_value_description : value_description -> unit
- val enter_type_declaration : type_declaration -> unit
val enter_type_extension : type_extension -> unit
val enter_extension_constructor : extension_constructor -> unit
val enter_pattern : pattern -> unit
val leave_structure : structure -> unit
val leave_value_description : value_description -> unit
- val leave_type_declaration : type_declaration -> unit
val leave_type_extension : type_extension -> unit
val leave_extension_constructor : extension_constructor -> unit
val leave_pattern : pattern -> unit
val leave_binding : value_binding -> unit
val leave_bindings : rec_flag -> unit
+ val enter_type_declarations : rec_flag -> unit
+ val enter_type_declaration : type_declaration -> unit
+ val leave_type_declaration : type_declaration -> unit
+ val leave_type_declarations : rec_flag -> unit
+
end
module MakeIterator :
[] -> []
| _ :: l -> ("a" ^ string_of_int n) :: make_params (n+1) l
-let make_next_first rs rem =
- if rs = Trec_first then
- match rem with
- Sig_type (id, decl, Trec_next) :: rem ->
- Sig_type (id, decl, Trec_first) :: rem
- | Sig_module (id, mty, Trec_next) :: rem ->
- Sig_module (id, mty, Trec_first) :: rem
- | _ -> rem
- else rem
+let update_rec_next rs rem =
+ match rs with
+ Trec_next -> rem
+ | Trec_first | Trec_not ->
+ match rem with
+ Sig_type (id, decl, Trec_next) :: rem ->
+ Sig_type (id, decl, rs) :: rem
+ | Sig_module (id, mty, Trec_next) :: rem ->
+ Sig_module (id, mty, rs) :: rem
+ | _ -> rem
let sig_item desc typ env loc = {
Typedtree.sig_desc = desc; sig_loc = loc; sig_env = env
check_type_decl env sdecl.ptype_loc id row_id newdecl decl rs rem;
real_id := Some id;
(Pident id, lid, Twith_typesubst tdecl),
- make_next_first rs rem
+ update_rec_next rs rem
| (Sig_module(id, md, rs) :: rem, [s], Pwith_module (_, lid'))
when Ident.name id = s ->
let path, md' = Typetexp.find_module initial_env loc lid'.txt in
ignore(Includemod.modtypes env newmd.md_type md.md_type);
real_id := Some id;
(Pident id, lid, Twith_modsubst (path, lid')),
- make_next_first rs rem
+ update_rec_next rs rem
| (Sig_module(id, md, rs) :: rem, s :: namelist, _)
when Ident.name id = s ->
let ((path, path_loc, tcstr), newsg) =
| [] -> rem
| d1 :: dl -> fn Trec_first d1 :: map_end (fn Trec_next) dl rem
-let map_rec' = map_rec
-(*
-let rec map_rec' fn decls rem =
+let map_rec_type ~rec_flag fn decls rem =
match decls with
- | (id,_ as d1) :: dl when Btype.is_row_name (Ident.name id) ->
- fn Trec_not d1 :: map_rec' fn dl rem
- | _ -> map_rec fn decls rem
-*)
+ | [] -> rem
+ | d1 :: dl ->
+ let first =
+ match rec_flag with
+ | Recursive -> Trec_first
+ | Nonrecursive -> Trec_not
+ in
+ fn first d1 :: map_end (fn Trec_next) dl rem
-let rec map_rec'' fn decls rem =
+let rec map_rec_type_with_row_types ~rec_flag fn decls rem =
match decls with
- | d1 :: dl when Btype.is_row_name (Ident.name d1.typ_id) ->
- fn Trec_not d1 :: map_rec'' fn dl rem
- | _ -> map_rec fn decls rem
+ | [] -> rem
+ | d1 :: dl ->
+ if Btype.is_row_name (Ident.name d1.typ_id) then
+ fn Trec_not d1 :: map_rec_type_with_row_types ~rec_flag fn dl rem
+ else
+ map_rec_type ~rec_flag fn decls rem
+
+let rec_flag_of_ptype_declarations tds =
+ let is_nonrec =
+ List.exists
+ (fun td ->
+ List.exists (fun (n, _) -> n.txt = "nonrec")
+ td.ptype_attributes)
+ tds
+ in
+ if is_nonrec then Nonrecursive else Recursive
(* Add type extension flags to extension contructors *)
let map_ext fn exts rem =
| item :: srem ->
match item.psig_desc with
| Psig_type sdecls ->
+ let rec_flag = rec_flag_of_ptype_declarations sdecls in
let decls = Typedecl.approx_type_decl env sdecls in
let rem = approx_sig env srem in
- map_rec' (fun rs (id, info) -> Sig_type(id, info, rs)) decls rem
+ map_rec_type ~rec_flag
+ (fun rs (id, info) -> Sig_type(id, info, rs)) decls rem
| Psig_module pmd ->
let md = approx_module_declaration env pmd in
let (id, newenv) =
else Sig_value(tdesc.val_id, tdesc.val_val) :: rem),
final_env
| Psig_type sdecls ->
+ let rec_flag = rec_flag_of_ptype_declarations sdecls in
List.iter
(fun decl ->
check_name "type" type_names decl.ptype_name)
sdecls;
- let (decls, newenv) = Typedecl.transl_type_decl env sdecls in
+ let (decls, newenv) = Typedecl.transl_type_decl env rec_flag sdecls in
let (trem, rem, final_env) = transl_sig newenv srem in
mksig (Tsig_type decls) env loc :: trem,
- map_rec'' (fun rs td ->
- Sig_type(td.typ_id, td.typ_type, rs)) decls rem,
+ map_rec_type_with_row_types ~rec_flag
+ (fun rs td -> Sig_type(td.typ_id, td.typ_type, rs)) decls rem,
final_env
| Psig_typext styext ->
let (tyext, newenv) =
path_of_module mexp
| _ -> raise Not_a_path
+let path_of_module mexp =
+ try Some (path_of_module mexp) with Not_a_path -> None
+
(* Check that all core type schemes in a structure are closed *)
let rec closed_modtype = function
mod_loc = smod.pmod_loc }
| Pmod_apply(sfunct, sarg) ->
let arg = type_module true funct_body None env sarg in
- let path = try Some (path_of_module arg) with Not_a_path -> None in
+ let path = path_of_module arg in
let funct =
type_module (sttn && path <> None) funct_body None env sfunct in
begin match Env.scrape_alias env funct.mod_type with
let (desc, newenv) = Typedecl.transl_value_decl env loc sdesc in
Tstr_primitive desc, [Sig_value(desc.val_id, desc.val_val)], newenv
| Pstr_type sdecls ->
+ let rec_flag = rec_flag_of_ptype_declarations sdecls in
List.iter
(fun decl -> check_name "type" type_names decl.ptype_name)
sdecls;
- let (decls, newenv) = Typedecl.transl_type_decl env sdecls in
+ let (decls, newenv) = Typedecl.transl_type_decl env rec_flag sdecls in
Tstr_type decls,
- map_rec'' (fun rs info -> Sig_type(info.typ_id, info.typ_type, rs))
+ map_rec_type_with_row_types ~rec_flag
+ (fun rs info -> Sig_type(info.typ_id, info.typ_type, rs))
decls [],
enrich_type_decls anchor decls env newenv
| Pstr_typext styext ->
val type_open_:
?toplevel:bool -> Asttypes.override_flag ->
Env.t -> Location.t -> Longident.t Asttypes.loc -> Path.t * Env.t
-
+val modtype_of_package:
+ Env.t -> Location.t ->
+ Path.t -> Longident.t list -> type_expr list -> module_type
val simplify_signature: signature -> signature
+val path_of_module : Typedtree.module_expr -> Path.t option
+
val save_signature:
string -> Typedtree.signature -> string -> string ->
Env.t -> Types.signature_item list -> unit
}
and rec_status =
- Trec_not (* not recursive *)
+ Trec_not (* first in a nonrecursive group *)
| Trec_first (* first in a recursive group *)
- | Trec_next (* not first in a recursive group *)
+ | Trec_next (* not first in a recursive/nonrecursive group *)
and ext_status =
Text_first (* first constructor of an extension *)
}
and rec_status =
- Trec_not (* not recursive *)
+ Trec_not (* first in a nonrecursive group *)
| Trec_first (* first in a recursive group *)
- | Trec_next (* not first in a recursive group *)
+ | Trec_next (* not first in a recursive/nonrecursive group *)
and ext_status =
Text_first (* first constructor in an extension *)
r
let find_value env loc lid =
+ Env.check_value_name (Longident.last lid) loc;
let (path, decl) as r =
find_component Env.lookup_value (fun lid -> Unbound_value lid) env loc lid
in
let compile_file name =
command
(Printf.sprintf
- "%s -c %s %s %s %s"
+ "%s -c %s %s %s %s %s"
(match !Clflags.c_compiler with
| Some cc -> cc
| None ->
if !Clflags.native_code
then Config.native_c_compiler
else Config.bytecomp_c_compiler)
+ (if !Clflags.debug then "-g" else "")
(String.concat " " (List.rev !Clflags.all_ccopts))
(quote_prefixed "-I" (List.rev !Clflags.include_dirs))
(Clflags.std_include_flag "-I")
| MainDll
| Partial
+let remove_Wl cclibs =
+ cclibs |> List.map (fun cclib ->
+ (* -Wl,-foo,bar -> -foo bar *)
+ if String.length cclib >= 4 && "-Wl," = String.sub cclib 0 4 then
+ String.map (function ',' -> ' ' | c -> c)
+ (String.sub cclib 4 (String.length cclib - 4))
+ else cclib)
+
let call_linker mode output_name files extra =
- let files = quote_files files in
let cmd =
if mode = Partial then
- Printf.sprintf "%s%s %s %s"
+ Printf.sprintf "%s%s %s %s %s"
Config.native_pack_linker
(Filename.quote output_name)
- files
+ (quote_prefixed "-L" !Config.load_path)
+ (quote_files (remove_Wl files))
extra
else
Printf.sprintf "%s -o %s %s %s %s %s %s %s"
"" (*(Clflags.std_include_flag "-I")*)
(quote_prefixed "-L" !Config.load_path)
(String.concat " " (List.rev !Clflags.all_ccopts))
- files
+ (quote_files files)
extra
in
command cmd = 0
and fast = ref false (* -unsafe *)
and link_everything = ref false (* -linkall *)
and custom_runtime = ref false (* -custom *)
+and no_check_prims = ref false (* -no-check-prims *)
and bytecode_compatible_32 = ref false (* -compat-32 *)
and output_c_object = ref false (* -output-obj *)
+and output_complete_object = ref false (* -output-complete-obj *)
and all_ccopts = ref ([] : string list) (* -ccopt *)
and classic = ref false (* -nolabels *)
and nopervasives = ref false (* -nopervasives *)
let runtime_variant = ref "";; (* -runtime-variant *)
+let keep_docs = ref false (* -keep-docs *)
let keep_locs = ref false (* -keep-locs *)
let unsafe_string = ref true;; (* -safe-string / -unsafe-string *)
val fast : bool ref
val link_everything : bool ref
val custom_runtime : bool ref
+val no_check_prims : bool ref
val bytecode_compatible_32 : bool ref
val output_c_object : bool ref
+val output_complete_object : bool ref
val all_ccopts : string list ref
val classic : bool ref
val nopervasives : bool ref
val dlcode : bool ref
val runtime_variant : string ref
val force_slash : bool ref
+val keep_docs : bool ref
val keep_locs : bool ref
val unsafe_string : bool ref
val opaque : bool ref
else search (i+1) 0
in search start 0
+let replace_substring ~before ~after str =
+ let rec search acc curr =
+ match search_substring before str curr with
+ | next ->
+ let prefix = String.sub str curr (next - curr) in
+ search (prefix :: acc) (next + String.length before)
+ | exception Not_found ->
+ let suffix = String.sub str curr (String.length str - curr) in
+ List.rev (suffix :: acc)
+ in String.concat after (search [] 0)
+
let rev_split_words s =
let rec split1 res i =
if i >= String.length s then res else begin
at offset [start] in [str]. Raise [Not_found] if [pat]
does not occur. *)
+val replace_substring: before:string -> after:string -> string -> string
+ (* [search_substring ~before ~after str] replaces all occurences
+ of [before] with [after] in [str] and returns the resulting string. *)
+
val rev_split_words: string -> string list
(* [rev_split_words s] splits [s] in blank-separated words, and return
the list of words in reverse order. *)
| Attribute_payload of string * string (* 47 *)
| Eliminated_optional_arguments of string list (* 48 *)
| No_cmi_file of string (* 49 *)
+ | Bad_docstring of bool (* 50 *)
;;
(* If you remove a warning, leave a hole in the numbering. NEVER change
| Attribute_payload _ -> 47
| Eliminated_optional_arguments _ -> 48
| No_cmi_file _ -> 49
+ | Bad_docstring _ -> 50
;;
-let last_warning_number = 49
+let last_warning_number = 50
(* Must be the max number returned by the [number] function. *)
let letter = function
current := {error; active}
(* If you change these, don't forget to change them in man/ocamlc.m *)
-let defaults_w = "+a-4-6-7-9-27-29-32..39-41..42-44-45-48";;
+let defaults_w = "+a-4-6-7-9-27-29-32..39-41..42-44-45-48-50";;
let defaults_warn_error = "-a";;
let () = parse_options false defaults_w;;
(String.concat ", " sl)
| No_cmi_file s ->
"no cmi file was found in path for module " ^ s
+ | Bad_docstring unattached ->
+ if unattached then "unattached documentation comment (ignored)"
+ else "ambiguous documentation comment"
;;
let nerrors = ref 0;;
let print ppf w =
let msg = message w in
let num = number w in
- let newlines = ref 0 in
- for i = 0 to String.length msg - 1 do
- if msg.[i] = '\n' then incr newlines;
- done;
- let out_functions = Format.pp_get_formatter_out_functions ppf () in
- let countnewline x = incr newlines; out_functions.Format.out_newline x in
- Format.pp_set_formatter_out_functions ppf
- {out_functions with Format.out_newline = countnewline};
Format.fprintf ppf "%d: %s" num msg;
Format.pp_print_flush ppf ();
- Format.pp_set_formatter_out_functions ppf out_functions;
- if (!current).error.(num) then incr nerrors;
- !newlines
+ if (!current).error.(num) then incr nerrors
;;
exception Errors of int;;
43, "Nonoptional label applied as optional.";
44, "Open statement shadows an already defined identifier.";
45, "Open statement shadows an already defined label or constructor.";
- 46, "Illegal environment variable.";
+ 46, "Error in environment variable.";
47, "Illegal attribute payload.";
48, "Implicit elimination of optional arguments.";
- 49, "Absent cmi file when looking up module alias.";
+ 49, "Missing cmi file when looking up module alias.";
+ 50, "Unexpected documentation comment.";
]
;;
let help_warnings () =
List.iter (fun (i, s) -> Printf.printf "%3i %s\n" i s) descriptions;
- print_endline " A All warnings.";
+ print_endline " A all warnings";
for i = Char.code 'b' to Char.code 'z' do
let c = Char.chr i in
match letter c with
| [] -> ()
| [n] ->
- Printf.printf " %c Synonym for warning %i.\n" (Char.uppercase c) n
+ Printf.printf " %c warning %i\n" (Char.uppercase c) n
| l ->
- Printf.printf " %c Set of warnings %s.\n"
+ Printf.printf " %c warnings %s.\n"
(Char.uppercase c)
(String.concat ", " (List.map string_of_int l))
done;
| Attribute_payload of string * string (* 47 *)
| Eliminated_optional_arguments of string list (* 48 *)
| No_cmi_file of string (* 49 *)
+ | Bad_docstring of bool (* 50 *)
;;
val parse_options : bool -> string -> unit;;
val defaults_w : string;;
val defaults_warn_error : string;;
-val print : formatter -> t -> int;;
- (* returns the number of newlines in the printed string *)
-
+val print : formatter -> t -> unit;;
exception Errors of int;;
include ../config/Makefile
CC=$(BYTECC)
-CFLAGS=-O -DNDEBUG $(BYTECCCOMPOPTS)
+CFLAGS=-DNDEBUG $(BYTECCCOMPOPTS)
OBJS= closure.o error.o lalr.o lr0.o main.o mkpar.o output.o reader.o \
skeleton.o symtab.o verbose.o warshall.o
clean:
rm -f *.$(O) ocamlyacc.exe *~ version.h
-.SUFFIXES: .c .$(O)
-
-.c.$(O):
+%.$(O): %.c
$(BYTECC) -DNDEBUG -DNO_UNIX $(BYTECCCOMPOPTS) -c $<
depend:
projects / ocaml.git / commitdiff