From: Stephane Glondu Date: Fri, 12 Jun 2015 14:23:52 +0000 (+0200) Subject: Imported Upstream version 4.02.2~rc1 X-Git-Tag: archive/raspbian/4.08.1-4+rpi1~3^2~63^2~6 X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=b4487092fcc7bc534956f23f47e96303d1a90ba8;p=ocaml.git Imported Upstream version 4.02.2~rc1 --- diff --git a/.depend b/.depend index 5d95a9bb..d7eed05a 100644 --- a/.depend +++ b/.depend @@ -25,14 +25,16 @@ utils/terminfo.cmx : utils/terminfo.cmi 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 \ @@ -40,9 +42,11 @@ 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 \ @@ -51,10 +55,14 @@ parsing/ast_mapper.cmx : parsing/parsetree.cmi utils/misc.cmx \ 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 \ @@ -62,15 +70,19 @@ 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 @@ -94,10 +106,10 @@ typing/ctype.cmi : typing/types.cmi typing/path.cmi parsing/longident.cmi \ typing/ident.cmi typing/env.cmi parsing/asttypes.cmi typing/datarepr.cmi : typing/types.cmi typing/path.cmi typing/ident.cmi \ parsing/asttypes.cmi +typing/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 \ @@ -115,10 +127,10 @@ typing/parmatch.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 @@ -130,12 +142,13 @@ typing/typecore.cmi : typing/types.cmi typing/typedtree.cmi typing/path.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 \ @@ -176,6 +189,12 @@ typing/datarepr.cmo : typing/types.cmi typing/path.cmi parsing/location.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 \ @@ -188,12 +207,6 @@ typing/env.cmx : utils/warnings.cmx typing/types.cmx utils/tbl.cmx \ typing/datarepr.cmx utils/consistbl.cmx utils/config.cmx \ typing/cmi_format.cmx utils/clflags.cmx typing/btype.cmx \ parsing/asttypes.cmi typing/env.cmi -typing/envaux.cmo : typing/types.cmi typing/subst.cmi typing/printtyp.cmi \ - typing/path.cmi 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 \ @@ -252,6 +265,12 @@ typing/predef.cmx : typing/types.cmx typing/path.cmx parsing/location.cmx \ typing/ident.cmx typing/btype.cmx parsing/asttypes.cmi typing/predef.cmi typing/primitive.cmo : utils/misc.cmi typing/primitive.cmi typing/primitive.cmx : utils/misc.cmx typing/primitive.cmi +typing/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 \ @@ -264,12 +283,6 @@ typing/printtyp.cmx : typing/types.cmx typing/primitive.cmx \ parsing/location.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \ utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \ typing/printtyp.cmi -typing/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 \ @@ -284,20 +297,20 @@ typing/typeclass.cmo : utils/warnings.cmi typing/typetexp.cmi \ 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 \ @@ -332,14 +345,6 @@ typing/typedecl.cmx : utils/warnings.cmx typing/typetexp.cmx \ 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 \ @@ -348,6 +353,14 @@ typing/typedtreeMap.cmo : typing/typedtree.cmi utils/misc.cmi \ 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 \ @@ -431,15 +444,17 @@ bytecomp/bytelibrarian.cmx : utils/misc.cmx parsing/location.cmx \ utils/config.cmx bytecomp/cmo_format.cmi utils/clflags.cmx \ bytecomp/bytelink.cmx bytecomp/bytelibrarian.cmi bytecomp/bytelink.cmo : utils/warnings.cmi bytecomp/symtable.cmi \ - bytecomp/opcodes.cmo utils/misc.cmi parsing/location.cmi typing/ident.cmi \ - bytecomp/dll.cmi utils/consistbl.cmi utils/config.cmi \ - bytecomp/cmo_format.cmi utils/clflags.cmi utils/ccomp.cmi \ - bytecomp/bytesections.cmi bytecomp/bytelink.cmi + bytecomp/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 \ @@ -520,12 +535,12 @@ bytecomp/switch.cmo : bytecomp/switch.cmi bytecomp/switch.cmx : bytecomp/switch.cmi bytecomp/symtable.cmo : utils/tbl.cmi bytecomp/runtimedef.cmi \ typing/predef.cmi utils/misc.cmi bytecomp/meta.cmi 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 \ @@ -578,27 +593,29 @@ bytecomp/typeopt.cmo : typing/types.cmi typing/typedtree.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 @@ -611,8 +628,8 @@ asmcomp/printlinear.cmi : asmcomp/linearize.cmi asmcomp/printmach.cmi : asmcomp/reg.cmi asmcomp/mach.cmi asmcomp/proc.cmi : asmcomp/reg.cmi asmcomp/mach.cmi asmcomp/reg.cmi : 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 \ @@ -621,12 +638,6 @@ asmcomp/selection.cmi : asmcomp/mach.cmi asmcomp/cmm.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 \ @@ -677,6 +688,14 @@ asmcomp/asmpackager.cmx : typing/typemod.cmx bytecomp/translmod.cmx \ utils/config.cmx asmcomp/compilenv.cmx asmcomp/cmx_format.cmi \ utils/clflags.cmx utils/ccomp.cmx asmcomp/asmlink.cmx asmcomp/asmgen.cmx \ asmcomp/asmpackager.cmi +asmcomp/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 \ @@ -691,10 +710,6 @@ asmcomp/closure.cmx : utils/tbl.cmx bytecomp/switch.cmx typing/primitive.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 \ @@ -707,6 +722,10 @@ asmcomp/cmmgen.cmx : typing/types.cmx bytecomp/switch.cmx \ utils/config.cmx asmcomp/compilenv.cmx asmcomp/cmx_format.cmi \ asmcomp/cmm.cmx utils/clflags.cmx asmcomp/clambda.cmx \ parsing/asttypes.cmi asmcomp/arch.cmx asmcomp/cmmgen.cmi +asmcomp/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 \ @@ -729,6 +748,12 @@ asmcomp/compilenv.cmo : utils/misc.cmi parsing/location.cmi typing/ident.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 \ @@ -737,20 +762,20 @@ asmcomp/debuginfo.cmo : parsing/location.cmi bytecomp/lambda.cmi \ 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 \ @@ -803,14 +828,14 @@ asmcomp/proc.cmx : asmcomp/reg.cmx utils/misc.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 @@ -849,8 +874,8 @@ driver/compenv.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 : @@ -885,6 +910,8 @@ driver/compmisc.cmx : typing/typemod.cmx utils/misc.cmx \ 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 \ @@ -895,8 +922,6 @@ driver/main.cmx : utils/warnings.cmx utils/misc.cmx driver/main_args.cmx \ driver/compile.cmx driver/compenv.cmx utils/clflags.cmx \ bytecomp/bytepackager.cmx bytecomp/bytelink.cmx \ bytecomp/bytelibrarian.cmx driver/main.cmi -driver/main_args.cmo : utils/warnings.cmi driver/main_args.cmi -driver/main_args.cmx : utils/warnings.cmx driver/main_args.cmi driver/optcompile.cmo : utils/warnings.cmi typing/typemod.cmi \ typing/typedtree.cmi typing/typecore.cmi bytecomp/translmod.cmi \ typing/stypes.cmi bytecomp/simplif.cmi typing/printtyped.cmi \ @@ -952,13 +977,15 @@ toplevel/expunge.cmo : bytecomp/symtable.cmi bytecomp/runtimedef.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 \ @@ -1010,7 +1037,7 @@ toplevel/topdirs.cmo : utils/warnings.cmi typing/typetexp.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 \ @@ -1018,7 +1045,7 @@ toplevel/topdirs.cmx : utils/warnings.cmx typing/typetexp.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 \ diff --git a/.gitignore b/.gitignore index 6c66ecc5..87f7cda4 100644 --- a/.gitignore +++ b/.gitignore @@ -202,11 +202,11 @@ /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 @@ -2161,6 +2161,31 @@ /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 diff --git a/.merlin b/.merlin new file mode 100644 index 00000000..99779840 --- /dev/null +++ b/.merlin @@ -0,0 +1,51 @@ +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 + diff --git a/.travis-ci.sh b/.travis-ci.sh index 788c997a..e34353af 100644 --- a/.travis-ci.sh +++ b/.travis-ci.sh @@ -3,11 +3,11 @@ i386) ./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 ;; diff --git a/Changes b/Changes index f1435285..dfa9e700 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,244 @@ -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: @@ -17,7 +256,7 @@ 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) @@ -49,6 +288,8 @@ Standard library: (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 @@ -66,8 +307,8 @@ Standard library: - 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 "*") @@ -76,7 +317,7 @@ Language features: (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) @@ -107,8 +348,8 @@ Type system: 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 @@ -359,7 +600,7 @@ Features wishes: - 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 = ..." @@ -419,8 +660,8 @@ Features wishes: - 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 "*") @@ -855,8 +1096,8 @@ Tools: (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 @@ -885,8 +1126,8 @@ Bug fixes: - 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 "*") @@ -1212,8 +1453,8 @@ Other changes: - 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 @@ -1310,8 +1551,8 @@ Other changes: 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 "*" ) @@ -1441,8 +1682,8 @@ Bug Fixes: - 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 @@ -1490,8 +1731,8 @@ Feature wishes: - 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 @@ -1546,8 +1787,8 @@ Other changes: - 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 "*" ) @@ -1677,8 +1918,8 @@ Bug fixes: - 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 @@ -1695,8 +1936,8 @@ Bug fixes: - 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 @@ -1782,8 +2023,8 @@ New features: 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 "*" ) @@ -1860,8 +2101,8 @@ Lexer generator (ocamllex): improved error reporting. 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 @@ -1896,8 +2137,8 @@ New features: -Objective Caml 3.09.2: ----------------------- +Objective Caml 3.09.2 (14 Apr 2006): +------------------------------------ Bug fixes: - Makefile: problem with "make world.opt" PR#3954 @@ -1927,8 +2168,8 @@ New features: - 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 @@ -1962,8 +2203,8 @@ Bug fixes: 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 "*" ) @@ -2037,8 +2278,8 @@ Miscellaneous: - 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 @@ -2085,8 +2326,8 @@ Bug fixes: - 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) @@ -2130,8 +2371,8 @@ Bug fixes: - 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) @@ -2151,8 +2392,8 @@ Misc: - 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 @@ -2176,8 +2417,8 @@ Misc: - 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 "*" ) @@ -2278,8 +2519,8 @@ Camlp4: - 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 @@ -2438,8 +2679,8 @@ OCamldoc: - 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. @@ -2464,8 +2705,8 @@ Windows ports: - 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. @@ -2596,8 +2837,8 @@ Windows port: - 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 @@ -2664,8 +2905,8 @@ License: added special exception to the LGPL'ed code (libraries and 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 @@ -2745,8 +2986,8 @@ Windows port: -Objective Caml 3.02: --------------------- +Objective Caml 3.02 (30 Jul 2001): +---------------------------------- Both compilers: - Fixed embarrassing bug in pattern-matching compilation @@ -2811,8 +3052,8 @@ MacOS 9 port: - 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. @@ -2929,8 +3170,8 @@ Mac OS ports: - Int64.format works on Mac OS 8/9. -Objective Caml 3.00: --------------------- +Objective Caml 3.00 (25 Apr 2000): +---------------------------------- Language: - OCaml/OLabl merger: @@ -3040,8 +3281,8 @@ Macintosh port: 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. @@ -3054,8 +3295,8 @@ Objective Caml 2.04: - 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). @@ -3140,8 +3381,8 @@ Others: 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. @@ -3223,8 +3464,8 @@ Objective Caml 2.02: - 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 @@ -3301,8 +3542,8 @@ Objective Caml 2.01: * 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/ @@ -3400,8 +3641,8 @@ Objective Caml 2.00: - 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 @@ -3425,8 +3666,8 @@ Objective Caml 1.07: * 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" @@ -3523,8 +3764,8 @@ Objective Caml 1.06: * 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. @@ -3542,8 +3783,8 @@ handling of checkpoints; various other small fixes. * 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 @@ -3605,8 +3846,8 @@ Objective Caml 1.04: * 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 @@ -3654,8 +3895,9 @@ Objective Caml 1.03: * 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; @@ -3711,8 +3953,9 @@ Objective Caml 1.02: 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; @@ -3763,8 +4006,8 @@ Objective Caml 1.01: 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. @@ -3799,8 +4042,8 @@ marshaling to/from strings. * 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. @@ -3830,8 +4073,8 @@ manifest module type specifications. * 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. @@ -3844,8 +4087,8 @@ out-of-order pops fixed. * 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. @@ -3868,13 +4111,13 @@ Intel decided to organize the floating-point registers as a stack). * 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). @@ -3896,8 +4139,8 @@ core on me). * 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). @@ -3914,8 +4157,8 @@ arbitrary-precision arithmetic have been ported (thanks to John 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) @@ -3931,7 +4174,7 @@ no calls to ranlib in Solaris * 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. diff --git a/INSTALL b/INSTALL index 63ae5c67..a83bbd3b 100644 --- a/INSTALL +++ b/INSTALL @@ -140,15 +140,24 @@ Examples: 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" diff --git a/Makefile b/Makefile index 6c0e7e64..1cfc9b40 100644 --- a/Makefile +++ b/Makefile @@ -13,20 +13,20 @@ # 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 @@ -43,7 +43,7 @@ UTILS=utils/misc.cmo utils/tbl.cmo utils/config.cmo \ 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 \ @@ -94,6 +94,8 @@ ASMCOMP=asmcomp/arch.cmo asmcomp/debuginfo.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 @@ -192,7 +194,7 @@ coldstart: 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: @@ -317,7 +319,7 @@ install: 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 \ @@ -538,8 +540,8 @@ $(COMMON:.cmo=.cmx) $(BYTECOMP:.cmo=.cmx) $(ASMCOMP:.cmo=.cmx): ocamlopt # 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:: @@ -552,9 +554,9 @@ beforedepend:: bytecomp/opcodes.ml 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 = [|'; \ @@ -628,8 +630,7 @@ partialclean:: 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 @@ -677,7 +678,7 @@ library: ocamlc 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 @@ -751,7 +752,7 @@ alldepend:: otherlibraries: ocamltools for i in $(OTHERLIBRARIES); do \ - (cd otherlibs/$$i; $(MAKE) RUNTIME=$(RUNTIME) all) || exit $$?; \ + (cd otherlibs/$$i; $(MAKE) all) || exit $$?; \ done otherlibrariesopt: @@ -798,9 +799,8 @@ alldepend:: # 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 diff --git a/Makefile.nt b/Makefile.nt index 16b53fe2..3179374c 100644 --- a/Makefile.nt +++ b/Makefile.nt @@ -13,18 +13,18 @@ # 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) @@ -39,7 +39,7 @@ UTILS=utils/misc.cmo utils/tbl.cmo utils/config.cmo \ 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 \ @@ -277,7 +277,9 @@ installopt: 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 @@ -463,8 +465,8 @@ $(COMMON:.cmo=.cmx) $(BYTECOMP:.cmo=.cmx) $(ASMCOMP:.cmo=.cmx): ocamlopt # 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:: @@ -477,9 +479,9 @@ beforedepend:: bytecomp/opcodes.ml 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 = [|'; \ @@ -550,7 +552,7 @@ beforedepend:: asmcomp/scheduling.ml # 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 @@ -603,7 +605,7 @@ alldepend:: 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:: @@ -659,15 +661,25 @@ alldepend:: # 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 @@ -729,6 +741,7 @@ alldepend:: depend 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 diff --git a/README.win32 b/README.win32 index 111c9a10..0f520f46 100644 --- a/README.win32 +++ b/README.win32 @@ -1,11 +1,14 @@ 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 @@ -15,7 +18,7 @@ Here is a summary of the main differences between these ports: 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 @@ -161,12 +164,12 @@ contributed his changes to the OCaml project. ------------------------------------------------------------------------------ - 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. @@ -177,14 +180,18 @@ the Cygwin development tools, available at http://www.cygwin.com/ and the flexdll tool, available at http://alain.frisch.fr/flexdll.html -You will need to install at least the following Cygwin packages (use -the Setup tool from Cygwin): +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: @@ -218,13 +225,22 @@ You will need the following software components to perform the recompilation: - 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 @@ -238,8 +254,13 @@ directory of the OCaml distribution. Then, do 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 @@ -260,7 +281,7 @@ NOTES: * 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 diff --git a/VERSION b/VERSION index 9023b27c..7fb240e1 100644 --- a/VERSION +++ b/VERSION @@ -1,4 +1,4 @@ -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 diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp index b576ece9..d56d0f5f 100644 --- a/asmcomp/amd64/emit.mlp +++ b/asmcomp/amd64/emit.mlp @@ -20,6 +20,12 @@ open Mach 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") diff --git a/asmcomp/arm/emit.mlp b/asmcomp/arm/emit.mlp index 61035b85..4948fb2b 100644 --- a/asmcomp/arm/emit.mlp +++ b/asmcomp/arm/emit.mlp @@ -852,8 +852,10 @@ let fundecl fundecl = 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; diff --git a/asmcomp/arm64/arch.ml b/asmcomp/arm64/arch.ml index bfbe183f..3e62da89 100644 --- a/asmcomp/arm64/arch.ml +++ b/asmcomp/arm64/arch.ml @@ -34,8 +34,12 @@ type addressing_mode = (* 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 *) @@ -91,6 +95,12 @@ let print_addressing printreg addr ppf arg = 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 -> "+" @@ -103,6 +113,9 @@ let print_specific_operation printreg op ppf arg = 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) diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp index 734bd23e..750c2b23 100644 --- a/asmcomp/arm64/emit.mlp +++ b/asmcomp/arm64/emit.mlp @@ -231,6 +231,32 @@ let emit_intconst dst n = 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" *) @@ -302,6 +328,217 @@ let emit_load_symbol_addr dst s = ` 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 = @@ -410,29 +647,9 @@ 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` @@ -443,14 +660,35 @@ let emit_instr i = 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` @@ -506,7 +744,7 @@ let emit_instr i = 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 -> @@ -654,12 +892,24 @@ let fundecl fundecl = 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`; diff --git a/asmcomp/asmlink.ml b/asmcomp/asmlink.ml index 153da7ca..cea7b568 100644 --- a/asmcomp/asmlink.ml +++ b/asmcomp/asmlink.ml @@ -91,10 +91,11 @@ let extract_crc_implementations () = 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 () = @@ -179,7 +180,7 @@ let scan_file obj_name tolink = match read_file obj_name with | 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 @@ -284,12 +285,13 @@ let link_shared ppf objfiles output_name = 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 diff --git a/asmcomp/branch_relaxation.ml b/asmcomp/branch_relaxation.ml new file mode 100644 index 00000000..d4609e4a --- /dev/null +++ b/asmcomp/branch_relaxation.ml @@ -0,0 +1,138 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/asmcomp/branch_relaxation.mli b/asmcomp/branch_relaxation.mli new file mode 100644 index 00000000..e2a93f83 --- /dev/null +++ b/asmcomp/branch_relaxation.mli @@ -0,0 +1,26 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/asmcomp/branch_relaxation_intf.ml b/asmcomp/branch_relaxation_intf.ml new file mode 100644 index 00000000..0812c7c1 --- /dev/null +++ b/asmcomp/branch_relaxation_intf.ml @@ -0,0 +1,64 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index 1f640b9b..83149660 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -349,10 +349,10 @@ let mod_int c1 c2 dbg = (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 -> @@ -1254,13 +1254,21 @@ let subst_boxed_number unbox_fn boxed_id unboxed_id box_chunk box_offset exp = 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) @@ -1270,7 +1278,10 @@ let subst_boxed_number unbox_fn boxed_id unboxed_id box_chunk box_offset exp = | 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) diff --git a/asmcomp/emitaux.ml b/asmcomp/emitaux.ml index 24a621b3..ec2e8f06 100644 --- a/asmcomp/emitaux.ml +++ b/asmcomp/emitaux.ml @@ -195,6 +195,15 @@ let cfi_adjust_cfa_offset n = 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 *) diff --git a/asmcomp/emitaux.mli b/asmcomp/emitaux.mli index 486a5839..e943da38 100644 --- a/asmcomp/emitaux.mli +++ b/asmcomp/emitaux.mli @@ -56,3 +56,4 @@ val is_generic_function: string -> bool 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 diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp index 0a26ed14..43440852 100644 --- a/asmcomp/power/emit.mlp +++ b/asmcomp/power/emit.mlp @@ -308,126 +308,87 @@ let defined_functions = ref StringSet.empty (* 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 *) @@ -848,7 +809,10 @@ let fundecl fundecl = ` 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 diff --git a/asmrun/.depend b/asmrun/.depend index 1088ad8e..e761606f 100644 --- a/asmrun/.depend +++ b/asmrun/.depend @@ -1,753 +1,1044 @@ -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 diff --git a/asmrun/Makefile b/asmrun/Makefile index 63ff80c6..37b6182d 100644 --- a/asmrun/Makefile +++ b/asmrun/Makefile @@ -16,9 +16,10 @@ include ../config/Makefile 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 \ @@ -32,12 +33,13 @@ ASMOBJS=$(ARCH).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: @@ -48,7 +50,7 @@ all-runtimed: libasmrund.a libasmrund.a: $(DOBJS) rm -f libasmrund.a - ar rc libasmrund.a $(DOBJS) + $(ARCMD) rc libasmrund.a $(DOBJS) $(RANLIB) libasmrund.a all-noprof: @@ -57,16 +59,29 @@ all-prof: libasmrunp.a 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 @@ -79,10 +94,21 @@ install-runtimed: 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 @@ -93,6 +119,9 @@ power.o: power-$(SYSTEM).o 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 @@ -173,40 +202,43 @@ LINKEDFILES=misc.c freelist.c major_gc.c minor_gc.c memory.c alloc.c array.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 diff --git a/asmrun/Makefile.nt b/asmrun/Makefile.nt index 77c2002d..dba8343c 100644 --- a/asmrun/Makefile.nt +++ b/asmrun/Makefile.nt @@ -68,9 +68,7 @@ $(LINKEDFILES): %.c: ../byterun/%.c 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:: diff --git a/asmrun/amd64.S b/asmrun/amd64.S index d2e00752..be38848e 100644 --- a/asmrun/amd64.S +++ b/asmrun/amd64.S @@ -471,7 +471,7 @@ FUNCTION(G(caml_start_program)) /* 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 */ @@ -636,7 +636,7 @@ CFI_STARTPROC 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 @@ -649,13 +649,13 @@ CFI_STARTPROC 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 diff --git a/asmrun/backtrace.c b/asmrun/backtrace.c index 05e0d6b2..fafe13a0 100644 --- a/asmrun/backtrace.c +++ b/asmrun/backtrace.c @@ -17,11 +17,11 @@ #include #include -#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; @@ -204,17 +204,8 @@ CAMLprim value caml_get_current_callstack(value max_frames_value) { /* 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; @@ -260,7 +251,7 @@ static void extract_location_info(frame_descr * d, 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; @@ -293,7 +284,7 @@ static void print_location(struct loc_info * li, int index) 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); @@ -306,7 +297,7 @@ void caml_print_exception_backtrace(void) 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); diff --git a/asmrun/fail.c b/asmrun/fail.c index cb2c1cbd..c674d1a8 100644 --- a/asmrun/fail.c +++ b/asmrun/fail.c @@ -15,17 +15,17 @@ #include #include -#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 */ diff --git a/asmrun/i386.S b/asmrun/i386.S index 347e967c..e55969ee 100644 --- a/asmrun/i386.S +++ b/asmrun/i386.S @@ -19,7 +19,7 @@ /* 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 diff --git a/asmrun/natdynlink.c b/asmrun/natdynlink.c index 86c4f3e6..82e8795f 100644 --- a/asmrun/natdynlink.c +++ b/asmrun/natdynlink.c @@ -11,15 +11,16 @@ /* */ /***********************************************************************/ -#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 #include @@ -51,10 +52,15 @@ CAMLprim value caml_natdynlink_open(value filename, value global) 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())); @@ -117,10 +123,15 @@ CAMLprim value caml_natdynlink_run_toplevel(value filename, value symbol) 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); diff --git a/asmrun/roots.c b/asmrun/roots.c index 93e7a655..32325e2e 100644 --- a/asmrun/roots.c +++ b/asmrun/roots.c @@ -13,15 +13,15 @@ /* 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 #include diff --git a/asmrun/signals_asm.c b/asmrun/signals_asm.c index df76c501..4ac2a64f 100644 --- a/asmrun/signals_asm.c +++ b/asmrun/signals_asm.c @@ -19,11 +19,11 @@ #include #include #include -#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" @@ -47,6 +47,8 @@ extern void caml_win32_overflow_detection(); 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) \ diff --git a/asmrun/signals_osdep.h b/asmrun/signals_osdep.h index f3b4642d..627e3b72 100644 --- a/asmrun/signals_osdep.h +++ b/asmrun/signals_osdep.h @@ -66,18 +66,7 @@ #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 - #endif + #include #define DECLARE_SIGNAL_HANDLER(name) \ static void name(int sig, siginfo_t * info, ucontext_t * context) @@ -163,14 +152,24 @@ #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 + #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 */ diff --git a/asmrun/stack.h b/asmrun/stack.h index 92b3c28a..6e559429 100644 --- a/asmrun/stack.h +++ b/asmrun/stack.h @@ -78,6 +78,15 @@ typedef struct { 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; @@ -90,6 +99,10 @@ extern void caml_init_frame_descriptors(void); 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); diff --git a/asmrun/startup.c b/asmrun/startup.c index 9a00f2d7..1fefe7fd 100644 --- a/asmrun/startup.c +++ b/asmrun/startup.c @@ -15,24 +15,24 @@ #include #include -#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; diff --git a/boot/ocamlc b/boot/ocamlc index a1aec5db..a70f3df7 100755 Binary files a/boot/ocamlc and b/boot/ocamlc differ diff --git a/boot/ocamldep b/boot/ocamldep index 2760d2f9..d5231c77 100755 Binary files a/boot/ocamldep and b/boot/ocamldep differ diff --git a/boot/ocamllex b/boot/ocamllex index 80acc9ea..7420b7e7 100755 Binary files a/boot/ocamllex and b/boot/ocamllex differ diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml index c0f8f6a9..2f5c0ec4 100644 --- a/bytecomp/bytelink.ml +++ b/bytecomp/bytelink.ml @@ -42,7 +42,7 @@ let lib_ccobjs = ref [] 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 @@ -50,7 +50,8 @@ let add_ccobjs l = 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 @@ -132,7 +133,7 @@ let scan_file obj_name tolink = 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 -> @@ -196,7 +197,7 @@ let clear_crc_interfaces () = (* 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 *) @@ -207,8 +208,14 @@ let link_compunit ppf output_fun currpos_fun inchan file_name compunit = 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 @@ -263,9 +270,10 @@ let link_file ppf output_fun currpos_fun = function 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 := [] @@ -309,7 +317,7 @@ let link_bytecode ppf tolink exec_name standalone = 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; @@ -572,8 +580,15 @@ let link ppf objfiles output_name = 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 @@ -581,13 +596,19 @@ let link ppf objfiles output_name = 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; diff --git a/bytecomp/lambda.ml b/bytecomp/lambda.ml index 5d9fb593..d32ac4fb 100644 --- a/bytecomp/lambda.ml +++ b/bytecomp/lambda.ml @@ -539,10 +539,9 @@ let lam_of_loc kind loc = | 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 diff --git a/bytecomp/symtable.ml b/bytecomp/symtable.ml index 1cc3a531..a0ce2737 100644 --- a/bytecomp/symtable.ml +++ b/bytecomp/symtable.ml @@ -81,7 +81,9 @@ let num_of_prim name = 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 = diff --git a/bytecomp/translmod.ml b/bytecomp/translmod.ml index a2944f3d..d3c6ca2b 100644 --- a/bytecomp/translmod.ml +++ b/bytecomp/translmod.ml @@ -121,7 +121,7 @@ and wrap_id_pos_list id_pos_list get_field lam = (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 @@ -405,7 +405,7 @@ and transl_structure fields cc rootpath = function | 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 @@ -596,7 +596,7 @@ let transl_store_structure glob map prims str = | 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 diff --git a/byterun/.depend b/byterun/.depend index 743737d0..ea58393c 100644 --- a/byterun/.depend +++ b/byterun/.depend @@ -1,422 +1,726 @@ -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 diff --git a/byterun/.ignore b/byterun/.ignore index 7b178a46..7eab2b62 100644 --- a/byterun/.ignore +++ b/byterun/.ignore @@ -1,8 +1,8 @@ -jumptbl.h +caml/jumptbl.h primitives prims.c -opnames.h -version.h +caml/opnames.h +caml/version.h ocamlrun ocamlrun.exe ocamlrund diff --git a/byterun/Makefile b/byterun/Makefile index 816dd75e..ae57e2a7 100644 --- a/byterun/Makefile +++ b/byterun/Makefile @@ -13,17 +13,14 @@ 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) \ @@ -34,42 +31,50 @@ ocamlrund$(EXE): libcamlrund.a prims.o 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 diff --git a/byterun/Makefile.common b/byterun/Makefile.common index b6bff219..2c56c43f 100755 --- a/byterun/Makefile.common +++ b/byterun/Makefile.common @@ -12,6 +12,8 @@ ######################################################################### include ../config/Makefile +CAMLRUN ?= ../boot/ocamlrun +CAMLYACC ?= ../boot/ocamlyacc CC=$(BYTECC) @@ -31,7 +33,8 @@ PRIMS=\ 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 @@ -56,13 +59,13 @@ INSTALL_LIBDIR=$(DESTDIR)$(LIBDIR) 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 @@ -72,6 +75,10 @@ install:: install-$(RUNTIMED) 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) @@ -96,8 +103,8 @@ primitives : $(PRIMS) | 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; \ @@ -106,23 +113,23 @@ prims.c : 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 diff --git a/byterun/Makefile.nt b/byterun/Makefile.nt index af288188..71873f21 100644 --- a/byterun/Makefile.nt +++ b/byterun/Makefile.nt @@ -24,7 +24,7 @@ ocamlrun$(EXE): libcamlrun.$(A) prims.$(O) $(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) @@ -33,21 +33,20 @@ 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 diff --git a/byterun/alloc.c b/byterun/alloc.c index 1fc33b55..6544a0c5 100644 --- a/byterun/alloc.c +++ b/byterun/alloc.c @@ -17,12 +17,12 @@ */ #include -#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 @@ -184,3 +184,7 @@ CAMLprim value caml_update_dummy(value dummy, value newval) } return Val_unit; } + + + + diff --git a/byterun/alloc.h b/byterun/alloc.h deleted file mode 100644 index f00a7ef0..00000000 --- a/byterun/alloc.h +++ /dev/null @@ -1,54 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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 */ diff --git a/byterun/array.c b/byterun/array.c index ba6fd701..76713bf8 100644 --- a/byterun/array.c +++ b/byterun/array.c @@ -14,11 +14,11 @@ /* Operations on arrays */ #include -#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) { diff --git a/byterun/backtrace.c b/byterun/backtrace.c index 76e3ddf5..008b199f 100644 --- a/byterun/backtrace.c +++ b/byterun/backtrace.c @@ -18,24 +18,24 @@ #include #include -#include "config.h" +#include "caml/config.h" #ifdef HAS_UNISTD #include #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; @@ -133,17 +133,17 @@ void caml_stash_backtrace(value exn, code_t pc, value * sp, int reraise) #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; @@ -170,10 +170,10 @@ CAMLprim value caml_get_current_callstack(value max_frames_value) { /* 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; } } @@ -183,11 +183,11 @@ CAMLprim value caml_get_current_callstack(value max_frames_value) { /* 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); } diff --git a/byterun/backtrace.h b/byterun/backtrace.h deleted file mode 100644 index ec499919..00000000 --- a/byterun/backtrace.h +++ /dev/null @@ -1,31 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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 */ diff --git a/byterun/callback.c b/byterun/callback.c index 5da37ec9..30109851 100644 --- a/byterun/callback.c +++ b/byterun/callback.c @@ -14,19 +14,19 @@ /* Callbacks from C to OCaml */ #include -#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; @@ -245,3 +245,14 @@ CAMLexport value * caml_named_value(char const *name) } 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 ); + } + } +} diff --git a/byterun/callback.h b/byterun/callback.h deleted file mode 100644 index ded0b980..00000000 --- a/byterun/callback.h +++ /dev/null @@ -1,55 +0,0 @@ -/***********************************************************************/ -/* */ -/* OCaml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the 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 diff --git a/byterun/caml/address_class.h b/byterun/caml/address_class.h new file mode 100644 index 00000000..f7908b6d --- /dev/null +++ b/byterun/caml/address_class.h @@ -0,0 +1,82 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/alloc.h b/byterun/caml/alloc.h new file mode 100644 index 00000000..f00a7ef0 --- /dev/null +++ b/byterun/caml/alloc.h @@ -0,0 +1,54 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/backtrace.h b/byterun/caml/backtrace.h new file mode 100644 index 00000000..ec499919 --- /dev/null +++ b/byterun/caml/backtrace.h @@ -0,0 +1,31 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/callback.h b/byterun/caml/callback.h new file mode 100644 index 00000000..ef50945c --- /dev/null +++ b/byterun/caml/callback.h @@ -0,0 +1,57 @@ +/***********************************************************************/ +/* */ +/* 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 diff --git a/byterun/caml/compact.h b/byterun/caml/compact.h new file mode 100644 index 00000000..2abac167 --- /dev/null +++ b/byterun/caml/compact.h @@ -0,0 +1,25 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/compare.h b/byterun/caml/compare.h new file mode 100644 index 00000000..41d6a0c9 --- /dev/null +++ b/byterun/caml/compare.h @@ -0,0 +1,19 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/compatibility.h b/byterun/caml/compatibility.h new file mode 100644 index 00000000..11181176 --- /dev/null +++ b/byterun/caml/compatibility.h @@ -0,0 +1,369 @@ +/***********************************************************************/ +/* */ +/* 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/.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 */ diff --git a/byterun/caml/config.h b/byterun/caml/config.h new file mode 100644 index 00000000..6f608364 --- /dev/null +++ b/byterun/caml/config.h @@ -0,0 +1,172 @@ +/***********************************************************************/ +/* */ +/* 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" +/* */ + +#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 */ diff --git a/byterun/caml/custom.h b/byterun/caml/custom.h new file mode 100644 index 00000000..ff3cd89a --- /dev/null +++ b/byterun/caml/custom.h @@ -0,0 +1,71 @@ +/***********************************************************************/ +/* */ +/* 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. */ + +/* */ +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); +/* */ + +#ifdef __cplusplus +} +#endif + +#endif /* CAML_CUSTOM_H */ diff --git a/byterun/caml/debugger.h b/byterun/caml/debugger.h new file mode 100644 index 00000000..b5079eb3 --- /dev/null +++ b/byterun/caml/debugger.h @@ -0,0 +1,111 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/dynlink.h b/byterun/caml/dynlink.h new file mode 100644 index 00000000..74cfdb66 --- /dev/null +++ b/byterun/caml/dynlink.h @@ -0,0 +1,36 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/exec.h b/byterun/caml/exec.h new file mode 100644 index 00000000..a58bcf8b --- /dev/null +++ b/byterun/caml/exec.h @@ -0,0 +1,60 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/fail.h b/byterun/caml/fail.h new file mode 100644 index 00000000..da72c780 --- /dev/null +++ b/byterun/caml/fail.h @@ -0,0 +1,84 @@ +/***********************************************************************/ +/* */ +/* 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 + +/* */ +#include +/* */ + +#ifndef CAML_NAME_SPACE +#include "compatibility.h" +#endif +#include "misc.h" +#include "mlvalues.h" + +/* */ +#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); + +/* */ + +#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 */ diff --git a/byterun/caml/finalise.h b/byterun/caml/finalise.h new file mode 100644 index 00000000..96853f52 --- /dev/null +++ b/byterun/caml/finalise.h @@ -0,0 +1,27 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/fix_code.h b/byterun/caml/fix_code.h new file mode 100644 index 00000000..419ad327 --- /dev/null +++ b/byterun/caml/fix_code.h @@ -0,0 +1,40 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/freelist.h b/byterun/caml/freelist.h new file mode 100644 index 00000000..146961fa --- /dev/null +++ b/byterun/caml/freelist.h @@ -0,0 +1,34 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/gc.h b/byterun/caml/gc.h new file mode 100644 index 00000000..3cbf08a2 --- /dev/null +++ b/byterun/caml/gc.h @@ -0,0 +1,56 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/gc_ctrl.h b/byterun/caml/gc_ctrl.h new file mode 100644 index 00000000..de6933e8 --- /dev/null +++ b/byterun/caml/gc_ctrl.h @@ -0,0 +1,42 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/globroots.h b/byterun/caml/globroots.h new file mode 100644 index 00000000..1c3ebab2 --- /dev/null +++ b/byterun/caml/globroots.h @@ -0,0 +1,25 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/hash.h b/byterun/caml/hash.h new file mode 100644 index 00000000..452a0925 --- /dev/null +++ b/byterun/caml/hash.h @@ -0,0 +1,36 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/instrtrace.h b/byterun/caml/instrtrace.h new file mode 100644 index 00000000..30201608 --- /dev/null +++ b/byterun/caml/instrtrace.h @@ -0,0 +1,30 @@ +/***********************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the 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 diff --git a/byterun/caml/instruct.h b/byterun/caml/instruct.h new file mode 100644 index 00000000..f9cc80ee --- /dev/null +++ b/byterun/caml/instruct.h @@ -0,0 +1,62 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/int64_emul.h b/byterun/caml/int64_emul.h new file mode 100644 index 00000000..ba7904a4 --- /dev/null +++ b/byterun/caml/int64_emul.h @@ -0,0 +1,287 @@ +/***********************************************************************/ +/* */ +/* 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 + +#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 */ diff --git a/byterun/caml/int64_format.h b/byterun/caml/int64_format.h new file mode 100644 index 00000000..b0de5272 --- /dev/null +++ b/byterun/caml/int64_format.h @@ -0,0 +1,105 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/int64_native.h b/byterun/caml/int64_native.h new file mode 100644 index 00000000..e9ffe674 --- /dev/null +++ b/byterun/caml/int64_native.h @@ -0,0 +1,61 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/interp.h b/byterun/caml/interp.h new file mode 100644 index 00000000..c8e2f89f --- /dev/null +++ b/byterun/caml/interp.h @@ -0,0 +1,31 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/intext.h b/byterun/caml/intext.h new file mode 100644 index 00000000..f7aa655c --- /dev/null +++ b/byterun/caml/intext.h @@ -0,0 +1,168 @@ +/***********************************************************************/ +/* */ +/* 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" + +/* */ +#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]. */ + +/* */ + +#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. */ + +/* */ +value caml_input_val (struct channel * chan); + /* Read a structured value from the channel [chan]. */ +/* */ + +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); + +/* */ + +/* 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; + +/* */ + +#ifdef __cplusplus +} +#endif + +#endif /* CAML_INTEXT_H */ diff --git a/byterun/caml/io.h b/byterun/caml/io.h new file mode 100644 index 00000000..64a8bf50 --- /dev/null +++ b/byterun/caml/io.h @@ -0,0 +1,115 @@ +/***********************************************************************/ +/* */ +/* 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 +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 */ diff --git a/byterun/caml/major_gc.h b/byterun/caml/major_gc.h new file mode 100644 index 00000000..f473df94 --- /dev/null +++ b/byterun/caml/major_gc.h @@ -0,0 +1,60 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/md5.h b/byterun/caml/md5.h new file mode 100644 index 00000000..d8aff097 --- /dev/null +++ b/byterun/caml/md5.h @@ -0,0 +1,41 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/memory.h b/byterun/caml/memory.h new file mode 100644 index 00000000..fe6d7823 --- /dev/null +++ b/byterun/caml/memory.h @@ -0,0 +1,409 @@ +/***********************************************************************/ +/* */ +/* 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" +/* */ +#include "gc.h" +#include "major_gc.h" +#include "minor_gc.h" +/* */ +#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 */ + +/* */ + +#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)) + +/* */ + +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 */ diff --git a/byterun/caml/minor_gc.h b/byterun/caml/minor_gc.h new file mode 100644 index 00000000..d3e8ac50 --- /dev/null +++ b/byterun/caml/minor_gc.h @@ -0,0 +1,52 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/misc.h b/byterun/caml/misc.h new file mode 100644 index 00000000..db0971d2 --- /dev/null +++ b/byterun/caml/misc.h @@ -0,0 +1,170 @@ +/***********************************************************************/ +/* */ +/* 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 +#include + +/* Basic types and constants */ + +typedef size_t asize_t; + +#ifndef NULL +#define NULL 0 +#endif + +/* */ +typedef char * addr; +/* */ + +#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 */ + +/* */ + +/* 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 + +/* */ + +#ifdef __cplusplus +} +#endif + +#endif /* CAML_MISC_H */ diff --git a/byterun/caml/mlvalues.h b/byterun/caml/mlvalues.h new file mode 100644 index 00000000..fe4a8f09 --- /dev/null +++ b/byterun/caml/mlvalues.h @@ -0,0 +1,305 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/osdeps.h b/byterun/caml/osdeps.h new file mode 100644 index 00000000..8204205f --- /dev/null +++ b/byterun/caml/osdeps.h @@ -0,0 +1,68 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/prims.h b/byterun/caml/prims.h new file mode 100644 index 00000000..7a996781 --- /dev/null +++ b/byterun/caml/prims.h @@ -0,0 +1,34 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/printexc.h b/byterun/caml/printexc.h new file mode 100644 index 00000000..748faa9c --- /dev/null +++ b/byterun/caml/printexc.h @@ -0,0 +1,33 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/reverse.h b/byterun/caml/reverse.h new file mode 100644 index 00000000..09d34a51 --- /dev/null +++ b/byterun/caml/reverse.h @@ -0,0 +1,86 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/roots.h b/byterun/caml/roots.h new file mode 100644 index 00000000..ca6a5d26 --- /dev/null +++ b/byterun/caml/roots.h @@ -0,0 +1,36 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/signals.h b/byterun/caml/signals.h new file mode 100644 index 00000000..58451666 --- /dev/null +++ b/byterun/caml/signals.h @@ -0,0 +1,57 @@ +/***********************************************************************/ +/* */ +/* 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 + +/* */ +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; +/* */ + +CAMLextern void caml_enter_blocking_section (void); +CAMLextern void caml_leave_blocking_section (void); + +/* */ +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); +/* */ + +#ifdef __cplusplus +} +#endif + +#endif /* CAML_SIGNALS_H */ diff --git a/byterun/caml/signals_machdep.h b/byterun/caml/signals_machdep.h new file mode 100644 index 00000000..4987e2f6 --- /dev/null +++ b/byterun/caml/signals_machdep.h @@ -0,0 +1,60 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/stacks.h b/byterun/caml/stacks.h new file mode 100644 index 00000000..c596f255 --- /dev/null +++ b/byterun/caml/stacks.h @@ -0,0 +1,41 @@ +/***********************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the 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 */ diff --git a/byterun/caml/startup.h b/byterun/caml/startup.h new file mode 100644 index 00000000..3dda64b3 --- /dev/null +++ b/byterun/caml/startup.h @@ -0,0 +1,38 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/sys.h b/byterun/caml/sys.h new file mode 100644 index 00000000..5eb18fc0 --- /dev/null +++ b/byterun/caml/sys.h @@ -0,0 +1,28 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/ui.h b/byterun/caml/ui.h new file mode 100644 index 00000000..29584650 --- /dev/null +++ b/byterun/caml/ui.h @@ -0,0 +1,26 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/caml/weak.h b/byterun/caml/weak.h new file mode 100644 index 00000000..0cf4b8b2 --- /dev/null +++ b/byterun/caml/weak.h @@ -0,0 +1,24 @@ +/***********************************************************************/ +/* */ +/* 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 */ diff --git a/byterun/compact.c b/byterun/compact.c index 0afbd9dc..9af9688d 100644 --- a/byterun/compact.c +++ b/byterun/compact.c @@ -13,16 +13,17 @@ #include -#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 */ @@ -58,7 +59,7 @@ static void invert_pointer_at (word *p) /* 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. */ diff --git a/byterun/compact.h b/byterun/compact.h deleted file mode 100644 index 2abac167..00000000 --- a/byterun/compact.h +++ /dev/null @@ -1,25 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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 */ diff --git a/byterun/compare.c b/byterun/compare.c index 6593ed9a..4e8d25af 100644 --- a/byterun/compare.c +++ b/byterun/compare.c @@ -13,11 +13,11 @@ #include #include -#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. */ diff --git a/byterun/compare.h b/byterun/compare.h deleted file mode 100644 index 41d6a0c9..00000000 --- a/byterun/compare.h +++ /dev/null @@ -1,19 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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 */ diff --git a/byterun/compatibility.h b/byterun/compatibility.h deleted file mode 100644 index 11181176..00000000 --- a/byterun/compatibility.h +++ /dev/null @@ -1,369 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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/.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 */ diff --git a/byterun/config.h b/byterun/config.h deleted file mode 100644 index f7759885..00000000 --- a/byterun/config.h +++ /dev/null @@ -1,172 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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" -/* */ - -#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 */ diff --git a/byterun/custom.c b/byterun/custom.c index e4f9eaf5..eeb976d9 100644 --- a/byterun/custom.c +++ b/byterun/custom.c @@ -13,11 +13,11 @@ #include -#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, diff --git a/byterun/custom.h b/byterun/custom.h deleted file mode 100644 index ff3cd89a..00000000 --- a/byterun/custom.h +++ /dev/null @@ -1,71 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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. */ - -/* */ -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); -/* */ - -#ifdef __cplusplus -} -#endif - -#endif /* CAML_CUSTOM_H */ diff --git a/byterun/debugger.c b/byterun/debugger.c index 6024ed92..41a64b1c 100644 --- a/byterun/debugger.c +++ b/byterun/debugger.c @@ -19,10 +19,10 @@ #include -#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; @@ -64,14 +64,14 @@ void caml_debugger_cleanup_fork(void) #include #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 */ diff --git a/byterun/debugger.h b/byterun/debugger.h deleted file mode 100644 index b5079eb3..00000000 --- a/byterun/debugger.h +++ /dev/null @@ -1,111 +0,0 @@ -/***********************************************************************/ -/* */ -/* OCaml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the 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 */ diff --git a/byterun/dynlink.c b/byterun/dynlink.c index 8b4498b9..6d09a3c0 100644 --- a/byterun/dynlink.c +++ b/byterun/dynlink.c @@ -18,18 +18,19 @@ #include #include #include -#include "config.h" +#include "caml/config.h" #ifdef HAS_UNISTD #include #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 @@ -119,7 +120,9 @@ static void open_shared_lib(char * name) 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()); @@ -202,10 +205,15 @@ CAMLprim value caml_dynlink_open_lib(value mode, value filename) { 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; diff --git a/byterun/dynlink.h b/byterun/dynlink.h deleted file mode 100644 index 74cfdb66..00000000 --- a/byterun/dynlink.h +++ /dev/null @@ -1,36 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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 */ diff --git a/byterun/exec.h b/byterun/exec.h deleted file mode 100644 index a58bcf8b..00000000 --- a/byterun/exec.h +++ /dev/null @@ -1,60 +0,0 @@ -/***********************************************************************/ -/* */ -/* OCaml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the 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 */ diff --git a/byterun/extern.c b/byterun/extern.c index 33fa89a9..5965b8d5 100644 --- a/byterun/extern.c +++ b/byterun/extern.c @@ -13,20 +13,20 @@ /* Structured output */ -/* The interface of this file is "intext.h" */ +/* The interface of this file is "caml/intext.h" */ #include -#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. */ diff --git a/byterun/fail.c b/byterun/fail.c index 148e47a9..7943f9ae 100644 --- a/byterun/fail.c +++ b/byterun/fail.c @@ -15,16 +15,16 @@ #include #include -#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; diff --git a/byterun/fail.h b/byterun/fail.h deleted file mode 100644 index da72c780..00000000 --- a/byterun/fail.h +++ /dev/null @@ -1,84 +0,0 @@ -/***********************************************************************/ -/* */ -/* OCaml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../LICENSE. */ -/* */ -/***********************************************************************/ - -#ifndef CAML_FAIL_H -#define CAML_FAIL_H - -/* */ -#include -/* */ - -#ifndef CAML_NAME_SPACE -#include "compatibility.h" -#endif -#include "misc.h" -#include "mlvalues.h" - -/* */ -#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); - -/* */ - -#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 */ diff --git a/byterun/finalise.c b/byterun/finalise.c index 15b7a753..b9ce1b1b 100644 --- a/byterun/finalise.c +++ b/byterun/finalise.c @@ -13,11 +13,11 @@ /* 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; diff --git a/byterun/finalise.h b/byterun/finalise.h deleted file mode 100644 index 96853f52..00000000 --- a/byterun/finalise.h +++ /dev/null @@ -1,27 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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 */ diff --git a/byterun/fix_code.c b/byterun/fix_code.c index 3380dc91..95a7591b 100644 --- a/byterun/fix_code.c +++ b/byterun/fix_code.c @@ -13,21 +13,21 @@ /* Handling of blocks of bytecode (endianness switch, threading). */ -#include "config.h" +#include "caml/config.h" #ifdef HAS_UNISTD #include #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; @@ -95,33 +95,44 @@ void caml_fixup_endianness(code_t code, asize_t len) 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; @@ -149,6 +160,13 @@ void caml_thread_code (code_t code, asize_t len) 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) diff --git a/byterun/fix_code.h b/byterun/fix_code.h deleted file mode 100644 index 419ad327..00000000 --- a/byterun/fix_code.h +++ /dev/null @@ -1,40 +0,0 @@ -/***********************************************************************/ -/* */ -/* OCaml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the 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 */ diff --git a/byterun/floats.c b/byterun/floats.c index 7ff6d89d..de18c333 100644 --- a/byterun/floats.c +++ b/byterun/floats.c @@ -11,20 +11,20 @@ /* */ /***********************************************************************/ -/* 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 #include #include #include -#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 @@ -150,6 +150,7 @@ CAMLprim value caml_float_of_string(value vs) 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) @@ -452,7 +453,8 @@ enum { FP_normal, FP_subnormal, FP_zero, FP_infinite, FP_nan }; 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); diff --git a/byterun/freelist.c b/byterun/freelist.c index 1bbbc25f..a588a8b7 100644 --- a/byterun/freelist.c +++ b/byterun/freelist.c @@ -18,14 +18,14 @@ #include -#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. diff --git a/byterun/freelist.h b/byterun/freelist.h deleted file mode 100644 index 146961fa..00000000 --- a/byterun/freelist.h +++ /dev/null @@ -1,34 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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 */ diff --git a/byterun/gc.h b/byterun/gc.h deleted file mode 100644 index 3cbf08a2..00000000 --- a/byterun/gc.h +++ /dev/null @@ -1,56 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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 */ diff --git a/byterun/gc_ctrl.c b/byterun/gc_ctrl.c index 1ab099da..1f2a0238 100644 --- a/byterun/gc_ctrl.c +++ b/byterun/gc_ctrl.c @@ -11,21 +11,21 @@ /* */ /***********************************************************************/ -#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 diff --git a/byterun/gc_ctrl.h b/byterun/gc_ctrl.h deleted file mode 100644 index de6933e8..00000000 --- a/byterun/gc_ctrl.h +++ /dev/null @@ -1,42 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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 */ diff --git a/byterun/globroots.c b/byterun/globroots.c index ded393e8..d3dd9252 100644 --- a/byterun/globroots.c +++ b/byterun/globroots.c @@ -13,11 +13,11 @@ /* 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 diff --git a/byterun/globroots.h b/byterun/globroots.h deleted file mode 100644 index 1c3ebab2..00000000 --- a/byterun/globroots.h +++ /dev/null @@ -1,25 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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 */ diff --git a/byterun/hash.c b/byterun/hash.c index f8964265..8663a3db 100644 --- a/byterun/hash.c +++ b/byterun/hash.c @@ -16,10 +16,10 @@ /* 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/ */ diff --git a/byterun/hash.h b/byterun/hash.h deleted file mode 100644 index 436a8bb1..00000000 --- a/byterun/hash.h +++ /dev/null @@ -1,29 +0,0 @@ -/***********************************************************************/ -/* */ -/* OCaml */ -/* */ -/* Xavier Leroy, projet Gallium, INRIA Rocquencourt */ -/* */ -/* Copyright 2011 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../LICENSE. */ -/* */ -/***********************************************************************/ - -/* Auxiliary functions for custom hash functions */ - -#ifndef CAML_HASH_H -#define CAML_HASH_H - -#include "mlvalues.h" - -CAMLextern uint32 caml_hash_mix_uint32(uint32 h, uint32 d); -CAMLextern uint32 caml_hash_mix_intnat(uint32 h, intnat d); -CAMLextern uint32 caml_hash_mix_int64(uint32 h, int64 d); -CAMLextern uint32 caml_hash_mix_double(uint32 h, double d); -CAMLextern uint32 caml_hash_mix_float(uint32 h, float d); -CAMLextern uint32 caml_hash_mix_string(uint32 h, value s); - - -#endif diff --git a/byterun/instrtrace.c b/byterun/instrtrace.c index 0a19fd2f..712b4636 100644 --- a/byterun/instrtrace.c +++ b/byterun/instrtrace.c @@ -19,12 +19,12 @@ #include #include -#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; diff --git a/byterun/instrtrace.h b/byterun/instrtrace.h deleted file mode 100644 index 30201608..00000000 --- a/byterun/instrtrace.h +++ /dev/null @@ -1,30 +0,0 @@ -/***********************************************************************/ -/* */ -/* OCaml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the 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 diff --git a/byterun/instruct.h b/byterun/instruct.h deleted file mode 100644 index f9cc80ee..00000000 --- a/byterun/instruct.h +++ /dev/null @@ -1,62 +0,0 @@ -/***********************************************************************/ -/* */ -/* OCaml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the 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 */ diff --git a/byterun/int64_emul.h b/byterun/int64_emul.h deleted file mode 100644 index ba7904a4..00000000 --- a/byterun/int64_emul.h +++ /dev/null @@ -1,287 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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 - -#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 */ diff --git a/byterun/int64_format.h b/byterun/int64_format.h deleted file mode 100644 index b0de5272..00000000 --- a/byterun/int64_format.h +++ /dev/null @@ -1,105 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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 */ diff --git a/byterun/int64_native.h b/byterun/int64_native.h deleted file mode 100644 index e9ffe674..00000000 --- a/byterun/int64_native.h +++ /dev/null @@ -1,61 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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 */ diff --git a/byterun/intern.c b/byterun/intern.c index e0fcc5db..d2943afb 100644 --- a/byterun/intern.c +++ b/byterun/intern.c @@ -13,22 +13,22 @@ /* Structured input, compact format */ -/* The interface of this file is "intext.h" */ +/* The interface of this file is "caml/intext.h" */ #include #include -#include "alloc.h" -#include "callback.h" -#include "custom.h" -#include "fail.h" -#include "gc.h" -#include "intext.h" -#include "io.h" -#include "md5.h" -#include "memory.h" -#include "mlvalues.h" -#include "misc.h" -#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. */ diff --git a/byterun/interp.c b/byterun/interp.c index 9b682ba6..fd4740b2 100644 --- a/byterun/interp.c +++ b/byterun/interp.c @@ -13,22 +13,22 @@ /* The bytecode interpreter */ #include -#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 @@ -220,7 +220,7 @@ value caml_interprete(code_t prog, asize_t prog_size) #ifdef THREADED_CODE static void * jumptable[] = { -# include "jumptbl.h" +# include "caml/jumptbl.h" }; #endif diff --git a/byterun/interp.h b/byterun/interp.h deleted file mode 100644 index c8e2f89f..00000000 --- a/byterun/interp.h +++ /dev/null @@ -1,31 +0,0 @@ -/***********************************************************************/ -/* */ -/* OCaml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the 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 */ diff --git a/byterun/intext.h b/byterun/intext.h deleted file mode 100644 index f7aa655c..00000000 --- a/byterun/intext.h +++ /dev/null @@ -1,168 +0,0 @@ -/***********************************************************************/ -/* */ -/* OCaml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the 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" - -/* */ -#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]. */ - -/* */ - -#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. */ - -/* */ -value caml_input_val (struct channel * chan); - /* Read a structured value from the channel [chan]. */ -/* */ - -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); - -/* */ - -/* 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; - -/* */ - -#ifdef __cplusplus -} -#endif - -#endif /* CAML_INTEXT_H */ diff --git a/byterun/ints.c b/byterun/ints.c index d762c761..4a732762 100644 --- a/byterun/ints.c +++ b/byterun/ints.c @@ -13,13 +13,13 @@ #include #include -#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, diff --git a/byterun/io.c b/byterun/io.c index 5f04a966..11f941dc 100644 --- a/byterun/io.c +++ b/byterun/io.c @@ -18,22 +18,22 @@ #include #include #include -#include "config.h" +#include "caml/config.h" #ifdef HAS_UNISTD #include #endif #ifdef __CYGWIN__ #include #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 diff --git a/byterun/io.h b/byterun/io.h deleted file mode 100644 index 64a8bf50..00000000 --- a/byterun/io.h +++ /dev/null @@ -1,115 +0,0 @@ -/***********************************************************************/ -/* */ -/* OCaml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the 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 -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 */ diff --git a/byterun/lexing.c b/byterun/lexing.c index 22ef6acd..eac302e3 100644 --- a/byterun/lexing.c +++ b/byterun/lexing.c @@ -13,9 +13,9 @@ /* 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; diff --git a/byterun/main.c b/byterun/main.c index b51c31c5..1ad20280 100644 --- a/byterun/main.c +++ b/byterun/main.c @@ -14,9 +14,9 @@ /* 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 **); diff --git a/byterun/major_gc.c b/byterun/major_gc.c index a44c8d90..006da847 100644 --- a/byterun/major_gc.c +++ b/byterun/major_gc.c @@ -13,19 +13,19 @@ #include -#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 @@ -59,6 +59,8 @@ static value *weak_prev; static unsigned long major_gc_counter = 0; #endif +void (*caml_major_gc_hook)(void) = NULL; + static void realloc_gray_vals (void) { value *new; @@ -90,13 +92,6 @@ void caml_darken (value v, value *p /* not used */) { #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 @@ -107,6 +102,15 @@ void caml_darken (value v, value *p /* not used */) 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){ @@ -145,6 +149,7 @@ static void mark_slice (intnat work) 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; @@ -169,8 +174,6 @@ static void mark_slice (intnat work) 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 @@ -189,6 +192,10 @@ static void mark_slice (intnat work) 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; @@ -307,6 +314,7 @@ static void mark_slice (intnat work) 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); @@ -314,6 +322,7 @@ static void mark_slice (intnat work) } } gray_vals_cur = gray_vals_ptr; + if (caml_major_slice_end_hook != NULL) (*caml_major_slice_end_hook) (); } static void sweep_slice (intnat work) @@ -321,6 +330,7 @@ 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){ @@ -359,6 +369,7 @@ static void sweep_slice (intnat work) } } } + if (caml_major_slice_end_hook != NULL) (*caml_major_slice_end_hook) (); } /* The main entry point for the GC. Called after each minor GC. diff --git a/byterun/major_gc.h b/byterun/major_gc.h deleted file mode 100644 index f473df94..00000000 --- a/byterun/major_gc.h +++ /dev/null @@ -1,60 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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 */ diff --git a/byterun/md5.c b/byterun/md5.c index 10ac76ab..5d748c1a 100644 --- a/byterun/md5.c +++ b/byterun/md5.c @@ -12,13 +12,13 @@ /***********************************************************************/ #include -#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 */ @@ -33,18 +33,16 @@ CAMLprim value caml_md5_string(value str, value ofs, value len) 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)); @@ -66,6 +64,12 @@ CAMLprim value caml_md5_chan(value vchan, value len) 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) { diff --git a/byterun/md5.h b/byterun/md5.h deleted file mode 100644 index d8aff097..00000000 --- a/byterun/md5.h +++ /dev/null @@ -1,41 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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 */ diff --git a/byterun/memory.c b/byterun/memory.c index 54d91c96..4eb63b40 100644 --- a/byterun/memory.c +++ b/byterun/memory.c @@ -13,17 +13,18 @@ #include #include -#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 */ diff --git a/byterun/memory.h b/byterun/memory.h deleted file mode 100644 index 9befa873..00000000 --- a/byterun/memory.h +++ /dev/null @@ -1,447 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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" -/* */ -#include "gc.h" -#include "major_gc.h" -#include "minor_gc.h" -/* */ -#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 */ - -/* */ - -#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)) - -/* */ - -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 */ diff --git a/byterun/meta.c b/byterun/meta.c index e5c6f941..edec4079 100644 --- a/byterun/meta.c +++ b/byterun/meta.c @@ -14,19 +14,19 @@ /* Primitives for the toplevel */ #include -#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 diff --git a/byterun/minor_gc.c b/byterun/minor_gc.c index b15d1e44..4aaec966 100644 --- a/byterun/minor_gc.c +++ b/byterun/minor_gc.c @@ -12,19 +12,19 @@ /***********************************************************************/ #include -#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; @@ -226,8 +226,11 @@ void caml_oldify_mopup (void) 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(); @@ -252,8 +255,11 @@ void caml_empty_minor_heap (void) 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; @@ -271,16 +277,14 @@ void caml_empty_minor_heap (void) */ 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 (); } diff --git a/byterun/minor_gc.h b/byterun/minor_gc.h deleted file mode 100644 index 4727826d..00000000 --- a/byterun/minor_gc.h +++ /dev/null @@ -1,56 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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 */ diff --git a/byterun/misc.c b/byterun/misc.c index 6dc27d5c..a951ee2b 100644 --- a/byterun/misc.c +++ b/byterun/misc.c @@ -14,9 +14,16 @@ #include #include #include -#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 diff --git a/byterun/misc.h b/byterun/misc.h deleted file mode 100644 index 5640980a..00000000 --- a/byterun/misc.h +++ /dev/null @@ -1,155 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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 -#include - -/* Basic types and constants */ - -typedef size_t asize_t; - -#ifndef NULL -#define NULL 0 -#endif - -/* */ -typedef char * addr; -/* */ - -#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 */ - -/* */ - -/* 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 - -/* */ - -#endif /* CAML_MISC_H */ diff --git a/byterun/mlvalues.h b/byterun/mlvalues.h deleted file mode 100644 index 268bcfe9..00000000 --- a/byterun/mlvalues.h +++ /dev/null @@ -1,305 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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 */ diff --git a/byterun/obj.c b/byterun/obj.c index b045fee2..ce7ffcd0 100644 --- a/byterun/obj.c +++ b/byterun/obj.c @@ -14,16 +14,16 @@ /* Operations on objects */ #include -#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) { diff --git a/byterun/osdeps.h b/byterun/osdeps.h deleted file mode 100644 index 8204205f..00000000 --- a/byterun/osdeps.h +++ /dev/null @@ -1,68 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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 */ diff --git a/byterun/parsing.c b/byterun/parsing.c index a857e392..bd51a41e 100644 --- a/byterun/parsing.c +++ b/byterun/parsing.c @@ -15,10 +15,10 @@ #include #include -#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 diff --git a/byterun/prims.h b/byterun/prims.h deleted file mode 100644 index 7a996781..00000000 --- a/byterun/prims.h +++ /dev/null @@ -1,34 +0,0 @@ -/***********************************************************************/ -/* */ -/* OCaml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the 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 */ diff --git a/byterun/printexc.c b/byterun/printexc.c index a371a71f..7647b3a1 100644 --- a/byterun/printexc.c +++ b/byterun/printexc.c @@ -16,13 +16,13 @@ #include #include #include -#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; diff --git a/byterun/printexc.h b/byterun/printexc.h deleted file mode 100644 index 748faa9c..00000000 --- a/byterun/printexc.h +++ /dev/null @@ -1,33 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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 */ diff --git a/byterun/reverse.h b/byterun/reverse.h deleted file mode 100644 index 09d34a51..00000000 --- a/byterun/reverse.h +++ /dev/null @@ -1,86 +0,0 @@ -/***********************************************************************/ -/* */ -/* OCaml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the 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 */ diff --git a/byterun/roots.c b/byterun/roots.c index 43afbedc..f812cd75 100644 --- a/byterun/roots.c +++ b/byterun/roots.c @@ -13,15 +13,15 @@ /* 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; diff --git a/byterun/roots.h b/byterun/roots.h deleted file mode 100644 index ca6a5d26..00000000 --- a/byterun/roots.h +++ /dev/null @@ -1,36 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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 */ diff --git a/byterun/signals.c b/byterun/signals.c index 10f452b4..3d642f19 100644 --- a/byterun/signals.c +++ b/byterun/signals.c @@ -15,17 +15,17 @@ #include #include -#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 diff --git a/byterun/signals.h b/byterun/signals.h deleted file mode 100644 index 58451666..00000000 --- a/byterun/signals.h +++ /dev/null @@ -1,57 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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 - -/* */ -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; -/* */ - -CAMLextern void caml_enter_blocking_section (void); -CAMLextern void caml_leave_blocking_section (void); - -/* */ -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); -/* */ - -#ifdef __cplusplus -} -#endif - -#endif /* CAML_SIGNALS_H */ diff --git a/byterun/signals_byt.c b/byterun/signals_byt.c index 9703afaa..e9c6c662 100644 --- a/byterun/signals_byt.c +++ b/byterun/signals_byt.c @@ -15,11 +15,11 @@ #include #include -#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 diff --git a/byterun/signals_machdep.h b/byterun/signals_machdep.h deleted file mode 100644 index 4987e2f6..00000000 --- a/byterun/signals_machdep.h +++ /dev/null @@ -1,60 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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 */ diff --git a/byterun/stacks.c b/byterun/stacks.c index bc2bdc46..94bff0b9 100644 --- a/byterun/stacks.c +++ b/byterun/stacks.c @@ -14,11 +14,11 @@ /* To initialize and resize the stacks */ #include -#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; diff --git a/byterun/stacks.h b/byterun/stacks.h deleted file mode 100644 index c596f255..00000000 --- a/byterun/stacks.h +++ /dev/null @@ -1,41 +0,0 @@ -/***********************************************************************/ -/* */ -/* OCaml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the 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 */ diff --git a/byterun/startup.c b/byterun/startup.c index 36972206..fb6e7778 100644 --- a/byterun/startup.c +++ b/byterun/startup.c @@ -17,41 +17,41 @@ #include #include #include -#include "config.h" +#include "caml/config.h" #ifdef HAS_UNISTD #include #endif #ifdef _WIN32 #include #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 diff --git a/byterun/startup.h b/byterun/startup.h deleted file mode 100644 index 3dda64b3..00000000 --- a/byterun/startup.h +++ /dev/null @@ -1,38 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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 */ diff --git a/byterun/str.c b/byterun/str.c index 6effa91a..a72b34c4 100644 --- a/byterun/str.c +++ b/byterun/str.c @@ -17,10 +17,10 @@ #include #include #include -#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 #endif diff --git a/byterun/sys.c b/byterun/sys.c index 03ca1e3e..292f664b 100644 --- a/byterun/sys.c +++ b/byterun/sys.c @@ -25,7 +25,7 @@ #if !_WIN32 #include #endif -#include "config.h" +#include "caml/config.h" #ifdef HAS_UNISTD #include #endif @@ -39,15 +39,15 @@ #ifdef HAS_GETTIMEOFDAY #include #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) { @@ -268,7 +268,7 @@ CAMLprim value caml_sys_getenv(value var) } char * caml_exe_name; -static char ** caml_main_argv; +char ** caml_main_argv; CAMLprim value caml_sys_get_argv(value unit) { diff --git a/byterun/sys.h b/byterun/sys.h deleted file mode 100644 index 5eb18fc0..00000000 --- a/byterun/sys.h +++ /dev/null @@ -1,28 +0,0 @@ -/***********************************************************************/ -/* */ -/* OCaml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the 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 */ diff --git a/byterun/terminfo.c b/byterun/terminfo.c index 04086a3f..1d0fdc42 100644 --- a/byterun/terminfo.c +++ b/byterun/terminfo.c @@ -13,11 +13,11 @@ /* 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)) diff --git a/byterun/ui.h b/byterun/ui.h deleted file mode 100644 index 29584650..00000000 --- a/byterun/ui.h +++ /dev/null @@ -1,26 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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 */ diff --git a/byterun/unix.c b/byterun/unix.c index be2c39b1..38ddee00 100644 --- a/byterun/unix.c +++ b/byterun/unix.c @@ -22,9 +22,9 @@ #include #include #include -#include "config.h" +#include "caml/config.h" #ifdef SUPPORT_DYNAMIC_LINKING -#ifdef __CYGWIN32__ +#ifdef __CYGWIN__ #include "flexdll.h" #else #include @@ -38,9 +38,9 @@ #else #include #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) @@ -86,7 +86,7 @@ char * caml_search_in_path(struct ext_table * path, char * name) return caml_strdup(name); } -#ifdef __CYGWIN32__ +#ifdef __CYGWIN__ /* Cygwin needs special treatment because of the implicit ".exe" at the end of executable file names */ @@ -137,7 +137,7 @@ char * caml_search_exe_in_path(char * name) 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); @@ -159,7 +159,7 @@ char * caml_search_dll_in_path(struct ext_table * path, char * name) } #ifdef SUPPORT_DYNAMIC_LINKING -#ifdef __CYGWIN32__ +#ifdef __CYGWIN__ /* Use flexdll */ void * caml_dlopen(char * libname, int for_execution, int global) diff --git a/byterun/weak.c b/byterun/weak.c index 75699671..65da99dc 100644 --- a/byterun/weak.c +++ b/byterun/weak.c @@ -15,11 +15,11 @@ #include -#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; diff --git a/byterun/weak.h b/byterun/weak.h deleted file mode 100644 index 0cf4b8b2..00000000 --- a/byterun/weak.h +++ /dev/null @@ -1,24 +0,0 @@ -/***********************************************************************/ -/* */ -/* 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 */ diff --git a/byterun/win32.c b/byterun/win32.c index 67e96832..f26caf8f 100644 --- a/byterun/win32.c +++ b/byterun/win32.c @@ -25,12 +25,13 @@ #include #include #include -#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 @@ -418,14 +419,8 @@ static void caml_reset_stack (void *faulting_address) 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) { diff --git a/compilerlibs/.gitignore b/compilerlibs/.gitignore new file mode 100644 index 00000000..e69de29b diff --git a/config/Makefile.mingw b/config/Makefile.mingw index c2049803..5b4658f7 100644 --- a/config/Makefile.mingw +++ b/config/Makefile.mingw @@ -68,7 +68,7 @@ X11_INCLUDES= X11_LINK= BYTECCRPATH= SUPPORTS_SHARED_LIBRARIES=true -SHAREDCCCOMPOPTS= +SHAREDCCCOMPOPTS=-O MKSHAREDLIBRPATH= NATIVECCPROFOPTS= NATIVECCRPATH= diff --git a/config/Makefile.mingw64 b/config/Makefile.mingw64 index 0a3bdfbd..19a9b943 100644 --- a/config/Makefile.mingw64 +++ b/config/Makefile.mingw64 @@ -68,7 +68,7 @@ X11_INCLUDES= X11_LINK= BYTECCRPATH= SUPPORTS_SHARED_LIBRARIES=true -SHAREDCCCOMPOPTS= +SHAREDCCCOMPOPTS=-O MKSHAREDLIBRPATH= NATIVECCPROFOPTS= NATIVECCRPATH= diff --git a/config/Makefile.msvc b/config/Makefile.msvc index 93cf94b6..e0145102 100644 --- a/config/Makefile.msvc +++ b/config/Makefile.msvc @@ -60,7 +60,7 @@ X11_INCLUDES= X11_LINK= BYTECCRPATH= SUPPORTS_SHARED_LIBRARIES=true -SHAREDCCCOMPOPTS= +SHAREDCCCOMPOPTS=-Ox NATIVECCPROFOPTS= NATIVECCRPATH= ASM=ml -nologo -coff -Cp -c -Fo diff --git a/config/Makefile.msvc64 b/config/Makefile.msvc64 index 1b2e1888..783ce953 100644 --- a/config/Makefile.msvc64 +++ b/config/Makefile.msvc64 @@ -60,7 +60,7 @@ X11_INCLUDES= X11_LINK= BYTECCRPATH= SUPPORTS_SHARED_LIBRARIES=true -SHAREDCCCOMPOPTS= +SHAREDCCCOMPOPTS=-Ox NATIVECCPROFOPTS= NATIVECCRPATH= ASM=ml64 -nologo -Cp -c -Fo diff --git a/config/auto-aux/nanosecond_stat.c b/config/auto-aux/nanosecond_stat.c new file mode 100644 index 00000000..fc92e67b --- /dev/null +++ b/config/auto-aux/nanosecond_stat.c @@ -0,0 +1,28 @@ +/***********************************************************************/ +/* */ +/* 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 +#include +#include + +#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; +} diff --git a/config/auto-aux/searchpath b/config/auto-aux/searchpath index 79d7fcae..e229ac92 100755 --- a/config/auto-aux/searchpath +++ b/config/auto-aux/searchpath @@ -15,9 +15,18 @@ # 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 diff --git a/configure b/configure index 3edb9fd2..4ea1498c 100755 --- a/configure +++ b/configure @@ -16,6 +16,7 @@ configure_options="$*" prefix=/usr/local bindir='' +target_bindir='' libdir='' mandir='' manext=1 @@ -77,7 +78,7 @@ wrn() { } err() { - printf "[ERROR!]%b\n" "$*" 1>&3 + printf "[ERROR!] %b\n" "$*" 1>&3 exit 2 } @@ -85,10 +86,6 @@ exec 3>&1 # 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;; @@ -96,6 +93,8 @@ while : ; do prefix=$2; shift;; -bindir|--bindir) bindir=$2; shift;; + -target-bindir|--target-bindir) + target_bindir="$2"; shift;; -libdir|--libdir) libdir=$2; shift;; -mandir|--mandir) @@ -155,7 +154,12 @@ while : ; do 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 @@ -236,17 +240,23 @@ else 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 @@ -374,10 +384,15 @@ case "$bytecc,$target" in *,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." @@ -442,7 +457,7 @@ case $? in 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." @@ -452,29 +467,43 @@ case $? in 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 @@ -926,6 +955,8 @@ case "$arch,$system" in 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';; @@ -967,7 +998,8 @@ if (SHELL=/bin/sh; export SHELL; (./sharpbang || ./sharpbang2) >/dev/null); then "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;; @@ -1298,6 +1330,15 @@ if sh ./hasgot pwrite; then 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 @@ -1645,6 +1686,12 @@ if $no_naked_pointers; then 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" @@ -1673,8 +1720,8 @@ SYSLIB=-l\$(1) #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 @@ -1715,6 +1762,11 @@ echo "MKEXEDEBUGFLAG=$mkexedebugflag" >> 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 diff --git a/debugger/.depend b/debugger/.depend index b6254161..c9a56ac1 100644 --- a/debugger/.depend +++ b/debugger/.depend @@ -16,8 +16,8 @@ int64ops.cmi : lexer.cmi : parser.cmi loadprinter.cmi : ../parsing/longident.cmi dynlink.cmi parameters.cmi : -parser.cmi : parser_aux.cmi ../parsing/longident.cmi parser_aux.cmi : primitives.cmi ../parsing/longident.cmi +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 diff --git a/debugger/Makefile.shared b/debugger/Makefile.shared index fed1d26d..f3859c63 100644 --- a/debugger/Makefile.shared +++ b/debugger/Makefile.shared @@ -11,15 +11,15 @@ ######################################################################### 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) @@ -32,7 +32,7 @@ OTHEROBJS=\ $(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 \ diff --git a/debugger/command_line.ml b/debugger/command_line.ml index a4647110..b4f9f693 100644 --- a/debugger/command_line.ml +++ b/debugger/command_line.ml @@ -610,8 +610,12 @@ let instr_break ppf lexbuf = 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 diff --git a/debugger/debugcom.ml b/debugger/debugcom.ml index ac91df79..8bfd3aab 100644 --- a/debugger/debugcom.ml +++ b/debugger/debugcom.ml @@ -213,14 +213,16 @@ module Remote_value = | 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 diff --git a/debugger/source.ml b/debugger/source.ml index aa9ec708..fa2b3c7e 100644 --- a/debugger/source.ml +++ b/debugger/source.ml @@ -21,6 +21,8 @@ let source_extensions = [".ml"] (*** 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 diff --git a/driver/compenv.ml b/driver/compenv.ml index 82704fd8..e7b4987c 100644 --- a/driver/compenv.ml +++ b/driver/compenv.ml @@ -56,26 +56,28 @@ let first_objfiles = ref [] 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 @@ -175,6 +177,7 @@ let read_OCAMLPARAM ppf position = | "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 diff --git a/driver/compenv.mli b/driver/compenv.mli index 85d588ef..59cd1012 100644 --- a/driver/compenv.mli +++ b/driver/compenv.mli @@ -10,7 +10,6 @@ (* *) (***********************************************************************) -(* val check_unit_name : Format.formatter -> string -> string -> unit *) val module_of_filename : Format.formatter -> string -> string -> string val output_prefix : string -> string @@ -35,3 +34,10 @@ type readenv_position = 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 diff --git a/driver/compile.ml b/driver/compile.ml index 3b5d2ae0..9edfb804 100644 --- a/driver/compile.ml +++ b/driver/compile.ml @@ -60,50 +60,44 @@ let implementation ppf sourcefile outputprefix = 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; diff --git a/driver/main.ml b/driver/main.ml index f8358a0c..e3c59c9e 100644 --- a/driver/main.ml +++ b/driver/main.ml @@ -83,6 +83,7 @@ module Options = Main_args.Make_bytecomp_options (struct 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 @@ -92,6 +93,7 @@ module Options = Main_args.Make_bytecomp_options (struct 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 @@ -106,6 +108,8 @@ module Options = Main_args.Make_bytecomp_options (struct 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 @@ -196,3 +200,7 @@ let main () = exit 2 let _ = main () + + + + diff --git a/driver/main_args.ml b/driver/main_args.ml index 7636abe0..f5d7e316 100644 --- a/driver/main_args.ml +++ b/driver/main_args.ml @@ -126,6 +126,10 @@ let mk_intf_suffix_2 f = "-intf_suffix", Arg.String f, " (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" ;; @@ -160,6 +164,10 @@ let mk_no_app_funct f = "-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" @@ -214,7 +222,12 @@ let mk_open f = "-open", Arg.String f, " Opens the 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 = @@ -516,11 +529,13 @@ module type Compiler_options = sig 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 @@ -541,6 +556,7 @@ module type Bytecomp_options = sig 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 @@ -642,6 +658,7 @@ struct 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; @@ -653,6 +670,7 @@ struct 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; @@ -661,6 +679,7 @@ struct 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; @@ -668,6 +687,7 @@ struct 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; @@ -769,6 +789,7 @@ struct 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; @@ -783,6 +804,7 @@ struct 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; diff --git a/driver/main_args.mli b/driver/main_args.mli index 18ade80b..ddee921d 100644 --- a/driver/main_args.mli +++ b/driver/main_args.mli @@ -62,11 +62,13 @@ module type Compiler_options = sig 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 @@ -88,6 +90,7 @@ module type Bytecomp_options = sig 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 diff --git a/driver/optcompile.ml b/driver/optcompile.ml index f0ef78d1..9a5f3b93 100644 --- a/driver/optcompile.ml +++ b/driver/optcompile.ml @@ -66,22 +66,16 @@ let implementation ppf sourcefile outputprefix = 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 diff --git a/driver/optmain.ml b/driver/optmain.ml index 947d4307..0a680ce4 100644 --- a/driver/optmain.ml +++ b/driver/optmain.ml @@ -90,6 +90,7 @@ module Options = Main_args.Make_optcomp_options (struct 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 @@ -104,6 +105,8 @@ module Options = Main_args.Make_optcomp_options (struct 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 diff --git a/driver/pparse.ml b/driver/pparse.ml index 4b2553f2..b67c1805 100644 --- a/driver/pparse.ml +++ b/driver/pparse.ml @@ -20,10 +20,7 @@ exception Error of error (* 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 @@ -34,6 +31,12 @@ let preprocess sourcefile = 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 -> () @@ -124,7 +127,7 @@ let apply_rewriters ?restore ~tool_name magic ast = 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 @@ -138,6 +141,10 @@ let file ppf ~tool_name inputfile parse_fun ast_magic = 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 @@ -159,6 +166,7 @@ let file ppf ~tool_name inputfile parse_fun ast_magic = 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@.\ diff --git a/driver/pparse.mli b/driver/pparse.mli index bcff4e78..64976989 100644 --- a/driver/pparse.mli +++ b/driver/pparse.mli @@ -34,3 +34,8 @@ val report_error : formatter -> error -> unit 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 diff --git a/emacs/caml-types.el b/emacs/caml-types.el index 4bc22665..0af667bd 100644 --- a/emacs/caml-types.el +++ b/emacs/caml-types.el @@ -20,6 +20,18 @@ (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. @@ -349,21 +361,36 @@ See `caml-types-location-re' for annotation file format. (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)) diff --git a/experimental/doligez/check-bounds.diff b/experimental/doligez/check-bounds.diff new file mode 100644 index 00000000..c2e07952 --- /dev/null +++ b/experimental/doligez/check-bounds.diff @@ -0,0 +1,149 @@ +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 + #include ++#include + #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(); ++} diff --git a/experimental/doligez/checkheaders b/experimental/doligez/checkheaders new file mode 100755 index 00000000..5de15329 --- /dev/null +++ b/experimental/doligez/checkheaders @@ -0,0 +1,152 @@ +#!/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 diff --git a/experimental/frisch/Makefile b/experimental/frisch/Makefile new file mode 100644 index 00000000..89de11f0 --- /dev/null +++ b/experimental/frisch/Makefile @@ -0,0 +1,79 @@ +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 diff --git a/experimental/frisch/copy_typedef.ml b/experimental/frisch/copy_typedef.ml new file mode 100644 index 00000000..baf52de4 --- /dev/null +++ b/experimental/frisch/copy_typedef.ml @@ -0,0 +1,181 @@ +(* + 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 diff --git a/experimental/frisch/eval.ml b/experimental/frisch/eval.ml new file mode 100644 index 00000000..3940b7ea --- /dev/null +++ b/experimental/frisch/eval.ml @@ -0,0 +1,141 @@ +(* 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 diff --git a/experimental/frisch/extension_points.txt b/experimental/frisch/extension_points.txt new file mode 100644 index 00000000..f9d4e774 --- /dev/null +++ b/experimental/frisch/extension_points.txt @@ -0,0 +1,740 @@ +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$; + |}] diff --git a/experimental/frisch/ifdef.ml b/experimental/frisch/ifdef.ml new file mode 100644 index 00000000..6263b59a --- /dev/null +++ b/experimental/frisch/ifdef.ml @@ -0,0 +1,118 @@ +(* 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 diff --git a/experimental/frisch/js_syntax.ml b/experimental/frisch/js_syntax.ml new file mode 100644 index 00000000..fe11cb65 --- /dev/null +++ b/experimental/frisch/js_syntax.ml @@ -0,0 +1,112 @@ +(* 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 diff --git a/experimental/frisch/metaquot_test.ml b/experimental/frisch/metaquot_test.ml new file mode 100644 index 00000000..bbdfe240 --- /dev/null +++ b/experimental/frisch/metaquot_test.ml @@ -0,0 +1,27 @@ +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 diff --git a/experimental/frisch/minidoc.ml b/experimental/frisch/minidoc.ml new file mode 100644 index 00000000..bf37a012 --- /dev/null +++ b/experimental/frisch/minidoc.ml @@ -0,0 +1,72 @@ +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 diff --git a/experimental/frisch/nomli.ml b/experimental/frisch/nomli.ml new file mode 100644 index 00000000..6cf34557 --- /dev/null +++ b/experimental/frisch/nomli.ml @@ -0,0 +1,114 @@ +(** 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) + diff --git a/experimental/frisch/ppx_builder.ml b/experimental/frisch/ppx_builder.ml new file mode 100644 index 00000000..cb866df8 --- /dev/null +++ b/experimental/frisch/ppx_builder.ml @@ -0,0 +1,100 @@ +(* + 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 diff --git a/experimental/frisch/ppx_matches.ml b/experimental/frisch/ppx_matches.ml new file mode 100644 index 00000000..f6d95347 --- /dev/null +++ b/experimental/frisch/ppx_matches.ml @@ -0,0 +1,29 @@ +(* + 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 diff --git a/experimental/frisch/test_builder.ml b/experimental/frisch/test_builder.ml new file mode 100644 index 00000000..25427309 --- /dev/null +++ b/experimental/frisch/test_builder.ml @@ -0,0 +1,19 @@ +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] diff --git a/experimental/frisch/test_copy_typedef.ml b/experimental/frisch/test_copy_typedef.ml new file mode 100644 index 00000000..cd774c69 --- /dev/null +++ b/experimental/frisch/test_copy_typedef.ml @@ -0,0 +1,19 @@ +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] diff --git a/experimental/frisch/test_copy_typedef.mli b/experimental/frisch/test_copy_typedef.mli new file mode 100644 index 00000000..8e137a7d --- /dev/null +++ b/experimental/frisch/test_copy_typedef.mli @@ -0,0 +1,20 @@ +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 diff --git a/experimental/frisch/test_eval.ml b/experimental/frisch/test_eval.ml new file mode 100644 index 00000000..c0dfc697 --- /dev/null +++ b/experimental/frisch/test_eval.ml @@ -0,0 +1,37 @@ +[%%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%!" + + diff --git a/experimental/frisch/test_ifdef.ml b/experimental/frisch/test_ifdef.ml new file mode 100644 index 00000000..8a18cdaa --- /dev/null +++ b/experimental/frisch/test_ifdef.ml @@ -0,0 +1,25 @@ +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] + diff --git a/experimental/frisch/test_js.ml b/experimental/frisch/test_js.ml new file mode 100644 index 00000000..2582a0fb --- /dev/null +++ b/experimental/frisch/test_js.ml @@ -0,0 +1,22 @@ +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] diff --git a/experimental/frisch/test_matches.ml b/experimental/frisch/test_matches.ml new file mode 100644 index 00000000..a46a38ba --- /dev/null +++ b/experimental/frisch/test_matches.ml @@ -0,0 +1,3 @@ +let l = List.filter [%matches ? 'a'..'z'] ['a';'A';'X';'x'] + +let f = [%matches ? Some i when i >= 0] diff --git a/experimental/frisch/test_nomli.ml b/experimental/frisch/test_nomli.ml new file mode 100644 index 00000000..affa0767 --- /dev/null +++ b/experimental/frisch/test_nomli.ml @@ -0,0 +1,30 @@ +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)] diff --git a/experimental/frisch/testdoc.mli b/experimental/frisch/testdoc.mli new file mode 100644 index 00000000..c22307ae --- /dev/null +++ b/experimental/frisch/testdoc.mli @@ -0,0 +1,29 @@ +[@@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"] diff --git a/experimental/frisch/unused_exported_values.ml b/experimental/frisch/unused_exported_values.ml new file mode 100644 index 00000000..7b2d2f90 --- /dev/null +++ b/experimental/frisch/unused_exported_values.ml @@ -0,0 +1,63 @@ +(* 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 diff --git a/experimental/garrigue/.cvsignore b/experimental/garrigue/.cvsignore new file mode 100644 index 00000000..4539eb6d --- /dev/null +++ b/experimental/garrigue/.cvsignore @@ -0,0 +1,2 @@ +*.out +*.out2 diff --git a/experimental/garrigue/caml_set_oid.diff b/experimental/garrigue/caml_set_oid.diff new file mode 100644 index 00000000..aaaa160e --- /dev/null +++ b/experimental/garrigue/caml_set_oid.diff @@ -0,0 +1,141 @@ +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 = diff --git a/experimental/garrigue/coerce.diff b/experimental/garrigue/coerce.diff new file mode 100644 index 00000000..e90e1fc9 --- /dev/null +++ b/experimental/garrigue/coerce.diff @@ -0,0 +1,93 @@ +Index: typing/ctype.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/ctype.ml,v +retrieving revision 1.201 +diff -u -r1.201 ctype.ml +--- typing/ctype.ml 5 Apr 2006 02:28:13 -0000 1.201 ++++ typing/ctype.ml 17 May 2006 23:48:22 -0000 +@@ -490,6 +490,31 @@ + unmark_class_signature sign; + Some reason + ++(* Variant for checking principality *) ++ ++let rec free_nodes_rec ty = ++ let ty = repr ty in ++ if ty.level >= lowest_level then begin ++ if ty.level <= !current_level then raise Exit; ++ ty.level <- pivot_level - ty.level; ++ begin match ty.desc with ++ Tvar -> ++ raise Exit ++ | Tobject (ty, _) -> ++ free_nodes_rec ty ++ | Tfield (_, _, ty1, ty2) -> ++ free_nodes_rec ty1; free_nodes_rec ty2 ++ | Tvariant row -> ++ let row = row_repr row in ++ iter_row free_nodes_rec {row with row_bound = []}; ++ if not (static_row row) then free_nodes_rec row.row_more ++ | _ -> ++ iter_type_expr free_nodes_rec ty ++ end; ++ end ++ ++let has_free_nodes ty = ++ try free_nodes_rec ty; false with Exit -> true + + (**********************) + (* Type duplication *) +Index: typing/ctype.mli +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/ctype.mli,v +retrieving revision 1.54 +diff -u -r1.54 ctype.mli +--- typing/ctype.mli 5 Apr 2006 02:28:13 -0000 1.54 ++++ typing/ctype.mli 17 May 2006 23:48:22 -0000 +@@ -228,6 +228,9 @@ + val closed_class: + type_expr list -> class_signature -> closed_class_failure option + (* Check whether all type variables are bound *) ++val has_free_nodes: type_expr -> bool ++ (* Check whether there are free type variables, or nodes with ++ level lower or equal to !current_level *) + + val unalias: type_expr -> type_expr + val signature_of_class_type: class_type -> class_signature +Index: typing/typecore.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/typecore.ml,v +retrieving revision 1.181 +diff -u -r1.181 typecore.ml +--- typing/typecore.ml 16 Apr 2006 23:28:22 -0000 1.181 ++++ typing/typecore.ml 17 May 2006 23:48:22 -0000 +@@ -1183,12 +1183,29 @@ + let (ty', force) = + Typetexp.transl_simple_type_delayed env sty' + in ++ if !Clflags.principal then begin_def (); + let arg = type_exp env sarg in ++ let has_fv = ++ if !Clflags.principal then begin ++ end_def (); ++ let b = has_free_nodes arg.exp_type in ++ Ctype.unify env arg.exp_type (newvar ()); ++ b ++ end else ++ free_variables arg.exp_type <> [] ++ in + begin match arg.exp_desc, !self_coercion, (repr ty').desc with + Texp_ident(_, {val_kind=Val_self _}), (path,r) :: _, + Tconstr(path',_,_) when Path.same path path' -> + r := sexp.pexp_loc :: !r; + force () ++ | _ when not has_fv -> ++ begin try ++ let force' = subtype env arg.exp_type ty' in ++ force (); force' () ++ with Subtype (tr1, tr2) -> ++ raise(Error(sexp.pexp_loc, Not_subtype(tr1, tr2))) ++ end + | _ -> + let ty, b = enlarge_type env ty' in + force (); diff --git a/experimental/garrigue/countchars.ml b/experimental/garrigue/countchars.ml new file mode 100644 index 00000000..0f14d2fe --- /dev/null +++ b/experimental/garrigue/countchars.ml @@ -0,0 +1,16 @@ +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 diff --git a/experimental/garrigue/dirs_multimatch b/experimental/garrigue/dirs_multimatch new file mode 100644 index 00000000..3e444000 --- /dev/null +++ b/experimental/garrigue/dirs_multimatch @@ -0,0 +1 @@ +parsing typing bytecomp driver toplevel diff --git a/experimental/garrigue/dirs_poly b/experimental/garrigue/dirs_poly new file mode 100644 index 00000000..60cb39f1 --- /dev/null +++ b/experimental/garrigue/dirs_poly @@ -0,0 +1 @@ +bytecomp byterun driver parsing stdlib tools toplevel typing utils diff --git a/experimental/garrigue/fixedtypes.ml b/experimental/garrigue/fixedtypes.ml new file mode 100644 index 00000000..aa6e530e --- /dev/null +++ b/experimental/garrigue/fixedtypes.ml @@ -0,0 +1,77 @@ +(* cvs update -r fixedtypes parsing typing *) + +(* recursive types *) +class c = object (self) method m = 1 method s = self end +module type S = sig type t = private #c end;; + +module M : S = struct type t = c end +module type S' = S with type t = c;; + +class d = object inherit c method n = 2 end +module type S2 = S with type t = private #d;; +module M2 : S = struct type t = d end;; +module M3 : S = struct type t = private #d end;; + +module T1 = struct + type ('a,'b) a = [`A of 'a | `B of 'b] + type ('a,'b) b = [`Z | ('a,'b) a] +end +module type T2 = sig + type a and b + val evala : a -> int + val evalb : b -> int +end +module type T3 = sig + type a0 = private [> (a0,b0) T1.a] + and b0 = private [> (a0,b0) T1.b] +end +module type T4 = sig + include T3 + include T2 with type a = a0 and type b = b0 +end +module F(X:T4) = struct + type a = X.a and b = X.b + let a = X.evala (`B `Z) + let b = X.evalb (`A(`B `Z)) + let a2b (x : a) : b = `A x + let b2a (x : b) : a = `B x +end +module M4 = struct + type a = [`A of a | `B of b | `ZA] + and b = [`A of a | `B of b | `Z] + type a0 = a + type b0 = b + let rec eval0 = function + `A a -> evala a + | `B b -> evalb b + and evala : a -> int = function + #T1.a as x -> 1 + eval0 x + | `ZA -> 3 + and evalb : b -> int = function + #T1.a as x -> 1 + eval0 x + | `Z -> 7 +end +module M5 = F(M4) + +module M6 : sig + class ci : int -> + object + val x : int + method x : int + method move : int -> unit + end + type c = private #ci + val create : int -> c +end = struct + class ci x = object + val mutable x : int = x + method x = x + method move d = x <- x+d + end + type c = ci + let create = new ci +end +let f (x : M6.c) = x#move 3; x#x;; + +module M : sig type t = private [> `A of bool] end = + struct type t = [`A of int] end diff --git a/experimental/garrigue/gadt-escape-check.diff b/experimental/garrigue/gadt-escape-check.diff new file mode 100644 index 00000000..3e4a44e2 --- /dev/null +++ b/experimental/garrigue/gadt-escape-check.diff @@ -0,0 +1,519 @@ +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 *) diff --git a/experimental/garrigue/generative-functors.diff b/experimental/garrigue/generative-functors.diff new file mode 100644 index 00000000..c7786d11 --- /dev/null +++ b/experimental/garrigue/generative-functors.diff @@ -0,0 +1,1008 @@ +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 "@[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 "()" ++ | 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 "@[@[sig@ %a@]@ end@]" (* "@[sig@ %a@ end@]" *) + (self#list self#signature_item ) s (* FIXME wrong indentation*) +- | Pmty_functor (s, mt1, mt2) -> ++ | Pmty_functor (_, None, mt2) -> ++ pp f "@[functor () ->@ %a@]" self#module_type mt2 ++ | Pmty_functor (s, Some mt1, mt2) -> + pp f "@[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 "@[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 + diff --git a/experimental/garrigue/impure-functors.diff b/experimental/garrigue/impure-functors.diff new file mode 100644 index 00000000..fd8dba57 --- /dev/null +++ b/experimental/garrigue/impure-functors.diff @@ -0,0 +1,223 @@ +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 "@[@[sig@ %a@]@ end@]" (* "@[sig@ %a@ end@]" *) + (self#list self#signature_item ) s (* FIXME wrong indentation*) ++ | Pmty_functor ({txt="*"}, mt1, mt2) -> ++ pp f "@[functor () ->@ %a@]" self#module_type mt2 + | Pmty_functor (s, mt1, mt2) -> + pp f "@[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 "@[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 + diff --git a/experimental/garrigue/marshal_objects.diff b/experimental/garrigue/marshal_objects.diff new file mode 100644 index 00000000..bb9b4dd7 --- /dev/null +++ b/experimental/garrigue/marshal_objects.diff @@ -0,0 +1,800 @@ +? bytecomp/alpha_eq.ml +Index: bytecomp/lambda.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/bytecomp/lambda.ml,v +retrieving revision 1.44 +diff -u -r1.44 lambda.ml +--- bytecomp/lambda.ml 25 Aug 2005 15:35:16 -0000 1.44 ++++ bytecomp/lambda.ml 2 Feb 2006 05:08:56 -0000 +@@ -287,9 +287,10 @@ + let compare = compare + end) + +-let free_ids get l = ++let free_ids get used l = + let fv = ref IdentSet.empty in + let rec free l = ++ let old = !fv in + iter free l; + fv := List.fold_right IdentSet.add (get l) !fv; + match l with +@@ -307,17 +308,20 @@ + fv := IdentSet.remove v !fv + | Lassign(id, e) -> + fv := IdentSet.add id !fv ++ | Lifused(id, e) -> ++ if used && not (IdentSet.mem id old) then fv := IdentSet.remove id !fv + | Lvar _ | Lconst _ | Lapply _ + | Lprim _ | Lswitch _ | Lstaticraise _ + | Lifthenelse _ | Lsequence _ | Lwhile _ +- | Lsend _ | Levent _ | Lifused _ -> () ++ | Lsend _ | Levent _ -> () + in free l; !fv + +-let free_variables l = +- free_ids (function Lvar id -> [id] | _ -> []) l ++let free_variables ?(ifused=false) l = ++ free_ids (function Lvar id -> [id] | _ -> []) ifused l + + let free_methods l = +- free_ids (function Lsend(Self, Lvar meth, obj, _) -> [meth] | _ -> []) l ++ free_ids (function Lsend(Self, Lvar meth, obj, _) -> [meth] | _ -> []) ++ false l + + (* Check if an action has a "when" guard *) + let raise_count = ref 0 +Index: bytecomp/lambda.mli +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/bytecomp/lambda.mli,v +retrieving revision 1.42 +diff -u -r1.42 lambda.mli +--- bytecomp/lambda.mli 25 Aug 2005 15:35:16 -0000 1.42 ++++ bytecomp/lambda.mli 2 Feb 2006 05:08:56 -0000 +@@ -177,7 +177,7 @@ + + val iter: (lambda -> unit) -> lambda -> unit + module IdentSet: Set.S with type elt = Ident.t +-val free_variables: lambda -> IdentSet.t ++val free_variables: ?ifused:bool -> lambda -> IdentSet.t + val free_methods: lambda -> IdentSet.t + + val transl_path: Path.t -> lambda +Index: bytecomp/translclass.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/bytecomp/translclass.ml,v +retrieving revision 1.38 +diff -u -r1.38 translclass.ml +--- bytecomp/translclass.ml 13 Aug 2005 20:59:37 -0000 1.38 ++++ bytecomp/translclass.ml 2 Feb 2006 05:08:56 -0000 +@@ -46,6 +46,10 @@ + + let lfield v i = Lprim(Pfield i, [Lvar v]) + ++let ltuple l = Lprim(Pmakeblock(0,Immutable), l) ++ ++let lprim name args = Lapply(oo_prim name, args) ++ + let transl_label l = share (Const_immstring l) + + let rec transl_meth_list lst = +@@ -68,8 +72,8 @@ + Lvar offset])])])) + + let transl_val tbl create name = +- Lapply (oo_prim (if create then "new_variable" else "get_variable"), +- [Lvar tbl; transl_label name]) ++ lprim (if create then "new_variable" else "get_variable") ++ [Lvar tbl; transl_label name] + + let transl_vals tbl create vals rem = + List.fold_right +@@ -82,7 +86,7 @@ + (fun (nm, id) rem -> + try + (nm, id, +- Lapply(oo_prim "get_method", [Lvar tbl; Lvar (Meths.find nm meths)])) ++ lprim "get_method" [Lvar tbl; Lvar (Meths.find nm meths)]) + :: rem + with Not_found -> rem) + inh_meths [] +@@ -97,17 +101,15 @@ + let (inh_init, obj_init, has_init) = init obj' in + if obj_init = lambda_unit then + (inh_init, +- Lapply (oo_prim (if has_init then "create_object_and_run_initializers" +- else"create_object_opt"), +- [obj; Lvar cl])) ++ lprim (if has_init then "create_object_and_run_initializers" ++ else"create_object_opt") ++ [obj; Lvar cl]) + else begin + (inh_init, +- Llet(Strict, obj', +- Lapply (oo_prim "create_object_opt", [obj; Lvar cl]), ++ Llet(Strict, obj', lprim "create_object_opt" [obj; Lvar cl], + Lsequence(obj_init, + if not has_init then Lvar obj' else +- Lapply (oo_prim "run_initializers_opt", +- [obj; Lvar obj'; Lvar cl])))) ++ lprim "run_initializers_opt" [obj; Lvar obj'; Lvar cl]))) + end + + let rec build_object_init cl_table obj params inh_init obj_init cl = +@@ -203,14 +205,13 @@ + + + let bind_method tbl lab id cl_init = +- Llet(StrictOpt, id, Lapply (oo_prim "get_method_label", +- [Lvar tbl; transl_label lab]), ++ Llet(StrictOpt, id, lprim "get_method_label" [Lvar tbl; transl_label lab], + cl_init) + +-let bind_methods tbl meths vals cl_init = +- let methl = Meths.fold (fun lab id tl -> (lab,id) :: tl) meths [] in ++let bind_methods tbl methl vals cl_init = + let len = List.length methl and nvals = List.length vals in +- if len < 2 && nvals = 0 then Meths.fold (bind_method tbl) meths cl_init else ++ if len < 2 && nvals = 0 then ++ List.fold_right (fun (n,i) -> bind_method tbl n i) methl cl_init else + if len = 0 && nvals < 2 then transl_vals tbl true vals cl_init else + let ids = Ident.create "ids" in + let i = ref len in +@@ -229,21 +230,19 @@ + vals' cl_init) + in + Llet(StrictOpt, ids, +- Lapply (oo_prim getter, +- [Lvar tbl; transl_meth_list (List.map fst methl)] @ names), ++ lprim getter ++ ([Lvar tbl; transl_meth_list (List.map fst methl)] @ names), + List.fold_right +- (fun (lab,id) lam -> decr i; Llet(StrictOpt, id, lfield ids !i, lam)) ++ (fun (lab,id) lam -> decr i; Llet(Alias, id, lfield ids !i, lam)) + methl cl_init) + + let output_methods tbl methods lam = + match methods with + [] -> lam + | [lab; code] -> +- lsequence (Lapply(oo_prim "set_method", [Lvar tbl; lab; code])) lam ++ lsequence (lprim "set_method" [Lvar tbl; lab; code]) lam + | _ -> +- lsequence (Lapply(oo_prim "set_methods", +- [Lvar tbl; Lprim(Pmakeblock(0,Immutable), methods)])) +- lam ++ lsequence (lprim "set_methods" [Lvar tbl; ltuple methods]) lam + + let rec ignore_cstrs cl = + match cl.cl_desc with +@@ -266,7 +265,8 @@ + Llet (Strict, obj_init, + Lapply(Lprim(Pfield 1, [lpath]), Lvar cla :: + if top then [Lprim(Pfield 3, [lpath])] else []), +- bind_super cla super cl_init)) ++ bind_super cla super cl_init), ++ [], []) + | _ -> + assert false + end +@@ -278,10 +278,11 @@ + match field with + Cf_inher (cl, vals, meths) -> + let cl_init = output_methods cla methods cl_init in +- let inh_init, cl_init = ++ let (inh_init, cl_init, meths', vals') = + build_class_init cla false + (vals, meths_super cla str.cl_meths meths) + inh_init cl_init msubst top cl in ++ let cl_init = bind_methods cla meths' vals' cl_init in + (inh_init, cl_init, [], values) + | Cf_val (name, id, exp) -> + (inh_init, cl_init, methods, (name, id)::values) +@@ -304,29 +305,37 @@ + (inh_init, cl_init, methods, vals @ values) + | Cf_init exp -> + (inh_init, +- Lsequence(Lapply (oo_prim "add_initializer", +- Lvar cla :: msubst false (transl_exp exp)), ++ Lsequence(lprim "add_initializer" ++ (Lvar cla :: msubst false (transl_exp exp)), + cl_init), + methods, values)) + str.cl_field + (inh_init, cl_init, [], []) + in + let cl_init = output_methods cla methods cl_init in +- (inh_init, bind_methods cla str.cl_meths values cl_init) ++ (* inh_init, bind_methods cla str.cl_meths values cl_init *) ++ let methods = Meths.fold (fun n i l -> (n,i)::l) str.cl_meths [] in ++ (inh_init, cl_init, methods, values) + | Tclass_fun (pat, vals, cl, _) -> +- let (inh_init, cl_init) = ++ let (inh_init, cl_init, methods, values) = + build_class_init cla cstr super inh_init cl_init msubst top cl + in ++ let fv = free_variables ~ifused:true cl_init in ++ let vals = List.filter (fun (id,_) -> IdentSet.mem id fv) vals in + let vals = List.map (function (id, _) -> (Ident.name id, id)) vals in +- (inh_init, transl_vals cla true vals cl_init) ++ (* inh_init, transl_vals cla true vals cl_init *) ++ (inh_init, cl_init, methods, vals @ values) + | Tclass_apply (cl, exprs) -> + build_class_init cla cstr super inh_init cl_init msubst top cl + | Tclass_let (rec_flag, defs, vals, cl) -> +- let (inh_init, cl_init) = ++ let (inh_init, cl_init, methods, values) = + build_class_init cla cstr super inh_init cl_init msubst top cl + in ++ let fv = free_variables ~ifused:true cl_init in ++ let vals = List.filter (fun (id,_) -> IdentSet.mem id fv) vals in + let vals = List.map (function (id, _) -> (Ident.name id, id)) vals in +- (inh_init, transl_vals cla true vals cl_init) ++ (* inh_init, transl_vals cla true vals cl_init *) ++ (inh_init, cl_init, methods, vals @ values) + | Tclass_constraint (cl, vals, meths, concr_meths) -> + let virt_meths = + List.filter (fun lab -> not (Concr.mem lab concr_meths)) meths in +@@ -358,23 +367,34 @@ + cl_init valids in + (inh_init, + Llet (Strict, inh, +- Lapply(oo_prim "inherits", narrow_args @ +- [lpath; Lconst(Const_pointer(if top then 1 else 0))]), ++ lprim "inherits" ++ (narrow_args @ ++ [lpath; Lconst(Const_pointer(if top then 1 else 0))]), + Llet(StrictOpt, obj_init, lfield inh 0, + Llet(Alias, inh_vals, lfield inh 1, +- Llet(Alias, inh_meths, lfield inh 2, cl_init))))) ++ Llet(Alias, inh_meths, lfield inh 2, cl_init)))), ++ [], []) + | _ -> + let core cl_init = + build_class_init cla true super inh_init cl_init msubst top cl + in + if cstr then core cl_init else +- let (inh_init, cl_init) = +- core (Lsequence (Lapply (oo_prim "widen", [Lvar cla]), cl_init)) ++ let (inh_init, cl_init, methods, values) = ++ core (Lsequence (lprim "widen" [Lvar cla], cl_init)) + in +- (inh_init, +- Lsequence(Lapply (oo_prim "narrow", narrow_args), cl_init)) ++ let cl_init = bind_methods cla methods values cl_init in ++ (inh_init, Lsequence(lprim "narrow" narrow_args, cl_init), [], []) + end + ++let build_class_init cla env inh_init obj_init msubst top cl = ++ let inh_init = List.rev inh_init in ++ let (inh_init, cl_init, methods, values) = ++ build_class_init cla true ([],[]) inh_init obj_init msubst top cl in ++ assert (inh_init = []); ++ if IdentSet.mem env (free_variables ~ifused:true cl_init) ++ then bind_methods cla methods (("", env) :: values) cl_init ++ else Llet(Alias, env, lambda_unit, bind_methods cla methods values cl_init) ++ + let rec build_class_lets cl = + match cl.cl_desc with + Tclass_let (rec_flag, defs, vals, cl) -> +@@ -459,16 +479,16 @@ + Strict, new_init, lfunction [obj_init] obj_init', + Llet( + Alias, cla, transl_path path, +- Lprim(Pmakeblock(0, Immutable), +- [Lapply(Lvar new_init, [lfield cla 0]); +- lfunction [table] +- (Llet(Strict, env_init, +- Lapply(lfield cla 1, [Lvar table]), +- lfunction [envs] +- (Lapply(Lvar new_init, +- [Lapply(Lvar env_init, [Lvar envs])])))); +- lfield cla 2; +- lfield cla 3]))) ++ ltuple ++ [Lapply(Lvar new_init, [lfield cla 0]); ++ lfunction [table] ++ (Llet(Strict, env_init, ++ Lapply(lfield cla 1, [Lvar table]), ++ lfunction [envs] ++ (Lapply(Lvar new_init, ++ [Lapply(Lvar env_init, [Lvar envs])])))); ++ lfield cla 2; ++ lfield cla 3])) + with Exit -> + lambda_unit + +@@ -541,7 +561,7 @@ + open CamlinternalOO + let builtin_meths arr self env env2 body = + let builtin, args = builtin_meths self env env2 body in +- if not arr then [Lapply(oo_prim builtin, args)] else ++ if not arr then [lprim builtin args] else + let tag = match builtin with + "get_const" -> GetConst + | "get_var" -> GetVar +@@ -599,7 +619,8 @@ + + (* Prepare for heavy environment handling *) + let tables = Ident.create (Ident.name cl_id ^ "_tables") in +- let (top_env, req) = oo_add_class tables in ++ let table_init = ref None in ++ let (top_env, req) = oo_add_class tables table_init in + let top = not req in + let cl_env, llets = build_class_lets cl in + let new_ids = if top then [] else Env.diff top_env cl_env in +@@ -633,6 +654,7 @@ + begin try + (* Doesn't seem to improve size for bytecode *) + (* if not !Clflags.native_code then raise Not_found; *) ++ if !Clflags.debug then raise Not_found; + builtin_meths arr [self] env env2 (lfunction args body') + with Not_found -> + [lfunction (self :: args) +@@ -665,15 +687,8 @@ + build_object_init_0 cla [] cl copy_env subst_env top ids in + if not (Translcore.check_recursive_lambda ids obj_init) then + raise(Error(cl.cl_loc, Illegal_class_expr)); +- let inh_init' = List.rev inh_init in +- let (inh_init', cl_init) = +- build_class_init cla true ([],[]) inh_init' obj_init msubst top cl +- in +- assert (inh_init' = []); +- let table = Ident.create "table" +- and class_init = Ident.create (Ident.name cl_id ^ "_init") +- and env_init = Ident.create "env_init" +- and obj_init = Ident.create "obj_init" in ++ let cl_init = build_class_init cla env2 inh_init obj_init msubst top cl in ++ let obj_init = Ident.create "obj_init" in + let pub_meths = + List.sort + (fun s s' -> compare (Btype.hash_variant s) (Btype.hash_variant s')) +@@ -685,42 +700,44 @@ + let name' = List.assoc tag rev_map in + if name' <> name then raise(Error(cl.cl_loc, Tags(name, name')))) + tags pub_meths; ++ let pos = cl.cl_loc.Location.loc_end in ++ let filepos = [transl_label pos.Lexing.pos_fname; ++ Lconst(Const_base(Const_int pos.Lexing.pos_cnum))] in + let ltable table lam = +- Llet(Strict, table, +- Lapply (oo_prim "create_table", [transl_meth_list pub_meths]), lam) ++ Llet(Strict, table, lprim "create_table" [transl_meth_list pub_meths], lam) + and ldirect obj_init = + Llet(Strict, obj_init, cl_init, +- Lsequence(Lapply (oo_prim "init_class", [Lvar cla]), ++ Lsequence(lprim "init_class_shared" (Lvar cla :: filepos), + Lapply(Lvar obj_init, [lambda_unit]))) + in + (* Simplest case: an object defined at toplevel (ids=[]) *) + if top && ids = [] then llets (ltable cla (ldirect obj_init)) else + ++ let table = Ident.create "table" ++ and class_init = Ident.create (Ident.name cl_id ^ "_init") ++ and env_init = Ident.create (Ident.name cl_id ^ "_env_init") in ++ let cl_init_fun = Lfunction(Curried, [cla], cl_init) in + let concrete = + ids = [] || + Typeclass.virtual_methods (Ctype.signature_of_class_type cl.cl_type) = [] +- and lclass lam = +- let cl_init = llets (Lfunction(Curried, [cla], cl_init)) in ++ and lclass cl_init lam = + Llet(Strict, class_init, cl_init, lam (free_variables cl_init)) + and lbody fv = + if List.for_all (fun id -> not (IdentSet.mem id fv)) ids then +- Lapply (oo_prim "make_class",[transl_meth_list pub_meths; +- Lvar class_init]) ++ lprim "make_class" ++ (transl_meth_list pub_meths :: Lvar class_init :: filepos) + else + ltable table ( + Llet( + Strict, env_init, Lapply(Lvar class_init, [Lvar table]), +- Lsequence( +- Lapply (oo_prim "init_class", [Lvar table]), +- Lprim(Pmakeblock(0, Immutable), +- [Lapply(Lvar env_init, [lambda_unit]); +- Lvar class_init; Lvar env_init; lambda_unit])))) ++ Lsequence(lprim "init_class_shared" (Lvar table :: filepos), ++ ltuple [Lapply(Lvar env_init, [lambda_unit]); ++ Lvar class_init; Lvar env_init; lambda_unit]))) + and lbody_virt lenvs = +- Lprim(Pmakeblock(0, Immutable), +- [lambda_unit; Lfunction(Curried,[cla], cl_init); lambda_unit; lenvs]) ++ ltuple [lambda_unit; cl_init_fun; lambda_unit; lenvs] + in + (* Still easy: a class defined at toplevel *) +- if top && concrete then lclass lbody else ++ if top && concrete then lclass (llets cl_init_fun) lbody else + if top then llets (lbody_virt lambda_unit) else + + (* Now for the hard stuff: prepare for table cacheing *) +@@ -733,23 +750,16 @@ + let lenv = + let menv = + if !new_ids_meths = [] then lambda_unit else +- Lprim(Pmakeblock(0, Immutable), +- List.map (fun id -> Lvar id) !new_ids_meths) in ++ ltuple (List.map (fun id -> Lvar id) !new_ids_meths) in + if !new_ids_init = [] then menv else +- Lprim(Pmakeblock(0, Immutable), +- menv :: List.map (fun id -> Lvar id) !new_ids_init) ++ ltuple (menv :: List.map (fun id -> Lvar id) !new_ids_init) + and linh_envs = + List.map (fun (_, p) -> Lprim(Pfield 3, [transl_path p])) + (List.rev inh_init) + in + let make_envs lam = + Llet(StrictOpt, envs, +- (if linh_envs = [] then lenv else +- Lprim(Pmakeblock(0, Immutable), lenv :: linh_envs)), +- lam) +- and def_ids cla lam = +- Llet(StrictOpt, env2, +- Lapply (oo_prim "new_variable", [Lvar cla; transl_label ""]), ++ (if linh_envs = [] then lenv else ltuple (lenv :: linh_envs)), + lam) + in + let inh_paths = +@@ -757,46 +767,53 @@ + (fun (_,path) -> List.mem (Path.head path) new_ids) inh_init in + let inh_keys = + List.map (fun (_,p) -> Lprim(Pfield 1, [transl_path p])) inh_paths in +- let lclass lam = +- Llet(Strict, class_init, +- Lfunction(Curried, [cla], def_ids cla cl_init), lam) ++ let lclass_init lam = ++ Llet(Strict, class_init, cl_init_fun, lam) + and lcache lam = + if inh_keys = [] then Llet(Alias, cached, Lvar tables, lam) else +- Llet(Strict, cached, +- Lapply(oo_prim "lookup_tables", +- [Lvar tables; Lprim(Pmakeblock(0, Immutable), inh_keys)]), ++ Llet(Strict, cached, lprim "lookup_tables" [Lvar tables; ltuple inh_keys], + lam) + and lset cached i lam = + Lprim(Psetfield(i, true), [Lvar cached; lam]) + in +- let ldirect () = +- ltable cla +- (Llet(Strict, env_init, def_ids cla cl_init, +- Lsequence(Lapply (oo_prim "init_class", [Lvar cla]), +- lset cached 0 (Lvar env_init)))) +- and lclass_virt () = +- lset cached 0 (Lfunction(Curried, [cla], def_ids cla cl_init)) ++ let ldirect prim pos = ++ ltable cla ( ++ Llet(Strict, env_init, cl_init, ++ Lsequence(lprim prim (Lvar cla :: pos), Lvar env_init))) ++ and lclass_concrete cached = ++ ltuple [Lapply (lfield cached 0, [lenvs]); ++ lfield cached 1; lfield cached 0; lenvs] + in ++ + llets ( +- lcache ( +- Lsequence( +- Lifthenelse(lfield cached 0, lambda_unit, +- if ids = [] then ldirect () else +- if not concrete then lclass_virt () else +- lclass ( +- Lapply (oo_prim "make_class_store", +- [transl_meth_list pub_meths; +- Lvar class_init; Lvar cached]))), + make_envs ( +- if ids = [] then Lapply(lfield cached 0, [lenvs]) else +- Lprim(Pmakeblock(0, Immutable), +- if concrete then +- [Lapply(lfield cached 0, [lenvs]); +- lfield cached 1; +- lfield cached 0; +- lenvs] +- else [lambda_unit; lfield cached 0; lambda_unit; lenvs] +- ))))) ++ if inh_paths = [] && concrete then ++ if ids = [] then begin ++ table_init := Some (ldirect "init_class_shared" filepos); ++ Lapply (Lvar tables, [lenvs]) ++ end else begin ++ let init = ++ lclass cl_init_fun (fun _ -> ++ lprim "make_class_env" ++ (transl_meth_list pub_meths :: Lvar class_init :: filepos)) ++ in table_init := Some init; ++ lclass_concrete tables ++ end ++ else begin ++ lcache ( ++ Lsequence( ++ Lifthenelse(lfield cached 0, lambda_unit, ++ if ids = [] then lset cached 0 (ldirect "init_class" []) else ++ if not concrete then lset cached 0 cl_init_fun else ++ lclass_init ( ++ lprim "make_class_store" ++ [transl_meth_list pub_meths; Lvar class_init; Lvar cached])), ++ llets ( ++ make_envs ( ++ if ids = [] then Lapply(lfield cached 0, [lenvs]) else ++ if concrete then lclass_concrete cached else ++ ltuple [lambda_unit; lfield cached 0; lambda_unit; lenvs])))) ++ end)) + + (* Wrapper for class compilation *) + +Index: bytecomp/translobj.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/bytecomp/translobj.ml,v +retrieving revision 1.9 +diff -u -r1.9 translobj.ml +--- bytecomp/translobj.ml 26 May 2004 11:10:51 -0000 1.9 ++++ bytecomp/translobj.ml 2 Feb 2006 05:08:56 -0000 +@@ -88,7 +88,6 @@ + + (* Insert labels *) + +-let string s = Lconst (Const_base (Const_string s)) + let int n = Lconst (Const_base (Const_int n)) + + let prim_makearray = +@@ -124,8 +123,8 @@ + let top_env = ref Env.empty + let classes = ref [] + +-let oo_add_class id = +- classes := id :: !classes; ++let oo_add_class id init = ++ classes := (id, init) :: !classes; + (!top_env, !cache_required) + + let oo_wrap env req f x = +@@ -141,10 +140,12 @@ + let lambda = f x in + let lambda = + List.fold_left +- (fun lambda id -> ++ (fun lambda (id, init) -> + Llet(StrictOpt, id, +- Lprim(Pmakeblock(0, Mutable), +- [lambda_unit; lambda_unit; lambda_unit]), ++ (match !init with ++ Some lam -> lam ++ | None -> Lprim(Pmakeblock(0, Mutable), ++ [lambda_unit; lambda_unit; lambda_unit])), + lambda)) + lambda !classes + in +Index: bytecomp/translobj.mli +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/bytecomp/translobj.mli,v +retrieving revision 1.6 +diff -u -r1.6 translobj.mli +--- bytecomp/translobj.mli 26 May 2004 11:10:51 -0000 1.6 ++++ bytecomp/translobj.mli 2 Feb 2006 05:08:56 -0000 +@@ -25,4 +25,4 @@ + Ident.t -> int -> ('a -> lambda) -> 'a -> int * lambda + + val oo_wrap: Env.t -> bool -> ('a -> lambda) -> 'a -> lambda +-val oo_add_class: Ident.t -> Env.t * bool ++val oo_add_class: Ident.t -> Lambda.lambda option ref -> Env.t * bool +Index: byterun/compare.h +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/byterun/compare.h,v +retrieving revision 1.2 +diff -u -r1.2 compare.h +--- byterun/compare.h 31 Dec 2003 14:20:35 -0000 1.2 ++++ byterun/compare.h 2 Feb 2006 05:08:56 -0000 +@@ -17,5 +17,6 @@ + #define CAML_COMPARE_H + + CAMLextern int caml_compare_unordered; ++CAMLextern value caml_compare(value, value); + + #endif /* CAML_COMPARE_H */ +Index: byterun/extern.c +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/byterun/extern.c,v +retrieving revision 1.59 +diff -u -r1.59 extern.c +--- byterun/extern.c 4 Jan 2006 16:55:49 -0000 1.59 ++++ byterun/extern.c 2 Feb 2006 05:08:56 -0000 +@@ -411,6 +411,22 @@ + extern_record_location(v); + break; + } ++ case Object_tag: { ++ value field0; ++ mlsize_t i; ++ i = Wosize_val(Field(v, 0)) - 1; ++ field0 = Field(Field(v, 0),i); ++ if (Wosize_val(field0) > 0) { ++ writecode32(CODE_OBJECT, Wosize_hd (hd)); ++ extern_record_location(v); ++ extern_rec(field0); ++ for (i = 1; i < sz - 1; i++) extern_rec(Field(v, i)); ++ v = Field(v, i); ++ goto tailcall; ++ } ++ if (!extern_closures) ++ extern_invalid_argument("output_value: dynamic class"); ++ } /* may fall through */ + default: { + value field0; + mlsize_t i; +Index: byterun/intern.c +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/byterun/intern.c,v +retrieving revision 1.60 +diff -u -r1.60 intern.c +--- byterun/intern.c 22 Sep 2005 14:21:50 -0000 1.60 ++++ byterun/intern.c 2 Feb 2006 05:08:56 -0000 +@@ -28,6 +28,8 @@ + #include "mlvalues.h" + #include "misc.h" + #include "reverse.h" ++#include "callback.h" ++#include "compare.h" + + static unsigned char * intern_src; + /* Reading pointer in block holding input data. */ +@@ -98,6 +100,25 @@ + #define readblock(dest,len) \ + (memmove((dest), intern_src, (len)), intern_src += (len)) + ++static value get_method_table (value key) ++{ ++ static value *classes = NULL; ++ value current; ++ if (classes == NULL) { ++ classes = caml_named_value("caml_oo_classes"); ++ if (classes == NULL) return 0; ++ caml_register_global_root(classes); ++ } ++ for (current = Field(*classes, 0); Is_block(current); ++ current = Field(current, 1)) ++ { ++ value head = Field(current, 0); ++ if (caml_compare(key, Field(head, 0)) == Val_int(0)) ++ return Field(head, 1); ++ } ++ return 0; ++} ++ + static void intern_cleanup(void) + { + if (intern_input_malloced) caml_stat_free(intern_input); +@@ -315,6 +336,24 @@ + Custom_ops_val(v) = ops; + intern_dest += 1 + size; + break; ++ case CODE_OBJECT: ++ size = read32u(); ++ v = Val_hp(intern_dest); ++ *dest = v; ++ if (intern_obj_table != NULL) intern_obj_table[obj_counter++] = v; ++ dest = (value *) (intern_dest + 1); ++ *intern_dest = Make_header(size, Object_tag, intern_color); ++ intern_dest += 1 + size; ++ intern_rec(dest); ++ *dest = get_method_table(*dest); ++ if (*dest == 0) { ++ intern_cleanup(); ++ caml_failwith("input_value: unknown class"); ++ } ++ for(size--, dest++; size > 1; size--, dest++) ++ intern_rec(dest); ++ goto tailcall; ++ + default: + intern_cleanup(); + caml_failwith("input_value: ill-formed message"); +Index: byterun/intext.h +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/byterun/intext.h,v +retrieving revision 1.32 +diff -u -r1.32 intext.h +--- byterun/intext.h 22 Sep 2005 14:21:50 -0000 1.32 ++++ byterun/intext.h 2 Feb 2006 05:08:56 -0000 +@@ -56,6 +56,7 @@ + #define CODE_CODEPOINTER 0x10 + #define CODE_INFIXPOINTER 0x11 + #define CODE_CUSTOM 0x12 ++#define CODE_OBJECT 0x14 + + #if ARCH_FLOAT_ENDIANNESS == 0x76543210 + #define CODE_DOUBLE_NATIVE CODE_DOUBLE_BIG +Index: stdlib/camlinternalOO.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/stdlib/camlinternalOO.ml,v +retrieving revision 1.14 +diff -u -r1.14 camlinternalOO.ml +--- stdlib/camlinternalOO.ml 25 Oct 2005 18:34:07 -0000 1.14 ++++ stdlib/camlinternalOO.ml 2 Feb 2006 05:08:56 -0000 +@@ -305,10 +305,38 @@ + public_methods; + table + ++(* ++let create_table_variables pub_meths priv_meths vars = ++ let tbl = create_table pub_meths in ++ let pub_meths = to_array pub_meths ++ and priv_meths = to_array priv_meths ++ and vars = to_array vars in ++ let len = 2 + Array.length pub_meths + Array.length priv_meths in ++ let res = Array.create len tbl in ++ let mv = new_methods_variables tbl pub_meths vars in ++ Array.blit mv 0 res 1; ++ res ++*) ++ + let init_class table = + inst_var_count := !inst_var_count + table.size - 1; + table.initializers <- List.rev table.initializers; +- resize table (3 + magic table.methods.(1) * 16 / Sys.word_size) ++ let len = 3 + magic table.methods.(1) * 16 / Sys.word_size in ++ (* keep 1 more for extra info *) ++ let len = if len > Array.length table.methods then len else len+1 in ++ resize table len ++ ++let classes = ref [] ++let () = Callback.register "caml_oo_classes" classes ++ ++let init_class_shared table (file : string) (pos : int) = ++ init_class table; ++ let rec unique_pos pos = ++ if List.mem_assoc (file, pos) !classes then unique_pos (pos + 0x100000) ++ else pos in ++ let pos = unique_pos pos in ++ table.methods.(Array.length table.methods - 1) <- Obj.magic (file, pos); ++ classes := ((file, pos), table.methods) :: !classes + + let inherits cla vals virt_meths concr_meths (_, super, _, env) top = + narrow cla vals virt_meths concr_meths; +@@ -319,12 +347,18 @@ + Array.map (fun nm -> get_method cla (get_method_label cla nm)) + (to_array concr_meths)) + +-let make_class pub_meths class_init = ++let make_class pub_meths class_init file pos = + let table = create_table pub_meths in + let env_init = class_init table in +- init_class table; ++ init_class_shared table file pos; + (env_init (Obj.repr 0), class_init, env_init, Obj.repr 0) + ++let make_class_env pub_meths class_init file pos = ++ let table = create_table pub_meths in ++ let env_init = class_init table in ++ init_class_shared table file pos; ++ (env_init, class_init) ++ + type init_table = { mutable env_init: t; mutable class_init: table -> t } + + let make_class_store pub_meths class_init init_table = +Index: stdlib/camlinternalOO.mli +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/stdlib/camlinternalOO.mli,v +retrieving revision 1.9 +diff -u -r1.9 camlinternalOO.mli +--- stdlib/camlinternalOO.mli 25 Oct 2005 18:34:07 -0000 1.9 ++++ stdlib/camlinternalOO.mli 2 Feb 2006 05:08:56 -0000 +@@ -43,14 +43,20 @@ + val add_initializer : table -> (obj -> unit) -> unit + val dummy_table : table + val create_table : string array -> table ++(* val create_table_variables : ++ string array -> string array -> string array -> table *) + val init_class : table -> unit ++val init_class_shared : table -> string -> int -> unit + val inherits : + table -> string array -> string array -> string array -> + (t * (table -> obj -> Obj.t) * t * obj) -> bool -> + (Obj.t * int array * closure array) + val make_class : +- string array -> (table -> Obj.t -> t) -> ++ string array -> (table -> Obj.t -> t) -> string -> int -> + (t * (table -> Obj.t -> t) * (Obj.t -> t) * Obj.t) ++val make_class_env : ++ string array -> (table -> Obj.t -> t) -> string -> int -> ++ (Obj.t -> t) * (table -> Obj.t -> t) + type init_table + val make_class_store : + string array -> (table -> t) -> init_table -> unit diff --git a/experimental/garrigue/module-errors.diff b/experimental/garrigue/module-errors.diff new file mode 100644 index 00000000..2f8c2bc2 --- /dev/null +++ b/experimental/garrigue/module-errors.diff @@ -0,0 +1,403 @@ +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 "@[%a%a@]" include_err err print_errs errs ++let rec context ppf = function ++ Module id :: rem -> ++ fprintf ppf "@[<2>module %a%a@]" ident id args rem ++ | Modtype id :: rem -> ++ fprintf ppf "@[<2>module type %a =@ %a@]" ident id context_mty rem ++ | Body x :: rem -> ++ fprintf ppf "functor (%a) ->@ %a" ident x context_mty rem ++ | Arg x :: rem -> ++ fprintf ppf "functor (%a : %a) -> ..." ident x context_mty rem ++ | [] -> ++ fprintf ppf "" ++and context_mty ppf = function ++ (Module _ | Modtype _) :: _ as rem -> ++ fprintf ppf "@[<2>sig@ %a@;<1 -2>end@]" context rem ++ | cxt -> context ppf cxt ++and args ppf = function ++ Body x :: rem -> ++ fprintf ppf "(%a)%a" ident x args rem ++ | Arg x :: rem -> ++ fprintf ppf "(%a :@ %a) : ..." ident x context_mty rem ++ | cxt -> ++ fprintf ppf " :@ %a" context_mty cxt ++ ++let path_of_context = function ++ Module id :: rem -> ++ let rec subm path = function ++ [] -> path ++ | Module id :: rem -> subm (Pdot (path, Ident.name id, -1)) rem ++ | _ -> assert false ++ in subm (Pident id) rem ++ | _ -> assert false ++ ++let context ppf cxt = ++ if cxt = [] then () else ++ if List.for_all (function Module _ -> true | _ -> false) cxt then ++ fprintf ppf "In module %a:@ " path (path_of_context cxt) ++ else ++ fprintf ppf "@[At position@ %a@]@ " context cxt ++ ++let include_err ppf (cxt, err) = ++ fprintf ppf "@[%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 "@[%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 diff --git a/experimental/garrigue/multimatch.diff b/experimental/garrigue/multimatch.diff new file mode 100644 index 00000000..6eb34b72 --- /dev/null +++ b/experimental/garrigue/multimatch.diff @@ -0,0 +1,1418 @@ +Index: parsing/lexer.mll +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/parsing/lexer.mll,v +retrieving revision 1.73 +diff -u -r1.73 lexer.mll +--- parsing/lexer.mll 11 Apr 2005 16:44:26 -0000 1.73 ++++ parsing/lexer.mll 2 Feb 2006 06:28:32 -0000 +@@ -63,6 +63,8 @@ + "match", MATCH; + "method", METHOD; + "module", MODULE; ++ "multifun", MULTIFUN; ++ "multimatch", MULTIMATCH; + "mutable", MUTABLE; + "new", NEW; + "object", OBJECT; +Index: parsing/parser.mly +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/parsing/parser.mly,v +retrieving revision 1.123 +diff -u -r1.123 parser.mly +--- parsing/parser.mly 23 Mar 2005 03:08:37 -0000 1.123 ++++ parsing/parser.mly 2 Feb 2006 06:28:32 -0000 +@@ -257,6 +257,8 @@ + %token MINUSDOT + %token MINUSGREATER + %token MODULE ++%token MULTIFUN ++%token MULTIMATCH + %token MUTABLE + %token NATIVEINT + %token NEW +@@ -325,7 +327,7 @@ + %nonassoc SEMI /* below EQUAL ({lbl=...; lbl=...}) */ + %nonassoc LET /* above SEMI ( ...; let ... in ...) */ + %nonassoc below_WITH +-%nonassoc FUNCTION WITH /* below BAR (match ... with ...) */ ++%nonassoc FUNCTION WITH MULTIFUN /* below BAR (match ... with ...) */ + %nonassoc AND /* above WITH (module rec A: SIG with ... and ...) */ + %nonassoc THEN /* below ELSE (if ... then ...) */ + %nonassoc ELSE /* (if ... then ... else ...) */ +@@ -804,8 +806,12 @@ + { mkexp(Pexp_function("", None, List.rev $3)) } + | FUN labeled_simple_pattern fun_def + { let (l,o,p) = $2 in mkexp(Pexp_function(l, o, [p, $3])) } ++ | MULTIFUN opt_bar match_cases ++ { mkexp(Pexp_multifun(List.rev $3)) } + | MATCH seq_expr WITH opt_bar match_cases +- { mkexp(Pexp_match($2, List.rev $5)) } ++ { mkexp(Pexp_match($2, List.rev $5, false)) } ++ | MULTIMATCH seq_expr WITH opt_bar match_cases ++ { mkexp(Pexp_match($2, List.rev $5, true)) } + | TRY seq_expr WITH opt_bar match_cases + { mkexp(Pexp_try($2, List.rev $5)) } + | TRY seq_expr WITH error +@@ -1318,10 +1324,10 @@ + | simple_core_type2 { Rinherit $1 } + ; + tag_field: +- name_tag OF opt_ampersand amper_type_list +- { Rtag ($1, $3, List.rev $4) } +- | name_tag +- { Rtag ($1, true, []) } ++ name_tag OF opt_ampersand amper_type_list amper_type_pair_list ++ { Rtag ($1, $3, List.rev $4, $5) } ++ | name_tag amper_type_pair_list ++ { Rtag ($1, true, [], $2) } + ; + opt_ampersand: + AMPERSAND { true } +@@ -1331,6 +1337,11 @@ + core_type { [$1] } + | amper_type_list AMPERSAND core_type { $3 :: $1 } + ; ++amper_type_pair_list: ++ AMPERSAND core_type EQUAL core_type amper_type_pair_list ++ { ($2, $4) :: $5 } ++ | /* empty */ ++ { [] } + opt_present: + LBRACKETGREATER name_tag_list RBRACKET { List.rev $2 } + | /* empty */ { [] } +Index: parsing/parsetree.mli +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/parsing/parsetree.mli,v +retrieving revision 1.42 +diff -u -r1.42 parsetree.mli +--- parsing/parsetree.mli 23 Mar 2005 03:08:37 -0000 1.42 ++++ parsing/parsetree.mli 2 Feb 2006 06:28:32 -0000 +@@ -43,7 +43,7 @@ + | Pfield_var + + and row_field = +- Rtag of label * bool * core_type list ++ Rtag of label * bool * core_type list * (core_type * core_type) list + | Rinherit of core_type + + (* XXX Type expressions for the class language *) +@@ -86,7 +86,7 @@ + | Pexp_let of rec_flag * (pattern * expression) list * expression + | Pexp_function of label * expression option * (pattern * expression) list + | Pexp_apply of expression * (label * expression) list +- | Pexp_match of expression * (pattern * expression) list ++ | Pexp_match of expression * (pattern * expression) list * bool + | Pexp_try of expression * (pattern * expression) list + | Pexp_tuple of expression list + | Pexp_construct of Longident.t * expression option * bool +@@ -111,6 +111,7 @@ + | Pexp_lazy of expression + | Pexp_poly of expression * core_type option + | Pexp_object of class_structure ++ | Pexp_multifun of (pattern * expression) list + + (* Value descriptions *) + +Index: parsing/printast.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/parsing/printast.ml,v +retrieving revision 1.29 +diff -u -r1.29 printast.ml +--- parsing/printast.ml 4 Jan 2006 16:55:50 -0000 1.29 ++++ parsing/printast.ml 2 Feb 2006 06:28:32 -0000 +@@ -205,10 +205,14 @@ + line i ppf "Pexp_apply\n"; + expression i ppf e; + list i label_x_expression ppf l; +- | Pexp_match (e, l) -> ++ | Pexp_match (e, l, b) -> + line i ppf "Pexp_match\n"; + expression i ppf e; + list i pattern_x_expression_case ppf l; ++ bool i ppf b ++ | Pexp_multifun l -> ++ line i ppf "Pexp_multifun\n"; ++ list i pattern_x_expression_case ppf l; + | Pexp_try (e, l) -> + line i ppf "Pexp_try\n"; + expression i ppf e; +@@ -653,7 +657,7 @@ + + and label_x_bool_x_core_type_list i ppf x = + match x with +- Rtag (l, b, ctl) -> ++ Rtag (l, b, ctl, cstr) -> + line i ppf "Rtag \"%s\" %s\n" l (string_of_bool b); + list (i+1) core_type ppf ctl + | Rinherit (ct) -> +Index: typing/btype.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/btype.ml,v +retrieving revision 1.38 +diff -u -r1.38 btype.ml +--- typing/btype.ml 4 Jan 2006 16:55:50 -0000 1.38 ++++ typing/btype.ml 2 Feb 2006 06:28:32 -0000 +@@ -66,16 +66,16 @@ + Clink r when !r <> Cunknown -> commu_repr !r + | c -> c + +-let rec row_field_repr_aux tl = function +- Reither(_, tl', _, {contents = Some fi}) -> +- row_field_repr_aux (tl@tl') fi +- | Reither(c, tl', m, r) -> +- Reither(c, tl@tl', m, r) ++let rec row_field_repr_aux tl tl2 = function ++ Reither(_, tl', _, tl2', {contents = Some fi}) -> ++ row_field_repr_aux (tl@tl') (tl2@tl2') fi ++ | Reither(c, tl', m, tl2', r) -> ++ Reither(c, tl@tl', m, tl2@tl2', r) + | Rpresent (Some _) when tl <> [] -> + Rpresent (Some (List.hd tl)) + | fi -> fi + +-let row_field_repr fi = row_field_repr_aux [] fi ++let row_field_repr fi = row_field_repr_aux [] [] fi + + let rec rev_concat l ll = + match ll with +@@ -170,7 +170,8 @@ + (fun (_, fi) -> + match row_field_repr fi with + | Rpresent(Some ty) -> f ty +- | Reither(_, tl, _, _) -> List.iter f tl ++ | Reither(_, tl, _, tl2, _) -> ++ List.iter f tl; List.iter (fun (t1,t2) -> f t1; f t2) tl2 + | _ -> ()) + row.row_fields; + match (repr row.row_more).desc with +@@ -208,15 +209,17 @@ + (fun (l, fi) -> l, + match row_field_repr fi with + | Rpresent(Some ty) -> Rpresent(Some(f ty)) +- | Reither(c, tl, m, e) -> ++ | Reither(c, tl, m, tpl, e) -> + let e = if keep then e else ref None in + let m = if row.row_fixed then fixed else m in + let tl = List.map f tl in ++ let tl1 = List.map (fun (t1,_) -> repr (f t1)) tpl ++ and tl2 = List.map (fun (_,t2) -> repr (f t2)) tpl in + bound := List.filter + (function {desc=Tconstr(_,[],_)} -> false | _ -> true) +- (List.map repr tl) ++ (List.map repr tl @ tl1 @ tl2) + @ !bound; +- Reither(c, tl, m, e) ++ Reither(c, tl, m, List.combine tl1 tl2, e) + | _ -> fi) + row.row_fields in + let name = +Index: typing/ctype.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/ctype.ml,v +retrieving revision 1.200 +diff -u -r1.200 ctype.ml +--- typing/ctype.ml 6 Jan 2006 02:16:24 -0000 1.200 ++++ typing/ctype.ml 2 Feb 2006 06:28:32 -0000 +@@ -340,7 +340,7 @@ + let fi = filter_row_fields erase fi in + match row_field_repr f with + Rabsent -> fi +- | Reither(_,_,false,e) when erase -> set_row_field e Rabsent; fi ++ | Reither(_,_,false,_,e) when erase -> set_row_field e Rabsent; fi + | _ -> p :: fi + + (**************************************) +@@ -1286,6 +1286,10 @@ + + module TypeMap = Map.Make (TypeOps) + ++ ++(* A list of univars which may appear free in a type, but only if generic *) ++let allowed_univars = ref TypeSet.empty ++ + (* Test the occurence of free univars in a type *) + (* that's way too expansive. Must do some kind of cacheing *) + let occur_univar env ty = +@@ -1307,7 +1311,12 @@ + then + match ty.desc with + Tunivar -> +- if not (TypeSet.mem ty bound) then raise (Unify [ty, newgenvar()]) ++ if TypeSet.mem ty bound then () else ++ if TypeSet.mem ty !allowed_univars && ++ (ty.level = generic_level || ++ ty.level = pivot_level - generic_level) ++ then () ++ else raise (Unify [ty, newgenvar()]) + | Tpoly (ty, tyl) -> + let bound = List.fold_right TypeSet.add (List.map repr tyl) bound in + occur_rec bound ty +@@ -1393,6 +1402,7 @@ + with exn -> univar_pairs := old_univars; raise exn + + let univar_pairs = ref [] ++let delayed_conditionals = ref [] + + + (*****************) +@@ -1691,9 +1701,11 @@ + with Not_found -> (h,l)::hl) + (List.map (fun (l,_) -> (hash_variant l, l)) row1.row_fields) + (List.map fst r2)); ++ let fixed1 = row1.row_fixed || rm1.desc <> Tvar ++ and fixed2 = row2.row_fixed || rm2.desc <> Tvar in + let more = +- if row1.row_fixed then rm1 else +- if row2.row_fixed then rm2 else ++ if fixed1 then rm1 else ++ if fixed2 then rm2 else + newgenvar () + in update_level env (min rm1.level rm2.level) more; + let fixed = row1.row_fixed || row2.row_fixed +@@ -1726,18 +1738,18 @@ + let bound = row1.row_bound @ row2.row_bound in + let row0 = {row_fields = []; row_more = more; row_bound = bound; + row_closed = closed; row_fixed = fixed; row_name = name} in +- let set_more row rest = ++ let set_more row row_fixed rest = + let rest = + if closed then + filter_row_fields row.row_closed rest + else rest in +- if rest <> [] && (row.row_closed || row.row_fixed) +- || closed && row.row_fixed && not row.row_closed then begin ++ if rest <> [] && (row.row_closed || row_fixed) ++ || closed && row_fixed && not row.row_closed then begin + let t1 = mkvariant [] true and t2 = mkvariant rest false in + raise (Unify [if row == row1 then (t1,t2) else (t2,t1)]) + end; + let rm = row_more row in +- if row.row_fixed then ++ if row_fixed then + if row0.row_more == rm then () else + if rm.desc = Tvar then link_type rm row0.row_more else + unify env rm row0.row_more +@@ -1748,11 +1760,11 @@ + in + let md1 = rm1.desc and md2 = rm2.desc in + begin try +- set_more row1 r2; +- set_more row2 r1; ++ set_more row1 fixed1 r2; ++ set_more row2 fixed2 r1; + List.iter + (fun (l,f1,f2) -> +- try unify_row_field env row1.row_fixed row2.row_fixed l f1 f2 ++ try unify_row_field env fixed1 fixed2 row1 row2 l f1 f2 + with Unify trace -> + raise (Unify ((mkvariant [l,f1] true, + mkvariant [l,f2] true) :: trace))) +@@ -1761,13 +1773,13 @@ + log_type rm1; rm1.desc <- md1; log_type rm2; rm2.desc <- md2; raise exn + end + +-and unify_row_field env fixed1 fixed2 l f1 f2 = ++and unify_row_field env fixed1 fixed2 row1 row2 l f1 f2 = + let f1 = row_field_repr f1 and f2 = row_field_repr f2 in + if f1 == f2 then () else + match f1, f2 with + Rpresent(Some t1), Rpresent(Some t2) -> unify env t1 t2 + | Rpresent None, Rpresent None -> () +- | Reither(c1, tl1, m1, e1), Reither(c2, tl2, m2, e2) -> ++ | Reither(c1, tl1, m1, tp1, e1), Reither(c2, tl2, m2, tp2, e2) -> + if e1 == e2 then () else + let redo = + (m1 || m2) && +@@ -1777,32 +1789,70 @@ + List.iter (unify env t1) tl; + !e1 <> None || !e2 <> None + end in +- if redo then unify_row_field env fixed1 fixed2 l f1 f2 else ++ let redo = ++ redo || begin ++ if tp1 = [] && fixed1 then unify_pairs env tp2; ++ if tp2 = [] && fixed2 then unify_pairs env tp1; ++ !e1 <> None || !e2 <> None ++ end ++ in ++ if redo then unify_row_field env fixed1 fixed2 row1 row2 l f1 f2 else + let tl1 = List.map repr tl1 and tl2 = List.map repr tl2 in + let rec remq tl = function [] -> [] + | ty :: tl' -> + if List.memq ty tl then remq tl tl' else ty :: remq tl tl' + in + let tl2' = remq tl2 tl1 and tl1' = remq tl1 tl2 in ++ let repr_pairs = List.map (fun (t1,t2) -> repr t1, repr t2) in ++ let tp1 = repr_pairs tp1 and tp2 = repr_pairs tp2 in ++ let rec rempq tp = function [] -> [] ++ | (t1,t2 as p) :: tp' -> ++ if List.exists (fun (t1',t2') -> t1==t1' && t2==t2') (tp@tp') then ++ rempq tp tp' ++ else p :: rempq tp tp' ++ in ++ let tp1' = ++ if fixed2 then begin ++ delayed_conditionals := ++ (!univar_pairs, tp1, l, row2) :: !delayed_conditionals; ++ [] ++ end else rempq tp2 tp1 ++ and tp2' = ++ if fixed1 then begin ++ delayed_conditionals := ++ (!univar_pairs, tp2, l, row1) :: !delayed_conditionals; ++ [] ++ end else rempq tp1 tp2 ++ in + let e = ref None in +- let f1' = Reither(c1 || c2, tl1', m1 || m2, e) +- and f2' = Reither(c1 || c2, tl2', m1 || m2, e) in +- set_row_field e1 f1'; set_row_field e2 f2'; +- | Reither(_, _, false, e1), Rabsent -> set_row_field e1 f2 +- | Rabsent, Reither(_, _, false, e2) -> set_row_field e2 f1 ++ let f1' = Reither(c1 || c2, tl1', m1 || m2, tp2', e) ++ and f2' = Reither(c1 || c2, tl2', m1 || m2, tp1', e) in ++ set_row_field e1 f1'; set_row_field e2 f2' ++ | Reither(_, _, false, _, e1), Rabsent -> set_row_field e1 f2 ++ | Rabsent, Reither(_, _, false, _, e2) -> set_row_field e2 f1 + | Rabsent, Rabsent -> () +- | Reither(false, tl, _, e1), Rpresent(Some t2) when not fixed1 -> ++ | Reither(false, tl, _, tp, e1), Rpresent(Some t2) when not fixed1 -> + set_row_field e1 f2; +- (try List.iter (fun t1 -> unify env t1 t2) tl ++ begin try ++ List.iter (fun t1 -> unify env t1 t2) tl; ++ List.iter (fun (t1,t2) -> unify env t1 t2) tp ++ with exn -> e1 := None; raise exn ++ end ++ | Rpresent(Some t1), Reither(false, tl, _, tp, e2) when not fixed2 -> ++ set_row_field e2 f1; ++ begin try ++ List.iter (unify env t1) tl; ++ List.iter (fun (t1,t2) -> unify env t1 t2) tp ++ with exn -> e2 := None; raise exn ++ end ++ | Reither(true, [], _, tpl, e1), Rpresent None when not fixed1 -> ++ set_row_field e1 f2; ++ (try List.iter (fun (t1,t2) -> unify env t1 t2) tpl + with exn -> e1 := None; raise exn) +- | Rpresent(Some t1), Reither(false, tl, _, e2) when not fixed2 -> ++ | Rpresent None, Reither(true, [], _, tpl, e2) when not fixed2 -> + set_row_field e2 f1; +- (try List.iter (unify env t1) tl ++ (try List.iter (fun (t1,t2) -> unify env t1 t2) tpl + with exn -> e2 := None; raise exn) +- | Reither(true, [], _, e1), Rpresent None when not fixed1 -> +- set_row_field e1 f2 +- | Rpresent None, Reither(true, [], _, e2) when not fixed2 -> +- set_row_field e2 f1 + | _ -> raise (Unify []) + + +@@ -1920,6 +1970,166 @@ + (* Matching between type schemes *) + (***********************************) + ++(* Forward declaration (order should be reversed...) *) ++let equal' = ref (fun _ -> failwith "Ctype.equal'") ++ ++let make_generics_univars tyl = ++ let polyvars = ref TypeSet.empty in ++ let rec make_rec ty = ++ let ty = repr ty in ++ if ty.level = generic_level then begin ++ if ty.desc = Tvar then begin ++ log_type ty; ++ ty.desc <- Tunivar; ++ polyvars := TypeSet.add ty !polyvars ++ end ++ else if ty.desc = Tunivar then set_level ty (generic_level - 1); ++ ty.level <- pivot_level - generic_level; ++ iter_type_expr make_rec ty ++ end ++ in ++ List.iter make_rec tyl; ++ List.iter unmark_type tyl; ++ !polyvars ++ ++(* New version of moregeneral, using unification *) ++ ++let copy_cond (p,tpl,l,row) = ++ let row = ++ match repr (copy (newgenty (Tvariant row))) with ++ {desc=Tvariant row} -> row ++ | _ -> assert false ++ and pairs = ++ List.map (fun (t1,t2) -> copy t1, copy t2) tpl in ++ (p, pairs, l, row) ++ ++let get_row_field l row = ++ try row_field_repr (List.assoc l (row_repr row).row_fields) ++ with Not_found -> Rabsent ++ ++let rec check_conditional_list env cdtls pattvars tpls = ++ match cdtls with ++ [] -> ++ let finished = ++ List.for_all (fun (_,t1,t2) -> !equal' env false [t1] [t2]) tpls in ++ if not finished then begin ++ let polyvars = make_generics_univars pattvars in ++ delayed_conditionals := []; ++ allowed_univars := polyvars; ++ List.iter (fun (pairs, ty1, ty2) -> unify_pairs env ty1 ty2 pairs) ++ tpls; ++ check_conditionals env polyvars !delayed_conditionals ++ end ++ | (pairs, tpl1, l, row2 as cond) :: cdtls -> ++ let cont = check_conditional_list env cdtls pattvars in ++ let tpl1 = ++ List.filter (fun (t1,t2) -> not (!equal' env false [t1] [t2])) tpl1 in ++ let included = ++ List.for_all ++ (fun (t1,t2) -> ++ List.exists ++ (fun (_,t1',t2') -> !equal' env false [t1;t2] [t1';t2']) ++ tpls) ++ tpl1 in ++ if included then cont tpls else ++ match get_row_field l row2 with ++ Rpresent _ -> ++ cont (List.map (fun (t1,t2) -> (pairs,t1,t2)) tpl1 @ tpls) ++ | Rabsent -> cont tpls ++ | Reither (c, tl2, _, _, _) -> ++ cont tpls; ++ if c && tl2 <> [] then () (* cannot succeed *) else ++ let (pairs, tpl1, l, row2) = copy_cond cond ++ and tpls = List.map (fun (p,t1,t2) -> p, copy t1, copy t2) tpls ++ and pattvars = List.map copy pattvars ++ and cdtls = List.map copy_cond cdtls in ++ cleanup_types (); ++ let tl2, tpl2, e2 = ++ match get_row_field l row2 with ++ Reither (c, tl2, _, tpl2, e2) -> tl2, tpl2, e2 ++ | _ -> assert false ++ in ++ let snap = Btype.snapshot () in ++ let ok = ++ try ++ begin match tl2 with ++ [] -> ++ set_row_field e2 (Rpresent None) ++ | t::tl -> ++ set_row_field e2 (Rpresent (Some t)); ++ List.iter (unify env t) tl ++ end; ++ List.iter (fun (t1,t2) -> unify_pairs env t1 t2 pairs) tpl2; ++ true ++ with exn -> ++ Btype.backtrack snap; ++ false ++ in ++ (* This is not [cont] : types have been copied *) ++ if ok then ++ check_conditional_list env cdtls pattvars ++ (List.map (fun (t1,t2) -> (pairs,t1,t2)) tpl1 @ tpls) ++ ++and check_conditionals env polyvars cdtls = ++ let cdtls = List.map copy_cond cdtls in ++ let pattvars = ref [] in ++ TypeSet.iter ++ (fun ty -> ++ let ty = repr ty in ++ match ty.desc with ++ Tsubst ty -> ++ let ty = repr ty in ++ begin match ty.desc with ++ Tunivar -> ++ log_type ty; ++ ty.desc <- Tvar; ++ pattvars := ty :: !pattvars ++ | Ttuple [tv;_] -> ++ if tv.desc = Tunivar then ++ (log_type tv; tv.desc <- Tvar; pattvars := ty :: !pattvars) ++ else if tv.desc <> Tvar then assert false ++ | Tvar -> () ++ | _ -> assert false ++ end ++ | _ -> ()) ++ polyvars; ++ cleanup_types (); ++ check_conditional_list env cdtls !pattvars [] ++ ++ ++(* Must empty univar_pairs first *) ++let unify_poly env polyvars subj patt = ++ let old_level = !current_level in ++ current_level := generic_level; ++ delayed_conditionals := []; ++ allowed_univars := polyvars; ++ try ++ unify env subj patt; ++ check_conditionals env polyvars !delayed_conditionals; ++ current_level := old_level; ++ allowed_univars := TypeSet.empty; ++ delayed_conditionals := [] ++ with exn -> ++ current_level := old_level; ++ allowed_univars := TypeSet.empty; ++ delayed_conditionals := []; ++ raise exn ++ ++let moregeneral env _ subj patt = ++ let old_level = !current_level in ++ current_level := generic_level; ++ let subj = instance subj ++ and patt = instance patt in ++ let polyvars = make_generics_univars [patt] in ++ current_level := old_level; ++ let snap = Btype.snapshot () in ++ try ++ unify_poly env polyvars subj patt; ++ true ++ with Unify _ -> ++ Btype.backtrack snap; ++ false ++ + (* + Update the level of [ty]. First check that the levels of generic + variables from the subject are not lowered. +@@ -2072,35 +2282,101 @@ + Rpresent(Some t1), Rpresent(Some t2) -> + moregen inst_nongen type_pairs env t1 t2 + | Rpresent None, Rpresent None -> () +- | Reither(false, tl1, _, e1), Rpresent(Some t2) when not univ -> ++ | Reither(false, tl1, _, [], e1), Rpresent(Some t2) when not univ -> + set_row_field e1 f2; + List.iter (fun t1 -> moregen inst_nongen type_pairs env t1 t2) tl1 +- | Reither(c1, tl1, _, e1), Reither(c2, tl2, m2, e2) -> ++ | Reither(c1, tl1, _, tpl1, e1), Reither(c2, tl2, m2, tpl2, e2) -> + if e1 != e2 then begin + if c1 && not c2 then raise(Unify []); +- set_row_field e1 (Reither (c2, [], m2, e2)); +- if List.length tl1 = List.length tl2 then +- List.iter2 (moregen inst_nongen type_pairs env) tl1 tl2 +- else match tl2 with +- t2 :: _ -> ++ let tpl' = if tpl1 = [] then tpl2 else [] in ++ set_row_field e1 (Reither (c2, [], m2, tpl', e2)); ++ begin match tl2 with ++ [t2] -> + List.iter (fun t1 -> moregen inst_nongen type_pairs env t1 t2) + tl1 +- | [] -> +- if tl1 <> [] then raise (Unify []) ++ | _ -> ++ if List.length tl1 <> List.length tl2 then raise (Unify []); ++ List.iter2 (moregen inst_nongen type_pairs env) tl1 tl2 ++ end; ++ if tpl1 <> [] then ++ delayed_conditionals := ++ (!univar_pairs, tpl1, l, row2) :: !delayed_conditionals + end +- | Reither(true, [], _, e1), Rpresent None when not univ -> ++ | Reither(true, [], _, [], e1), Rpresent None when not univ -> + set_row_field e1 f2 +- | Reither(_, _, _, e1), Rabsent when not univ -> ++ | Reither(_, _, _, [], e1), Rabsent when not univ -> + set_row_field e1 f2 + | Rabsent, Rabsent -> () + | _ -> raise (Unify [])) + pairs + ++let check_conditional env (pairs, tpl1, l, row2) tpls cont = ++ let tpl1 = ++ List.filter (fun (t1,t2) -> not (!equal' env false [t1] [t2])) tpl1 in ++ let included = ++ List.for_all ++ (fun (t1,t2) -> ++ List.exists (fun (t1',t2') -> !equal' env false [t1;t2] [t1';t2']) ++ tpls) ++ tpl1 in ++ if tpl1 = [] || included then cont tpls else ++ match get_row_field l row2 with ++ Rpresent _ -> cont (tpl1 @ tpls) ++ | Rabsent -> cont tpls ++ | Reither (c, tl2, _, tpl2, e2) -> ++ if not c || tl2 = [] then begin ++ let snap = Btype.snapshot () in ++ let ok = ++ try ++ begin match tl2 with ++ [] -> ++ set_row_field e2 (Rpresent None) ++ | t::tl -> ++ set_row_field e2 (Rpresent (Some t)); ++ List.iter (unify env t) tl ++ end; ++ List.iter (fun (t1,t2) -> unify_pairs env t1 t2 pairs) tpl2; ++ true ++ with Unify _ -> false ++ in ++ if ok then cont (tpl1 @ tpls); ++ Btype.backtrack snap ++ end; ++ cont tpls ++ ++let rec check_conditionals inst_nongen env cdtls tpls = ++ match cdtls with ++ [] -> ++ let tpls = ++ List.filter (fun (t1,t2) -> not (!equal' env false [t1] [t2])) tpls in ++ if tpls = [] then () else begin ++ delayed_conditionals := []; ++ let tl1, tl2 = List.split tpls in ++ let type_pairs = TypePairs.create 13 in ++ List.iter2 (moregen false type_pairs env) tl2 tl1; ++ check_conditionals inst_nongen env !delayed_conditionals [] ++ end ++ | cdtl :: cdtls -> ++ check_conditional env cdtl tpls ++ (check_conditionals inst_nongen env cdtls) ++ ++ + (* Must empty univar_pairs first *) + let moregen inst_nongen type_pairs env patt subj = + univar_pairs := []; +- moregen inst_nongen type_pairs env patt subj ++ delayed_conditionals := []; ++ try ++ moregen inst_nongen type_pairs env patt subj; ++ check_conditionals inst_nongen env !delayed_conditionals []; ++ univar_pairs := []; ++ delayed_conditionals := [] ++ with exn -> ++ univar_pairs := []; ++ delayed_conditionals := []; ++ raise exn ++ + ++(* old implementation + (* + Non-generic variable can be instanciated only if [inst_nongen] is + true. So, [inst_nongen] should be set to false if the subject might +@@ -2128,6 +2404,7 @@ + in + current_level := old_level; + res ++*) + + + (* Alternative approach: "rigidify" a type scheme, +@@ -2296,30 +2573,36 @@ + {desc=Tvariant row2} -> eqtype_row rename type_pairs subst env row1 row2 + | _ -> raise Cannot_expand + with Cannot_expand -> ++ let eqtype_rec = eqtype rename type_pairs subst env in + let row1 = row_repr row1 and row2 = row_repr row2 in + let r1, r2, pairs = merge_row_fields row1.row_fields row2.row_fields in + if row1.row_closed <> row2.row_closed + || not row1.row_closed && (r1 <> [] || r2 <> []) + || filter_row_fields false (r1 @ r2) <> [] + then raise (Unify []); +- if not (static_row row1) then +- eqtype rename type_pairs subst env row1.row_more row2.row_more; ++ if not (static_row row1) then eqtype_rec row1.row_more row2.row_more; + List.iter + (fun (_,f1,f2) -> + match row_field_repr f1, row_field_repr f2 with + Rpresent(Some t1), Rpresent(Some t2) -> +- eqtype rename type_pairs subst env t1 t2 +- | Reither(true, [], _, _), Reither(true, [], _, _) -> +- () +- | Reither(false, t1::tl1, _, _), Reither(false, t2::tl2, _, _) -> +- eqtype rename type_pairs subst env t1 t2; ++ eqtype_rec t1 t2 ++ | Reither(true, [], _, tp1, _), Reither(true, [], _, tp2, _) -> ++ List.iter2 ++ (fun (t1,t1') (t2,t2') -> eqtype_rec t1 t2; eqtype_rec t1' t2') ++ tp1 tp2 ++ | Reither(false, t1::tl1, _, tpl1, _), ++ Reither(false, t2::tl2, _, tpl2, _) -> ++ eqtype_rec t1 t2; ++ List.iter2 ++ (fun (t1,t1') (t2,t2') -> eqtype_rec t1 t2; eqtype_rec t1' t2') ++ tpl1 tpl2; + if List.length tl1 = List.length tl2 then + (* if same length allow different types (meaning?) *) +- List.iter2 (eqtype rename type_pairs subst env) tl1 tl2 ++ List.iter2 eqtype_rec tl1 tl2 + else begin + (* otherwise everything must be equal *) +- List.iter (eqtype rename type_pairs subst env t1) tl2; +- List.iter (fun t1 -> eqtype rename type_pairs subst env t1 t2) tl1 ++ List.iter (eqtype_rec t1) tl2; ++ List.iter (fun t1 -> eqtype_rec t1 t2) tl1 + end + | Rpresent None, Rpresent None -> () + | Rabsent, Rabsent -> () +@@ -2334,6 +2617,8 @@ + with + Unify _ -> false + ++let () = equal' := equal ++ + (* Must empty univar_pairs first *) + let eqtype rename type_pairs subst env t1 t2 = + univar_pairs := []; +@@ -2770,14 +3055,14 @@ + (fun (l,f as orig) -> match row_field_repr f with + Rpresent None -> + if posi then +- (l, Reither(true, [], false, ref None)), Unchanged ++ (l, Reither(true, [], false, [], ref None)), Unchanged + else + orig, Unchanged + | Rpresent(Some t) -> + let (t', c) = build_subtype env visited loops posi level' t in + if posi && level > 0 then begin + bound := t' :: !bound; +- (l, Reither(false, [t'], false, ref None)), c ++ (l, Reither(false, [t'], false, [], ref None)), c + end else + (l, Rpresent(Some t')), c + | _ -> assert false) +@@ -2960,11 +3245,11 @@ + List.fold_left + (fun cstrs (_,f1,f2) -> + match row_field_repr f1, row_field_repr f2 with +- (Rpresent None|Reither(true,_,_,_)), Rpresent None -> ++ (Rpresent None|Reither(true,_,_,[],_)), Rpresent None -> + cstrs + | Rpresent(Some t1), Rpresent(Some t2) -> + subtype_rec env ((t1, t2)::trace) t1 t2 cstrs +- | Reither(false, t1::_, _, _), Rpresent(Some t2) -> ++ | Reither(false, t1::_, _, [], _), Rpresent(Some t2) -> + subtype_rec env ((t1, t2)::trace) t1 t2 cstrs + | Rabsent, _ -> cstrs + | _ -> raise Exit) +@@ -2977,11 +3262,11 @@ + (fun cstrs (_,f1,f2) -> + match row_field_repr f1, row_field_repr f2 with + Rpresent None, Rpresent None +- | Reither(true,[],_,_), Reither(true,[],_,_) ++ | Reither(true,[],_,[],_), Reither(true,[],_,[],_) + | Rabsent, Rabsent -> + cstrs + | Rpresent(Some t1), Rpresent(Some t2) +- | Reither(false,[t1],_,_), Reither(false,[t2],_,_) -> ++ | Reither(false,[t1],_,[],_), Reither(false,[t2],_,[],_) -> + subtype_rec env ((t1, t2)::trace) t1 t2 cstrs + | _ -> raise Exit) + cstrs pairs +@@ -3079,16 +3364,26 @@ + let fields = List.map + (fun (l,f) -> + let f = row_field_repr f in l, +- match f with Reither(b, ty::(_::_ as tyl), m, e) -> +- let tyl' = +- List.fold_left +- (fun tyl ty -> +- if List.exists (fun ty' -> equal env false [ty] [ty']) tyl +- then tyl else ty::tyl) +- [ty] tyl ++ match f with Reither(b, tyl, m, tp, e) -> ++ let rem_dbl eq l = ++ List.rev ++ (List.fold_left ++ (fun xs x -> if List.exists (eq x) xs then xs else x::xs) ++ [] l) ++ in ++ let tyl' = rem_dbl (fun t1 t2 -> equal env false [t1] [t2]) tyl ++ and tp' = ++ List.filter ++ (fun (ty1,ty2) -> not (equal env false [ty1] [ty2])) tp ++ in ++ let tp' = ++ rem_dbl ++ (fun (t1,t2) (t1',t2') -> equal env false [t1;t2] [t1';t2']) ++ tp' + in +- if List.length tyl' <= List.length tyl then +- let f = Reither(b, List.rev tyl', m, ref None) in ++ if List.length tyl' < List.length tyl ++ || List.length tp' < List.length tp then ++ let f = Reither(b, tyl', m, tp', ref None) in + set_row_field e f; + f + else f +@@ -3344,9 +3639,9 @@ + List.iter + (fun (l,fi) -> + match row_field_repr fi with +- Reither (c, t1::(_::_ as tl), m, e) -> ++ Reither (c, t1::(_::_ as tl), m, tp, e) -> + List.iter (unify env t1) tl; +- set_row_field e (Reither (c, [t1], m, ref None)) ++ set_row_field e (Reither (c, [t1], m, tp, ref None)) + | _ -> + ()) + row.row_fields; +Index: typing/includecore.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/includecore.ml,v +retrieving revision 1.32 +diff -u -r1.32 includecore.ml +--- typing/includecore.ml 8 Aug 2005 05:40:52 -0000 1.32 ++++ typing/includecore.ml 2 Feb 2006 06:28:32 -0000 +@@ -71,10 +71,10 @@ + (fun (_, f1, f2) -> + match Btype.row_field_repr f1, Btype.row_field_repr f2 with + Rpresent(Some t1), +- (Rpresent(Some t2) | Reither(false, [t2], _, _)) -> ++ (Rpresent(Some t2) | Reither(false,[t2],_,[],_)) -> + to_equal := (t1,t2) :: !to_equal; true +- | Rpresent None, (Rpresent None | Reither(true, [], _, _)) -> true +- | Reither(c1,tl1,_,_), Reither(c2,tl2,_,_) ++ | Rpresent None, (Rpresent None | Reither(true,[],_,[],_)) -> true ++ | Reither(c1,tl1,_,[],_), Reither(c2,tl2,_,[],_) + when List.length tl1 = List.length tl2 && c1 = c2 -> + to_equal := List.combine tl1 tl2 @ !to_equal; true + | Rabsent, (Reither _ | Rabsent) -> true +Index: typing/oprint.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/oprint.ml,v +retrieving revision 1.22 +diff -u -r1.22 oprint.ml +--- typing/oprint.ml 23 Mar 2005 03:08:37 -0000 1.22 ++++ typing/oprint.ml 2 Feb 2006 06:28:33 -0000 +@@ -223,14 +223,18 @@ + print_fields rest ppf [] + | (s, t) :: l -> + fprintf ppf "%s : %a;@ %a" s print_out_type t (print_fields rest) l +-and print_row_field ppf (l, opt_amp, tyl) = ++and print_row_field ppf (l, opt_amp, tyl, tpl) = + let pr_of ppf = + if opt_amp then fprintf ppf " of@ &@ " + else if tyl <> [] then fprintf ppf " of@ " +- else fprintf ppf "" +- in +- fprintf ppf "@[`%s%t%a@]" l pr_of (print_typlist print_out_type " &") +- tyl ++ and pr_tp ppf (t1,t2) = ++ fprintf ppf "@[%a =@ %a@]" ++ print_out_type t1 ++ print_out_type t2 ++ in ++ fprintf ppf "@[`%s%t%a%a@]" l pr_of ++ (print_typlist print_out_type " &") tyl ++ (print_list_init pr_tp (fun ppf -> fprintf ppf " &@ ")) tpl + and print_typlist print_elem sep ppf = + function + [] -> () +Index: typing/outcometree.mli +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/outcometree.mli,v +retrieving revision 1.14 +diff -u -r1.14 outcometree.mli +--- typing/outcometree.mli 23 Mar 2005 03:08:37 -0000 1.14 ++++ typing/outcometree.mli 2 Feb 2006 06:28:33 -0000 +@@ -61,7 +61,8 @@ + bool * out_variant * bool * (string list) option + | Otyp_poly of string list * out_type + and out_variant = +- | Ovar_fields of (string * bool * out_type list) list ++ | Ovar_fields of ++ (string * bool * out_type list * (out_type * out_type) list ) list + | Ovar_name of out_ident * out_type list + + type out_class_type = +Index: typing/parmatch.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/parmatch.ml,v +retrieving revision 1.70 +diff -u -r1.70 parmatch.ml +--- typing/parmatch.ml 24 Mar 2005 17:20:54 -0000 1.70 ++++ typing/parmatch.ml 2 Feb 2006 06:28:33 -0000 +@@ -568,11 +568,11 @@ + List.fold_left + (fun nm (tag,f) -> + match Btype.row_field_repr f with +- | Reither(_, _, false, e) -> ++ | Reither(_, _, false, _, e) -> + (* m=false means that this tag is not explicitly matched *) + Btype.set_row_field e Rabsent; + None +- | Rabsent | Reither (_, _, true, _) | Rpresent _ -> nm) ++ | Rabsent | Reither (_, _, true, _, _) | Rpresent _ -> nm) + row.row_name row.row_fields in + if not row.row_closed || nm != row.row_name then begin + (* this unification cannot fail *) +@@ -605,8 +605,8 @@ + List.for_all + (fun (tag,f) -> + match Btype.row_field_repr f with +- Rabsent | Reither(_, _, false, _) -> true +- | Reither (_, _, true, _) ++ Rabsent | Reither(_, _, false, _, _) -> true ++ | Reither (_, _, true, _, _) + (* m=true, do not discard matched tags, rather warn *) + | Rpresent _ -> List.mem tag fields) + row.row_fields +@@ -739,7 +739,7 @@ + match Btype.row_field_repr f with + Rabsent (* | Reither _ *) -> others + (* This one is called after erasing pattern info *) +- | Reither (c, _, _, _) -> make_other_pat tag c :: others ++ | Reither (c, _, _, _, _) -> make_other_pat tag c :: others + | Rpresent arg -> make_other_pat tag (arg = None) :: others) + [] row.row_fields + with +Index: typing/printtyp.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/printtyp.ml,v +retrieving revision 1.140 +diff -u -r1.140 printtyp.ml +--- typing/printtyp.ml 4 Jan 2006 16:55:50 -0000 1.140 ++++ typing/printtyp.ml 2 Feb 2006 06:28:33 -0000 +@@ -157,9 +157,12 @@ + and raw_field ppf = function + Rpresent None -> fprintf ppf "Rpresent None" + | Rpresent (Some t) -> fprintf ppf "@[<1>Rpresent(Some@,%a)@]" raw_type t +- | Reither (c,tl,m,e) -> +- fprintf ppf "@[Reither(%b,@,%a,@,%b,@,@[<1>ref%t@])@]" c +- raw_type_list tl m ++ | Reither (c,tl,m,tpl,e) -> ++ fprintf ppf "@[Reither(%b,@,%a,@,%b,@,%a,@,@[<1>ref%t@])@]" ++ c raw_type_list tl m ++ (raw_list ++ (fun ppf (t1,t2) -> ++ fprintf ppf "@[%a,@,%a@]" raw_type t1 raw_type t2)) tpl + (fun ppf -> + match !e with None -> fprintf ppf " None" + | Some f -> fprintf ppf "@,@[<1>(%a)@]" raw_field f) +@@ -219,8 +222,9 @@ + List.for_all + (fun (_, f) -> + match row_field_repr f with +- | Reither(c, l, _, _) -> +- row.row_closed && if c then l = [] else List.length l = 1 ++ | Reither(c, l, _, pl, _) -> ++ row.row_closed && pl = [] && ++ if c then l = [] else List.length l = 1 + | _ -> true) + row.row_fields + +@@ -392,13 +396,16 @@ + + and tree_of_row_field sch (l, f) = + match row_field_repr f with +- | Rpresent None | Reither(true, [], _, _) -> (l, false, []) +- | Rpresent(Some ty) -> (l, false, [tree_of_typexp sch ty]) +- | Reither(c, tyl, _, _) -> +- if c (* contradiction: un constructeur constant qui a un argument *) +- then (l, true, tree_of_typlist sch tyl) +- else (l, false, tree_of_typlist sch tyl) +- | Rabsent -> (l, false, [] (* une erreur, en fait *)) ++ | Rpresent None | Reither(true, [], _, [], _) -> (l, false, [], []) ++ | Rpresent(Some ty) -> (l, false, [tree_of_typexp sch ty], []) ++ | Reither(c, tyl, _, tpl, _) -> ++ let ttpl = ++ List.map ++ (fun (t1,t2) -> tree_of_typexp sch t1, tree_of_typexp sch t2) ++ tpl ++ in ++ (l, c && tpl = [], tree_of_typlist sch tyl, ttpl) ++ | Rabsent -> (l, false, [], [] (* une erreur, en fait *)) + + and tree_of_typlist sch tyl = + List.map (tree_of_typexp sch) tyl +Index: typing/typeclass.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/typeclass.ml,v +retrieving revision 1.85 +diff -u -r1.85 typeclass.ml +--- typing/typeclass.ml 22 Jul 2005 06:42:36 -0000 1.85 ++++ typing/typeclass.ml 2 Feb 2006 06:28:33 -0000 +@@ -727,7 +727,7 @@ + {pexp_loc = loc; pexp_desc = + Pexp_match({pexp_loc = loc; pexp_desc = + Pexp_ident(Longident.Lident"*opt*")}, +- scases)} in ++ scases, false)} in + let sfun = + {pcl_loc = scl.pcl_loc; pcl_desc = + Pcl_fun(l, None, {ppat_loc = loc; ppat_desc = Ppat_var"*opt*"}, +Index: typing/typecore.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/typecore.ml,v +retrieving revision 1.178 +diff -u -r1.178 typecore.ml +--- typing/typecore.ml 6 Jan 2006 02:25:37 -0000 1.178 ++++ typing/typecore.ml 2 Feb 2006 06:28:33 -0000 +@@ -156,15 +156,21 @@ + let field = row_field tag row in + begin match field with + | Rabsent -> assert false +- | Reither (true, [], _, e) when not row.row_closed -> +- set_row_field e (Rpresent None) +- | Reither (false, ty::tl, _, e) when not row.row_closed -> ++ | Reither (true, [], _, tpl, e) when not row.row_closed -> ++ set_row_field e (Rpresent None); ++ List.iter ++ (fun (t1,t2) -> unify_pat pat.pat_env {pat with pat_type=t1} t2) ++ tpl ++ | Reither (false, ty::tl, _, tpl, e) when not row.row_closed -> + set_row_field e (Rpresent (Some ty)); ++ List.iter ++ (fun (t1,t2) -> unify_pat pat.pat_env {pat with pat_type=t1} t2) ++ tpl; + begin match opat with None -> assert false + | Some pat -> List.iter (unify_pat pat.pat_env pat) (ty::tl) + end +- | Reither (c, l, true, e) when not row.row_fixed -> +- set_row_field e (Reither (c, [], false, ref None)) ++ | Reither (c, l, true, tpl, e) when not row.row_fixed -> ++ set_row_field e (Reither (c, [], false, [], ref None)) + | _ -> () + end; + (* Force check of well-formedness *) +@@ -307,13 +313,13 @@ + match row_field_repr f with + Rpresent None -> + (l,None) :: pats, +- (l, Reither(true,[], true, ref None)) :: fields ++ (l, Reither(true,[], true, [], ref None)) :: fields + | Rpresent (Some ty) -> + bound := ty :: !bound; + (l, Some {pat_desc=Tpat_any; pat_loc=Location.none; pat_env=env; + pat_type=ty}) + :: pats, +- (l, Reither(false, [ty], true, ref None)) :: fields ++ (l, Reither(false, [ty], true, [], ref None)) :: fields + | _ -> pats, fields) + ([],[]) fields in + let row = +@@ -337,6 +343,18 @@ + pat pats in + rp { r with pat_loc = loc } + ++let rec flatten_or_pat pat = ++ match pat.pat_desc with ++ Tpat_or (p1, p2, _) -> ++ flatten_or_pat p1 @ flatten_or_pat p2 ++ | _ -> ++ [pat] ++ ++let all_variants pat = ++ List.for_all ++ (function {pat_desc=Tpat_variant _} -> true | _ -> false) ++ (flatten_or_pat pat) ++ + let rec find_record_qual = function + | [] -> None + | (Longident.Ldot (modname, _), _) :: _ -> Some modname +@@ -423,7 +441,7 @@ + let arg = may_map (type_pat env) sarg in + let arg_type = match arg with None -> [] | Some arg -> [arg.pat_type] in + let row = { row_fields = +- [l, Reither(arg = None, arg_type, true, ref None)]; ++ [l, Reither(arg = None, arg_type, true, [], ref None)]; + row_bound = arg_type; + row_closed = false; + row_more = newvar (); +@@ -788,7 +806,7 @@ + newty (Tarrow(p, type_option (newvar ()), type_approx env e, Cok)) + | Pexp_function (p,_,(_,e)::_) -> + newty (Tarrow(p, newvar (), type_approx env e, Cok)) +- | Pexp_match (_, (_,e)::_) -> type_approx env e ++ | Pexp_match (_, (_,e)::_, false) -> type_approx env e + | Pexp_try (e, _) -> type_approx env e + | Pexp_tuple l -> newty (Ttuple(List.map (type_approx env) l)) + | Pexp_ifthenelse (_,e,_) -> type_approx env e +@@ -939,17 +957,26 @@ + exp_loc = sexp.pexp_loc; + exp_type = ty_res; + exp_env = env } +- | Pexp_match(sarg, caselist) -> ++ | Pexp_match(sarg, caselist, multi) -> + let arg = type_exp env sarg in + let ty_res = newvar() in + let cases, partial = +- type_cases env arg.exp_type ty_res (Some sexp.pexp_loc) caselist ++ type_cases env arg.exp_type ty_res (Some sexp.pexp_loc) caselist ~multi + in + re { + exp_desc = Texp_match(arg, cases, partial); + exp_loc = sexp.pexp_loc; + exp_type = ty_res; + exp_env = env } ++ | Pexp_multifun caselist -> ++ let ty_arg = newvar() and ty_res = newvar() in ++ let cases, partial = ++ type_cases env ty_arg ty_res (Some sexp.pexp_loc) caselist ~multi:true ++ in ++ { exp_desc = Texp_function (cases, partial); ++ exp_loc = sexp.pexp_loc; ++ exp_type = newty (Tarrow ("", ty_arg, ty_res, Cok)); ++ exp_env = env } + | Pexp_try(sbody, caselist) -> + let body = type_exp env sbody in + let cases, _ = +@@ -1758,7 +1785,7 @@ + {pexp_loc = loc; pexp_desc = + Pexp_match({pexp_loc = loc; pexp_desc = + Pexp_ident(Longident.Lident"*opt*")}, +- scases)} in ++ scases, false)} in + let sfun = + {pexp_loc = sexp.pexp_loc; pexp_desc = + Pexp_function(l, None,[{ppat_loc = loc; ppat_desc = Ppat_var"*opt*"}, +@@ -1864,7 +1891,8 @@ + + (* Typing of match cases *) + +-and type_cases ?in_function env ty_arg ty_res partial_loc caselist = ++and type_cases ?in_function ?(multi=false) ++ env ty_arg ty_res partial_loc caselist = + let ty_arg' = newvar () in + let pattern_force = ref [] in + let pat_env_list = +@@ -1898,10 +1926,64 @@ + let cases = + List.map2 + (fun (pat, ext_env) (spat, sexp) -> +- let exp = type_expect ?in_function ext_env sexp ty_res in +- (pat, exp)) +- pat_env_list caselist +- in ++ let add_variant_case lab row ty_res ty_res' = ++ let fi = List.assoc lab (row_repr row).row_fields in ++ begin match row_field_repr fi with ++ Reither (c, _, m, _, e) -> ++ let row' = ++ { row_fields = ++ [lab, Reither(c,[],false,[ty_res,ty_res'], ref None)]; ++ row_more = newvar (); row_bound = [ty_res; ty_res']; ++ row_closed = false; row_fixed = false; row_name = None } ++ in ++ unify_pat ext_env {pat with pat_type= newty (Tvariant row)} ++ (newty (Tvariant row')) ++ | _ -> ++ unify_exp ext_env ++ { exp_desc = Texp_tuple []; exp_type = ty_res; ++ exp_env = ext_env; exp_loc = sexp.pexp_loc } ++ ty_res' ++ end ++ in ++ pat, ++ match pat.pat_desc with ++ _ when multi && all_variants pat -> ++ let ty_res' = newvar () in ++ List.iter ++ (function {pat_desc=Tpat_variant(lab,_,row)} -> ++ add_variant_case lab row ty_res ty_res' ++ | _ -> assert false) ++ (flatten_or_pat pat); ++ type_expect ?in_function ext_env sexp ty_res' ++ | Tpat_alias (p, id) when multi && all_variants p -> ++ let vd = Env.find_value (Path.Pident id) ext_env in ++ let row' = ++ match repr vd.val_type with ++ {desc=Tvariant row'} -> row' ++ | _ -> assert false ++ in ++ begin_def (); ++ let tv = newvar () in ++ let env = Env.add_value id {vd with val_type=tv} ext_env in ++ let exp = type_exp env sexp in ++ end_def (); ++ generalize exp.exp_type; ++ generalize tv; ++ List.iter ++ (function {pat_desc=Tpat_variant(lab,_,row)}, [tv'; ty'] -> ++ let fi' = List.assoc lab (row_repr row').row_fields in ++ let row' = ++ {row' with row_fields=[lab,fi']; row_more=newvar()} in ++ unify_pat ext_env {pat with pat_type=tv'} ++ (newty (Tvariant row')); ++ add_variant_case lab row ty_res ty' ++ | _ -> assert false) ++ (List.map (fun p -> p, instance_list [tv; exp.exp_type]) ++ (flatten_or_pat p)); ++ {exp with exp_type = instance exp.exp_type} ++ | _ -> ++ type_expect ?in_function ext_env sexp ty_res) ++ pat_env_list caselist in + let partial = + match partial_loc with None -> Partial + | Some loc -> Parmatch.check_partial loc cases +Index: typing/typedecl.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/typedecl.ml,v +retrieving revision 1.75 +diff -u -r1.75 typedecl.ml +--- typing/typedecl.ml 16 Aug 2005 00:48:56 -0000 1.75 ++++ typing/typedecl.ml 2 Feb 2006 06:28:33 -0000 +@@ -432,8 +432,10 @@ + match Btype.row_field_repr f with + Rpresent (Some ty) -> + compute_same ty +- | Reither (_, tyl, _, _) -> +- List.iter compute_same tyl ++ | Reither (_, tyl, _, tpl, _) -> ++ List.iter compute_same tyl; ++ List.iter (compute_variance_rec true true true) ++ (List.map fst tpl @ List.map snd tpl) + | _ -> ()) + row.row_fields; + compute_same row.row_more +@@ -856,8 +858,8 @@ + explain row.row_fields + (fun (l,f) -> match Btype.row_field_repr f with + Rpresent (Some t) -> t +- | Reither (_,[t],_,_) -> t +- | Reither (_,tl,_,_) -> Btype.newgenty (Ttuple tl) ++ | Reither (_,[t],_,_,_) -> t ++ | Reither (_,tl,_,_,_) -> Btype.newgenty (Ttuple tl) + | _ -> Btype.newgenty (Ttuple[])) + "case" (fun (lab,_) -> "`" ^ lab ^ " of ") + | _ -> trivial ty' +Index: typing/types.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/types.ml,v +retrieving revision 1.25 +diff -u -r1.25 types.ml +--- typing/types.ml 9 Dec 2004 12:40:53 -0000 1.25 ++++ typing/types.ml 2 Feb 2006 06:28:33 -0000 +@@ -48,7 +48,9 @@ + + and row_field = + Rpresent of type_expr option +- | Reither of bool * type_expr list * bool * row_field option ref ++ | Reither of ++ bool * type_expr list * bool * ++ (type_expr * type_expr) list * row_field option ref + | Rabsent + + and abbrev_memo = +Index: typing/types.mli +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/types.mli,v +retrieving revision 1.25 +diff -u -r1.25 types.mli +--- typing/types.mli 9 Dec 2004 12:40:53 -0000 1.25 ++++ typing/types.mli 2 Feb 2006 06:28:33 -0000 +@@ -47,7 +47,9 @@ + + and row_field = + Rpresent of type_expr option +- | Reither of bool * type_expr list * bool * row_field option ref ++ | Reither of ++ bool * type_expr list * bool * ++ (type_expr * type_expr) list * row_field option ref + (* 1st true denotes a constant constructor *) + (* 2nd true denotes a tag in a pattern matching, and + is erased later *) +Index: typing/typetexp.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/typetexp.ml,v +retrieving revision 1.54 +diff -u -r1.54 typetexp.ml +--- typing/typetexp.ml 22 Jul 2005 06:42:36 -0000 1.54 ++++ typing/typetexp.ml 2 Feb 2006 06:28:33 -0000 +@@ -207,9 +207,9 @@ + match Btype.row_field_repr f with + | Rpresent (Some ty) -> + bound := ty :: !bound; +- Reither(false, [ty], false, ref None) ++ Reither(false, [ty], false, [], ref None) + | Rpresent None -> +- Reither (true, [], false, ref None) ++ Reither (true, [], false, [], ref None) + | _ -> f) + row.row_fields + in +@@ -273,13 +273,16 @@ + (l, f) :: fields + in + let rec add_field fields = function +- Rtag (l, c, stl) -> ++ Rtag (l, c, stl, stpl) -> + name := None; + let f = match present with + Some present when not (List.mem l present) -> +- let tl = List.map (transl_type env policy) stl in +- bound := tl @ !bound; +- Reither(c, tl, false, ref None) ++ let transl_list = List.map (transl_type env policy) in ++ let tl = transl_list stl in ++ let stpl1, stpl2 = List.split stpl in ++ let tpl1 = transl_list stpl1 and tpl2 = transl_list stpl2 in ++ bound := tl @ tpl1 @ tpl2 @ !bound; ++ Reither(c, tl, false, List.combine tpl1 tpl2, ref None) + | _ -> + if List.length stl > 1 || c && stl <> [] then + raise(Error(styp.ptyp_loc, Present_has_conjunction l)); +@@ -311,9 +314,9 @@ + begin match f with + Rpresent(Some ty) -> + bound := ty :: !bound; +- Reither(false, [ty], false, ref None) ++ Reither(false, [ty], false, [], ref None) + | Rpresent None -> +- Reither(true, [], false, ref None) ++ Reither(true, [], false, [], ref None) + | _ -> + assert false + end +@@ -406,7 +409,8 @@ + {row with row_fixed=true; + row_fields = List.map + (fun (s,f as p) -> match Btype.row_field_repr f with +- Reither (c, tl, m, r) -> s, Reither (c, tl, true, r) ++ Reither (c, tl, m, tpl, r) -> ++ s, Reither (c, tl, true, tpl, r) + | _ -> p) + row.row_fields}; + Btype.iter_row make_fixed_univars row +Index: typing/unused_var.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/unused_var.ml,v +retrieving revision 1.5 +diff -u -r1.5 unused_var.ml +--- typing/unused_var.ml 4 Jan 2006 16:55:50 -0000 1.5 ++++ typing/unused_var.ml 2 Feb 2006 06:28:33 -0000 +@@ -122,9 +122,11 @@ + | Pexp_apply (e, lel) -> + expression ppf tbl e; + List.iter (fun (_, e) -> expression ppf tbl e) lel; +- | Pexp_match (e, pel) -> ++ | Pexp_match (e, pel, _) -> + expression ppf tbl e; + match_pel ppf tbl pel; ++ | Pexp_multifun pel -> ++ match_pel ppf tbl pel; + | Pexp_try (e, pel) -> + expression ppf tbl e; + match_pel ppf tbl pel; +Index: bytecomp/matching.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/bytecomp/matching.ml,v +retrieving revision 1.67 +diff -u -r1.67 matching.ml +--- bytecomp/matching.ml 7 Sep 2005 16:07:48 -0000 1.67 ++++ bytecomp/matching.ml 2 Feb 2006 06:28:33 -0000 +@@ -1991,7 +1991,7 @@ + List.iter + (fun (_, f) -> + match Btype.row_field_repr f with +- Rabsent | Reither(true, _::_, _, _) -> () ++ Rabsent | Reither(true, _::_, _, _, _) -> () + | _ -> incr num_constr) + row.row_fields + else +Index: toplevel/genprintval.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/toplevel/genprintval.ml,v +retrieving revision 1.38 +diff -u -r1.38 genprintval.ml +--- toplevel/genprintval.ml 13 Jun 2005 04:55:53 -0000 1.38 ++++ toplevel/genprintval.ml 2 Feb 2006 06:28:33 -0000 +@@ -293,7 +293,7 @@ + | (l, f) :: fields -> + if Btype.hash_variant l = tag then + match Btype.row_field_repr f with +- | Rpresent(Some ty) | Reither(_,[ty],_,_) -> ++ | Rpresent(Some ty) | Reither(_,[ty],_,_,_) -> + let args = + tree_of_val (depth - 1) (O.field obj 1) ty in + Oval_variant (l, Some args) diff --git a/experimental/garrigue/multimatch.ml b/experimental/garrigue/multimatch.ml new file mode 100644 index 00000000..7c9aa73f --- /dev/null +++ b/experimental/garrigue/multimatch.ml @@ -0,0 +1,158 @@ +(* Simple example *) +let f x = + (multimatch x with `A -> 1 | `B -> true), + (multimatch x with `A -> 1. | `B -> "1");; + +(* OK *) +module M : sig + val f : + [< `A & 'a = int & 'b = float | `B & 'b =string & 'a = bool] -> 'a * 'b +end = struct let f = f end;; + +(* Bad *) +module M : sig + val f : + [< `A & 'a = int & 'b = float | `B & 'b =string & 'a = int] -> 'a * 'b +end = struct let f = f end;; + +(* Should be good! *) +module M : sig + val f : + [< `A & 'a = int * float | `B & 'a = bool * string] -> 'a +end = struct let f = f end;; + +let f = multifun `A|`B as x -> f x;; + +(* Two-level example *) +let f = multifun + `A -> (multifun `C -> 1 | `D -> 1.) + | `B -> (multifun `C -> true | `D -> "1");; + +(* OK *) +module M : sig + val f : + [< `A & 'b = [< `C & 'a = int | `D & 'a = float & 'c = bool] -> 'a + | `B & 'b = [< `C & 'c = bool | `D & 'c = string] -> 'c] -> 'b +end = struct let f = f end;; + +(* Bad *) +module M : sig + val f : + [< `A & 'b = [< `C & 'a = int | `D & 'a = bool] -> 'a + | `B & 'b = [< `C & 'c = bool | `D & 'c = string] -> 'c] -> 'b +end = struct let f = f end;; + +module M : sig + val f : + [< `A & 'b = [< `C & 'a = int | `D] -> 'a + | `B & 'b = [< `C & 'c = bool | `D & 'c = string] -> 'c] -> 'b +end = struct let f = f end;; + + +(* Examples with hidden sharing *) +let r = ref [] +let f = multifun `A -> 1 | `B -> true +let g x = r := [f x];; + +(* Bad! *) +module M : sig + val g : [< `A & 'a = int | `B & 'a = bool] -> unit +end = struct let g = g end;; + +let r = ref [] +let f = multifun `A -> r | `B -> ref [];; +(* Now OK *) +module M : sig + val f : [< `A & 'b = int list ref | `B & 'b = 'c list ref] -> 'b +end = struct let f = f end;; +(* Still OK *) +let l : int list ref = r;; +module M : sig + val f : [< `A & 'b = int list ref | `B & 'b = 'c list ref] -> 'b +end = struct let f = f end;; + + +(* Examples that would need unification *) +let f = multifun `A -> (1, []) | `B -> (true, []) +let g x = fst (f x);; +(* Didn't work, now Ok *) +module M : sig + val g : [< `A & 'a * 'b = int * bool | `B & 'a * 'b = bool * int] -> 'a +end = struct let g = g end;; +let g = multifun (`A|`B) as x -> g x;; + +(* Other examples *) + +let f x = + let a = multimatch x with `A -> 1 | `B -> "1" in + (multifun `A -> print_int | `B -> print_string) x a +;; + +let f = multifun (`A|`B) as x -> f x;; + +type unit_op = [`Set of int | `Move of int] +type int_op = [`Get] + +let op r = + multifun + `Get -> !r + | `Set x -> r := x + | `Move dx -> r := !r + dx +;; + +let rec trace r = function + [] -> [] + | op1 :: ops -> + multimatch op1 with + #int_op as op1 -> + let x = op r op1 in + x :: trace r ops + | #unit_op as op1 -> + op r op1; + trace r ops +;; + +class point x = object + val mutable x : int = x + method get = x + method set y = x <- y + method move dx = x <- x + dx +end;; + +let poly sort coeffs x = + let add, mul, zero = + multimatch sort with + `Int -> (+), ( * ), 0 + | `Float -> (+.), ( *. ), 0. + in + let rec compute = function + [] -> zero + | c :: cs -> add c (mul x (compute cs)) + in + compute coeffs +;; + +module M : sig + val poly : [< `Int & 'a = int | `Float & 'a = float] -> 'a list -> 'a -> 'a +end = struct let poly = poly end;; + +type ('a,'b) num_sort = + 'b constraint 'b = [< `Int & 'a = int | `Float & 'a = float] +module M : sig + val poly : ('a,_) num_sort -> 'a list -> 'a -> 'a +end = struct let poly = poly end;; + + +(* type dispatch *) + +type num = [ `Int | `Float ] +let print0 = multifun + `Int -> print_int + | `Float -> print_float +;; +let print1 = multifun + #num as x -> print0 x + | `List t -> List.iter (print0 t) + | `Pair(t1,t2) -> (fun (x,y) -> print0 t1 x; print0 t2 y) +;; +print1 (`Pair(`Int,`Float)) (1,1.0);; diff --git a/experimental/garrigue/newlabels.ps b/experimental/garrigue/newlabels.ps new file mode 100644 index 00000000..01eac194 --- /dev/null +++ b/experimental/garrigue/newlabels.ps @@ -0,0 +1,1458 @@ +%!PS-Adobe-2.0 +%%Creator: dvipsk 5.78 p1.4 Copyright 1996-98 ASCII Corp.(www-ptex@ascii.co.jp) +%%dvipsk 5.78 Copyright 1998 Radical Eye Software (www.radicaleye.com) +%%Title: newlabels.dvi +%%Pages: 2 0 +%%PageOrder: Ascend +%%BoundingBox: 0 0 596 842 +%%EndComments +%%BeginProcSet: PStoPS 1 15 +userdict begin +[/showpage/erasepage/copypage]{dup where{pop dup load + type/operatortype eq{1 array cvx dup 0 3 index cvx put + bind def}{pop}ifelse}{pop}ifelse}forall +[/letter/legal/executivepage/a4/a4small/b5/com10envelope + /monarchenvelope/c5envelope/dlenvelope/lettersmall/note + /folio/quarto/a5]{dup where{dup wcheck{exch{}put} + {pop{}def}ifelse}{pop}ifelse}forall +/setpagedevice {pop}bind 1 index where{dup wcheck{3 1 roll put} + {pop def}ifelse}{def}ifelse +/PStoPSmatrix matrix currentmatrix def +/PStoPSxform matrix def/PStoPSclip{clippath}def +/defaultmatrix{PStoPSmatrix exch PStoPSxform exch concatmatrix}bind def +/initmatrix{matrix defaultmatrix setmatrix}bind def +/initclip[{matrix currentmatrix PStoPSmatrix setmatrix + [{currentpoint}stopped{$error/newerror false put{newpath}} + {/newpath cvx 3 1 roll/moveto cvx 4 array astore cvx}ifelse] + {[/newpath cvx{/moveto cvx}{/lineto cvx} + {/curveto cvx}{/closepath cvx}pathforall]cvx exch pop} + stopped{$error/errorname get/invalidaccess eq{cleartomark + $error/newerror false put cvx exec}{stop}ifelse}if}bind aload pop + /initclip dup load dup type dup/operatortype eq{pop exch pop} + {dup/arraytype eq exch/packedarraytype eq or + {dup xcheck{exch pop aload pop}{pop cvx}ifelse} + {pop cvx}ifelse}ifelse + {newpath PStoPSclip clip newpath exec setmatrix} bind aload pop]cvx def +/initgraphics{initmatrix newpath initclip 1 setlinewidth + 0 setlinecap 0 setlinejoin []0 setdash 0 setgray + 10 setmiterlimit}bind def +end +%%EndProcSet +%DVIPSCommandLine: dvips -f newlabels +%DVIPSParameters: dpi=300 +%DVIPSSource: TeX output 1999.10.26:1616 +%%BeginProcSet: tex.pro +%! +/TeXDict 300 dict def TeXDict begin /N{def}def /B{bind def}N /S{exch}N +/X{S N}B /TR{translate}N /isls false N /vsize 11 72 mul N /hsize 8.5 72 +mul N /landplus90{false}def /@rigin{isls{[0 landplus90{1 -1}{-1 1} +ifelse 0 0 0]concat}if 72 Resolution div 72 VResolution div neg scale +isls{landplus90{VResolution 72 div vsize mul 0 exch}{Resolution -72 div +hsize mul 0}ifelse TR}if Resolution VResolution vsize -72 div 1 add mul +TR[matrix currentmatrix{dup dup round sub abs 0.00001 lt{round}if} +forall round exch round exch]setmatrix}N /@landscape{/isls true N}B +/@manualfeed{statusdict /manualfeed true put}B /@copies{/#copies X}B +/FMat[1 0 0 -1 0 0]N /FBB[0 0 0 0]N /nn 0 N /IE 0 N /ctr 0 N /df-tail{ +/nn 8 dict N nn begin /FontType 3 N /FontMatrix fntrx N /FontBBox FBB N +string /base X array /BitMaps X /BuildChar{CharBuilder}N /Encoding IE N +end dup{/foo setfont}2 array copy cvx N load 0 nn put /ctr 0 N[}B /df{ +/sf 1 N /fntrx FMat N df-tail}B /dfs{div /sf X /fntrx[sf 0 0 sf neg 0 0] +N df-tail}B /E{pop nn dup definefont setfont}B /ch-width{ch-data dup +length 5 sub get}B /ch-height{ch-data dup length 4 sub get}B /ch-xoff{ +128 ch-data dup length 3 sub get sub}B /ch-yoff{ch-data dup length 2 sub +get 127 sub}B /ch-dx{ch-data dup length 1 sub get}B /ch-image{ch-data +dup type /stringtype ne{ctr get /ctr ctr 1 add N}if}B /id 0 N /rw 0 N +/rc 0 N /gp 0 N /cp 0 N /G 0 N /sf 0 N /CharBuilder{save 3 1 roll S dup +/base get 2 index get S /BitMaps get S get /ch-data X pop /ctr 0 N ch-dx +0 ch-xoff ch-yoff ch-height sub ch-xoff ch-width add ch-yoff +setcachedevice ch-width ch-height true[1 0 0 -1 -.1 ch-xoff sub ch-yoff +.1 sub]{ch-image}imagemask restore}B /D{/cc X dup type /stringtype ne{]} +if nn /base get cc ctr put nn /BitMaps get S ctr S sf 1 ne{dup dup +length 1 sub dup 2 index S get sf div put}if put /ctr ctr 1 add N}B /I{ +cc 1 add D}B /bop{userdict /bop-hook known{bop-hook}if /SI save N @rigin +0 0 moveto /V matrix currentmatrix dup 1 get dup mul exch 0 get dup mul +add .99 lt{/QV}{/RV}ifelse load def pop pop}N /eop{SI restore userdict +/eop-hook known{eop-hook}if showpage}N /@start{userdict /start-hook +known{start-hook}if pop /VResolution X /Resolution X 1000 div /DVImag X +/IE 256 array N 2 string 0 1 255{IE S dup 360 add 36 4 index cvrs cvn +put}for pop 65781.76 div /vsize X 65781.76 div /hsize X}N /p{show}N +/RMat[1 0 0 -1 0 0]N /BDot 260 string N /rulex 0 N /ruley 0 N /v{/ruley +X /rulex X V}B /V{}B /RV statusdict begin /product where{pop false[ +(Display)(NeXT)(LaserWriter 16/600)]{dup length product length le{dup +length product exch 0 exch getinterval eq{pop true exit}if}{pop}ifelse} +forall}{false}ifelse end{{gsave TR -.1 .1 TR 1 1 scale rulex ruley false +RMat{BDot}imagemask grestore}}{{gsave TR -.1 .1 TR rulex ruley scale 1 1 +false RMat{BDot}imagemask grestore}}ifelse B /QV{gsave newpath transform +round exch round exch itransform moveto rulex 0 rlineto 0 ruley neg +rlineto rulex neg 0 rlineto fill grestore}B /a{moveto}B /delta 0 N /tail +{dup /delta X 0 rmoveto}B /M{S p delta add tail}B /b{S p tail}B /c{-4 M} +B /d{-3 M}B /e{-2 M}B /f{-1 M}B /g{0 M}B /h{1 M}B /i{2 M}B /j{3 M}B /k{ +4 M}B /w{0 rmoveto}B /l{p -4 w}B /m{p -3 w}B /n{p -2 w}B /o{p -1 w}B /q{ +p 1 w}B /r{p 2 w}B /s{p 3 w}B /t{p 4 w}B /x{0 S rmoveto}B /y{3 2 roll p +a}B /bos{/SS save N}B /eos{SS restore}B end + +%%EndProcSet +TeXDict begin 39158280 55380996 1000 300 300 (newlabels.dvi) +@start +%DVIPSBitmapFont: Fa cmr6 6 2 +/Fa 2 51 df<187898181818181818181818181818FF08107D8F0F> 49 +D<1F00618040C08060C0600060006000C00180030006000C00102020207FC0FFC00B107F +8F0F> I E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fb cmmi8 8 4 +/Fb 4 111 df 85 D<0300038003000000000000000000000000001C00240046 +0046008C000C0018001800180031003100320032001C0009177F960C> 105 +D<383C1E0044C6630047028100460301008E0703000C0603000C0603000C060300180C06 +00180C0620180C0C20180C0C40301804C0301807001B0E7F8D1F> 109 +D<383C0044C6004702004602008E06000C06000C06000C0600180C00180C401818401818 +80300980300E00120E7F8D15> I E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fc cmbx8 8 4 +/Fc 4 111 df<01800780FF80FF80078007800780078007800780078007800780078007 +800780078007800780FFF8FFF80D157D9414> 49 D<387C7C7C3800000000FCFC3C3C3C +3C3C3C3C3C3C3C3CFFFF08187F970B> 105 D 109 D I +E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fd cmsy8 8 3 +/Fd 3 93 df 0 D<020002000200C218F2783AE00F800F80 +3AE0F278C2180200020002000D0E7E8E12> 3 D<03F8001FFF003C07806000C0C00060C0 +0060C00060C00060C00060C00060C00060C00060C00060C00060C00060C00060C00060C0 +006040002013137E9218> 92 D E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fe cmtt12 12 43 +/Fe 43 125 df<01818003C3C003C3C003C3C003C3C003C3C003C3C07FFFF0FFFFF8FFFF +F87FFFF00787800787800787800F8F800F0F000F0F000F0F000F0F007FFFF0FFFFF8FFFF +F87FFFF01E1E001E1E001E1E001E1E001E1E001E1E000C0C00151E7E9D1A> 35 +D<00E00003F00007F8000738000E1C000E1C000E1C000E1C000E38000E39FC0E71FC07F1 +FC07E1C007C1C00781C00783800F83801FC3803DC70078E70070EE00E07E00E07E00E03C +08E03C1CE07E1C70FF1C7FE7F83FC3F80F00E0161E7F9D1A> 38 +D<0038007800F001E003C007800F000E001C001C0038003800700070007000E000E000E0 +00E000E000E000E000E000E000E000700070007000380038001C001C000E000F00078003 +C001E000F8007800380D2878A21A> 40 D<6000F00078003C001E000F000780038001C0 +01C000E000E0007000700070003800380038003800380038003800380038003800700070 +007000E000E001C001C0038007800F001E003C007800F00060000D287CA21A> I<7FFFC0 +FFFFE0FFFFE07FFFC013047D901A> 45 D<00C001C001C003C007C00FC07FC0FDC071C0 +01C001C001C001C001C001C001C001C001C001C001C001C001C001C001C001C001C001C0 +7FFF7FFF7FFF101E7B9D1A> 49 D<03F8000FFE001FFF803C07C07801E07000E0E00070 +F00070F000706000700000700000700000E00000E00001C00003C0000780000F00001E00 +003C0000780000F00003E00007C0000F00001E00703C00707FFFF0FFFFF07FFFF0141E7D +9D1A> I<03FC000FFF003FFFC03C03E07800E07800707800700000700000700000E00001 +E00007C003FF8003FF0003FFC00003E00000E0000070000078000038000038600038F000 +38F00078E000707000E07E03E03FFFC00FFF0001FC00151E7E9D1A> I<01FC0007FF001F +FFC01F07C03C01E07800F07000707000707000707800F03800E01E03C00FFF8003FE0007 +FF001F8FC03C01E07800F0700070E00038E00038E00038E00038F000787000707800F03E +03E01FFFC007FF0001FC00151E7E9D1A> 56 D<01F00007FC001FFE003E0F0038078070 +03807001C0E001C0E001C0E001E0E000E0E000E0E001E07001E07803E03C0FE01FFFE00F +FCE003F0E00001C00001C00001C0000380600380F00700F00F00F03E007FFC003FF0000F +C000131E7D9D1A> I<3078FCFC78300000000000000000003078FCFC7830061576941A> +I<183C7E7E3C18000000000000000000183C7E7E3E1E0E0E1C3CF8F060071C77941A> I< +0000C00003E00007E0000FC0003F80007E0000FC0003F80007E0000FC0003F80007E0000 +FC0000FC00007E00003F80000FC00007E00003F80000FC00007E00003F80000FC00007E0 +0003E00000C0131A7D9B1A> I<7FFFF0FFFFF8FFFFF87FFFF00000000000000000000000 +007FFFF0FFFFF8FFFFF87FFFF0150C7E941A> I<600000F80000FC00007E00003F80000F +C00007E00003F80000FC00007E00003F80000FC00007E00007E0000FC0003F80007E0000 +FC0003F80007E0000FC0003F80007E0000FC0000F80000600000131A7D9B1A> I<007C38 +01FF3807FFF80F83F81E00F81C0078380078380038700038700038700000E00000E00000 +E00000E00000E00000E00000E00000E000007000007000387000383800383800381C0070 +1E00F00F83E007FFC001FF80007C00151E7E9D1A> 67 D 78 D<03F8E00FFEE01FFFE03C07E07801E0F001E0E000E0 +E000E0E000E0E000007000007800003F80001FF80007FF00007FC00007E00000F0000070 +000038000038600038E00038E00038E00070F000F0FE01E0FFFFC0EFFF80E1FE00151E7E +9D1A> 83 D<7FFFFEFFFFFEFFFFFEE0380EE0380EE0380EE0380E003800003800003800 +003800003800003800003800003800003800003800003800003800003800003800003800 +00380000380000380000380000380003FF8003FF8003FF80171E7F9D1A> I 91 D 93 D<1FF0003FFC007FFE00780F +00300700000380000380007F8007FF801FFF803F8380780380700380E00380E00380E003 +80700780780F803FFFFC1FFDFC07F0FC16157D941A> 97 D<7E0000FE00007E00000E00 +000E00000E00000E00000E00000E00000E3E000EFF800FFFE00FC1F00F80700F00380E00 +380E001C0E001C0E001C0E001C0E001C0E001C0E001C0F00380F00780F80F00FC1E00FFF +C00EFF80063E00161E7F9D1A> I<00FF8003FFC00FFFE01F01E03C00C078000070000070 +0000E00000E00000E00000E00000E000007000007000007800703C00701F01F00FFFE003 +FFC000FE0014157D941A> I<000FC0001FC0000FC00001C00001C00001C00001C00001C0 +0001C001F1C007FDC00FFFC01E0FC03C07C07803C07001C0E001C0E001C0E001C0E001C0 +E001C0E001C0E001C07003C07003C03807C03E0FC01FFFF807FDFC01F1F8161E7E9D1A> +I<01F80007FF000FFF801E07C03C01C07800E07000E0E00070E00070FFFFF0FFFFF0FFFF +F0E000007000007000007800703C00701F01F00FFFE003FF8000FE0014157D941A> I<00 +07E0001FF0003FF800787800F03000E00000E00000E00000E0007FFFF0FFFFF0FFFFF000 +E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000 +E00000E00000E0003FFF807FFFC03FFF80151E7F9D1A> I<7E0000FE00007E00000E0000 +0E00000E00000E00000E00000E00000E3E000EFF800FFFC00FC1C00F80E00F00E00E00E0 +0E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E07FC3FC +FFE7FE7FC3FC171E7F9D1A> 104 D<00C00001E00001E00000C000000000000000000000 +0000000000000000007FE0007FE0007FE00000E00000E00000E00000E00000E00000E000 +00E00000E00000E00000E00000E00000E00000E00000E00000E0007FFF80FFFFC07FFF80 +121F7C9E1A> I<7FE000FFE0007FE00000E00000E00000E00000E00000E00000E00000E0 +0000E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000E0 +0000E00000E00000E00000E00000E0007FFFC0FFFFE07FFFC0131E7D9D1A> 108 +D<7CE0E000FFFBF8007FFFF8001F1F1C001E1E1C001E1E1C001C1C1C001C1C1C001C1C1C +001C1C1C001C1C1C001C1C1C001C1C1C001C1C1C001C1C1C001C1C1C001C1C1C001C1C1C +007F1F1F00FFBFBF807F1F1F00191580941A> I<7E3E00FEFF807FFFC00FC1C00F80E00F +00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E +00E07FC3FCFFE7FE7FC3FC17157F941A> I<01F00007FC001FFF003E0F803C07807803C0 +7001C0E000E0E000E0E000E0E000E0E000E0E000E0F001E07001C07803C03C07803E0F80 +1FFF0007FC0001F00013157D941A> I<7E3E00FEFF807FFFE00FC1F00F80700F00380E00 +380E001C0E001C0E001C0E001C0E001C0E001C0E001C0F00380F00780F80F00FC1E00FFF +C00EFF800E3E000E00000E00000E00000E00000E00000E00000E00000E00007FC000FFE0 +007FC00016207F941A> I<7F81F8FF8FFC7F9FFE03FE1E03F80C03E00003E00003C00003 +80000380000380000380000380000380000380000380000380000380007FFF00FFFF007F +FF0017157F941A> 114 D<07FB801FFF807FFF80780780E00380E00380E003807800007F +C0001FFC0007FE00003F800007806001C0E001C0E001C0F003C0FC0780FFFF00EFFE00E3 +F80012157C941A> I<0180000380000380000380000380000380000380007FFFE0FFFFE0 +FFFFE0038000038000038000038000038000038000038000038000038000038000038070 +03807003807003807001C1E001FFE000FF80003F00141C7F9B1A> I<7E07E0FE0FE07E07 +E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00 +E00E00E00E01E00F03E007FFFC03FFFE00FCFC17157F941A> I<7F83FCFFC7FE7F83FC0E +00E00E00E00E00E00701C00701C00701C003838003838003838001C70001C70001C70000 +EE0000EE0000EE00007C00007C0000380017157F941A> I I<7FC7F87FCFFC7FC7F80703C00383 +8003C70001EF0000FE00007C00007800003800007C0000EE0001EE0001C7000383800783 +C00F01C07FC7FCFFC7FE7FC7FC17157F941A> I<7F83FCFFC7FE7F83FC0E00E00E00E007 +00E00701C00701C00381C003838003C38001C38001C70000E70000E70000E60000660000 +6E00003C00003C00003C0000380000380000380000700000700030F00078E00071E0007F +C0003F80001E000017207F941A> I<60F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0 +F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F060042775A21A> 124 D +E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Ff cmr8 8 3 +/Ff 3 51 df<003000003000003000003000003000003000003000003000003000003000 +003000FFFFFCFFFFFC003000003000003000003000003000003000003000003000003000 +00300000300016187E931B> 43 D<06000E00FE000E000E000E000E000E000E000E000E +000E000E000E000E000E000E000E000E000E00FFE00B157D9412> 49 +D<0F8030E040708030C038E0384038003800700070006000C00180030006000C08080810 +183FF07FF0FFF00D157E9412> I E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fg cmmi12 12 13 +/Fg 13 121 df<0FFFF81FFFFC3FFFF870200040200080200080600000600000600000C0 +0000C00000C00000C00001C0000180000180000380000380000380000700000300001615 +7E9415> 28 D<0000100000002000000020000000200000002000000040000000400000 +004000000040000000800000008000000080000000800000010000000FE00000711C0001 +C10600030203000E0203801C020180180201C0380401C0700401C0700401C0700401C0E0 +080380E0080380E00807006008070070100E0030101C00301038001C10E0000623800001 +FE0000002000000020000000400000004000000040000000400000008000000080000000 +800000008000001A2D7EA21D> 30 D<70F8F8F87005057C840E> 58 +D<70F8FCFC7404040404080810102040060F7C840E> I<00008000018000018000030000 +0300000300000600000600000600000C00000C00000C0000180000180000180000300000 +300000300000600000600000600000C00000C00000C00001800001800001800001800003 +00000300000300000600000600000600000C00000C00000C000018000018000018000030 +0000300000300000600000600000600000C00000C00000C0000011317DA418> 61 +D<00FFFC00000F8000000F0000000F0000001E0000001E0000001E0000001E0000003C00 +00003C0000003C0000003C00000078000000780000007800000078000000F0000000F000 +0000F0000000F0000001E0000001E0000001E0002001E0002003C0004003C0004003C000 +8003C0008007800180078001000780030007800F000F803E00FFFFFE001B227DA121> 76 +D<1FFFFFFE1E01E00E1801E0063001E0062003C0062003C0064003C0044003C004400780 +04800780048007800400078000000F0000000F0000000F0000000F0000001E0000001E00 +00001E0000001E0000003C0000003C0000003C0000003C00000078000000780000007800 +000078000000F0000000F0000000F0000000F0000001F000007FFFC0001F227EA11D> 84 +D<3FFE01FF8003C0003C0003C000300003C0001000078000200007800020000780002000 +07800020000F000040000F000040000F000040000F000040001E000080001E000080001E +000080001E000080003C000100003C000100003C000100003C0001000078000200007800 +020000780002000078000200007000040000F000040000F0000800007000080000700010 +00007000200000380040000038008000001C01000000060600000001F800000021237DA1 +21> I<007E000381000700800E00801C0080380080780100700600FFF800F00000F00000 +E00000E00000E00000E00000E00080E000807003003004001838000FC00011157D9417> +101 D<01E00FC001C001C001C0038003800380038007000700070007000E000E000E000E +001C001C001C001C0038003800380038007000700070007080E100E100E100620062003C +000B237EA20F> 108 D<03C0F004631C04740E08780E08700708700708700F00E00F00E0 +0F00E00F00E00F01C01E01C01E01C01E01C03C03803803803803C07003C0E0072180071E +000700000700000E00000E00000E00000E00001C00001C00001C0000FF8000181F819418 +> 112 D<3C0F004630C04741C08783C08783C08701808700000E00000E00000E00000E00 +001C00001C00001C00001C000038000038000038000038000070000030000012157E9416 +> 114 D<01E0F006310C081A1C101A3C201C3C201C18201C000038000038000038000038 +0000700000700000700000700860E010F0E010F0E020E170404230803C1F0016157E941C +> 120 D E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fh cmti12 12 22 +/Fh 22 122 df 45 D<70F8F8F0E005057A840F> I<00F8 +C00185C00705C00E03800E03801C03803C0380380700780700780700780700F00E00F00E +00F00E00F00E10F01C20701C20703C20305C40308C400F078014157B9419> 97 +D<03C01F8003800380038007000700070007000E000E000E000E001C001CF81D0C1E0E3C +0638073807380F700F700F700F700FE01EE01EE01EE03CE038E038607060E031C01F0010 +237BA216> I<007E0001C1000301800703800E07801C07803C0000380000780000780000 +780000F00000F00000F00000F00000F00100700100700200300C001830000FC00011157B +9416> I<00003C0003F80000380000380000380000700000700000700000700000E00000 +E00000E00000E00001C000F9C00185C00705C00E03800E03801C03803C03803807007807 +00780700780700F00E00F00E00F00E00F00E10F01C20701C20703C20305C40308C400F07 +8016237BA219> I<00F803840E021C023C0238027804F018FFE0F000F000E000E000E000 +E000E002E0026004701830600F800F157A9416> I<00003E0000470000CF00018F000186 +000380000380000380000700000700000700000700000700000E0000FFF0000E00000E00 +000E00001C00001C00001C00001C00001C00003800003800003800003800003800007000 +00700000700000700000700000E00000E00000E00000E00000C00001C00001C000718000 +F18000F300006200003C0000182D82A20F> I<001F180030B800E0B801C07001C0700380 +700780700700E00F00E00F00E00F00E01E01C01E01C01E01C01E01C01E03800E03800E07 +80060B8006170001E700000700000700000E00000E00000E00701C00F01800F0300060E0 +003F8000151F7E9416> I<00C001E001C001C0000000000000000000000000000000001E +002300430043008700870087000E000E001C001C001C0038003800384070807080708071 +0032001C000B217BA00F> 105 D<00F00007E00000E00000E00000E00001C00001C00001 +C00001C0000380000380000380000380000700000701E00702100704700E08F00E10F00E +20600E40001D80001E00001FC0001C7000383800383800381C00381C2070384070384070 +3840701880E01880600F0014237DA216> 107 D<01E00FC001C001C001C0038003800380 +038007000700070007000E000E000E000E001C001C001C001C0038003800380038007000 +700070007100E200E200E200E200640038000B237CA20C> I<1C0F80F8002610C10C0047 +6066060087807807008780780700870070070087007007000E00E00E000E00E00E000E00 +E00E000E00E00E001C01C01C001C01C01C001C01C01C001C01C038203803803840380380 +70403803807080380380308070070031003003001E0023157B9428> I<380F804C30C04E +40608E80708F00708E00708E00701C00E01C00E01C00E01C00E03801C03801C03801C038 +0384700388700308700708700310E003106001E016157B941B> I<007E0001C300038180 +0701C00E01C01C01E03C01E03801E07801E07801E07801E0F003C0F003C0F00380F00780 +700700700E00700C0030180018700007C00013157B9419> I<01C1F002621804741C0878 +0C08700E08700E08701E00E01E00E01E00E01E00E01E01C03C01C03C01C03C01C0780380 +7003807003C0E003C1C0072380071E000700000700000E00000E00000E00000E00001C00 +001C00001C0000FFC000171F7F9419> I<1C1F002620804741C08783C08703C087018087 +00000E00000E00000E00000E00001C00001C00001C00001C000038000038000038000038 +000070000030000012157B9415> 114 D<00FC000183000200800401800C03800C03000C +00000F00000FF00007FC0003FE00003E00000F00000700700700F00600F00600E0040040 +08002030001FC00011157D9414> I<00C001C001C001C001C003800380038003800700FF +F8070007000E000E000E000E001C001C001C001C00380038003800381070207020704070 +8031001E000D1F7C9E10> I<1E0060E02300E0F04380E1F04381C0F08381C0708701C030 +8701C030070380200E0380200E0380200E0380201C0700401C0700401C0700401C070080 +1C0700801C0701001C0F01000C0B02000613840003E0F8001C157B9420> 119 +D<03C1E0046210083470103CF02038F020386020380000700000700000700000700000E0 +0000E00000E00000E02061C040F1C040F1C080E2C100446200383C0014157D9416> I<1E +00302300704380704380E08380E08700E08700E00701C00E01C00E01C00E01C01C03801C +03801C03801C03801C07001C07001C07001C0F000C3E0003CE00000E00000E00001C0060 +1C00F03800F03000E0600080C0004380003E0000141F7B9418> I +E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fi cmbx12 12 20 +/Fi 20 122 df 68 D<01FE0207FF861F01FE3C007E7C001E78000E78000EF80006F80006FC0006 +FC0000FF0000FFE0007FFF007FFFC03FFFF01FFFF80FFFFC03FFFE003FFE0003FE00007F +00003F00003FC0001FC0001FC0001FE0001EE0001EF0003CFC003CFF00F8C7FFE080FF80 +18227DA11F> 83 D<7FFFFFFF807FFFFFFF807E03F80F807803F807807003F803806003 +F80180E003F801C0E003F801C0C003F800C0C003F800C0C003F800C0C003F800C00003F8 +00000003F800000003F800000003F800000003F800000003F800000003F800000003F800 +000003F800000003F800000003F800000003F800000003F800000003F800000003F80000 +0003F800000003F800000003F800000003F800000003F8000001FFFFF00001FFFFF00022 +227EA127> I<0FFC003FFF807E07C07E03E07E01E07E01F03C01F00001F00001F0003FF0 +03FDF01FC1F03F01F07E01F0FC01F0FC01F0FC01F0FC01F07E02F07E0CF81FF87F07E03F +18167E951B> 97 D I<00FF8007FFE00F83F01F03F03E03F07E03F07C01E07C0000 +FC0000FC0000FC0000FC0000FC0000FC00007C00007E00007E00003E00181F00300FC060 +07FFC000FF0015167E9519> I<00FE0007FF800F87C01E01E03E01F07C00F07C00F8FC00 +F8FC00F8FFFFF8FFFFF8FC0000FC0000FC00007C00007C00007E00003E00181F00300FC0 +7003FFC000FF0015167E951A> 101 D<001FC0007FE000F1F001E3F003E3F007C3F007C1 +E007C00007C00007C00007C00007C00007C000FFFE00FFFE0007C00007C00007C00007C0 +0007C00007C00007C00007C00007C00007C00007C00007C00007C00007C00007C00007C0 +0007C00007C0003FFC003FFC00142380A211> I<01FE0F0007FFBF800F87C7801F03E780 +1E01E0003E01F0003E01F0003E01F0003E01F0003E01F0001E01E0001F03E0000F87C000 +0FFF800009FE000018000000180000001C0000001FFFE0000FFFF80007FFFE001FFFFF00 +3C003F0078000F80F0000780F0000780F0000780F000078078000F003C001E001F007C00 +0FFFF80001FFC00019217F951C> I<1C003E007F007F007F003E001C0000000000000000 +00000000000000FF00FF001F001F001F001F001F001F001F001F001F001F001F001F001F +001F001F001F001F001F00FFE0FFE00B247EA310> 105 D 108 +D I I<00FE0007FFC00F83E01E00F03E00F87C00 +7C7C007C7C007CFC007EFC007EFC007EFC007EFC007EFC007EFC007E7C007C7C007C3E00 +F81F01F00F83E007FFC000FE0017167E951C> I I<0FF3003FFF00781F00600700E00300E00300F00300FC00007F +E0007FF8003FFE000FFF0001FF00000F80C00780C00380E00380E00380F00700FC0E00EF +FC00C7F00011167E9516> 115 D<01800001800001800001800003800003800007800007 +80000F80003F8000FFFF00FFFF000F80000F80000F80000F80000F80000F80000F80000F +80000F80000F80000F80000F81800F81800F81800F81800F81800F830007C30003FE0000 +F80011207F9F16> I I 120 D I E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fj cmsy10 12 15 +/Fj 15 107 df 0 D<03F0000FFC001FFE003FFF007F +FF807FFF80FFFFC0FFFFC0FFFFC0FFFFC0FFFFC0FFFFC0FFFFC0FFFFC07FFF807FFF803F +FF001FFE000FFC0003F00012147D9519> 15 D<000FFFFC007FFFFC01F0000003800000 +060000000C0000001800000030000000300000006000000060000000C0000000C0000000 +C0000000C0000000C0000000C0000000C0000000C0000000600000006000000030000000 +30000000180000000C000000060000000380000001E00000007FFFFC001FFFFC1E1E7C9A +27> 26 D<00000001800000000001800000000001800000000001800000000000C00000 +000000C000000000006000000000003000000000003000000000001C00000000000E0000 +0000000700FFFFFFFFFFE0FFFFFFFFFFE0000000000700000000000E00000000001C0000 +000000300000000000300000000000600000000000C00000000000C00000000001800000 +00000180000000000180000000000180002B1A7D9832> 33 D<001FFF007FFF01E00003 +80000600000C0000180000300000300000600000600000600000C00000C00000FFFFFFFF +FFFFC00000C000006000006000006000003000003000001800000C000006000003800001 +E000007FFF001FFF181E7C9A21> 50 D<00000300000300000600000600000C00000C00 +00180000180000300000300000600000600000C00000C00000C000018000018000030000 +0300000600000600000C00000C0000180000180000300000300000600000600000C00000 +C0000180000180000300000300000300000600000600000C00000C000018000018000030 +0000300000600000600000C00000400000183079A300> 54 D I<00008000018001F980070F000C0300180380180780 +3006C03006C0700CE0600C60600C60600C60E01870E01870E01870E03070E03070E03070 +E06070E06070E06070E06070E0C070E0C070E0C070E18070E180706180606300607300E0 +7300E03300C03600C01E01801E01800C03000F0E000DF800180000180000180000142A7E +A519> 59 D<000100000003000000030000000300000003000000030000000300000003 +000000030000000300000003000000030000000300000003000000030000000300000003 +000000030000000300000003000000030000000300000003000000030000000300000003 +000000030000000300000003000000030000FFFFFFFEFFFFFFFE1F207C9F27> 63 +D<40000040C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000 +C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000 +C0C00000C0C00000C0C00000C0C00000C0C00000C0600001806000018030000300180006 +000E001C000780780001FFE000007F80001A1F7D9D21> 91 D<007F800001FFE0000780 +78000E001C0018000600300003006000018060000180C00000C0C00000C0C00000C0C000 +00C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C000 +00C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C000 +00C0400000401A1F7D9D21> I<000C0000000C0000001E0000001E0000001E0000003300 +0000330000006180000061800000C0C00000C0C00000C0C0000180600001806000030030 +00030030000300300006001800060018000C000C000C000C000C000C0018000600180006 +003000030030000300600001806000018060000180C00000C0C00000401A1F7D9D21> 94 +D<0003C0001E0000380000700000E00000E00000E00000E00000E00000E00000E00000E0 +0000E00000E00000E00000E00000E00000E00000E00000E00000E00001C0000380000F00 +00F800000F000003800001C00000E00000E00000E00000E00000E00000E00000E00000E0 +0000E00000E00000E00000E00000E00000E00000E00000E00000E000007000003800001E +000003C012317DA419> 102 D I 106 D E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fk cmr12 12 65 +/Fk 65 125 df<001FC1F00070371800C03E3C01807C3C0380783C070038000700380007 +003800070038000700380007003800070038000700380007003800FFFFFFC00700380007 +003800070038000700380007003800070038000700380007003800070038000700380007 +0038000700380007003800070038000700380007003800070038000700380007003C007F +E1FFC01E2380A21C> 11 D<001FC0000070200000C01000018038000380780007007800 +0700300007000000070000000700000007000000070000000700000007000000FFFFF800 +070078000700380007003800070038000700380007003800070038000700380007003800 +070038000700380007003800070038000700380007003800070038000700380007003800 +070038007FE1FF80192380A21B> I<001FD8000070380000C07800018078000380780007 +0038000700380007003800070038000700380007003800070038000700380007003800FF +FFF800070038000700380007003800070038000700380007003800070038000700380007 +003800070038000700380007003800070038000700380007003800070038000700380007 +003800070038007FF3FF80192380A21B> I<000FC07F00007031C08000E00B004001801E +00E003803E01E007003C01E007001C00C007001C000007001C000007001C000007001C00 +0007001C000007001C000007001C0000FFFFFFFFE007001C01E007001C00E007001C00E0 +07001C00E007001C00E007001C00E007001C00E007001C00E007001C00E007001C00E007 +001C00E007001C00E007001C00E007001C00E007001C00E007001C00E007001C00E00700 +1C00E007001C00E07FF1FFCFFE272380A229> I<70F8FCFC740404040408081010204006 +0F7CA20E> 39 D<00200040008001000300060004000C000C0018001800300030003000 +7000600060006000E000E000E000E000E000E000E000E000E000E000E000E000E000E000 +6000600060007000300030003000180018000C000C000400060003000100008000400020 +0B327CA413> I<800040002000100018000C000400060006000300030001800180018001 +C000C000C000C000E000E000E000E000E000E000E000E000E000E000E000E000E000E000 +C000C000C001C0018001800180030003000600060004000C00180010002000400080000B +327DA413> I<70F8FCFC7404040404080810102040060F7C840E> 44 +D I<70F8F8F87005057C840E> I<01F000071C000C0600180300 +3803803803807001C07001C07001C07001C0F001E0F001E0F001E0F001E0F001E0F001E0 +F001E0F001E0F001E0F001E0F001E0F001E0F001E0F001E07001C07001C07001C07803C0 +3803803803801C07000C0600071C0001F00013227EA018> 48 D<008003800F80F38003 +800380038003800380038003800380038003800380038003800380038003800380038003 +800380038003800380038003800380038007C0FFFE0F217CA018> I<03F0000C1C001007 +002007804003C04003C08003E0F003E0F801E0F801E0F801E02003E00003E00003C00003 +C0000780000700000E00001C0000180000300000600000C0000180000100000200200400 +200800201800603000403FFFC07FFFC0FFFFC013217EA018> I<03F8000C1E00100F0020 +07804007C07807C07803C07807C03807C0000780000780000700000F00000C0000380003 +F000001C00000F000007800007800003C00003C00003E02003E07003E0F803E0F803E0F0 +03C04003C0400780200780100F000C1C0003F00013227EA018> I<000300000300000700 +000700000F00001700001700002700006700004700008700018700010700020700060700 +040700080700080700100700200700200700400700C00700FFFFF8000700000700000700 +000700000700000700000700000F80007FF015217FA018> I<70F8F8F870000000000000 +000000000070F8F8F87005157C940E> 58 D 61 D<07E01838201C400E800FF00FF00FF00F000F000E001C00380030006000C000C0 +00800080018001000100010001000100010000000000000000000000038007C007C007C0 +038010237DA217> 63 D<0001800000018000000180000003C0000003C0000003C00000 +05E0000005E0000009F0000008F0000008F00000107800001078000010780000203C0000 +203C0000203C0000401E0000401E0000C01F0000800F0000800F0001FFFF800100078001 +000780020003C0020003C0020003C0040001E0040001E0040001E0080000F01C0000F03E +0001F8FF800FFF20237EA225> 65 D I<0007E0100038183000E0063001C00170038000F007 +0000F00E0000701E0000701C0000303C0000303C0000307C0000107800001078000010F8 +000000F8000000F8000000F8000000F8000000F8000000F8000000F80000007800000078 +0000107C0000103C0000103C0000101C0000201E0000200E000040070000400380008001 +C0010000E0020000381C000007E0001C247DA223> I I 70 D<0007F008003C0C1800E0021801C0 +01B8038000F8070000780F0000381E0000381E0000183C0000183C0000187C0000087800 +000878000008F8000000F8000000F8000000F8000000F8000000F8000000F8000000F800 +1FFF780000F8780000787C0000783C0000783C0000781E0000781E0000780F0000780700 +0078038000B801C000B800E00318003C0C080007F00020247DA226> I I I 75 +D I +78 D<000FE00000783C0000E00E0003C00780078003C00F0001E00E0000E01E0000F03C +0000783C0000787C00007C7C00007C7800003C7800003CF800003EF800003EF800003EF8 +00003EF800003EF800003EF800003EF800003EF800003E7800003C7C00007C7C00007C3C +0000783E0000F81E0000F00F0001E00F0001E0078003C003C0078000E00E0000783C0000 +0FE0001F247DA226> I I 82 D<03F0200C0C601802603001E07000E0600060E00060E000 +60E00020E00020E00020F00000F000007800007F00003FF0001FFE000FFF0003FF80003F +C00007E00001E00000F00000F0000070800070800070800070800070C00060C00060E000 +C0F000C0C80180C6070081FC0014247DA21B> I<7FFFFFF8780780786007801840078008 +4007800840078008C007800C800780048007800480078004800780040007800000078000 +000780000007800000078000000780000007800000078000000780000007800000078000 +000780000007800000078000000780000007800000078000000780000007800000078000 +00078000000FC00001FFFE001E227EA123> I 86 D I 91 D 93 +D<1FE000303800780C00780E0030070000070000070000070000FF0007C7001E07003C07 +00780700700700F00708F00708F00708F00F087817083C23900FC1E015157E9418> 97 +D<0E0000FE00001E00000E00000E00000E00000E00000E00000E00000E00000E00000E00 +000E00000E00000E1F000E61C00E80600F00300E00380E003C0E001C0E001E0E001E0E00 +1E0E001E0E001E0E001E0E001E0E001C0E003C0E00380F00700C80600C41C0083F001723 +7FA21B> I<01FE000703000C07801C0780380300780000700000F00000F00000F00000F0 +0000F00000F00000F000007000007800403800401C00800C010007060001F80012157E94 +16> I<0000E0000FE00001E00000E00000E00000E00000E00000E00000E00000E00000E0 +0000E00000E00000E001F8E00704E00C02E01C01E03800E07800E07000E0F000E0F000E0 +F000E0F000E0F000E0F000E0F000E07000E07800E03800E01801E00C02E0070CF001F0FE +17237EA21B> I<01FC000707000C03801C01C03801C07801E07000E0F000E0FFFFE0F000 +00F00000F00000F00000F000007000007800203800201C00400E008007030000FC001315 +7F9416> I<003E0000E30001C78003878003078007000007000007000007000007000007 +0000070000070000070000FFF80007000007000007000007000007000007000007000007 +00000700000700000700000700000700000700000700000700000700000700000780007F +F000112380A20F> I<00007003F1980E1E181C0E18380700380700780780780780780780 +7807803807003807001C0E001E1C0033F0002000002000003000003800003FFE001FFFC0 +0FFFE03000F0600030C00018C00018C00018C000186000306000303800E00E038003FE00 +15217F9518> I<0E0000FE00001E00000E00000E00000E00000E00000E00000E00000E00 +000E00000E00000E00000E00000E1F800E60C00E80E00F00700F00700E00700E00700E00 +700E00700E00700E00700E00700E00700E00700E00700E00700E00700E00700E00700E00 +70FFE7FF18237FA21B> I<1C003E003E003E001C00000000000000000000000000000000 +000E007E001E000E000E000E000E000E000E000E000E000E000E000E000E000E000E000E +000E000E00FFC00A227FA10E> I<00E001F001F001F000E0000000000000000000000000 +00000000007007F000F00070007000700070007000700070007000700070007000700070 +00700070007000700070007000700070007000706070F0E0F0C061803F000C2C83A10F> +I<0E0000FE00001E00000E00000E00000E00000E00000E00000E00000E00000E00000E00 +000E00000E00000E03FC0E01F00E01C00E01800E02000E04000E08000E10000E38000EF8 +000F1C000E1E000E0E000E07000E07800E03C00E01C00E01E00E00F00E00F8FFE3FE1723 +7FA21A> I<0E00FE001E000E000E000E000E000E000E000E000E000E000E000E000E000E +000E000E000E000E000E000E000E000E000E000E000E000E000E000E000E000E000E000E +00FFE00B237FA20E> I<0E1FC07F00FE60E183801E807201C00F003C00E00F003C00E00E +003800E00E003800E00E003800E00E003800E00E003800E00E003800E00E003800E00E00 +3800E00E003800E00E003800E00E003800E00E003800E00E003800E00E003800E00E0038 +00E0FFE3FF8FFE27157F942A> I<0E1F80FE60C01E80E00F00700F00700E00700E00700E +00700E00700E00700E00700E00700E00700E00700E00700E00700E00700E00700E00700E +0070FFE7FF18157F941B> I<01FC000707000C01801800C03800E0700070700070F00078 +F00078F00078F00078F00078F00078F000787000707800F03800E01C01C00E0380070700 +01FC0015157F9418> I<0E1F00FE61C00E80600F00700E00380E003C0E003C0E001E0E00 +1E0E001E0E001E0E001E0E001E0E001E0E003C0E003C0E00380F00700E80E00E41C00E3F +000E00000E00000E00000E00000E00000E00000E00000E00000E0000FFE000171F7F941B +> I<01F8200704600E02601C01603801E07800E07800E0F000E0F000E0F000E0F000E0F0 +00E0F000E0F000E07800E07800E03801E01C01E00C02E0070CE001F0E00000E00000E000 +00E00000E00000E00000E00000E00000E00000E0000FFE171F7E941A> I<0E3CFE461E8F +0F0F0F060F000E000E000E000E000E000E000E000E000E000E000E000E000E000F00FFF0 +10157F9413> I<0F8830786018C018C008C008E008F0007F003FE00FF001F8003C801C80 +0C800CC00CC008E018D0308FC00E157E9413> I<02000200020002000600060006000E00 +1E003E00FFFC0E000E000E000E000E000E000E000E000E000E000E000E040E040E040E04 +0E040E040708030801F00E1F7F9E13> I<0E0070FE07F01E00F00E00700E00700E00700E +00700E00700E00700E00700E00700E00700E00700E00700E00700E00700E00F00E00F006 +017003827800FC7F18157F941B> I I I I I<3FFFC0380380300780200700600E +00401C00403C0040380000700000E00001E00001C0000380400700400F00400E00C01C00 +80380080780180700780FFFF8012157F9416> I 124 +D E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fl cmbx12 14.4 19 +/Fl 19 118 df<00007FE0030007FFFC07001FFFFF0F007FF00F9F00FF0001FF01FC0000 +FF03F800007F07F000003F0FE000001F1FC000001F1FC000000F3F8000000F3F80000007 +7F800000077F800000077F00000000FF00000000FF00000000FF00000000FF00000000FF +00000000FF00000000FF00000000FF00000000FF000000007F000000007F800000007F80 +0000073F800000073F800000071FC00000071FC000000E0FE000000E07F000001C03F800 +003C01FC00007800FF0001F0007FF007C0001FFFFF800007FFFE0000007FF00028297CA8 +31> 67 D +76 D<0000FFC00000000FFFFC0000003F807F000000FE001FC00001F80007E00003F000 +03F00007E00001F8000FE00001FC001FC00000FE001FC00000FE003F8000007F003F8000 +007F007F8000007F807F0000003F807F0000003F807F0000003F80FF0000003FC0FF0000 +003FC0FF0000003FC0FF0000003FC0FF0000003FC0FF0000003FC0FF0000003FC0FF0000 +003FC0FF0000003FC0FF0000003FC07F0000003F807F8000007F807F8000007F803F8000 +007F003F8000007F001FC00000FE001FC00000FE000FE00001FC0007F00003F80003F800 +07F00001FC000FE00000FE001FC000003FC0FF0000000FFFFC00000000FFC000002A297C +A833> 79 D 86 D<03FF80000FFFF0001F01FC003F80FE003F807F003F803F003F803F +801F003F8000003F8000003F8000003F8000003F80003FFF8001FC3F800FE03F801F803F +803F003F807E003F80FC003F80FC003F80FC003F80FC003F80FC005F807E00DF803F839F +FC1FFE0FFC03FC03FC1E1B7E9A21> 97 D I<00007FF000007FF000007FF0000007F0000007F0000007 +F0000007F0000007F0000007F0000007F0000007F0000007F0000007F0000007F0000007 +F0003F87F001FFF7F007F03FF00FC00FF01F8007F03F0007F03F0007F07E0007F07E0007 +F07E0007F0FE0007F0FE0007F0FE0007F0FE0007F0FE0007F0FE0007F0FE0007F0FE0007 +F07E0007F07E0007F03F0007F03F0007F01F800FF00FC01FF007E07FFF01FFE7FF007F87 +FF202A7EA925> 100 D<003FC00001FFF00003E07C000F803E001F801F001F001F003F00 +0F807E000F807E000FC07E000FC0FE0007C0FE0007C0FFFFFFC0FFFFFFC0FE000000FE00 +0000FE0000007E0000007E0000007F0000003F0001C01F0001C00F80038007C0070003F0 +1E0000FFFC00003FE0001A1B7E9A1F> I<0007F8003FFC007E3E01FC7F03F87F03F07F07 +F07F07F03E07F00007F00007F00007F00007F00007F00007F000FFFFC0FFFFC0FFFFC007 +F00007F00007F00007F00007F00007F00007F00007F00007F00007F00007F00007F00007 +F00007F00007F00007F00007F00007F00007F00007F00007F0007FFF807FFF807FFF8018 +2A7EA915> I +104 D<07000F801FC03FE03FE03FE01FC00F8007000000000000000000000000000000FF +E0FFE0FFE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00F +E00FE00FE00FE00FE00FE0FFFEFFFEFFFE0F2B7EAA12> I 108 D 110 D<003FE00001FFFC0003F07E000FC01F801F80 +0FC03F0007E03F0007E07E0003F07E0003F07E0003F0FE0003F8FE0003F8FE0003F8FE00 +03F8FE0003F8FE0003F8FE0003F8FE0003F87E0003F07E0003F03F0007E03F0007E01F80 +0FC00FC01F8007F07F0001FFFC00003FE0001D1B7E9A22> I I 114 D<03FE300FFFF03E03F078 +00F07000F0F00070F00070F80070FE0000FFE0007FFF007FFFC03FFFE01FFFF007FFF800 +FFF80007FC0000FCE0007CE0003CF0003CF00038F80038FC0070FF01E0E7FFC0C1FF0016 +1B7E9A1B> I<00E00000E00000E00000E00001E00001E00001E00003E00003E00007E000 +0FE0001FFFE0FFFFE0FFFFE00FE0000FE0000FE0000FE0000FE0000FE0000FE0000FE000 +0FE0000FE0000FE0000FE0000FE0000FE0700FE0700FE0700FE0700FE0700FE0700FE070 +07F0E003F0C001FF80007F0014267FA51A> I I E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fm cmr12 14.4 20 +/Fm 20 118 df<78FCFCFEFE7A02020202040404080810204007127B8510> 44 +D<00200000E00001E0000FE000FFE000F1E00001E00001E00001E00001E00001E00001E0 +0001E00001E00001E00001E00001E00001E00001E00001E00001E00001E00001E00001E0 +0001E00001E00001E00001E00001E00001E00001E00001E00001E00001E00001E00001E0 +0001E00003F000FFFFC0FFFFC012287BA71D> 49 D<01FC0007FF000C0FC01803E02001 +F06001F04000F84000F8F800FCFC00FCFC007CFC007CFC007C7800FC0000FC0000F80000 +F80001F00001F00003E00003C0000780000700000E00001C0000380000300000600000C0 +000180000300040200040400080800081000082000183FFFF87FFFF0FFFFF0FFFFF01628 +7DA71D> I<000FC0003FF000F01801C01803803C07007C0F007C0E00381E00003C00003C +00003C0000780000780000780000F83F00F8C1C0F900E0FA0070FA0038FC003CFC001EFC +001EF8001EF8001FF8001FF8001FF8001F78001F78001F78001F78001F3C001E3C001E1C +003C1E003C0E007807007003C1E001FFC0007E0018297EA71D> 54 +D<007E0001FF800781C00F00E01E00703C00383C003878003C78003CF8001EF8001EF800 +1EF8001EF8001FF8001FF8001FF8001F78001F78003F78003F3C003F1C005F0E005F0700 +9F03831F00FC1F00001E00001E00001E00003E00003C00003C0000381C00783E00703E00 +E03C01C01803801C0F000FFE0003F80018297EA71D> 57 D<0000FF00100007FFE03000 +1FC07830003E000C7000F80006F001F00003F003E00001F007C00000F00F800000700F80 +0000701F000000303F000000303E000000303E000000107E000000107E000000107C0000 +0000FC00000000FC00000000FC00000000FC00000000FC00000000FC00000000FC000000 +00FC00000000FC0000FFFF7C0000FFFF7E000003F07E000001F03E000001F03E000001F0 +3F000001F01F000001F00F800001F00F800001F007C00001F003E00001F001F00002F000 +F80002F0003E000C70001FC038300007FFE0100000FF8000282B7DA92E> 71 +D<01FFFE01FFFE0007E00003E00003E00003E00003E00003E00003E00003E00003E00003 +E00003E00003E00003E00003E00003E00003E00003E00003E00003E00003E00003E00003 +E00003E00003E00003E00003E00003E00003E00003E03003E07803E0FC03E0FC03E0FC03 +C0F807C0400780200F00300E000C3C0003F000172A7DA81E> 74 +D<0001FF0000000F01E000003C0078000078003C0000E0000E0001E0000F0003C0000780 +07800003C00F800003E01F000001F01F000001F03E000000F83E000000F87E000000FC7E +000000FC7C0000007C7C0000007CFC0000007EFC0000007EFC0000007EFC0000007EFC00 +00007EFC0000007EFC0000007EFC0000007EFC0000007E7C0000007C7E000000FC7E0000 +00FC7E000000FC3E000000F83F000001F81F000001F01F000001F00F800003E007800003 +C007C00007C003E0000F8000F0001E000078003C00003C007800000F01E0000001FF0000 +272B7DA92E> 79 D<03FC00000C070000100380003C01C0003E01E0003E00F0001C00F0 +000800F0000000F0000000F0000000F000007FF00003E0F0000F80F0001E00F0003C00F0 +007C00F0007800F040F800F040F800F040F800F040F801F0407C01F0403C0278801E0C7F +8007F01E001A1A7E991D> 97 D<0F000000FF000000FF0000001F0000000F0000000F00 +00000F0000000F0000000F0000000F0000000F0000000F0000000F0000000F0000000F00 +00000F0000000F07E0000F1838000F600E000F8007000F8007800F0003C00F0003C00F00 +01E00F0001E00F0001F00F0001F00F0001F00F0001F00F0001F00F0001F00F0001F00F00 +01E00F0001E00F0003E00F0003C00F0003800F8007800E800F000E401C000C303800080F +C0001C2A7EA921> I<007F0001C0E00700100E00781E00F83C00F83C00707C0020780000 +F80000F80000F80000F80000F80000F80000F80000F800007800007C00003C00083C0008 +1E00100E002007006001C180007E00151A7E991A> I<00FC000387800701C00E01E01C00 +E03C00F03C00F0780078780078F80078F80078FFFFF8F80000F80000F80000F80000F800 +007800007800003C00083C00081E00100E002007004001C180007E00151A7E991A> 101 +D<00000F0001FC3080070743800E03C3801E03C1003C01E0003C01E0007C01F0007C01F0 +007C01F0007C01F0007C01F0003C01E0003C01E0001E03C0000E0380001707000011FC00 +0030000000300000003000000030000000180000001FFF80000FFFF00007FFF80018007C +0030001E0070000E0060000700E0000700E0000700E0000700E000070070000E0070000E +0038001C001C0038000781E00000FF000019287E9A1D> 103 D<1E003F003F003F003F00 +1E000000000000000000000000000000000000000F00FF00FF001F000F000F000F000F00 +0F000F000F000F000F000F000F000F000F000F000F000F000F000F000F000F00FFF0FFF0 +0C297EA811> 105 D<007E0003C3C00700E00E00701C00383C003C3C003C78001E78001E +F8001FF8001FF8001FF8001FF8001FF8001FF8001FF8001F78001E78001E3C003C3C003C +1C00380E00700700E003C3C0007E00181A7E991D> 111 D<003F010001E0830003804300 +0F0027001E0017001E001F003C000F007C000F007C000F0078000F00F8000F00F8000F00 +F8000F00F8000F00F8000F00F8000F00F8000F007C000F007C000F003C000F003E001F00 +1E001F000F002F0007804F0001C18F00007E0F0000000F0000000F0000000F0000000F00 +00000F0000000F0000000F0000000F0000000F0000000F000000FFF00000FFF01C267E99 +1F> 113 D<0F0F80FF11C0FF23E01F43E00F83E00F81C00F80000F00000F00000F00000F +00000F00000F00000F00000F00000F00000F00000F00000F00000F00000F00000F00000F +00000F8000FFFC00FFFC00131A7E9917> I<07F0801C0D80300380600180E00180E00080 +E00080F00080F800007E00007FE0003FFC001FFE0007FF00003F800007808003C08003C0 +8001C0C001C0C001C0E00180E00380F00300CC0E0083F800121A7E9917> I<0080000080 +000080000080000180000180000180000380000380000780000F80001FFF80FFFF800780 +000780000780000780000780000780000780000780000780000780000780000780000780 +0007804007804007804007804007804007804007804003C08001C08000E100003E001225 +7FA417> I<0F000F00FF00FF00FF00FF001F001F000F000F000F000F000F000F000F000F +000F000F000F000F000F000F000F000F000F000F000F000F000F000F000F000F000F000F +000F000F000F000F000F000F000F001F000F001F0007002F0003804F8001C08FF0007F0F +F01C1A7E9921> I E +%EndDVIPSBitmapFont +%DVIPSBitmapFont: Fn cmr17 20.74 18 +/Fn 18 119 df<000001FF00008000001FFFE0018000007F007801800001F8000E038000 +03E000070780000FC000018780001F000000CF80003E0000006F80007C0000003F8000F8 +0000003F8001F00000001F8003F00000000F8007E00000000F8007C000000007800FC000 +000007800FC000000007801F8000000003801F8000000003803F8000000003803F000000 +0001803F0000000001807F0000000001807F0000000001807E0000000000007E00000000 +0000FE000000000000FE000000000000FE000000000000FE000000000000FE0000000000 +00FE000000000000FE000000000000FE000000000000FE000000000000FE000000000000 +FE0000000000007E0000000000007E0000000000007F0000000000007F0000000001803F +0000000001803F0000000001803F8000000001801F8000000001801F8000000003000FC0 +00000003000FC0000000030007E0000000060007E0000000060003F0000000060001F000 +00000C0000F80000001800007C0000001800003E0000003000001F0000006000000FC000 +01C0000003E0000380000001F8000E000000007F007C000000001FFFF00000000001FF00 +0000313D7CBB39> 67 D 76 D<000003FF00000000001E01E000000000F0003C000000 +03C0000F000000078000078000000F000003C000003E000001F000007C000000F80000F8 +0000007C0001F00000003E0001F00000003E0003E00000001F0007E00000001F8007C000 +00000F800FC00000000FC00F8000000007C01F8000000007E01F8000000007E03F000000 +0003F03F0000000003F03F0000000003F07F0000000003F87E0000000001F87E00000000 +01F87E0000000001F8FE0000000001FCFE0000000001FCFE0000000001FCFE0000000001 +FCFE0000000001FCFE0000000001FCFE0000000001FCFE0000000001FCFE0000000001FC +FE0000000001FCFE0000000001FC7E0000000001F87F0000000003F87F0000000003F87F +0000000003F87F0000000003F83F0000000003F03F8000000007F01F8000000007E01F80 +00000007E01FC00000000FE00FC00000000FC007C00000000F8007E00000001F8003E000 +00001F0001F00000003E0001F80000007E0000F80000007C00007C000000F800003E0000 +01F000000F000003C000000780000780000003E0001F00000000F8007C000000001E01E0 +0000000003FF000000363D7CBB3E> 79 D<003F80000001C0F0000003003C000004001E +00000C000F000018000780001C0007C0003E0003C0003F0003E0003F0003E0003F0003E0 +001E0003E000000003E000000003E000000003E00000003FE000000FF3E000007E03E000 +01F803E00003E003E0000FC003E0001F8003E0003F0003E0003E0003E0007E0003E0007E +0003E060FC0003E060FC0003E060FC0003E060FC0007E060FC0007E0607C000BE0607E00 +0BE0603E0011F0C01F0060F0C007C1807F8000FE003E0023257CA427> 97 +D<03E0000000FFE0000000FFE000000007E000000003E000000003E000000003E0000000 +03E000000003E000000003E000000003E000000003E000000003E000000003E000000003 +E000000003E000000003E000000003E000000003E000000003E000000003E000000003E0 +00000003E000000003E03FC00003E0E0780003E3001C0003E6000F0003E800078003F800 +03C003F00001E003E00001F003E00000F003E00000F803E00000F803E00000FC03E00000 +7C03E000007C03E000007E03E000007E03E000007E03E000007E03E000007E03E000007E +03E000007E03E000007E03E000007E03E000007C03E000007C03E00000FC03E00000F803 +E00000F803E00001F003E00001E003F00003E003D80003C003C80007800384000E000383 +001C000381C0F00003003F8000273C7EBB2C> I<0007F800003C0E0000F0018001E000C0 +03C00060078000300F0000701F0000F81F0001F83E0001F83E0001F87E0000F07C000000 +7C000000FC000000FC000000FC000000FC000000FC000000FC000000FC000000FC000000 +FC0000007C0000007C0000007E0000003E0000003E00000C1F00000C1F0000180F800018 +0780003003C0006001E000C000F00180003C0E000007F8001E257DA423> I<0007F80000 +3C1E0000F0078001C003C003C001E0078000F00F0000F81F0000781E00007C3E00007C3E +00007C7E00003E7C00003E7C00003EFC00003EFC00003EFFFFFFFEFC000000FC000000FC +000000FC000000FC000000FC0000007C0000007C0000007E0000003E0000003E0000061F +0000060F00000C0F80000C0780001803C0003000E00060007000C0001E07000003FC001F +257EA423> 101 D<0000FC0000078300000E0380001C07C0003C0FC000780FC000F80FC0 +00F8078000F0000001F0000001F0000001F0000001F0000001F0000001F0000001F00000 +01F0000001F0000001F0000001F0000001F0000001F0000001F00000FFFFFC00FFFFFC00 +01F0000001F0000001F0000001F0000001F0000001F0000001F0000001F0000001F00000 +01F0000001F0000001F0000001F0000001F0000001F0000001F0000001F0000001F00000 +01F0000001F0000001F0000001F0000001F0000001F0000001F0000001F0000001F00000 +01F0000001F0000001F0000001F0000001F0000003F800007FFFE0007FFFE0001A3C7FBB +18> I<07000F801FC01FC01FC00F80070000000000000000000000000000000000000000 +0000000000000007C0FFC0FFC00FC007C007C007C007C007C007C007C007C007C007C007 +C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007 +C007C00FE0FFFEFFFE0F397DB815> 105 D<0003800007C0000FE0000FE0000FE00007C0 +000380000000000000000000000000000000000000000000000000000000000000000000 +0000000000000007E000FFE000FFE0000FE00003E00003E00003E00003E00003E00003E0 +0003E00003E00003E00003E00003E00003E00003E00003E00003E00003E00003E00003E0 +0003E00003E00003E00003E00003E00003E00003E00003E00003E00003E00003E00003E0 +0003E00003E00003E00003E00003E00003E00003E00003E00003E00003E00003E00003E0 +7803C0FC07C0FC0780FC0780FC0F00780E00381C000FE000134A82B818> I<07C0FFC0FF +C00FC007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007 +C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007 +C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007 +C00FE0FFFEFFFE0F3C7DBB15> 108 D<03E01FE0003FC000FFE0607C00C0F800FFE0801E +01003C0007E3000F06001E0003E4000F88001F0003E4000F88001F0003E8000790000F00 +03E80007D0000F8003F00007E0000F8003F00007E0000F8003E00007C0000F8003E00007 +C0000F8003E00007C0000F8003E00007C0000F8003E00007C0000F8003E00007C0000F80 +03E00007C0000F8003E00007C0000F8003E00007C0000F8003E00007C0000F8003E00007 +C0000F8003E00007C0000F8003E00007C0000F8003E00007C0000F8003E00007C0000F80 +03E00007C0000F8003E00007C0000F8003E00007C0000F8003E00007C0000F8003E00007 +C0000F8003E00007C0000F8003E00007C0000F8003E00007C0000F8003E00007C0000F80 +07F0000FE0001FC0FFFF81FFFF03FFFEFFFF81FFFF03FFFE3F257EA443> I<03E01FE000 +FFE0607C00FFE0801E0007E3000F0003E4000F8003E4000F8003E800078003E80007C003 +F00007C003F00007C003E00007C003E00007C003E00007C003E00007C003E00007C003E0 +0007C003E00007C003E00007C003E00007C003E00007C003E00007C003E00007C003E000 +07C003E00007C003E00007C003E00007C003E00007C003E00007C003E00007C003E00007 +C003E00007C003E00007C003E00007C003E00007C007F0000FE0FFFF81FFFFFFFF81FFFF +28257EA42C> I<0007FC0000001C070000007001C00001E000F00003C00078000780003C +000F00001E001F00001F001E00000F003E00000F803E00000F807C000007C07C000007C0 +7C000007C0FC000007E0FC000007E0FC000007E0FC000007E0FC000007E0FC000007E0FC +000007E0FC000007E0FC000007E07C000007C07C000007C07E00000FC03E00000F803E00 +000F801E00000F001F00001F000F00001E000780003C0003C000780001E000F000007001 +C000001C0700000007FC000023257EA427> I<03E03E00FFE0C300FFE1078007E20FC003 +E40FC003E80FC003E8078003E8030003F0000003F0000003F0000003E0000003E0000003 +E0000003E0000003E0000003E0000003E0000003E0000003E0000003E0000003E0000003 +E0000003E0000003E0000003E0000003E0000003E0000003E0000003E0000003E0000003 +E0000003E0000003E0000007F00000FFFFC000FFFFC0001A257EA41E> 114 +D<00FF02000700C6000C002E0010001E0030001E0060000E0060000E00E0000600E00006 +00E0000600F0000600F8000600FC0000007F0000003FF000003FFF80000FFFE00007FFF0 +0001FFFC00003FFE000001FE0000003F00C0001F00C0000F80C0000780E0000380E00003 +80E0000380E0000380F0000300F0000300F8000700F8000600E4000C00E2001800C18070 +00807F800019257DA41F> I<003000000030000000300000003000000030000000300000 +0070000000700000007000000070000000F0000000F0000001F0000001F0000003F00000 +07F000001FFFFE00FFFFFE0001F0000001F0000001F0000001F0000001F0000001F00000 +01F0000001F0000001F0000001F0000001F0000001F0000001F0000001F0000001F00000 +01F0000001F0000001F0000001F0000001F0018001F0018001F0018001F0018001F00180 +01F0018001F0018001F0018001F0018000F0010000F8030000F8030000780200003C0400 +000E08000003F00019357FB41E> I 118 +D E +%EndDVIPSBitmapFont +end +%%EndProlog +%%BeginSetup +%%Feature: *Resolution 300dpi +TeXDict begin +%%PaperSize: a4 + +userdict/PStoPSxform PStoPSmatrix matrix currentmatrix + matrix invertmatrix matrix concatmatrix + matrix invertmatrix put +%%EndSetup +%%Page: (0,1) 1 +userdict/PStoPSsaved save put +PStoPSmatrix setmatrix +595.000000 0.271378 translate +90 rotate +0.706651 dup scale +userdict/PStoPSmatrix matrix currentmatrix put +userdict/PStoPSclip{0 0 moveto + 595.000000 0 rlineto 0 842.000000 rlineto -595.000000 0 rlineto + closepath}put initclip +/showpage{}def/copypage{}def/erasepage{}def +PStoPSxform concat +1 0 bop Fn 281 370 a(Cleaner) p 570 370 a(seman) n(tics) p +927 370 a(for) p 1047 370 a(Ob) t(jectiv) n(e) p 1404 +370 a(Lab) r(el) p Fm 717 518 a(Jacques) p 934 518 a(Garrigue) 719 +634 y(Octob) r(er) p 945 634 a(26,) p 1040 634 a(1999) p +Fl 11 836 a(Credits) p Fk 11 929 a(This) p 122 929 a(prop) q(osal) p +319 929 a(con) o(tains) p 510 929 a(ideas) p 632 929 +a(from) p 747 929 a(Damien) p 928 929 a(Doligez) p 1101 +929 a(and) p 1196 929 a(Pierre) p 1340 929 a(W) l(eis.) p +Fl 11 1073 a(Lab) r(els) p 221 1073 a(and) p 351 1073 +a(optionals) p Fk 11 1165 a(Lab) q(els) p 165 1165 a(and) p +259 1165 a(optional) p 449 1165 a(argumen) o(ts) p 687 +1165 a(had) p 781 1165 a(t) o(w) o(o) p 873 1165 a(problems) p +1082 1165 a(in) p 1139 1165 a(Ob) s(jectiv) o(e) p 1360 +1165 a(Lab) q(el.) p Fj 83 1280 a(\017) p Fk 133 1280 +a(They) p 259 1280 a(w) o(ere) p 372 1280 a(not) p 459 +1280 a(fully) p 570 1280 a(coheren) o(t) p 767 1280 a(with) p +878 1280 a(the) p 963 1280 a(original) p 1139 1280 a(call-b) o(y-v) m +(alue) p 1423 1280 a(seman) o(tics) p 1644 1280 a(of) p +1700 1280 a(the) p 1784 1280 a(lan-) 133 1340 y(guage.) p +303 1340 a(In) p 368 1340 a(some) p 495 1340 a(\(subtle\)) p +681 1340 a(cases,) p 823 1340 a(a) p 868 1340 a(side-e\013ect) p +1099 1340 a(migh) o(t) p 1243 1340 a(get) p 1329 1340 +a(dela) o(y) o(ed) p 1508 1340 a(more) p 1635 1340 a(than) p +1753 1340 a(in) p 1814 1340 a(an) 133 1400 y(un) o(t) o(yp) q(ed) p +322 1400 a(seman) o(tics.) p Fj 83 1502 a(\017) p Fk +133 1502 a(F) l(or) p 220 1502 a(optional) p 410 1502 +a(argumen) o(ts,) p 660 1502 a(no) p 728 1502 a(un) o(t) o(yp) q(ed) p +918 1502 a(seman) o(tics) p 1139 1502 a(existed.) 84 +1616 y(This) p 195 1616 a(new) p 295 1616 a(prop) q(osal) p +492 1616 a(corrects) p 674 1616 a(these) p 799 1616 a(t) o(w) o(o) p +891 1616 a(\015a) o(ws.) p Fi 11 1746 a(Syn) n(tax) p +Fk 11 1838 a(W) l(e) p 95 1838 a(k) o(eep) p 206 1838 +a(Ob) s(jectiv) o(e) p 426 1838 a(Lab) q(el's) p 594 +1838 a(syn) o(tax,) p 764 1838 a(except) p 917 1838 a(for) p +991 1838 a(default) p 1155 1838 a(v) m(alues) p 1301 +1838 a(in) p 1357 1838 a(optional) p 1547 1838 a(argumen) o(ts.) p +Fh 329 1944 a(typ) n(expr) p Fk 528 1944 a(::=) p Fg +634 1944 a(:) p 656 1944 a(:) p 678 1944 a(:) p Fj 579 +2004 a(j) p Fh 634 2004 a(typ) n(expr) p Fj 806 2004 +a(!) p Fh 870 2004 a(typ) n(expr) p Fj 579 2064 a(j) p +Fk 634 2064 a([?]) p Fi(lab) r(el) p Fk 801 2064 a(:) p +Fh(typ) n(expr) p Fj 987 2064 a(!) p Fh 1050 2064 a(typ) n(expr) 391 +2124 y(expr) p Fk 528 2124 a(::=) p Fg 634 2124 a(:) p +656 2124 a(:) p 678 2124 a(:) p Fj 579 2185 a(j) p Fh +634 2185 a(expr) p 746 2185 a(lab) n(ele) n(d-expr) p +Ff 991 2163 a(+) p Fj 579 2245 a(j) p Fe 634 2245 a(fun) p +Fj 728 2245 a(f) p Fh(lab) n(ele) n(d-simple-p) n(attern) p +Fj 1209 2245 a(g) p Ff 1234 2227 a(+) p Fk 1280 2245 +a([) p Fe(when) p Fh 1412 2245 a(expr) p Fk 1507 2245 +a(]) p Fj 1535 2245 a(!) p Fh 1599 2245 a(expr) p Fj +579 2305 a(j) p Fe 634 2305 a(function) p Fh 856 2305 +a(lab) n(ele) n(d-p) n(attern) p Fk 1177 2305 a([) p +Fe(when) p Fh 1309 2305 a(expr) p Fk 1404 2305 a(]) p +Fj 1432 2305 a(!) p Fh 1496 2305 a(expr) p Fj 785 2365 +a(f) p Fe(|) p Fh 851 2365 a(lab) n(ele) n(d-p) n(attern) p +Fk 1172 2365 a([) p Fe(when) p Fg 1305 2365 a(expr) p +Fk 1403 2365 a(]) p Fj 1430 2365 a(!) p Fh 1494 2365 +a(expr) p Fj 1589 2365 a(g) p Fd 1614 2347 a(\003) p +Fh 242 2425 a(lab) n(ele) n(d-expr) p Fk 528 2425 a(::=) p +634 2425 a([?]) p Fh(expr) p Fj 579 2486 a(j) p Fk 634 +2486 a([?]) p Fi(lab) r(el) p Fk 801 2486 a(:) p Fh(expr) 182 +2546 y(lab) n(ele) n(d-p) n(attern) p Fk 528 2546 a(::=) p +Fh 634 2546 a(p) n(attern) p Fj 579 2606 a(j) p Fi 634 +2606 a(lab) r(el) p Fk 751 2606 a(:) p Fh(p) n(attern) p +Fj 579 2666 a(j) p Fk 634 2666 a(?[) p Fe(\() p Fh(expr) p +Fe(\)) p Fk(]) p Fi(lab) r(el) p Fk 943 2666 a(:) p Fh +956 2666 a(p) n(attern) p Fk 926 2937 a(1) p eop +PStoPSsaved restore +userdict/PStoPSsaved save put +PStoPSmatrix setmatrix +595.000000 421.271378 translate +90 rotate +0.706651 dup scale +userdict/PStoPSmatrix matrix currentmatrix put +userdict/PStoPSclip{0 0 moveto + 595.000000 0 rlineto 0 842.000000 rlineto -595.000000 0 rlineto + closepath}put initclip +PStoPSxform concat +2 1 bop Fi 11 168 a(Dynamic) p 247 168 a(seman) n(tics) p +Fj 11 261 a(;) p Fk 52 261 a(is) p 101 261 a(a) p 141 +261 a(notation) p 337 261 a(for) p 411 261 a(the) p 495 +261 a(empt) o(y) p 644 261 a(lab) q(el.) 86 366 y(\() p +Fe(fun) p Fi 198 366 a(l) p Fc 214 373 a(i) p Fk 227 +366 a(:) p Fg(x) p Fj 282 366 a(!) p Fg 346 366 a(e) p +Fk(\)) p Fi 404 366 a(l) p Fc 420 373 a(1) p Fk 442 366 +a(:) p Fg 455 366 a(e) p Ff 478 373 a(1) p Fg 506 366 +a(:) p 528 366 a(:) p 550 366 a(:) p Fi 571 366 a(l) p +Fc 587 373 a(n) p Fk 612 366 a(:) p Fg 625 366 a(e) p +Fb 648 373 a(n) p Fj 515 427 a(!) p Fk 579 427 a(\() p +Fg(e) p Fk([) p Fg(e) p Fb 658 434 a(i) p Fg 671 427 +a(=x) p Fk(]) p Fi 752 427 a(l) p Fc 768 434 a(1) p Fk +790 427 a(:) p Fg(e) p Ff 827 434 a(1) p Fg 855 427 a(:) p +877 427 a(:) p 899 427 a(:) p Fi 920 427 a(l) p Fc 936 +434 a(i) p Fd(\000) p Fc(1) p Fk 997 427 a(:) p Fg 1010 +427 a(e) p Fb 1033 434 a(i) p Fd(\000) p Ff(1) p Fi 1108 +427 a(l) p Fc 1124 434 a(i) p Ff(+) p Fc(1) p Fk 1185 +427 a(:) p Fg(e) p Fb 1222 434 a(i) p Ff(+1) p Fg 1289 +427 a(:) p 1311 427 a(:) p 1333 427 a(:) p Fi 1354 427 +a(l) p Fc 1370 434 a(n) p Fk 1395 427 a(:) p Fg 1408 +427 a(e) p Fb 1431 434 a(n) p Fk 86 487 a(\() p Fe(fun) p +Fk 198 487 a(?) p Fi(l) p Fc 237 494 a(i) p Fk 250 487 +a(:) p Fg(x) p Fj 305 487 a(!) p Fg 369 487 a(e) p Fk(\)) p +Fi 427 487 a(l) p Fc 443 494 a(1) p Fk 465 487 a(:) p +Fg 478 487 a(e) p Ff 501 494 a(1) p Fg 529 487 a(:) p +551 487 a(:) p 573 487 a(:) p Fi 594 487 a(l) p Fc 610 +494 a(n) p Fk 635 487 a(:) p Fg 648 487 a(e) p Fb 671 +494 a(n) p Fj 515 547 a(!) p Fg 579 547 a(e) p Fk([) p +Fe(Some) p Fk 717 547 a(\() p Fg(e) p Fb 759 554 a(i) p +Fk 773 547 a(\)) p Fg(=x) p Fk(]) p Fi 874 547 a(l) p +Fc 890 554 a(1) p Fk 912 547 a(:) p Fg 925 547 a(e) p +Ff 948 554 a(1) p Fg 976 547 a(:) p 998 547 a(:) p 1020 +547 a(:) p Fi 1042 547 a(l) p Fc 1058 554 a(i) p Fd(\000) p +Fc(1) p Fk 1118 547 a(:) p Fg(e) p Fb 1155 554 a(i) p +Fd(\000) p Ff(1) p Fi 1230 547 a(l) p Fc 1246 554 a(i) p +Ff(+) p Fc(1) p Fk 1307 547 a(:) p Fg 1320 547 a(e) p +Fb 1343 554 a(i) p Ff(+1) p Fg 1410 547 a(:) p 1432 547 +a(:) p 1454 547 a(:) p Fi 1476 547 a(l) p Fc 1492 554 +a(n) p Fk 1516 547 a(:) p Fg(e) p Fb 1553 554 a(n) p +Fk 86 607 a(\() p Fe(fun) p Fk 198 607 a(?) p Fi(l) p +Fk(:) p Fg 250 607 a(x) p Fj 292 607 a(!) p Fg 356 607 +a(e) p Fk(\)) p Fi 413 607 a(l) p Fc 429 614 a(1) p Fk +451 607 a(:) p Fg(e) p Ff 488 614 a(1) p Fg 516 607 a(:) p +538 607 a(:) p 560 607 a(:) p Fi 581 607 a(l) p Fc 597 +614 a(n) p Fk 621 607 a(:) p Fg(e) p Fb 658 614 a(n) p +Fk 1154 607 a(when) p Fi 1281 607 a(l) p Fc 1297 614 +a(i) p Fk 1324 607 a(=) p Fj 1376 607 a(;) p Fk 1417 +607 a(and) p Fg 1512 607 a(l) p Fj 1541 607 a(62) p 1588 +607 a(f) p Fi(l) p Fc 1629 614 a(1) p Fg 1660 607 a(:) p +1682 607 a(:) p 1704 607 a(:) p Fi 1725 607 a(l) p Fc +1741 614 a(n) p Fj 1765 607 a(g) 515 667 y(!) p Fg 579 +667 a(e) p Fk([) p Fe(None) p Fg 717 667 a(=x) p Fk(]) p +Fi 799 667 a(l) p Fc 815 674 a(1) p Fk 837 667 a(:) p +Fg(e) p Ff 874 674 a(1) p Fg 901 667 a(:) p 923 667 a(:) p +945 667 a(:) p Fi 967 667 a(l) p Fc 983 674 a(n) p Fk +1007 667 a(:) p Fg(e) p Fb 1044 674 a(n) p Fk 86 728 +a(\(\() p Fe(fun) p Fi 217 728 a(l) p Fk(:) p Fg 246 +728 a(x) p Fj 288 728 a(!) p Fg 352 728 a(e) p Fk(\)) p +Fi 409 728 a(l) p Fc 425 735 a(1) p Fk 447 728 a(:) p +Fg(e) p Ff 484 735 a(1) p Fg 511 728 a(:) p 533 728 a(:) p +555 728 a(:) p Fi 577 728 a(l) p Fc 593 735 a(m) p Fk +629 728 a(:) p Fg 642 728 a(e) p Fb 665 735 a(m) p Fk +698 728 a(\)) p Fi 733 728 a(l) p Fc 749 735 a(m) p Ff(+) p +Fc(1) p Fk 833 728 a(:) p Fg 846 728 a(e) p Fb 869 735 +a(m) p Ff(+1) p Fg 955 728 a(:) p 977 728 a(:) p 999 +728 a(:) p Fi 1021 728 a(l) p Fc 1037 735 a(n) p Fk 1061 +728 a(:) p Fg(e) p Fb 1098 735 a(n) p Fk 1373 728 a(when) p +Fi 1501 728 a(l) p Fj 1530 728 a(62) p 1577 728 a(f) p +Fi(l) p Fc 1618 735 a(1) p Fg 1648 728 a(:) p 1670 728 +a(:) p 1692 728 a(:) p Fi 1714 728 a(l) p Fc 1730 735 +a(m) p Fj 1765 728 a(g) 515 788 y(!) p Fk 579 788 a(\() p +Fe(fun) p Fi 691 788 a(l) p Fk(:) p Fg 720 788 a(x) p +Fj 761 788 a(!) p Fg 825 788 a(e) p Fk(\)) p Fi 883 788 +a(l) p Fc 899 795 a(1) p Fk 921 788 a(:) p Fg 934 788 +a(e) p Ff 957 795 a(1) p Fg 985 788 a(:) p 1007 788 a(:) p +1029 788 a(:) p Fi 1051 788 a(l) p Fc 1067 795 a(n) p +Fk 1091 788 a(:) p Fg 1104 788 a(e) p Fb 1127 795 a(n) p +Fk 86 848 a(\(\() p Fe(fun) p Fk 217 848 a(?) p Fi(l) p +Fk(:) p Fg 269 848 a(x) p Fj 311 848 a(!) p Fg 375 848 +a(e) p Fk(\)) p Fi 432 848 a(l) p Fc 448 855 a(1) p Fk +470 848 a(:) p Fg(e) p Ff 507 855 a(1) p Fg 535 848 a(:) p +557 848 a(:) p 579 848 a(:) p Fi 600 848 a(l) p Fc 616 +855 a(m) p Fk 652 848 a(:) p Fg 665 848 a(e) p Fb 688 +855 a(m) p Fk 721 848 a(\)) p Fi 756 848 a(l) p Fc 772 +855 a(m) p Ff(+) p Fc(1) p Fk 856 848 a(:) p Fg 869 848 +a(e) p Fb 892 855 a(m) p Ff(+1) p Fg 978 848 a(:) p 1000 +848 a(:) p 1022 848 a(:) p Fi 1044 848 a(l) p Fc 1060 +855 a(n) p Fk 1084 848 a(:) p Fg(e) p Fb 1121 855 a(n) p +Fk 1261 848 a(when) p Fj 1388 848 a(f) p Fi(l) p Fg(;) p +Fj 1451 848 a(;g) p 1530 848 a(6) m(\\) p 1577 848 a(f) p +Fi(l) p Fc 1618 855 a(1) p Fg 1648 848 a(:) p 1670 848 +a(:) p 1692 848 a(:) p Fi 1714 848 a(l) p Fc 1730 855 +a(m) p Fj 1765 848 a(g) 515 908 y(!) p Fk 579 908 a(\() p +Fe(fun) p Fk 691 908 a(?) p Fi(l) p Fk(:) p Fg 743 908 +a(x) p Fj 785 908 a(!) p Fg 848 908 a(e) p Fk(\)) p Fi +906 908 a(l) p Fc 922 915 a(1) p Fk 944 908 a(:) p Fg(e) p +Ff 981 915 a(1) p Fg 1008 908 a(:) p 1030 908 a(:) p +1052 908 a(:) p Fi 1074 908 a(l) p Fc 1090 915 a(n) p +Fk 1114 908 a(:) p Fg 1127 908 a(e) p Fb 1150 915 a(n) p +Fi 11 1035 a(T) n(yping) p Fk 11 1127 a(Seman) o(tics) p +240 1127 a(are) p 321 1127 a(k) o(ept) p 430 1127 a(throughout) p +685 1127 a(compilation) p 950 1127 a(b) o(y) p 1018 1127 +a(disallo) o(wing) p 1269 1127 a(lab) q(el) p 1387 1127 +a(comm) o(utation) p 1684 1127 a(for) p 1759 1127 a(func-) 11 +1187 y(tion) p 116 1187 a(t) o(yp) q(es.) p 278 1187 +a(Ho) o(w) o(ev) o(er,) p 494 1187 a(the) p 583 1187 +a(original) p 764 1187 a(comfort) p 949 1187 a(of) p +1009 1187 a(out-of-order) p 1283 1187 a(application) p +1540 1187 a(is) p 1594 1187 a(reco) o(v) o(ered) p 1814 +1187 a(b) o(y) 11 1247 y(allo) o(wing) p 207 1247 a(argumen) o(t) p +431 1247 a(reordering) p 670 1247 a(in) p 732 1247 a(application,) p +1005 1247 a(when) p 1138 1247 a(the) p 1227 1247 a(function's) p +1457 1247 a(t) o(yp) q(e) p 1572 1247 a(is) p Fh 1626 +1247 a(wel) r(l) p 1731 1247 a(known) p Fk 11 1308 a(\() p +Fh(c.f.) p Fk 118 1308 a(p) q(olymorphic) p 400 1308 +a(metho) q(ds\).) p Fl 11 1452 a(V) p 56 1452 a(arian) n(ts) p +Fk 11 1544 a(V) l(arian) o(t) p 187 1544 a(t) o(yping,) p +355 1544 a(as) p 417 1544 a(it) p 468 1544 a(is) p 519 +1544 a(presen) o(ted) p 739 1544 a(in) p 798 1544 a(the) p +884 1544 a(user's) p 1022 1544 a(man) o(ual,) p 1210 +1544 a(is) p 1261 1544 a(not) p 1350 1544 a(principal:) p +1576 1544 a(in) p 1635 1544 a(some) p 1760 1544 a(cases) 11 +1605 y(t) o(ypabilit) o(y) p 239 1605 a(of) p 301 1605 +a(an) p 375 1605 a(expression) p 616 1605 a(ma) o(y) p +728 1605 a(dep) q(end) p 904 1605 a(on) p 978 1605 a(the) p +1069 1605 a(order) p 1202 1605 a(in) p 1265 1605 a(whic) o(h) p +1411 1605 a(the) p 1502 1605 a(t) o(yping) p 1660 1605 +a(algorithm) 11 1665 y(pro) q(ceeds.) p Fe 133 1779 a(#) p +184 1779 a(let) p 286 1779 a(f1) p 363 1779 a(\(x) p +440 1779 a(:) p 491 1779 a([<) p 568 1779 a(a) p 620 +1779 a(b\(int\)]\)) p 850 1779 a(=) p 902 1779 a(\(\)) 184 +1839 y(let) p 286 1839 a(f2) p 363 1839 a(\(x) p 440 +1839 a(:) p 491 1839 a([<) p 568 1839 a(a]\)) p 671 1839 +a(=) p 722 1839 a(\(\)) 184 1899 y(let) p 286 1899 a(f3) p +363 1899 a(\(x) p 440 1899 a(:) p 491 1899 a([<) p 568 +1899 a(a) p 620 1899 a(b\(bool\)]\)) p 876 1899 a(=) p +927 1899 a(\(\);;) 133 1960 y(val) p 235 1960 a(f1) p +312 1960 a(:) p 363 1960 a([<) p 440 1960 a(a) p 491 +1960 a(b\(int\)]) p 696 1960 a(->) p 773 1960 a(unit) p +902 1960 a(=) p 953 1960 a() 133 2020 y(val) p 235 +2020 a(f2) p 312 2020 a(:) p 363 2020 a([<) p 440 2020 +a(a]) p 517 2020 a(->) p 594 2020 a(unit) p 722 2020 +a(=) p 773 2020 a() 133 2080 y(val) p 235 2080 a(f3) p +312 2080 a(:) p 363 2080 a([<) p 440 2080 a(a) p 491 +2080 a(b\(bool\)]) p 722 2080 a(->) p 799 2080 a(unit) p +927 2080 a(=) p 978 2080 a() 133 2140 y(#) p 184 +2140 a(fun) p 286 2140 a(x) p 338 2140 a(->) p 414 2140 +a(f1) p 491 2140 a(x;) p 568 2140 a(f2) p 645 2140 a(x;) p +722 2140 a(f3) p 799 2140 a(x;;) 133 2200 y(-) p 184 +2200 a(:) p 235 2200 a([<) p 312 2200 a(a]) p 389 2200 +a(->) p 466 2200 a(unit) p 594 2200 a(=) p 645 2200 a() 133 +2260 y(#) p 184 2260 a(fun) p 286 2260 a(x) p 338 2260 +a(->) p 414 2260 a(f1) p 491 2260 a(x;) p 568 2260 a(f3) p +645 2260 a(x;;) 133 2321 y(Character) o(s) p 414 2321 +a(18-19:) 133 2381 y(This) p 261 2381 a(expressio) o(n) p +543 2381 a(has) p 645 2381 a(type) p 773 2381 a([<) p +850 2381 a(a) p 902 2381 a(b\(int\)]) p 1107 2381 a(but) p +1209 2381 a(is) p 1286 2381 a(here) p 1414 2381 a(used) p +1542 2381 a(with) p 1670 2381 a(type) 184 2441 y([<) p +261 2441 a(a) p 312 2441 a(b\(bool\)]) p Fk 84 2555 a(Here) p +204 2555 a(the) p 292 2555 a(constrain) o(t) p 526 2555 +a(in) o(tro) q(duced) p 775 2555 a(b) o(y) p Fe 848 2555 +a(f2) p Fk 920 2555 a(hides) p 1049 2555 a(the) p 1138 +2555 a(constructor) p Fe 1401 2555 a(b) p Fk(,) p 1462 +2555 a(and) p 1562 2555 a(a) o(v) o(oids) p 1714 2555 +a(a) p 1760 2555 a(clash) 11 2615 y(b) q(et) o(w) o(een) p +Fe 199 2615 a(int) p Fk 292 2615 a(and) p Fe 387 2615 +a(bool) p Fk(.) 84 2676 y(An) p 163 2676 a(easy) p 270 +2676 a(w) o(a) o(y) p 369 2676 a(to) p 428 2676 a(solv) o(e) p +547 2676 a(this) p 642 2676 a(w) o(ould) p 784 2676 a(b) q(e) p +850 2676 a(to) p 909 2676 a(restrict) p 1077 2676 a(hiding) p +1226 2676 a(absen) o(t) p 1379 2676 a(lab) q(els) p 1515 +2676 a(to) p 1575 2676 a(generic) p 1739 2676 a(t) o(yp) q(es.) 11 +2736 y(This) p 124 2736 a(w) o(a) o(y) p 224 2736 a(the) p +310 2736 a(second) p 469 2736 a(case) p 574 2736 a(w) o(ould) p +718 2736 a(still) p 814 2736 a(fail,) p 913 2736 a(since) p +Fe 1034 2736 a(x) p Fk 1077 2736 a(has) p 1166 2736 a(a) p +1208 2736 a(monorphic) p 1451 2736 a(t) o(yp) q(e.) p +1584 2736 a(This) p 1697 2736 a(solution) 11 2796 y(w) o(ould) p +153 2796 a(b) q(e) p 219 2796 a(correct) p 382 2796 a(and) p +477 2796 a(principal.) 926 2937 y(2) p eop +PStoPSsaved restore +%%Page: (2,3) 2 +userdict/PStoPSsaved save put +PStoPSmatrix setmatrix +595.000000 0.271378 translate +90 rotate +0.706651 dup scale +userdict/PStoPSmatrix matrix currentmatrix put +userdict/PStoPSclip{0 0 moveto + 595.000000 0 rlineto 0 842.000000 rlineto -595.000000 0 rlineto + closepath}put initclip +/showpage{}def/copypage{}def/erasepage{}def +PStoPSxform concat +3 2 bop Fk 84 168 a(Ho) o(w) o(ev) o(er,) p 293 168 a(one) p +382 168 a(can) p 472 168 a(easily) p 606 168 a(see) p +684 168 a(that) p 789 168 a(this) p 884 168 a(solution) p +1068 168 a(is) p 1117 168 a(coun) o(ter-in) o(tuitiv) o(e.) p +1504 168 a(F) l(or) p 1591 168 a(the) p 1675 168 a(user,) p +Fe 1791 168 a(b) p Fk 1833 168 a(is) 11 229 y(already) p +183 229 a(an) p 250 229 a(imp) q(ossible) p 488 229 a(constructor,) p +759 229 a(and) p 854 229 a(ha) o(ving) p 1011 229 a(a) p +1052 229 a(clash) p 1174 229 a(on) p 1242 229 a(it) p +1291 229 a(is) p 1340 229 a(hard) p 1453 229 a(to) p +1513 229 a(understand.) 84 289 y(Another) p 277 289 a(solution) p +463 289 a(is) p 514 289 a(to) p 575 289 a(go) p 642 289 +a(the) p 728 289 a(opp) q(osite) p 924 289 a(w) o(a) o(y) l(.) p +1044 289 a(T) l(o) p 1117 289 a(accept) p 1271 289 a(more) p +1395 289 a(programs.) p 1634 289 a(This) p 1747 289 a(is) p +1798 289 a(the) 11 349 y(w) o(a) o(y) p 109 349 a(w) o(e) p +181 349 a(explore) p 351 349 a(here,) p 470 349 a(with) p +581 349 a(an) p 649 349 a(unc) o(hanged) p 891 349 a(syn) o(tax.) p +Fi 11 479 a(T) n(yping) p Fk 11 571 a(The) p 114 571 +a(idea) p 220 571 a(is) p 273 571 a(to) p 336 571 a(dela) o(y) p +466 571 a(uni\014cation) p 711 571 a(on) p 782 571 a(constructor) p +1043 571 a(un) o(til) p 1161 571 a(they) p 1274 571 a(are) p +1359 571 a(explicitely) p 1595 571 a(kno) o(wn) p 1753 +571 a(to) p 1816 571 a(b) q(e) 11 631 y(presen) o(t.) p +199 631 a(W) l(e) p 280 631 a(k) o(eep) p 390 631 a(the) p +472 631 a(\() p Fg(T) t(;) p 546 631 a(U;) p 601 631 +a(L) p Fk(\)) p 666 631 a(represen) o(tation) p 983 631 +a(of) p 1036 631 a(v) m(arian) o(t) p 1200 631 a(t) o(yp) q(es,) p +1341 631 a(but) p Fg 1428 631 a(T) p Fk 1478 631 a(is) p +1525 631 a(no) p 1591 631 a(longer) p 1735 631 a(a) p +1774 631 a(map) 11 692 y(from) p 126 692 a(constructors) p +403 692 a(to) p 462 692 a(t) o(yp) q(es,) p 605 692 a(but) p +694 692 a(from) p 809 692 a(constructors) p 1086 692 +a(to) p 1146 692 a(sets) p 1241 692 a(of) p 1297 692 +a(t) o(yp) q(es.) 84 752 y(When) p 230 752 a(w) o(e) p +307 752 a(unify) p 436 752 a(t) o(w) o(o) p 532 752 a(v) m(arian) o(t) p +702 752 a(t) o(yp) q(es,) p 850 752 a(the) p 938 752 +a(\014rst) p 1043 752 a(step) p 1150 752 a(is) p 1204 +752 a(just) p 1305 752 a(to) p 1369 752 a(tak) o(e) p +1479 752 a(the) p 1567 752 a(union) p 1707 752 a(of) p +1767 752 a(b) q(oth) 11 812 y(t) o(yping) p 162 812 a(en) o(vironmen) o +(ts,) p 476 812 a(dropping) p 682 812 a(unnecessary) p +952 812 a(t) o(yp) q(es.) 204 932 y(\() p Fg(T) p Ff +252 939 a(1) p Fg 272 932 a(;) p 294 932 a(U) p Ff 327 +939 a(1) p Fg 346 932 a(;) p 368 932 a(L) p Ff 401 939 +a(1) p Fk 421 932 a(\)) p Fj 451 932 a(^) p Fk 495 932 +a(\() p Fg(T) p Ff 543 939 a(2) p Fg 563 932 a(;) p 585 +932 a(U) p Ff 618 939 a(2) p Fg 637 932 a(;) p 659 932 +a(L) p Ff 692 939 a(2) p Fk 712 932 a(\)) p 745 932 a(=) p +797 932 a(\(\() p Fg(T) p Ff 864 939 a(1) p Fj 883 932 +a(j) p Fb 897 939 a(U) p Fa 921 944 a(1) p Fd 938 939 +a(\\) p Fb(U) p Fa 986 944 a(2) p Fk 1005 932 a(\)) p +Fj 1035 932 a([) p Fk 1079 932 a(\() p Fg(T) p Ff 1127 +939 a(2) p Fj 1146 932 a(j) p Fb 1160 939 a(U) p Fa 1184 +944 a(1) p Fd 1201 939 a(\\) p Fb(U) p Fa 1249 944 a(2) p +Fk 1268 932 a(\)) p Fg(;) p 1309 932 a(U) p Ff 1342 939 +a(1) p Fj 1373 932 a(\\) p Fg 1417 932 a(U) p Ff 1450 +939 a(2) p Fg 1470 932 a(;) p 1492 932 a(L) p Ff 1525 +939 a(1) p Fj 1556 932 a([) p Fg 1600 932 a(L) p Ff 1633 +939 a(2) p Fk 1653 932 a(\)) 84 1042 y(Here) p 203 1042 +a(the) p 291 1042 a(union) p 431 1042 a(of) p 490 1042 +a(t) o(w) o(o) p 587 1042 a(t) o(yping) p 742 1042 a(en) o(vironmen) o +(ts) p 1046 1042 a(is) p 1099 1042 a(the) p 1187 1042 +a(p) q(oin) o(t) o(wise) p 1407 1042 a(union) p 1547 +1042 a(of) p 1606 1042 a(their) p 1727 1042 a(sets) p +1826 1042 a(of) 11 1102 y(t) o(yp) q(es) p 140 1102 a(for) p +214 1102 a(eac) o(h) p 324 1102 a(constructor.) 84 1162 +y(This) p 195 1162 a(\014rst) p 296 1162 a(step) p 399 +1162 a(nev) o(er) p 529 1162 a(fails.) 84 1222 y(In) p +145 1222 a(a) p 186 1222 a(second) p 343 1222 a(step,) p +460 1222 a(structural) p 685 1222 a(constrain) o(ts) p +934 1222 a(are) p 1015 1222 a(enforced) p 1209 1222 a(on) p +1277 1222 a(the) p 1361 1222 a(resulting) p 1562 1222 +a(t) o(yp) q(e) p 1672 1222 a(\() p Fg(T) t(;) p 1746 +1222 a(U;) p 1801 1222 a(L) p Fk(\).) 11 1282 y(First,) p +Fg 144 1282 a(L) p Fk 195 1282 a(should) p 351 1282 a(b) q(e) p +418 1282 a(included) p 614 1282 a(in) p Fg 672 1282 a(U) p +Fk 710 1282 a(.) p 749 1282 a(Then,) p 892 1282 a(for) p +967 1282 a(all) p 1036 1282 a(constructors) p 1314 1282 +a(app) q(earing) p 1542 1282 a(in) p Fg 1600 1282 a(L) p +Fk(,) p 1664 1282 a(the) p 1749 1282 a(set) p 1826 1282 +a(of) 11 1343 y(t) o(yp) q(es) p 136 1343 a(asso) q(ciated) p +365 1343 a(with) p 472 1343 a(eac) o(h) p 578 1343 a(constructor) p +833 1343 a(is) p 878 1343 a(collapsed) p 1084 1343 a(b) o(y) p +1148 1343 a(uni\014cation.) p 1407 1343 a(This) p 1515 +1343 a(can) p 1600 1343 a(b) q(e) p 1663 1343 a(expressed) 11 +1403 y(b) o(y) p 78 1403 a(rewriting) p 287 1403 a(rules,) p +417 1403 a(where) p Fg 558 1403 a(e) p Fk 597 1403 a(is) p +646 1403 a(a) p 687 1403 a(m) o(ulti-equation) p 1015 +1403 a(and) p Fg 1109 1403 a(\036) p Fk 1155 1403 a(a) p +1195 1403 a(set) p 1271 1403 a(of) p 1327 1403 a(m) o(ultiequations) 249 +1509 y(if) p Fg 294 1509 a(L) p Fj 341 1509 a(6\032) p +Fg 393 1509 a(U) p Fk 448 1509 a(then) p 559 1509 a(\() p +Fg(T) t(;) p 633 1509 a(U;) p 688 1509 a(L) p Fk(\)) p +753 1509 a(=) p Fg 805 1509 a(e) p Fj 839 1509 a(^) p +Fg 883 1509 a(\036) p Fj 926 1509 a(\000) p 956 1509 +a(!) p 1020 1509 a(?) p Fk 249 1629 a(if) p Fg 294 1629 +a(l) p Fj 323 1629 a(2) p Fg 370 1629 a(L) p Fk 420 1629 +a(and) p Fg 515 1629 a(T) p Fk 551 1629 a(\() p Fg(l) p +Fk 586 1629 a(\)) p 617 1629 a(=) p Fj 669 1629 a(f) p +Fg(\034) p Ff 715 1636 a(1) p Fg 735 1629 a(;) p 757 +1629 a(:) p 779 1629 a(:) p 801 1629 a(:) p 822 1629 +a(;) p 844 1629 a(\034) p Fb 865 1636 a(n) p Fj 889 1629 +a(g) p Fk 930 1629 a(then) 298 1689 y(\() p Fg(T) t(;) p +372 1689 a(U;) p 427 1689 a(L) p Fk(\)) p 492 1689 a(=) p +Fg 544 1689 a(e) p Fj 577 1689 a(^) p Fg 622 1689 a(\036) p +Fj 664 1689 a(\000) p 695 1689 a(!) p Fk 759 1689 a(\() p +Fg(T) p Fj 814 1689 a(f) p Fg(l) p Fj 867 1689 a(7!) p +Fg 931 1689 a(\034) p Ff 952 1696 a(1) p Fj 972 1689 +a(g) p Fg(;) p 1019 1689 a(U;) p 1074 1689 a(L) p Fk(\)) p +1139 1689 a(=) p Fg 1191 1689 a(e) p Fj 1225 1689 a(^) p +Fg 1269 1689 a(\034) p Ff 1290 1696 a(1) p Fk 1324 1689 +a(=) p Fg 1376 1689 a(:) p 1398 1689 a(:) p 1420 1689 +a(:) p Fk 1447 1689 a(=) p Fg 1498 1689 a(\034) p Fb +1519 1696 a(n) p Fj 1554 1689 a(^) p Fg 1598 1689 a(\036) p +Fk 84 1796 a(Optionally) p 331 1796 a(one) p 425 1796 +a(can) p 519 1796 a(add) p 619 1796 a(rules) p 740 1796 +a(that) p 850 1796 a(remo) o(v) o(e) p 1022 1796 a(a) p +1067 1796 a(constructor) p Fg 1329 1796 a(l) p Fk 1366 +1796 a(from) p Fg 1486 1796 a(U) p Fk 1545 1796 a(if) p +1594 1796 a(the) p 1683 1796 a(equation) 11 1856 y(obtained) p +211 1856 a(from) p Fg 326 1856 a(T) p Fk 362 1856 a(\() p +Fg(l) p Fk 397 1856 a(\)) p 431 1856 a(has) p 518 1856 +a(no) p 586 1856 a(solution.) p 790 1856 a(Suc) o(h) p +908 1856 a(rules) p 1024 1856 a(w) o(ould) p 1167 1856 +a(b) q(e) p 1233 1856 a(sound) p 1374 1856 a(and) p 1469 +1856 a(complete.) p Fi 11 1986 a(Syn) n(tax) p 198 1986 +a(of) p 262 1986 a(t) n(yp) r(es) p Fk 11 2078 a(Thanks) p +188 2078 a(to) p 250 2078 a(the) p 336 2078 a(go) q(o) q(d) p +458 2078 a(prop) q(erties) p 689 2078 a(of) p 747 2078 +a(these) p 874 2078 a(constrain) o(ts,) p 1139 2078 a(the) p +1226 2078 a(surface) p 1392 2078 a(syn) o(tax) p 1551 +2078 a(of) p 1608 2078 a(t) o(yp) q(es) p 1740 2078 a(w) o(ould) 11 +2138 y(only) p 118 2138 a(ha) o(v) o(e) p 230 2138 a(to) p +290 2138 a(b) q(e) p 356 2138 a(sligh) o(tly) p 527 2138 +a(extended.) p Fh 590 2244 a(tag-typ) n(e) p Fk 798 2244 +a(::=) p Fh 904 2244 a(ident) p Fj 849 2304 a(j) p Fh +904 2304 a(ident) p Fe 1031 2304 a(\() p Fh(typ) n(expr-list) p +Fe(\)) p Fh 523 2365 a(typ) n(expr-list) p Fk 798 2365 +a(::=) p Fh 904 2365 a(typ) n(expr) p Fj 849 2425 a(j) p +Fh 904 2425 a(typ) n(expr) p Fe 1078 2425 a(&) p Fh 1120 +2425 a(typ) n(expr-list) p Fk 84 2531 a(Notice) p 234 +2531 a(that) p 336 2531 a(a) p 373 2531 a(0-ary) p 496 +2531 a(constructor) p 751 2531 a(and) p 842 2531 a(an) p +907 2531 a(1-ary) p 1030 2531 a(construtor) p 1262 2531 +a(are) p 1340 2531 a(con) o(tradictory) l(,) p 1648 2531 +a(and) p 1740 2531 a(w) o(ould) 11 2592 y(result) p 146 +2592 a(in) p 203 2592 a(the) p 287 2592 a(absence) p +466 2592 a(of) p 522 2592 a(this) p 617 2592 a(constructor.) 926 +2937 y(3) p eop +PStoPSsaved restore +userdict/PStoPSsaved save put +PStoPSmatrix setmatrix +595.000000 421.271378 translate +90 rotate +0.706651 dup scale +userdict/PStoPSmatrix matrix currentmatrix put +userdict/PStoPSclip{0 0 moveto + 595.000000 0 rlineto 0 842.000000 rlineto -595.000000 0 rlineto + closepath}put initclip +PStoPSxform concat +4 3 bop Fi 11 168 a(Discussion) p Fk 11 261 a(Suc) o(h) p +133 261 a(a) p 179 261 a(c) o(hange) p 345 261 a(has) p +436 261 a(the) p 525 261 a(ma) s(jor) p 672 261 a(adv) m(an) o(tage) p +907 261 a(of) p 967 261 a(b) q(oth) p 1087 261 a(reco) o(v) o(ering) p +1324 261 a(principalit) o(y) p 1589 261 a(and) p 1688 +261 a(a) o(v) o(oiding) 11 321 y(unin) o(tuitiv) o(e) p +266 321 a(error) p 392 321 a(messages.) p 640 321 a(Constrain) o(ts) p +909 321 a(created) p 1087 321 a(in) p 1152 321 a(suc) o(h) p +1269 321 a(a) p 1317 321 a(w) o(a) o(y) p 1423 321 a(are) p +1512 321 a(v) o(ery) p 1626 321 a(ligh) o(t:) p 1772 +321 a(they) 11 381 y(alw) o(a) o(ys) p 165 381 a(app) q(ear) p +325 381 a(inside) p 463 381 a(a) p 502 381 a(v) m(arian) o(t) p +666 381 a(t) o(yp) q(e,) p 788 381 a(and) p 882 381 a(if) p +926 381 a(the) p 1008 381 a(v) m(arian) o(t) p 1172 381 +a(t) o(yp) q(e) p 1281 381 a(do) q(es) p 1390 381 a(not) p +1475 381 a(app) q(ear) p 1635 381 a(in) p 1691 381 a(the) p +1774 381 a(\014nal) 11 441 y(t) o(yp) q(e) p 120 441 +a(sc) o(heme,) p 301 441 a(then) p 412 441 a(the) p 496 +441 a(constrain) o(t) p 725 441 a(can) p 815 441 a(b) q(e) p +881 441 a(discarded) p 1098 441 a(safely) l(.) 84 501 +y(On) p 165 501 a(the) p 249 501 a(other) p 376 501 a(hand,) p +512 501 a(there) p 637 501 a(are) p 718 501 a(t) o(w) o(o) p +810 501 a(dra) o(wbac) o(ks.) p Fj 83 616 a(\017) p Fk +133 616 a(Some) p 259 616 a(errors) p 393 616 a(will) p +482 616 a(b) q(e) p 544 616 a(dela) o(y) o(ed) p 715 +616 a(longer) p 858 616 a(than) p 968 616 a(no) o(w,) p +1080 616 a(un) o(til) p 1191 616 a(a) p 1228 616 a(construtor) p +1460 616 a(is) p 1505 616 a(actually) p 1687 616 a(included) 133 +676 y(in) p Fg 189 676 a(L) p Fk(.) p 258 676 a(It) p +311 676 a(is) p 360 676 a(not) p 446 676 a(clear) p 563 +676 a(ho) o(w) p 665 676 a(damageable) p 930 676 a(it) p +979 676 a(is.) p Fj 83 777 a(\017) p Fk 133 777 a(While) p +272 777 a(t) o(yp) q(e) p 378 777 a(inference) p 579 +777 a(is) p 625 777 a(simple) p 774 777 a(and) p 865 +777 a(costless) p 1036 777 a(for) p 1108 777 a(this) p +1200 777 a(extension,) p 1426 777 a(simpli\014cation) p +1724 777 a(of) p 1776 777 a(con-) 133 838 y(strain) o(ts) p +310 838 a(|marking) p 551 838 a(constructors) p 830 838 +a(with) p 943 838 a(unsolv) m(able) p 1182 838 a(constrain) o(ts) p +1432 838 a(as) p 1494 838 a(absen) o(t,) p 1663 838 a(and) p +1760 838 a(elim-) 133 898 y(inating) p 300 898 a(redundan) o(t) p +536 898 a(t) o(yp) q(es) p 667 898 a(in) p 726 898 a(constrain) o(ts|) p +1025 898 a(is) p 1076 898 a(a) p 1119 898 a(bit) p 1197 +898 a(more) p 1320 898 a(exp) q(ensiv) o(e.) p 1565 898 +a(Also,) p 1691 898 a(allo) o(wing) 133 958 y(suc) o(h) p +244 958 a(constrained) p 506 958 a(t) o(yp) q(es) p 637 +958 a(inside) p 777 958 a(signatures) p 1010 958 a(w) o(ould) p +1154 958 a(mean) p 1286 958 a(ha) o(ving) p 1444 958 +a(to) p 1506 958 a(solv) o(e) p 1627 958 a(a) p 1669 +958 a(matc) o(hing) 133 1018 y(problem,) p 333 1018 a(whic) o(h) p +469 1018 a(is) p 514 1018 a(exp) q(onen) o(tial) p 772 +1018 a(in) p 825 1018 a(the) p 906 1018 a(n) o(um) o(b) q(er) p +1080 1018 a(of) p 1132 1018 a(connected) p 1356 1018 +a(constrain) o(ts) p 1600 1018 a(inside) p 1735 1018 +a(a) p 1772 1018 a(t) o(yp) q(e) 133 1078 y(sc) o(heme.) 84 +1193 y(Reasonably) p 340 1193 a(e\016cien) o(t) p 516 +1193 a(algorithms) p 754 1193 a(exist) p 866 1193 a(to) p +922 1193 a(solv) o(e) p 1038 1193 a(these) p 1159 1193 +a(problems,) p 1379 1193 a(so) p 1435 1193 a(the) p 1515 +1193 a(di\016cult) o(y) p 1715 1193 a(is) p 1760 1193 +a(more) 11 1253 y(in) p 67 1253 a(the) p 151 1253 a(increased) p +363 1253 a(complexit) o(y) p 611 1253 a(of) p 667 1253 +a(the) p 751 1253 a(t) o(yp) q(e-c) o(hec) o(k) o(er) p +1031 1253 a(than) p 1145 1253 a(in) p 1202 1253 a(run-time) p +1402 1253 a(cost.) p Fl 11 1397 a(Other) p 205 1397 a(features) p +Fk 11 1490 a(Ob) s(jectiv) o(e) p 238 1490 a(Lab) q(el) p +380 1490 a(con) o(tains) p 579 1490 a(t) o(w) o(o) p +678 1490 a(other) p 812 1490 a(features:) p 1029 1490 +a(p) q(olymorphic) p 1318 1490 a(metho) q(ds) p 1521 +1490 a(and) p 1623 1490 a(t) o(yp) q(e-driv) o(en) 11 +1550 y(access) p 153 1550 a(of) p 208 1550 a(records.) p +394 1550 a(Both) p 514 1550 a(of) p 568 1550 a(them) p +692 1550 a(use) p 775 1550 a(the) p 857 1550 a(same) p +978 1550 a(metho) q(d) p 1154 1550 a(of) p 1209 1550 +a(enforcing) p 1417 1550 a(principalit) o(y) p 1676 1550 +a(of) p 1730 1550 a(t) o(yping) 11 1610 y(through) p +191 1610 a(tracing) p 351 1610 a(user) p 450 1610 a(pro) o(vided) p +647 1610 a(t) o(yp) q(e) p 752 1610 a(information.) p +1034 1610 a(With) p 1155 1610 a(this) p 1246 1610 a(tracing,) p +1422 1610 a(their) p 1534 1610 a(implem) o(en) n(tation) 11 +1670 y(is) p 60 1670 a(v) o(ery) p 167 1670 a(easy) l(,) p +283 1670 a(but) p 373 1670 a(without) p 554 1670 a(it) p +603 1670 a(they) p 713 1670 a(lo) q(ose) p 834 1670 a(principalit) o(y) +l(.) 84 1730 y(While) p 229 1730 a(these) p 357 1730 +a(features) p 543 1730 a(pro) o(vide) p 720 1730 a(some) p +845 1730 a(comfort) p 1029 1730 a(in) p 1089 1730 a(writing) p +1260 1730 a(user) p 1366 1730 a(programs,) p 1598 1730 +a(they) p 1711 1730 a(are) p 1795 1730 a(not) 11 1791 +y(strictly) p 182 1791 a(necessary) p 403 1791 a(for) p +482 1791 a(the) p 571 1791 a(v) m(arious) p 742 1791 +a(libraries) p 934 1791 a(coming) p 1107 1791 a(with) p +1223 1791 a(O'Labl) p 1391 1791 a(\(LablTk,) p 1602 1791 +a(LablGL) p 1787 1791 a(and) 11 1851 y(LablGTK\).) 926 +2937 y(4) p eop +PStoPSsaved restore +%%Trailer +end +userdict /end-hook known{end-hook}if +%%EOF diff --git a/experimental/garrigue/nongeneral-let.diff b/experimental/garrigue/nongeneral-let.diff new file mode 100644 index 00000000..bcdc69e8 --- /dev/null +++ b/experimental/garrigue/nongeneral-let.diff @@ -0,0 +1,428 @@ +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 "\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 "
  • %s
    • \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; diff --git a/experimental/garrigue/objvariant.diff b/experimental/garrigue/objvariant.diff new file mode 100644 index 00000000..75deb24c --- /dev/null +++ b/experimental/garrigue/objvariant.diff @@ -0,0 +1,354 @@ +? objvariants-3.09.1.diffs +? objvariants.diffs +Index: btype.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/btype.ml,v +retrieving revision 1.37.4.1 +diff -u -r1.37.4.1 btype.ml +--- btype.ml 5 Dec 2005 13:18:42 -0000 1.37.4.1 ++++ btype.ml 16 Jan 2006 02:23:14 -0000 +@@ -177,7 +177,8 @@ + Tvariant row -> iter_row f row + | Tvar | Tunivar | Tsubst _ | Tconstr _ -> + Misc.may (fun (_,l) -> List.iter f l) row.row_name; +- List.iter f row.row_bound ++ List.iter f row.row_bound; ++ List.iter (fun (s,k,t) -> f t) row.row_object + | _ -> assert false + + let iter_type_expr f ty = +@@ -224,7 +225,9 @@ + | Some (path, tl) -> Some (path, List.map f tl) in + { row_fields = fields; row_more = more; + row_bound = !bound; row_fixed = row.row_fixed && fixed; +- row_closed = row.row_closed; row_name = name; } ++ row_closed = row.row_closed; row_name = name; ++ row_object = List.map (fun (s,k,t) -> (s,k,f t)) row.row_object; ++ } + + let rec copy_kind = function + Fvar{contents = Some k} -> copy_kind k +Index: ctype.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/ctype.ml,v +retrieving revision 1.197.2.6 +diff -u -r1.197.2.6 ctype.ml +--- ctype.ml 15 Dec 2005 02:28:38 -0000 1.197.2.6 ++++ ctype.ml 16 Jan 2006 02:23:15 -0000 +@@ -1421,7 +1421,7 @@ + newgenty + (Tvariant + {row_fields = fields; row_closed = closed; row_more = newvar(); +- row_bound = []; row_fixed = false; row_name = None }) ++ row_bound = []; row_fixed = false; row_name = None; row_object=[]}) + + (**** Unification ****) + +@@ -1724,8 +1724,11 @@ + else None + in + let bound = row1.row_bound @ row2.row_bound in ++ let opairs, _, miss2 = associate_fields row1.row_object row2.row_object in ++ let row_object = row1.row_object @ miss2 in + let row0 = {row_fields = []; row_more = more; row_bound = bound; +- row_closed = closed; row_fixed = fixed; row_name = name} in ++ row_closed = closed; row_fixed = fixed; row_name = name; ++ row_object = row_object } in + let set_more row rest = + let rest = + if closed then +@@ -1758,6 +1761,18 @@ + raise (Unify ((mkvariant [l,f1] true, + mkvariant [l,f2] true) :: trace))) + pairs; ++ List.iter (fun (s,_,ty1,_,ty2) -> unify env ty1 ty2) opairs; ++ if row_object <> [] then begin ++ List.iter ++ (fun (l,f) -> ++ match row_field_repr f with ++ Rpresent (Some ty) -> ++ let fi = build_fields generic_level row_object (newgenvar()) in ++ unify env (newgenty (Tobject (fi, ref None))) ty ++ | Rpresent None -> raise (Unify []) ++ | _ -> ()) ++ (row_repr row1).row_fields ++ end; + with exn -> + log_type rm1; rm1.desc <- md1; log_type rm2; rm2.desc <- md2; raise exn + end +@@ -2789,7 +2804,8 @@ + let row = + { row_fields = List.map fst fields; row_more = newvar(); + row_bound = !bound; row_closed = posi; row_fixed = false; +- row_name = if c > Unchanged then None else row.row_name } ++ row_name = if c > Unchanged then None else row.row_name; ++ row_object = [] } + in + (newty (Tvariant row), Changed) + | Tobject (t1, _) -> +Index: oprint.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/oprint.ml,v +retrieving revision 1.22 +diff -u -r1.22 oprint.ml +--- oprint.ml 23 Mar 2005 03:08:37 -0000 1.22 ++++ oprint.ml 16 Jan 2006 02:23:15 -0000 +@@ -185,7 +185,7 @@ + fprintf ppf "@[<2>< %a >@]" (print_fields rest) fields + | Otyp_stuff s -> fprintf ppf "%s" s + | Otyp_var (ng, s) -> fprintf ppf "'%s%s" (if ng then "_" else "") s +- | Otyp_variant (non_gen, row_fields, closed, tags) -> ++ | Otyp_variant (non_gen, row_fields, closed, tags, obj) -> + let print_present ppf = + function + None | Some [] -> () +@@ -198,12 +198,17 @@ + ppf fields + | Ovar_name (id, tyl) -> + fprintf ppf "@[%a%a@]" print_typargs tyl print_ident id ++ and print_object ppf obj = ++ if obj <> [] then ++ fprintf ppf "@ as @[<2>< %a >@]" (print_fields (Some false)) obj + in +- fprintf ppf "%s[%s@[@[%a@]%a ]@]" (if non_gen then "_" else "") ++ fprintf ppf "%s[%s@[@[%a@]%a%a ]@]" ++ (if non_gen then "_" else "") + (if closed then if tags = None then " " else "< " + else if tags = None then "> " else "? ") + print_fields row_fields + print_present tags ++ print_object obj + | Otyp_alias _ | Otyp_poly _ | Otyp_arrow _ | Otyp_tuple _ as ty -> + fprintf ppf "@[<1>(%a)@]" print_out_type ty + | Otyp_abstract | Otyp_sum _ | Otyp_record _ | Otyp_manifest (_, _) -> () +Index: outcometree.mli +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/outcometree.mli,v +retrieving revision 1.14 +diff -u -r1.14 outcometree.mli +--- outcometree.mli 23 Mar 2005 03:08:37 -0000 1.14 ++++ outcometree.mli 16 Jan 2006 02:23:15 -0000 +@@ -59,6 +59,7 @@ + | Otyp_var of bool * string + | Otyp_variant of + bool * out_variant * bool * (string list) option ++ * (string * out_type) list + | Otyp_poly of string list * out_type + and out_variant = + | Ovar_fields of (string * bool * out_type list) list +Index: printtyp.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/printtyp.ml,v +retrieving revision 1.139.2.2 +diff -u -r1.139.2.2 printtyp.ml +--- printtyp.ml 7 Dec 2005 23:37:27 -0000 1.139.2.2 ++++ printtyp.ml 16 Jan 2006 02:23:15 -0000 +@@ -244,7 +244,10 @@ + visited_objects := px :: !visited_objects; + match row.row_name with + | Some(p, tyl) when namable_row row -> +- List.iter (mark_loops_rec visited) tyl ++ List.iter (mark_loops_rec visited) tyl; ++ if not (static_row row) then ++ List.iter (fun (s,k,t) -> mark_loops_rec visited t) ++ row.row_object + | _ -> + iter_row (mark_loops_rec visited) {row with row_bound = []} + end +@@ -343,25 +346,27 @@ + | _ -> false) + fields in + let all_present = List.length present = List.length fields in ++ let static = row.row_closed && all_present in ++ let obj = ++ if static then [] else ++ List.map (fun (s,k,t) -> (s, tree_of_typexp sch t)) row.row_object ++ in ++ let tags = if all_present then None else Some (List.map fst present) in + begin match row.row_name with + | Some(p, tyl) when namable_row row -> + let id = tree_of_path p in + let args = tree_of_typlist sch tyl in +- if row.row_closed && all_present then ++ if static then + Otyp_constr (id, args) + else + let non_gen = is_non_gen sch px in +- let tags = +- if all_present then None else Some (List.map fst present) in + Otyp_variant (non_gen, Ovar_name(tree_of_path p, args), +- row.row_closed, tags) ++ row.row_closed, tags, obj) + | _ -> +- let non_gen = +- not (row.row_closed && all_present) && is_non_gen sch px in ++ let non_gen = not static && is_non_gen sch px in + let fields = List.map (tree_of_row_field sch) fields in +- let tags = +- if all_present then None else Some (List.map fst present) in +- Otyp_variant (non_gen, Ovar_fields fields, row.row_closed, tags) ++ Otyp_variant (non_gen, Ovar_fields fields, row.row_closed, ++ tags, obj) + end + | Tobject (fi, nm) -> + tree_of_typobject sch fi nm +Index: typecore.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/typecore.ml,v +retrieving revision 1.176.2.2 +diff -u -r1.176.2.2 typecore.ml +--- typecore.ml 11 Dec 2005 09:56:33 -0000 1.176.2.2 ++++ typecore.ml 16 Jan 2006 02:23:15 -0000 +@@ -170,7 +170,8 @@ + (* Force check of well-formedness *) + unify_pat pat.pat_env pat + (newty(Tvariant{row_fields=[]; row_more=newvar(); row_closed=false; +- row_bound=[]; row_fixed=false; row_name=None})); ++ row_bound=[]; row_fixed=false; row_name=None; ++ row_object=[]})); + | _ -> () + + let rec iter_pattern f p = +@@ -251,7 +252,7 @@ + let ty = may_map (build_as_type env) p' in + newty (Tvariant{row_fields=[l, Rpresent ty]; row_more=newvar(); + row_bound=[]; row_name=None; +- row_fixed=false; row_closed=false}) ++ row_fixed=false; row_closed=false; row_object=[]}) + | Tpat_record lpl -> + let lbl = fst(List.hd lpl) in + if lbl.lbl_private = Private then p.pat_type else +@@ -318,7 +319,8 @@ + ([],[]) fields in + let row = + { row_fields = List.rev fields; row_more = newvar(); row_bound = !bound; +- row_closed = false; row_fixed = false; row_name = Some (path, tyl) } ++ row_closed = false; row_fixed = false; row_name = Some (path, tyl); ++ row_object = [] } + in + let ty = newty (Tvariant row) in + let gloc = {loc with Location.loc_ghost=true} in +@@ -428,7 +430,8 @@ + row_closed = false; + row_more = newvar (); + row_fixed = false; +- row_name = None } in ++ row_name = None; ++ row_object = [] } in + rp { + pat_desc = Tpat_variant(l, arg, row); + pat_loc = sp.ppat_loc; +@@ -976,7 +979,8 @@ + row_bound = []; + row_closed = false; + row_fixed = false; +- row_name = None}); ++ row_name = None; ++ row_object = []}); + exp_env = env } + | Pexp_record(lid_sexp_list, opt_sexp) -> + let ty = newvar() in +@@ -1261,8 +1265,30 @@ + assert false + end + | _ -> +- (Texp_send(obj, Tmeth_name met), +- filter_method env met Public obj.exp_type) ++ let obj, met_ty = ++ match expand_head env obj.exp_type with ++ {desc = Tvariant _} -> ++ let exp_ty = newvar () in ++ let met_ty = filter_method env met Public exp_ty in ++ let row = ++ {row_fields=[]; row_more=newvar(); ++ row_bound=[]; row_closed=false; ++ row_fixed=false; row_name=None; ++ row_object=[met, Fpresent, met_ty]} in ++ unify_exp env obj (newty (Tvariant row)); ++ let prim = Primitive.parse_declaration 1 ["%field1"] in ++ let ty = newty(Tarrow("", obj.exp_type, exp_ty, Cok)) in ++ let vd = {val_type = ty; val_kind = Val_prim prim} in ++ let esnd = ++ {exp_desc=Texp_ident(Path.Pident(Ident.create"snd"), vd); ++ exp_loc = Location.none; exp_type = ty; exp_env = env} ++ in ++ ({obj with exp_type = exp_ty; ++ exp_desc = Texp_apply(esnd,[Some obj, Required])}, ++ met_ty) ++ | _ -> (obj, filter_method env met Public obj.exp_type) ++ in ++ (Texp_send(obj, Tmeth_name met), met_ty) + in + if !Clflags.principal then begin + end_def (); +Index: types.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/types.ml,v +retrieving revision 1.25 +diff -u -r1.25 types.ml +--- types.ml 9 Dec 2004 12:40:53 -0000 1.25 ++++ types.ml 16 Jan 2006 02:23:15 -0000 +@@ -44,7 +44,9 @@ + row_bound: type_expr list; + row_closed: bool; + row_fixed: bool; +- row_name: (Path.t * type_expr list) option } ++ row_name: (Path.t * type_expr list) option; ++ row_object: (string * field_kind * type_expr) list; ++ } + + and row_field = + Rpresent of type_expr option +Index: types.mli +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/types.mli,v +retrieving revision 1.25 +diff -u -r1.25 types.mli +--- types.mli 9 Dec 2004 12:40:53 -0000 1.25 ++++ types.mli 16 Jan 2006 02:23:15 -0000 +@@ -43,7 +43,9 @@ + row_bound: type_expr list; + row_closed: bool; + row_fixed: bool; +- row_name: (Path.t * type_expr list) option } ++ row_name: (Path.t * type_expr list) option; ++ row_object: (string * field_kind * type_expr) list; ++ } + + and row_field = + Rpresent of type_expr option +Index: typetexp.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/typetexp.ml,v +retrieving revision 1.54 +diff -u -r1.54 typetexp.ml +--- typetexp.ml 22 Jul 2005 06:42:36 -0000 1.54 ++++ typetexp.ml 16 Jan 2006 02:23:15 -0000 +@@ -215,7 +215,8 @@ + in + let row = { row_closed = true; row_fields = fields; + row_bound = !bound; row_name = Some (path, args); +- row_fixed = false; row_more = newvar () } in ++ row_fixed = false; row_more = newvar (); ++ row_object = [] } in + let static = Btype.static_row row in + let row = + if static then row else +@@ -262,7 +263,7 @@ + let mkfield l f = + newty (Tvariant {row_fields=[l,f]; row_more=newvar(); + row_bound=[]; row_closed=true; +- row_fixed=false; row_name=None}) in ++ row_fixed=false; row_name=None; row_object=[]}) in + let add_typed_field loc l f fields = + try + let f' = List.assoc l fields in +@@ -345,7 +346,7 @@ + let row = + { row_fields = List.rev fields; row_more = newvar (); + row_bound = !bound; row_closed = closed; +- row_fixed = false; row_name = !name } in ++ row_fixed = false; row_name = !name; row_object = [] } in + let static = Btype.static_row row in + let row = + if static then row else diff --git a/experimental/garrigue/objvariant.ml b/experimental/garrigue/objvariant.ml new file mode 100644 index 00000000..3233e03c --- /dev/null +++ b/experimental/garrigue/objvariant.ml @@ -0,0 +1,42 @@ +(* use with [cvs update -r objvariants typing] *) + +let f (x : [> ]) = x#m 3;; +let o = object method m x = x+2 end;; +f (`A o);; +let l = [`A o; `B(object method m x = x -2 method y = 3 end)];; +List.map f l;; +let g = function `A x -> x#m 3 | `B x -> x#y;; +List.map g l;; +fun x -> ignore (x=f); List.map x l;; +fun (x : [< `A of _ | `B of _] -> int) -> ignore (x=f); List.map x l;; + + +class cvar name = + object + method name = name + method print ppf = Format.pp_print_string ppf name + end + +type var = [`Var of cvar] + +class cint n = + object + method n = n + method print ppf = Format.pp_print_int ppf n + end + +class ['a] cadd (e1 : 'a) (e2 : 'a) = + object + constraint 'a = [> ] + method e1 = e1 + method e2 = e2 + method print ppf = Format.fprintf ppf "(%t, %t)" e1#print e2#print + end + +type 'a expr = [var | `Int of cint | `Add of 'a cadd] + +type expr1 = expr1 expr + +let print = Format.printf "%t@." + +let e1 : expr1 = `Add (new cadd (`Var (new cvar "x")) (`Int (new cint 2))) diff --git a/experimental/garrigue/parser-lessminus.diff b/experimental/garrigue/parser-lessminus.diff new file mode 100644 index 00000000..7b535307 --- /dev/null +++ b/experimental/garrigue/parser-lessminus.diff @@ -0,0 +1,77 @@ +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 diff --git a/experimental/garrigue/pattern-local-types.diff b/experimental/garrigue/pattern-local-types.diff new file mode 100644 index 00000000..0e6f00a2 --- /dev/null +++ b/experimental/garrigue/pattern-local-types.diff @@ -0,0 +1,467 @@ +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 = + # val g : 'a ty -> 'a = ++# - : unit -> unit list = ++# - : 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 = ++# 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 = + # val g : 'a ty -> 'a = ++# - : unit -> unit list = ++# - : 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 = ++# 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 "\n"; ++ list (i+1) string ppf l; + pattern (i+1) ppf p; + expression (i+1) ppf e; + diff --git a/experimental/garrigue/printers.ml b/experimental/garrigue/printers.ml new file mode 100644 index 00000000..c80c42d6 --- /dev/null +++ b/experimental/garrigue/printers.ml @@ -0,0 +1,11 @@ +(* $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 diff --git a/experimental/garrigue/propagation-to-patterns.diff b/experimental/garrigue/propagation-to-patterns.diff new file mode 100644 index 00000000..642d986f --- /dev/null +++ b/experimental/garrigue/propagation-to-patterns.diff @@ -0,0 +1,212 @@ +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 + ^ diff --git a/experimental/garrigue/show_types.diff b/experimental/garrigue/show_types.diff new file mode 100644 index 00000000..f59105ee --- /dev/null +++ b/experimental/garrigue/show_types.diff @@ -0,0 +1,419 @@ +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 diff --git a/experimental/garrigue/tests.ml b/experimental/garrigue/tests.ml new file mode 100644 index 00000000..c39d152f --- /dev/null +++ b/experimental/garrigue/tests.ml @@ -0,0 +1,22 @@ +(* $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" diff --git a/experimental/garrigue/valvirt.diff b/experimental/garrigue/valvirt.diff new file mode 100644 index 00000000..2cf55742 --- /dev/null +++ b/experimental/garrigue/valvirt.diff @@ -0,0 +1,2349 @@ +Index: utils/warnings.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/utils/warnings.ml,v +retrieving revision 1.23 +diff -u -r1.23 warnings.ml +--- utils/warnings.ml 15 Sep 2005 03:09:26 -0000 1.23 ++++ utils/warnings.ml 5 Apr 2006 02:25:59 -0000 +@@ -26,7 +26,7 @@ + | Statement_type (* S *) + | Unused_match (* U *) + | Unused_pat +- | Hide_instance_variable of string (* V *) ++ | Instance_variable_override of string (* V *) + | Illegal_backslash (* X *) + | Implicit_public_methods of string list + | Unerasable_optional_argument +@@ -54,7 +54,7 @@ + | Statement_type -> 's' + | Unused_match + | Unused_pat -> 'u' +- | Hide_instance_variable _ -> 'v' ++ | Instance_variable_override _ -> 'v' + | Illegal_backslash + | Implicit_public_methods _ + | Unerasable_optional_argument +@@ -126,9 +126,9 @@ + String.concat " " + ("the following methods are overridden \ + by the inherited class:\n " :: slist) +- | Hide_instance_variable lab -> +- "this definition of an instance variable " ^ lab ^ +- " hides a previously\ndefined instance variable of the same name." ++ | Instance_variable_override lab -> ++ "the instance variable " ^ lab ^ " is overridden.\n" ^ ++ "The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)" + | Partial_application -> + "this function application is partial,\n\ + maybe some arguments are missing." +Index: utils/warnings.mli +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/utils/warnings.mli,v +retrieving revision 1.16 +diff -u -r1.16 warnings.mli +--- utils/warnings.mli 15 Sep 2005 03:09:26 -0000 1.16 ++++ utils/warnings.mli 5 Apr 2006 02:25:59 -0000 +@@ -26,7 +26,7 @@ + | Statement_type (* S *) + | Unused_match (* U *) + | Unused_pat +- | Hide_instance_variable of string (* V *) ++ | Instance_variable_override of string (* V *) + | Illegal_backslash (* X *) + | Implicit_public_methods of string list + | Unerasable_optional_argument +Index: parsing/parser.mly +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/parsing/parser.mly,v +retrieving revision 1.123 +diff -u -r1.123 parser.mly +--- parsing/parser.mly 23 Mar 2005 03:08:37 -0000 1.123 ++++ parsing/parser.mly 5 Apr 2006 02:25:59 -0000 +@@ -623,6 +623,8 @@ + { [] } + | class_fields INHERIT class_expr parent_binder + { Pcf_inher ($3, $4) :: $1 } ++ | class_fields VAL virtual_value ++ { Pcf_valvirt $3 :: $1 } + | class_fields VAL value + { Pcf_val $3 :: $1 } + | class_fields virtual_method +@@ -638,14 +640,20 @@ + AS LIDENT + { Some $2 } + | /* empty */ +- {None} ++ { None } ++; ++virtual_value: ++ MUTABLE VIRTUAL label COLON core_type ++ { $3, Mutable, $5, symbol_rloc () } ++ | VIRTUAL mutable_flag label COLON core_type ++ { $3, $2, $5, symbol_rloc () } + ; + value: +- mutable_flag label EQUAL seq_expr +- { $2, $1, $4, symbol_rloc () } +- | mutable_flag label type_constraint EQUAL seq_expr +- { $2, $1, (let (t, t') = $3 in ghexp(Pexp_constraint($5, t, t'))), +- symbol_rloc () } ++ mutable_flag label EQUAL seq_expr ++ { $2, $1, $4, symbol_rloc () } ++ | mutable_flag label type_constraint EQUAL seq_expr ++ { $2, $1, (let (t, t') = $3 in ghexp(Pexp_constraint($5, t, t'))), ++ symbol_rloc () } + ; + virtual_method: + METHOD PRIVATE VIRTUAL label COLON poly_type +@@ -711,8 +719,12 @@ + | class_sig_fields CONSTRAINT constrain { Pctf_cstr $3 :: $1 } + ; + value_type: +- mutable_flag label COLON core_type +- { $2, $1, Some $4, symbol_rloc () } ++ VIRTUAL mutable_flag label COLON core_type ++ { $3, $2, Virtual, $5, symbol_rloc () } ++ | MUTABLE virtual_flag label COLON core_type ++ { $3, Mutable, $2, $5, symbol_rloc () } ++ | label COLON core_type ++ { $1, Immutable, Concrete, $3, symbol_rloc () } + ; + method_type: + METHOD private_flag label COLON poly_type +Index: parsing/parsetree.mli +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/parsing/parsetree.mli,v +retrieving revision 1.42 +diff -u -r1.42 parsetree.mli +--- parsing/parsetree.mli 23 Mar 2005 03:08:37 -0000 1.42 ++++ parsing/parsetree.mli 5 Apr 2006 02:25:59 -0000 +@@ -152,7 +152,7 @@ + + and class_type_field = + Pctf_inher of class_type +- | Pctf_val of (string * mutable_flag * core_type option * Location.t) ++ | Pctf_val of (string * mutable_flag * virtual_flag * core_type * Location.t) + | Pctf_virt of (string * private_flag * core_type * Location.t) + | Pctf_meth of (string * private_flag * core_type * Location.t) + | Pctf_cstr of (core_type * core_type * Location.t) +@@ -179,6 +179,7 @@ + + and class_field = + Pcf_inher of class_expr * string option ++ | Pcf_valvirt of (string * mutable_flag * core_type * Location.t) + | Pcf_val of (string * mutable_flag * expression * Location.t) + | Pcf_virt of (string * private_flag * core_type * Location.t) + | Pcf_meth of (string * private_flag * expression * Location.t) +Index: parsing/printast.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/parsing/printast.ml,v +retrieving revision 1.29 +diff -u -r1.29 printast.ml +--- parsing/printast.ml 4 Jan 2006 16:55:50 -0000 1.29 ++++ parsing/printast.ml 5 Apr 2006 02:25:59 -0000 +@@ -353,10 +353,11 @@ + | Pctf_inher (ct) -> + line i ppf "Pctf_inher\n"; + class_type i ppf ct; +- | Pctf_val (s, mf, cto, loc) -> ++ | Pctf_val (s, mf, vf, ct, loc) -> + line i ppf +- "Pctf_val \"%s\" %a %a\n" s fmt_mutable_flag mf fmt_location loc; +- option i core_type ppf cto; ++ "Pctf_val \"%s\" %a %a %a\n" s ++ fmt_mutable_flag mf fmt_virtual_flag vf fmt_location loc; ++ core_type (i+1) ppf ct; + | Pctf_virt (s, pf, ct, loc) -> + line i ppf + "Pctf_virt \"%s\" %a %a\n" s fmt_private_flag pf fmt_location loc; +@@ -428,6 +429,10 @@ + line i ppf "Pcf_inher\n"; + class_expr (i+1) ppf ce; + option (i+1) string ppf so; ++ | Pcf_valvirt (s, mf, ct, loc) -> ++ line i ppf ++ "Pcf_valvirt \"%s\" %a %a\n" s fmt_mutable_flag mf fmt_location loc; ++ core_type (i+1) ppf ct; + | Pcf_val (s, mf, e, loc) -> + line i ppf + "Pcf_val \"%s\" %a %a\n" s fmt_mutable_flag mf fmt_location loc; +Index: typing/btype.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/btype.ml,v +retrieving revision 1.38 +diff -u -r1.38 btype.ml +--- typing/btype.ml 4 Jan 2006 16:55:50 -0000 1.38 ++++ typing/btype.ml 5 Apr 2006 02:25:59 -0000 +@@ -330,7 +330,7 @@ + + let unmark_class_signature sign = + unmark_type sign.cty_self; +- Vars.iter (fun l (m, t) -> unmark_type t) sign.cty_vars ++ Vars.iter (fun l (m, v, t) -> unmark_type t) sign.cty_vars + + let rec unmark_class_type = + function +Index: typing/ctype.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/ctype.ml,v +retrieving revision 1.200 +diff -u -r1.200 ctype.ml +--- typing/ctype.ml 6 Jan 2006 02:16:24 -0000 1.200 ++++ typing/ctype.ml 5 Apr 2006 02:25:59 -0000 +@@ -857,7 +857,7 @@ + Tcty_signature + {cty_self = copy sign.cty_self; + cty_vars = +- Vars.map (function (mut, ty) -> (mut, copy ty)) sign.cty_vars; ++ Vars.map (function (m, v, ty) -> (m, v, copy ty)) sign.cty_vars; + cty_concr = sign.cty_concr; + cty_inher = + List.map (fun (p,tl) -> (p, List.map copy tl)) sign.cty_inher} +@@ -2354,10 +2354,11 @@ + | CM_Val_type_mismatch of string * (type_expr * type_expr) list + | CM_Meth_type_mismatch of string * (type_expr * type_expr) list + | CM_Non_mutable_value of string ++ | CM_Non_concrete_value of string + | CM_Missing_value of string + | CM_Missing_method of string + | CM_Hide_public of string +- | CM_Hide_virtual of string ++ | CM_Hide_virtual of string * string + | CM_Public_method of string + | CM_Private_method of string + | CM_Virtual_method of string +@@ -2390,8 +2391,8 @@ + end) + pairs; + Vars.iter +- (fun lab (mut, ty) -> +- let (mut', ty') = Vars.find lab sign1.cty_vars in ++ (fun lab (mut, v, ty) -> ++ let (mut', v', ty') = Vars.find lab sign1.cty_vars in + try moregen true type_pairs env ty' ty with Unify trace -> + raise (Failure [CM_Val_type_mismatch + (lab, expand_trace env trace)])) +@@ -2437,7 +2438,7 @@ + end + in + if Concr.mem lab sign1.cty_concr then err +- else CM_Hide_virtual lab::err) ++ else CM_Hide_virtual ("method", lab) :: err) + miss1 [] + in + let missing_method = List.map (fun (m, _, _) -> m) miss2 in +@@ -2455,11 +2456,13 @@ + in + let error = + Vars.fold +- (fun lab (mut, ty) err -> ++ (fun lab (mut, vr, ty) err -> + try +- let (mut', ty') = Vars.find lab sign1.cty_vars in ++ let (mut', vr', ty') = Vars.find lab sign1.cty_vars in + if mut = Mutable && mut' <> Mutable then + CM_Non_mutable_value lab::err ++ else if vr = Concrete && vr' <> Concrete then ++ CM_Non_concrete_value lab::err + else + err + with Not_found -> +@@ -2467,6 +2470,14 @@ + sign2.cty_vars error + in + let error = ++ Vars.fold ++ (fun lab (_,vr,_) err -> ++ if vr = Virtual && not (Vars.mem lab sign2.cty_vars) then ++ CM_Hide_virtual ("instance variable", lab) :: err ++ else err) ++ sign1.cty_vars error ++ in ++ let error = + List.fold_right + (fun e l -> + if List.mem e missing_method then l else CM_Virtual_method e::l) +@@ -2516,8 +2527,8 @@ + end) + pairs; + Vars.iter +- (fun lab (mut, ty) -> +- let (mut', ty') = Vars.find lab sign1.cty_vars in ++ (fun lab (_, _, ty) -> ++ let (_, _, ty') = Vars.find lab sign1.cty_vars in + try eqtype true type_pairs subst env ty ty' with Unify trace -> + raise (Failure [CM_Val_type_mismatch + (lab, expand_trace env trace)])) +@@ -2554,7 +2565,7 @@ + end + in + if Concr.mem lab sign1.cty_concr then err +- else CM_Hide_virtual lab::err) ++ else CM_Hide_virtual ("method", lab) :: err) + miss1 [] + in + let missing_method = List.map (fun (m, _, _) -> m) miss2 in +@@ -2578,11 +2589,13 @@ + in + let error = + Vars.fold +- (fun lab (mut, ty) err -> ++ (fun lab (mut, vr, ty) err -> + try +- let (mut', ty') = Vars.find lab sign1.cty_vars in ++ let (mut', vr', ty') = Vars.find lab sign1.cty_vars in + if mut = Mutable && mut' <> Mutable then + CM_Non_mutable_value lab::err ++ else if vr = Concrete && vr' <> Concrete then ++ CM_Non_concrete_value lab::err + else + err + with Not_found -> +@@ -2590,6 +2603,14 @@ + sign2.cty_vars error + in + let error = ++ Vars.fold ++ (fun lab (_,vr,_) err -> ++ if vr = Virtual && not (Vars.mem lab sign2.cty_vars) then ++ CM_Hide_virtual ("instance variable", lab) :: err ++ else err) ++ sign1.cty_vars error ++ in ++ let error = + List.fold_right + (fun e l -> + if List.mem e missing_method then l else CM_Virtual_method e::l) +@@ -3279,7 +3300,7 @@ + let nondep_class_signature env id sign = + { cty_self = nondep_type_rec env id sign.cty_self; + cty_vars = +- Vars.map (function (m, t) -> (m, nondep_type_rec env id t)) ++ Vars.map (function (m, v, t) -> (m, v, nondep_type_rec env id t)) + sign.cty_vars; + cty_concr = sign.cty_concr; + cty_inher = +Index: typing/ctype.mli +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/ctype.mli,v +retrieving revision 1.53 +diff -u -r1.53 ctype.mli +--- typing/ctype.mli 9 Dec 2004 12:40:53 -0000 1.53 ++++ typing/ctype.mli 5 Apr 2006 02:25:59 -0000 +@@ -170,10 +170,11 @@ + | CM_Val_type_mismatch of string * (type_expr * type_expr) list + | CM_Meth_type_mismatch of string * (type_expr * type_expr) list + | CM_Non_mutable_value of string ++ | CM_Non_concrete_value of string + | CM_Missing_value of string + | CM_Missing_method of string + | CM_Hide_public of string +- | CM_Hide_virtual of string ++ | CM_Hide_virtual of string * string + | CM_Public_method of string + | CM_Private_method of string + | CM_Virtual_method of string +Index: typing/includeclass.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/includeclass.ml,v +retrieving revision 1.7 +diff -u -r1.7 includeclass.ml +--- typing/includeclass.ml 6 Mar 2000 22:11:57 -0000 1.7 ++++ typing/includeclass.ml 5 Apr 2006 02:25:59 -0000 +@@ -78,14 +78,17 @@ + | CM_Non_mutable_value lab -> + fprintf ppf + "@[The non-mutable instance variable %s cannot become mutable@]" lab ++ | CM_Non_concrete_value lab -> ++ fprintf ppf ++ "@[The virtual instance variable %s cannot become concrete@]" lab + | CM_Missing_value lab -> + fprintf ppf "@[The first class type has no instance variable %s@]" lab + | CM_Missing_method lab -> + fprintf ppf "@[The first class type has no method %s@]" lab + | CM_Hide_public lab -> + fprintf ppf "@[The public method %s cannot be hidden@]" lab +- | CM_Hide_virtual lab -> +- fprintf ppf "@[The virtual method %s cannot be hidden@]" lab ++ | CM_Hide_virtual (k, lab) -> ++ fprintf ppf "@[The virtual %s %s cannot be hidden@]" k lab + | CM_Public_method lab -> + fprintf ppf "@[The public method %s cannot become private" lab + | CM_Virtual_method lab -> +Index: typing/oprint.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/oprint.ml,v +retrieving revision 1.22 +diff -u -r1.22 oprint.ml +--- typing/oprint.ml 23 Mar 2005 03:08:37 -0000 1.22 ++++ typing/oprint.ml 5 Apr 2006 02:25:59 -0000 +@@ -291,8 +291,10 @@ + fprintf ppf "@[<2>method %s%s%s :@ %a@]" + (if priv then "private " else "") (if virt then "virtual " else "") + name !out_type ty +- | Ocsg_value (name, mut, ty) -> +- fprintf ppf "@[<2>val %s%s :@ %a@]" (if mut then "mutable " else "") ++ | Ocsg_value (name, mut, vr, ty) -> ++ fprintf ppf "@[<2>val %s%s%s :@ %a@]" ++ (if mut then "mutable " else "") ++ (if vr then "virtual " else "") + name !out_type ty + + let out_class_type = ref print_out_class_type +Index: typing/outcometree.mli +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/outcometree.mli,v +retrieving revision 1.14 +diff -u -r1.14 outcometree.mli +--- typing/outcometree.mli 23 Mar 2005 03:08:37 -0000 1.14 ++++ typing/outcometree.mli 5 Apr 2006 02:25:59 -0000 +@@ -71,7 +71,7 @@ + and out_class_sig_item = + | Ocsg_constraint of out_type * out_type + | Ocsg_method of string * bool * bool * out_type +- | Ocsg_value of string * bool * out_type ++ | Ocsg_value of string * bool * bool * out_type + + type out_module_type = + | Omty_abstract +Index: typing/printtyp.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/printtyp.ml,v +retrieving revision 1.140 +diff -u -r1.140 printtyp.ml +--- typing/printtyp.ml 4 Jan 2006 16:55:50 -0000 1.140 ++++ typing/printtyp.ml 5 Apr 2006 02:26:00 -0000 +@@ -650,7 +650,7 @@ + Ctype.flatten_fields (Ctype.object_fields sign.cty_self) + in + List.iter (fun met -> mark_loops (method_type met)) fields; +- Vars.iter (fun _ (_, ty) -> mark_loops ty) sign.cty_vars ++ Vars.iter (fun _ (_, _, ty) -> mark_loops ty) sign.cty_vars + | Tcty_fun (_, ty, cty) -> + mark_loops ty; + prepare_class_type params cty +@@ -682,13 +682,15 @@ + csil (tree_of_constraints params) + in + let all_vars = +- Vars.fold (fun l (m, t) all -> (l, m, t) :: all) sign.cty_vars [] in ++ Vars.fold (fun l (m, v, t) all -> (l, m, v, t) :: all) sign.cty_vars [] ++ in + (* Consequence of PR#3607: order of Map.fold has changed! *) + let all_vars = List.rev all_vars in + let csil = + List.fold_left +- (fun csil (l, m, t) -> +- Ocsg_value (l, m = Mutable, tree_of_typexp sch t) :: csil) ++ (fun csil (l, m, v, t) -> ++ Ocsg_value (l, m = Mutable, v = Virtual, tree_of_typexp sch t) ++ :: csil) + csil all_vars + in + let csil = +@@ -763,7 +765,9 @@ + List.exists + (fun (lab, _, ty) -> + not (lab = dummy_method || Concr.mem lab sign.cty_concr)) +- fields in ++ fields ++ || Vars.fold (fun _ (_,vr,_) b -> vr = Virtual || b) sign.cty_vars false ++ in + + Osig_class_type + (virt, Ident.name id, +Index: typing/subst.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/subst.ml,v +retrieving revision 1.49 +diff -u -r1.49 subst.ml +--- typing/subst.ml 4 Jan 2006 16:55:50 -0000 1.49 ++++ typing/subst.ml 5 Apr 2006 02:26:00 -0000 +@@ -178,7 +178,8 @@ + + let class_signature s sign = + { cty_self = typexp s sign.cty_self; +- cty_vars = Vars.map (function (m, t) -> (m, typexp s t)) sign.cty_vars; ++ cty_vars = ++ Vars.map (function (m, v, t) -> (m, v, typexp s t)) sign.cty_vars; + cty_concr = sign.cty_concr; + cty_inher = + List.map (fun (p, tl) -> (type_path s p, List.map (typexp s) tl)) +Index: typing/typeclass.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/typeclass.ml,v +retrieving revision 1.85 +diff -u -r1.85 typeclass.ml +--- typing/typeclass.ml 22 Jul 2005 06:42:36 -0000 1.85 ++++ typing/typeclass.ml 5 Apr 2006 02:26:00 -0000 +@@ -24,7 +24,7 @@ + + type error = + Unconsistent_constraint of (type_expr * type_expr) list +- | Method_type_mismatch of string * (type_expr * type_expr) list ++ | Field_type_mismatch of string * string * (type_expr * type_expr) list + | Structure_expected of class_type + | Cannot_apply of class_type + | Apply_wrong_label of label +@@ -36,7 +36,7 @@ + | Unbound_class_type_2 of Longident.t + | Abbrev_type_clash of type_expr * type_expr * type_expr + | Constructor_type_mismatch of string * (type_expr * type_expr) list +- | Virtual_class of bool * string list ++ | Virtual_class of bool * string list * string list + | Parameter_arity_mismatch of Longident.t * int * int + | Parameter_mismatch of (type_expr * type_expr) list + | Bad_parameters of Ident.t * type_expr * type_expr +@@ -49,6 +49,7 @@ + | Non_collapsable_conjunction of + Ident.t * Types.class_declaration * (type_expr * type_expr) list + | Final_self_clash of (type_expr * type_expr) list ++ | Mutability_mismatch of string * mutable_flag + + exception Error of Location.t * error + +@@ -90,7 +91,7 @@ + generalize_class_type cty + | Tcty_signature {cty_self = sty; cty_vars = vars; cty_inher = inher} -> + Ctype.generalize sty; +- Vars.iter (fun _ (_, ty) -> Ctype.generalize ty) vars; ++ Vars.iter (fun _ (_, _, ty) -> Ctype.generalize ty) vars; + List.iter (fun (_,tl) -> List.iter Ctype.generalize tl) inher + | Tcty_fun (_, ty, cty) -> + Ctype.generalize ty; +@@ -152,7 +153,7 @@ + | Tcty_signature sign -> + Ctype.closed_schema sign.cty_self + && +- Vars.fold (fun _ (_, ty) cc -> Ctype.closed_schema ty && cc) ++ Vars.fold (fun _ (_, _, ty) cc -> Ctype.closed_schema ty && cc) + sign.cty_vars + true + | Tcty_fun (_, ty, cty) -> +@@ -172,7 +173,7 @@ + limited_generalize rv cty + | Tcty_signature sign -> + Ctype.limited_generalize rv sign.cty_self; +- Vars.iter (fun _ (_, ty) -> Ctype.limited_generalize rv ty) ++ Vars.iter (fun _ (_, _, ty) -> Ctype.limited_generalize rv ty) + sign.cty_vars; + List.iter (fun (_, tl) -> List.iter (Ctype.limited_generalize rv) tl) + sign.cty_inher +@@ -201,11 +202,25 @@ + Env.add_value id {val_type = ty; val_kind = Val_unbound} par_env) + + (* Enter an instance variable in the environment *) +-let enter_val cl_num vars lab mut ty val_env met_env par_env = +- let (id, val_env, met_env, par_env) as result = +- enter_met_env lab (Val_ivar (mut, cl_num)) ty val_env met_env par_env ++let enter_val cl_num vars inh lab mut virt ty val_env met_env par_env loc = ++ let (id, virt) = ++ try ++ let (id, mut', virt', ty') = Vars.find lab !vars in ++ if mut' <> mut then raise (Error(loc, Mutability_mismatch(lab, mut))); ++ Ctype.unify val_env (Ctype.instance ty) (Ctype.instance ty'); ++ (if not inh then Some id else None), ++ (if virt' = Concrete then virt' else virt) ++ with ++ Ctype.Unify tr -> ++ raise (Error(loc, Field_type_mismatch("instance variable", lab, tr))) ++ | Not_found -> None, virt ++ in ++ let (id, _, _, _) as result = ++ match id with Some id -> (id, val_env, met_env, par_env) ++ | None -> ++ enter_met_env lab (Val_ivar (mut, cl_num)) ty val_env met_env par_env + in +- vars := Vars.add lab (id, mut, ty) !vars; ++ vars := Vars.add lab (id, mut, virt, ty) !vars; + result + + let inheritance self_type env concr_meths warn_meths loc parent = +@@ -218,7 +233,7 @@ + with Ctype.Unify trace -> + match trace with + _::_::_::({desc = Tfield(n, _, _, _)}, _)::rem -> +- raise(Error(loc, Method_type_mismatch (n, rem))) ++ raise(Error(loc, Field_type_mismatch ("method", n, rem))) + | _ -> + assert false + end; +@@ -243,7 +258,7 @@ + in + let ty = transl_simple_type val_env false sty in + try Ctype.unify val_env ty ty' with Ctype.Unify trace -> +- raise(Error(loc, Method_type_mismatch (lab, trace))) ++ raise(Error(loc, Field_type_mismatch ("method", lab, trace))) + + let delayed_meth_specs = ref [] + +@@ -253,7 +268,7 @@ + in + let unif ty = + try Ctype.unify val_env ty ty' with Ctype.Unify trace -> +- raise(Error(loc, Method_type_mismatch (lab, trace))) ++ raise(Error(loc, Field_type_mismatch ("method", lab, trace))) + in + match sty.ptyp_desc, priv with + Ptyp_poly ([],sty), Public -> +@@ -279,6 +294,15 @@ + + (*******************************) + ++let add_val env loc lab (mut, virt, ty) val_sig = ++ let virt = ++ try ++ let (mut', virt', ty') = Vars.find lab val_sig in ++ if virt' = Concrete then virt' else virt ++ with Not_found -> virt ++ in ++ Vars.add lab (mut, virt, ty) val_sig ++ + let rec class_type_field env self_type meths (val_sig, concr_meths, inher) = + function + Pctf_inher sparent -> +@@ -293,25 +317,12 @@ + parent + in + let val_sig = +- Vars.fold +- (fun lab (mut, ty) val_sig -> Vars.add lab (mut, ty) val_sig) +- cl_sig.cty_vars val_sig +- in ++ Vars.fold (add_val env sparent.pcty_loc) cl_sig.cty_vars val_sig in + (val_sig, concr_meths, inher) + +- | Pctf_val (lab, mut, sty_opt, loc) -> +- let (mut, ty) = +- match sty_opt with +- None -> +- let (mut', ty) = +- try Vars.find lab val_sig with Not_found -> +- raise(Error(loc, Unbound_val lab)) +- in +- (if mut = Mutable then mut' else Immutable), ty +- | Some sty -> +- mut, transl_simple_type env false sty +- in +- (Vars.add lab (mut, ty) val_sig, concr_meths, inher) ++ | Pctf_val (lab, mut, virt, sty, loc) -> ++ let ty = transl_simple_type env false sty in ++ (add_val env loc lab (mut, virt, ty) val_sig, concr_meths, inher) + + | Pctf_virt (lab, priv, sty, loc) -> + declare_method env meths self_type lab priv sty loc; +@@ -397,7 +408,7 @@ + + let rec class_field cl_num self_type meths vars + (val_env, met_env, par_env, fields, concr_meths, warn_meths, +- inh_vals, inher) = ++ warn_vals, inher) = + function + Pcf_inher (sparent, super) -> + let parent = class_expr cl_num val_env par_env sparent in +@@ -411,18 +422,23 @@ + parent.cl_type + in + (* Variables *) +- let (val_env, met_env, par_env, inh_vars, inh_vals) = ++ let (val_env, met_env, par_env, inh_vars, warn_vals) = + Vars.fold +- (fun lab (mut, ty) (val_env, met_env, par_env, inh_vars, inh_vals) -> ++ (fun lab info (val_env, met_env, par_env, inh_vars, warn_vals) -> ++ let mut, vr, ty = info in + let (id, val_env, met_env, par_env) = +- enter_val cl_num vars lab mut ty val_env met_env par_env ++ enter_val cl_num vars true lab mut vr ty val_env met_env par_env ++ sparent.pcl_loc + in +- if StringSet.mem lab inh_vals then +- Location.prerr_warning sparent.pcl_loc +- (Warnings.Hide_instance_variable lab); +- (val_env, met_env, par_env, (lab, id) :: inh_vars, +- StringSet.add lab inh_vals)) +- cl_sig.cty_vars (val_env, met_env, par_env, [], inh_vals) ++ let warn_vals = ++ if vr = Virtual then warn_vals else ++ if StringSet.mem lab warn_vals then ++ (Location.prerr_warning sparent.pcl_loc ++ (Warnings.Instance_variable_override lab); warn_vals) ++ else StringSet.add lab warn_vals ++ in ++ (val_env, met_env, par_env, (lab, id) :: inh_vars, warn_vals)) ++ cl_sig.cty_vars (val_env, met_env, par_env, [], warn_vals) + in + (* Inherited concrete methods *) + let inh_meths = +@@ -443,11 +459,26 @@ + in + (val_env, met_env, par_env, + lazy(Cf_inher (parent, inh_vars, inh_meths))::fields, +- concr_meths, warn_meths, inh_vals, inher) ++ concr_meths, warn_meths, warn_vals, inher) ++ ++ | Pcf_valvirt (lab, mut, styp, loc) -> ++ if !Clflags.principal then Ctype.begin_def (); ++ let ty = Typetexp.transl_simple_type val_env false styp in ++ if !Clflags.principal then begin ++ Ctype.end_def (); ++ Ctype.generalize_structure ty ++ end; ++ let (id, val_env, met_env', par_env) = ++ enter_val cl_num vars false lab mut Virtual ty ++ val_env met_env par_env loc ++ in ++ (val_env, met_env', par_env, ++ lazy(Cf_val (lab, id, None, met_env' == met_env)) :: fields, ++ concr_meths, warn_meths, StringSet.remove lab warn_vals, inher) + + | Pcf_val (lab, mut, sexp, loc) -> +- if StringSet.mem lab inh_vals then +- Location.prerr_warning loc (Warnings.Hide_instance_variable lab); ++ if StringSet.mem lab warn_vals then ++ Location.prerr_warning loc (Warnings.Instance_variable_override lab); + if !Clflags.principal then Ctype.begin_def (); + let exp = + try type_exp val_env sexp with Ctype.Unify [(ty, _)] -> +@@ -457,17 +488,19 @@ + Ctype.end_def (); + Ctype.generalize_structure exp.exp_type + end; +- let (id, val_env, met_env, par_env) = +- enter_val cl_num vars lab mut exp.exp_type val_env met_env par_env +- in +- (val_env, met_env, par_env, lazy(Cf_val (lab, id, exp)) :: fields, +- concr_meths, warn_meths, inh_vals, inher) ++ let (id, val_env, met_env', par_env) = ++ enter_val cl_num vars false lab mut Concrete exp.exp_type ++ val_env met_env par_env loc ++ in ++ (val_env, met_env', par_env, ++ lazy(Cf_val (lab, id, Some exp, met_env' == met_env)) :: fields, ++ concr_meths, warn_meths, StringSet.add lab warn_vals, inher) + + | Pcf_virt (lab, priv, sty, loc) -> + virtual_method val_env meths self_type lab priv sty loc; + let warn_meths = Concr.remove lab warn_meths in + (val_env, met_env, par_env, fields, concr_meths, warn_meths, +- inh_vals, inher) ++ warn_vals, inher) + + | Pcf_meth (lab, priv, expr, loc) -> + let (_, ty) = +@@ -493,7 +526,7 @@ + end + | _ -> assert false + with Ctype.Unify trace -> +- raise(Error(loc, Method_type_mismatch (lab, trace))) ++ raise(Error(loc, Field_type_mismatch ("method", lab, trace))) + end; + let meth_expr = make_method cl_num expr in + (* backup variables for Pexp_override *) +@@ -510,12 +543,12 @@ + Cf_meth (lab, texp) + end in + (val_env, met_env, par_env, field::fields, +- Concr.add lab concr_meths, Concr.add lab warn_meths, inh_vals, inher) ++ Concr.add lab concr_meths, Concr.add lab warn_meths, warn_vals, inher) + + | Pcf_cstr (sty, sty', loc) -> + type_constraint val_env sty sty' loc; + (val_env, met_env, par_env, fields, concr_meths, warn_meths, +- inh_vals, inher) ++ warn_vals, inher) + + | Pcf_let (rec_flag, sdefs, loc) -> + let (defs, val_env) = +@@ -545,7 +578,7 @@ + ([], met_env, par_env) + in + (val_env, met_env, par_env, lazy(Cf_let(rec_flag, defs, vals))::fields, +- concr_meths, warn_meths, inh_vals, inher) ++ concr_meths, warn_meths, warn_vals, inher) + + | Pcf_init expr -> + let expr = make_method cl_num expr in +@@ -562,7 +595,7 @@ + Cf_init texp + end in + (val_env, met_env, par_env, field::fields, +- concr_meths, warn_meths, inh_vals, inher) ++ concr_meths, warn_meths, warn_vals, inher) + + and class_structure cl_num final val_env met_env loc (spat, str) = + (* Environment for substructures *) +@@ -616,7 +649,7 @@ + Ctype.unify val_env self_type (Ctype.newvar ()); + let sign = + {cty_self = public_self; +- cty_vars = Vars.map (function (id, mut, ty) -> (mut, ty)) !vars; ++ cty_vars = Vars.map (fun (id, mut, vr, ty) -> (mut, vr, ty)) !vars; + cty_concr = concr_meths; + cty_inher = inher} in + let methods = get_methods self_type in +@@ -628,7 +661,11 @@ + be modified after this point *) + Ctype.close_object self_type; + let mets = virtual_methods {sign with cty_self = self_type} in +- if mets <> [] then raise(Error(loc, Virtual_class(true, mets))); ++ let vals = ++ Vars.fold ++ (fun name (mut, vr, ty) l -> if vr = Virtual then name :: l else l) ++ sign.cty_vars [] in ++ if mets <> [] then raise(Error(loc, Virtual_class(true, mets, vals))); + let self_methods = + List.fold_right + (fun (lab,kind,ty) rem -> +@@ -1135,9 +1172,14 @@ + in + + if cl.pci_virt = Concrete then begin +- match virtual_methods (Ctype.signature_of_class_type typ) with +- [] -> () +- | mets -> raise(Error(cl.pci_loc, Virtual_class(define_class, mets))) ++ let sign = Ctype.signature_of_class_type typ in ++ let mets = virtual_methods sign in ++ let vals = ++ Vars.fold ++ (fun name (mut, vr, ty) l -> if vr = Virtual then name :: l else l) ++ sign.cty_vars [] in ++ if mets <> [] || vals <> [] then ++ raise(Error(cl.pci_loc, Virtual_class(true, mets, vals))); + end; + + (* Misc. *) +@@ -1400,10 +1442,10 @@ + Printtyp.report_unification_error ppf trace + (fun ppf -> fprintf ppf "Type") + (fun ppf -> fprintf ppf "is not compatible with type") +- | Method_type_mismatch (m, trace) -> ++ | Field_type_mismatch (k, m, trace) -> + Printtyp.report_unification_error ppf trace + (function ppf -> +- fprintf ppf "The method %s@ has type" m) ++ fprintf ppf "The %s %s@ has type" k m) + (function ppf -> + fprintf ppf "but is expected to have type") + | Structure_expected clty -> +@@ -1451,15 +1493,20 @@ + fprintf ppf "The expression \"new %s\" has type" c) + (function ppf -> + fprintf ppf "but is used with type") +- | Virtual_class (cl, mets) -> ++ | Virtual_class (cl, mets, vals) -> + let print_mets ppf mets = + List.iter (function met -> fprintf ppf "@ %s" met) mets in + let cl_mark = if cl then "" else " type" in ++ let missings = ++ match mets, vals with ++ [], _ -> "variables" ++ | _, [] -> "methods" ++ | _ -> "methods and variables" ++ in + fprintf ppf +- "@[This class%s should be virtual@ \ +- @[<2>The following methods are undefined :%a@] +- @]" +- cl_mark print_mets mets ++ "@[This class%s should be virtual.@ \ ++ @[<2>The following %s are undefined :%a@]@]" ++ cl_mark missings print_mets (mets @ vals) + | Parameter_arity_mismatch(lid, expected, provided) -> + fprintf ppf + "@[The class constructor %a@ expects %i type argument(s),@ \ +@@ -1532,3 +1579,10 @@ + fprintf ppf "This object is expected to have type") + (function ppf -> + fprintf ppf "but has actually type") ++ | Mutability_mismatch (lab, mut) -> ++ let mut1, mut2 = ++ if mut = Immutable then "mutable", "immutable" ++ else "immutable", "mutable" in ++ fprintf ppf ++ "@[The instance variable is %s,@ it cannot be redefined as %s@]" ++ mut1 mut2 +Index: typing/typeclass.mli +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/typeclass.mli,v +retrieving revision 1.18 +diff -u -r1.18 typeclass.mli +--- typing/typeclass.mli 1 Dec 2003 00:32:11 -0000 1.18 ++++ typing/typeclass.mli 5 Apr 2006 02:26:00 -0000 +@@ -49,7 +49,7 @@ + + type error = + Unconsistent_constraint of (type_expr * type_expr) list +- | Method_type_mismatch of string * (type_expr * type_expr) list ++ | Field_type_mismatch of string * string * (type_expr * type_expr) list + | Structure_expected of class_type + | Cannot_apply of class_type + | Apply_wrong_label of label +@@ -61,7 +61,7 @@ + | Unbound_class_type_2 of Longident.t + | Abbrev_type_clash of type_expr * type_expr * type_expr + | Constructor_type_mismatch of string * (type_expr * type_expr) list +- | Virtual_class of bool * string list ++ | Virtual_class of bool * string list * string list + | Parameter_arity_mismatch of Longident.t * int * int + | Parameter_mismatch of (type_expr * type_expr) list + | Bad_parameters of Ident.t * type_expr * type_expr +@@ -74,6 +74,7 @@ + | Non_collapsable_conjunction of + Ident.t * Types.class_declaration * (type_expr * type_expr) list + | Final_self_clash of (type_expr * type_expr) list ++ | Mutability_mismatch of string * mutable_flag + + exception Error of Location.t * error + +Index: typing/typecore.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/typecore.ml,v +retrieving revision 1.178 +diff -u -r1.178 typecore.ml +--- typing/typecore.ml 6 Jan 2006 02:25:37 -0000 1.178 ++++ typing/typecore.ml 5 Apr 2006 02:26:00 -0000 +@@ -611,11 +611,11 @@ + List.for_all + (function + Cf_meth _ -> true +- | Cf_val (_,_,e) -> incr count; is_nonexpansive e ++ | Cf_val (_,_,e,_) -> incr count; is_nonexpansive_opt e + | Cf_init e -> is_nonexpansive e + | Cf_inher _ | Cf_let _ -> false) + fields && +- Vars.fold (fun _ (mut,_) b -> decr count; b && mut = Immutable) ++ Vars.fold (fun _ (mut,_,_) b -> decr count; b && mut = Immutable) + vars true && + !count = 0 + | _ -> false +@@ -1356,7 +1356,7 @@ + (path_self, _) -> + let type_override (lab, snewval) = + begin try +- let (id, _, ty) = Vars.find lab !vars in ++ let (id, _, _, ty) = Vars.find lab !vars in + (Path.Pident id, type_expect env snewval (instance ty)) + with + Not_found -> +Index: typing/typecore.mli +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/typecore.mli,v +retrieving revision 1.37 +diff -u -r1.37 typecore.mli +--- typing/typecore.mli 4 Mar 2005 14:51:31 -0000 1.37 ++++ typing/typecore.mli 5 Apr 2006 02:26:00 -0000 +@@ -38,7 +38,8 @@ + string -> type_expr -> Env.t -> Env.t -> Env.t -> Parsetree.pattern -> + Typedtree.pattern * + (Ident.t * type_expr) Meths.t ref * +- (Ident.t * Asttypes.mutable_flag * type_expr) Vars.t ref * ++ (Ident.t * Asttypes.mutable_flag * Asttypes.virtual_flag * type_expr) ++ Vars.t ref * + Env.t * Env.t * Env.t + val type_expect: + ?in_function:(Location.t * type_expr) -> +Index: typing/typedtree.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/typedtree.ml,v +retrieving revision 1.36 +diff -u -r1.36 typedtree.ml +--- typing/typedtree.ml 25 Nov 2003 09:20:43 -0000 1.36 ++++ typing/typedtree.ml 5 Apr 2006 02:26:00 -0000 +@@ -106,7 +106,7 @@ + + and class_field = + Cf_inher of class_expr * (string * Ident.t) list * (string * Ident.t) list +- | Cf_val of string * Ident.t * expression ++ | Cf_val of string * Ident.t * expression option * bool + | Cf_meth of string * expression + | Cf_let of rec_flag * (pattern * expression) list * + (Ident.t * expression) list +@@ -140,7 +140,8 @@ + | Tstr_recmodule of (Ident.t * module_expr) list + | Tstr_modtype of Ident.t * module_type + | Tstr_open of Path.t +- | Tstr_class of (Ident.t * int * string list * class_expr) list ++ | Tstr_class of ++ (Ident.t * int * string list * class_expr * virtual_flag) list + | Tstr_cltype of (Ident.t * cltype_declaration) list + | Tstr_include of module_expr * Ident.t list + +Index: typing/typedtree.mli +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/typedtree.mli,v +retrieving revision 1.34 +diff -u -r1.34 typedtree.mli +--- typing/typedtree.mli 25 Nov 2003 09:20:43 -0000 1.34 ++++ typing/typedtree.mli 5 Apr 2006 02:26:00 -0000 +@@ -107,7 +107,8 @@ + and class_field = + Cf_inher of class_expr * (string * Ident.t) list * (string * Ident.t) list + (* Inherited instance variables and concrete methods *) +- | Cf_val of string * Ident.t * expression ++ | Cf_val of string * Ident.t * expression option * bool ++ (* None = virtual, true = override *) + | Cf_meth of string * expression + | Cf_let of rec_flag * (pattern * expression) list * + (Ident.t * expression) list +@@ -141,7 +142,8 @@ + | Tstr_recmodule of (Ident.t * module_expr) list + | Tstr_modtype of Ident.t * module_type + | Tstr_open of Path.t +- | Tstr_class of (Ident.t * int * string list * class_expr) list ++ | Tstr_class of ++ (Ident.t * int * string list * class_expr * virtual_flag) list + | Tstr_cltype of (Ident.t * cltype_declaration) list + | Tstr_include of module_expr * Ident.t list + +Index: typing/typemod.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/typemod.ml,v +retrieving revision 1.73 +diff -u -r1.73 typemod.ml +--- typing/typemod.ml 8 Aug 2005 09:41:51 -0000 1.73 ++++ typing/typemod.ml 5 Apr 2006 02:26:00 -0000 +@@ -17,6 +17,7 @@ + open Misc + open Longident + open Path ++open Asttypes + open Parsetree + open Types + open Typedtree +@@ -667,8 +668,9 @@ + let (classes, new_env) = Typeclass.class_declarations env cl in + let (str_rem, sig_rem, final_env) = type_struct new_env srem in + (Tstr_class +- (List.map (fun (i, _,_,_,_,_,_,_, s, m, c) -> +- (i, s, m, c)) classes) :: ++ (List.map (fun (i, d, _,_,_,_,_,_, s, m, c) -> ++ let vf = if d.cty_new = None then Virtual else Concrete in ++ (i, s, m, c, vf)) classes) :: + Tstr_cltype + (List.map (fun (_,_, i, d, _,_,_,_,_,_,_) -> (i, d)) classes) :: + Tstr_type +Index: typing/types.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/types.ml,v +retrieving revision 1.25 +diff -u -r1.25 types.ml +--- typing/types.ml 9 Dec 2004 12:40:53 -0000 1.25 ++++ typing/types.ml 5 Apr 2006 02:26:00 -0000 +@@ -90,7 +90,8 @@ + | Val_prim of Primitive.description (* Primitive *) + | Val_ivar of mutable_flag * string (* Instance variable (mutable ?) *) + | Val_self of (Ident.t * type_expr) Meths.t ref * +- (Ident.t * Asttypes.mutable_flag * type_expr) Vars.t ref * ++ (Ident.t * Asttypes.mutable_flag * ++ Asttypes.virtual_flag * type_expr) Vars.t ref * + string * type_expr + (* Self *) + | Val_anc of (string * Ident.t) list * string +@@ -156,7 +157,8 @@ + + and class_signature = + { cty_self: type_expr; +- cty_vars: (Asttypes.mutable_flag * type_expr) Vars.t; ++ cty_vars: ++ (Asttypes.mutable_flag * Asttypes.virtual_flag * type_expr) Vars.t; + cty_concr: Concr.t; + cty_inher: (Path.t * type_expr list) list } + +Index: typing/types.mli +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/types.mli,v +retrieving revision 1.25 +diff -u -r1.25 types.mli +--- typing/types.mli 9 Dec 2004 12:40:53 -0000 1.25 ++++ typing/types.mli 5 Apr 2006 02:26:00 -0000 +@@ -91,7 +91,8 @@ + | Val_prim of Primitive.description (* Primitive *) + | Val_ivar of mutable_flag * string (* Instance variable (mutable ?) *) + | Val_self of (Ident.t * type_expr) Meths.t ref * +- (Ident.t * Asttypes.mutable_flag * type_expr) Vars.t ref * ++ (Ident.t * Asttypes.mutable_flag * ++ Asttypes.virtual_flag * type_expr) Vars.t ref * + string * type_expr + (* Self *) + | Val_anc of (string * Ident.t) list * string +@@ -158,7 +159,8 @@ + + and class_signature = + { cty_self: type_expr; +- cty_vars: (Asttypes.mutable_flag * type_expr) Vars.t; ++ cty_vars: ++ (Asttypes.mutable_flag * Asttypes.virtual_flag * type_expr) Vars.t; + cty_concr: Concr.t; + cty_inher: (Path.t * type_expr list) list } + +Index: typing/unused_var.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/typing/unused_var.ml,v +retrieving revision 1.5 +diff -u -r1.5 unused_var.ml +--- typing/unused_var.ml 4 Jan 2006 16:55:50 -0000 1.5 ++++ typing/unused_var.ml 5 Apr 2006 02:26:00 -0000 +@@ -245,7 +245,7 @@ + match cf with + | Pcf_inher (ce, _) -> class_expr ppf tbl ce; + | Pcf_val (_, _, e, _) -> expression ppf tbl e; +- | Pcf_virt _ -> () ++ | Pcf_virt _ | Pcf_valvirt _ -> () + | Pcf_meth (_, _, e, _) -> expression ppf tbl e; + | Pcf_cstr _ -> () + | Pcf_let (recflag, pel, _) -> let_pel ppf tbl recflag pel None; +Index: bytecomp/translclass.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/bytecomp/translclass.ml,v +retrieving revision 1.38 +diff -u -r1.38 translclass.ml +--- bytecomp/translclass.ml 13 Aug 2005 20:59:37 -0000 1.38 ++++ bytecomp/translclass.ml 5 Apr 2006 02:26:00 -0000 +@@ -133,10 +133,10 @@ + (fun _ -> lambda_unit) cl + in + (inh_init, lsequence obj_init' obj_init, true) +- | Cf_val (_, id, exp) -> ++ | Cf_val (_, id, Some exp, _) -> + (inh_init, lsequence (set_inst_var obj id exp) obj_init, + has_init) +- | Cf_meth _ -> ++ | Cf_meth _ | Cf_val _ -> + (inh_init, obj_init, has_init) + | Cf_init _ -> + (inh_init, obj_init, true) +@@ -213,27 +213,17 @@ + if len < 2 && nvals = 0 then Meths.fold (bind_method tbl) meths cl_init else + if len = 0 && nvals < 2 then transl_vals tbl true vals cl_init else + let ids = Ident.create "ids" in +- let i = ref len in +- let getter, names, cl_init = +- match vals with [] -> "get_method_labels", [], cl_init +- | (_,id0)::vals' -> +- incr i; +- let i = ref (List.length vals) in +- "new_methods_variables", +- [transl_meth_list (List.map fst vals)], +- Llet(Strict, id0, lfield ids 0, +- List.fold_right +- (fun (name,id) rem -> +- decr i; +- Llet(Alias, id, Lprim(Poffsetint !i, [Lvar id0]), rem)) +- vals' cl_init) ++ let i = ref (len + nvals) in ++ let getter, names = ++ if nvals = 0 then "get_method_labels", [] else ++ "new_methods_variables", [transl_meth_list (List.map fst vals)] + in + Llet(StrictOpt, ids, + Lapply (oo_prim getter, + [Lvar tbl; transl_meth_list (List.map fst methl)] @ names), + List.fold_right + (fun (lab,id) lam -> decr i; Llet(StrictOpt, id, lfield ids !i, lam)) +- methl cl_init) ++ (methl @ vals) cl_init) + + let output_methods tbl methods lam = + match methods with +@@ -283,8 +273,9 @@ + (vals, meths_super cla str.cl_meths meths) + inh_init cl_init msubst top cl in + (inh_init, cl_init, [], values) +- | Cf_val (name, id, exp) -> +- (inh_init, cl_init, methods, (name, id)::values) ++ | Cf_val (name, id, exp, over) -> ++ let values = if over then values else (name, id) :: values in ++ (inh_init, cl_init, methods, values) + | Cf_meth (name, exp) -> + let met_code = msubst true (transl_exp exp) in + let met_code = +@@ -342,27 +333,24 @@ + assert (Path.same path path'); + let lpath = transl_path path in + let inh = Ident.create "inh" +- and inh_vals = Ident.create "vals" +- and inh_meths = Ident.create "meths" ++ and ofs = List.length vals + 1 + and valids, methids = super in + let cl_init = + List.fold_left + (fun init (nm, id, _) -> +- Llet(StrictOpt, id, lfield inh_meths (index nm concr_meths), ++ Llet(StrictOpt, id, lfield inh (index nm concr_meths + ofs), + init)) + cl_init methids in + let cl_init = + List.fold_left + (fun init (nm, id) -> +- Llet(StrictOpt, id, lfield inh_vals (index nm vals), init)) ++ Llet(StrictOpt, id, lfield inh (index nm vals + 1), init)) + cl_init valids in + (inh_init, + Llet (Strict, inh, + Lapply(oo_prim "inherits", narrow_args @ + [lpath; Lconst(Const_pointer(if top then 1 else 0))]), +- Llet(StrictOpt, obj_init, lfield inh 0, +- Llet(Alias, inh_vals, lfield inh 1, +- Llet(Alias, inh_meths, lfield inh 2, cl_init))))) ++ Llet(StrictOpt, obj_init, lfield inh 0, cl_init))) + | _ -> + let core cl_init = + build_class_init cla true super inh_init cl_init msubst top cl +@@ -397,12 +385,16 @@ + XXX Il devrait etre peu couteux d'ecrire des classes : + class c x y = d e f + *) +-let rec transl_class_rebind obj_init cl = ++let rec transl_class_rebind obj_init cl vf = + match cl.cl_desc with + Tclass_ident path -> ++ if vf = Concrete then begin ++ try if (Env.find_class path cl.cl_env).cty_new = None then raise Exit ++ with Not_found -> raise Exit ++ end; + (path, obj_init) + | Tclass_fun (pat, _, cl, partial) -> +- let path, obj_init = transl_class_rebind obj_init cl in ++ let path, obj_init = transl_class_rebind obj_init cl vf in + let build params rem = + let param = name_pattern "param" [pat, ()] in + Lfunction (Curried, param::params, +@@ -414,14 +406,14 @@ + Lfunction (Curried, params, rem) -> build params rem + | rem -> build [] rem) + | Tclass_apply (cl, oexprs) -> +- let path, obj_init = transl_class_rebind obj_init cl in ++ let path, obj_init = transl_class_rebind obj_init cl vf in + (path, transl_apply obj_init oexprs) + | Tclass_let (rec_flag, defs, vals, cl) -> +- let path, obj_init = transl_class_rebind obj_init cl in ++ let path, obj_init = transl_class_rebind obj_init cl vf in + (path, Translcore.transl_let rec_flag defs obj_init) + | Tclass_structure _ -> raise Exit + | Tclass_constraint (cl', _, _, _) -> +- let path, obj_init = transl_class_rebind obj_init cl' in ++ let path, obj_init = transl_class_rebind obj_init cl' vf in + let rec check_constraint = function + Tcty_constr(path', _, _) when Path.same path path' -> () + | Tcty_fun (_, _, cty) -> check_constraint cty +@@ -430,21 +422,21 @@ + check_constraint cl.cl_type; + (path, obj_init) + +-let rec transl_class_rebind_0 self obj_init cl = ++let rec transl_class_rebind_0 self obj_init cl vf = + match cl.cl_desc with + Tclass_let (rec_flag, defs, vals, cl) -> +- let path, obj_init = transl_class_rebind_0 self obj_init cl in ++ let path, obj_init = transl_class_rebind_0 self obj_init cl vf in + (path, Translcore.transl_let rec_flag defs obj_init) + | _ -> +- let path, obj_init = transl_class_rebind obj_init cl in ++ let path, obj_init = transl_class_rebind obj_init cl vf in + (path, lfunction [self] obj_init) + +-let transl_class_rebind ids cl = ++let transl_class_rebind ids cl vf = + try + let obj_init = Ident.create "obj_init" + and self = Ident.create "self" in + let obj_init0 = lapply (Lvar obj_init) [Lvar self] in +- let path, obj_init' = transl_class_rebind_0 self obj_init0 cl in ++ let path, obj_init' = transl_class_rebind_0 self obj_init0 cl vf in + if not (Translcore.check_recursive_lambda ids obj_init') then + raise(Error(cl.cl_loc, Illegal_class_expr)); + let id = (obj_init' = lfunction [self] obj_init0) in +@@ -592,9 +584,9 @@ + *) + + +-let transl_class ids cl_id arity pub_meths cl = ++let transl_class ids cl_id arity pub_meths cl vflag = + (* First check if it is not only a rebind *) +- let rebind = transl_class_rebind ids cl in ++ let rebind = transl_class_rebind ids cl vflag in + if rebind <> lambda_unit then rebind else + + (* Prepare for heavy environment handling *) +@@ -696,9 +688,7 @@ + (* Simplest case: an object defined at toplevel (ids=[]) *) + if top && ids = [] then llets (ltable cla (ldirect obj_init)) else + +- let concrete = +- ids = [] || +- Typeclass.virtual_methods (Ctype.signature_of_class_type cl.cl_type) = [] ++ let concrete = (vflag = Concrete) + and lclass lam = + let cl_init = llets (Lfunction(Curried, [cla], cl_init)) in + Llet(Strict, class_init, cl_init, lam (free_variables cl_init)) +@@ -800,11 +790,11 @@ + + (* Wrapper for class compilation *) + +-let transl_class ids cl_id arity pub_meths cl = +- oo_wrap cl.cl_env false (transl_class ids cl_id arity pub_meths) cl ++let transl_class ids cl_id arity pub_meths cl vf = ++ oo_wrap cl.cl_env false (transl_class ids cl_id arity pub_meths cl) vf + + let () = +- transl_object := (fun id meths cl -> transl_class [] id 0 meths cl) ++ transl_object := (fun id meths cl -> transl_class [] id 0 meths cl Concrete) + + (* Error report *) + +Index: bytecomp/translclass.mli +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/bytecomp/translclass.mli,v +retrieving revision 1.11 +diff -u -r1.11 translclass.mli +--- bytecomp/translclass.mli 12 Aug 2004 12:55:11 -0000 1.11 ++++ bytecomp/translclass.mli 5 Apr 2006 02:26:00 -0000 +@@ -16,7 +16,8 @@ + open Lambda + + val transl_class : +- Ident.t list -> Ident.t -> int -> string list -> class_expr -> lambda;; ++ Ident.t list -> Ident.t -> ++ int -> string list -> class_expr -> Asttypes.virtual_flag -> lambda;; + + type error = Illegal_class_expr | Tags of string * string + +Index: bytecomp/translmod.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/bytecomp/translmod.ml,v +retrieving revision 1.51 +diff -u -r1.51 translmod.ml +--- bytecomp/translmod.ml 12 Aug 2004 12:55:11 -0000 1.51 ++++ bytecomp/translmod.ml 5 Apr 2006 02:26:00 -0000 +@@ -317,10 +317,10 @@ + | Tstr_open path :: rem -> + transl_structure fields cc rootpath rem + | Tstr_class cl_list :: rem -> +- let ids = List.map (fun (i, _, _, _) -> i) cl_list in ++ let ids = List.map (fun (i, _, _, _, _) -> i) cl_list in + Lletrec(List.map +- (fun (id, arity, meths, cl) -> +- (id, transl_class ids id arity meths cl)) ++ (fun (id, arity, meths, cl, vf) -> ++ (id, transl_class ids id arity meths cl vf)) + cl_list, + transl_structure (List.rev ids @ fields) cc rootpath rem) + | Tstr_cltype cl_list :: rem -> +@@ -414,11 +414,11 @@ + | Tstr_open path :: rem -> + transl_store subst rem + | Tstr_class cl_list :: rem -> +- let ids = List.map (fun (i, _, _, _) -> i) cl_list in ++ let ids = List.map (fun (i, _, _, _, _) -> i) cl_list in + let lam = + Lletrec(List.map +- (fun (id, arity, meths, cl) -> +- (id, transl_class ids id arity meths cl)) ++ (fun (id, arity, meths, cl, vf) -> ++ (id, transl_class ids id arity meths cl vf)) + cl_list, + store_idents ids) in + Lsequence(subst_lambda subst lam, +@@ -485,7 +485,7 @@ + | Tstr_modtype(id, decl) :: rem -> defined_idents rem + | Tstr_open path :: rem -> defined_idents rem + | Tstr_class cl_list :: rem -> +- List.map (fun (i, _, _, _) -> i) cl_list @ defined_idents rem ++ List.map (fun (i, _, _, _, _) -> i) cl_list @ defined_idents rem + | Tstr_cltype cl_list :: rem -> defined_idents rem + | Tstr_include(modl, ids) :: rem -> ids @ defined_idents rem + +@@ -603,14 +603,14 @@ + | Tstr_class cl_list -> + (* we need to use unique names for the classes because there might + be a value named identically *) +- let ids = List.map (fun (i, _, _, _) -> i) cl_list in ++ let ids = List.map (fun (i, _, _, _, _) -> i) cl_list in + List.iter set_toplevel_unique_name ids; + Lletrec(List.map +- (fun (id, arity, meths, cl) -> +- (id, transl_class ids id arity meths cl)) ++ (fun (id, arity, meths, cl, vf) -> ++ (id, transl_class ids id arity meths cl vf)) + cl_list, + make_sequence +- (fun (id, _, _, _) -> toploop_setvalue_id id) ++ (fun (id, _, _, _, _) -> toploop_setvalue_id id) + cl_list) + | Tstr_cltype cl_list -> + lambda_unit +Index: driver/main_args.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/driver/main_args.ml,v +retrieving revision 1.48 +diff -u -r1.48 main_args.ml +--- driver/main_args.ml 4 Jan 2006 16:55:49 -0000 1.48 ++++ driver/main_args.ml 5 Apr 2006 02:26:00 -0000 +@@ -136,11 +136,11 @@ + \032 E/e enable/disable fragile match\n\ + \032 F/f enable/disable partially applied function\n\ + \032 L/l enable/disable labels omitted in application\n\ +- \032 M/m enable/disable overridden method\n\ ++ \032 M/m enable/disable overridden methods\n\ + \032 P/p enable/disable partial match\n\ + \032 S/s enable/disable non-unit statement\n\ + \032 U/u enable/disable unused match case\n\ +- \032 V/v enable/disable hidden instance variable\n\ ++ \032 V/v enable/disable overridden instance variables\n\ + \032 Y/y enable/disable suspicious unused variables\n\ + \032 Z/z enable/disable all other unused variables\n\ + \032 X/x enable/disable all other warnings\n\ +Index: driver/optmain.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/driver/optmain.ml,v +retrieving revision 1.87 +diff -u -r1.87 optmain.ml +--- driver/optmain.ml 4 Jan 2006 16:55:49 -0000 1.87 ++++ driver/optmain.ml 5 Apr 2006 02:26:00 -0000 +@@ -173,7 +173,7 @@ + \032 P/p enable/disable partial match\n\ + \032 S/s enable/disable non-unit statement\n\ + \032 U/u enable/disable unused match case\n\ +- \032 V/v enable/disable hidden instance variables\n\ ++ \032 V/v enable/disable overridden instance variables\n\ + \032 Y/y enable/disable suspicious unused variables\n\ + \032 Z/z enable/disable all other unused variables\n\ + \032 X/x enable/disable all other warnings\n\ +Index: stdlib/camlinternalOO.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/stdlib/camlinternalOO.ml,v +retrieving revision 1.14 +diff -u -r1.14 camlinternalOO.ml +--- stdlib/camlinternalOO.ml 25 Oct 2005 18:34:07 -0000 1.14 ++++ stdlib/camlinternalOO.ml 5 Apr 2006 02:26:00 -0000 +@@ -206,7 +206,11 @@ + (table.methods_by_name, table.methods_by_label, table.hidden_meths, + table.vars, virt_meth_labs, vars) + :: table.previous_states; +- table.vars <- Vars.empty; ++ table.vars <- ++ Vars.fold ++ (fun lab info tvars -> ++ if List.mem lab vars then Vars.add lab info tvars else tvars) ++ table.vars Vars.empty; + let by_name = ref Meths.empty in + let by_label = ref Labs.empty in + List.iter2 +@@ -255,9 +259,11 @@ + index + + let new_variable table name = +- let index = new_slot table in +- table.vars <- Vars.add name index table.vars; +- index ++ try Vars.find name table.vars ++ with Not_found -> ++ let index = new_slot table in ++ table.vars <- Vars.add name index table.vars; ++ index + + let to_array arr = + if arr = Obj.magic 0 then [||] else arr +@@ -265,16 +271,17 @@ + let new_methods_variables table meths vals = + let meths = to_array meths in + let nmeths = Array.length meths and nvals = Array.length vals in +- let index = new_variable table vals.(0) in +- let res = Array.create (nmeths + 1) index in +- for i = 1 to nvals - 1 do ignore (new_variable table vals.(i)) done; ++ let res = Array.create (nmeths + nvals) 0 in + for i = 0 to nmeths - 1 do +- res.(i+1) <- get_method_label table meths.(i) ++ res.(i) <- get_method_label table meths.(i) ++ done; ++ for i = 0 to nvals - 1 do ++ res.(i+nmeths) <- new_variable table vals.(i) + done; + res + + let get_variable table name = +- Vars.find name table.vars ++ try Vars.find name table.vars with Not_found -> assert false + + let get_variables table names = + Array.map (get_variable table) names +@@ -315,9 +322,12 @@ + let init = + if top then super cla env else Obj.repr (super cla) in + widen cla; +- (init, Array.map (get_variable cla) (to_array vals), +- Array.map (fun nm -> get_method cla (get_method_label cla nm)) +- (to_array concr_meths)) ++ Array.concat ++ [[| repr init |]; ++ magic (Array.map (get_variable cla) (to_array vals) : int array); ++ Array.map ++ (fun nm -> repr (get_method cla (get_method_label cla nm) : closure)) ++ (to_array concr_meths) ] + + let make_class pub_meths class_init = + let table = create_table pub_meths in +Index: stdlib/camlinternalOO.mli +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/stdlib/camlinternalOO.mli,v +retrieving revision 1.9 +diff -u -r1.9 camlinternalOO.mli +--- stdlib/camlinternalOO.mli 25 Oct 2005 18:34:07 -0000 1.9 ++++ stdlib/camlinternalOO.mli 5 Apr 2006 02:26:00 -0000 +@@ -46,8 +46,7 @@ + val init_class : table -> unit + val inherits : + table -> string array -> string array -> string array -> +- (t * (table -> obj -> Obj.t) * t * obj) -> bool -> +- (Obj.t * int array * closure array) ++ (t * (table -> obj -> Obj.t) * t * obj) -> bool -> Obj.t array + val make_class : + string array -> (table -> Obj.t -> t) -> + (t * (table -> Obj.t -> t) * (Obj.t -> t) * Obj.t) +@@ -79,6 +78,7 @@ + + (** {6 Builtins to reduce code size} *) + ++(* + val get_const : t -> closure + val get_var : int -> closure + val get_env : int -> int -> closure +@@ -103,6 +103,7 @@ + val send_var : tag -> int -> int -> closure + val send_env : tag -> int -> int -> int -> closure + val send_meth : tag -> label -> int -> closure ++*) + + type impl = + GetConst +Index: stdlib/sys.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/stdlib/sys.ml,v +retrieving revision 1.142 +diff -u -r1.142 sys.ml +--- stdlib/sys.ml 22 Mar 2006 12:39:39 -0000 1.142 ++++ stdlib/sys.ml 5 Apr 2006 02:26:00 -0000 +@@ -78,4 +78,4 @@ + + (* OCaml version string, must be in the format described in sys.mli. *) + +-let ocaml_version = "3.10+dev4 (2006-03-22)";; ++let ocaml_version = "3.10+dev5 (2006-04-05)";; +Index: tools/depend.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/tools/depend.ml,v +retrieving revision 1.9 +diff -u -r1.9 depend.ml +--- tools/depend.ml 23 Mar 2005 03:08:37 -0000 1.9 ++++ tools/depend.ml 5 Apr 2006 02:26:00 -0000 +@@ -87,7 +87,7 @@ + + and add_class_type_field bv = function + Pctf_inher cty -> add_class_type bv cty +- | Pctf_val(_, _, oty, _) -> add_opt add_type bv oty ++ | Pctf_val(_, _, _, ty, _) -> add_type bv ty + | Pctf_virt(_, _, ty, _) -> add_type bv ty + | Pctf_meth(_, _, ty, _) -> add_type bv ty + | Pctf_cstr(ty1, ty2, _) -> add_type bv ty1; add_type bv ty2 +@@ -280,6 +280,7 @@ + and add_class_field bv = function + Pcf_inher(ce, _) -> add_class_expr bv ce + | Pcf_val(_, _, e, _) -> add_expr bv e ++ | Pcf_valvirt(_, _, ty, _) + | Pcf_virt(_, _, ty, _) -> add_type bv ty + | Pcf_meth(_, _, e, _) -> add_expr bv e + | Pcf_cstr(ty1, ty2, _) -> add_type bv ty1; add_type bv ty2 +Index: tools/ocamlprof.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/tools/ocamlprof.ml,v +retrieving revision 1.38 +diff -u -r1.38 ocamlprof.ml +--- tools/ocamlprof.ml 24 Mar 2005 17:20:54 -0000 1.38 ++++ tools/ocamlprof.ml 5 Apr 2006 02:26:00 -0000 +@@ -328,7 +328,7 @@ + rewrite_patexp_list iflag spat_sexp_list + | Pcf_init sexp -> + rewrite_exp iflag sexp +- | Pcf_virt _ | Pcf_cstr _ -> () ++ | Pcf_valvirt _ | Pcf_virt _ | Pcf_cstr _ -> () + + and rewrite_class_expr iflag cexpr = + match cexpr.pcl_desc with +Index: otherlibs/labltk/browser/searchpos.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/otherlibs/labltk/browser/searchpos.ml,v +retrieving revision 1.48 +diff -u -r1.48 searchpos.ml +--- otherlibs/labltk/browser/searchpos.ml 23 Mar 2005 03:08:37 -0000 1.48 ++++ otherlibs/labltk/browser/searchpos.ml 5 Apr 2006 02:26:01 -0000 +@@ -141,9 +141,8 @@ + List.iter cfl ~f: + begin function + Pctf_inher cty -> search_pos_class_type cty ~pos ~env +- | Pctf_val (_, _, Some ty, loc) -> ++ | Pctf_val (_, _, _, ty, loc) -> + if in_loc loc ~pos then search_pos_type ty ~pos ~env +- | Pctf_val _ -> () + | Pctf_virt (_, _, ty, loc) -> + if in_loc loc ~pos then search_pos_type ty ~pos ~env + | Pctf_meth (_, _, ty, loc) -> +@@ -675,7 +674,7 @@ + | Tstr_modtype _ -> () + | Tstr_open _ -> () + | Tstr_class l -> +- List.iter l ~f:(fun (id, _, _, cl) -> search_pos_class_expr cl ~pos) ++ List.iter l ~f:(fun (id, _, _, cl, _) -> search_pos_class_expr cl ~pos) + | Tstr_cltype _ -> () + | Tstr_include (m, _) -> search_pos_module_expr m ~pos + end +@@ -685,7 +684,8 @@ + begin function + Cf_inher (cl, _, _) -> + search_pos_class_expr cl ~pos +- | Cf_val (_, _, exp) -> search_pos_expr exp ~pos ++ | Cf_val (_, _, Some exp, _) -> search_pos_expr exp ~pos ++ | Cf_val _ -> () + | Cf_meth (_, exp) -> search_pos_expr exp ~pos + | Cf_let (_, pel, iel) -> + List.iter pel ~f: +Index: ocamldoc/Makefile +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/ocamldoc/Makefile,v +retrieving revision 1.61 +diff -u -r1.61 Makefile +--- ocamldoc/Makefile 4 Jan 2006 16:55:49 -0000 1.61 ++++ ocamldoc/Makefile 5 Apr 2006 02:26:01 -0000 +@@ -31,7 +31,7 @@ + MKDIR=mkdir -p + CP=cp -f + OCAMLDOC=ocamldoc +-OCAMLDOC_RUN=sh ./runocamldoc $(SUPPORTS_SHARED_LIBRARIES) ++OCAMLDOC_RUN=./ocamldoc.opt #sh ./runocamldoc $(SUPPORTS_SHARED_LIBRARIES) + OCAMLDOC_OPT=$(OCAMLDOC).opt + OCAMLDOC_LIBCMA=odoc_info.cma + OCAMLDOC_LIBCMI=odoc_info.cmi +@@ -188,12 +188,12 @@ + ../otherlibs/num/num.mli + + all: exe lib +- $(MAKE) manpages + + exe: $(OCAMLDOC) + lib: $(OCAMLDOC_LIBCMA) $(OCAMLDOC_LIBCMI) $(ODOC_TEST) + + opt.opt: exeopt libopt ++ $(MAKE) manpages + exeopt: $(OCAMLDOC_OPT) + libopt: $(OCAMLDOC_LIBCMXA) $(OCAMLDOC_LIBCMI) + debug: +Index: ocamldoc/odoc_ast.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/ocamldoc/odoc_ast.ml,v +retrieving revision 1.27 +diff -u -r1.27 odoc_ast.ml +--- ocamldoc/odoc_ast.ml 4 Jan 2006 16:55:49 -0000 1.27 ++++ ocamldoc/odoc_ast.ml 5 Apr 2006 02:26:01 -0000 +@@ -88,7 +88,7 @@ + ident_type_decl_list + | Typedtree.Tstr_class info_list -> + List.iter +- (fun ((id,_,_,_) as ci) -> ++ (fun ((id,_,_,_,_) as ci) -> + Hashtbl.add table (C (Name.from_ident id)) + (Typedtree.Tstr_class [ci])) + info_list +@@ -146,7 +146,7 @@ + + let search_class_exp table name = + match Hashtbl.find table (C name) with +- | (Typedtree.Tstr_class [(_,_,_,ce)]) -> ++ | (Typedtree.Tstr_class [(_,_,_,ce,_)]) -> + ( + try + let type_decl = search_type_declaration table name in +@@ -184,7 +184,7 @@ + let rec iter = function + | [] -> + raise Not_found +- | Typedtree.Cf_val (_, ident, exp) :: q ++ | Typedtree.Cf_val (_, ident, Some exp, _) :: q + when Name.from_ident ident = name -> + exp.Typedtree.exp_type + | _ :: q -> +@@ -523,7 +523,8 @@ + p_clexp.Parsetree.pcl_loc.Location.loc_end.Lexing.pos_cnum + q + +- | (Parsetree.Pcf_val (label, mutable_flag, expression, loc)) :: q -> ++ | (Parsetree.Pcf_val (label, mutable_flag, _, loc) | ++ Parsetree.Pcf_valvirt (label, mutable_flag, _, loc)) :: q -> + let complete_name = Name.concat current_class_name label in + let (info_opt, ele_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in + let type_exp = +Index: ocamldoc/odoc_sig.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/ocamldoc/odoc_sig.ml,v +retrieving revision 1.37 +diff -u -r1.37 odoc_sig.ml +--- ocamldoc/odoc_sig.ml 4 Jan 2006 16:55:50 -0000 1.37 ++++ ocamldoc/odoc_sig.ml 5 Apr 2006 02:26:01 -0000 +@@ -107,7 +107,7 @@ + | _ -> assert false + + let search_attribute_type name class_sig = +- let (_, type_expr) = Types.Vars.find name class_sig.Types.cty_vars in ++ let (_, _, type_expr) = Types.Vars.find name class_sig.Types.cty_vars in + type_expr + + let search_method_type name class_sig = +@@ -269,7 +269,7 @@ + [] -> pos_limit + | ele2 :: _ -> + match ele2 with +- Parsetree.Pctf_val (_, _, _, loc) ++ Parsetree.Pctf_val (_, _, _, _, loc) + | Parsetree.Pctf_virt (_, _, _, loc) + | Parsetree.Pctf_meth (_, _, _, loc) + | Parsetree.Pctf_cstr (_, _, loc) -> loc.Location.loc_start.Lexing.pos_cnum +@@ -330,7 +330,7 @@ + in + ([], ele_comments) + +- | Parsetree.Pctf_val (name, mutable_flag, _, loc) :: q -> ++ | Parsetree.Pctf_val (name, mutable_flag, _, _, loc) :: q -> + (* of (string * mutable_flag * core_type option * Location.t)*) + let (comment_opt, eles_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in + let complete_name = Name.concat current_class_name name in +Index: camlp4/camlp4/ast2pt.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/camlp4/camlp4/ast2pt.ml,v +retrieving revision 1.36 +diff -u -r1.36 ast2pt.ml +--- camlp4/camlp4/ast2pt.ml 29 Jun 2005 04:11:26 -0000 1.36 ++++ camlp4/camlp4/ast2pt.ml 5 Apr 2006 02:26:01 -0000 +@@ -244,6 +244,7 @@ + ; + value mkmutable m = if m then Mutable else Immutable; + value mkprivate m = if m then Private else Public; ++value mkvirtual m = if m then Virtual else Concrete; + value mktrecord (loc, n, m, t) = + (n, mkmutable m, ctyp (mkpolytype t), mkloc loc); + value mkvariant (loc, c, tl) = (c, List.map ctyp tl, mkloc loc); +@@ -862,8 +863,8 @@ + | CgInh loc ct -> [Pctf_inher (class_type ct) :: l] + | CgMth loc s pf t -> + [Pctf_meth (s, mkprivate pf, ctyp (mkpolytype t), mkloc loc) :: l] +- | CgVal loc s b t -> +- [Pctf_val (s, mkmutable b, Some (ctyp t), mkloc loc) :: l] ++ | CgVal loc s b v t -> ++ [Pctf_val (s, mkmutable b, mkvirtual v, ctyp t, mkloc loc) :: l] + | CgVir loc s b t -> + [Pctf_virt (s, mkprivate b, ctyp (mkpolytype t), mkloc loc) :: l] ] + and class_expr = +@@ -907,7 +908,9 @@ + [Pcf_meth (s, mkprivate b, e, mkloc loc) :: l] + | CrVal loc s b e -> [Pcf_val (s, mkmutable b, expr e, mkloc loc) :: l] + | CrVir loc s b t -> +- [Pcf_virt (s, mkprivate b, ctyp (mkpolytype t), mkloc loc) :: l] ] ++ [Pcf_virt (s, mkprivate b, ctyp (mkpolytype t), mkloc loc) :: l] ++ | CrVvr loc s b t -> ++ [Pcf_valvirt (s, mkmutable b, ctyp t, mkloc loc) :: l] ] + ; + + value interf ast = List.fold_right sig_item ast []; +Index: camlp4/camlp4/mLast.mli +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/camlp4/camlp4/mLast.mli,v +retrieving revision 1.18 +diff -u -r1.18 mLast.mli +--- camlp4/camlp4/mLast.mli 29 Jun 2005 04:11:26 -0000 1.18 ++++ camlp4/camlp4/mLast.mli 5 Apr 2006 02:26:01 -0000 +@@ -180,7 +180,7 @@ + | CgDcl of loc and list class_sig_item + | CgInh of loc and class_type + | CgMth of loc and string and bool and ctyp +- | CgVal of loc and string and bool and ctyp ++ | CgVal of loc and string and bool and bool and ctyp + | CgVir of loc and string and bool and ctyp ] + and class_expr = + [ CeApp of loc and class_expr and expr +@@ -196,7 +196,8 @@ + | CrIni of loc and expr + | CrMth of loc and string and bool and expr and option ctyp + | CrVal of loc and string and bool and expr +- | CrVir of loc and string and bool and ctyp ] ++ | CrVir of loc and string and bool and ctyp ++ | CrVvr of loc and string and bool and ctyp ] + ; + + external loc_of_ctyp : ctyp -> loc = "%field0"; +Index: camlp4/camlp4/reloc.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/camlp4/camlp4/reloc.ml,v +retrieving revision 1.18 +diff -u -r1.18 reloc.ml +--- camlp4/camlp4/reloc.ml 29 Jun 2005 04:11:26 -0000 1.18 ++++ camlp4/camlp4/reloc.ml 5 Apr 2006 02:26:01 -0000 +@@ -350,7 +350,7 @@ + | CgDcl loc x1 -> let nloc = floc loc in CgDcl nloc (List.map (class_sig_item floc sh) x1) + | CgInh loc x1 -> let nloc = floc loc in CgInh nloc (class_type floc sh x1) + | CgMth loc x1 x2 x3 -> let nloc = floc loc in CgMth nloc x1 x2 (ctyp floc sh x3) +- | CgVal loc x1 x2 x3 -> let nloc = floc loc in CgVal nloc x1 x2 (ctyp floc sh x3) ++ | CgVal loc x1 x2 x3 x4 -> let nloc = floc loc in CgVal nloc x1 x2 x3 (ctyp floc sh x4) + | CgVir loc x1 x2 x3 -> let nloc = floc loc in CgVir nloc x1 x2 (ctyp floc sh x3) ] + and class_expr floc sh = + self where rec self = +@@ -377,5 +377,6 @@ + | CrMth loc x1 x2 x3 x4 -> + let nloc = floc loc in CrMth nloc x1 x2 (expr floc sh x3) (option_map (ctyp floc sh) x4) + | CrVal loc x1 x2 x3 -> let nloc = floc loc in CrVal nloc x1 x2 (expr floc sh x3) +- | CrVir loc x1 x2 x3 -> let nloc = floc loc in CrVir nloc x1 x2 (ctyp floc sh x3) ] ++ | CrVir loc x1 x2 x3 -> let nloc = floc loc in CrVir nloc x1 x2 (ctyp floc sh x3) ++ | CrVvr loc x1 x2 x3 -> let nloc = floc loc in CrVvr nloc x1 x2 (ctyp floc sh x3) ] + ; +Index: camlp4/etc/pa_o.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/camlp4/etc/pa_o.ml,v +retrieving revision 1.66 +diff -u -r1.66 pa_o.ml +--- camlp4/etc/pa_o.ml 29 Jun 2005 04:11:26 -0000 1.66 ++++ camlp4/etc/pa_o.ml 5 Apr 2006 02:26:01 -0000 +@@ -1037,8 +1037,14 @@ + class_str_item: + [ [ "inherit"; ce = class_expr; pb = OPT [ "as"; i = LIDENT -> i ] -> + <:class_str_item< inherit $ce$ $opt:pb$ >> +- | "val"; mf = OPT "mutable"; lab = label; e = cvalue_binding -> +- <:class_str_item< value $opt:o2b mf$ $lab$ = $e$ >> ++ | "val"; "mutable"; lab = label; e = cvalue_binding -> ++ <:class_str_item< value mutable $lab$ = $e$ >> ++ | "val"; lab = label; e = cvalue_binding -> ++ <:class_str_item< value $lab$ = $e$ >> ++ | "val"; "mutable"; "virtual"; lab = label; ":"; t = ctyp -> ++ <:class_str_item< value virtual mutable $lab$ : $t$ >> ++ | "val"; "virtual"; mf = OPT "mutable"; lab = label; ":"; t = ctyp -> ++ <:class_str_item< value virtual $opt:o2b mf$ $lab$ : $t$ >> + | "method"; "private"; "virtual"; l = label; ":"; t = poly_type -> + <:class_str_item< method virtual private $l$ : $t$ >> + | "method"; "virtual"; "private"; l = label; ":"; t = poly_type -> +@@ -1087,8 +1093,9 @@ + ; + class_sig_item: + [ [ "inherit"; cs = class_signature -> <:class_sig_item< inherit $cs$ >> +- | "val"; mf = OPT "mutable"; l = label; ":"; t = ctyp -> +- <:class_sig_item< value $opt:o2b mf$ $l$ : $t$ >> ++ | "val"; mf = OPT "mutable"; vf = OPT "virtual"; ++ l = label; ":"; t = ctyp -> ++ <:class_sig_item< value $opt:o2b mf$ $opt:o2b vf$ $l$ : $t$ >> + | "method"; "private"; "virtual"; l = label; ":"; t = poly_type -> + <:class_sig_item< method virtual private $l$ : $t$ >> + | "method"; "virtual"; "private"; l = label; ":"; t = poly_type -> +Index: camlp4/etc/pr_o.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/camlp4/etc/pr_o.ml,v +retrieving revision 1.51 +diff -u -r1.51 pr_o.ml +--- camlp4/etc/pr_o.ml 5 Jan 2006 10:44:29 -0000 1.51 ++++ camlp4/etc/pr_o.ml 5 Apr 2006 02:26:01 -0000 +@@ -1768,10 +1768,11 @@ + [: `S LR "method"; private_flag pf; `label lab; + `S LR ":" :]; + `ctyp t "" k :] +- | MLast.CgVal _ lab mf t -> ++ | MLast.CgVal _ lab mf vf t -> + fun curr next dg k -> + [: `HVbox +- [: `S LR "val"; mutable_flag mf; `label lab; `S LR ":" :]; ++ [: `S LR "val"; mutable_flag mf; virtual_flag vf; ++ `label lab; `S LR ":" :]; + `ctyp t "" k :] + | MLast.CgVir _ lab pf t -> + fun curr next dg k -> +Index: camlp4/meta/pa_r.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/camlp4/meta/pa_r.ml,v +retrieving revision 1.64 +diff -u -r1.64 pa_r.ml +--- camlp4/meta/pa_r.ml 29 Jun 2005 04:11:26 -0000 1.64 ++++ camlp4/meta/pa_r.ml 5 Apr 2006 02:26:01 -0000 +@@ -658,7 +658,9 @@ + | "inherit"; ce = class_expr; pb = OPT as_lident -> + <:class_str_item< inherit $ce$ $opt:pb$ >> + | "value"; mf = OPT "mutable"; lab = label; e = cvalue_binding -> +- <:class_str_item< value $opt:o2b mf$ $lab$ = $e$ >> ++ <:class_str_item< value $opt:o2b mf$ $lab$ = $e$ >> ++ | "value"; "virtual"; mf = OPT "mutable"; l = label; ":"; t = ctyp -> ++ <:class_str_item< value virtual $opt:o2b mf$ $l$ : $t$ >> + | "method"; "virtual"; pf = OPT "private"; l = label; ":"; t = ctyp -> + <:class_str_item< method virtual $opt:o2b pf$ $l$ : $t$ >> + | "method"; pf = OPT "private"; l = label; topt = OPT polyt; +@@ -701,8 +703,9 @@ + [ [ "declare"; st = LIST0 [ s = class_sig_item; ";" -> s ]; "end" -> + <:class_sig_item< declare $list:st$ end >> + | "inherit"; cs = class_type -> <:class_sig_item< inherit $cs$ >> +- | "value"; mf = OPT "mutable"; l = label; ":"; t = ctyp -> +- <:class_sig_item< value $opt:o2b mf$ $l$ : $t$ >> ++ | "value"; mf = OPT "mutable"; vf = OPT "virtual"; ++ l = label; ":"; t = ctyp -> ++ <:class_sig_item< value $opt:o2b mf$ $opt:o2b vf$ $l$ : $t$ >> + | "method"; "virtual"; pf = OPT "private"; l = label; ":"; t = ctyp -> + <:class_sig_item< method virtual $opt:o2b pf$ $l$ : $t$ >> + | "method"; pf = OPT "private"; l = label; ":"; t = ctyp -> +Index: camlp4/meta/q_MLast.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/camlp4/meta/q_MLast.ml,v +retrieving revision 1.60 +diff -u -r1.60 q_MLast.ml +--- camlp4/meta/q_MLast.ml 29 Jun 2005 04:11:26 -0000 1.60 ++++ camlp4/meta/q_MLast.ml 5 Apr 2006 02:26:01 -0000 +@@ -947,6 +947,8 @@ + Qast.Node "CrDcl" [Qast.Loc; st] + | "inherit"; ce = class_expr; pb = SOPT as_lident -> + Qast.Node "CrInh" [Qast.Loc; ce; pb] ++ | "value"; "virtual"; mf = SOPT "mutable"; l = label; ":"; t = ctyp -> ++ Qast.Node "CrVvr" [Qast.Loc; l; o2b mf; t] + | "value"; mf = SOPT "mutable"; lab = label; e = cvalue_binding -> + Qast.Node "CrVal" [Qast.Loc; lab; o2b mf; e] + | "method"; "virtual"; pf = SOPT "private"; l = label; ":"; t = ctyp -> +@@ -992,8 +994,9 @@ + [ [ "declare"; st = SLIST0 [ s = class_sig_item; ";" -> s ]; "end" -> + Qast.Node "CgDcl" [Qast.Loc; st] + | "inherit"; cs = class_type -> Qast.Node "CgInh" [Qast.Loc; cs] +- | "value"; mf = SOPT "mutable"; l = label; ":"; t = ctyp -> +- Qast.Node "CgVal" [Qast.Loc; l; o2b mf; t] ++ | "value"; mf = SOPT "mutable"; vf = SOPT "virtual"; ++ l = label; ":"; t = ctyp -> ++ Qast.Node "CgVal" [Qast.Loc; l; o2b mf; o2b vf; t] + | "method"; "virtual"; pf = SOPT "private"; l = label; ":"; t = ctyp -> + Qast.Node "CgVir" [Qast.Loc; l; o2b pf; t] + | "method"; pf = SOPT "private"; l = label; ":"; t = ctyp -> +Index: camlp4/ocaml_src/camlp4/ast2pt.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/camlp4/ocaml_src/camlp4/ast2pt.ml,v +retrieving revision 1.36 +diff -u -r1.36 ast2pt.ml +--- camlp4/ocaml_src/camlp4/ast2pt.ml 29 Jun 2005 04:11:26 -0000 1.36 ++++ camlp4/ocaml_src/camlp4/ast2pt.ml 5 Apr 2006 02:26:01 -0000 +@@ -227,6 +227,7 @@ + ;; + let mkmutable m = if m then Mutable else Immutable;; + let mkprivate m = if m then Private else Public;; ++let mkvirtual m = if m then Virtual else Concrete;; + let mktrecord (loc, n, m, t) = + n, mkmutable m, ctyp (mkpolytype t), mkloc loc + ;; +@@ -878,8 +879,8 @@ + | CgInh (loc, ct) -> Pctf_inher (class_type ct) :: l + | CgMth (loc, s, pf, t) -> + Pctf_meth (s, mkprivate pf, ctyp (mkpolytype t), mkloc loc) :: l +- | CgVal (loc, s, b, t) -> +- Pctf_val (s, mkmutable b, Some (ctyp t), mkloc loc) :: l ++ | CgVal (loc, s, b, v, t) -> ++ Pctf_val (s, mkmutable b, mkvirtual v, ctyp t, mkloc loc) :: l + | CgVir (loc, s, b, t) -> + Pctf_virt (s, mkprivate b, ctyp (mkpolytype t), mkloc loc) :: l + and class_expr = +@@ -923,6 +924,8 @@ + | CrVal (loc, s, b, e) -> Pcf_val (s, mkmutable b, expr e, mkloc loc) :: l + | CrVir (loc, s, b, t) -> + Pcf_virt (s, mkprivate b, ctyp (mkpolytype t), mkloc loc) :: l ++ | CrVvr (loc, s, b, t) -> ++ Pcf_valvirt (s, mkmutable b, ctyp t, mkloc loc) :: l + ;; + + let interf ast = List.fold_right sig_item ast [];; +Index: camlp4/ocaml_src/camlp4/mLast.mli +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/camlp4/ocaml_src/camlp4/mLast.mli,v +retrieving revision 1.20 +diff -u -r1.20 mLast.mli +--- camlp4/ocaml_src/camlp4/mLast.mli 29 Jun 2005 04:11:26 -0000 1.20 ++++ camlp4/ocaml_src/camlp4/mLast.mli 5 Apr 2006 02:26:01 -0000 +@@ -180,7 +180,7 @@ + | CgDcl of loc * class_sig_item list + | CgInh of loc * class_type + | CgMth of loc * string * bool * ctyp +- | CgVal of loc * string * bool * ctyp ++ | CgVal of loc * string * bool * bool * ctyp + | CgVir of loc * string * bool * ctyp + and class_expr = + CeApp of loc * class_expr * expr +@@ -197,6 +197,7 @@ + | CrMth of loc * string * bool * expr * ctyp option + | CrVal of loc * string * bool * expr + | CrVir of loc * string * bool * ctyp ++ | CrVvr of loc * string * bool * ctyp + ;; + + external loc_of_ctyp : ctyp -> loc = "%field0";; +Index: camlp4/ocaml_src/camlp4/reloc.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/camlp4/ocaml_src/camlp4/reloc.ml,v +retrieving revision 1.20 +diff -u -r1.20 reloc.ml +--- camlp4/ocaml_src/camlp4/reloc.ml 29 Jun 2005 04:11:26 -0000 1.20 ++++ camlp4/ocaml_src/camlp4/reloc.ml 5 Apr 2006 02:26:01 -0000 +@@ -430,8 +430,8 @@ + let nloc = floc loc in CgInh (nloc, class_type floc sh x1) + | CgMth (loc, x1, x2, x3) -> + let nloc = floc loc in CgMth (nloc, x1, x2, ctyp floc sh x3) +- | CgVal (loc, x1, x2, x3) -> +- let nloc = floc loc in CgVal (nloc, x1, x2, ctyp floc sh x3) ++ | CgVal (loc, x1, x2, x3, x4) -> ++ let nloc = floc loc in CgVal (nloc, x1, x2, x3, ctyp floc sh x4) + | CgVir (loc, x1, x2, x3) -> + let nloc = floc loc in CgVir (nloc, x1, x2, ctyp floc sh x3) + in +@@ -478,6 +478,8 @@ + let nloc = floc loc in CrVal (nloc, x1, x2, expr floc sh x3) + | CrVir (loc, x1, x2, x3) -> + let nloc = floc loc in CrVir (nloc, x1, x2, ctyp floc sh x3) ++ | CrVvr (loc, x1, x2, x3) -> ++ let nloc = floc loc in CrVvr (nloc, x1, x2, ctyp floc sh x3) + in + self + ;; +Index: camlp4/ocaml_src/meta/pa_r.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/camlp4/ocaml_src/meta/pa_r.ml,v +retrieving revision 1.59 +diff -u -r1.59 pa_r.ml +--- camlp4/ocaml_src/meta/pa_r.ml 29 Jun 2005 04:11:26 -0000 1.59 ++++ camlp4/ocaml_src/meta/pa_r.ml 5 Apr 2006 02:26:01 -0000 +@@ -2161,6 +2161,15 @@ + (fun (t : 'ctyp) _ (l : 'label) (pf : string option) _ _ + (_loc : Lexing.position * Lexing.position) -> + (MLast.CrVir (_loc, l, o2b pf, t) : 'class_str_item)); ++ [Gramext.Stoken ("", "value"); Gramext.Stoken ("", "virtual"); ++ Gramext.Sopt (Gramext.Stoken ("", "mutable")); ++ Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); ++ Gramext.Stoken ("", ":"); ++ Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))], ++ Gramext.action ++ (fun (t : 'ctyp) _ (l : 'label) (mf : string option) _ _ ++ (_loc : Lexing.position * Lexing.position) -> ++ (MLast.CrVvr (_loc, l, o2b mf, t) : 'class_str_item)); + [Gramext.Stoken ("", "value"); + Gramext.Sopt (Gramext.Stoken ("", "mutable")); + Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); +@@ -2338,13 +2347,15 @@ + (MLast.CgVir (_loc, l, o2b pf, t) : 'class_sig_item)); + [Gramext.Stoken ("", "value"); + Gramext.Sopt (Gramext.Stoken ("", "mutable")); ++ Gramext.Sopt (Gramext.Stoken ("", "virtual")); + Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); + Gramext.Stoken ("", ":"); + Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))], + Gramext.action +- (fun (t : 'ctyp) _ (l : 'label) (mf : string option) _ ++ (fun (t : 'ctyp) _ (l : 'label) (vf : string option) ++ (mf : string option) _ + (_loc : Lexing.position * Lexing.position) -> +- (MLast.CgVal (_loc, l, o2b mf, t) : 'class_sig_item)); ++ (MLast.CgVal (_loc, l, o2b mf, o2b vf, t) : 'class_sig_item)); + [Gramext.Stoken ("", "inherit"); + Gramext.Snterm + (Grammar.Entry.obj (class_type : 'class_type Grammar.Entry.e))], +Index: camlp4/ocaml_src/meta/q_MLast.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/camlp4/ocaml_src/meta/q_MLast.ml,v +retrieving revision 1.65 +diff -u -r1.65 q_MLast.ml +--- camlp4/ocaml_src/meta/q_MLast.ml 12 Jan 2006 08:54:21 -0000 1.65 ++++ camlp4/ocaml_src/meta/q_MLast.ml 5 Apr 2006 02:26:01 -0000 +@@ -3152,9 +3152,9 @@ + Gramext.action + (fun (x : string) + (_loc : Lexing.position * Lexing.position) -> +- (Qast.Str x : 'e__17))])], ++ (Qast.Str x : 'e__18))])], + Gramext.action +- (fun (a : 'e__17 option) ++ (fun (a : 'e__18 option) + (_loc : Lexing.position * Lexing.position) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm +@@ -3191,9 +3191,9 @@ + Gramext.action + (fun (x : string) + (_loc : Lexing.position * Lexing.position) -> +- (Qast.Str x : 'e__16))])], ++ (Qast.Str x : 'e__17))])], + Gramext.action +- (fun (a : 'e__16 option) ++ (fun (a : 'e__17 option) + (_loc : Lexing.position * Lexing.position) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm +@@ -3216,9 +3216,9 @@ + Gramext.action + (fun (x : string) + (_loc : Lexing.position * Lexing.position) -> +- (Qast.Str x : 'e__15))])], ++ (Qast.Str x : 'e__16))])], + Gramext.action +- (fun (a : 'e__15 option) ++ (fun (a : 'e__16 option) + (_loc : Lexing.position * Lexing.position) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm +@@ -3235,6 +3235,31 @@ + (_loc : Lexing.position * Lexing.position) -> + (Qast.Node ("CrVal", [Qast.Loc; lab; o2b mf; e]) : + 'class_str_item)); ++ [Gramext.Stoken ("", "value"); Gramext.Stoken ("", "virtual"); ++ Gramext.srules ++ [[Gramext.Sopt ++ (Gramext.srules ++ [[Gramext.Stoken ("", "mutable")], ++ Gramext.action ++ (fun (x : string) ++ (_loc : Lexing.position * Lexing.position) -> ++ (Qast.Str x : 'e__15))])], ++ Gramext.action ++ (fun (a : 'e__15 option) ++ (_loc : Lexing.position * Lexing.position) -> ++ (Qast.Option a : 'a_opt)); ++ [Gramext.Snterm ++ (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], ++ Gramext.action ++ (fun (a : 'a_opt) (_loc : Lexing.position * Lexing.position) -> ++ (a : 'a_opt))]; ++ Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e)); ++ Gramext.Stoken ("", ":"); ++ Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))], ++ Gramext.action ++ (fun (t : 'ctyp) _ (l : 'label) (mf : 'a_opt) _ _ ++ (_loc : Lexing.position * Lexing.position) -> ++ (Qast.Node ("CrVvr", [Qast.Loc; l; o2b mf; t]) : 'class_str_item)); + [Gramext.Stoken ("", "inherit"); + Gramext.Snterm + (Grammar.Entry.obj (class_expr : 'class_expr Grammar.Entry.e)); +@@ -3366,9 +3391,9 @@ + Gramext.action + (fun _ (csf : 'class_sig_item) + (_loc : Lexing.position * Lexing.position) -> +- (csf : 'e__18))])], ++ (csf : 'e__19))])], + Gramext.action +- (fun (a : 'e__18 list) ++ (fun (a : 'e__19 list) + (_loc : Lexing.position * Lexing.position) -> + (Qast.List a : 'a_list)); + [Gramext.Snterm +@@ -3446,9 +3471,9 @@ + Gramext.action + (fun (x : string) + (_loc : Lexing.position * Lexing.position) -> +- (Qast.Str x : 'e__22))])], ++ (Qast.Str x : 'e__24))])], + Gramext.action +- (fun (a : 'e__22 option) ++ (fun (a : 'e__24 option) + (_loc : Lexing.position * Lexing.position) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm +@@ -3471,9 +3496,9 @@ + Gramext.action + (fun (x : string) + (_loc : Lexing.position * Lexing.position) -> +- (Qast.Str x : 'e__21))])], ++ (Qast.Str x : 'e__23))])], + Gramext.action +- (fun (a : 'e__21 option) ++ (fun (a : 'e__23 option) + (_loc : Lexing.position * Lexing.position) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm +@@ -3496,9 +3521,26 @@ + Gramext.action + (fun (x : string) + (_loc : Lexing.position * Lexing.position) -> +- (Qast.Str x : 'e__20))])], ++ (Qast.Str x : 'e__21))])], + Gramext.action +- (fun (a : 'e__20 option) ++ (fun (a : 'e__21 option) ++ (_loc : Lexing.position * Lexing.position) -> ++ (Qast.Option a : 'a_opt)); ++ [Gramext.Snterm ++ (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], ++ Gramext.action ++ (fun (a : 'a_opt) (_loc : Lexing.position * Lexing.position) -> ++ (a : 'a_opt))]; ++ Gramext.srules ++ [[Gramext.Sopt ++ (Gramext.srules ++ [[Gramext.Stoken ("", "virtual")], ++ Gramext.action ++ (fun (x : string) ++ (_loc : Lexing.position * Lexing.position) -> ++ (Qast.Str x : 'e__22))])], ++ Gramext.action ++ (fun (a : 'e__22 option) + (_loc : Lexing.position * Lexing.position) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm +@@ -3510,9 +3552,10 @@ + Gramext.Stoken ("", ":"); + Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))], + Gramext.action +- (fun (t : 'ctyp) _ (l : 'label) (mf : 'a_opt) _ ++ (fun (t : 'ctyp) _ (l : 'label) (vf : 'a_opt) (mf : 'a_opt) _ + (_loc : Lexing.position * Lexing.position) -> +- (Qast.Node ("CgVal", [Qast.Loc; l; o2b mf; t]) : 'class_sig_item)); ++ (Qast.Node ("CgVal", [Qast.Loc; l; o2b mf; o2b vf; t]) : ++ 'class_sig_item)); + [Gramext.Stoken ("", "inherit"); + Gramext.Snterm + (Grammar.Entry.obj (class_type : 'class_type Grammar.Entry.e))], +@@ -3531,9 +3574,9 @@ + Gramext.action + (fun _ (s : 'class_sig_item) + (_loc : Lexing.position * Lexing.position) -> +- (s : 'e__19))])], ++ (s : 'e__20))])], + Gramext.action +- (fun (a : 'e__19 list) ++ (fun (a : 'e__20 list) + (_loc : Lexing.position * Lexing.position) -> + (Qast.List a : 'a_list)); + [Gramext.Snterm +@@ -3556,9 +3599,9 @@ + Gramext.action + (fun (x : string) + (_loc : Lexing.position * Lexing.position) -> +- (Qast.Str x : 'e__23))])], ++ (Qast.Str x : 'e__25))])], + Gramext.action +- (fun (a : 'e__23 option) ++ (fun (a : 'e__25 option) + (_loc : Lexing.position * Lexing.position) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm +@@ -3593,9 +3636,9 @@ + Gramext.action + (fun (x : string) + (_loc : Lexing.position * Lexing.position) -> +- (Qast.Str x : 'e__24))])], ++ (Qast.Str x : 'e__26))])], + Gramext.action +- (fun (a : 'e__24 option) ++ (fun (a : 'e__26 option) + (_loc : Lexing.position * Lexing.position) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm +@@ -3713,9 +3756,9 @@ + Gramext.action + (fun (x : string) + (_loc : Lexing.position * Lexing.position) -> +- (Qast.Str x : 'e__25))])], ++ (Qast.Str x : 'e__27))])], + Gramext.action +- (fun (a : 'e__25 option) ++ (fun (a : 'e__27 option) + (_loc : Lexing.position * Lexing.position) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm +@@ -3922,9 +3965,9 @@ + Gramext.action + (fun (x : string) + (_loc : Lexing.position * Lexing.position) -> +- (Qast.Str x : 'e__26))])], ++ (Qast.Str x : 'e__28))])], + Gramext.action +- (fun (a : 'e__26 option) ++ (fun (a : 'e__28 option) + (_loc : Lexing.position * Lexing.position) -> + (Qast.Option a : 'a_opt)); + [Gramext.Snterm +@@ -4390,9 +4433,9 @@ + Gramext.action + (fun _ (e : 'expr) + (_loc : Lexing.position * Lexing.position) -> +- (e : 'e__29))])], ++ (e : 'e__31))])], + Gramext.action +- (fun (a : 'e__29 list) ++ (fun (a : 'e__31 list) + (_loc : Lexing.position * Lexing.position) -> + (Qast.List a : 'a_list)); + [Gramext.Snterm +@@ -4425,9 +4468,9 @@ + Gramext.action + (fun _ (e : 'expr) + (_loc : Lexing.position * Lexing.position) -> +- (e : 'e__28))])], ++ (e : 'e__30))])], + Gramext.action +- (fun (a : 'e__28 list) ++ (fun (a : 'e__30 list) + (_loc : Lexing.position * Lexing.position) -> + (Qast.List a : 'a_list)); + [Gramext.Snterm +@@ -4454,9 +4497,9 @@ + Gramext.action + (fun _ (e : 'expr) + (_loc : Lexing.position * Lexing.position) -> +- (e : 'e__27))])], ++ (e : 'e__29))])], + Gramext.action +- (fun (a : 'e__27 list) ++ (fun (a : 'e__29 list) + (_loc : Lexing.position * Lexing.position) -> + (Qast.List a : 'a_list)); + [Gramext.Snterm +@@ -4547,9 +4590,9 @@ + Gramext.action + (fun _ (cf : 'class_str_item) + (_loc : Lexing.position * Lexing.position) -> +- (cf : 'e__30))])], ++ (cf : 'e__32))])], + Gramext.action +- (fun (a : 'e__30 list) ++ (fun (a : 'e__32 list) + (_loc : Lexing.position * Lexing.position) -> + (Qast.List a : 'a_list)); + [Gramext.Snterm +@@ -4592,9 +4635,9 @@ + Gramext.action + (fun _ (csf : 'class_sig_item) + (_loc : Lexing.position * Lexing.position) -> +- (csf : 'e__32))])], ++ (csf : 'e__34))])], + Gramext.action +- (fun (a : 'e__32 list) ++ (fun (a : 'e__34 list) + (_loc : Lexing.position * Lexing.position) -> + (Qast.List a : 'a_list)); + [Gramext.Snterm +@@ -4623,9 +4666,9 @@ + Gramext.action + (fun _ (csf : 'class_sig_item) + (_loc : Lexing.position * Lexing.position) -> +- (csf : 'e__31))])], ++ (csf : 'e__33))])], + Gramext.action +- (fun (a : 'e__31 list) ++ (fun (a : 'e__33 list) + (_loc : Lexing.position * Lexing.position) -> + (Qast.List a : 'a_list)); + [Gramext.Snterm +Index: camlp4/top/rprint.ml +=================================================================== +RCS file: /net/yquem/devel/caml/repository/csl/camlp4/top/rprint.ml,v +retrieving revision 1.18 +diff -u -r1.18 rprint.ml +--- camlp4/top/rprint.ml 29 Jun 2005 04:11:26 -0000 1.18 ++++ camlp4/top/rprint.ml 5 Apr 2006 02:26:01 -0000 +@@ -288,8 +288,9 @@ + fprintf ppf "@[<2>method %s%s%s :@ %a;@]" + (if priv then "private " else "") (if virt then "virtual " else "") + name Toploop.print_out_type.val ty +- | Ocsg_value name mut ty -> +- fprintf ppf "@[<2>value %s%s :@ %a;@]" (if mut then "mutable " else "") ++ | Ocsg_value name mut virt ty -> ++ fprintf ppf "@[<2>value %s%s%s :@ %a;@]" ++ (if mut then "mutable " else "") (if virt then "virtual " else "") + name Toploop.print_out_type.val ty ] + ; + diff --git a/experimental/garrigue/variable-names-Tvar.diff b/experimental/garrigue/variable-names-Tvar.diff new file mode 100644 index 00000000..99ff6a24 --- /dev/null +++ b/experimental/garrigue/variable-names-Tvar.diff @@ -0,0 +1,1656 @@ +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 "@[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 "@[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 "" + | Tarrow(_, ty1, ty2, _) -> + Oval_stuff "" +@@ -327,8 +327,6 @@ + fatal_error "Printval.outval_of_value" + | Tpoly (ty, _) -> + tree_of_val (depth - 1) obj ty +- | Tunivar -> +- Oval_stuff "" + | Tpackage _ -> + Oval_stuff "" + 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 diff --git a/experimental/garrigue/variable-names.ml b/experimental/garrigue/variable-names.ml new file mode 100644 index 00000000..f3c7771a --- /dev/null +++ b/experimental/garrigue/variable-names.ml @@ -0,0 +1,4 @@ +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);; diff --git a/experimental/garrigue/varunion.ml b/experimental/garrigue/varunion.ml new file mode 100644 index 00000000..41dca65f --- /dev/null +++ b/experimental/garrigue/varunion.ml @@ -0,0 +1,435 @@ +(* cvs update -r varunion parsing typing bytecomp toplevel *) + +type t = private [> ];; +type u = private [> ] ~ [t];; +type v = [t | u];; +let f x = (x : t :> v);; + +(* bad *) +module Mix(X: sig type t = private [> ] end) + (Y: sig type t = private [> ] end) = + struct type t = [X.t | Y.t] end;; + +(* bad *) +module Mix(X: sig type t = private [> `A of int ] end) + (Y: sig type t = private [> `A of bool] ~ [X.t] end) = + struct type t = [X.t | Y.t] end;; + +(* ok *) +module Mix(X: sig type t = private [> `A of int ] end) + (Y: sig type t = private [> `A of int] ~ [X.t] end) = + struct type t = [X.t | Y.t] end;; + +(* bad *) +module Mix(X: sig type t = private [> `A of int ] end) + (Y: sig type t = private [> `B of bool] ~ [X.t] end) = + struct type t = [X.t | Y.t] end;; + +type 'a t = private [> `L of 'a] ~ [`L];; + +(* ok *) +module Mix(X: sig type t = private [> `A of int ] ~ [`B] end) + (Y: sig type t = private [> `B of bool] ~ [X.t] end) = + struct type t = [X.t | Y.t] let is_t = function #t -> true | _ -> false end;; + +module Mix(X: sig type t = private [> `A of int ] ~ [`B] end) + (Y: sig type t = private [> `B of bool] ~ [X.t] end) = + struct + type t = [X.t | Y.t] + let which = function #X.t -> `X | #Y.t -> `Y + end;; + +module Mix(I: sig type t = private [> ] ~ [`A;`B] end) + (X: sig type t = private [> I.t | `A of int ] ~ [`B] end) + (Y: sig type t = private [> I.t | `B of bool] ~ [X.t] end) = + struct + type t = [X.t | Y.t] + let which = function #X.t -> `X | #Y.t -> `Y + end;; + +(* ok *) +module M = + Mix(struct type t = [`C of char] end) + (struct type t = [`A of int | `C of char] end) + (struct type t = [`B of bool | `C of char] end);; + +(* bad *) +module M = + Mix(struct type t = [`B of bool] end) + (struct type t = [`A of int | `B of bool] end) + (struct type t = [`B of bool | `C of char] end);; + +(* ok *) +module M1 = struct type t = [`A of int | `C of char] end +module M2 = struct type t = [`B of bool | `C of char] end +module I = struct type t = [`C of char] end +module M = Mix(I)(M1)(M2) ;; + +let c = (`C 'c' : M.t) ;; + +module M(X : sig type t = private [> `A] end) = + struct let f (#X.t as x) = x end;; + +(* code generation *) +type t = private [> `A ] ~ [`B];; +match `B with #t -> 1 | `B -> 2;; + +module M : sig type t = private [> `A of int | `B] ~ [`C] end = + struct type t = [`A of int | `B | `D of bool] end;; +let f = function (`C | #M.t) -> 1+1 ;; +let f = function (`A _ | `B #M.t) -> 1+1 ;; + +(* expression *) +module Mix(X:sig type t = private [> ] val show: t -> string end) + (Y:sig type t = private [> ] ~ [X.t] val show: t -> string end) = + struct + type t = [X.t | Y.t] + let show : t -> string = function + #X.t as x -> X.show x + | #Y.t as y -> Y.show y + end;; + +module EStr = struct + type t = [`Str of string] + let show (`Str s) = s +end +module EInt = struct + type t = [`Int of int] + let show (`Int i) = string_of_int i +end +module M = Mix(EStr)(EInt);; + +module type T = sig type t = private [> ] val show: t -> string end +module Mix(X:T)(Y:T with type t = private [> ] ~ [X.t]) : + T with type t = [X.t | Y.t] = + struct + type t = [X.t | Y.t] + let show = function + #X.t as x -> X.show x + | #Y.t as y -> Y.show y + end;; +module M = Mix(EStr)(EInt);; + +(* deep *) +module M : sig type t = private [> `A] end = struct type t = [`A] end +module M' : sig type t = private [> ] end = struct type t = [M.t | `A] end;; + +(* bad *) +type t = private [> ] +type u = private [> `A of int] ~ [t] ;; + +(* ok *) +type t = private [> `A of int] +type u = private [> `A of int] ~ [t] ;; + +module F(X: sig + type t = private [> ] ~ [`A;`B;`C;`D] + type u = private [> `A|`B|`C] ~ [t; `D] +end) : sig type v = private [< X.t | X.u | `D] end = struct + open X + let f = function #u -> 1 | #t -> 2 | `D -> 3 + let g = function #u|#t|`D -> 2 + type v = [t|u|`D] +end + +(* ok *) +module M = struct type t = private [> `A] end;; +module M' : sig type t = private [> ] ~ [`A] end = M;; + +(* ok *) +module type T = sig type t = private [> ] ~ [`A] end;; +module type T' = T with type t = private [> `A];; + +(* ok *) +type t = private [> ] ~ [`A] +let f = function `A x -> x | #t -> 0 +type t' = private [< `A of int | t];; + +(* should be ok *) +module F(X:sig end) : + sig type t = private [> ] type u = private [> ] ~ [t] end = + struct type t = [ `A] type u = [`B] end +module M = F(String) +let f = function #M.t -> 1 | #M.u -> 2 +let f = function #M.t -> 1 | _ -> 2 +type t = [M.t | M.u] +let f = function #t -> 1 | _ -> 2;; +module G(X : sig type t = private [> ] type u = private [> ] ~ [t] end) = + struct let f = function #X.t -> 1 | _ -> 2 end;; +module M1 = G(struct module N = F(String) type t = N.t type u = N.u end) ;; +module M1 = G(struct type t = M.t type u = M.u end) ;; +(* bad *) +let f = function #F(String).t -> 1 | _ -> 2;; +type t = [F(String).t | M.u] +let f = function #t -> 1 | _ -> 2;; +module N : sig type t = private [> ] end = + struct type t = [F(String).t | M.u] end;; + +(* compatibility improvement *) +type a = [`A of int | `B] +type b = [`A of bool | `B] +type c = private [> ] ~ [a;b] +let f = function #c -> 1 | `A x -> truncate x +type d = private [> ] ~ [a] +let g = function #d -> 1 | `A x -> truncate x;; + + +(* Expression Problem: functorial form *) + +type num = [ `Num of int ] + +module type Exp = sig + type t = private [> num] + val eval : t -> t + val show : t -> string +end + +module Num(X : Exp) = struct + type t = num + let eval (`Num _ as x) : X.t = x + let show (`Num n) = string_of_int n +end + +type 'a add = [ `Add of 'a * 'a ] + +module Add(X : Exp with type t = private [> num | 'a add] as 'a) = struct + type t = X.t add + let show (`Add(e1, e2) : t) = "("^ X.show e1 ^"+"^ X.show e2 ^")" + let eval (`Add(e1, e2) : t) = + let e1 = X.eval e1 and e2 = X.eval e2 in + match e1, e2 with + `Num n1, `Num n2 -> `Num (n1+n2) + | `Num 0, e | e, `Num 0 -> e + | e12 -> `Add e12 +end + +type 'a mul = [`Mul of 'a * 'a] + +module Mul(X : Exp with type t = private [> num | 'a mul] as 'a) = struct + type t = X.t mul + let show (`Mul(e1, e2) : t) = "("^ X.show e1 ^"*"^ X.show e2 ^")" + let eval (`Mul(e1, e2) : t) = + let e1 = X.eval e1 and e2 = X.eval e2 in + match e1, e2 with + `Num n1, `Num n2 -> `Num (n1*n2) + | `Num 0, e | e, `Num 0 -> `Num 0 + | `Num 1, e | e, `Num 1 -> e + | e12 -> `Mul e12 +end + +module Ext(X : sig type t = private [> ] end)(Y : sig type t end) = struct + module type S = + sig + type t = private [> ] ~ [ X.t ] + val eval : t -> Y.t + val show : t -> string + end +end + +module Dummy = struct type t = [`Dummy] end + +module Mix(E : Exp)(E1 : Ext(Dummy)(E).S)(E2 : Ext(E1)(E).S) = + struct + type t = [E1.t | E2.t] + let eval = function + #E1.t as x -> E1.eval x + | #E2.t as x -> E2.eval x + let show = function + #E1.t as x -> E1.show x + | #E2.t as x -> E2.show x + end + +module rec EAdd : (Exp with type t = [num | EAdd.t add]) = + Mix(EAdd)(Num(EAdd))(Add(EAdd)) + +(* A bit heavy: one must pass E to everybody *) +module rec E : Exp with type t = [num | E.t add | E.t mul] = + Mix(E)(Mix(E)(Num(E))(Add(E)))(Mul(E)) + +let e = E.eval (`Add(`Mul(`Num 2,`Num 3),`Num 1)) + +(* Alternatives *) +(* Direct approach, no need of Mix *) +module rec E : (Exp with type t = [num | E.t add | E.t mul]) = + struct + module E1 = Num(E) + module E2 = Add(E) + module E3 = Mul(E) + type t = E.t + let show = function + | #num as x -> E1.show x + | #add as x -> E2.show x + | #mul as x -> E3.show x + let eval = function + | #num as x -> E1.eval x + | #add as x -> E2.eval x + | #mul as x -> E3.eval x + end + +(* Do functor applications in Mix *) +module type T = sig type t = private [> ] end +module type Tnum = sig type t = private [> num] end + +module Ext(E : Tnum) = struct + module type S = functor (Y : Exp with type t = E.t) -> + sig + type t = private [> num] + val eval : t -> Y.t + val show : t -> string + end +end + +module Ext'(E : Tnum)(X : T) = struct + module type S = functor (Y : Exp with type t = E.t) -> + sig + type t = private [> ] ~ [ X.t ] + val eval : t -> Y.t + val show : t -> string + end +end + +module Mix(E : Exp)(F1 : Ext(E).S)(F2 : Ext'(E)(F1(E)).S) = + struct + module E1 = F1(E) + module E2 = F2(E) + type t = [E1.t | E2.t] + let eval = function + #E1.t as x -> E1.eval x + | #E2.t as x -> E2.eval x + let show = function + #E1.t as x -> E1.show x + | #E2.t as x -> E2.show x + end + +module Join(E : Exp)(F1 : Ext(E).S)(F2 : Ext'(E)(F1(E)).S) + (E' : Exp with type t = E.t) = + Mix(E)(F1)(F2) + +module rec EAdd : (Exp with type t = [num | EAdd.t add]) = + Mix(EAdd)(Num)(Add) + +module rec EMul : (Exp with type t = [num | EMul.t mul]) = + Mix(EMul)(Num)(Mul) + +module rec E : (Exp with type t = [num | E.t add | E.t mul]) = + Mix(E)(Join(E)(Num)(Add))(Mul) + +(* Linear extension by the end: not so nice *) +module LExt(X : T) = struct + module type S = + sig + type t + val eval : t -> X.t + val show : t -> string + end +end +module LNum(E: Exp)(X : LExt(E).S with type t = private [> ] ~ [num]) = + struct + type t = [num | X.t] + let show = function + `Num n -> string_of_int n + | #X.t as x -> X.show x + let eval = function + #num as x -> x + | #X.t as x -> X.eval x + end +module LAdd(E : Exp with type t = private [> num | 'a add] as 'a) + (X : LExt(E).S with type t = private [> ] ~ [add]) = + struct + type t = [E.t add | X.t] + let show = function + `Add(e1,e2) -> "("^ E.show e1 ^"+"^ E.show e2 ^")" + | #X.t as x -> X.show x + let eval = function + `Add(e1,e2) -> + let e1 = E.eval e1 and e2 = E.eval e2 in + begin match e1, e2 with + `Num n1, `Num n2 -> `Num (n1+n2) + | `Num 0, e | e, `Num 0 -> e + | e12 -> `Add e12 + end + | #X.t as x -> X.eval x + end +module LEnd = struct + type t = [`Dummy] + let show `Dummy = "" + let eval `Dummy = `Dummy +end +module rec L : Exp with type t = [num | L.t add | `Dummy] = + LAdd(L)(LNum(L)(LEnd)) + +(* Back to first form, but add map *) + +module Num(X : Exp) = struct + type t = num + let map f x = x + let eval1 (`Num _ as x) : X.t = x + let show (`Num n) = string_of_int n +end + +module Add(X : Exp with type t = private [> num | 'a add] as 'a) = struct + type t = X.t add + let show (`Add(e1, e2) : t) = "("^ X.show e1 ^"+"^ X.show e2 ^")" + let map f (`Add(e1, e2) : t) = `Add(f e1, f e2) + let eval1 (`Add(e1, e2) as e : t) = + match e1, e2 with + `Num n1, `Num n2 -> `Num (n1+n2) + | `Num 0, e | e, `Num 0 -> e + | _ -> e +end + +module Mul(X : Exp with type t = private [> num | 'a mul] as 'a) = struct + type t = X.t mul + let show (`Mul(e1, e2) : t) = "("^ X.show e1 ^"*"^ X.show e2 ^")" + let map f (`Mul(e1, e2) : t) = `Mul(f e1, f e2) + let eval1 (`Mul(e1, e2) as e : t) = + match e1, e2 with + `Num n1, `Num n2 -> `Num (n1*n2) + | `Num 0, e | e, `Num 0 -> `Num 0 + | `Num 1, e | e, `Num 1 -> e + | _ -> e +end + +module Ext(X : sig type t = private [> ] end)(Y : sig type t end) = struct + module type S = + sig + type t = private [> ] ~ [ X.t ] + val map : (Y.t -> Y.t) -> t -> t + val eval1 : t -> Y.t + val show : t -> string + end +end + +module Mix(E : Exp)(E1 : Ext(Dummy)(E).S)(E2 : Ext(E1)(E).S) = + struct + type t = [E1.t | E2.t] + let map f = function + #E1.t as x -> (E1.map f x : E1.t :> t) + | #E2.t as x -> (E2.map f x : E2.t :> t) + let eval1 = function + #E1.t as x -> E1.eval1 x + | #E2.t as x -> E2.eval1 x + let show = function + #E1.t as x -> E1.show x + | #E2.t as x -> E2.show x + end + +module type ET = sig + type t + val map : (t -> t) -> t -> t + val eval1 : t -> t + val show : t -> string +end + +module Fin(E : ET) = struct + include E + let rec eval e = eval1 (map eval e) +end + +module rec EAdd : (Exp with type t = [num | EAdd.t add]) = + Fin(Mix(EAdd)(Num(EAdd))(Add(EAdd))) + +module rec E : Exp with type t = [num | E.t add | E.t mul] = + Fin(Mix(E)(Mix(E)(Num(E))(Add(E)))(Mul(E))) + +let e = E.eval (`Add(`Mul(`Num 2,`Num 3),`Num 1)) diff --git a/experimental/garrigue/with-module-type.diff b/experimental/garrigue/with-module-type.diff new file mode 100644 index 00000000..2b99c1f9 --- /dev/null +++ b/experimental/garrigue/with-module-type.diff @@ -0,0 +1,530 @@ +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 "@[%a@]" self#module_type mt + | _ -> pp f "@[(%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 "@[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; diff --git a/lex/.depend b/lex/.depend index 455421e7..10f90c22 100644 --- a/lex/.depend +++ b/lex/.depend @@ -3,8 +3,8 @@ compact.cmi : lexgen.cmi cset.cmi : lexer.cmi : parser.cmi lexgen.cmi : syntax.cmi -output.cmi : syntax.cmi lexgen.cmi compact.cmi common.cmi outputbis.cmi : syntax.cmi lexgen.cmi common.cmi +output.cmi : syntax.cmi lexgen.cmi compact.cmi common.cmi parser.cmi : syntax.cmi syntax.cmi : cset.cmi table.cmi : @@ -22,10 +22,10 @@ main.cmo : syntax.cmi parser.cmi outputbis.cmi output.cmi lexgen.cmi \ lexer.cmi cset.cmi compact.cmi common.cmi main.cmx : syntax.cmx parser.cmx outputbis.cmx output.cmx lexgen.cmx \ lexer.cmx cset.cmx compact.cmx common.cmx -output.cmo : lexgen.cmi compact.cmi common.cmi output.cmi -output.cmx : lexgen.cmx compact.cmx common.cmx output.cmi outputbis.cmo : lexgen.cmi common.cmi outputbis.cmi outputbis.cmx : lexgen.cmx common.cmx outputbis.cmi +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 diff --git a/lex/Makefile b/lex/Makefile index cb5df8b4..3691cb2b 100644 --- a/lex/Makefile +++ b/lex/Makefile @@ -11,13 +11,17 @@ ######################################################################### # 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 \ diff --git a/lex/Makefile.nt b/lex/Makefile.nt index 38c71f2e..6bd85604 100644 --- a/lex/Makefile.nt +++ b/lex/Makefile.nt @@ -13,15 +13,16 @@ # 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 \ diff --git a/man/ocaml.m b/man/ocaml.m index 79f81df0..5c839ea6 100644 --- a/man/ocaml.m +++ b/man/ocaml.m @@ -81,9 +81,9 @@ If the given directory starts with .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 diff --git a/man/ocamlc.m b/man/ocamlc.m index 090f1c68..adb28092 100644 --- a/man/ocamlc.m +++ b/man/ocamlc.m @@ -191,8 +191,12 @@ linking with this library automatically adds back the 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 @@ -350,9 +354,9 @@ If the given directory starts with .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 @@ -370,6 +374,9 @@ Recognize file names ending with .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 @@ -745,7 +752,7 @@ have type \ \ Non-returning statement. 22 -\ \ Camlp4 warning. +\ \ Preprocessor warning. 23 \ \ Useless record @@ -825,6 +832,21 @@ mutually recursive types. 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. @@ -878,7 +900,7 @@ 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. @@ -907,7 +929,8 @@ compiling your program with later versions of OCaml when they add new 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. diff --git a/man/ocamlopt.m b/man/ocamlopt.m index fb20ca99..a541e598 100644 --- a/man/ocamlopt.m +++ b/man/ocamlopt.m @@ -153,7 +153,12 @@ linking with this library automatically adds back the 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. @@ -260,9 +265,9 @@ If the given directory starts with .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 @@ -299,6 +304,9 @@ Recognize file names ending with 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 @@ -595,7 +603,8 @@ compiling your program with later versions of OCaml when they add new 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. diff --git a/man/ocamlrun.m b/man/ocamlrun.m index ea467ea4..810f5258 100644 --- a/man/ocamlrun.m +++ b/man/ocamlrun.m @@ -193,6 +193,9 @@ Calling of finalisation functions. 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 diff --git a/ocamlbuild/.depend b/ocamlbuild/.depend index 3b67d873..d6dda722 100644 --- a/ocamlbuild/.depend +++ b/ocamlbuild/.depend @@ -8,9 +8,9 @@ exit_codes.cmi : fda.cmi : slurp.cmi findlib.cmi : signatures.cmi command.cmi flags.cmi : tags.cmi command.cmi -glob.cmi : signatures.cmi glob_ast.cmi bool.cmi glob_ast.cmi : bool.cmi glob_lexer.cmi : glob_ast.cmi +glob.cmi : signatures.cmi glob_ast.cmi bool.cmi hooks.cmi : hygiene.cmi : slurp.cmi lexers.cmi : loc.cmi glob.cmi @@ -20,17 +20,17 @@ main.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 @@ -75,12 +75,12 @@ findlib.cmx : my_unix.cmx my_std.cmx lexers.cmx const.cmx command.cmx \ 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 \ @@ -111,6 +111,22 @@ my_unix.cmo : my_std.cmi my_unix.cmi my_unix.cmx : my_std.cmx my_unix.cmi ocaml_arch.cmo : pathname.cmi my_std.cmi command.cmi ocaml_arch.cmi ocaml_arch.cmx : pathname.cmx my_std.cmx command.cmx ocaml_arch.cmi +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 @@ -141,22 +157,6 @@ ocaml_utils.cmo : tools.cmi tags.cmi pathname.cmi param_tags.cmi options.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 \ diff --git a/ocamlbuild/Makefile b/ocamlbuild/Makefile index b40d0ead..d302d206 100644 --- a/ocamlbuild/Makefile +++ b/ocamlbuild/Makefile @@ -11,13 +11,14 @@ ######################################################################### 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) @@ -125,9 +126,11 @@ ocamlbuildlib.cmxa: ocamlbuild_pack.cmx $(EXTRA_CMX) # 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 @@ -135,13 +138,14 @@ ocamlbuild_pack.cmx: $(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 diff --git a/ocamlbuild/Makefile.noboot b/ocamlbuild/Makefile.noboot deleted file mode 100644 index 313e5689..00000000 --- a/ocamlbuild/Makefile.noboot +++ /dev/null @@ -1,227 +0,0 @@ -#(***********************************************************************) -#(* *) -#(* 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 diff --git a/ocamlbuild/command.ml b/ocamlbuild/command.ml index fc6e07cf..79e2a1dc 100644 --- a/ocamlbuild/command.ml +++ b/ocamlbuild/command.ml @@ -125,7 +125,7 @@ let virtual_solver virtual_command = (* On Windows, we need to also check for the ".exe" version of the file. *) let file_or_exe_exists file = - sys_file_exists file || (Sys.os_type = "Win32" && sys_file_exists (file ^ ".exe")) + 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]. *) @@ -393,6 +393,9 @@ let pdep tags ptag deps = 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 = diff --git a/ocamlbuild/command.mli b/ocamlbuild/command.mli index 18547a45..a28c7519 100644 --- a/ocamlbuild/command.mli +++ b/ocamlbuild/command.mli @@ -46,4 +46,6 @@ val dep : Tags.elt list -> pathname list -> unit 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 diff --git a/ocamlbuild/configuration.ml b/ocamlbuild/configuration.ml index 6290e60a..bc50a010 100644 --- a/ocamlbuild/configuration.ml +++ b/ocamlbuild/configuration.ml @@ -81,10 +81,11 @@ let tag_any tags = 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) = diff --git a/ocamlbuild/main.ml b/ocamlbuild/main.ml index 07ca9c06..d59a450b 100644 --- a/ocamlbuild/main.ml +++ b/ocamlbuild/main.ml @@ -25,7 +25,6 @@ exception Exit_build_error of string exception Exit_silently let clean () = - Log.finish (); Shell.rm_rf !Options.build_dir; if !Options.make_links then begin let entry = @@ -34,6 +33,7 @@ let clean () = in Slurp.force (Resource.clean_up_links entry) end; + Log.finish (); raise Exit_silently ;; @@ -57,7 +57,7 @@ let show_documentation () = 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"; @@ -67,6 +67,8 @@ let builtin_useful_tags = 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 @@ -74,7 +76,7 @@ let proceed () = (* 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 @@ -91,6 +93,8 @@ let proceed () = <**/*.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 @@ -201,7 +205,14 @@ let proceed () = 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 (); @@ -263,10 +274,10 @@ let proceed () = 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;; diff --git a/ocamlbuild/my_unix.ml b/ocamlbuild/my_unix.ml index fa1c5d45..5bfbee01 100644 --- a/ocamlbuild/my_unix.ml +++ b/ocamlbuild/my_unix.ml @@ -84,6 +84,12 @@ let rec readlink x = 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 diff --git a/ocamlbuild/ocaml_compiler.ml b/ocamlbuild/ocaml_compiler.ml index c270a7f6..7526598f 100644 --- a/ocamlbuild/ocaml_compiler.ml +++ b/ocamlbuild/ocaml_compiler.ml @@ -156,7 +156,7 @@ let byte_compile_ocaml_interf mli cmi env build = 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 @@ -266,6 +266,9 @@ let byte_link = byte_link_gen ocamlc_link_prog 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 = @@ -286,6 +289,9 @@ let native_link x = native_link_gen ocamlopt_link_prog 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 diff --git a/ocamlbuild/ocaml_compiler.mli b/ocamlbuild/ocaml_compiler.mli index 38206e5a..0c951abd 100644 --- a/ocamlbuild/ocaml_compiler.mli +++ b/ocamlbuild/ocaml_compiler.mli @@ -43,11 +43,13 @@ val link_gen : 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 diff --git a/ocamlbuild/ocaml_dependencies.ml b/ocamlbuild/ocaml_dependencies.ml index de2c11fa..f62eb7d4 100644 --- a/ocamlbuild/ocaml_dependencies.ml +++ b/ocamlbuild/ocaml_dependencies.ml @@ -194,12 +194,51 @@ module Make (I : INPUT) = struct 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 @@ -210,11 +249,14 @@ module Make (I : INPUT) = struct 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 diff --git a/ocamlbuild/ocaml_specific.ml b/ocamlbuild/ocaml_specific.ml index 79517a86..18ae0944 100644 --- a/ocamlbuild/ocaml_specific.ml +++ b/ocamlbuild/ocaml_specific.ml @@ -61,7 +61,9 @@ let x_p_dll = "%.p"-.-ext_dll;; (* -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" @@ -221,6 +223,15 @@ rule "ocaml: cmo* -> byte.c" ~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] @@ -239,6 +250,11 @@ rule "ocaml: cmx* & o* -> native.(o|obj)" ~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" @@ -527,11 +543,22 @@ end;; 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"]);; @@ -558,6 +585,15 @@ let () = (* 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"]; @@ -616,6 +652,8 @@ let () = (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 = @@ -666,8 +704,11 @@ flag ["ocaml"; "debug"; "pack"; "byte"] (A "-g");; 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");; @@ -694,6 +735,7 @@ flag ["ocaml"; "compile"; "no_alias_deps";] (A "-no-alias-deps");; 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");; diff --git a/ocamlbuild/ocaml_tools.ml b/ocamlbuild/ocaml_tools.ml index f4019c7a..be6fed38 100644 --- a/ocamlbuild/ocaml_tools.ml +++ b/ocamlbuild/ocaml_tools.ml @@ -73,7 +73,7 @@ let menhir_modular menhir_base mlypack mlypack_depends env build = 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 @@ -99,14 +99,14 @@ let infer_interface ml mli env build = 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 diff --git a/ocamlbuild/ocamlbuild_unix_plugin.ml b/ocamlbuild/ocamlbuild_unix_plugin.ml index 9966c4dc..2ed88b99 100644 --- a/ocamlbuild/ocamlbuild_unix_plugin.ml +++ b/ocamlbuild/ocamlbuild_unix_plugin.ml @@ -72,13 +72,22 @@ let execute_many = 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; diff --git a/ocamlbuild/options.ml b/ocamlbuild/options.ml index 5193b9b9..3d4393d3 100644 --- a/ocamlbuild/options.ml +++ b/ocamlbuild/options.ml @@ -101,7 +101,9 @@ let show_documentation = ref false 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 [] diff --git a/ocamlbuild/test/good-output b/ocamlbuild/test/good-output new file mode 100644 index 00000000..b140dab3 --- /dev/null +++ b/ocamlbuild/test/good-output @@ -0,0 +1,1473 @@ + _____ _ ____ +|_ _|__ ___| |_|___ \ + | |/ _ \/ __| __| __) | + | | __/\__ \ |_ / __/ + |_|\___||___/\__|_____| + +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 "" OK +Globexp for "" OK +Globexp for " and or " OK +Globexp for " titi" OK +Glob.eval "<[a]>" "a" = true OK +Glob.eval "<[a]>" "b" = false OK +Glob.eval "<[a]>" "a" = true OK +Glob.eval "<[a]>" "b" = false OK +Glob.eval "<[a]>" "a" = true OK +Glob.eval "<[a]>" "b" = false OK +Glob.eval "<[a-z]>" "a" = true OK +Glob.eval "<[a-z]>" "e" = true OK +Glob.eval "<[a-z]>" "k" = true OK +Glob.eval "<[a-z]>" "z" = true OK +Glob.eval "<[a-z]>" "0" = false OK +Glob.eval "<[a-z]>" "A" = false OK +Glob.eval "<[a-z]>" "~" = false OK +Glob.eval "<[a-z]>" "a" = true OK +Glob.eval "<[a-z]>" "e" = true OK +Glob.eval "<[a-z]>" "k" = true OK +Glob.eval "<[a-z]>" "z" = true OK +Glob.eval "<[a-z]>" "0" = false OK +Glob.eval "<[a-z]>" "A" = false OK +Glob.eval "<[a-z]>" "~" = false OK +Glob.eval "<[a-z]>" "a" = true OK +Glob.eval "<[a-z]>" "e" = true OK +Glob.eval "<[a-z]>" "k" = true OK +Glob.eval "<[a-z]>" "z" = true OK +Glob.eval "<[a-z]>" "0" = false OK +Glob.eval "<[a-z]>" "A" = false OK +Glob.eval "<[a-z]>" "~" = false OK +Glob.eval "<[a-z][0-9]>" "a0" = true OK +Glob.eval "<[a-z][0-9]>" "b9" = true OK +Glob.eval "<[a-z][0-9]>" "a00" = false OK +Glob.eval "<[a-z][0-9]>" "a0a" = false OK +Glob.eval "<[a-z][0-9]>" "b0a" = false OK +Glob.eval "<[a-z][0-9]>" "isduis" = false OK +Glob.eval "<[a-z][0-9]>" "" = false OK +Glob.eval "<[a-z][0-9]>" "a0" = true OK +Glob.eval "<[a-z][0-9]>" "b9" = true OK +Glob.eval "<[a-z][0-9]>" "a00" = false OK +Glob.eval "<[a-z][0-9]>" "a0a" = false OK +Glob.eval "<[a-z][0-9]>" "b0a" = false OK +Glob.eval "<[a-z][0-9]>" "isduis" = false OK +Glob.eval "<[a-z][0-9]>" "" = false OK +Glob.eval "<[a-z][0-9]>" "a0" = true OK +Glob.eval "<[a-z][0-9]>" "b9" = true OK +Glob.eval "<[a-z][0-9]>" "a00" = false OK +Glob.eval "<[a-z][0-9]>" "a0a" = false OK +Glob.eval "<[a-z][0-9]>" "b0a" = false OK +Glob.eval "<[a-z][0-9]>" "isduis" = false OK +Glob.eval "<[a-z][0-9]>" "" = false OK +Glob.eval "" "hello" = true OK +Glob.eval "" "helli" = false OK +Glob.eval "" "hello" = true OK +Glob.eval "" "helli" = false OK +Glob.eval "" "hello" = true OK +Glob.eval "" "helli" = false OK +Glob.eval "\"hello\"" "hello" = true OK +Glob.eval "\"hello\"" "heidi" = false OK +Glob.eval "\"hello\"" "hello" = true OK +Glob.eval "\"hello\"" "heidi" = false OK +Glob.eval "\"hello\"" "hello" = true OK +Glob.eval "\"hello\"" "heidi" = false OK +Glob.eval "<*>" "" = true OK +Glob.eval "<*>" "a" = true OK +Glob.eval "<*>" "ax" = true OK +Glob.eval "<*>" "" = true OK +Glob.eval "<*>" "a" = true OK +Glob.eval "<*>" "ax" = true OK +Glob.eval "<*>" "" = true OK +Glob.eval "<*>" "a" = true OK +Glob.eval "<*>" "ax" = true OK +Glob.eval "" "ab" = true OK +Glob.eval "" "acb" = true OK +Glob.eval "" "axxxxxb" = true OK +Glob.eval "" "ababbababb" = true OK +Glob.eval "" "abx" = false OK +Glob.eval "" "xxxxxab" = false OK +Glob.eval "" "xab" = false OK +Glob.eval "" "ab" = true OK +Glob.eval "" "acb" = true OK +Glob.eval "" "axxxxxb" = true OK +Glob.eval "" "ababbababb" = true OK +Glob.eval "" "abx" = false OK +Glob.eval "" "xxxxxab" = false OK +Glob.eval "" "xab" = false OK +Glob.eval "" "ab" = true OK +Glob.eval "" "acb" = true OK +Glob.eval "" "axxxxxb" = true OK +Glob.eval "" "ababbababb" = true OK +Glob.eval "" "abx" = false OK +Glob.eval "" "xxxxxab" = false OK +Glob.eval "" "xab" = false OK +Glob.eval "<*.ml>" "hello.ml" = true OK +Glob.eval "<*.ml>" ".ml" = true OK +Glob.eval "<*.ml>" "ml" = false OK +Glob.eval "<*.ml>" "" = false OK +Glob.eval "<*.ml>" "toto.mli" = false OK +Glob.eval "<*.ml>" "hello.ml" = true OK +Glob.eval "<*.ml>" ".ml" = true OK +Glob.eval "<*.ml>" "ml" = false OK +Glob.eval "<*.ml>" "" = false OK +Glob.eval "<*.ml>" "toto.mli" = false OK +Glob.eval "<*.ml>" "hello.ml" = true OK +Glob.eval "<*.ml>" ".ml" = true OK +Glob.eval "<*.ml>" "ml" = false OK +Glob.eval "<*.ml>" "" = false OK +Glob.eval "<*.ml>" "toto.mli" = false OK +Glob.eval "" "a" = true OK +Glob.eval "" "" = false OK +Glob.eval "" "aa" = false OK +Glob.eval "" "ba" = false OK +Glob.eval "" "ab" = false OK +Glob.eval "" "abaa" = false OK +Glob.eval "" "a" = true OK +Glob.eval "" "" = false OK +Glob.eval "" "aa" = false OK +Glob.eval "" "ba" = false OK +Glob.eval "" "ab" = false OK +Glob.eval "" "abaa" = false OK +Glob.eval "" "a" = true OK +Glob.eval "" "" = false OK +Glob.eval "" "aa" = false OK +Glob.eval "" "ba" = false OK +Glob.eval "" "ab" = false OK +Glob.eval "" "abaa" = false OK +Glob.eval "" "ab" = true OK +Glob.eval "" "" = false OK +Glob.eval "" "abab" = false OK +Glob.eval "" "aba" = false OK +Glob.eval "" "abx" = false OK +Glob.eval "" "ab" = true OK +Glob.eval "" "" = false OK +Glob.eval "" "abab" = false OK +Glob.eval "" "aba" = false OK +Glob.eval "" "abx" = false OK +Glob.eval "" "ab" = true OK +Glob.eval "" "" = false OK +Glob.eval "" "abab" = false OK +Glob.eval "" "aba" = false OK +Glob.eval "" "abx" = false OK +Glob.eval "" "abac" = true OK +Glob.eval "" "abxc" = true OK +Glob.eval "" "abab" = false OK +Glob.eval "" "ababab" = false OK +Glob.eval "" "ababa" = false OK +Glob.eval "" "abac" = true OK +Glob.eval "" "abxc" = true OK +Glob.eval "" "abab" = false OK +Glob.eval "" "ababab" = false OK +Glob.eval "" "ababa" = false OK +Glob.eval "" "abac" = true OK +Glob.eval "" "abxc" = true OK +Glob.eval "" "abab" = false OK +Glob.eval "" "ababab" = false OK +Glob.eval "" "ababa" = false OK +Glob.eval "<*ab?cd*>" "123abecd345" = true OK +Glob.eval "<*ab?cd*>" "abccd" = true OK +Glob.eval "<*ab?cd*>" "abccd345" = true OK +Glob.eval "<*ab?cd*>" "ababcababccdab" = true OK +Glob.eval "<*ab?cd*>" "abcd" = false OK +Glob.eval "<*ab?cd*>" "aaaaabcdababcd" = false OK +Glob.eval "<*ab?cd*>" "123abecd345" = true OK +Glob.eval "<*ab?cd*>" "abccd" = true OK +Glob.eval "<*ab?cd*>" "abccd345" = true OK +Glob.eval "<*ab?cd*>" "ababcababccdab" = true OK +Glob.eval "<*ab?cd*>" "abcd" = false OK +Glob.eval "<*ab?cd*>" "aaaaabcdababcd" = false OK +Glob.eval "<*ab?cd*>" "123abecd345" = true OK +Glob.eval "<*ab?cd*>" "abccd" = true OK +Glob.eval "<*ab?cd*>" "abccd345" = true OK +Glob.eval "<*ab?cd*>" "ababcababccdab" = true OK +Glob.eval "<*ab?cd*>" "abcd" = false OK +Glob.eval "<*ab?cd*>" "aaaaabcdababcd" = false OK +Glob.eval "<*this*is*a*test*>" "this is a test" = true OK +Glob.eval "<*this*is*a*test*>" "You know this is a test really" = true OK +Glob.eval "<*this*is*a*test*>" "thisisatest" = true OK +Glob.eval "<*this*is*a*test*>" "thisatest" = false OK +Glob.eval "<*this*is*a*test*>" "this is a test" = true OK +Glob.eval "<*this*is*a*test*>" "You know this is a test really" = true OK +Glob.eval "<*this*is*a*test*>" "thisisatest" = true OK +Glob.eval "<*this*is*a*test*>" "thisatest" = false OK +Glob.eval "<*this*is*a*test*>" "this is a test" = true OK +Glob.eval "<*this*is*a*test*>" "You know this is a test really" = true OK +Glob.eval "<*this*is*a*test*>" "thisisatest" = true OK +Glob.eval "<*this*is*a*test*>" "thisatest" = false OK +Glob.eval "" "bxx" = true OK +Glob.eval "" "bx" = true OK +Glob.eval "" "aaab" = false OK +Glob.eval "" "" = false OK +Glob.eval "" "bxx" = true OK +Glob.eval "" "bx" = true OK +Glob.eval "" "aaab" = false OK +Glob.eval "" "" = false OK +Glob.eval "" "bxx" = true OK +Glob.eval "" "bx" = true OK +Glob.eval "" "aaab" = false OK +Glob.eval "" "" = false OK +Glob.eval "<*>" "" = true OK +Glob.eval "<*>" "a" = true OK +Glob.eval "<*>" "aaa" = true OK +Glob.eval "<*>" "aaaaa" = true OK +Glob.eval "<*>" "" = true OK +Glob.eval "<*>" "a" = true OK +Glob.eval "<*>" "aaa" = true OK +Glob.eval "<*>" "aaaaa" = true OK +Glob.eval "<*>" "" = true OK +Glob.eval "<*>" "a" = true OK +Glob.eval "<*>" "aaa" = true OK +Glob.eval "<*>" "aaaaa" = true OK +Glob.eval "" "a" = true OK +Glob.eval "" "" = false OK +Glob.eval "" "aaa" = false OK +Glob.eval "" "aaaaa" = false OK +Glob.eval "" "a" = true OK +Glob.eval "" "" = false OK +Glob.eval "" "aaa" = false OK +Glob.eval "" "aaaaa" = false OK +Glob.eval "" "a" = true OK +Glob.eval "" "" = false OK +Glob.eval "" "aaa" = false OK +Glob.eval "" "aaaaa" = false OK +Glob.eval "<{a,b}>" "a" = true OK +Glob.eval "<{a,b}>" "b" = true OK +Glob.eval "<{a,b}>" "" = false OK +Glob.eval "<{a,b}>" "aa" = false OK +Glob.eval "<{a,b}>" "ab" = false OK +Glob.eval "<{a,b}>" "ba" = false OK +Glob.eval "<{a,b}>" "bb" = false OK +Glob.eval "<{a,b}>" "c" = false OK +Glob.eval "<{a,b}>" "a" = true OK +Glob.eval "<{a,b}>" "b" = true OK +Glob.eval "<{a,b}>" "" = false OK +Glob.eval "<{a,b}>" "aa" = false OK +Glob.eval "<{a,b}>" "ab" = false OK +Glob.eval "<{a,b}>" "ba" = false OK +Glob.eval "<{a,b}>" "bb" = false OK +Glob.eval "<{a,b}>" "c" = false OK +Glob.eval "<{a,b}>" "a" = true OK +Glob.eval "<{a,b}>" "b" = true OK +Glob.eval "<{a,b}>" "" = false OK +Glob.eval "<{a,b}>" "aa" = false OK +Glob.eval "<{a,b}>" "ab" = false OK +Glob.eval "<{a,b}>" "ba" = false OK +Glob.eval "<{a,b}>" "bb" = false OK +Glob.eval "<{a,b}>" "c" = false OK +Glob.eval "" "toto.ml" = true OK +Glob.eval "" "toto.mli" = true OK +Glob.eval "" "toto." = false OK +Glob.eval "" "toto.mll" = false OK +Glob.eval "" "toto.ml" = true OK +Glob.eval "" "toto.mli" = true OK +Glob.eval "" "toto." = false OK +Glob.eval "" "toto.mll" = false OK +Glob.eval "" "toto.ml" = true OK +Glob.eval "" "toto.mli" = true OK +Glob.eval "" "toto." = false OK +Glob.eval "" "toto.mll" = false OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "acf" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "acg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "adf" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "adg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "aef" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "aeg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bcf" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bcg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bdf" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bdg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bef" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "beg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "afg" = false OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "af" = false OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "aee" = false OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "acf" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "acg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "adf" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "adg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "aef" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "aeg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bcf" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bcg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bdf" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bdg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bef" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "beg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "afg" = false OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "af" = false OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "aee" = false OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "acf" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "acg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "adf" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "adg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "aef" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "aeg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bcf" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bcg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bdf" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bdg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bef" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "beg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "afg" = false OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "af" = false OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "aee" = false OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "a.ml" = true OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "b.ml" = true OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "a.mli" = true OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "hello.ml" = false OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "a.mli.x" = false OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "a.ml" = true OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "b.ml" = true OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "a.mli" = true OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "hello.ml" = false OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "a.mli.x" = false OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "a.ml" = true OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "b.ml" = true OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "a.mli" = true OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "hello.ml" = false OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "a.mli.x" = false OK +Glob.eval "<*>" "alpha" = true OK +Glob.eval "<*>" "beta" = true OK +Glob.eval "<*>" "alpha/beta" = false OK +Glob.eval "<*>" "gamma/delta" = false OK +Glob.eval "<*>" "alpha" = true OK +Glob.eval "<*>" "beta" = true OK +Glob.eval "<*>" "alpha/beta" = false OK +Glob.eval "<*>" "gamma/delta" = false OK +Glob.eval "<*>" "alpha" = true OK +Glob.eval "<*>" "beta" = true OK +Glob.eval "<*>" "alpha/beta" = false OK +Glob.eval "<*>" "gamma/delta" = false OK +Glob.eval "" "alpha/beta" = true OK +Glob.eval "" "alpha/gamma/beta" = true OK +Glob.eval "" "alpha/gamma/delta/beta" = true OK +Glob.eval "" "alpha" = false OK +Glob.eval "" "beta" = false OK +Glob.eval "" "gamma/delta" = false OK +Glob.eval "" "alpha/beta" = true OK +Glob.eval "" "alpha/gamma/beta" = true OK +Glob.eval "" "alpha/gamma/delta/beta" = true OK +Glob.eval "" "alpha" = false OK +Glob.eval "" "beta" = false OK +Glob.eval "" "gamma/delta" = false OK +Glob.eval "" "alpha/beta" = true OK +Glob.eval "" "alpha/gamma/beta" = true OK +Glob.eval "" "alpha/gamma/delta/beta" = true OK +Glob.eval "" "alpha" = false OK +Glob.eval "" "beta" = false OK +Glob.eval "" "gamma/delta" = false OK +Glob.eval "<**/*.ml>" "toto.ml" = true OK +Glob.eval "<**/*.ml>" "toto/tata.ml" = true OK +Glob.eval "<**/*.ml>" "alpha/gamma/delta/beta.ml" = true OK +Glob.eval "<**/*.ml>" "toto.mli" = false OK +Glob.eval "<**/*.ml>" "toto.ml" = true OK +Glob.eval "<**/*.ml>" "toto/tata.ml" = true OK +Glob.eval "<**/*.ml>" "alpha/gamma/delta/beta.ml" = true OK +Glob.eval "<**/*.ml>" "toto.mli" = false OK +Glob.eval "<**/*.ml>" "toto.ml" = true OK +Glob.eval "<**/*.ml>" "toto/tata.ml" = true OK +Glob.eval "<**/*.ml>" "alpha/gamma/delta/beta.ml" = true OK +Glob.eval "<**/*.ml>" "toto.mli" = false OK +Glob.eval "" "toto/" = true OK +Glob.eval "" "toto/tata" = true OK +Glob.eval "" "toto/alpha/gamma/delta/beta.ml" = true OK +Glob.eval "" "toto" = true OK +Glob.eval "" "toto2/tata" = false OK +Glob.eval "" "tata/titi" = false OK +Glob.eval "" "toto/" = true OK +Glob.eval "" "toto/tata" = true OK +Glob.eval "" "toto/alpha/gamma/delta/beta.ml" = true OK +Glob.eval "" "toto" = true OK +Glob.eval "" "toto2/tata" = false OK +Glob.eval "" "tata/titi" = false OK +Glob.eval "" "toto/" = true OK +Glob.eval "" "toto/tata" = true OK +Glob.eval "" "toto/alpha/gamma/delta/beta.ml" = true OK +Glob.eval "" "toto" = true OK +Glob.eval "" "toto2/tata" = false OK +Glob.eval "" "tata/titi" = false OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libfoo.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "src/bar/libfoo.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "otherlibs/unix/libunix.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "otherlibsliblib/unlibix/libunix.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libfoo/libbar.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "src/libfoo/boo/libbar.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "bar" = None OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libbar/foo.a" = None OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libfoo.b.a" = None OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libfoo.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "src/bar/libfoo.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "otherlibs/unix/libunix.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "otherlibsliblib/unlibix/libunix.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libfoo/libbar.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "src/libfoo/boo/libbar.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "bar" = None OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libbar/foo.a" = None OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libfoo.b.a" = None OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libfoo.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "src/bar/libfoo.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "otherlibs/unix/libunix.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "otherlibsliblib/unlibix/libunix.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libfoo/libbar.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "src/libfoo/boo/libbar.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "bar" = None OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libbar/foo.a" = None OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libfoo.b.a" = None OK + _____ _ _ ___ +|_ _|__ ___| |_/ |/ _ \ + | |/ _ \/ __| __| | | | | + | | __/\__ \ |_| | |_| | + |_|\___||___/\__|_|\___/ + +Globexp for "\"hello\"" OK +Globexp for "" OK +Globexp for "" OK +Globexp for " and or " OK +Globexp for " titi" OK +Glob.eval "<[a]>" "a" = true OK +Glob.eval "<[a]>" "b" = false OK +Glob.eval "<[a]>" "a" = true OK +Glob.eval "<[a]>" "b" = false OK +Glob.eval "<[a]>" "a" = true OK +Glob.eval "<[a]>" "b" = false OK +Glob.eval "<[a-z]>" "a" = true OK +Glob.eval "<[a-z]>" "e" = true OK +Glob.eval "<[a-z]>" "k" = true OK +Glob.eval "<[a-z]>" "z" = true OK +Glob.eval "<[a-z]>" "0" = false OK +Glob.eval "<[a-z]>" "A" = false OK +Glob.eval "<[a-z]>" "~" = false OK +Glob.eval "<[a-z]>" "a" = true OK +Glob.eval "<[a-z]>" "e" = true OK +Glob.eval "<[a-z]>" "k" = true OK +Glob.eval "<[a-z]>" "z" = true OK +Glob.eval "<[a-z]>" "0" = false OK +Glob.eval "<[a-z]>" "A" = false OK +Glob.eval "<[a-z]>" "~" = false OK +Glob.eval "<[a-z]>" "a" = true OK +Glob.eval "<[a-z]>" "e" = true OK +Glob.eval "<[a-z]>" "k" = true OK +Glob.eval "<[a-z]>" "z" = true OK +Glob.eval "<[a-z]>" "0" = false OK +Glob.eval "<[a-z]>" "A" = false OK +Glob.eval "<[a-z]>" "~" = false OK +Glob.eval "<[a-z][0-9]>" "a0" = true OK +Glob.eval "<[a-z][0-9]>" "b9" = true OK +Glob.eval "<[a-z][0-9]>" "a00" = false OK +Glob.eval "<[a-z][0-9]>" "a0a" = false OK +Glob.eval "<[a-z][0-9]>" "b0a" = false OK +Glob.eval "<[a-z][0-9]>" "isduis" = false OK +Glob.eval "<[a-z][0-9]>" "" = false OK +Glob.eval "<[a-z][0-9]>" "a0" = true OK +Glob.eval "<[a-z][0-9]>" "b9" = true OK +Glob.eval "<[a-z][0-9]>" "a00" = false OK +Glob.eval "<[a-z][0-9]>" "a0a" = false OK +Glob.eval "<[a-z][0-9]>" "b0a" = false OK +Glob.eval "<[a-z][0-9]>" "isduis" = false OK +Glob.eval "<[a-z][0-9]>" "" = false OK +Glob.eval "<[a-z][0-9]>" "a0" = true OK +Glob.eval "<[a-z][0-9]>" "b9" = true OK +Glob.eval "<[a-z][0-9]>" "a00" = false OK +Glob.eval "<[a-z][0-9]>" "a0a" = false OK +Glob.eval "<[a-z][0-9]>" "b0a" = false OK +Glob.eval "<[a-z][0-9]>" "isduis" = false OK +Glob.eval "<[a-z][0-9]>" "" = false OK +Glob.eval "" "hello" = true OK +Glob.eval "" "helli" = false OK +Glob.eval "" "hello" = true OK +Glob.eval "" "helli" = false OK +Glob.eval "" "hello" = true OK +Glob.eval "" "helli" = false OK +Glob.eval "\"hello\"" "hello" = true OK +Glob.eval "\"hello\"" "heidi" = false OK +Glob.eval "\"hello\"" "hello" = true OK +Glob.eval "\"hello\"" "heidi" = false OK +Glob.eval "\"hello\"" "hello" = true OK +Glob.eval "\"hello\"" "heidi" = false OK +Glob.eval "<*>" "" = true OK +Glob.eval "<*>" "a" = true OK +Glob.eval "<*>" "ax" = true OK +Glob.eval "<*>" "" = true OK +Glob.eval "<*>" "a" = true OK +Glob.eval "<*>" "ax" = true OK +Glob.eval "<*>" "" = true OK +Glob.eval "<*>" "a" = true OK +Glob.eval "<*>" "ax" = true OK +Glob.eval "" "ab" = true OK +Glob.eval "" "acb" = true OK +Glob.eval "" "axxxxxb" = true OK +Glob.eval "" "ababbababb" = true OK +Glob.eval "" "abx" = false OK +Glob.eval "" "xxxxxab" = false OK +Glob.eval "" "xab" = false OK +Glob.eval "" "ab" = true OK +Glob.eval "" "acb" = true OK +Glob.eval "" "axxxxxb" = true OK +Glob.eval "" "ababbababb" = true OK +Glob.eval "" "abx" = false OK +Glob.eval "" "xxxxxab" = false OK +Glob.eval "" "xab" = false OK +Glob.eval "" "ab" = true OK +Glob.eval "" "acb" = true OK +Glob.eval "" "axxxxxb" = true OK +Glob.eval "" "ababbababb" = true OK +Glob.eval "" "abx" = false OK +Glob.eval "" "xxxxxab" = false OK +Glob.eval "" "xab" = false OK +Glob.eval "<*.ml>" "hello.ml" = true OK +Glob.eval "<*.ml>" ".ml" = true OK +Glob.eval "<*.ml>" "ml" = false OK +Glob.eval "<*.ml>" "" = false OK +Glob.eval "<*.ml>" "toto.mli" = false OK +Glob.eval "<*.ml>" "hello.ml" = true OK +Glob.eval "<*.ml>" ".ml" = true OK +Glob.eval "<*.ml>" "ml" = false OK +Glob.eval "<*.ml>" "" = false OK +Glob.eval "<*.ml>" "toto.mli" = false OK +Glob.eval "<*.ml>" "hello.ml" = true OK +Glob.eval "<*.ml>" ".ml" = true OK +Glob.eval "<*.ml>" "ml" = false OK +Glob.eval "<*.ml>" "" = false OK +Glob.eval "<*.ml>" "toto.mli" = false OK +Glob.eval "" "a" = true OK +Glob.eval "" "" = false OK +Glob.eval "" "aa" = false OK +Glob.eval "" "ba" = false OK +Glob.eval "" "ab" = false OK +Glob.eval "" "abaa" = false OK +Glob.eval "" "a" = true OK +Glob.eval "" "" = false OK +Glob.eval "" "aa" = false OK +Glob.eval "" "ba" = false OK +Glob.eval "" "ab" = false OK +Glob.eval "" "abaa" = false OK +Glob.eval "" "a" = true OK +Glob.eval "" "" = false OK +Glob.eval "" "aa" = false OK +Glob.eval "" "ba" = false OK +Glob.eval "" "ab" = false OK +Glob.eval "" "abaa" = false OK +Glob.eval "" "ab" = true OK +Glob.eval "" "" = false OK +Glob.eval "" "abab" = false OK +Glob.eval "" "aba" = false OK +Glob.eval "" "abx" = false OK +Glob.eval "" "ab" = true OK +Glob.eval "" "" = false OK +Glob.eval "" "abab" = false OK +Glob.eval "" "aba" = false OK +Glob.eval "" "abx" = false OK +Glob.eval "" "ab" = true OK +Glob.eval "" "" = false OK +Glob.eval "" "abab" = false OK +Glob.eval "" "aba" = false OK +Glob.eval "" "abx" = false OK +Glob.eval "" "abac" = true OK +Glob.eval "" "abxc" = true OK +Glob.eval "" "abab" = false OK +Glob.eval "" "ababab" = false OK +Glob.eval "" "ababa" = false OK +Glob.eval "" "abac" = true OK +Glob.eval "" "abxc" = true OK +Glob.eval "" "abab" = false OK +Glob.eval "" "ababab" = false OK +Glob.eval "" "ababa" = false OK +Glob.eval "" "abac" = true OK +Glob.eval "" "abxc" = true OK +Glob.eval "" "abab" = false OK +Glob.eval "" "ababab" = false OK +Glob.eval "" "ababa" = false OK +Glob.eval "<*ab?cd*>" "123abecd345" = true OK +Glob.eval "<*ab?cd*>" "abccd" = true OK +Glob.eval "<*ab?cd*>" "abccd345" = true OK +Glob.eval "<*ab?cd*>" "ababcababccdab" = true OK +Glob.eval "<*ab?cd*>" "abcd" = false OK +Glob.eval "<*ab?cd*>" "aaaaabcdababcd" = false OK +Glob.eval "<*ab?cd*>" "123abecd345" = true OK +Glob.eval "<*ab?cd*>" "abccd" = true OK +Glob.eval "<*ab?cd*>" "abccd345" = true OK +Glob.eval "<*ab?cd*>" "ababcababccdab" = true OK +Glob.eval "<*ab?cd*>" "abcd" = false OK +Glob.eval "<*ab?cd*>" "aaaaabcdababcd" = false OK +Glob.eval "<*ab?cd*>" "123abecd345" = true OK +Glob.eval "<*ab?cd*>" "abccd" = true OK +Glob.eval "<*ab?cd*>" "abccd345" = true OK +Glob.eval "<*ab?cd*>" "ababcababccdab" = true OK +Glob.eval "<*ab?cd*>" "abcd" = false OK +Glob.eval "<*ab?cd*>" "aaaaabcdababcd" = false OK +Glob.eval "<*this*is*a*test*>" "this is a test" = true OK +Glob.eval "<*this*is*a*test*>" "You know this is a test really" = true OK +Glob.eval "<*this*is*a*test*>" "thisisatest" = true OK +Glob.eval "<*this*is*a*test*>" "thisatest" = false OK +Glob.eval "<*this*is*a*test*>" "this is a test" = true OK +Glob.eval "<*this*is*a*test*>" "You know this is a test really" = true OK +Glob.eval "<*this*is*a*test*>" "thisisatest" = true OK +Glob.eval "<*this*is*a*test*>" "thisatest" = false OK +Glob.eval "<*this*is*a*test*>" "this is a test" = true OK +Glob.eval "<*this*is*a*test*>" "You know this is a test really" = true OK +Glob.eval "<*this*is*a*test*>" "thisisatest" = true OK +Glob.eval "<*this*is*a*test*>" "thisatest" = false OK +Glob.eval "" "bxx" = true OK +Glob.eval "" "bx" = true OK +Glob.eval "" "aaab" = false OK +Glob.eval "" "" = false OK +Glob.eval "" "bxx" = true OK +Glob.eval "" "bx" = true OK +Glob.eval "" "aaab" = false OK +Glob.eval "" "" = false OK +Glob.eval "" "bxx" = true OK +Glob.eval "" "bx" = true OK +Glob.eval "" "aaab" = false OK +Glob.eval "" "" = false OK +Glob.eval "<*>" "" = true OK +Glob.eval "<*>" "a" = true OK +Glob.eval "<*>" "aaa" = true OK +Glob.eval "<*>" "aaaaa" = true OK +Glob.eval "<*>" "" = true OK +Glob.eval "<*>" "a" = true OK +Glob.eval "<*>" "aaa" = true OK +Glob.eval "<*>" "aaaaa" = true OK +Glob.eval "<*>" "" = true OK +Glob.eval "<*>" "a" = true OK +Glob.eval "<*>" "aaa" = true OK +Glob.eval "<*>" "aaaaa" = true OK +Glob.eval "" "a" = true OK +Glob.eval "" "" = false OK +Glob.eval "" "aaa" = false OK +Glob.eval "" "aaaaa" = false OK +Glob.eval "" "a" = true OK +Glob.eval "" "" = false OK +Glob.eval "" "aaa" = false OK +Glob.eval "" "aaaaa" = false OK +Glob.eval "" "a" = true OK +Glob.eval "" "" = false OK +Glob.eval "" "aaa" = false OK +Glob.eval "" "aaaaa" = false OK +Glob.eval "<{a,b}>" "a" = true OK +Glob.eval "<{a,b}>" "b" = true OK +Glob.eval "<{a,b}>" "" = false OK +Glob.eval "<{a,b}>" "aa" = false OK +Glob.eval "<{a,b}>" "ab" = false OK +Glob.eval "<{a,b}>" "ba" = false OK +Glob.eval "<{a,b}>" "bb" = false OK +Glob.eval "<{a,b}>" "c" = false OK +Glob.eval "<{a,b}>" "a" = true OK +Glob.eval "<{a,b}>" "b" = true OK +Glob.eval "<{a,b}>" "" = false OK +Glob.eval "<{a,b}>" "aa" = false OK +Glob.eval "<{a,b}>" "ab" = false OK +Glob.eval "<{a,b}>" "ba" = false OK +Glob.eval "<{a,b}>" "bb" = false OK +Glob.eval "<{a,b}>" "c" = false OK +Glob.eval "<{a,b}>" "a" = true OK +Glob.eval "<{a,b}>" "b" = true OK +Glob.eval "<{a,b}>" "" = false OK +Glob.eval "<{a,b}>" "aa" = false OK +Glob.eval "<{a,b}>" "ab" = false OK +Glob.eval "<{a,b}>" "ba" = false OK +Glob.eval "<{a,b}>" "bb" = false OK +Glob.eval "<{a,b}>" "c" = false OK +Glob.eval "" "toto.ml" = true OK +Glob.eval "" "toto.mli" = true OK +Glob.eval "" "toto." = false OK +Glob.eval "" "toto.mll" = false OK +Glob.eval "" "toto.ml" = true OK +Glob.eval "" "toto.mli" = true OK +Glob.eval "" "toto." = false OK +Glob.eval "" "toto.mll" = false OK +Glob.eval "" "toto.ml" = true OK +Glob.eval "" "toto.mli" = true OK +Glob.eval "" "toto." = false OK +Glob.eval "" "toto.mll" = false OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "acf" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "acg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "adf" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "adg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "aef" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "aeg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bcf" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bcg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bdf" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bdg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bef" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "beg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "afg" = false OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "af" = false OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "aee" = false OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "acf" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "acg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "adf" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "adg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "aef" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "aeg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bcf" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bcg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bdf" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bdg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bef" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "beg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "afg" = false OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "af" = false OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "aee" = false OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "acf" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "acg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "adf" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "adg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "aef" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "aeg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bcf" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bcg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bdf" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bdg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "bef" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "beg" = true OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "afg" = false OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "af" = false OK +Glob.eval "<{a,b}{c,[de]}{f,g}>" "aee" = false OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "a.ml" = true OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "b.ml" = true OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "a.mli" = true OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "hello.ml" = false OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "a.mli.x" = false OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "a.ml" = true OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "b.ml" = true OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "a.mli" = true OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "hello.ml" = false OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "a.mli.x" = false OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "a.ml" = true OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "b.ml" = true OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "a.mli" = true OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "hello.ml" = false OK +Glob.eval "(<*.ml> or <*.mli>) and not \"hello.ml\"" "a.mli.x" = false OK +Glob.eval "<*>" "alpha" = true OK +Glob.eval "<*>" "beta" = true OK +Glob.eval "<*>" "alpha/beta" = false OK +Glob.eval "<*>" "gamma/delta" = false OK +Glob.eval "<*>" "alpha" = true OK +Glob.eval "<*>" "beta" = true OK +Glob.eval "<*>" "alpha/beta" = false OK +Glob.eval "<*>" "gamma/delta" = false OK +Glob.eval "<*>" "alpha" = true OK +Glob.eval "<*>" "beta" = true OK +Glob.eval "<*>" "alpha/beta" = false OK +Glob.eval "<*>" "gamma/delta" = false OK +Glob.eval "" "alpha/beta" = true OK +Glob.eval "" "alpha/gamma/beta" = true OK +Glob.eval "" "alpha/gamma/delta/beta" = true OK +Glob.eval "" "alpha" = false OK +Glob.eval "" "beta" = false OK +Glob.eval "" "gamma/delta" = false OK +Glob.eval "" "alpha/beta" = true OK +Glob.eval "" "alpha/gamma/beta" = true OK +Glob.eval "" "alpha/gamma/delta/beta" = true OK +Glob.eval "" "alpha" = false OK +Glob.eval "" "beta" = false OK +Glob.eval "" "gamma/delta" = false OK +Glob.eval "" "alpha/beta" = true OK +Glob.eval "" "alpha/gamma/beta" = true OK +Glob.eval "" "alpha/gamma/delta/beta" = true OK +Glob.eval "" "alpha" = false OK +Glob.eval "" "beta" = false OK +Glob.eval "" "gamma/delta" = false OK +Glob.eval "<**/*.ml>" "toto.ml" = true OK +Glob.eval "<**/*.ml>" "toto/tata.ml" = true OK +Glob.eval "<**/*.ml>" "alpha/gamma/delta/beta.ml" = true OK +Glob.eval "<**/*.ml>" "toto.mli" = false OK +Glob.eval "<**/*.ml>" "toto.ml" = true OK +Glob.eval "<**/*.ml>" "toto/tata.ml" = true OK +Glob.eval "<**/*.ml>" "alpha/gamma/delta/beta.ml" = true OK +Glob.eval "<**/*.ml>" "toto.mli" = false OK +Glob.eval "<**/*.ml>" "toto.ml" = true OK +Glob.eval "<**/*.ml>" "toto/tata.ml" = true OK +Glob.eval "<**/*.ml>" "alpha/gamma/delta/beta.ml" = true OK +Glob.eval "<**/*.ml>" "toto.mli" = false OK +Glob.eval "" "toto/" = true OK +Glob.eval "" "toto/tata" = true OK +Glob.eval "" "toto/alpha/gamma/delta/beta.ml" = true OK +Glob.eval "" "toto" = true OK +Glob.eval "" "toto2/tata" = false OK +Glob.eval "" "tata/titi" = false OK +Glob.eval "" "toto/" = true OK +Glob.eval "" "toto/tata" = true OK +Glob.eval "" "toto/alpha/gamma/delta/beta.ml" = true OK +Glob.eval "" "toto" = true OK +Glob.eval "" "toto2/tata" = false OK +Glob.eval "" "tata/titi" = false OK +Glob.eval "" "toto/" = true OK +Glob.eval "" "toto/tata" = true OK +Glob.eval "" "toto/alpha/gamma/delta/beta.ml" = true OK +Glob.eval "" "toto" = true OK +Glob.eval "" "toto2/tata" = false OK +Glob.eval "" "tata/titi" = false OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libfoo.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "src/bar/libfoo.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "otherlibs/unix/libunix.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "otherlibsliblib/unlibix/libunix.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libfoo/libbar.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "src/libfoo/boo/libbar.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "bar" = None OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libbar/foo.a" = None OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libfoo.b.a" = None OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libfoo.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "src/bar/libfoo.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "otherlibs/unix/libunix.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "otherlibsliblib/unlibix/libunix.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libfoo/libbar.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "src/libfoo/boo/libbar.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "bar" = None OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libbar/foo.a" = None OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libfoo.b.a" = None OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libfoo.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "src/bar/libfoo.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "otherlibs/unix/libunix.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "otherlibsliblib/unlibix/libunix.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libfoo/libbar.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "src/libfoo/boo/libbar.a" OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "bar" = None OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libbar/foo.a" = None OK +Resource.matchit "%(path:<**/>)lib%(libname:<*> and not <*.*>).a" "libfoo.b.a" = None OK + _____ _ _ _ +|_ _|__ ___| |_/ / | + | |/ _ \/ __| __| | | + | | __/\__ \ |_| | | + |_|\___||___/\__|_|_| + +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 / | | | | |_| |_| | (_| | | + |_|\___||___/\__| \_/ |_|_| \__|\__,_|\__,_|_| + + _____ _ +|_ _|_ _ _ __ __ _ ___| |_ ___ + | |/ _` | '__/ _` |/ _ \ __/ __| + | | (_| | | | (_| | __/ |_\__ \ + |_|\__,_|_| \__, |\___|\__|___/ + |___/ diff --git a/ocamlbuild/test/runtest.sh b/ocamlbuild/test/runtest.sh new file mode 100755 index 00000000..600f4232 --- /dev/null +++ b/ocamlbuild/test/runtest.sh @@ -0,0 +1,56 @@ +######################################################################### +# # +# 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 $@ diff --git a/ocamlbuild/test/test1/foo.ml b/ocamlbuild/test/test1/foo.ml new file mode 100644 index 00000000..304c7649 --- /dev/null +++ b/ocamlbuild/test/test1/foo.ml @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test10/dbdi b/ocamlbuild/test/test10/dbdi new file mode 100644 index 00000000..a6b99728 --- /dev/null +++ b/ocamlbuild/test/test10/dbdi @@ -0,0 +1,24 @@ +(***********************************************************************) +(* *) +(* 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";; diff --git a/ocamlbuild/test/test10/test.sh b/ocamlbuild/test/test10/test.sh new file mode 100755 index 00000000..2ff23404 --- /dev/null +++ b/ocamlbuild/test/test10/test.sh @@ -0,0 +1,18 @@ +######################################################################### +# # +# 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 diff --git a/ocamlbuild/test/test11/_tags b/ocamlbuild/test/test11/_tags new file mode 100644 index 00000000..82387432 --- /dev/null +++ b/ocamlbuild/test/test11/_tags @@ -0,0 +1,14 @@ +######################################################################### +# # +# 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 diff --git a/ocamlbuild/test/test11/a/aa.ml b/ocamlbuild/test/test11/a/aa.ml new file mode 100644 index 00000000..d373383d --- /dev/null +++ b/ocamlbuild/test/test11/a/aa.ml @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test11/a/aa.mli b/ocamlbuild/test/test11/a/aa.mli new file mode 100644 index 00000000..45d2d6fd --- /dev/null +++ b/ocamlbuild/test/test11/a/aa.mli @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test11/b/bb.ml b/ocamlbuild/test/test11/b/bb.ml new file mode 100644 index 00000000..f5cce236 --- /dev/null +++ b/ocamlbuild/test/test11/b/bb.ml @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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] diff --git a/ocamlbuild/test/test11/b/libb.mllib b/ocamlbuild/test/test11/b/libb.mllib new file mode 100644 index 00000000..d0acbb70 --- /dev/null +++ b/ocamlbuild/test/test11/b/libb.mllib @@ -0,0 +1 @@ +Bb diff --git a/ocamlbuild/test/test11/myocamlbuild.ml b/ocamlbuild/test/test11/myocamlbuild.ml new file mode 100644 index 00000000..5a018c20 --- /dev/null +++ b/ocamlbuild/test/test11/myocamlbuild.ml @@ -0,0 +1,17 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test11/test.sh b/ocamlbuild/test/test11/test.sh new file mode 100755 index 00000000..989d051d --- /dev/null +++ b/ocamlbuild/test/test11/test.sh @@ -0,0 +1,25 @@ +######################################################################### +# # +# 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 diff --git a/ocamlbuild/test/test2/_tags b/ocamlbuild/test/test2/_tags new file mode 100644 index 00000000..5db64505 --- /dev/null +++ b/ocamlbuild/test/test2/_tags @@ -0,0 +1,15 @@ +######################################################################### +# # +# 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 diff --git a/ocamlbuild/test/test2/tata.ml b/ocamlbuild/test/test2/tata.ml new file mode 100644 index 00000000..2b777f07 --- /dev/null +++ b/ocamlbuild/test/test2/tata.ml @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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" diff --git a/ocamlbuild/test/test2/tata.mli b/ocamlbuild/test/test2/tata.mli new file mode 100644 index 00000000..3fb12338 --- /dev/null +++ b/ocamlbuild/test/test2/tata.mli @@ -0,0 +1,14 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test2/test.sh b/ocamlbuild/test/test2/test.sh new file mode 100755 index 00000000..0843ce42 --- /dev/null +++ b/ocamlbuild/test/test2/test.sh @@ -0,0 +1,30 @@ +######################################################################### +# # +# 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 diff --git a/ocamlbuild/test/test2/titi.ml b/ocamlbuild/test/test2/titi.ml new file mode 100644 index 00000000..95dc139c --- /dev/null +++ b/ocamlbuild/test/test2/titi.ml @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 = [] diff --git a/ocamlbuild/test/test2/toto.ml b/ocamlbuild/test/test2/toto.ml new file mode 100644 index 00000000..d0a99c16 --- /dev/null +++ b/ocamlbuild/test/test2/toto.ml @@ -0,0 +1,17 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test2/tutu.ml b/ocamlbuild/test/test2/tutu.ml new file mode 100644 index 00000000..e5c5a95a --- /dev/null +++ b/ocamlbuild/test/test2/tutu.ml @@ -0,0 +1,14 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test2/tutu.mli b/ocamlbuild/test/test2/tutu.mli new file mode 100644 index 00000000..bbcd6f88 --- /dev/null +++ b/ocamlbuild/test/test2/tutu.mli @@ -0,0 +1,15 @@ +(***********************************************************************) +(* *) +(* ocamlbuild *) +(* *) +(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + +(* a comment *) +val tutu : int +val tutu' : float diff --git a/ocamlbuild/test/test2/tyty.mli b/ocamlbuild/test/test2/tyty.mli new file mode 100644 index 00000000..cfd91160 --- /dev/null +++ b/ocamlbuild/test/test2/tyty.mli @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test2/vivi1.ml b/ocamlbuild/test/test2/vivi1.ml new file mode 100644 index 00000000..78aaf09d --- /dev/null +++ b/ocamlbuild/test/test2/vivi1.ml @@ -0,0 +1,14 @@ +(***********************************************************************) +(* *) +(* 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|] diff --git a/ocamlbuild/test/test2/vivi2.ml b/ocamlbuild/test/test2/vivi2.ml new file mode 100644 index 00000000..dd14288f --- /dev/null +++ b/ocamlbuild/test/test2/vivi2.ml @@ -0,0 +1,14 @@ +(***********************************************************************) +(* *) +(* 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|] diff --git a/ocamlbuild/test/test2/vivi3.ml b/ocamlbuild/test/test2/vivi3.ml new file mode 100644 index 00000000..89c4bc33 --- /dev/null +++ b/ocamlbuild/test/test2/vivi3.ml @@ -0,0 +1,14 @@ +(***********************************************************************) +(* *) +(* 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|] diff --git a/ocamlbuild/test/test3/_tags b/ocamlbuild/test/test3/_tags new file mode 100644 index 00000000..b2018471 --- /dev/null +++ b/ocamlbuild/test/test3/_tags @@ -0,0 +1,13 @@ +######################################################################### +# # +# 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 diff --git a/ocamlbuild/test/test3/a.ml b/ocamlbuild/test/test3/a.ml new file mode 100644 index 00000000..8943491c --- /dev/null +++ b/ocamlbuild/test/test3/a.ml @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test3/a.mli b/ocamlbuild/test/test3/a.mli new file mode 100644 index 00000000..2978f3bc --- /dev/null +++ b/ocamlbuild/test/test3/a.mli @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 *) diff --git a/ocamlbuild/test/test3/b.ml b/ocamlbuild/test/test3/b.ml new file mode 100644 index 00000000..2074ea5c --- /dev/null +++ b/ocamlbuild/test/test3/b.ml @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test3/b.mli b/ocamlbuild/test/test3/b.mli new file mode 100644 index 00000000..289f91f3 --- /dev/null +++ b/ocamlbuild/test/test3/b.mli @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 *) diff --git a/ocamlbuild/test/test3/c.ml b/ocamlbuild/test/test3/c.ml new file mode 100644 index 00000000..5a161603 --- /dev/null +++ b/ocamlbuild/test/test3/c.ml @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test3/c.mli b/ocamlbuild/test/test3/c.mli new file mode 100644 index 00000000..289f91f3 --- /dev/null +++ b/ocamlbuild/test/test3/c.mli @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 *) diff --git a/ocamlbuild/test/test3/d.ml b/ocamlbuild/test/test3/d.ml new file mode 100644 index 00000000..8b96630e --- /dev/null +++ b/ocamlbuild/test/test3/d.ml @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test3/d.mli b/ocamlbuild/test/test3/d.mli new file mode 100644 index 00000000..289f91f3 --- /dev/null +++ b/ocamlbuild/test/test3/d.mli @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 *) diff --git a/ocamlbuild/test/test3/e.ml b/ocamlbuild/test/test3/e.ml new file mode 100644 index 00000000..3ac83e48 --- /dev/null +++ b/ocamlbuild/test/test3/e.ml @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test3/e.mli b/ocamlbuild/test/test3/e.mli new file mode 100644 index 00000000..289f91f3 --- /dev/null +++ b/ocamlbuild/test/test3/e.mli @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 *) diff --git a/ocamlbuild/test/test3/f.ml b/ocamlbuild/test/test3/f.ml new file mode 100644 index 00000000..7c1ae8d4 --- /dev/null +++ b/ocamlbuild/test/test3/f.ml @@ -0,0 +1,14 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test3/f.mli b/ocamlbuild/test/test3/f.mli new file mode 100644 index 00000000..289f91f3 --- /dev/null +++ b/ocamlbuild/test/test3/f.mli @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 *) diff --git a/ocamlbuild/test/test3/proj.odocl b/ocamlbuild/test/test3/proj.odocl new file mode 100644 index 00000000..532c7203 --- /dev/null +++ b/ocamlbuild/test/test3/proj.odocl @@ -0,0 +1 @@ +A B C D E F diff --git a/ocamlbuild/test/test3/test.sh b/ocamlbuild/test/test3/test.sh new file mode 100755 index 00000000..d3b28526 --- /dev/null +++ b/ocamlbuild/test/test3/test.sh @@ -0,0 +1,23 @@ +######################################################################### +# # +# 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 diff --git a/ocamlbuild/test/test4/_tags b/ocamlbuild/test/test4/_tags new file mode 100644 index 00000000..f381c675 --- /dev/null +++ b/ocamlbuild/test/test4/_tags @@ -0,0 +1,14 @@ +######################################################################### +# # +# 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 diff --git a/ocamlbuild/test/test4/a/aa.ml b/ocamlbuild/test/test4/a/aa.ml new file mode 100644 index 00000000..d373383d --- /dev/null +++ b/ocamlbuild/test/test4/a/aa.ml @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test4/a/aa.mli b/ocamlbuild/test/test4/a/aa.mli new file mode 100644 index 00000000..45d2d6fd --- /dev/null +++ b/ocamlbuild/test/test4/a/aa.mli @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test4/b/bb.ml b/ocamlbuild/test/test4/b/bb.ml new file mode 100644 index 00000000..65777877 --- /dev/null +++ b/ocamlbuild/test/test4/b/bb.ml @@ -0,0 +1,14 @@ +(***********************************************************************) +(* *) +(* 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] diff --git a/ocamlbuild/test/test4/test.sh b/ocamlbuild/test/test4/test.sh new file mode 100755 index 00000000..46b7129d --- /dev/null +++ b/ocamlbuild/test/test4/test.sh @@ -0,0 +1,23 @@ +######################################################################### +# # +# 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 diff --git a/ocamlbuild/test/test5/_tags b/ocamlbuild/test/test5/_tags new file mode 100644 index 00000000..daa80725 --- /dev/null +++ b/ocamlbuild/test/test5/_tags @@ -0,0 +1,13 @@ +######################################################################### +# # +# 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) diff --git a/ocamlbuild/test/test5/a.ml b/ocamlbuild/test/test5/a.ml new file mode 100644 index 00000000..89039068 --- /dev/null +++ b/ocamlbuild/test/test5/a.ml @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test5/a.mli b/ocamlbuild/test/test5/a.mli new file mode 100644 index 00000000..c263e150 --- /dev/null +++ b/ocamlbuild/test/test5/a.mli @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test5/b.ml b/ocamlbuild/test/test5/b.ml new file mode 100644 index 00000000..72ec04e9 --- /dev/null +++ b/ocamlbuild/test/test5/b.ml @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test5/c.mlpack b/ocamlbuild/test/test5/c.mlpack new file mode 100644 index 00000000..5decc2b6 --- /dev/null +++ b/ocamlbuild/test/test5/c.mlpack @@ -0,0 +1 @@ +A B diff --git a/ocamlbuild/test/test5/d.ml b/ocamlbuild/test/test5/d.ml new file mode 100644 index 00000000..171ecf5a --- /dev/null +++ b/ocamlbuild/test/test5/d.ml @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test5/stack.ml b/ocamlbuild/test/test5/stack.ml new file mode 100644 index 00000000..0acc39d3 --- /dev/null +++ b/ocamlbuild/test/test5/stack.ml @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test5/test.sh b/ocamlbuild/test/test5/test.sh new file mode 100755 index 00000000..30bba5ce --- /dev/null +++ b/ocamlbuild/test/test5/test.sh @@ -0,0 +1,23 @@ +######################################################################### +# # +# 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 diff --git a/ocamlbuild/test/test6/a.ml b/ocamlbuild/test/test6/a.ml new file mode 100644 index 00000000..045a8047 --- /dev/null +++ b/ocamlbuild/test/test6/a.ml @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test6/a.mli b/ocamlbuild/test/test6/a.mli new file mode 100644 index 00000000..a8f98ba8 --- /dev/null +++ b/ocamlbuild/test/test6/a.mli @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test6/b.ml b/ocamlbuild/test/test6/b.ml new file mode 100644 index 00000000..de477cef --- /dev/null +++ b/ocamlbuild/test/test6/b.ml @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test6/b.mli b/ocamlbuild/test/test6/b.mli new file mode 100644 index 00000000..5f545ae6 --- /dev/null +++ b/ocamlbuild/test/test6/b.mli @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test6/b.mli.v1 b/ocamlbuild/test/test6/b.mli.v1 new file mode 100644 index 00000000..5f545ae6 --- /dev/null +++ b/ocamlbuild/test/test6/b.mli.v1 @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test6/b.mli.v2 b/ocamlbuild/test/test6/b.mli.v2 new file mode 100644 index 00000000..ede11d29 --- /dev/null +++ b/ocamlbuild/test/test6/b.mli.v2 @@ -0,0 +1,14 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test6/d.ml b/ocamlbuild/test/test6/d.ml new file mode 100644 index 00000000..db9a453c --- /dev/null +++ b/ocamlbuild/test/test6/d.ml @@ -0,0 +1,14 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test6/d.mli b/ocamlbuild/test/test6/d.mli new file mode 100644 index 00000000..496f5992 --- /dev/null +++ b/ocamlbuild/test/test6/d.mli @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test6/d.mli.v1 b/ocamlbuild/test/test6/d.mli.v1 new file mode 100644 index 00000000..26b952ce --- /dev/null +++ b/ocamlbuild/test/test6/d.mli.v1 @@ -0,0 +1,14 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test6/d.mli.v2 b/ocamlbuild/test/test6/d.mli.v2 new file mode 100644 index 00000000..496f5992 --- /dev/null +++ b/ocamlbuild/test/test6/d.mli.v2 @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test6/main.ml b/ocamlbuild/test/test6/main.ml new file mode 100644 index 00000000..6d20a21d --- /dev/null +++ b/ocamlbuild/test/test6/main.ml @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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. diff --git a/ocamlbuild/test/test6/main.mli b/ocamlbuild/test/test6/main.mli new file mode 100644 index 00000000..289f91f3 --- /dev/null +++ b/ocamlbuild/test/test6/main.mli @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 *) diff --git a/ocamlbuild/test/test6/test.sh b/ocamlbuild/test/test6/test.sh new file mode 100755 index 00000000..8fb2e67e --- /dev/null +++ b/ocamlbuild/test/test6/test.sh @@ -0,0 +1,37 @@ +######################################################################### +# # +# 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 diff --git a/ocamlbuild/test/test7/_tags b/ocamlbuild/test/test7/_tags new file mode 100644 index 00000000..ec07803c --- /dev/null +++ b/ocamlbuild/test/test7/_tags @@ -0,0 +1,13 @@ +######################################################################### +# # +# 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 diff --git a/ocamlbuild/test/test7/aa.ml b/ocamlbuild/test/test7/aa.ml new file mode 100644 index 00000000..c4521f0d --- /dev/null +++ b/ocamlbuild/test/test7/aa.ml @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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" diff --git a/ocamlbuild/test/test7/bb.mli b/ocamlbuild/test/test7/bb.mli new file mode 100644 index 00000000..63af4358 --- /dev/null +++ b/ocamlbuild/test/test7/bb.mli @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test7/bb1.ml b/ocamlbuild/test/test7/bb1.ml new file mode 100644 index 00000000..0b18853a --- /dev/null +++ b/ocamlbuild/test/test7/bb1.ml @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test7/bb2.ml b/ocamlbuild/test/test7/bb2.ml new file mode 100644 index 00000000..25221836 --- /dev/null +++ b/ocamlbuild/test/test7/bb2.ml @@ -0,0 +1,15 @@ +(***********************************************************************) +(* *) +(* ocamlbuild *) +(* *) +(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + +let bb = 43 +let f x = x + 1 +let () = incr (ref 0) diff --git a/ocamlbuild/test/test7/bb3.ml b/ocamlbuild/test/test7/bb3.ml new file mode 100644 index 00000000..11e3b9e1 --- /dev/null +++ b/ocamlbuild/test/test7/bb3.ml @@ -0,0 +1,15 @@ +(***********************************************************************) +(* *) +(* ocamlbuild *) +(* *) +(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + +let bb = 43 +let f x = x + 1 +let () = incr (ref 1) diff --git a/ocamlbuild/test/test7/bbcc.mllib b/ocamlbuild/test/test7/bbcc.mllib new file mode 100644 index 00000000..a97a0e6c --- /dev/null +++ b/ocamlbuild/test/test7/bbcc.mllib @@ -0,0 +1 @@ +Bb Cc diff --git a/ocamlbuild/test/test7/c2.ml b/ocamlbuild/test/test7/c2.ml new file mode 100644 index 00000000..d15ee418 --- /dev/null +++ b/ocamlbuild/test/test7/c2.ml @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test7/c2.mli b/ocamlbuild/test/test7/c2.mli new file mode 100644 index 00000000..9ec012b2 --- /dev/null +++ b/ocamlbuild/test/test7/c2.mli @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test7/c3.ml b/ocamlbuild/test/test7/c3.ml new file mode 100644 index 00000000..1596a100 --- /dev/null +++ b/ocamlbuild/test/test7/c3.ml @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test7/cc.ml b/ocamlbuild/test/test7/cc.ml new file mode 100644 index 00000000..1cba0473 --- /dev/null +++ b/ocamlbuild/test/test7/cc.ml @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test7/cool_plugin.ml b/ocamlbuild/test/test7/cool_plugin.ml new file mode 100644 index 00000000..b5400a54 --- /dev/null +++ b/ocamlbuild/test/test7/cool_plugin.ml @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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" diff --git a/ocamlbuild/test/test7/main.ml b/ocamlbuild/test/test7/main.ml new file mode 100644 index 00000000..817ef569 --- /dev/null +++ b/ocamlbuild/test/test7/main.ml @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test7/myocamlbuild.ml b/ocamlbuild/test/test7/myocamlbuild.ml new file mode 100644 index 00000000..1d33e0bf --- /dev/null +++ b/ocamlbuild/test/test7/myocamlbuild.ml @@ -0,0 +1,19 @@ +(***********************************************************************) +(* *) +(* ocamlbuild *) +(* *) +(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *) +(* *) +(* Copyright 2007 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + +open Ocamlbuild_plugin;; +dispatch begin function +| After_rules -> + use_lib "main" "bbcc"; + dep ["ocaml"; "link"; "byte"; "my_cool_plugin"] ["cool_plugin.cmo"]; +| _ -> () +end diff --git a/ocamlbuild/test/test7/test.sh b/ocamlbuild/test/test7/test.sh new file mode 100755 index 00000000..1d4eb1b5 --- /dev/null +++ b/ocamlbuild/test/test7/test.sh @@ -0,0 +1,30 @@ +######################################################################### +# # +# 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 diff --git a/ocamlbuild/test/test8/a.ml b/ocamlbuild/test/test8/a.ml new file mode 100644 index 00000000..c333d438 --- /dev/null +++ b/ocamlbuild/test/test8/a.ml @@ -0,0 +1,13 @@ +(***********************************************************************) +(* *) +(* 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;; diff --git a/ocamlbuild/test/test8/myocamlbuild.ml b/ocamlbuild/test/test8/myocamlbuild.ml new file mode 100644 index 00000000..52330ec6 --- /dev/null +++ b/ocamlbuild/test/test8/myocamlbuild.ml @@ -0,0 +1,28 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test8/test.sh b/ocamlbuild/test/test8/test.sh new file mode 100755 index 00000000..9b57933c --- /dev/null +++ b/ocamlbuild/test/test8/test.sh @@ -0,0 +1,23 @@ +######################################################################### +# # +# 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 diff --git a/ocamlbuild/test/test9/dbgl b/ocamlbuild/test/test9/dbgl new file mode 100644 index 00000000..78290948 --- /dev/null +++ b/ocamlbuild/test/test9/dbgl @@ -0,0 +1,22 @@ +(***********************************************************************) +(* *) +(* 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;; diff --git a/ocamlbuild/test/test9/test.sh b/ocamlbuild/test/test9/test.sh new file mode 100755 index 00000000..aaed954c --- /dev/null +++ b/ocamlbuild/test/test9/test.sh @@ -0,0 +1,18 @@ +######################################################################### +# # +# 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 diff --git a/ocamlbuild/test/test9/testglob.ml b/ocamlbuild/test/test9/testglob.ml new file mode 100644 index 00000000..77778731 --- /dev/null +++ b/ocamlbuild/test/test9/testglob.ml @@ -0,0 +1,146 @@ +(***********************************************************************) +(* *) +(* 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; + "", true; + "", true; + " and or ", true; + " titi", false +];; + +let tests2 = [ + "<[a]>", ["a"], ["b"]; + "<[a-z]>", ["a";"e";"k";"z"], ["0";"A";"~"]; + "<[a-z][0-9]>", ["a0";"b9"], ["a00";"a0a";"b0a";"isduis";""]; + "", ["hello"], ["helli"]; + "\"hello\"", ["hello"], ["heidi"]; + "<*>", ["";"a";"ax"], []; + "", ["ab";"acb";"axxxxxb";"ababbababb"], ["abx";"xxxxxab";"xab"]; + "<*.ml>", ["hello.ml";".ml"], ["ml"; ""; "toto.mli"]; + "", ["a"], ["";"aa";"ba";"ab";"abaa"]; + "", ["ab"], ["";"abab";"aba";"abx"]; + "", ["abac";"abxc"], ["abab";"ababab";"ababa"]; + "<*ab?cd*>", ["123abecd345";"abccd";"abccd345";"ababcababccdab"], ["abcd";"aaaaabcdababcd"]; + "<*this*is*a*test*>", ["this is a test";"You know this is a test really";"thisisatest"], ["thisatest"]; + "", ["bxx";"bx"], ["aaab";""]; + "<*>", ["";"a";"aaa";"aaaaa"], []; + "", ["a"],["";"aaa";"aaaaa"]; + "<{a,b}>", ["a";"b"],["";"aa";"ab";"ba";"bb";"c"]; + "", ["toto.ml";"toto.mli"],["toto.";"toto.mll"]; + "<{a,b}{c,[de]}{f,g}>", ["acf";"acg";"adf";"adg";"aef";"aeg";"bcf";"bcg";"bdf";"bdg";"bef";"beg"], + ["afg";"af";"aee"]; + "(<*.ml> or <*.mli>) and not \"hello.ml\"", + ["a.ml"; "b.ml"; "a.mli"], + ["hello.ml"; "a.mli.x"]; + "<*>", ["alpha";"beta"], ["alpha/beta";"gamma/delta"]; + "", ["alpha/beta";"alpha/gamma/beta";"alpha/gamma/delta/beta"], + ["alpha";"beta";"gamma/delta"]; + "<**/*.ml>", ["toto.ml";"toto/tata.ml";"alpha/gamma/delta/beta.ml"], + ["toto.mli"]; + "", ["toto/";"toto/tata";"toto/alpha/gamma/delta/beta.ml";"toto"], + ["toto2/tata"; "tata/titi"] +];; + +let tests3 = [ + "%(path:<**/>)lib%(libname:<*> and not <*.*>).a", + ["libfoo.a","","foo"; + "src/bar/libfoo.a","src/bar/","foo"; + "otherlibs/unix/libunix.a","otherlibs/unix/","unix"; + "otherlibsliblib/unlibix/libunix.a","otherlibsliblib/unlibix/","unix"; + "libfoo/libbar.a","libfoo/","bar"; + "src/libfoo/boo/libbar.a","src/libfoo/boo/","bar"; + ], + ["bar"; "libbar/foo.a"; "libfoo.b.a"] +];; + +let _ = + let times = 3 in + List.iter + begin fun (str, ast) -> + let ast' = yep Glob.parse str in + if ast <> ast' then + begin + Printf.printf "Globexp parsing failed for %S.\n%!" str; + exit 1 + end + else + Printf.printf "Globexp for %S OK\n%!" str + end + tests1; + List.iter + begin fun (gstr, yes, no) -> + let globber = Glob.parse gstr in + let check polarity = + List.iter + begin fun y -> + if Glob.eval globber y = polarity then + Printf.printf "Glob.eval %S %S = %b OK\n%!" gstr y polarity + else + begin + Printf.printf "Glob.eval %S %S = %b FAIL\n%!" gstr y (not polarity); + exit 1 + end + end + in + for k = 1 to times do + check true yes; + check false no + done + end + tests2; + List.iter begin fun (str, yes, no) -> + let resource = Resource.import_pattern str in + for k = 1 to times do + List.iter begin fun (y, path, libname) -> + let resource' = Resource.import y in + match Resource.matchit resource resource' with + | Some env -> + let path' = Resource.subst env "%(path)" in + let libname' = Resource.subst env "%(libname)" in + if path' = path && libname = libname' then + Printf.printf "Resource.matchit %S %S OK\n%!" str y + else begin + Printf.printf "Resource.matchit %S %S FAIL\n%!" str y; + exit 1 + end + | None -> + begin + Printf.printf "Resource.matchit %S %S = None FAIL\n%!" str y; + exit 1 + end + end yes; + List.iter begin fun y -> + let resource' = Resource.import y in + if Resource.matchit resource resource' = None then + Printf.printf "Resource.matchit %S %S = None OK\n%!" str y + else begin + Printf.printf "Resource.matchit %S %S <> None FAIL\n%!" str y; + exit 1 + end + end no + done + end tests3 +;; diff --git a/ocamlbuild/test/test_virtual/foo.itarget b/ocamlbuild/test/test_virtual/foo.itarget new file mode 100644 index 00000000..257cc564 --- /dev/null +++ b/ocamlbuild/test/test_virtual/foo.itarget @@ -0,0 +1 @@ +foo diff --git a/ocamlbuild/test/test_virtual/foo1 b/ocamlbuild/test/test_virtual/foo1 new file mode 100644 index 00000000..1715acd6 --- /dev/null +++ b/ocamlbuild/test/test_virtual/foo1 @@ -0,0 +1 @@ +foo1 diff --git a/ocamlbuild/test/test_virtual/foo2 b/ocamlbuild/test/test_virtual/foo2 new file mode 100644 index 00000000..54b060ee --- /dev/null +++ b/ocamlbuild/test/test_virtual/foo2 @@ -0,0 +1 @@ +foo2 diff --git a/ocamlbuild/test/test_virtual/myocamlbuild.ml b/ocamlbuild/test/test_virtual/myocamlbuild.ml new file mode 100644 index 00000000..049628fa --- /dev/null +++ b/ocamlbuild/test/test_virtual/myocamlbuild.ml @@ -0,0 +1,23 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/ocamlbuild/test/test_virtual/test.sh b/ocamlbuild/test/test_virtual/test.sh new file mode 100755 index 00000000..9960c83f --- /dev/null +++ b/ocamlbuild/test/test_virtual/test.sh @@ -0,0 +1,28 @@ +######################################################################### +# # +# 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 diff --git a/ocamlbuild/testsuite/internal.ml b/ocamlbuild/testsuite/internal.ml index d0071543..9b48af52 100644 --- a/ocamlbuild/testsuite/internal.ml +++ b/ocamlbuild/testsuite/internal.ml @@ -160,6 +160,13 @@ let () = test "OutputObj" ~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" diff --git a/ocamldoc/.depend b/ocamldoc/.depend index b98bb57f..6c729e32 100644 --- a/ocamldoc/.depend +++ b/ocamldoc/.depend @@ -1,11 +1,3 @@ -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 \ @@ -52,6 +44,8 @@ odoc_class.cmo : ../typing/types.cmi odoc_value.cmo odoc_types.cmi \ odoc_parameter.cmo odoc_name.cmi odoc_class.cmx : ../typing/types.cmx odoc_value.cmx odoc_types.cmx \ odoc_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 \ @@ -60,8 +54,6 @@ odoc_comments.cmx : odoc_types.cmx odoc_text.cmx odoc_see_lexer.cmx \ odoc_parser.cmx odoc_misc.cmx odoc_messages.cmx odoc_merge.cmx \ odoc_lexer.cmx odoc_global.cmx odoc_cross.cmx odoc_comments_global.cmx \ odoc_comments.cmi -odoc_comments_global.cmo : odoc_comments_global.cmi -odoc_comments_global.cmx : odoc_comments_global.cmi odoc_config.cmo : ../utils/config.cmi odoc_config.cmi odoc_config.cmx : ../utils/config.cmx odoc_config.cmi odoc_control.cmo : @@ -150,6 +142,14 @@ odoc_misc.cmo : ../typing/types.cmi ../typing/predef.cmi ../typing/path.cmi \ 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 @@ -212,12 +212,12 @@ odoc_texi.cmo : ../typing/types.cmi odoc_to_text.cmo odoc_messages.cmo \ odoc_info.cmi ../parsing/asttypes.cmi odoc_texi.cmx : ../typing/types.cmx odoc_to_text.cmx odoc_messages.cmx \ odoc_info.cmx ../parsing/asttypes.cmi +odoc_text_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 @@ -236,8 +236,8 @@ odoc_analyse.cmi : odoc_module.cmo odoc_global.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 diff --git a/ocamldoc/Makefile b/ocamldoc/Makefile index 7a487c6c..7c6d9885 100644 --- a/ocamldoc/Makefile +++ b/ocamldoc/Makefile @@ -11,16 +11,16 @@ #(***********************************************************************) 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) @@ -233,10 +233,10 @@ odoc_see_lexer.ml: odoc_see_lexer.mll $(OCAMLLEX) $< .mly.ml: - $(OCAMLYACC) -v $< + $(CAMLYACC) -v $< .mly.mli: - $(OCAMLYACC) -v $< + $(CAMLYACC) -v $< # Installation targets ###################### @@ -343,8 +343,8 @@ clean:: dummy @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 diff --git a/ocamldoc/Makefile.nt b/ocamldoc/Makefile.nt index 22cd36eb..9c009596 100644 --- a/ocamldoc/Makefile.nt +++ b/ocamldoc/Makefile.nt @@ -11,16 +11,16 @@ #(***********************************************************************) 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) @@ -202,10 +202,10 @@ odoc_see_lexer.ml: odoc_see_lexer.mll $(OCAMLLEX) $< .mly.ml: - $(OCAMLYACC) -v $< + $(CAMLYACC) -v $< .mly.mli: - $(OCAMLYACC) -v $< + $(CAMLYACC) -v $< # Installation targets ###################### @@ -240,8 +240,8 @@ clean:: dummy @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 diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml index 358a71a5..2e6d1ded 100644 --- a/ocamldoc/odoc_ast.ml +++ b/ocamldoc/odoc_ast.ml @@ -1181,8 +1181,7 @@ module Analyser = | 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 @@ -1191,6 +1190,16 @@ module Analyser = 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, []) @@ -1220,7 +1229,7 @@ module Analyser = 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 @@ -1232,7 +1241,7 @@ module Analyser = 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 ; @@ -1241,7 +1250,7 @@ module Analyser = (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 = ( @@ -1262,7 +1271,7 @@ module Analyser = (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 *) @@ -1709,7 +1718,11 @@ module Analyser = } 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 ; } } @@ -1859,6 +1872,7 @@ module Analyser = (*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 diff --git a/ocamldoc/odoc_name.ml b/ocamldoc/odoc_name.ml index bdb1f58c..296331ad 100644 --- a/ocamldoc/odoc_name.ml +++ b/ocamldoc/odoc_name.ml @@ -28,6 +28,7 @@ let infix_chars = [ '|' ; ':' ; '~' ; '!' ; + '#' ; ] type t = string diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml index e41cf2b8..a10837ff 100644 --- a/ocamldoc/odoc_sig.ml +++ b/ocamldoc/odoc_sig.ml @@ -723,8 +723,7 @@ module Analyser = (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 @@ -733,6 +732,16 @@ module Analyser = 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 [] -> @@ -768,7 +777,7 @@ module Analyser = 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] *) @@ -779,7 +788,7 @@ module Analyser = 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; @@ -814,7 +823,7 @@ module Analyser = (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 diff --git a/otherlibs/Makefile b/otherlibs/Makefile index 397497dd..3ca2a487 100644 --- a/otherlibs/Makefile +++ b/otherlibs/Makefile @@ -13,10 +13,10 @@ # 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 diff --git a/otherlibs/Makefile.shared b/otherlibs/Makefile.shared index 9bed5f76..cb8bf174 100644 --- a/otherlibs/Makefile.shared +++ b/otherlibs/Makefile.shared @@ -15,10 +15,11 @@ 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 diff --git a/otherlibs/bigarray/.depend b/otherlibs/bigarray/.depend index 889328a3..b4649586 100644 --- a/otherlibs/bigarray/.depend +++ b/otherlibs/bigarray/.depend @@ -1,21 +1,26 @@ -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 diff --git a/otherlibs/bigarray/Makefile b/otherlibs/bigarray/Makefile index 3f8c52f2..3bcc7a40 100644 --- a/otherlibs/bigarray/Makefile +++ b/otherlibs/bigarray/Makefile @@ -21,7 +21,7 @@ HEADERS=bigarray.h 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 diff --git a/otherlibs/bigarray/Makefile.nt b/otherlibs/bigarray/Makefile.nt index db5ed605..baeaa7a1 100644 --- a/otherlibs/bigarray/Makefile.nt +++ b/otherlibs/bigarray/Makefile.nt @@ -21,7 +21,7 @@ HEADERS=bigarray.h 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 diff --git a/otherlibs/bigarray/bigarray.h b/otherlibs/bigarray/bigarray.h index c10e20cf..23bde233 100644 --- a/otherlibs/bigarray/bigarray.h +++ b/otherlibs/bigarray/bigarray.h @@ -15,10 +15,10 @@ #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; @@ -106,10 +106,18 @@ struct caml_ba_array { #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 */ diff --git a/otherlibs/bigarray/bigarray.mli b/otherlibs/bigarray/bigarray.mli index b3016a71..6bde90a9 100644 --- a/otherlibs/bigarray/bigarray.mli +++ b/otherlibs/bigarray/bigarray.mli @@ -452,7 +452,11 @@ module Genarray : 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 diff --git a/otherlibs/bigarray/bigarray_stubs.c b/otherlibs/bigarray/bigarray_stubs.c index 7e63cbf4..c98a92f0 100644 --- a/otherlibs/bigarray/bigarray_stubs.c +++ b/otherlibs/bigarray/bigarray_stubs.c @@ -14,14 +14,14 @@ #include #include #include -#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 diff --git a/otherlibs/bigarray/mmap_unix.c b/otherlibs/bigarray/mmap_unix.c index cdcfe3ce..027b1e5c 100644 --- a/otherlibs/bigarray/mmap_unix.c +++ b/otherlibs/bigarray/mmap_unix.c @@ -18,12 +18,12 @@ #include #include #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 */ diff --git a/otherlibs/bigarray/mmap_win32.c b/otherlibs/bigarray/mmap_win32.c index cd9da4af..5d7ec6bb 100644 --- a/otherlibs/bigarray/mmap_win32.c +++ b/otherlibs/bigarray/mmap_win32.c @@ -15,11 +15,11 @@ #include #include #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 */ diff --git a/otherlibs/dynlink/Makefile b/otherlibs/dynlink/Makefile index 6284a528..acff7a7a 100644 --- a/otherlibs/dynlink/Makefile +++ b/otherlibs/dynlink/Makefile @@ -13,15 +13,18 @@ # 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 @@ -32,7 +35,7 @@ COMPILEROBJS=\ ../../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 \ @@ -69,7 +72,7 @@ dynlink.cmx: dynlink.cmi natdynlink.ml 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) diff --git a/otherlibs/graph/.depend b/otherlibs/graph/.depend index ab9faa61..ec14b350 100644 --- a/otherlibs/graph/.depend +++ b/otherlibs/graph/.depend @@ -1,103 +1,70 @@ -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 diff --git a/otherlibs/graph/Makefile b/otherlibs/graph/Makefile index 9586f1c4..850e0251 100644 --- a/otherlibs/graph/Makefile +++ b/otherlibs/graph/Makefile @@ -26,7 +26,7 @@ EXTRACFLAGS=$(X11_INCLUDES) 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 diff --git a/otherlibs/graph/draw.c b/otherlibs/graph/draw.c index dc657875..195860fa 100644 --- a/otherlibs/graph/draw.c +++ b/otherlibs/graph/draw.c @@ -12,7 +12,7 @@ /***********************************************************************/ #include "libgraph.h" -#include +#include value caml_gr_plot(value vx, value vy) { diff --git a/otherlibs/graph/dump_img.c b/otherlibs/graph/dump_img.c index 4ba5c066..26f81607 100644 --- a/otherlibs/graph/dump_img.c +++ b/otherlibs/graph/dump_img.c @@ -13,8 +13,8 @@ #include "libgraph.h" #include "image.h" -#include -#include +#include +#include value caml_gr_dump_image(value image) { diff --git a/otherlibs/graph/events.c b/otherlibs/graph/events.c index 94bd8bc4..a8fe119b 100644 --- a/otherlibs/graph/events.c +++ b/otherlibs/graph/events.c @@ -13,8 +13,8 @@ #include #include "libgraph.h" -#include -#include +#include +#include #include #include #ifdef HAS_SYS_SELECT_H diff --git a/otherlibs/graph/fill.c b/otherlibs/graph/fill.c index 1e2965f1..8dc2f877 100644 --- a/otherlibs/graph/fill.c +++ b/otherlibs/graph/fill.c @@ -12,7 +12,7 @@ /***********************************************************************/ #include "libgraph.h" -#include +#include value caml_gr_fill_rect(value vx, value vy, value vw, value vh) { diff --git a/otherlibs/graph/image.c b/otherlibs/graph/image.c index 31693bbd..12588bf7 100644 --- a/otherlibs/graph/image.c +++ b/otherlibs/graph/image.c @@ -13,8 +13,8 @@ #include "libgraph.h" #include "image.h" -#include -#include +#include +#include static void caml_gr_free_image(value im) { diff --git a/otherlibs/graph/libgraph.h b/otherlibs/graph/libgraph.h index e75ee801..9b2972bc 100644 --- a/otherlibs/graph/libgraph.h +++ b/otherlibs/graph/libgraph.h @@ -14,7 +14,7 @@ #include #include #include -#include +#include struct canvas { int w, h; /* Dimensions of the drawable */ diff --git a/otherlibs/graph/make_img.c b/otherlibs/graph/make_img.c index 932d4605..b9c4bfca 100644 --- a/otherlibs/graph/make_img.c +++ b/otherlibs/graph/make_img.c @@ -13,7 +13,7 @@ #include "libgraph.h" #include "image.h" -#include +#include value caml_gr_make_image(value m) { diff --git a/otherlibs/graph/open.c b/otherlibs/graph/open.c index 14a00eaf..e8d26acf 100644 --- a/otherlibs/graph/open.c +++ b/otherlibs/graph/open.c @@ -15,10 +15,10 @@ #include #include #include "libgraph.h" -#include -#include -#include -#include +#include +#include +#include +#include #ifdef HAS_UNISTD #include #endif diff --git a/otherlibs/graph/text.c b/otherlibs/graph/text.c index 8ac422d5..7450df89 100644 --- a/otherlibs/graph/text.c +++ b/otherlibs/graph/text.c @@ -12,7 +12,7 @@ /***********************************************************************/ #include "libgraph.h" -#include +#include XFontStruct * caml_gr_font = NULL; diff --git a/otherlibs/num/.depend b/otherlibs/num/.depend index 51b180f5..c885abf0 100644 --- a/otherlibs/num/.depend +++ b/otherlibs/num/.depend @@ -1,21 +1,23 @@ -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 diff --git a/otherlibs/num/Makefile b/otherlibs/num/Makefile index e5bcb97c..e08e0294 100644 --- a/otherlibs/num/Makefile +++ b/otherlibs/num/Makefile @@ -31,7 +31,7 @@ bng.$(O): bng.h bng_digit.c \ 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 diff --git a/otherlibs/num/bng.c b/otherlibs/num/bng.c index 0483ef51..585e434e 100644 --- a/otherlibs/num/bng.c +++ b/otherlibs/num/bng.c @@ -14,7 +14,7 @@ /* $Id$ */ #include "bng.h" -#include "config.h" +#include "caml/config.h" #if defined(__GNUC__) && BNG_ASM_LEVEL > 0 #if defined(BNG_ARCH_ia32) diff --git a/otherlibs/num/bng.h b/otherlibs/num/bng.h index 19f2e2b9..527bee6a 100644 --- a/otherlibs/num/bng.h +++ b/otherlibs/num/bng.h @@ -14,7 +14,7 @@ /* $Id$ */ #include -#include "config.h" +#include "caml/config.h" typedef uintnat bngdigit; typedef bngdigit * bng; diff --git a/otherlibs/num/nat.ml b/otherlibs/num/nat.ml index 90cb471c..5ea5fda7 100644 --- a/otherlibs/num/nat.ml +++ b/otherlibs/num/nat.ml @@ -318,6 +318,12 @@ let digits = "0123456789ABCDEF" 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 @@ -329,7 +335,7 @@ let make_power_base base power_base = 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) (* diff --git a/otherlibs/num/nat_stubs.c b/otherlibs/num/nat_stubs.c index 9a62759f..ae109ac9 100644 --- a/otherlibs/num/nat_stubs.c +++ b/otherlibs/num/nat_stubs.c @@ -13,14 +13,14 @@ /* $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" diff --git a/otherlibs/num/num.ml b/otherlibs/num/num.ml index 67499e26..924e9eab 100644 --- a/otherlibs/num/num.ml +++ b/otherlibs/num/num.ml @@ -160,57 +160,71 @@ let floor_num = function | 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) -> @@ -368,13 +382,6 @@ let big_int_of_num = function | 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 diff --git a/otherlibs/str/.depend b/otherlibs/str/.depend index 5be8377c..1d224311 100644 --- a/otherlibs/str/.depend +++ b/otherlibs/str/.depend @@ -1,9 +1,11 @@ -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 diff --git a/otherlibs/str/Makefile b/otherlibs/str/Makefile index 509be62a..93b2bf95 100644 --- a/otherlibs/str/Makefile +++ b/otherlibs/str/Makefile @@ -27,7 +27,7 @@ str.cmo: 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 diff --git a/otherlibs/str/strstubs.c b/otherlibs/str/strstubs.c index 9de349a9..6c928704 100644 --- a/otherlibs/str/strstubs.c +++ b/otherlibs/str/strstubs.c @@ -13,10 +13,10 @@ #include #include -#include -#include -#include -#include +#include +#include +#include +#include /* The backtracking NFA interpreter */ diff --git a/otherlibs/systhreads/.depend b/otherlibs/systhreads/.depend index 85add2e5..b9e1cabc 100644 --- a/otherlibs/systhreads/.depend +++ b/otherlibs/systhreads/.depend @@ -1,14 +1,17 @@ -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 : diff --git a/otherlibs/systhreads/Makefile b/otherlibs/systhreads/Makefile index f24af23b..942a7b78 100644 --- a/otherlibs/systhreads/Makefile +++ b/otherlibs/systhreads/Makefile @@ -12,13 +12,15 @@ ######################################################################### 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 @@ -34,7 +36,7 @@ libthreads.a: $(BYTECODE_C_OBJS) $(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 @@ -44,7 +46,7 @@ libthreadsnat.a: $(NATIVECODE_C_OBJS) $(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 @@ -106,7 +108,7 @@ installopt: $(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 diff --git a/otherlibs/systhreads/Makefile.nt b/otherlibs/systhreads/Makefile.nt index 34117614..22fb1c71 100644 --- a/otherlibs/systhreads/Makefile.nt +++ b/otherlibs/systhreads/Makefile.nt @@ -12,12 +12,14 @@ ######################################################################### 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 @@ -32,7 +34,7 @@ all: lib$(LIBNAME).$(A) $(LIBNAME).cma $(CMIFILES) 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) @@ -46,7 +48,7 @@ st_stubs_b.$(O): st_stubs.c st_win32.h $(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) diff --git a/otherlibs/systhreads/st_posix.h b/otherlibs/systhreads/st_posix.h index e0bc65e4..1d87a229 100644 --- a/otherlibs/systhreads/st_posix.h +++ b/otherlibs/systhreads/st_posix.h @@ -80,7 +80,12 @@ static void st_thread_exit(void) 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 */ @@ -322,8 +327,10 @@ static void * caml_thread_tick(void * arg) /* 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 */ @@ -340,6 +347,15 @@ static void * caml_thread_tick(void * arg) /* "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); diff --git a/otherlibs/systhreads/st_stubs.c b/otherlibs/systhreads/st_stubs.c index dd99c736..eab89ab4 100644 --- a/otherlibs/systhreads/st_stubs.c +++ b/otherlibs/systhreads/st_stubs.c @@ -11,24 +11,24 @@ /* */ /***********************************************************************/ -#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) */ diff --git a/otherlibs/systhreads/threads.h b/otherlibs/systhreads/threads.h index 6a97b251..616138da 100644 --- a/otherlibs/systhreads/threads.h +++ b/otherlibs/systhreads/threads.h @@ -14,6 +14,10 @@ #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 @@ -55,4 +59,8 @@ CAMLextern int caml_c_thread_unregister(void); Both functions return 1 on success, 0 on error. */ +#ifdef __cplusplus +} +#endif + #endif /* CAML_THREADS_H */ diff --git a/otherlibs/threads/.depend b/otherlibs/threads/.depend index 3a6c7f02..2b70d942 100644 --- a/otherlibs/threads/.depend +++ b/otherlibs/threads/.depend @@ -1,14 +1,17 @@ -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 : diff --git a/otherlibs/threads/Makefile b/otherlibs/threads/Makefile index 4b783333..de789afd 100644 --- a/otherlibs/threads/Makefile +++ b/otherlibs/threads/Makefile @@ -11,15 +11,19 @@ # # ######################################################################### +# 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 @@ -121,7 +125,7 @@ installopt: $(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 diff --git a/otherlibs/threads/scheduler.c b/otherlibs/threads/scheduler.c index 45ef854d..585a8903 100644 --- a/otherlibs/threads/scheduler.c +++ b/otherlibs/threads/scheduler.c @@ -17,20 +17,20 @@ #include #include -#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) && \ diff --git a/otherlibs/unix/.depend b/otherlibs/unix/.depend index 85eee1b8..4f6a6387 100644 --- a/otherlibs/unix/.depend +++ b/otherlibs/unix/.depend @@ -1,506 +1,644 @@ -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 diff --git a/otherlibs/unix/Makefile b/otherlibs/unix/Makefile index 5f4d72b8..faebd3f5 100644 --- a/otherlibs/unix/Makefile +++ b/otherlibs/unix/Makefile @@ -41,7 +41,7 @@ HEADERS=unixsupport.h socketaddr.h 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 diff --git a/otherlibs/unix/accept.c b/otherlibs/unix/accept.c index 183b8e86..3fd01918 100644 --- a/otherlibs/unix/accept.c +++ b/otherlibs/unix/accept.c @@ -11,11 +11,11 @@ /* */ /***********************************************************************/ -#include -#include -#include -#include -#include +#include +#include +#include +#include +#include #include "unixsupport.h" #ifdef HAS_SOCKETS diff --git a/otherlibs/unix/access.c b/otherlibs/unix/access.c index 7df4f9c5..28c26b82 100644 --- a/otherlibs/unix/access.c +++ b/otherlibs/unix/access.c @@ -11,10 +11,10 @@ /* */ /***********************************************************************/ -#include -#include -#include -#include +#include +#include +#include +#include #include "unixsupport.h" #ifdef HAS_UNISTD diff --git a/otherlibs/unix/addrofstr.c b/otherlibs/unix/addrofstr.c index e17841f9..c4bd2e72 100644 --- a/otherlibs/unix/addrofstr.c +++ b/otherlibs/unix/addrofstr.c @@ -11,9 +11,9 @@ /* */ /***********************************************************************/ -#include -#include -#include +#include +#include +#include #include "unixsupport.h" #ifdef HAS_SOCKETS diff --git a/otherlibs/unix/alarm.c b/otherlibs/unix/alarm.c index 30472765..eb92a682 100644 --- a/otherlibs/unix/alarm.c +++ b/otherlibs/unix/alarm.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -#include +#include #include "unixsupport.h" CAMLprim value unix_alarm(value t) diff --git a/otherlibs/unix/bind.c b/otherlibs/unix/bind.c index e3d0046c..4ea75c21 100644 --- a/otherlibs/unix/bind.c +++ b/otherlibs/unix/bind.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include "unixsupport.h" #ifdef HAS_SOCKETS diff --git a/otherlibs/unix/chdir.c b/otherlibs/unix/chdir.c index 0d5326a0..24732111 100644 --- a/otherlibs/unix/chdir.c +++ b/otherlibs/unix/chdir.c @@ -11,9 +11,9 @@ /* */ /***********************************************************************/ -#include -#include -#include +#include +#include +#include #include "unixsupport.h" CAMLprim value unix_chdir(value path) diff --git a/otherlibs/unix/chmod.c b/otherlibs/unix/chmod.c index 90dd6024..2d3f30fe 100644 --- a/otherlibs/unix/chmod.c +++ b/otherlibs/unix/chmod.c @@ -13,9 +13,9 @@ #include #include -#include -#include -#include +#include +#include +#include #include "unixsupport.h" CAMLprim value unix_chmod(value path, value perm) diff --git a/otherlibs/unix/chown.c b/otherlibs/unix/chown.c index 697f4477..6c9e896a 100644 --- a/otherlibs/unix/chown.c +++ b/otherlibs/unix/chown.c @@ -11,9 +11,9 @@ /* */ /***********************************************************************/ -#include -#include -#include +#include +#include +#include #include "unixsupport.h" CAMLprim value unix_chown(value path, value uid, value gid) diff --git a/otherlibs/unix/chroot.c b/otherlibs/unix/chroot.c index b41c09ff..c30a0da9 100644 --- a/otherlibs/unix/chroot.c +++ b/otherlibs/unix/chroot.c @@ -11,9 +11,9 @@ /* */ /***********************************************************************/ -#include -#include -#include +#include +#include +#include #include "unixsupport.h" CAMLprim value unix_chroot(value path) diff --git a/otherlibs/unix/close.c b/otherlibs/unix/close.c index 8a56c413..aff8911f 100644 --- a/otherlibs/unix/close.c +++ b/otherlibs/unix/close.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include "unixsupport.h" CAMLprim value unix_close(value fd) diff --git a/otherlibs/unix/closedir.c b/otherlibs/unix/closedir.c index 4196acd4..5e8008d5 100644 --- a/otherlibs/unix/closedir.c +++ b/otherlibs/unix/closedir.c @@ -11,9 +11,9 @@ /* */ /***********************************************************************/ -#include -#include -#include +#include +#include +#include #include "unixsupport.h" #include #include diff --git a/otherlibs/unix/connect.c b/otherlibs/unix/connect.c index ed8b12c3..b4b3e19c 100644 --- a/otherlibs/unix/connect.c +++ b/otherlibs/unix/connect.c @@ -11,9 +11,9 @@ /* */ /***********************************************************************/ -#include -#include -#include +#include +#include +#include #include "unixsupport.h" #ifdef HAS_SOCKETS diff --git a/otherlibs/unix/cst2constr.c b/otherlibs/unix/cst2constr.c index f27cace7..87721ce3 100644 --- a/otherlibs/unix/cst2constr.c +++ b/otherlibs/unix/cst2constr.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include "cst2constr.h" value cst_to_constr(int n, int *tbl, int size, int deflt) diff --git a/otherlibs/unix/cstringv.c b/otherlibs/unix/cstringv.c index d8541100..0e614918 100644 --- a/otherlibs/unix/cstringv.c +++ b/otherlibs/unix/cstringv.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include "unixsupport.h" char ** cstringvect(value arg) diff --git a/otherlibs/unix/dup.c b/otherlibs/unix/dup.c index 36e3efac..c6e9dcf2 100644 --- a/otherlibs/unix/dup.c +++ b/otherlibs/unix/dup.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -#include +#include #include "unixsupport.h" CAMLprim value unix_dup(value fd) diff --git a/otherlibs/unix/dup2.c b/otherlibs/unix/dup2.c index c5018022..fd9ea3d2 100644 --- a/otherlibs/unix/dup2.c +++ b/otherlibs/unix/dup2.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -#include +#include #include "unixsupport.h" #ifdef HAS_DUP2 diff --git a/otherlibs/unix/envir.c b/otherlibs/unix/envir.c index 4b189334..366608b6 100644 --- a/otherlibs/unix/envir.c +++ b/otherlibs/unix/envir.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #ifndef _WIN32 extern char ** environ; diff --git a/otherlibs/unix/errmsg.c b/otherlibs/unix/errmsg.c index 5df3e1e7..0f610e9d 100644 --- a/otherlibs/unix/errmsg.c +++ b/otherlibs/unix/errmsg.c @@ -13,8 +13,8 @@ #include #include -#include -#include +#include +#include extern int error_table[]; diff --git a/otherlibs/unix/execv.c b/otherlibs/unix/execv.c index ee59fa48..9a775489 100644 --- a/otherlibs/unix/execv.c +++ b/otherlibs/unix/execv.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include "unixsupport.h" extern char ** cstringvect(); diff --git a/otherlibs/unix/execve.c b/otherlibs/unix/execve.c index 62b2d2c9..92171c2d 100644 --- a/otherlibs/unix/execve.c +++ b/otherlibs/unix/execve.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include "unixsupport.h" extern char ** cstringvect(); diff --git a/otherlibs/unix/execvp.c b/otherlibs/unix/execvp.c index 8e28fa06..ce6900ab 100644 --- a/otherlibs/unix/execvp.c +++ b/otherlibs/unix/execvp.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include "unixsupport.h" extern char ** cstringvect(); diff --git a/otherlibs/unix/exit.c b/otherlibs/unix/exit.c index 94f5fb5e..cfc4e16c 100644 --- a/otherlibs/unix/exit.c +++ b/otherlibs/unix/exit.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -#include +#include #include "unixsupport.h" CAMLprim value unix_exit(value n) diff --git a/otherlibs/unix/fchmod.c b/otherlibs/unix/fchmod.c index 711097eb..11578ff2 100644 --- a/otherlibs/unix/fchmod.c +++ b/otherlibs/unix/fchmod.c @@ -13,9 +13,9 @@ #include #include -#include -#include -#include +#include +#include +#include #include "unixsupport.h" #ifdef HAS_FCHMOD diff --git a/otherlibs/unix/fchown.c b/otherlibs/unix/fchown.c index 2a6746ca..24872ec8 100644 --- a/otherlibs/unix/fchown.c +++ b/otherlibs/unix/fchown.c @@ -11,9 +11,9 @@ /* */ /***********************************************************************/ -#include -#include -#include +#include +#include +#include #include "unixsupport.h" #ifdef HAS_FCHMOD diff --git a/otherlibs/unix/fcntl.c b/otherlibs/unix/fcntl.c index 886c12de..c89e9a6f 100644 --- a/otherlibs/unix/fcntl.c +++ b/otherlibs/unix/fcntl.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include "unixsupport.h" #ifdef HAS_UNISTD #include diff --git a/otherlibs/unix/fork.c b/otherlibs/unix/fork.c index b21d80c6..ac0d6772 100644 --- a/otherlibs/unix/fork.c +++ b/otherlibs/unix/fork.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include "unixsupport.h" CAMLprim value unix_fork(value unit) diff --git a/otherlibs/unix/ftruncate.c b/otherlibs/unix/ftruncate.c index ec494ba5..08a4a775 100644 --- a/otherlibs/unix/ftruncate.c +++ b/otherlibs/unix/ftruncate.c @@ -12,10 +12,10 @@ /***********************************************************************/ #include -#include -#include -#include -#include +#include +#include +#include +#include #include "unixsupport.h" #ifdef HAS_UNISTD #include diff --git a/otherlibs/unix/getaddrinfo.c b/otherlibs/unix/getaddrinfo.c index 28d8903a..28179343 100644 --- a/otherlibs/unix/getaddrinfo.c +++ b/otherlibs/unix/getaddrinfo.c @@ -12,12 +12,12 @@ /***********************************************************************/ #include -#include -#include -#include -#include -#include -#include +#include +#include +#include +#include +#include +#include #include "unixsupport.h" #include "cst2constr.h" diff --git a/otherlibs/unix/getcwd.c b/otherlibs/unix/getcwd.c index 8d1b8e50..043c96b6 100644 --- a/otherlibs/unix/getcwd.c +++ b/otherlibs/unix/getcwd.c @@ -11,9 +11,9 @@ /* */ /***********************************************************************/ -#include -#include -#include +#include +#include +#include #include "unixsupport.h" #if !defined (_WIN32) && !macintosh diff --git a/otherlibs/unix/getegid.c b/otherlibs/unix/getegid.c index b1977ec9..c0ab2b39 100644 --- a/otherlibs/unix/getegid.c +++ b/otherlibs/unix/getegid.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -#include +#include #include "unixsupport.h" CAMLprim value unix_getegid(value unit) diff --git a/otherlibs/unix/geteuid.c b/otherlibs/unix/geteuid.c index 9bf89714..095d3fe1 100644 --- a/otherlibs/unix/geteuid.c +++ b/otherlibs/unix/geteuid.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -#include +#include #include "unixsupport.h" CAMLprim value unix_geteuid(value unit) diff --git a/otherlibs/unix/getgid.c b/otherlibs/unix/getgid.c index 8cfe3ddb..8a4991a5 100644 --- a/otherlibs/unix/getgid.c +++ b/otherlibs/unix/getgid.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -#include +#include #include "unixsupport.h" CAMLprim value unix_getgid(value unit) diff --git a/otherlibs/unix/getgr.c b/otherlibs/unix/getgr.c index d1e610d8..14338ccf 100644 --- a/otherlibs/unix/getgr.c +++ b/otherlibs/unix/getgr.c @@ -11,10 +11,10 @@ /* */ /***********************************************************************/ -#include -#include -#include -#include +#include +#include +#include +#include #include "unixsupport.h" #include #include diff --git a/otherlibs/unix/getgroups.c b/otherlibs/unix/getgroups.c index 6d420b5e..84cd4540 100644 --- a/otherlibs/unix/getgroups.c +++ b/otherlibs/unix/getgroups.c @@ -11,9 +11,9 @@ /* */ /***********************************************************************/ -#include -#include -#include +#include +#include +#include #ifdef HAS_GETGROUPS diff --git a/otherlibs/unix/gethost.c b/otherlibs/unix/gethost.c index 8d5bb03f..d5220415 100644 --- a/otherlibs/unix/gethost.c +++ b/otherlibs/unix/gethost.c @@ -12,11 +12,11 @@ /***********************************************************************/ #include -#include -#include -#include -#include -#include +#include +#include +#include +#include +#include #include "unixsupport.h" #ifdef HAS_SOCKETS diff --git a/otherlibs/unix/gethostname.c b/otherlibs/unix/gethostname.c index 77b183cb..a3aba574 100644 --- a/otherlibs/unix/gethostname.c +++ b/otherlibs/unix/gethostname.c @@ -11,9 +11,9 @@ /* */ /***********************************************************************/ -#include -#include -#include +#include +#include +#include #ifndef _WIN32 #include #endif diff --git a/otherlibs/unix/getlogin.c b/otherlibs/unix/getlogin.c index 27a508e0..7f40e442 100644 --- a/otherlibs/unix/getlogin.c +++ b/otherlibs/unix/getlogin.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include "unixsupport.h" #include diff --git a/otherlibs/unix/getnameinfo.c b/otherlibs/unix/getnameinfo.c index d7dddb3f..d4663957 100644 --- a/otherlibs/unix/getnameinfo.c +++ b/otherlibs/unix/getnameinfo.c @@ -12,11 +12,11 @@ /***********************************************************************/ #include -#include -#include -#include -#include -#include +#include +#include +#include +#include +#include #include "unixsupport.h" #if defined(HAS_SOCKETS) && defined(HAS_IPV6) diff --git a/otherlibs/unix/getpeername.c b/otherlibs/unix/getpeername.c index 9692202c..183b210d 100644 --- a/otherlibs/unix/getpeername.c +++ b/otherlibs/unix/getpeername.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include "unixsupport.h" #ifdef HAS_SOCKETS diff --git a/otherlibs/unix/getpid.c b/otherlibs/unix/getpid.c index cf4c3f90..4cf46e4c 100644 --- a/otherlibs/unix/getpid.c +++ b/otherlibs/unix/getpid.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -#include +#include #include "unixsupport.h" CAMLprim value unix_getpid(value unit) diff --git a/otherlibs/unix/getppid.c b/otherlibs/unix/getppid.c index 616393b4..8c30a77a 100644 --- a/otherlibs/unix/getppid.c +++ b/otherlibs/unix/getppid.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -#include +#include #include "unixsupport.h" CAMLprim value unix_getppid(value unit) diff --git a/otherlibs/unix/getproto.c b/otherlibs/unix/getproto.c index 291a71da..b89cbba4 100644 --- a/otherlibs/unix/getproto.c +++ b/otherlibs/unix/getproto.c @@ -11,10 +11,10 @@ /* */ /***********************************************************************/ -#include -#include -#include -#include +#include +#include +#include +#include #include "unixsupport.h" #ifdef HAS_SOCKETS diff --git a/otherlibs/unix/getpw.c b/otherlibs/unix/getpw.c index 0061ca80..82fb4d8f 100644 --- a/otherlibs/unix/getpw.c +++ b/otherlibs/unix/getpw.c @@ -11,10 +11,10 @@ /* */ /***********************************************************************/ -#include -#include -#include -#include +#include +#include +#include +#include #include "unixsupport.h" #include diff --git a/otherlibs/unix/getserv.c b/otherlibs/unix/getserv.c index de91cbe0..deb5f147 100644 --- a/otherlibs/unix/getserv.c +++ b/otherlibs/unix/getserv.c @@ -11,10 +11,10 @@ /* */ /***********************************************************************/ -#include -#include -#include -#include +#include +#include +#include +#include #include "unixsupport.h" #ifdef HAS_SOCKETS diff --git a/otherlibs/unix/getsockname.c b/otherlibs/unix/getsockname.c index 69e20ccc..b28cfd14 100644 --- a/otherlibs/unix/getsockname.c +++ b/otherlibs/unix/getsockname.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include "unixsupport.h" #ifdef HAS_SOCKETS diff --git a/otherlibs/unix/gettimeofday.c b/otherlibs/unix/gettimeofday.c index f6a8615e..9cbfbeaa 100644 --- a/otherlibs/unix/gettimeofday.c +++ b/otherlibs/unix/gettimeofday.c @@ -11,9 +11,9 @@ /* */ /***********************************************************************/ -#include -#include -#include +#include +#include +#include #include "unixsupport.h" #ifdef HAS_GETTIMEOFDAY diff --git a/otherlibs/unix/getuid.c b/otherlibs/unix/getuid.c index f51722a5..7d0ce399 100644 --- a/otherlibs/unix/getuid.c +++ b/otherlibs/unix/getuid.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -#include +#include #include "unixsupport.h" CAMLprim value unix_getuid(value unit) diff --git a/otherlibs/unix/gmtime.c b/otherlibs/unix/gmtime.c index c8f6ac11..566f174f 100644 --- a/otherlibs/unix/gmtime.c +++ b/otherlibs/unix/gmtime.c @@ -11,10 +11,10 @@ /* */ /***********************************************************************/ -#include -#include -#include -#include +#include +#include +#include +#include #include "unixsupport.h" #include #include diff --git a/otherlibs/unix/initgroups.c b/otherlibs/unix/initgroups.c index e9541e5a..ca3ed4c9 100644 --- a/otherlibs/unix/initgroups.c +++ b/otherlibs/unix/initgroups.c @@ -11,9 +11,9 @@ /* */ /***********************************************************************/ -#include -#include -#include +#include +#include +#include #ifdef HAS_INITGROUPS diff --git a/otherlibs/unix/isatty.c b/otherlibs/unix/isatty.c index 800afc46..935c39d4 100644 --- a/otherlibs/unix/isatty.c +++ b/otherlibs/unix/isatty.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -#include +#include #include "unixsupport.h" CAMLprim value unix_isatty(value fd) diff --git a/otherlibs/unix/itimer.c b/otherlibs/unix/itimer.c index 537c2d9e..f1950264 100644 --- a/otherlibs/unix/itimer.c +++ b/otherlibs/unix/itimer.c @@ -11,10 +11,10 @@ /* */ /***********************************************************************/ -#include -#include -#include -#include +#include +#include +#include +#include #include "unixsupport.h" #ifdef HAS_SETITIMER diff --git a/otherlibs/unix/kill.c b/otherlibs/unix/kill.c index b3f7d887..c0f74d48 100644 --- a/otherlibs/unix/kill.c +++ b/otherlibs/unix/kill.c @@ -11,11 +11,11 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include "unixsupport.h" #include -#include +#include CAMLprim value unix_kill(value pid, value signal) { diff --git a/otherlibs/unix/link.c b/otherlibs/unix/link.c index c71118a5..0ec42f5f 100644 --- a/otherlibs/unix/link.c +++ b/otherlibs/unix/link.c @@ -11,9 +11,9 @@ /* */ /***********************************************************************/ -#include -#include -#include +#include +#include +#include #include "unixsupport.h" CAMLprim value unix_link(value path1, value path2) diff --git a/otherlibs/unix/listen.c b/otherlibs/unix/listen.c index 26b0185b..38efc9fd 100644 --- a/otherlibs/unix/listen.c +++ b/otherlibs/unix/listen.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include "unixsupport.h" #ifdef HAS_SOCKETS diff --git a/otherlibs/unix/lockf.c b/otherlibs/unix/lockf.c index 813a4f7f..aeaf4513 100644 --- a/otherlibs/unix/lockf.c +++ b/otherlibs/unix/lockf.c @@ -13,9 +13,9 @@ #include #include -#include -#include -#include +#include +#include +#include #include "unixsupport.h" #if defined(F_GETLK) && defined(F_SETLK) && defined(F_SETLKW) diff --git a/otherlibs/unix/lseek.c b/otherlibs/unix/lseek.c index 826d84f2..5a7b7770 100644 --- a/otherlibs/unix/lseek.c +++ b/otherlibs/unix/lseek.c @@ -13,10 +13,10 @@ #include #include -#include -#include -#include -#include +#include +#include +#include +#include #include "unixsupport.h" #ifdef HAS_UNISTD diff --git a/otherlibs/unix/mkdir.c b/otherlibs/unix/mkdir.c index d72a066c..6b9c76e6 100644 --- a/otherlibs/unix/mkdir.c +++ b/otherlibs/unix/mkdir.c @@ -13,9 +13,9 @@ #include #include -#include -#include -#include +#include +#include +#include #include "unixsupport.h" CAMLprim value unix_mkdir(value path, value perm) diff --git a/otherlibs/unix/mkfifo.c b/otherlibs/unix/mkfifo.c index a00bcf2d..07481385 100644 --- a/otherlibs/unix/mkfifo.c +++ b/otherlibs/unix/mkfifo.c @@ -13,10 +13,10 @@ #include #include -#include -#include -#include -#include +#include +#include +#include +#include #include "unixsupport.h" #ifdef HAS_MKFIFO diff --git a/otherlibs/unix/nanosecond_stat.h b/otherlibs/unix/nanosecond_stat.h new file mode 100644 index 00000000..c1a648ef --- /dev/null +++ b/otherlibs/unix/nanosecond_stat.h @@ -0,0 +1,25 @@ +/***********************************************************************/ +/* */ +/* 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 diff --git a/otherlibs/unix/nice.c b/otherlibs/unix/nice.c index d0956a16..e8f4f2b0 100644 --- a/otherlibs/unix/nice.c +++ b/otherlibs/unix/nice.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -#include +#include #include "unixsupport.h" #include #ifdef HAS_UNISTD diff --git a/otherlibs/unix/open.c b/otherlibs/unix/open.c index 32c332f2..1bad2c5b 100644 --- a/otherlibs/unix/open.c +++ b/otherlibs/unix/open.c @@ -11,11 +11,11 @@ /* */ /***********************************************************************/ -#include -#include -#include -#include -#include +#include +#include +#include +#include +#include #include "unixsupport.h" #include #ifdef HAS_UNISTD diff --git a/otherlibs/unix/opendir.c b/otherlibs/unix/opendir.c index 9cb6829c..bdf031b3 100644 --- a/otherlibs/unix/opendir.c +++ b/otherlibs/unix/opendir.c @@ -11,10 +11,10 @@ /* */ /***********************************************************************/ -#include -#include -#include -#include +#include +#include +#include +#include #include "unixsupport.h" #include #ifdef HAS_DIRENT diff --git a/otherlibs/unix/pipe.c b/otherlibs/unix/pipe.c index 7c6b1438..5f8f23da 100644 --- a/otherlibs/unix/pipe.c +++ b/otherlibs/unix/pipe.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include "unixsupport.h" CAMLprim value unix_pipe(value unit) diff --git a/otherlibs/unix/putenv.c b/otherlibs/unix/putenv.c index 28ad962f..ccb8f1ab 100644 --- a/otherlibs/unix/putenv.c +++ b/otherlibs/unix/putenv.c @@ -14,9 +14,9 @@ #include #include -#include -#include -#include +#include +#include +#include #include "unixsupport.h" diff --git a/otherlibs/unix/read.c b/otherlibs/unix/read.c index 3bbd0b47..14305d37 100644 --- a/otherlibs/unix/read.c +++ b/otherlibs/unix/read.c @@ -12,9 +12,9 @@ /***********************************************************************/ #include -#include -#include -#include +#include +#include +#include #include "unixsupport.h" CAMLprim value unix_read(value fd, value buf, value ofs, value len) diff --git a/otherlibs/unix/readdir.c b/otherlibs/unix/readdir.c index e6daf5f6..4c309268 100644 --- a/otherlibs/unix/readdir.c +++ b/otherlibs/unix/readdir.c @@ -11,10 +11,10 @@ /* */ /***********************************************************************/ -#include -#include -#include -#include +#include +#include +#include +#include #include "unixsupport.h" #include #include diff --git a/otherlibs/unix/readlink.c b/otherlibs/unix/readlink.c index 5706ba03..836718d1 100644 --- a/otherlibs/unix/readlink.c +++ b/otherlibs/unix/readlink.c @@ -11,11 +11,11 @@ /* */ /***********************************************************************/ -#include -#include -#include -#include -#include +#include +#include +#include +#include +#include #ifdef HAS_SYMLINK diff --git a/otherlibs/unix/rename.c b/otherlibs/unix/rename.c index 78da7094..78e0846c 100644 --- a/otherlibs/unix/rename.c +++ b/otherlibs/unix/rename.c @@ -12,9 +12,9 @@ /***********************************************************************/ #include -#include -#include -#include +#include +#include +#include #include "unixsupport.h" CAMLprim value unix_rename(value path1, value path2) diff --git a/otherlibs/unix/rewinddir.c b/otherlibs/unix/rewinddir.c index 17cc639f..c3771323 100644 --- a/otherlibs/unix/rewinddir.c +++ b/otherlibs/unix/rewinddir.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include "unixsupport.h" #include #include diff --git a/otherlibs/unix/rmdir.c b/otherlibs/unix/rmdir.c index 12d521a7..20359ce6 100644 --- a/otherlibs/unix/rmdir.c +++ b/otherlibs/unix/rmdir.c @@ -11,9 +11,9 @@ /* */ /***********************************************************************/ -#include -#include -#include +#include +#include +#include #include "unixsupport.h" CAMLprim value unix_rmdir(value path) diff --git a/otherlibs/unix/select.c b/otherlibs/unix/select.c index 12d8cc55..23c48024 100644 --- a/otherlibs/unix/select.c +++ b/otherlibs/unix/select.c @@ -11,11 +11,11 @@ /* */ /***********************************************************************/ -#include -#include -#include -#include -#include +#include +#include +#include +#include +#include #include "unixsupport.h" #ifdef HAS_SELECT diff --git a/otherlibs/unix/sendrecv.c b/otherlibs/unix/sendrecv.c index 679dde3c..7d251a43 100644 --- a/otherlibs/unix/sendrecv.c +++ b/otherlibs/unix/sendrecv.c @@ -12,11 +12,11 @@ /***********************************************************************/ #include -#include -#include -#include -#include -#include +#include +#include +#include +#include +#include #include "unixsupport.h" #ifdef HAS_SOCKETS diff --git a/otherlibs/unix/setgid.c b/otherlibs/unix/setgid.c index 8e635aa4..b7204745 100644 --- a/otherlibs/unix/setgid.c +++ b/otherlibs/unix/setgid.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -#include +#include #include "unixsupport.h" CAMLprim value unix_setgid(value gid) diff --git a/otherlibs/unix/setgroups.c b/otherlibs/unix/setgroups.c index 2279a6b3..7284b735 100644 --- a/otherlibs/unix/setgroups.c +++ b/otherlibs/unix/setgroups.c @@ -11,10 +11,10 @@ /* */ /***********************************************************************/ -#include -#include -#include -#include +#include +#include +#include +#include #ifdef HAS_SETGROUPS diff --git a/otherlibs/unix/setsid.c b/otherlibs/unix/setsid.c index 252b85c4..92814eba 100644 --- a/otherlibs/unix/setsid.c +++ b/otherlibs/unix/setsid.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include "unixsupport.h" #ifdef HAS_UNISTD #include diff --git a/otherlibs/unix/setuid.c b/otherlibs/unix/setuid.c index 8a2a8074..c8a9c622 100644 --- a/otherlibs/unix/setuid.c +++ b/otherlibs/unix/setuid.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -#include +#include #include "unixsupport.h" CAMLprim value unix_setuid(value uid) diff --git a/otherlibs/unix/shutdown.c b/otherlibs/unix/shutdown.c index c428afbd..1ceafd6e 100644 --- a/otherlibs/unix/shutdown.c +++ b/otherlibs/unix/shutdown.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include "unixsupport.h" #ifdef HAS_SOCKETS diff --git a/otherlibs/unix/signals.c b/otherlibs/unix/signals.c index d4d97ef0..d30a70db 100644 --- a/otherlibs/unix/signals.c +++ b/otherlibs/unix/signals.c @@ -14,11 +14,11 @@ #include #include -#include -#include -#include -#include -#include +#include +#include +#include +#include +#include #include "unixsupport.h" #ifndef NSIG diff --git a/otherlibs/unix/sleep.c b/otherlibs/unix/sleep.c index 58affd39..a39c5f82 100644 --- a/otherlibs/unix/sleep.c +++ b/otherlibs/unix/sleep.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include "unixsupport.h" CAMLprim value unix_sleep(value t) diff --git a/otherlibs/unix/socket.c b/otherlibs/unix/socket.c index 9e23231a..9cf3ed3a 100644 --- a/otherlibs/unix/socket.c +++ b/otherlibs/unix/socket.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include "unixsupport.h" #ifdef HAS_SOCKETS diff --git a/otherlibs/unix/socketaddr.c b/otherlibs/unix/socketaddr.c index 24babcab..2f4bdadf 100644 --- a/otherlibs/unix/socketaddr.c +++ b/otherlibs/unix/socketaddr.c @@ -12,9 +12,9 @@ /***********************************************************************/ #include -#include -#include -#include +#include +#include +#include #include #include "unixsupport.h" diff --git a/otherlibs/unix/socketaddr.h b/otherlibs/unix/socketaddr.h index cf25e2f9..0077daea 100644 --- a/otherlibs/unix/socketaddr.h +++ b/otherlibs/unix/socketaddr.h @@ -11,7 +11,10 @@ /* */ /***********************************************************************/ -#include "misc.h" +#ifndef CAML_SOCKETADDR_H +#define CAML_SOCKETADDR_H + +#include "caml/misc.h" #include #include #include @@ -33,6 +36,10 @@ typedef socklen_t socklen_param_type; 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*/); @@ -45,3 +52,9 @@ CAMLexport value alloc_inet_addr (struct in_addr * inaddr); 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 */ diff --git a/otherlibs/unix/socketpair.c b/otherlibs/unix/socketpair.c index 301ebf86..4f85f9a6 100644 --- a/otherlibs/unix/socketpair.c +++ b/otherlibs/unix/socketpair.c @@ -11,9 +11,9 @@ /* */ /***********************************************************************/ -#include -#include -#include +#include +#include +#include #include "unixsupport.h" #ifdef HAS_SOCKETS diff --git a/otherlibs/unix/sockopt.c b/otherlibs/unix/sockopt.c index b6167ebf..8137e42c 100644 --- a/otherlibs/unix/sockopt.c +++ b/otherlibs/unix/sockopt.c @@ -11,10 +11,10 @@ /* */ /***********************************************************************/ -#include -#include -#include -#include +#include +#include +#include +#include #include "unixsupport.h" #ifdef HAS_SOCKETS @@ -194,6 +194,7 @@ unix_getsockopt_aux(char * name, switch (ty) { case TYPE_BOOL: + return Val_bool(optval.i); case TYPE_INT: return Val_int(optval.i); case TYPE_LINGER: diff --git a/otherlibs/unix/stat.c b/otherlibs/unix/stat.c index f6d8c06d..f938645a 100644 --- a/otherlibs/unix/stat.c +++ b/otherlibs/unix/stat.c @@ -12,15 +12,15 @@ /***********************************************************************/ #include -#include -#include -#include -#include -#include "unixsupport.h" -#include "cst2constr.h" #include #include -#include +#include +#include +#include +#include +#include +#include "unixsupport.h" +#include "cst2constr.h" #ifndef S_IFLNK #define S_IFLNK 0 @@ -48,9 +48,11 @@ static value stat_aux(int use_64, struct stat *buf) 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); diff --git a/otherlibs/unix/strofaddr.c b/otherlibs/unix/strofaddr.c index 5381bc31..c4ea6bad 100644 --- a/otherlibs/unix/strofaddr.c +++ b/otherlibs/unix/strofaddr.c @@ -11,9 +11,9 @@ /* */ /***********************************************************************/ -#include -#include -#include +#include +#include +#include #include "unixsupport.h" #ifdef HAS_SOCKETS diff --git a/otherlibs/unix/symlink.c b/otherlibs/unix/symlink.c index d1dbf37c..dbbd2665 100644 --- a/otherlibs/unix/symlink.c +++ b/otherlibs/unix/symlink.c @@ -11,10 +11,10 @@ /* */ /***********************************************************************/ -#include -#include -#include -#include +#include +#include +#include +#include #include "unixsupport.h" #ifdef HAS_SYMLINK diff --git a/otherlibs/unix/termios.c b/otherlibs/unix/termios.c index 9dd168ae..40173737 100644 --- a/otherlibs/unix/termios.c +++ b/otherlibs/unix/termios.c @@ -11,9 +11,9 @@ /* */ /***********************************************************************/ -#include -#include -#include +#include +#include +#include #include "unixsupport.h" #ifdef HAS_TERMIOS @@ -90,17 +90,22 @@ static long terminal_io_descr[] = { #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}, @@ -110,6 +115,8 @@ static struct { {B9600, 9600}, {B19200, 19200}, {B38400, 38400}, + + /* usual extensions */ #ifdef B57600 {B57600, 57600}, #endif @@ -119,7 +126,66 @@ static struct { #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])) diff --git a/otherlibs/unix/time.c b/otherlibs/unix/time.c index 042a1f60..495adb66 100644 --- a/otherlibs/unix/time.c +++ b/otherlibs/unix/time.c @@ -12,8 +12,8 @@ /***********************************************************************/ #include -#include -#include +#include +#include #include "unixsupport.h" CAMLprim value unix_time(value unit) diff --git a/otherlibs/unix/times.c b/otherlibs/unix/times.c index 8ab6006d..8760ad2a 100644 --- a/otherlibs/unix/times.c +++ b/otherlibs/unix/times.c @@ -11,9 +11,9 @@ /* */ /***********************************************************************/ -#include -#include -#include +#include +#include +#include #include "unixsupport.h" #include #include diff --git a/otherlibs/unix/truncate.c b/otherlibs/unix/truncate.c index 520320eb..62683fcf 100644 --- a/otherlibs/unix/truncate.c +++ b/otherlibs/unix/truncate.c @@ -12,11 +12,11 @@ /***********************************************************************/ #include -#include -#include -#include -#include -#include +#include +#include +#include +#include +#include #include "unixsupport.h" #ifdef HAS_UNISTD #include diff --git a/otherlibs/unix/umask.c b/otherlibs/unix/umask.c index 311e4ed9..9b88f105 100644 --- a/otherlibs/unix/umask.c +++ b/otherlibs/unix/umask.c @@ -13,7 +13,7 @@ #include #include -#include +#include #include "unixsupport.h" CAMLprim value unix_umask(value perm) diff --git a/otherlibs/unix/unixsupport.c b/otherlibs/unix/unixsupport.c index f1df3fc7..6c7171fd 100644 --- a/otherlibs/unix/unixsupport.c +++ b/otherlibs/unix/unixsupport.c @@ -11,11 +11,11 @@ /* */ /***********************************************************************/ -#include -#include -#include -#include -#include +#include +#include +#include +#include +#include #include "unixsupport.h" #include "cst2constr.h" #include diff --git a/otherlibs/unix/unixsupport.h b/otherlibs/unix/unixsupport.h index a8065d97..d4312ab4 100644 --- a/otherlibs/unix/unixsupport.h +++ b/otherlibs/unix/unixsupport.h @@ -11,10 +11,17 @@ /* */ /***********************************************************************/ +#ifndef CAML_UNIXSUPPORT_H +#define CAML_UNIXSUPPORT_H + #ifdef HAS_UNISTD #include #endif +#ifdef __cplusplus +extern "C" { +#endif + #define Nothing ((value) 0) extern value unix_error_of_code (int errcode); @@ -25,3 +32,9 @@ extern void uerror (char * cmdname, value arg) Noreturn; #define UNIX_BUFFER_SIZE 65536 #define DIR_Val(v) *((DIR **) &Field(v, 0)) + +#ifdef __cplusplus +} +#endif + +#endif /* CAML_UNIXSUPPORT_H */ diff --git a/otherlibs/unix/unlink.c b/otherlibs/unix/unlink.c index ae63f69a..687c69c2 100644 --- a/otherlibs/unix/unlink.c +++ b/otherlibs/unix/unlink.c @@ -11,9 +11,9 @@ /* */ /***********************************************************************/ -#include -#include -#include +#include +#include +#include #include "unixsupport.h" CAMLprim value unix_unlink(value path) diff --git a/otherlibs/unix/utimes.c b/otherlibs/unix/utimes.c index 0c3b77d1..bf2ae2fb 100644 --- a/otherlibs/unix/utimes.c +++ b/otherlibs/unix/utimes.c @@ -11,10 +11,10 @@ /* */ /***********************************************************************/ -#include -#include -#include -#include +#include +#include +#include +#include #include "unixsupport.h" #ifdef HAS_UTIME diff --git a/otherlibs/unix/wait.c b/otherlibs/unix/wait.c index 81f36839..a8eb42b7 100644 --- a/otherlibs/unix/wait.c +++ b/otherlibs/unix/wait.c @@ -11,11 +11,11 @@ /* */ /***********************************************************************/ -#include -#include -#include -#include -#include +#include +#include +#include +#include +#include #include "unixsupport.h" #include diff --git a/otherlibs/unix/write.c b/otherlibs/unix/write.c index d6fe4093..d6842d9f 100644 --- a/otherlibs/unix/write.c +++ b/otherlibs/unix/write.c @@ -13,9 +13,9 @@ #include #include -#include -#include -#include +#include +#include +#include #include "unixsupport.h" #ifndef EAGAIN diff --git a/otherlibs/win32graph/dib.c b/otherlibs/win32graph/dib.c index 100beba3..26fccf7f 100644 --- a/otherlibs/win32graph/dib.c +++ b/otherlibs/win32graph/dib.c @@ -42,9 +42,9 @@ #include -#include +#include #include -#include +#include #include // Size of window extra bytes (we store a handle to a PALINFO structure). diff --git a/otherlibs/win32graph/draw.c b/otherlibs/win32graph/draw.c index 11426734..99e1c5c7 100644 --- a/otherlibs/win32graph/draw.c +++ b/otherlibs/win32graph/draw.c @@ -12,12 +12,12 @@ /***********************************************************************/ #include -#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; diff --git a/otherlibs/win32graph/events.c b/otherlibs/win32graph/events.c index 81242729..837e53ac 100755 --- a/otherlibs/win32graph/events.c +++ b/otherlibs/win32graph/events.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include "mlvalues.h" -#include "alloc.h" +#include "caml/mlvalues.h" +#include "caml/alloc.h" #include "libgraph.h" #include diff --git a/otherlibs/win32graph/open.c b/otherlibs/win32graph/open.c index ded2e28a..e9d10cad 100644 --- a/otherlibs/win32graph/open.c +++ b/otherlibs/win32graph/open.c @@ -13,10 +13,10 @@ #include #include -#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 static value gr_reset(void); @@ -112,7 +112,7 @@ int DoRegisterClass(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); diff --git a/otherlibs/win32unix/accept.c b/otherlibs/win32unix/accept.c index f2e14467..f705f0f0 100644 --- a/otherlibs/win32unix/accept.c +++ b/otherlibs/win32unix/accept.c @@ -11,10 +11,10 @@ /* */ /***********************************************************************/ -#include -#include -#include -#include +#include +#include +#include +#include #include "unixsupport.h" #include // for SO_OPENTYPE and SO_SYNCHRONOUS_NONALERT #include "socketaddr.h" diff --git a/otherlibs/win32unix/bind.c b/otherlibs/win32unix/bind.c index bc092308..4b1d3def 100644 --- a/otherlibs/win32unix/bind.c +++ b/otherlibs/win32unix/bind.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -#include +#include #include "unixsupport.h" #include "socketaddr.h" diff --git a/otherlibs/win32unix/channels.c b/otherlibs/win32unix/channels.c index 1e7e823a..b6350e17 100644 --- a/otherlibs/win32unix/channels.c +++ b/otherlibs/win32unix/channels.c @@ -11,10 +11,10 @@ /* */ /***********************************************************************/ -#include -#include -#include -#include +#include +#include +#include +#include #include "unixsupport.h" #include diff --git a/otherlibs/win32unix/close.c b/otherlibs/win32unix/close.c index 20b131b0..7f8da29d 100644 --- a/otherlibs/win32unix/close.c +++ b/otherlibs/win32unix/close.c @@ -11,9 +11,9 @@ /* */ /***********************************************************************/ -#include +#include #include "unixsupport.h" -#include +#include extern int _close(int); diff --git a/otherlibs/win32unix/close_on.c b/otherlibs/win32unix/close_on.c index 9ba342ed..7a316abc 100644 --- a/otherlibs/win32unix/close_on.c +++ b/otherlibs/win32unix/close_on.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -#include +#include #include "unixsupport.h" #include diff --git a/otherlibs/win32unix/connect.c b/otherlibs/win32unix/connect.c index 190eb742..37cdbdaa 100644 --- a/otherlibs/win32unix/connect.c +++ b/otherlibs/win32unix/connect.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include "unixsupport.h" #include "socketaddr.h" diff --git a/otherlibs/win32unix/createprocess.c b/otherlibs/win32unix/createprocess.c index 0e1e37a2..9766df5c 100644 --- a/otherlibs/win32unix/createprocess.c +++ b/otherlibs/win32unix/createprocess.c @@ -11,10 +11,10 @@ /* */ /***********************************************************************/ -#include +#include #include "unixsupport.h" #include -#include +#include static int win_has_console(void); diff --git a/otherlibs/win32unix/dup.c b/otherlibs/win32unix/dup.c index 76cbdf67..5db19e30 100644 --- a/otherlibs/win32unix/dup.c +++ b/otherlibs/win32unix/dup.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -#include +#include #include "unixsupport.h" CAMLprim value unix_dup(value fd) diff --git a/otherlibs/win32unix/dup2.c b/otherlibs/win32unix/dup2.c index 5f19710c..51842077 100644 --- a/otherlibs/win32unix/dup2.c +++ b/otherlibs/win32unix/dup2.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -#include +#include #include "unixsupport.h" extern int _dup2(int, int); diff --git a/otherlibs/win32unix/errmsg.c b/otherlibs/win32unix/errmsg.c index c3bc19c6..6107abc3 100644 --- a/otherlibs/win32unix/errmsg.c +++ b/otherlibs/win32unix/errmsg.c @@ -14,8 +14,8 @@ #include #include #include -#include -#include +#include +#include #include "unixsupport.h" extern int error_table[]; diff --git a/otherlibs/win32unix/getpeername.c b/otherlibs/win32unix/getpeername.c index ad6674bf..3467e03f 100644 --- a/otherlibs/win32unix/getpeername.c +++ b/otherlibs/win32unix/getpeername.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -#include +#include #include "unixsupport.h" #include "socketaddr.h" diff --git a/otherlibs/win32unix/getpid.c b/otherlibs/win32unix/getpid.c index 65c8828a..06d95356 100644 --- a/otherlibs/win32unix/getpid.c +++ b/otherlibs/win32unix/getpid.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -#include +#include #include "unixsupport.h" extern value val_process_id; diff --git a/otherlibs/win32unix/getsockname.c b/otherlibs/win32unix/getsockname.c index 1e28f4b2..21e9d063 100644 --- a/otherlibs/win32unix/getsockname.c +++ b/otherlibs/win32unix/getsockname.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -#include +#include #include "unixsupport.h" #include "socketaddr.h" diff --git a/otherlibs/win32unix/gettimeofday.c b/otherlibs/win32unix/gettimeofday.c index 573821fd..f4e25b5f 100644 --- a/otherlibs/win32unix/gettimeofday.c +++ b/otherlibs/win32unix/gettimeofday.c @@ -11,44 +11,20 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include #include "unixsupport.h" -#ifdef HAS_MKTIME -static double initial_time = 0; /* 0 means uninitialized */ -#else -static time_t initial_time = 0; /* 0 means uninitialized */ -#endif -static DWORD initial_tickcount; +/* 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 */ } diff --git a/otherlibs/win32unix/link.c b/otherlibs/win32unix/link.c index 97748ba2..93d21508 100644 --- a/otherlibs/win32unix/link.c +++ b/otherlibs/win32unix/link.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include "unixsupport.h" #include diff --git a/otherlibs/win32unix/listen.c b/otherlibs/win32unix/listen.c index 9602a373..767db61d 100644 --- a/otherlibs/win32unix/listen.c +++ b/otherlibs/win32unix/listen.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -#include +#include #include "unixsupport.h" CAMLprim value unix_listen(sock, backlog) diff --git a/otherlibs/win32unix/lockf.c b/otherlibs/win32unix/lockf.c index 6e6ca0ad..9c705a67 100644 --- a/otherlibs/win32unix/lockf.c +++ b/otherlibs/win32unix/lockf.c @@ -15,12 +15,12 @@ #include #include -#include -#include -#include +#include +#include +#include #include "unixsupport.h" #include -#include +#include #ifndef INVALID_SET_FILE_POINTER #define INVALID_SET_FILE_POINTER (-1) diff --git a/otherlibs/win32unix/lseek.c b/otherlibs/win32unix/lseek.c index 5306331c..6c30a62a 100644 --- a/otherlibs/win32unix/lseek.c +++ b/otherlibs/win32unix/lseek.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include "unixsupport.h" #ifdef HAS_UNISTD diff --git a/otherlibs/win32unix/mkdir.c b/otherlibs/win32unix/mkdir.c index 998b32ba..21bca10c 100644 --- a/otherlibs/win32unix/mkdir.c +++ b/otherlibs/win32unix/mkdir.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -#include +#include #include "unixsupport.h" CAMLprim value unix_mkdir(path, perm) diff --git a/otherlibs/win32unix/nonblock.c b/otherlibs/win32unix/nonblock.c index a9aaeca5..4001beca 100755 --- a/otherlibs/win32unix/nonblock.c +++ b/otherlibs/win32unix/nonblock.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include "unixsupport.h" CAMLprim value unix_set_nonblock(socket) diff --git a/otherlibs/win32unix/open.c b/otherlibs/win32unix/open.c index afb8d0fb..f9e9df21 100644 --- a/otherlibs/win32unix/open.c +++ b/otherlibs/win32unix/open.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include "unixsupport.h" #include diff --git a/otherlibs/win32unix/pipe.c b/otherlibs/win32unix/pipe.c index fe553778..88debb02 100644 --- a/otherlibs/win32unix/pipe.c +++ b/otherlibs/win32unix/pipe.c @@ -11,9 +11,9 @@ /* */ /***********************************************************************/ -#include -#include -#include +#include +#include +#include #include "unixsupport.h" #include diff --git a/otherlibs/win32unix/read.c b/otherlibs/win32unix/read.c index e7a2b38d..d65683cc 100644 --- a/otherlibs/win32unix/read.c +++ b/otherlibs/win32unix/read.c @@ -12,9 +12,9 @@ /***********************************************************************/ #include -#include -#include -#include +#include +#include +#include #include "unixsupport.h" CAMLprim value unix_read(value fd, value buf, value ofs, value vlen) diff --git a/otherlibs/win32unix/rename.c b/otherlibs/win32unix/rename.c index b8c0f3ed..ad46ead2 100644 --- a/otherlibs/win32unix/rename.c +++ b/otherlibs/win32unix/rename.c @@ -12,7 +12,7 @@ /***********************************************************************/ #include -#include +#include #include "unixsupport.h" CAMLprim value unix_rename(value path1, value path2) diff --git a/otherlibs/win32unix/select.c b/otherlibs/win32unix/select.c index d4afe498..0e21db89 100644 --- a/otherlibs/win32unix/select.c +++ b/otherlibs/win32unix/select.c @@ -11,11 +11,11 @@ /* */ /***********************************************************************/ -#include -#include -#include -#include -#include +#include +#include +#include +#include +#include #include "winworker.h" #include #include "windbug.h" diff --git a/otherlibs/win32unix/sendrecv.c b/otherlibs/win32unix/sendrecv.c index 32532553..5957f6ed 100644 --- a/otherlibs/win32unix/sendrecv.c +++ b/otherlibs/win32unix/sendrecv.c @@ -11,10 +11,10 @@ /* */ /***********************************************************************/ -#include -#include -#include -#include +#include +#include +#include +#include #include "unixsupport.h" #include "socketaddr.h" diff --git a/otherlibs/win32unix/shutdown.c b/otherlibs/win32unix/shutdown.c index 2d5707a3..96023111 100644 --- a/otherlibs/win32unix/shutdown.c +++ b/otherlibs/win32unix/shutdown.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -#include +#include #include "unixsupport.h" static int shutdown_command_table[] = { diff --git a/otherlibs/win32unix/sleep.c b/otherlibs/win32unix/sleep.c index 28e60e40..6d630d20 100644 --- a/otherlibs/win32unix/sleep.c +++ b/otherlibs/win32unix/sleep.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include "unixsupport.h" CAMLprim value unix_sleep(t) diff --git a/otherlibs/win32unix/socket.c b/otherlibs/win32unix/socket.c index ad8165b2..9385e82e 100644 --- a/otherlibs/win32unix/socket.c +++ b/otherlibs/win32unix/socket.c @@ -11,7 +11,7 @@ /* */ /***********************************************************************/ -#include +#include #include "unixsupport.h" #include // for SO_OPENTYPE and SO_SYNCHRONOUS_NONALERT diff --git a/otherlibs/win32unix/socketaddr.h b/otherlibs/win32unix/socketaddr.h index fde691ec..f3b6caf0 100644 --- a/otherlibs/win32unix/socketaddr.h +++ b/otherlibs/win32unix/socketaddr.h @@ -11,7 +11,10 @@ /* */ /***********************************************************************/ -#include "misc.h" +#ifndef CAML_SOCKETADDR_H +#define CAML_SOCKETADDR_H + +#include "caml/misc.h" union sock_addr_union { struct sockaddr s_gen; @@ -29,6 +32,10 @@ typedef socklen_t socklen_param_type; 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*/); @@ -41,3 +48,9 @@ CAMLprim value alloc_inet_addr (struct in_addr * inaddr); 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 */ diff --git a/otherlibs/win32unix/sockopt.c b/otherlibs/win32unix/sockopt.c index eefa9a30..aebc517a 100644 --- a/otherlibs/win32unix/sockopt.c +++ b/otherlibs/win32unix/sockopt.c @@ -12,10 +12,10 @@ /***********************************************************************/ #include -#include -#include -#include -#include +#include +#include +#include +#include #include "unixsupport.h" #include "socketaddr.h" diff --git a/otherlibs/win32unix/startup.c b/otherlibs/win32unix/startup.c index 65aedc6a..be66c8a8 100644 --- a/otherlibs/win32unix/startup.c +++ b/otherlibs/win32unix/startup.c @@ -14,7 +14,7 @@ #include #include #include -#include +#include #include "winworker.h" #include "windbug.h" diff --git a/otherlibs/win32unix/stat.c b/otherlibs/win32unix/stat.c index 56b45d03..46fc9841 100644 --- a/otherlibs/win32unix/stat.c +++ b/otherlibs/win32unix/stat.c @@ -12,9 +12,9 @@ /***********************************************************************/ #include -#include -#include -#include +#include +#include +#include #include "unixsupport.h" #include "cst2constr.h" #define _INTEGRAL_MAX_BITS 64 diff --git a/otherlibs/win32unix/system.c b/otherlibs/win32unix/system.c index 13d5658e..202dcd08 100644 --- a/otherlibs/win32unix/system.c +++ b/otherlibs/win32unix/system.c @@ -11,10 +11,10 @@ /* */ /***********************************************************************/ -#include -#include -#include -#include +#include +#include +#include +#include #include "unixsupport.h" #include #include diff --git a/otherlibs/win32unix/times.c b/otherlibs/win32unix/times.c index e6b5ab0a..e97d3a5c 100644 --- a/otherlibs/win32unix/times.c +++ b/otherlibs/win32unix/times.c @@ -11,8 +11,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include "unixsupport.h" #include diff --git a/otherlibs/win32unix/unixsupport.c b/otherlibs/win32unix/unixsupport.c index f954dfc9..5c606e0d 100644 --- a/otherlibs/win32unix/unixsupport.c +++ b/otherlibs/win32unix/unixsupport.c @@ -12,12 +12,12 @@ /***********************************************************************/ #include -#include -#include -#include -#include -#include -#include +#include +#include +#include +#include +#include +#include #include "unixsupport.h" #include "cst2constr.h" #include diff --git a/otherlibs/win32unix/unixsupport.h b/otherlibs/win32unix/unixsupport.h index b8f8acad..b8efb278 100644 --- a/otherlibs/win32unix/unixsupport.h +++ b/otherlibs/win32unix/unixsupport.h @@ -11,6 +11,9 @@ /* */ /***********************************************************************/ +#ifndef CAML_UNIXSUPPORT_H +#define CAML_UNIXSUPPORT_H + #define WIN32_LEAN_AND_MEAN #include #include @@ -24,6 +27,10 @@ #include #endif +#ifdef __cplusplus +extern "C" { +#endif + struct filedescr { union { HANDLE handle; @@ -62,3 +69,9 @@ extern value unix_freeze_buffer (value); #define FLAGS_FD_IS_BLOCKING (1<<0) #define UNIX_BUFFER_SIZE 65536 + +#ifdef __cplusplus +} +#endif + +#endif /* CAML_UNIXSUPPORT_H */ diff --git a/otherlibs/win32unix/windir.c b/otherlibs/win32unix/windir.c index 7a08e510..ef952aa9 100644 --- a/otherlibs/win32unix/windir.c +++ b/otherlibs/win32unix/windir.c @@ -11,11 +11,11 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include #include -#include -#include +#include +#include #include "unixsupport.h" CAMLprim value win_findfirst(name) diff --git a/otherlibs/win32unix/winwait.c b/otherlibs/win32unix/winwait.c index 0436072f..510a16fe 100644 --- a/otherlibs/win32unix/winwait.c +++ b/otherlibs/win32unix/winwait.c @@ -11,10 +11,10 @@ /* */ /***********************************************************************/ -#include -#include -#include -#include +#include +#include +#include +#include #include "unixsupport.h" #include #include diff --git a/otherlibs/win32unix/winworker.c b/otherlibs/win32unix/winworker.c index f8ef33e1..bcd5947a 100644 --- a/otherlibs/win32unix/winworker.c +++ b/otherlibs/win32unix/winworker.c @@ -11,10 +11,10 @@ /* */ /***********************************************************************/ -#include -#include -#include -#include +#include +#include +#include +#include #include "winworker.h" #include "winlist.h" #include "windbug.h" diff --git a/otherlibs/win32unix/write.c b/otherlibs/win32unix/write.c index 65f82ccb..dc0ae91b 100644 --- a/otherlibs/win32unix/write.c +++ b/otherlibs/win32unix/write.c @@ -13,9 +13,9 @@ #include #include -#include -#include -#include +#include +#include +#include #include "unixsupport.h" CAMLprim value unix_write(value fd, value buf, value vofs, value vlen) diff --git a/parsing/ast_helper.ml b/parsing/ast_helper.ml index 47c7bd33..b84cda8c 100644 --- a/parsing/ast_helper.ml +++ b/parsing/ast_helper.ml @@ -14,6 +14,7 @@ open Asttypes open Parsetree +open Docstrings type lid = Longident.t loc type str = string loc @@ -169,6 +170,10 @@ module Sig = struct 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 @@ -189,6 +194,10 @@ 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 @@ -225,13 +234,13 @@ module Cty = 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)) @@ -239,16 +248,23 @@ module Ctf = struct 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)) @@ -257,96 +273,117 @@ module Cf = struct 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) @@ -360,65 +397,73 @@ module Type = struct 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 = @@ -435,3 +480,4 @@ module Cstr = struct pcstr_fields = fields; } end + diff --git a/parsing/ast_helper.mli b/parsing/ast_helper.mli index b9b04f82..4dc96169 100644 --- a/parsing/ast_helper.mli +++ b/parsing/ast_helper.mli @@ -14,6 +14,7 @@ open Parsetree open Asttypes +open Docstrings type lid = Longident.t loc type str = string loc @@ -24,6 +25,7 @@ type attrs = attribute list 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. *) @@ -146,27 +148,38 @@ module Exp: (** 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} *) @@ -221,6 +234,7 @@ module Sig: 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 *) @@ -243,43 +257,49 @@ module Str: 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 @@ -300,7 +320,8 @@ module Cty: (** 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 @@ -309,6 +330,7 @@ module Ctf: 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 *) @@ -329,7 +351,7 @@ module Cl: (** 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 @@ -339,15 +361,19 @@ module Cf: 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 *) diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml index 669d0144..d57dabb9 100644 --- a/parsing/ast_mapper.ml +++ b/parsing/ast_mapper.ml @@ -174,6 +174,7 @@ module CT = struct 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) @@ -186,6 +187,7 @@ module CT = struct = 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) @@ -410,6 +412,7 @@ module CE = struct 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) @@ -437,6 +440,7 @@ module CE = struct 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) diff --git a/parsing/docstrings.ml b/parsing/docstrings.ml new file mode 100644 index 00000000..389f6cf7 --- /dev/null +++ b/parsing/docstrings.ml @@ -0,0 +1,344 @@ +(***********************************************************************) +(* *) +(* 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 + + + diff --git a/parsing/docstrings.mli b/parsing/docstrings.mli new file mode 100644 index 00000000..e8737850 --- /dev/null +++ b/parsing/docstrings.mli @@ -0,0 +1,148 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/parsing/lexer.mli b/parsing/lexer.mli index 9898e971..4878a36e 100644 --- a/parsing/lexer.mli +++ b/parsing/lexer.mli @@ -49,10 +49,7 @@ by the parser, as [preprocessor lexer lexbuf] where [lexer] is the 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 : diff --git a/parsing/lexer.mll b/parsing/lexer.mll index 237b4476..ad716781 100644 --- a/parsing/lexer.mll +++ b/parsing/lexer.mll @@ -63,6 +63,7 @@ let keyword_table = "module", MODULE; "mutable", MUTABLE; "new", NEW; + "nonrec", NONREC; "object", OBJECT; "of", OF; "open", OPEN; @@ -132,6 +133,16 @@ let is_in_string = ref false 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 @@ -218,6 +229,8 @@ let update_loc lexbuf file line absolute chars = let preprocessor = ref None +let escaped_newlines = ref false + (* Warn about Latin-1 characters used in idents *) let warn_latin1 lexbuf = @@ -225,6 +238,17 @@ 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 @@ -287,19 +311,14 @@ let float_literal = 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 } | "_" @@ -386,26 +405,27 @@ rule token = parse 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; @@ -483,6 +503,8 @@ rule token = parse | '%' { PERCENT } | ['*' '/' '%'] symbolchar * { INFIXOP3(Lexing.lexeme lexbuf) } + | '#' (symbolchar | '#') + + { SHARPOP(Lexing.lexeme lexbuf) } | eof { EOF } | _ { raise (Error(Illegal_character (Lexing.lexeme_char lexbuf 0), @@ -654,24 +676,98 @@ and skip_sharp_bang = parse | 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) } diff --git a/parsing/location.ml b/parsing/location.ml index 174377ee..a4910bdc 100644 --- a/parsing/location.ml +++ b/parsing/location.ml @@ -72,6 +72,22 @@ let status = ref Terminfo.Uninitialised 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 = @@ -261,20 +277,21 @@ let print_error ppf loc = 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 (); @@ -317,7 +334,7 @@ let error_of_exn exn = 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; _} = @@ -333,10 +350,16 @@ let rec report_error ppf ({loc; msg; sub; if_highlight} as err) = 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 diff --git a/parsing/location.mli b/parsing/location.mli index 1a7feeb4..77b754f7 100644 --- a/parsing/location.mli +++ b/parsing/location.mli @@ -29,11 +29,14 @@ type t = { 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]. *) @@ -52,10 +55,17 @@ val print_loc: formatter -> t -> unit val print_error: formatter -> t -> unit val print_error_cur_file: formatter -> unit val print_warning: t -> formatter -> Warnings.t -> unit +val 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 = { @@ -115,5 +125,11 @@ val register_error_of_exn: (exn -> error option) -> unit 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. *) diff --git a/parsing/parse.ml b/parsing/parse.ml index 2f4926ff..0941bf80 100644 --- a/parsing/parse.ml +++ b/parsing/parse.ml @@ -34,9 +34,11 @@ let maybe_skip_phrase lexbuf = 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 diff --git a/parsing/parser.mly b/parsing/parser.mly index ba8e98e6..863651c7 100644 --- a/parsing/parser.mly +++ b/parsing/parser.mly @@ -18,6 +18,7 @@ open Asttypes 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 @@ -28,8 +29,10 @@ let mkmod d = Mod.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 = @@ -283,11 +286,115 @@ let wrap_exp_attrs body (ext, attrs) = 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)) %} @@ -372,6 +479,7 @@ let mkctf_attrs d attrs = %token MUTABLE %token NATIVEINT %token NEW +%token NONREC %token OBJECT %token OF %token OPEN @@ -393,6 +501,7 @@ let mkctf_attrs d attrs = %token SEMI %token SEMISEMI %token SHARP +%token SHARPOP %token SIG %token STAR %token STRING @@ -411,6 +520,7 @@ let mkctf_attrs d attrs = %token WHILE %token WITH %token COMMENT +%token DOCSTRING %token EOL @@ -470,6 +580,7 @@ The precedences must be listed from low to high. %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. */ @@ -500,38 +611,52 @@ The precedences must be listed from low to high. /* 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 } @@ -568,7 +693,7 @@ module_expr: 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 @@ -613,62 +738,50 @@ 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 @@ -678,13 +791,24 @@ module_binding_body: | 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 */ @@ -693,7 +817,7 @@ module_type: 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 @@ -717,90 +841,112 @@ 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 @@ -827,8 +973,8 @@ 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 @@ -840,7 +986,7 @@ class_simple_expr: | 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 @@ -853,8 +999,8 @@ class_simple_expr: { 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 @@ -868,23 +1014,24 @@ class_fields: /* 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 @@ -959,7 +1106,7 @@ class_signature: ; 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 @@ -969,24 +1116,25 @@ class_self_type: ; 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 @@ -1003,30 +1151,38 @@ constrain_field: 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 */ @@ -1082,8 +1238,8 @@ expr: { $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 @@ -1276,6 +1432,8 @@ simple_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 @@ -1317,32 +1475,11 @@ label_expr: 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 @@ -1357,6 +1494,18 @@ let_binding_: | 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 } @@ -1539,27 +1688,49 @@ lbl_pattern: { (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 } @@ -1576,18 +1747,16 @@ type_kind: { (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*/ { [] } @@ -1628,41 +1797,46 @@ type_parameter_list: | 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) } ; @@ -1670,50 +1844,82 @@ generalized_constructor_arguments: 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) */ @@ -1723,7 +1929,7 @@ with_constraints: | 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) @@ -1734,7 +1940,7 @@ with_constraint: ~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 @@ -1762,10 +1968,22 @@ poly_type: | 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 @@ -1789,8 +2007,6 @@ simple_core_type: { $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: @@ -1864,8 +2080,8 @@ row_field: | 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, []) } ; @@ -1874,8 +2090,8 @@ opt_ampersand: | /* 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] } @@ -1910,7 +2126,7 @@ meth_list: | DOTDOT { [], Open } ; field: - label attributes COLON poly_type { ($1, $2, $4) } + label COLON poly_type_no_attr attributes { ($1, $4, $3) } ; label: LIDENT { $1 } @@ -1961,6 +2177,7 @@ operator: | INFIXOP2 { $1 } | INFIXOP3 { $1 } | INFIXOP4 { $1 } + | SHARPOP { $1 } | BANG { "!" } | PLUS { "+" } | PLUSDOT { "+." } @@ -2050,6 +2267,10 @@ rec_flag: /* empty */ { Nonrecursive } | REC { Recursive } ; +nonrec_flag: + /* empty */ { Recursive } + | NONREC { Nonrecursive } +; direction_flag: TO { Upto } | DOWNTO { Downto } diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli index a66317f4..295e3eaa 100644 --- a/parsing/parsetree.mli +++ b/parsing/parsetree.mli @@ -36,7 +36,7 @@ and attributes = attribute list 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} *) diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml index 7dea70c5..5e9b9455 100644 --- a/parsing/pprintast.ml +++ b/parsing/pprintast.ml @@ -197,9 +197,14 @@ class printer ()= object(self:'self) | 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@ " @@ -268,12 +273,12 @@ class printer ()= object(self:'self) | 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 @@ -363,7 +368,8 @@ class printer ()= object(self:'self) | 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 @@ -397,6 +403,7 @@ class printer ()= object(self:'self) 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) = @@ -608,7 +615,7 @@ class printer ()= object(self:'self) pp f "@[assert@ %a@]" self#simple_expr e | Pexp_lazy (e) -> pp f "@[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 "@[!poly!@ %a@]" self#simple_expr e | Pexp_poly (e, Some ct) -> @@ -1222,13 +1229,24 @@ class printer ()= object(self:'self) [] -> () | 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 @@ -1236,10 +1254,10 @@ class printer ()= object(self:'self) in match l with | [] -> assert false - | [x] -> type_decl "type" f x + | [x] -> type_decl "type" rf f x | x :: xs -> pp f "@[%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 @@ -1252,25 +1270,30 @@ class printer ()= object(self:'self) | 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 = @@ -1290,7 +1313,7 @@ class printer ()= object(self:'self) let constraints f = self#list ~first:"@ " (fun f (ct1,ct2,_) -> - pp f "@[constraint@ %a@ =@ %a@]" + pp f "@[ constraint@ %a@ =@ %a@]" self#core_type ct1 self#core_type ct2) f x.ptype_cstrs in diff --git a/parsing/pprintast.mli b/parsing/pprintast.mli index 13e3d09a..45556b84 100644 --- a/parsing/pprintast.mli +++ b/parsing/pprintast.mli @@ -80,6 +80,7 @@ class printer : 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 diff --git a/parsing/printast.ml b/parsing/printast.ml index f0472bcd..cb94856a 100644 --- a/parsing/printast.ml +++ b/parsing/printast.ml @@ -640,7 +640,7 @@ and signature_item i ppf x = | 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 -> @@ -875,7 +875,7 @@ and directive_argument i ppf x = 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); ;; diff --git a/stdlib/.depend b/stdlib/.depend index 96f95082..11f21a8f 100644 --- a/stdlib/.depend +++ b/stdlib/.depend @@ -1,12 +1,12 @@ 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 @@ -22,8 +22,8 @@ int32.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 @@ -43,32 +43,32 @@ stack.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 \ @@ -111,10 +111,10 @@ lazy.cmo : obj.cmi camlinternalLazy.cmi lazy.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 @@ -157,18 +157,18 @@ sort.cmo : array.cmi sort.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 @@ -177,24 +177,24 @@ arg.cmo : sys.cmi string.cmi printf.cmi list.cmi buffer.cmi array.cmi \ arg.cmi arg.p.cmx : sys.p.cmx string.p.cmx printf.p.cmx list.p.cmx buffer.p.cmx array.p.cmx \ arg.cmi -array.cmo : array.cmi -array.p.cmx : array.cmi arrayLabels.cmo : array.cmi arrayLabels.cmi arrayLabels.p.cmx : array.p.cmx arrayLabels.cmi +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 \ @@ -237,10 +237,10 @@ lazy.cmo : obj.cmi camlinternalLazy.cmi lazy.cmi lazy.p.cmx : obj.p.cmx camlinternalLazy.p.cmx lazy.cmi lexing.cmo : sys.cmi string.cmi 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 @@ -283,18 +283,18 @@ sort.cmo : array.cmi sort.cmi sort.p.cmx : array.p.cmx sort.cmi stack.cmo : list.cmi stack.cmi stack.p.cmx : list.p.cmx stack.cmi +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 diff --git a/stdlib/.ignore b/stdlib/.ignore index ad1b04e1..20d8653f 100644 --- a/stdlib/.ignore +++ b/stdlib/.ignore @@ -1,5 +1,7 @@ camlheader +target_camlheader camlheaderd +target_camlheaderd camlheader_ur labelled-* caml diff --git a/stdlib/Makefile b/stdlib/Makefile index 37f9a5f0..92fa3740 100644 --- a/stdlib/Makefile +++ b/stdlib/Makefile @@ -45,23 +45,28 @@ installopt-prof: 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 diff --git a/stdlib/Makefile.nt b/stdlib/Makefile.nt index 590701bf..5bc2e0ed 100644 --- a/stdlib/Makefile.nt +++ b/stdlib/Makefile.nt @@ -18,19 +18,21 @@ allopt: stdlib.cmxa std_exit.cmx 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) diff --git a/stdlib/Makefile.shared b/stdlib/Makefile.shared index 54de337c..8bc6e1bc 100755 --- a/stdlib/Makefile.shared +++ b/stdlib/Makefile.shared @@ -12,14 +12,17 @@ ######################################################################### 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 \ @@ -37,19 +40,20 @@ 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) @@ -65,7 +69,7 @@ clean:: 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 diff --git a/stdlib/array.ml b/stdlib/array.ml index 1990a78b..243eeade 100644 --- a/stdlib/array.ml +++ b/stdlib/array.ml @@ -29,6 +29,10 @@ external make_float: int -> float array = "caml_make_float_vect" 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) diff --git a/stdlib/array.mli b/stdlib/array.mli index 99de0c80..7580f7e7 100644 --- a/stdlib/array.mli +++ b/stdlib/array.mli @@ -154,7 +154,8 @@ val fold_right : ('b -> 'a -> 'a) -> 'b array -> 'a -> 'a 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} *) diff --git a/stdlib/arrayLabels.mli b/stdlib/arrayLabels.mli index 0d046378..f42853c8 100644 --- a/stdlib/arrayLabels.mli +++ b/stdlib/arrayLabels.mli @@ -17,24 +17,24 @@ external length : 'a array -> int = "%array_length" (** 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). @@ -51,9 +51,9 @@ external create : int -> 'a -> 'a array = "caml_make_vect" (** @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]. @@ -61,7 +61,7 @@ val init : int -> f:(int -> 'a) -> 'a array 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]. @@ -79,27 +79,27 @@ val create_matrix : dimx:int -> dimy:int -> 'a -> 'a array array {!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 @@ -108,7 +108,7 @@ val fill : 'a array -> pos:int -> len:int -> 'a -> unit 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 @@ -119,21 +119,21 @@ val blit : 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 @@ -146,12 +146,12 @@ val mapi : f:(int -> 'a -> 'b) -> 'a array -> 'b array 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]. *) @@ -166,9 +166,9 @@ val sort : cmp:('a -> 'a -> int) -> 'a array -> unit 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 @@ -180,7 +180,7 @@ val sort : cmp:('a -> 'a -> int) -> 'a array -> unit - [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 *) @@ -196,8 +196,8 @@ val stable_sort : cmp:('a -> 'a -> int) -> 'a array -> unit *) 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. *) diff --git a/stdlib/buffer.mli b/stdlib/buffer.mli index e7ce8b99..962f6bc7 100644 --- a/stdlib/buffer.mli +++ b/stdlib/buffer.mli @@ -38,11 +38,12 @@ val create : int -> t 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 @@ -85,7 +86,8 @@ val add_string : t -> string -> unit (** [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 @@ -93,7 +95,8 @@ val add_substring : t -> string -> int -> int -> unit 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 diff --git a/stdlib/bytesLabels.mli b/stdlib/bytesLabels.mli index d48d95f5..04043182 100644 --- a/stdlib/bytesLabels.mli +++ b/stdlib/bytesLabels.mli @@ -11,7 +11,9 @@ (* *) (***********************************************************************) -(** 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. *) diff --git a/stdlib/camlinternalFormat.ml b/stdlib/camlinternalFormat.ml index 40d76678..569f4ca3 100644 --- a/stdlib/camlinternalFormat.ml +++ b/stdlib/camlinternalFormat.ml @@ -475,6 +475,7 @@ fun buf fmtty -> match fmtty with | 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 -> @@ -492,6 +493,12 @@ fun buf fmtty -> match fmtty with (***) +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 . @@ -537,6 +544,12 @@ let bprint_fmt buf fmt = | 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; @@ -623,6 +636,7 @@ let rec symm : type a1 b1 c1 d1 e1 f1 a2 b2 c2 d2 e2 f2 . | 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) -> @@ -695,6 +709,11 @@ let rec fmtty_rel_det : type a1 b c d1 e1 f1 a2 d2 e2 f2 . (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), @@ -765,6 +784,10 @@ and trans : type | 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 @@ -835,6 +858,7 @@ fun fmtty -> match fmtty with | 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) -> @@ -856,6 +880,13 @@ fun fmtty -> match fmtty with | 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 . @@ -1315,15 +1346,16 @@ let format_of_aconv iconv c = (* 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 @@ -1403,6 +1435,8 @@ fun k o acc fmt -> match fmt with 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 @@ -1502,6 +1536,7 @@ fun k o acc fmtty fmt -> match fmtty with | 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 @@ -1628,6 +1663,16 @@ and make_float_padding_precision : type x y a b c d e f . 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 *) @@ -1806,7 +1851,7 @@ let fmt_ebb_of_string ?legacy_behavior str = 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. diff --git a/stdlib/camlinternalFormatBasics.ml b/stdlib/camlinternalFormatBasics.ml index f45f434c..4e5db73d 100644 --- a/stdlib/camlinternalFormatBasics.ml +++ b/stdlib/camlinternalFormatBasics.ml @@ -65,6 +65,12 @@ type ('a, 'b) precision = 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 @@ -306,6 +312,11 @@ and ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, '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 *) @@ -417,6 +428,32 @@ and ('a, 'b, 'c, 'd, 'e, 'f) fmt = ('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 @@ -490,6 +527,8 @@ let rec erase_rel : type a b c d e f g h i j k l . 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 -> @@ -543,6 +582,8 @@ fun fmtty1 fmtty2 -> match fmtty1 with 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 -> @@ -588,6 +629,8 @@ fun fmt1 fmt2 -> match fmt1 with 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 -> diff --git a/stdlib/camlinternalFormatBasics.mli b/stdlib/camlinternalFormatBasics.mli index 4e579f3a..80866e83 100644 --- a/stdlib/camlinternalFormatBasics.mli +++ b/stdlib/camlinternalFormatBasics.mli @@ -29,6 +29,11 @@ type ('a, 'b) precision = 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 = @@ -121,6 +126,11 @@ and ('a1, 'b1, 'c1, 'd1, 'e1, 'f1, '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 *) @@ -234,6 +244,11 @@ and ('a, 'b, 'c, 'd, 'e, 'f) fmt = ('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 diff --git a/stdlib/digest.ml b/stdlib/digest.ml index 14cb4ebd..695a01dc 100644 --- a/stdlib/digest.ml +++ b/stdlib/digest.ml @@ -34,9 +34,9 @@ let subbytes b ofs len = substring (Bytes.unsafe_to_string b) ofs len 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 diff --git a/stdlib/digest.mli b/stdlib/digest.mli index 583d2a46..9227cd7d 100644 --- a/stdlib/digest.mli +++ b/stdlib/digest.mli @@ -37,7 +37,8 @@ val string : string -> t (** 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 @@ -45,7 +46,8 @@ val substring : string -> int -> int -> t 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] diff --git a/stdlib/format.ml b/stdlib/format.ml index 5e206e11..1d196a51 100644 --- a/stdlib/format.ml +++ b/stdlib/format.ml @@ -976,6 +976,12 @@ let flush_str_formatter () = 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 @@ -1176,12 +1182,11 @@ let printf fmt = fprintf std_formatter fmt 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 = @@ -1194,7 +1199,7 @@ let asprintf (Format (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 (************************************************************** diff --git a/stdlib/format.mli b/stdlib/format.mli index 541ffbe3..05e153b2 100644 --- a/stdlib/format.mli +++ b/stdlib/format.mli @@ -74,7 +74,7 @@ (** {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. @@ -86,41 +86,41 @@ val open_box : int -> unit;; 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. @@ -128,7 +128,7 @@ val print_cut : unit -> unit;; 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, @@ -138,25 +138,25 @@ val print_break : int -> int -> unit;; 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. @@ -164,12 +164,12 @@ val set_margin : int -> unit;; 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, @@ -178,32 +178,32 @@ val set_max_indent : int -> unit;; 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 @@ -211,7 +211,7 @@ val open_vbox : int -> unit;; 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 @@ -220,7 +220,7 @@ val open_hvbox : int -> unit;; 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 @@ -231,13 +231,13 @@ val open_hovbox : int -> unit;; (** {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). @@ -249,24 +249,24 @@ val print_tbreak : int -> int -> unit;; 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 @@ -315,38 +315,42 @@ type tag = string;; 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]. @@ -362,7 +366,6 @@ val set_formatter_output_functions : 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} *) @@ -378,9 +381,9 @@ type formatter_out_functions = { 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 @@ -397,7 +400,7 @@ val set_formatter_out_functions : formatter_out_functions -> unit;; 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. *) @@ -410,7 +413,6 @@ type formatter_tag_functions = { 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 @@ -418,7 +420,7 @@ type formatter_tag_functions = { [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]. @@ -434,12 +436,12 @@ val set_formatter_tag_functions : formatter_tag_functions -> unit;; 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. @@ -457,40 +459,39 @@ type formatter;; (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 @@ -498,67 +499,66 @@ val make_formatter : (** {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, @@ -587,7 +587,7 @@ val pp_print_text : formatter -> string -> unit (** {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 @@ -656,13 +656,13 @@ val fprintf : formatter -> ('a, formatter, unit) format -> 'a;; *) -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 @@ -678,7 +678,7 @@ val sprintf : ('a, unit, string) format -> 'a;; 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] @@ -686,7 +686,7 @@ val asprintf : ('a, formatter, unit, string) format4 -> '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 @@ -696,19 +696,17 @@ val ifprintf : formatter -> ('a, formatter, unit) format -> 'a;; 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. *) @@ -716,7 +714,6 @@ val ksprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b;; 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 @@ -725,7 +722,6 @@ val bprintf : Buffer.t -> ('a, formatter, unit) format -> '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 : @@ -735,9 +731,7 @@ 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 -> @@ -746,22 +740,17 @@ val get_all_formatter_output_functions : (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]. *) diff --git a/stdlib/gc.mli b/stdlib/gc.mli index f86a1e68..a37edc67 100644 --- a/stdlib/gc.mli +++ b/stdlib/gc.mli @@ -113,8 +113,8 @@ type control = - [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; @@ -221,9 +221,10 @@ val finalise : ('a -> unit) -> 'a -> unit 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 ] diff --git a/stdlib/hashtbl.mli b/stdlib/hashtbl.mli index 0c3e4999..386f5a6c 100644 --- a/stdlib/hashtbl.mli +++ b/stdlib/hashtbl.mli @@ -345,7 +345,9 @@ val hash_param : int -> int -> 'a -> int 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, diff --git a/stdlib/header.c b/stdlib/header.c index cb3d9953..b8d02ea1 100644 --- a/stdlib/header.c +++ b/stdlib/header.c @@ -23,8 +23,8 @@ #include #include #include -#include "../byterun/mlvalues.h" -#include "../byterun/exec.h" +#include "../byterun/caml/mlvalues.h" +#include "../byterun/caml/exec.h" char * default_runtime_path = RUNTIME_NAME; @@ -40,7 +40,7 @@ char * default_runtime_path = RUNTIME_NAME; #define SEEK_END 2 #endif -#ifndef __CYGWIN32__ +#ifndef __CYGWIN__ /* Normal Unix search path function */ diff --git a/stdlib/headernt.c b/stdlib/headernt.c index aa113ac9..e95223db 100644 --- a/stdlib/headernt.c +++ b/stdlib/headernt.c @@ -15,8 +15,8 @@ #define WIN32_LEAN_AND_MEAN #include -#include "mlvalues.h" -#include "exec.h" +#include "caml/mlvalues.h" +#include "caml/exec.h" #ifndef __MINGW32__ #pragma comment(linker , "/entry:headerentry") diff --git a/stdlib/list.mli b/stdlib/list.mli index 5b88f229..93219597 100644 --- a/stdlib/list.mli +++ b/stdlib/list.mli @@ -279,7 +279,8 @@ val fast_sort : ('a -> 'a -> int) -> 'a list -> 'a list 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: diff --git a/stdlib/listLabels.mli b/stdlib/listLabels.mli index 8cf65147..7404fd00 100644 --- a/stdlib/listLabels.mli +++ b/stdlib/listLabels.mli @@ -50,7 +50,7 @@ val append : 'a list -> 'a list -> 'a list 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. *) @@ -69,40 +69,40 @@ val flatten : 'a list list -> 'a list 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. *) @@ -110,32 +110,32 @@ val fold_right : f:('a -> 'b -> 'b) -> 'a list -> init:'b -> 'b 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. *) @@ -259,7 +259,7 @@ val sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list 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. @@ -277,8 +277,8 @@ val stable_sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list *) 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: diff --git a/stdlib/marshal.mli b/stdlib/marshal.mli index 9dfdd162..4f0ed49b 100644 --- a/stdlib/marshal.mli +++ b/stdlib/marshal.mli @@ -114,7 +114,8 @@ external to_bytes : (** [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" @@ -141,7 +142,8 @@ val from_bytes : bytes -> int -> 'a 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 diff --git a/stdlib/obj.ml b/stdlib/obj.ml index ac9695cd..5cb970b8 100644 --- a/stdlib/obj.ml +++ b/stdlib/obj.ml @@ -37,6 +37,9 @@ let marshal (obj : t) = 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 diff --git a/stdlib/obj.mli b/stdlib/obj.mli index 3395fa86..6d06312b 100644 --- a/stdlib/obj.mli +++ b/stdlib/obj.mli @@ -36,6 +36,9 @@ external truncate : t -> int -> unit = "caml_obj_truncate" 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 diff --git a/stdlib/pervasives.mli b/stdlib/pervasives.mli index 64138291..f2b684ff 100644 --- a/stdlib/pervasives.mli +++ b/stdlib/pervasives.mli @@ -147,39 +147,55 @@ external ( or ) : bool -> bool -> bool = "%sequor" 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} *) @@ -594,7 +610,8 @@ val print_string : string -> unit (** 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. *) @@ -621,7 +638,8 @@ val prerr_string : string -> unit (** 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. *) @@ -708,7 +726,8 @@ val output_string : out_channel -> string -> unit (** 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], @@ -718,7 +737,8 @@ val output : out_channel -> bytes -> int -> int -> unit 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) @@ -838,7 +858,8 @@ val really_input_string : in_channel -> int -> string (** [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 diff --git a/stdlib/printexc.mli b/stdlib/printexc.mli index 6bffe174..c347b991 100644 --- a/stdlib/printexc.mli +++ b/stdlib/printexc.mli @@ -145,7 +145,11 @@ val set_uncaught_exception_handler: (exn -> raw_backtrace -> unit) -> unit {!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 *) @@ -177,6 +181,8 @@ val backtrace_slots : raw_backtrace -> backtrace_slot array option 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 = { @@ -243,6 +249,8 @@ type raw_backtrace_slot 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 diff --git a/stdlib/printf.mli b/stdlib/printf.mli index 4a725665..573414ec 100644 --- a/stdlib/printf.mli +++ b/stdlib/printf.mli @@ -136,7 +136,7 @@ val ifprintf : 'a -> ('b, 'a, unit) format -> 'b (** 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 @@ -144,20 +144,19 @@ val kfprintf : (out_channel -> 'a) -> out_channel -> 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 diff --git a/stdlib/scanf.ml b/stdlib/scanf.ml index 1372c41a..08fc9aba 100644 --- a/stdlib/scanf.ml +++ b/stdlib/scanf.ml @@ -1029,6 +1029,7 @@ fun k fmt -> match fmt with | 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 @@ -1068,6 +1069,7 @@ fun k fmtty fmt -> match fmtty with | 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) -> @@ -1125,6 +1127,12 @@ fun ib fmt readers -> match fmt with 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 @@ -1163,6 +1171,8 @@ fun ib fmt readers -> match fmt with 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 diff --git a/stdlib/scanf.mli b/stdlib/scanf.mli index 297d6f2d..f065c461 100644 --- a/stdlib/scanf.mli +++ b/stdlib/scanf.mli @@ -83,7 +83,7 @@ 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. @@ -93,7 +93,7 @@ type in_channel;; @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 @@ -105,7 +105,7 @@ type scanbuf = in_channel;; 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]. @@ -118,12 +118,12 @@ val stdin : in_channel;; @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]. @@ -135,31 +135,32 @@ val open_in : file_name -> in_channel;; @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. @@ -169,39 +170,39 @@ val from_function : (unit -> char) -> in_channel;; 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 @@ -223,14 +224,14 @@ type ('a, 'b, 'c, 'd) scanner = @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. @@ -453,7 +454,7 @@ val bscanf : Scanning.in_channel -> ('a, 'b, 'c, 'd) scanner;; (** {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 @@ -467,17 +468,17 @@ val fscanf : Pervasives.in_channel -> ('a, 'b, 'c, 'd) scanner;; 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 @@ -488,18 +489,20 @@ val kscanf : 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. @@ -510,14 +513,14 @@ val bscanf_format : 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 @@ -525,7 +528,7 @@ val format_from_string : @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 diff --git a/stdlib/stream.mli b/stdlib/stream.mli index 85a84610..1957cf60 100644 --- a/stdlib/stream.mli +++ b/stdlib/stream.mli @@ -47,7 +47,8 @@ val of_string : string -> char t (** 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. *) diff --git a/testsuite/makefiles/Makefile.one b/testsuite/makefiles/Makefile.one index 9f95b365..11c227ee 100644 --- a/testsuite/makefiles/Makefile.one +++ b/testsuite/makefiles/Makefile.one @@ -48,7 +48,8 @@ compile: $(ML_FILES) $(CMO_FILES) $(MAIN_MODULE).cmo @if $(BYTECODE_ONLY); then : ; else \ rm -f program.native program.native.exe; \ $(MAKE) $(CMX_FILES) $(MAIN_MODULE).cmx; \ - $(OCAMLOPT) $(ADD_COMPFLAGS) -o program.native$(EXE) $(O_FILES) \ + $(OCAMLOPT) $(ADD_COMPFLAGS) $(ADD_OPTCOMPFLAGS) \ + -o program.native$(EXE) $(O_FILES) \ $(CMXA_FILES) $(CMX_FILES) $(ADD_CMX_FILES) \ $(MAIN_MODULE).cmx; \ fi diff --git a/testsuite/makefiles/Makefile.toplevel b/testsuite/makefiles/Makefile.toplevel index 46acb3d7..284465fe 100644 --- a/testsuite/makefiles/Makefile.toplevel +++ b/testsuite/makefiles/Makefile.toplevel @@ -12,10 +12,10 @@ 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 diff --git a/testsuite/tests/asmcomp/mainarith.c b/testsuite/tests/asmcomp/mainarith.c index d102c16d..94ff371e 100644 --- a/testsuite/tests/asmcomp/mainarith.c +++ b/testsuite/tests/asmcomp/mainarith.c @@ -16,7 +16,7 @@ #include #include -#include "../../../byterun/config.h" +#include "../../../byterun/caml/config.h" #define FMT ARCH_INTNAT_PRINTF_FORMAT void caml_ml_array_bound_error(void) diff --git a/testsuite/tests/asmcomp/sparc.S b/testsuite/tests/asmcomp/sparc.S index ea029573..f2b9ce20 100644 --- a/testsuite/tests/asmcomp/sparc.S +++ b/testsuite/tests/asmcomp/sparc.S @@ -10,7 +10,7 @@ /* */ /***********************************************************************/ -#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 diff --git a/testsuite/tests/basic-manyargs/manyargsprim.c b/testsuite/tests/basic-manyargs/manyargsprim.c index 65e9cf5e..55fbc2e0 100644 --- a/testsuite/tests/basic-manyargs/manyargsprim.c +++ b/testsuite/tests/basic-manyargs/manyargsprim.c @@ -10,7 +10,7 @@ /* */ /***********************************************************************/ -#include "mlvalues.h" +#include "caml/mlvalues.h" #include "stdio.h" value manyargs(value a, value b, value c, value d, value e, value f, diff --git a/testsuite/tests/basic/divint.ml b/testsuite/tests/basic/divint.ml index 52d14b9c..60f09962 100644 --- a/testsuite/tests/basic/divint.ml +++ b/testsuite/tests/basic/divint.ml @@ -74,6 +74,7 @@ let do_test divisor (df: nativeint -> nativeint) (mf: nativeint -> nativeint) = 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); @@ -88,9 +89,11 @@ let _ = 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); @@ -105,8 +108,12 @@ let _ = 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 diff --git a/testsuite/tests/basic/divint.reference b/testsuite/tests/basic/divint.reference index 4aa1e211..e9a6387f 100644 --- a/testsuite/tests/basic/divint.reference +++ b/testsuite/tests/basic/divint.reference @@ -1,3 +1,4 @@ +1 int 2 int 3 int 4 int @@ -12,8 +13,10 @@ 55 int 125 int 625 int +-1 int -2 int -3 int +1 nat 2 nat 3 nat 4 nat @@ -28,6 +31,7 @@ 55 nat 125 nat 625 nat +-1 nat -2 nat -3 nat Test passed. diff --git a/testsuite/tests/callback/Makefile b/testsuite/tests/callback/Makefile index 58b5ed8a..d89c5326 100644 --- a/testsuite/tests/callback/Makefile +++ b/testsuite/tests/callback/Makefile @@ -31,9 +31,9 @@ common: 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" @@ -42,9 +42,9 @@ run-opt: common @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 @@ -54,6 +54,6 @@ promote: defaultpromote .PHONY: clean clean: defaultclean - @rm -f *.result ./program + @rm -f *.result ./program$(EXE) include $(BASEDIR)/makefiles/Makefile.common diff --git a/testsuite/tests/callback/callbackprim.c b/testsuite/tests/callback/callbackprim.c index f3c59811..71a123d1 100644 --- a/testsuite/tests/callback/callbackprim.c +++ b/testsuite/tests/callback/callbackprim.c @@ -10,9 +10,9 @@ /* */ /***********************************************************************/ -#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) { diff --git a/testsuite/tests/embedded/Makefile b/testsuite/tests/embedded/Makefile index a8de4dc0..088b0216 100644 --- a/testsuite/tests/embedded/Makefile +++ b/testsuite/tests/embedded/Makefile @@ -18,16 +18,12 @@ default: $(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':" @@ -41,6 +37,5 @@ promote: defaultpromote .PHONY: clean clean: defaultclean @rm -f *.result program - @rm -rf caml include $(BASEDIR)/makefiles/Makefile.common diff --git a/testsuite/tests/float-unboxing/Makefile b/testsuite/tests/float-unboxing/Makefile new file mode 100644 index 00000000..68524118 --- /dev/null +++ b/testsuite/tests/float-unboxing/Makefile @@ -0,0 +1,7 @@ +BASEDIR=../.. +MODULES= +MAIN_MODULE=float_subst_boxed_number +ADD_OPTCOMPFLAGS=-inline 20 + +include $(BASEDIR)/makefiles/Makefile.one +include $(BASEDIR)/makefiles/Makefile.common diff --git a/testsuite/tests/float-unboxing/float_subst_boxed_number.ml b/testsuite/tests/float-unboxing/float_subst_boxed_number.ml new file mode 100644 index 00000000..f77620ec --- /dev/null +++ b/testsuite/tests/float-unboxing/float_subst_boxed_number.ml @@ -0,0 +1,26 @@ +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 diff --git a/testsuite/tests/float-unboxing/float_subst_boxed_number.reference b/testsuite/tests/float-unboxing/float_subst_boxed_number.reference new file mode 100644 index 00000000..e69de29b diff --git a/testsuite/tests/gc-roots/globrootsprim.c b/testsuite/tests/gc-roots/globrootsprim.c index f7bb32ce..5c540acf 100644 --- a/testsuite/tests/gc-roots/globrootsprim.c +++ b/testsuite/tests/gc-roots/globrootsprim.c @@ -13,10 +13,10 @@ /* 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; }; diff --git a/testsuite/tests/lib-bigarray-2/bigarrfstub.c b/testsuite/tests/lib-bigarray-2/bigarrfstub.c index 35408284..72872987 100644 --- a/testsuite/tests/lib-bigarray-2/bigarrfstub.c +++ b/testsuite/tests/lib-bigarray-2/bigarrfstub.c @@ -11,7 +11,7 @@ /***********************************************************************/ #include -#include +#include #include extern void filltab_(void); diff --git a/testsuite/tests/lib-dynlink-bytecode/Makefile b/testsuite/tests/lib-dynlink-bytecode/Makefile index 832e367e..f9b1c6f9 100644 --- a/testsuite/tests/lib-dynlink-bytecode/Makefile +++ b/testsuite/tests/lib-dynlink-bytecode/Makefile @@ -24,10 +24,10 @@ default: 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 @@ -43,10 +43,6 @@ compile: caml @$(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'" @@ -70,6 +66,5 @@ promote: defaultpromote .PHONY: clean clean: defaultclean @rm -f main static custom custom.exe *.result marshal.data - @rm -rf caml include $(BASEDIR)/makefiles/Makefile.common diff --git a/testsuite/tests/lib-dynlink-native/Makefile b/testsuite/tests/lib-dynlink-native/Makefile index f4f9d099..f27438c2 100644 --- a/testsuite/tests/lib-dynlink-native/Makefile +++ b/testsuite/tests/lib-dynlink-native/Makefile @@ -102,14 +102,11 @@ mypack.cmx: packed1.cmx 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 @@ -120,6 +117,5 @@ clean: defaultclean @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 diff --git a/testsuite/tests/lib-format/pr6824.ml b/testsuite/tests/lib-format/pr6824.ml new file mode 100644 index 00000000..aa5e7eed --- /dev/null +++ b/testsuite/tests/lib-format/pr6824.ml @@ -0,0 +1,7 @@ +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);; diff --git a/testsuite/tests/lib-format/pr6824.reference b/testsuite/tests/lib-format/pr6824.reference new file mode 100644 index 00000000..69035c76 --- /dev/null +++ b/testsuite/tests/lib-format/pr6824.reference @@ -0,0 +1,6 @@ +[1] +[2] +[1] +[2] + +All tests succeeded. diff --git a/testsuite/tests/lib-hashtbl/htbl.ml b/testsuite/tests/lib-hashtbl/htbl.ml index 655191a8..bd5f33a6 100644 --- a/testsuite/tests/lib-hashtbl/htbl.ml +++ b/testsuite/tests/lib-hashtbl/htbl.ml @@ -193,7 +193,7 @@ let _ = 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%!"; diff --git a/testsuite/tests/lib-marshal/intextaux.c b/testsuite/tests/lib-marshal/intextaux.c index 924b896e..03688462 100644 --- a/testsuite/tests/lib-marshal/intextaux.c +++ b/testsuite/tests/lib-marshal/intextaux.c @@ -10,8 +10,8 @@ /* */ /***********************************************************************/ -#include -#include +#include +#include value marshal_to_block(value vbuf, value vlen, value v, value vflags) { diff --git a/testsuite/tests/lib-scanf/tscanf.ml b/testsuite/tests/lib-scanf/tscanf.ml index 33054b66..056bd5c7 100644 --- a/testsuite/tests/lib-scanf/tscanf.ml +++ b/testsuite/tests/lib-scanf/tscanf.ml @@ -1268,7 +1268,12 @@ sscanf "Hello \n" "%s%s%_1[ ]\n" (fun s1 s2 -> 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 ()) diff --git a/testsuite/tests/misc/weaklifetime.ml b/testsuite/tests/misc/weaklifetime.ml new file mode 100644 index 00000000..d6b23f3d --- /dev/null +++ b/testsuite/tests/misc/weaklifetime.ml @@ -0,0 +1,74 @@ +(*************************************************************************) +(* *) +(* 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 diff --git a/testsuite/tests/misc/weaklifetime.reference b/testsuite/tests/misc/weaklifetime.reference new file mode 100644 index 00000000..e69de29b diff --git a/testsuite/tests/prim-bigstring/bigstring_access.ml b/testsuite/tests/prim-bigstring/bigstring_access.ml index 8fad87b1..512181f0 100644 --- a/testsuite/tests/prim-bigstring/bigstring_access.ml +++ b/testsuite/tests/prim-bigstring/bigstring_access.ml @@ -63,40 +63,57 @@ let () = 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)) diff --git a/testsuite/tests/prim-bigstring/string_access.ml b/testsuite/tests/prim-bigstring/string_access.ml index 3afcc6c5..48964c0b 100644 --- a/testsuite/tests/prim-bigstring/string_access.ml +++ b/testsuite/tests/prim-bigstring/string_access.ml @@ -50,40 +50,57 @@ let () = 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)) diff --git a/testsuite/tests/typing-extensions/open_types.ml.reference b/testsuite/tests/typing-extensions/open_types.ml.reference index 841a94ba..e639c9df 100644 --- a/testsuite/tests/typing-extensions/open_types.ml.reference +++ b/testsuite/tests/typing-extensions/open_types.ml.reference @@ -13,21 +13,21 @@ 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. @@ -77,7 +77,7 @@ Error: Signature mismatch: 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 diff --git a/testsuite/tests/typing-gadts/pr5985.ml.reference b/testsuite/tests/typing-gadts/pr5985.ml.reference index af6154dd..4c29f6da 100644 --- a/testsuite/tests/typing-gadts/pr5985.ml.reference +++ b/testsuite/tests/typing-gadts/pr5985.ml.reference @@ -1,43 +1,43 @@ -# 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 = # 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: @@ -50,17 +50,17 @@ Error: Unbound module type S ^ 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. @@ -68,9 +68,9 @@ Error: In this definition, a type variable has a variance that # 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. @@ -81,9 +81,9 @@ Error: In this definition, a type variable has a variance that 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. # diff --git a/testsuite/tests/typing-gadts/pr6690.ml b/testsuite/tests/typing-gadts/pr6690.ml new file mode 100644 index 00000000..46ece4b2 --- /dev/null +++ b/testsuite/tests/typing-gadts/pr6690.ml @@ -0,0 +1,28 @@ +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 +;; diff --git a/testsuite/tests/typing-gadts/pr6690.ml.principal.reference b/testsuite/tests/typing-gadts/pr6690.ml.principal.reference new file mode 100644 index 00000000..2ff16245 --- /dev/null +++ b/testsuite/tests/typing-gadts/pr6690.ml.principal.reference @@ -0,0 +1,23 @@ + +# 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 = +# diff --git a/testsuite/tests/typing-gadts/pr6690.ml.reference b/testsuite/tests/typing-gadts/pr6690.ml.reference new file mode 100644 index 00000000..086f3237 --- /dev/null +++ b/testsuite/tests/typing-gadts/pr6690.ml.reference @@ -0,0 +1,27 @@ + +# 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 = +# diff --git a/testsuite/tests/typing-gadts/pr6817.ml b/testsuite/tests/typing-gadts/pr6817.ml new file mode 100644 index 00000000..73c1f635 --- /dev/null +++ b/testsuite/tests/typing-gadts/pr6817.ml @@ -0,0 +1,24 @@ +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 +;; diff --git a/testsuite/tests/typing-gadts/pr6817.ml.reference b/testsuite/tests/typing-gadts/pr6817.ml.reference new file mode 100644 index 00000000..ec47bcc9 --- /dev/null +++ b/testsuite/tests/typing-gadts/pr6817.ml.reference @@ -0,0 +1,9 @@ + +# 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 = +# diff --git a/testsuite/tests/typing-gadts/test.ml b/testsuite/tests/typing-gadts/test.ml index 2f0bb919..f4f23e0e 100644 --- a/testsuite/tests/typing-gadts/test.ml +++ b/testsuite/tests/typing-gadts/test.ml @@ -91,6 +91,12 @@ module Exhaustive = 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 @@ -157,6 +163,13 @@ module Normal_constrs = struct 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 ;; diff --git a/testsuite/tests/typing-gadts/test.ml.principal.reference b/testsuite/tests/typing-gadts/test.ml.principal.reference index fd9fb350..cba7f347 100644 --- a/testsuite/tests/typing-gadts/test.ml.principal.reference +++ b/testsuite/tests/typing-gadts/test.ml.principal.reference @@ -47,6 +47,24 @@ module Nonexhaustive : 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 ^ @@ -75,6 +93,11 @@ Error: This expression has type bool but an expression was expected of type s ^ 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 = # val test : 'a t -> 'a = diff --git a/testsuite/tests/typing-gadts/test.ml.reference b/testsuite/tests/typing-gadts/test.ml.reference index a5faa02c..a3ea98d1 100644 --- a/testsuite/tests/typing-gadts/test.ml.reference +++ b/testsuite/tests/typing-gadts/test.ml.reference @@ -47,6 +47,24 @@ module Nonexhaustive : 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 ^ @@ -76,6 +94,11 @@ Error: This pattern matches values of type int t ^ 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 = # val test : 'a t -> 'a = diff --git a/testsuite/tests/typing-gadts/yallop_bugs.ml.principal.reference b/testsuite/tests/typing-gadts/yallop_bugs.ml.principal.reference index ddae4d24..b9f0cac9 100644 --- a/testsuite/tests/typing-gadts/yallop_bugs.ml.principal.reference +++ b/testsuite/tests/typing-gadts/yallop_bugs.ml.principal.reference @@ -3,9 +3,9 @@ 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: diff --git a/testsuite/tests/typing-gadts/yallop_bugs.ml.reference b/testsuite/tests/typing-gadts/yallop_bugs.ml.reference index ddae4d24..b9f0cac9 100644 --- a/testsuite/tests/typing-gadts/yallop_bugs.ml.reference +++ b/testsuite/tests/typing-gadts/yallop_bugs.ml.reference @@ -3,9 +3,9 @@ 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: diff --git a/testsuite/tests/typing-misc/constraints.ml.reference b/testsuite/tests/typing-misc/constraints.ml.reference index 83a3dc1f..41a324c6 100644 --- a/testsuite/tests/typing-misc/constraints.ml.reference +++ b/testsuite/tests/typing-misc/constraints.ml.reference @@ -7,16 +7,16 @@ Error: Constraints are not satisfied in this type. [ `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: @@ -26,9 +26,9 @@ Error: This alias is bound to type 'a t = 'a but is used as an instance of type 'a The type variable 'a occurs inside 'a # val f : 'a t -> 'a -> bool = -# 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 # diff --git a/testsuite/tests/typing-misc/polyvars.ml b/testsuite/tests/typing-misc/polyvars.ml index 00dacf75..de8cb221 100644 --- a/testsuite/tests/typing-misc/polyvars.ml +++ b/testsuite/tests/typing-misc/polyvars.ml @@ -5,3 +5,11 @@ let f x = ignore (match x with `A|`B -> 1); ignore (x : [`A]);; let f (x : [< `A | `B]) = match x with `A | `B | `C -> 0;; (* warn *) let f (x : [`A | `B]) = match x with `A | `B | `C -> 0;; (* fail *) + +(* 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 *) diff --git a/testsuite/tests/typing-misc/polyvars.ml.principal.reference b/testsuite/tests/typing-misc/polyvars.ml.principal.reference index bc0741ab..6732640e 100644 --- a/testsuite/tests/typing-misc/polyvars.ml.principal.reference +++ b/testsuite/tests/typing-misc/polyvars.ml.principal.reference @@ -29,4 +29,6 @@ val f : [< `A | `B ] -> int = 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 = +# val f : 'a -> [< `Foo ] -> 'a = +# diff --git a/testsuite/tests/typing-misc/polyvars.ml.reference b/testsuite/tests/typing-misc/polyvars.ml.reference index 27c4cd43..751b02fc 100644 --- a/testsuite/tests/typing-misc/polyvars.ml.reference +++ b/testsuite/tests/typing-misc/polyvars.ml.reference @@ -29,4 +29,6 @@ val f : [< `A | `B ] -> int = 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 = +# val f : 'a -> [< `Foo ] -> 'a = +# diff --git a/testsuite/tests/typing-misc/wellfounded.ml b/testsuite/tests/typing-misc/wellfounded.ml new file mode 100644 index 00000000..b33adc5e --- /dev/null +++ b/testsuite/tests/typing-misc/wellfounded.ml @@ -0,0 +1,11 @@ +(* 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 () +;; diff --git a/testsuite/tests/typing-misc/wellfounded.ml.principal.reference b/testsuite/tests/typing-misc/wellfounded.ml.principal.reference new file mode 100644 index 00000000..04bf5586 --- /dev/null +++ b/testsuite/tests/typing-misc/wellfounded.ml.principal.reference @@ -0,0 +1,7 @@ + +# type _ prod = Prod : ('a * 'y) prod +# Characters 82-96: + type d = d * d + ^^^^^^^^^^^^^^ +Error: The type abbreviation d is cyclic +# diff --git a/testsuite/tests/typing-misc/wellfounded.ml.reference b/testsuite/tests/typing-misc/wellfounded.ml.reference new file mode 100644 index 00000000..04bf5586 --- /dev/null +++ b/testsuite/tests/typing-misc/wellfounded.ml.reference @@ -0,0 +1,7 @@ + +# type _ prod = Prod : ('a * 'y) prod +# Characters 82-96: + type d = d * d + ^^^^^^^^^^^^^^ +Error: The type abbreviation d is cyclic +# diff --git a/testsuite/tests/typing-objects/Exemples.ml.principal.reference b/testsuite/tests/typing-objects/Exemples.ml.principal.reference index 2b12a7d9..f0f3812e 100644 --- a/testsuite/tests/typing-objects/Exemples.ml.principal.reference +++ b/testsuite/tests/typing-objects/Exemples.ml.principal.reference @@ -24,8 +24,8 @@ # val get_x : < get_x : 'a; .. > -> 'a = # val set_x : < set_x : 'a; .. > -> 'a = # - : int list = [10; 5] -# Characters 7-96: - ......ref x_init = object +# Characters 1-96: + class ref x_init = object val mutable x = x_init method get = x method set y = x <- y diff --git a/testsuite/tests/typing-objects/Exemples.ml.reference b/testsuite/tests/typing-objects/Exemples.ml.reference index 7cbd68ec..085a9e92 100644 --- a/testsuite/tests/typing-objects/Exemples.ml.reference +++ b/testsuite/tests/typing-objects/Exemples.ml.reference @@ -24,8 +24,8 @@ # val get_x : < get_x : 'a; .. > -> 'a = # val set_x : < set_x : 'a; .. > -> 'a = # - : int list = [10; 5] -# Characters 7-96: - ......ref x_init = object +# Characters 1-96: + class ref x_init = object val mutable x = x_init method get = x method set y = x <- y diff --git a/testsuite/tests/typing-objects/Tests.ml.principal.reference b/testsuite/tests/typing-objects/Tests.ml.principal.reference index e5d9bb8d..6c944944 100644 --- a/testsuite/tests/typing-objects/Tests.ml.principal.reference +++ b/testsuite/tests/typing-objects/Tests.ml.principal.reference @@ -4,8 +4,8 @@ = # 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: @@ -19,8 +19,8 @@ and ['a] d : unit -> object constraint 'a = int #c end # * class ['a] c : 'a -> object ('a) constraint 'a = < f : 'a; .. > method f : 'a end # - : ('a c as 'a) -> 'a = -# * Characters 134-176: - ......x () = object +# * Characters 128-176: + class x () = object method virtual f : int end.. Error: This class should be virtual. The following methods are undefined : f @@ -29,8 +29,8 @@ 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.. @@ -51,17 +51,17 @@ Error: The abbreviation c is used with parameters bool c 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 = - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 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 > @@ -69,14 +69,14 @@ 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 @@ -217,8 +217,8 @@ class e : # * * * * * * * * * * * * * * * * * * * * * 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.. diff --git a/testsuite/tests/typing-objects/Tests.ml.reference b/testsuite/tests/typing-objects/Tests.ml.reference index ed4df922..57628351 100644 --- a/testsuite/tests/typing-objects/Tests.ml.reference +++ b/testsuite/tests/typing-objects/Tests.ml.reference @@ -4,8 +4,8 @@ = # 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: @@ -19,8 +19,8 @@ and ['a] d : unit -> object constraint 'a = int #c end # * class ['a] c : 'a -> object ('a) constraint 'a = < f : 'a; .. > method f : 'a end # - : ('a c as 'a) -> 'a = -# * Characters 134-176: - ......x () = object +# * Characters 128-176: + class x () = object method virtual f : int end.. Error: This class should be virtual. The following methods are undefined : f @@ -29,8 +29,8 @@ 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.. @@ -51,17 +51,17 @@ Error: The abbreviation c is used with parameters bool c 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 = - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 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 > @@ -69,14 +69,14 @@ 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 @@ -217,8 +217,8 @@ class e : # * * * * * * * * * * * * * * * * * * * * * 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.. diff --git a/testsuite/tests/typing-poly/poly.ml.principal.reference b/testsuite/tests/typing-poly/poly.ml.principal.reference index 53acb415..4de2912d 100644 --- a/testsuite/tests/typing-poly/poly.ml.principal.reference +++ b/testsuite/tests/typing-poly/poly.ml.principal.reference @@ -169,9 +169,9 @@ val f4 : id -> int * bool = # 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 @@ -271,9 +271,9 @@ Error: The universal type variable 'a cannot be generalized: 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 ] @@ -301,9 +301,9 @@ Error: Constraints are not satisfied in this type. 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 @@ -346,9 +346,9 @@ Characters 21-24: ^^^ Warning 11: this match case is unused. - : int * [< `B ] -> int = -# 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 @@ -640,9 +640,9 @@ Error: This field value has type unit -> unit which is less general than # 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) = # - : ('a -> 'a) * ('b -> 'b) = (, ) diff --git a/testsuite/tests/typing-poly/poly.ml.reference b/testsuite/tests/typing-poly/poly.ml.reference index 9929020d..8855c1f6 100644 --- a/testsuite/tests/typing-poly/poly.ml.reference +++ b/testsuite/tests/typing-poly/poly.ml.reference @@ -161,9 +161,9 @@ Error: This expression has type bool but an expression was expected of type # 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 @@ -254,9 +254,9 @@ Error: The universal type variable 'a cannot be generalized: 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 ] @@ -284,9 +284,9 @@ Error: Constraints are not satisfied in this type. 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 @@ -329,9 +329,9 @@ Characters 21-24: ^^^ Warning 11: this match case is unused. - : int * [< `B ] -> int = -# 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 @@ -598,9 +598,9 @@ Error: This field value has type unit -> unit which is less general than # 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) = # - : ('a -> 'a) * ('b -> 'b) = (, ) diff --git a/testsuite/tests/typing-private/private.ml.principal.reference b/testsuite/tests/typing-private/private.ml.principal.reference index 96b1d759..db933583 100644 --- a/testsuite/tests/typing-private/private.ml.principal.reference +++ b/testsuite/tests/typing-private/private.ml.principal.reference @@ -84,9 +84,9 @@ Error: Signature mismatch: # 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 diff --git a/testsuite/tests/typing-private/private.ml.reference b/testsuite/tests/typing-private/private.ml.reference index cb1573ed..341bc936 100644 --- a/testsuite/tests/typing-private/private.ml.reference +++ b/testsuite/tests/typing-private/private.ml.reference @@ -84,9 +84,9 @@ Error: Signature mismatch: # 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 diff --git a/testsuite/tests/typing-rectypes-bugs/pr6870_bad.ml b/testsuite/tests/typing-rectypes-bugs/pr6870_bad.ml new file mode 100644 index 00000000..ed834605 --- /dev/null +++ b/testsuite/tests/typing-rectypes-bugs/pr6870_bad.ml @@ -0,0 +1,2 @@ +module type T = sig type 'a t end +module Fix (T : T) = struct type r = ('r T.t as 'r) end diff --git a/testsuite/tests/typing-short-paths/pr6836.ml b/testsuite/tests/typing-short-paths/pr6836.ml new file mode 100644 index 00000000..121bc463 --- /dev/null +++ b/testsuite/tests/typing-short-paths/pr6836.ml @@ -0,0 +1,6 @@ +type t = [`A | `B];; +type 'a u = t;; +let a : [< int u] = `A;; + +type 'a s = 'a;; +let b : [< t s] = `B;; diff --git a/testsuite/tests/typing-short-paths/pr6836.ml.reference b/testsuite/tests/typing-short-paths/pr6836.ml.reference new file mode 100644 index 00000000..3f8c6dbd --- /dev/null +++ b/testsuite/tests/typing-short-paths/pr6836.ml.reference @@ -0,0 +1,7 @@ + +# type t = [ `A | `B ] +# type 'a u = t +# val a : [< int u > `A ] = `A +# type 'a s = 'a +# val b : [< t > `B ] = `B +# diff --git a/testsuite/tests/typing-short-paths/short-paths.ml b/testsuite/tests/typing-short-paths/short-paths.ml index a9812f4f..5d691aca 100644 --- a/testsuite/tests/typing-short-paths/short-paths.ml +++ b/testsuite/tests/typing-short-paths/short-paths.ml @@ -52,3 +52,6 @@ module N2 = struct type u = v and v = M1.v end;; 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;; diff --git a/testsuite/tests/typing-short-paths/short-paths.ml.reference b/testsuite/tests/typing-short-paths/short-paths.ml.reference index 53309ad3..b45fdd0d 100644 --- a/testsuite/tests/typing-short-paths/short-paths.ml.reference +++ b/testsuite/tests/typing-short-paths/short-paths.ml.reference @@ -80,4 +80,6 @@ Error: Signature mismatch: 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 # diff --git a/testsuite/tests/typing-warnings/pr6872.ml b/testsuite/tests/typing-warnings/pr6872.ml new file mode 100644 index 00000000..6eba3e70 --- /dev/null +++ b/testsuite/tests/typing-warnings/pr6872.ml @@ -0,0 +1,9 @@ +exception A;; +type a = A;; + +A;; +raise A;; +fun (A : a) -> ();; +function Not_found -> 1 | A -> 2 | _ -> 3;; +try raise A with A -> 2;; + diff --git a/testsuite/tests/typing-warnings/pr6872.ml.principal.reference b/testsuite/tests/typing-warnings/pr6872.ml.principal.reference new file mode 100644 index 00000000..0227cfd9 --- /dev/null +++ b/testsuite/tests/typing-warnings/pr6872.ml.principal.reference @@ -0,0 +1,35 @@ + +# 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 = +# 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 +# diff --git a/testsuite/tests/typing-warnings/pr6872.ml.reference b/testsuite/tests/typing-warnings/pr6872.ml.reference new file mode 100644 index 00000000..7aeebbeb --- /dev/null +++ b/testsuite/tests/typing-warnings/pr6872.ml.reference @@ -0,0 +1,30 @@ + +# 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 = +# Characters 26-27: + function Not_found -> 1 | A -> 2 | _ -> 3;; + ^ +Warning 42: this use of A required disambiguation. +- : exn -> int = +# 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 +# diff --git a/testsuite/tests/typing-warnings/unused_types.ml b/testsuite/tests/typing-warnings/unused_types.ml new file mode 100644 index 00000000..afe7d4cf --- /dev/null +++ b/testsuite/tests/typing-warnings/unused_types.ml @@ -0,0 +1,18 @@ +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 +;; diff --git a/testsuite/tests/typing-warnings/unused_types.ml.reference b/testsuite/tests/typing-warnings/unused_types.ml.reference new file mode 100644 index 00000000..d515c24e --- /dev/null +++ b/testsuite/tests/typing-warnings/unused_types.ml.reference @@ -0,0 +1,21 @@ + +# 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 +# diff --git a/testsuite/tests/utils/Makefile b/testsuite/tests/utils/Makefile index 4b7ab0dd..1d508680 100644 --- a/testsuite/tests/utils/Makefile +++ b/testsuite/tests/utils/Makefile @@ -18,3 +18,5 @@ CMO_FILES+="misc.cmo" include $(BASEDIR)/makefiles/Makefile.several include $(BASEDIR)/makefiles/Makefile.common + +BYTECODE_ONLY=true diff --git a/tools/.depend b/tools/.depend index c33f5c6f..810c439b 100644 --- a/tools/.depend +++ b/tools/.depend @@ -59,10 +59,10 @@ ocamldep.cmx : ../driver/pparse.cmx ../parsing/parsetree.cmi \ ../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 diff --git a/tools/Makefile.shared b/tools/Makefile.shared index 25174344..0b90cd32 100644 --- a/tools/Makefile.shared +++ b/tools/Makefile.shared @@ -11,8 +11,9 @@ ######################################################################### 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 @@ -37,7 +38,7 @@ opt.opt: ocamldep.opt read_cmt.opt 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 @@ -67,7 +68,7 @@ install:: 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 @@ -160,7 +161,7 @@ clean:: # 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 @@ -205,6 +206,7 @@ READ_CMT= \ ../utils/clflags.cmo \ ../parsing/location.cmo \ ../parsing/longident.cmo \ + ../parsing/docstrings.cmo \ ../parsing/lexer.cmo \ ../parsing/pprintast.cmo \ ../parsing/ast_helper.cmo \ @@ -257,7 +259,7 @@ dumpobj: $(DUMPOBJ) 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 || : ; \ @@ -267,7 +269,7 @@ opnames.ml: ../byterun/instruct.h -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 @@ -276,8 +278,15 @@ beforedepend:: 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 \ diff --git a/tools/eqparsetree.ml b/tools/eqparsetree.ml index 128453e0..4c699e99 100644 --- a/tools/eqparsetree.ml +++ b/tools/eqparsetree.ml @@ -273,12 +273,13 @@ let rec eq_structure_item_desc : | (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)) @@ -359,12 +360,13 @@ and eq_signature_item_desc : | (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)) diff --git a/tools/objinfo_helper.c b/tools/objinfo_helper.c index a8c79bd3..4a76cff1 100644 --- a/tools/objinfo_helper.c +++ b/tools/objinfo_helper.c @@ -10,8 +10,8 @@ /***********************************************************************/ #include "../config/s.h" -#include "../byterun/mlvalues.h" -#include "../byterun/alloc.h" +#include "../byterun/caml/mlvalues.h" +#include "../byterun/caml/alloc.h" #include #ifdef HAS_LIBBFD @@ -24,6 +24,12 @@ #include #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; @@ -74,14 +80,14 @@ int main(int argc, char ** argv) 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; } diff --git a/tools/ocamlcp.ml b/tools/ocamlcp.ml index 51559aea..26ced6c5 100644 --- a/tools/ocamlcp.ml +++ b/tools/ocamlcp.ml @@ -61,12 +61,14 @@ module Options = Main_args.Make_bytecomp_options (struct 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" @@ -74,6 +76,7 @@ module Options = Main_args.Make_bytecomp_options (struct 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" diff --git a/tools/ocamlmklib.ml b/tools/ocamlmklib.ml index 77ae57be..23a273ec 100644 --- a/tools/ocamlmklib.ml +++ b/tools/ocamlmklib.ml @@ -27,14 +27,17 @@ and caml_opts = ref [] (* -ccopt to pass to ocamlc, ocamlopt *) and dynlink = ref supports_shared_libraries and failsafe = ref false (* whether to fall back on static build only *) and c_libs = ref [] (* libs to pass to mksharedlib and ocamlc -cclib *) -and c_Lopts = ref [] (* options to pass to mksharedlib and ocamlc -cclib *) -and c_opts = ref [] (* options to pass to mksharedlib and ocamlc -ccopt *) +and 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 = @@ -84,6 +87,8 @@ let parse_arguments argv = 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 @@ -96,10 +101,14 @@ let parse_arguments argv = (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 @@ -148,7 +157,8 @@ Usage: ocamlmklib [options] <.cmo|.cma|.cmx|.cmxa|.ml|.mli|.o|.a|.obj|.lib|\ \nOptions are:\ \n -cclib C library passed to ocamlc -a or ocamlopt -a only\ \n -ccopt C option passed to ocamlc -a or ocamlopt -a only\ -\n -custom disable dynamic loading\ +\n -custom Disable dynamic loading\ +\n -g Build with debug information\ \n -dllpath Add to the run-time search path for DLLs\ \n -F Specify a framework directory (MacOSX)\ \n -framework Use framework (MacOSX)\ @@ -162,7 +172,9 @@ Usage: ocamlmklib [options] <.cmo|.cma|.cmx|.cmxa|.ml|.mli|.o|.a|.obj|.lib|\ \n -l Specify a dependent C library\ \n -L Add to the path searched for C libraries\ \n -ocamlc Use in place of \"ocamlc\"\ +\n -ocamlcflags Pass to ocamlc\ \n -ocamlopt Use in place of \"ocamlopt\"\ +\n -ocamloptflags Pass to ocamlopt\ \n -o Generated OCaml library is named .cma or .cmxa\ \n -oc Generated C library is named dll.so or lib.a\ \n -rpath Same as -dllpath \ @@ -229,8 +241,9 @@ let build_libs () = 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) @@ -248,9 +261,11 @@ let build_libs () = 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) @@ -262,8 +277,10 @@ let build_libs () = (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) diff --git a/tools/ocamloptp.ml b/tools/ocamloptp.ml index 0b788843..fd15fe59 100644 --- a/tools/ocamloptp.ml +++ b/tools/ocamloptp.ml @@ -61,6 +61,7 @@ module Options = Main_args.Make_optcomp_options (struct 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" @@ -75,6 +76,7 @@ module Options = Main_args.Make_optcomp_options (struct 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" diff --git a/tools/untypeast.ml b/tools/untypeast.ml index 7641c91d..a8b992ef 100644 --- a/tools/untypeast.ml +++ b/tools/untypeast.ml @@ -624,7 +624,7 @@ and untype_class_field cf = 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 diff --git a/toplevel/genprintval.ml b/toplevel/genprintval.ml index 27f45a2d..3144594f 100644 --- a/toplevel/genprintval.ml +++ b/toplevel/genprintval.ml @@ -37,11 +37,25 @@ module type EVALPATH = 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 : @@ -50,8 +64,12 @@ module type S = 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 @@ -59,9 +77,6 @@ module ObjTbl = Hashtbl.Make(struct 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. @@ -104,47 +119,74 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct (* 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 "" 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 "" 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. *) @@ -184,8 +226,8 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct 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 @@ -205,7 +247,7 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct 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 _ -> @@ -258,12 +300,58 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct 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 "" + 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 "" + 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 ) 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 @@ -416,6 +504,35 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct | None -> Oval_stuff "" + 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 "" + Printtyp.path path in + Oval_printer printer) + + in nest tree_of_val max_depth obj ty end diff --git a/toplevel/genprintval.mli b/toplevel/genprintval.mli index 3f7b85ab..1c2ec471 100644 --- a/toplevel/genprintval.mli +++ b/toplevel/genprintval.mli @@ -33,11 +33,28 @@ module type EVALPATH = 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 : diff --git a/toplevel/opttoploop.ml b/toplevel/opttoploop.ml index 9e9e3d74..d21860a8 100644 --- a/toplevel/opttoploop.ml +++ b/toplevel/opttoploop.ml @@ -136,7 +136,7 @@ let load_lambda ppf (size, lam) = 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); diff --git a/toplevel/topdirs.ml b/toplevel/topdirs.ml index 4773c3f0..42fe0a5d 100644 --- a/toplevel/topdirs.ml +++ b/toplevel/topdirs.ml @@ -185,17 +185,40 @@ let _ = Hashtbl.add directive_table "mod_use" (* 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 @@ -203,16 +226,45 @@ let match_printer_type ppf desc typename = (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 -> @@ -225,14 +277,30 @@ let find_printer_type ppf lid = 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 = @@ -361,7 +429,8 @@ let show_prim to_sig 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.@]@." diff --git a/toplevel/toploop.ml b/toplevel/toploop.ml index 9fa802ca..a3cb06b0 100644 --- a/toplevel/toploop.ml +++ b/toplevel/toploop.ml @@ -96,7 +96,13 @@ let outval_of_value env obj ty = 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 *) @@ -468,6 +474,7 @@ let initialize_toplevel_env () = 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 diff --git a/toplevel/toploop.mli b/toplevel/toploop.mli index 1867c001..6638d769 100644 --- a/toplevel/toploop.mli +++ b/toplevel/toploop.mli @@ -71,8 +71,19 @@ val eval_path: Env.t -> Path.t -> Obj.t 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 diff --git a/typing/ctype.ml b/typing/ctype.ml index 78852a43..d1ff9da5 100644 --- a/typing/ctype.ml +++ b/typing/ctype.ml @@ -1055,20 +1055,25 @@ let rec copy ?env ?partial ?keep_names ty = (* 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 *) @@ -1662,10 +1667,11 @@ exception Occur 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 @@ -1676,15 +1682,15 @@ let rec occur_rec env visited ty0 ty = 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 *) @@ -2052,8 +2058,11 @@ let rec mcomp type_pairs env t1 t2 = | (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 diff --git a/typing/ctype.mli b/typing/ctype.mli index 37daf3a4..36cb186f 100644 --- a/typing/ctype.mli +++ b/typing/ctype.mli @@ -144,6 +144,7 @@ val try_expand_once_opt: Env.t -> type_expr -> type_expr 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 diff --git a/typing/env.ml b/typing/env.ml index 7df15660..b11be4d8 100644 --- a/typing/env.ml +++ b/typing/env.ml @@ -58,6 +58,7 @@ type error = | 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 @@ -69,6 +70,7 @@ module EnvLazy : sig 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 @@ -95,6 +97,9 @@ 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 @@ -336,6 +341,12 @@ let check_consistency ps = (* 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 @@ -377,6 +388,10 @@ let find_pers_struct ?(check=true) name = | 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 -> @@ -414,6 +429,9 @@ let reset_cache_toplevel () = let set_unit_name name = current_unit := name +let get_unit_name () = + !current_unit + (* Lookup by identifier *) let rec find_module_descr path env = @@ -423,7 +441,7 @@ 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 @@ -487,7 +505,7 @@ let find_module ~alias path env = 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 @@ -927,20 +945,38 @@ let lookup_cltype lid env = (* 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 -> @@ -953,6 +989,13 @@ let iter_env proj1 proj2 f env = (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 = @@ -1296,7 +1339,20 @@ and check_usage loc id warn tbl = (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; @@ -1643,9 +1699,7 @@ let save_signature_with_imports sg modname filename imports = 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; @@ -1808,11 +1862,16 @@ let report_error ppf = function 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 diff --git a/typing/env.mli b/typing/env.mli index ed2f6f1c..e894557e 100644 --- a/typing/env.mli +++ b/typing/env.mli @@ -37,9 +37,11 @@ type type_descriptions = 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 @@ -145,6 +147,7 @@ val reset_cache_toplevel: unit -> unit (* 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 *) @@ -189,6 +192,7 @@ type error = | 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 @@ -256,3 +260,4 @@ val fold_cltypes: (** Utilities *) val scrape_alias: t -> module_type -> module_type +val check_value_name: string -> Location.t -> unit diff --git a/typing/oprint.ml b/typing/oprint.ml index 994d9327..4f482325 100644 --- a/typing/oprint.ml +++ b/typing/oprint.ml @@ -419,7 +419,10 @@ and print_out_sig_item ppf = 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 diff --git a/typing/parmatch.ml b/typing/parmatch.ml index 6732be7a..c2c7ceba 100644 --- a/typing/parmatch.ml +++ b/typing/parmatch.ml @@ -210,7 +210,8 @@ and pretty_cdr ppf v = match v.pat_desc with | _ -> 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 @@ -1811,8 +1812,8 @@ let do_check_partial ?pred exhaust loc casel pss = match pss 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 diff --git a/typing/parmatch.mli b/typing/parmatch.mli index 947f16fa..dfd955a8 100644 --- a/typing/parmatch.mli +++ b/typing/parmatch.mli @@ -53,7 +53,6 @@ val complete_constrs : 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 -> diff --git a/typing/printtyp.ml b/typing/printtyp.ml index 920c28b5..52fddd47 100644 --- a/typing/printtyp.ml +++ b/typing/printtyp.ml @@ -202,6 +202,10 @@ let () = Btype.print_raw := raw_type_expr 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) @@ -216,6 +220,8 @@ let apply_subst s1 tyl = 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 @@ -232,7 +238,7 @@ 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' @@ -287,24 +293,24 @@ let set_printing_env env = (* 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 = @@ -347,10 +353,14 @@ let best_type_path p = 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) @@ -437,7 +447,7 @@ let aliasable ty = 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 = @@ -556,12 +566,10 @@ let rec tree_of_typexp sch ty = | 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 = @@ -580,17 +588,22 @@ let rec tree_of_typexp sch ty = 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 @@ -1136,7 +1149,7 @@ let dummy = 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 @@ -1165,15 +1178,17 @@ let rec tree_of_modtype = function 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 @@ -1197,7 +1212,7 @@ and tree_of_signature_rec env' = function [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 = diff --git a/typing/stypes.ml b/typing/stypes.ml index e1f4557a..1f89e744 100644 --- a/typing/stypes.ml +++ b/typing/stypes.ml @@ -198,6 +198,10 @@ let dump filename = | 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 := []; diff --git a/typing/subst.ml b/typing/subst.ml index 2e84be01..c9b18e26 100644 --- a/typing/subst.ml +++ b/typing/subst.ml @@ -42,11 +42,22 @@ let remove_loc = 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 -> @@ -306,7 +317,7 @@ let extension_constructor s ext = 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 (); diff --git a/typing/subst.mli b/typing/subst.mli index a197f82f..7f6870e9 100644 --- a/typing/subst.mli +++ b/typing/subst.mli @@ -51,6 +51,8 @@ val modtype: t -> module_type -> module_type 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) *) diff --git a/typing/typeclass.ml b/typing/typeclass.ml index 33b776be..a29ddddb 100644 --- a/typing/typeclass.ml +++ b/typing/typeclass.ml @@ -944,7 +944,7 @@ and class_expr cl_num val_env met_env scl = | _ -> 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 *) diff --git a/typing/typecore.ml b/typing/typecore.ml index b173d99c..95af7ae6 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -282,6 +282,7 @@ let extract_concrete_record env ty = 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 = @@ -887,7 +888,7 @@ let unify_head_only loc env ty constr = | 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 *) @@ -1241,6 +1242,9 @@ let partial_pred ~lev env expected_ty constrs labels p = 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 -> @@ -2859,6 +2863,7 @@ and type_format loc str env = | 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 ] @@ -2978,6 +2983,10 @@ and type_format loc str env = 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 @@ -3518,7 +3527,7 @@ and type_cases ?in_function env ty_arg ty_res partial_flag loc caselist = 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 @@ -3696,7 +3705,8 @@ and type_let ?(check = fun s -> Warnings.Unused_var s) 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 diff --git a/typing/typecore.mli b/typing/typecore.mli index 4ce6b1fc..ee16c3b7 100644 --- a/typing/typecore.mli +++ b/typing/typecore.mli @@ -41,6 +41,9 @@ val type_self_pattern: (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 diff --git a/typing/typedecl.ml b/typing/typedecl.ml index ecad00f3..2fdda9dc 100644 --- a/typing/typedecl.ml +++ b/typing/typedecl.ml @@ -512,7 +512,7 @@ let check_well_founded env loc path to_check ty = (* 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 @@ -969,8 +969,8 @@ let name_recursion sdecl id decl = 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 = @@ -996,29 +996,35 @@ let transl_type_decl env 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 @@ -1036,9 +1042,13 @@ let transl_type_decl env sdecl_list = 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; diff --git a/typing/typedecl.mli b/typing/typedecl.mli index 45267495..8be29fe2 100644 --- a/typing/typedecl.mli +++ b/typing/typedecl.mli @@ -16,7 +16,7 @@ open Types 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: diff --git a/typing/typedtreeIter.ml b/typing/typedtreeIter.ml index 3d1a19fa..4b829067 100644 --- a/typing/typedtreeIter.ml +++ b/typing/typedtreeIter.ml @@ -23,7 +23,6 @@ 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 @@ -50,7 +49,6 @@ module type IteratorArgument = sig 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 @@ -79,6 +77,11 @@ module type IteratorArgument = sig 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 @@ -133,7 +136,7 @@ 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 @@ -188,6 +191,21 @@ module MakeIterator(Iter : IteratorArgument) : sig 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 @@ -353,7 +371,7 @@ module MakeIterator(Iter : IteratorArgument) : sig 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 -> @@ -590,7 +608,6 @@ module DefaultIteratorArgument = struct let enter_structure _ = () let enter_value_description _ = () - let enter_type_declaration _ = () let enter_type_extension _ = () let enter_extension_constructor _ = () let enter_pattern _ = () @@ -618,7 +635,6 @@ module DefaultIteratorArgument = struct let leave_structure _ = () let leave_value_description _ = () - let leave_type_declaration _ = () let leave_type_extension _ = () let leave_extension_constructor _ = () let leave_pattern _ = () @@ -649,4 +665,9 @@ module DefaultIteratorArgument = struct let enter_bindings _ = () let leave_bindings _ = () - end + let enter_type_declaration _ = () + let leave_type_declaration _ = () + + let enter_type_declarations _ = () + let leave_type_declarations _ = () +end diff --git a/typing/typedtreeIter.mli b/typing/typedtreeIter.mli index 547fc5c3..921afb7d 100644 --- a/typing/typedtreeIter.mli +++ b/typing/typedtreeIter.mli @@ -17,7 +17,6 @@ open Typedtree 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 @@ -44,7 +43,6 @@ module type IteratorArgument = sig 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 @@ -73,6 +71,11 @@ module type IteratorArgument = sig 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 : diff --git a/typing/typemod.ml b/typing/typemod.ml index a053d53a..bd5ed813 100644 --- a/typing/typemod.ml +++ b/typing/typemod.ml @@ -120,15 +120,16 @@ let rec make_params n = function [] -> [] | _ :: 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 @@ -207,7 +208,7 @@ let merge_constraint initial_env loc sg constr = 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 @@ -223,7 +224,7 @@ let merge_constraint initial_env loc sg constr = 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) = @@ -284,20 +285,35 @@ let map_rec fn decls rem = | [] -> 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 = @@ -348,9 +364,11 @@ and approx_sig env ssg = | 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) = @@ -561,15 +579,16 @@ and transl_signature env sg = 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) = @@ -851,6 +870,9 @@ let rec path_of_module mexp = 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 @@ -1115,7 +1137,7 @@ let rec type_module ?(alias=false) sttn funct_body anchor env smod = 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 @@ -1235,12 +1257,14 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope = 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 -> diff --git a/typing/typemod.mli b/typing/typemod.mli index 88950178..9f8e6170 100644 --- a/typing/typemod.mli +++ b/typing/typemod.mli @@ -35,9 +35,13 @@ val check_nongen_schemes: 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 diff --git a/typing/types.ml b/typing/types.ml index 8d3982ed..6ab98419 100644 --- a/typing/types.ml +++ b/typing/types.ml @@ -297,9 +297,9 @@ and modtype_declaration = } 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 *) diff --git a/typing/types.mli b/typing/types.mli index c3999826..fd7ef100 100644 --- a/typing/types.mli +++ b/typing/types.mli @@ -287,9 +287,9 @@ and modtype_declaration = } 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 *) diff --git a/typing/typetexp.ml b/typing/typetexp.ml index 523d435b..605366bc 100644 --- a/typing/typetexp.ml +++ b/typing/typetexp.ml @@ -240,6 +240,7 @@ let find_class env loc lid = 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 diff --git a/utils/ccomp.ml b/utils/ccomp.ml index bbc8e3f0..5871f689 100644 --- a/utils/ccomp.ml +++ b/utils/ccomp.ml @@ -51,13 +51,14 @@ let quote_optfile = function 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") @@ -97,14 +98,22 @@ type link_mode = | 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" @@ -120,7 +129,7 @@ let call_linker mode output_name files extra = "" (*(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 diff --git a/utils/clflags.ml b/utils/clflags.ml index 57834ccf..864d6888 100644 --- a/utils/clflags.ml +++ b/utils/clflags.ml @@ -26,8 +26,10 @@ and debug = ref false (* -g *) 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 *) @@ -108,5 +110,6 @@ let dlcode = ref true (* not -nodynlink *) 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 *) diff --git a/utils/clflags.mli b/utils/clflags.mli index 7e51cf33..aeed7d97 100644 --- a/utils/clflags.mli +++ b/utils/clflags.mli @@ -23,8 +23,10 @@ val debug : bool ref 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 @@ -91,6 +93,7 @@ val shared : 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 diff --git a/utils/misc.ml b/utils/misc.ml index 2eb8088e..2e785327 100644 --- a/utils/misc.ml +++ b/utils/misc.ml @@ -202,6 +202,17 @@ let search_substring pat str start = 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 diff --git a/utils/misc.mli b/utils/misc.mli index 5168a6a9..cec1b80b 100644 --- a/utils/misc.mli +++ b/utils/misc.mli @@ -101,6 +101,10 @@ val search_substring: string -> string -> int -> int 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. *) diff --git a/utils/warnings.ml b/utils/warnings.ml index 103789c4..a613b934 100644 --- a/utils/warnings.ml +++ b/utils/warnings.ml @@ -67,6 +67,7 @@ type t = | 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 @@ -125,9 +126,10 @@ let number = function | 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 @@ -240,7 +242,7 @@ let parse_options errflag s = 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;; @@ -384,6 +386,9 @@ let message = function (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;; @@ -391,19 +396,9 @@ 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;; @@ -474,24 +469,25 @@ let descriptions = 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; diff --git a/utils/warnings.mli b/utils/warnings.mli index edfd732c..ffd943fa 100644 --- a/utils/warnings.mli +++ b/utils/warnings.mli @@ -62,6 +62,7 @@ type t = | 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;; @@ -72,9 +73,7 @@ val is_error : t -> bool;; val defaults_w : string;; val defaults_warn_error : string;; -val print : formatter -> t -> int;; - (* returns the number of newlines in the printed string *) - +val print : formatter -> t -> unit;; exception Errors of int;; diff --git a/yacc/Makefile b/yacc/Makefile index f5b37e00..e7acf869 100644 --- a/yacc/Makefile +++ b/yacc/Makefile @@ -15,7 +15,7 @@ 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 diff --git a/yacc/Makefile.nt b/yacc/Makefile.nt index 32caa41e..9537365a 100644 --- a/yacc/Makefile.nt +++ b/yacc/Makefile.nt @@ -29,9 +29,7 @@ version.h : ../VERSION clean: rm -f *.$(O) ocamlyacc.exe *~ version.h -.SUFFIXES: .c .$(O) - -.c.$(O): +%.$(O): %.c $(BYTECC) -DNDEBUG -DNO_UNIX $(BYTECCCOMPOPTS) -c $< depend: