diff options
357 files changed, 8387 insertions, 6538 deletions
@@ -43,16 +43,16 @@ parsing/ast_helper.cmo : parsing/parsetree.cmi parsing/longident.cmi \ parsing/location.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/ast_mapper.cmo : parsing/parsetree.cmi parsing/location.cmi \ - utils/config.cmi parsing/ast_helper.cmi parsing/ast_mapper.cmi -parsing/ast_mapper.cmx : parsing/parsetree.cmi parsing/location.cmx \ - utils/config.cmx parsing/ast_helper.cmx parsing/ast_mapper.cmi +parsing/ast_mapper.cmo : parsing/parsetree.cmi utils/misc.cmi \ + parsing/location.cmi utils/config.cmi parsing/ast_helper.cmi \ + parsing/ast_mapper.cmi +parsing/ast_mapper.cmx : parsing/parsetree.cmi utils/misc.cmx \ + parsing/location.cmx utils/config.cmx parsing/ast_helper.cmx \ + parsing/ast_mapper.cmi parsing/lexer.cmo : utils/warnings.cmi parsing/parser.cmi utils/misc.cmi \ parsing/location.cmi parsing/lexer.cmi parsing/lexer.cmx : utils/warnings.cmx parsing/parser.cmx utils/misc.cmx \ parsing/location.cmx parsing/lexer.cmi -parsing/linenum.cmo : utils/misc.cmi -parsing/linenum.cmx : utils/misc.cmx parsing/location.cmo : utils/warnings.cmi utils/terminfo.cmi \ parsing/location.cmi parsing/location.cmx : utils/warnings.cmx utils/terminfo.cmx \ @@ -69,14 +69,18 @@ parsing/parser.cmo : parsing/syntaxerr.cmi parsing/parsetree.cmi \ parsing/parser.cmx : parsing/syntaxerr.cmx parsing/parsetree.cmi \ parsing/longident.cmx parsing/location.cmx utils/clflags.cmx \ parsing/asttypes.cmi parsing/ast_helper.cmx parsing/parser.cmi -parsing/pprintast.cmo : parsing/parsetree.cmi parsing/longident.cmi \ - parsing/location.cmi parsing/asttypes.cmi parsing/pprintast.cmi -parsing/pprintast.cmx : parsing/parsetree.cmi parsing/longident.cmx \ - parsing/location.cmx parsing/asttypes.cmi parsing/pprintast.cmi -parsing/printast.cmo : parsing/parsetree.cmi parsing/longident.cmi \ - parsing/location.cmi parsing/asttypes.cmi parsing/printast.cmi -parsing/printast.cmx : parsing/parsetree.cmi parsing/longident.cmx \ - parsing/location.cmx parsing/asttypes.cmi parsing/printast.cmi +parsing/pprintast.cmo : parsing/parsetree.cmi utils/misc.cmi \ + parsing/longident.cmi parsing/location.cmi parsing/asttypes.cmi \ + parsing/pprintast.cmi +parsing/pprintast.cmx : parsing/parsetree.cmi utils/misc.cmx \ + parsing/longident.cmx parsing/location.cmx parsing/asttypes.cmi \ + parsing/pprintast.cmi +parsing/printast.cmo : parsing/parsetree.cmi utils/misc.cmi \ + parsing/longident.cmi parsing/location.cmi parsing/asttypes.cmi \ + parsing/printast.cmi +parsing/printast.cmx : parsing/parsetree.cmi utils/misc.cmx \ + parsing/longident.cmx parsing/location.cmx parsing/asttypes.cmi \ + parsing/printast.cmi parsing/syntaxerr.cmo : parsing/location.cmi parsing/syntaxerr.cmi parsing/syntaxerr.cmx : parsing/location.cmx parsing/syntaxerr.cmi typing/annot.cmi : parsing/location.cmi @@ -97,8 +101,8 @@ typing/includeclass.cmi : typing/types.cmi typing/env.cmi typing/ctype.cmi typing/includecore.cmi : typing/types.cmi typing/typedtree.cmi \ typing/ident.cmi typing/env.cmi typing/includemod.cmi : typing/types.cmi typing/typedtree.cmi \ - typing/path.cmi typing/includecore.cmi typing/ident.cmi typing/env.cmi \ - typing/ctype.cmi + typing/path.cmi parsing/location.cmi typing/includecore.cmi \ + typing/ident.cmi typing/env.cmi typing/ctype.cmi typing/mtype.cmi : typing/types.cmi typing/path.cmi typing/ident.cmi \ typing/env.cmi typing/oprint.cmi : typing/outcometree.cmi @@ -136,9 +140,10 @@ typing/typemod.cmi : typing/types.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 parsing/asttypes.cmi -typing/typetexp.cmi : typing/types.cmi typing/typedtree.cmi typing/path.cmi \ - parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \ - typing/env.cmi parsing/asttypes.cmi +typing/typetexp.cmi : utils/warnings.cmi typing/types.cmi \ + typing/typedtree.cmi typing/path.cmi parsing/parsetree.cmi \ + parsing/longident.cmi parsing/location.cmi typing/env.cmi \ + parsing/asttypes.cmi typing/btype.cmo : typing/types.cmi typing/path.cmi utils/misc.cmi \ typing/ident.cmi typing/btype.cmi typing/btype.cmx : typing/types.cmx typing/path.cmx utils/misc.cmx \ @@ -182,11 +187,11 @@ typing/env.cmx : utils/warnings.cmx typing/types.cmx utils/tbl.cmx \ typing/cmi_format.cmx utils/clflags.cmx typing/btype.cmx \ parsing/asttypes.cmi typing/env.cmi typing/envaux.cmo : typing/types.cmi typing/subst.cmi typing/printtyp.cmi \ - typing/path.cmi typing/mtype.cmi utils/misc.cmi typing/env.cmi \ - parsing/asttypes.cmi typing/envaux.cmi + typing/path.cmi typing/mtype.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 typing/mtype.cmx utils/misc.cmx typing/env.cmx \ - parsing/asttypes.cmi typing/envaux.cmi + typing/path.cmx typing/mtype.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 \ @@ -205,18 +210,20 @@ typing/includemod.cmo : typing/types.cmi typing/typedtree.cmi utils/tbl.cmi \ typing/subst.cmi typing/printtyp.cmi typing/path.cmi typing/mtype.cmi \ utils/misc.cmi parsing/location.cmi typing/includecore.cmi \ typing/includeclass.cmi typing/ident.cmi typing/env.cmi typing/ctype.cmi \ - utils/clflags.cmi typing/includemod.cmi + typing/cmt_format.cmi utils/clflags.cmi typing/includemod.cmi typing/includemod.cmx : typing/types.cmx typing/typedtree.cmx utils/tbl.cmx \ typing/subst.cmx typing/printtyp.cmx typing/path.cmx typing/mtype.cmx \ utils/misc.cmx parsing/location.cmx typing/includecore.cmx \ typing/includeclass.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \ - utils/clflags.cmx typing/includemod.cmi + typing/cmt_format.cmx utils/clflags.cmx typing/includemod.cmi typing/mtype.cmo : typing/types.cmi typing/subst.cmi typing/path.cmi \ - typing/ident.cmi typing/env.cmi typing/ctype.cmi utils/clflags.cmi \ - typing/btype.cmi parsing/asttypes.cmi typing/mtype.cmi + utils/misc.cmi parsing/location.cmi typing/ident.cmi typing/env.cmi \ + typing/ctype.cmi utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \ + typing/mtype.cmi typing/mtype.cmx : typing/types.cmx typing/subst.cmx typing/path.cmx \ - typing/ident.cmx typing/env.cmx typing/ctype.cmx utils/clflags.cmx \ - typing/btype.cmx parsing/asttypes.cmi typing/mtype.cmi + utils/misc.cmx parsing/location.cmx typing/ident.cmx typing/env.cmx \ + typing/ctype.cmx utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \ + typing/mtype.cmi typing/oprint.cmo : typing/outcometree.cmi parsing/asttypes.cmi \ typing/oprint.cmi typing/oprint.cmx : typing/outcometree.cmi parsing/asttypes.cmi \ @@ -254,10 +261,10 @@ typing/printtyp.cmx : typing/types.cmx typing/primitive.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 parsing/longident.cmi parsing/location.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 parsing/longident.cmx parsing/location.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 @@ -329,10 +336,10 @@ 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 parsing/asttypes.cmi \ - typing/typedtreeIter.cmi -typing/typedtreeIter.cmx : typing/typedtree.cmx parsing/asttypes.cmi \ - typing/typedtreeIter.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 \ + parsing/asttypes.cmi typing/typedtreeIter.cmi typing/typedtreeMap.cmo : typing/typedtree.cmi utils/misc.cmi \ typing/typedtreeMap.cmi typing/typedtreeMap.cmx : typing/typedtree.cmx utils/misc.cmx \ @@ -386,7 +393,7 @@ bytecomp/instruct.cmi : typing/types.cmi typing/subst.cmi \ bytecomp/lambda.cmi : typing/types.cmi typing/primitive.cmi typing/path.cmi \ parsing/location.cmi typing/ident.cmi typing/env.cmi parsing/asttypes.cmi bytecomp/matching.cmi : typing/typedtree.cmi parsing/location.cmi \ - bytecomp/lambda.cmi typing/ident.cmi parsing/asttypes.cmi + bytecomp/lambda.cmi typing/ident.cmi bytecomp/meta.cmi : bytecomp/printinstr.cmi : bytecomp/instruct.cmi bytecomp/printlambda.cmi : bytecomp/lambda.cmi @@ -406,13 +413,13 @@ bytecomp/translobj.cmi : bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi bytecomp/typeopt.cmi : typing/typedtree.cmi typing/path.cmi \ bytecomp/lambda.cmi bytecomp/bytegen.cmo : typing/types.cmi bytecomp/switch.cmi typing/subst.cmi \ - typing/primitive.cmi utils/misc.cmi bytecomp/lambda.cmi \ - bytecomp/instruct.cmi typing/ident.cmi utils/config.cmi \ - parsing/asttypes.cmi bytecomp/bytegen.cmi + typing/primitive.cmi utils/misc.cmi bytecomp/matching.cmi \ + bytecomp/lambda.cmi bytecomp/instruct.cmi typing/ident.cmi \ + utils/config.cmi parsing/asttypes.cmi bytecomp/bytegen.cmi bytecomp/bytegen.cmx : typing/types.cmx bytecomp/switch.cmx typing/subst.cmx \ - typing/primitive.cmx utils/misc.cmx bytecomp/lambda.cmx \ - bytecomp/instruct.cmx typing/ident.cmx utils/config.cmx \ - parsing/asttypes.cmi bytecomp/bytegen.cmi + typing/primitive.cmx utils/misc.cmx bytecomp/matching.cmx \ + bytecomp/lambda.cmx bytecomp/instruct.cmx typing/ident.cmx \ + utils/config.cmx parsing/asttypes.cmi bytecomp/bytegen.cmi bytecomp/bytelibrarian.cmo : utils/misc.cmi parsing/location.cmi \ utils/config.cmi bytecomp/cmo_format.cmi utils/clflags.cmi \ bytecomp/bytelink.cmi bytecomp/bytelibrarian.cmi @@ -430,17 +437,17 @@ bytecomp/bytelink.cmx : utils/warnings.cmx bytecomp/symtable.cmx \ bytecomp/cmo_format.cmi utils/clflags.cmx utils/ccomp.cmx \ bytecomp/bytesections.cmx bytecomp/bytelink.cmi bytecomp/bytepackager.cmo : typing/typemod.cmi bytecomp/translmod.cmi \ - typing/subst.cmi typing/path.cmi utils/misc.cmi parsing/location.cmi \ - bytecomp/instruct.cmi typing/ident.cmi typing/env.cmi \ - bytecomp/emitcode.cmi utils/config.cmi bytecomp/cmo_format.cmi \ - utils/clflags.cmi bytecomp/bytelink.cmi bytecomp/bytegen.cmi \ - bytecomp/bytepackager.cmi + typing/subst.cmi bytecomp/printlambda.cmi typing/path.cmi utils/misc.cmi \ + parsing/location.cmi bytecomp/instruct.cmi typing/ident.cmi \ + typing/env.cmi bytecomp/emitcode.cmi utils/config.cmi \ + bytecomp/cmo_format.cmi utils/clflags.cmi bytecomp/bytelink.cmi \ + bytecomp/bytegen.cmi bytecomp/bytepackager.cmi bytecomp/bytepackager.cmx : typing/typemod.cmx bytecomp/translmod.cmx \ - typing/subst.cmx typing/path.cmx utils/misc.cmx parsing/location.cmx \ - bytecomp/instruct.cmx typing/ident.cmx typing/env.cmx \ - bytecomp/emitcode.cmx utils/config.cmx bytecomp/cmo_format.cmi \ - utils/clflags.cmx bytecomp/bytelink.cmx bytecomp/bytegen.cmx \ - bytecomp/bytepackager.cmi + typing/subst.cmx bytecomp/printlambda.cmx typing/path.cmx utils/misc.cmx \ + parsing/location.cmx bytecomp/instruct.cmx typing/ident.cmx \ + typing/env.cmx bytecomp/emitcode.cmx utils/config.cmx \ + bytecomp/cmo_format.cmi utils/clflags.cmx bytecomp/bytelink.cmx \ + bytecomp/bytegen.cmx bytecomp/bytepackager.cmi bytecomp/bytesections.cmo : utils/misc.cmi utils/config.cmi \ bytecomp/bytesections.cmi bytecomp/bytesections.cmx : utils/misc.cmx utils/config.cmx \ @@ -576,30 +583,30 @@ asmcomp/asmpackager.cmi : asmcomp/clambda.cmi : bytecomp/lambda.cmi typing/ident.cmi \ asmcomp/debuginfo.cmi parsing/asttypes.cmi asmcomp/closure.cmi : bytecomp/lambda.cmi asmcomp/clambda.cmi -asmcomp/cmm.cmi : typing/ident.cmi asmcomp/debuginfo.cmi +asmcomp/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/cmx_format.cmi : asmcomp/clambda.cmi asmcomp/codegen.cmi : asmcomp/cmm.cmi asmcomp/coloring.cmi : asmcomp/comballoc.cmi : asmcomp/mach.cmi -asmcomp/compilenv.cmi : bytecomp/lambda.cmi typing/ident.cmi \ - asmcomp/cmx_format.cmi asmcomp/clambda.cmi +asmcomp/compilenv.cmi : typing/ident.cmi asmcomp/cmx_format.cmi \ + asmcomp/clambda.cmi asmcomp/debuginfo.cmi : parsing/location.cmi bytecomp/lambda.cmi asmcomp/emit.cmi : asmcomp/linearize.cmi asmcomp/cmm.cmi asmcomp/emitaux.cmi : asmcomp/debuginfo.cmi asmcomp/interf.cmi : asmcomp/mach.cmi -asmcomp/linearize.cmi : asmcomp/reg.cmi asmcomp/mach.cmi \ +asmcomp/linearize.cmi : asmcomp/reg.cmi asmcomp/mach.cmi bytecomp/lambda.cmi \ asmcomp/debuginfo.cmi asmcomp/liveness.cmi : asmcomp/mach.cmi -asmcomp/mach.cmi : asmcomp/reg.cmi asmcomp/debuginfo.cmi asmcomp/cmm.cmi \ - asmcomp/arch.cmo +asmcomp/mach.cmi : asmcomp/reg.cmi bytecomp/lambda.cmi asmcomp/debuginfo.cmi \ + asmcomp/cmm.cmi asmcomp/arch.cmo asmcomp/printclambda.cmi : asmcomp/clambda.cmi asmcomp/printcmm.cmi : asmcomp/cmm.cmi asmcomp/printlinear.cmi : asmcomp/linearize.cmi asmcomp/printmach.cmi : asmcomp/reg.cmi asmcomp/mach.cmi asmcomp/proc.cmi : asmcomp/reg.cmi asmcomp/mach.cmi -asmcomp/reg.cmi : asmcomp/cmm.cmi +asmcomp/reg.cmi : typing/ident.cmi asmcomp/cmm.cmi asmcomp/reload.cmi : asmcomp/mach.cmi asmcomp/reloadgen.cmi : asmcomp/reg.cmi asmcomp/mach.cmi asmcomp/schedgen.cmi : asmcomp/mach.cmi asmcomp/linearize.cmi @@ -609,6 +616,7 @@ asmcomp/selectgen.cmi : utils/tbl.cmi asmcomp/reg.cmi asmcomp/mach.cmi \ 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/arch.cmo : asmcomp/arch.cmx : asmcomp/asmgen.cmo : bytecomp/translmod.cmi asmcomp/split.cmi \ @@ -664,29 +672,31 @@ asmcomp/clambda.cmo : bytecomp/lambda.cmi typing/ident.cmi \ asmcomp/clambda.cmx : bytecomp/lambda.cmx typing/ident.cmx \ asmcomp/debuginfo.cmx parsing/asttypes.cmi asmcomp/clambda.cmi asmcomp/closure.cmo : utils/tbl.cmi bytecomp/switch.cmi typing/primitive.cmi \ - utils/misc.cmi bytecomp/lambda.cmi typing/ident.cmi asmcomp/debuginfo.cmi \ - asmcomp/compilenv.cmi utils/clflags.cmi asmcomp/clambda.cmi \ - parsing/asttypes.cmi asmcomp/arch.cmo asmcomp/closure.cmi -asmcomp/closure.cmx : utils/tbl.cmx bytecomp/switch.cmx typing/primitive.cmx \ - utils/misc.cmx bytecomp/lambda.cmx typing/ident.cmx asmcomp/debuginfo.cmx \ - asmcomp/compilenv.cmx utils/clflags.cmx asmcomp/clambda.cmx \ - parsing/asttypes.cmi asmcomp/arch.cmx asmcomp/closure.cmi -asmcomp/cmm.cmo : typing/ident.cmi asmcomp/debuginfo.cmi asmcomp/arch.cmo \ - asmcomp/cmm.cmi -asmcomp/cmm.cmx : typing/ident.cmx asmcomp/debuginfo.cmx asmcomp/arch.cmx \ - asmcomp/cmm.cmi -asmcomp/cmmgen.cmo : typing/types.cmi bytecomp/switch.cmi asmcomp/proc.cmi \ - typing/primitive.cmi utils/misc.cmi bytecomp/lambda.cmi typing/ident.cmi \ - asmcomp/debuginfo.cmi utils/config.cmi asmcomp/compilenv.cmi \ - asmcomp/cmx_format.cmi asmcomp/cmm.cmi utils/clflags.cmi \ + utils/misc.cmi parsing/location.cmi bytecomp/lambda.cmi typing/ident.cmi \ + asmcomp/debuginfo.cmi asmcomp/compilenv.cmi utils/clflags.cmi \ asmcomp/clambda.cmi parsing/asttypes.cmi asmcomp/arch.cmo \ - asmcomp/cmmgen.cmi -asmcomp/cmmgen.cmx : typing/types.cmx bytecomp/switch.cmx asmcomp/proc.cmx \ - typing/primitive.cmx utils/misc.cmx bytecomp/lambda.cmx typing/ident.cmx \ - asmcomp/debuginfo.cmx utils/config.cmx asmcomp/compilenv.cmx \ - asmcomp/cmx_format.cmi asmcomp/cmm.cmx utils/clflags.cmx \ + asmcomp/closure.cmi +asmcomp/closure.cmx : utils/tbl.cmx bytecomp/switch.cmx typing/primitive.cmx \ + utils/misc.cmx parsing/location.cmx bytecomp/lambda.cmx typing/ident.cmx \ + asmcomp/debuginfo.cmx asmcomp/compilenv.cmx utils/clflags.cmx \ asmcomp/clambda.cmx parsing/asttypes.cmi asmcomp/arch.cmx \ - asmcomp/cmmgen.cmi + asmcomp/closure.cmi +asmcomp/cmm.cmo : bytecomp/lambda.cmi typing/ident.cmi asmcomp/debuginfo.cmi \ + asmcomp/arch.cmo asmcomp/cmm.cmi +asmcomp/cmm.cmx : bytecomp/lambda.cmx typing/ident.cmx asmcomp/debuginfo.cmx \ + asmcomp/arch.cmx asmcomp/cmm.cmi +asmcomp/cmmgen.cmo : typing/types.cmi bytecomp/switch.cmi \ + asmcomp/strmatch.cmi asmcomp/proc.cmi typing/primitive.cmi utils/misc.cmi \ + bytecomp/lambda.cmi typing/ident.cmi asmcomp/debuginfo.cmi \ + utils/config.cmi asmcomp/compilenv.cmi asmcomp/cmx_format.cmi \ + asmcomp/cmm.cmi utils/clflags.cmi asmcomp/clambda.cmi \ + parsing/asttypes.cmi asmcomp/arch.cmo asmcomp/cmmgen.cmi +asmcomp/cmmgen.cmx : typing/types.cmx bytecomp/switch.cmx \ + asmcomp/strmatch.cmx asmcomp/proc.cmx typing/primitive.cmx utils/misc.cmx \ + bytecomp/lambda.cmx typing/ident.cmx asmcomp/debuginfo.cmx \ + utils/config.cmx asmcomp/compilenv.cmx asmcomp/cmx_format.cmi \ + asmcomp/cmm.cmx utils/clflags.cmx asmcomp/clambda.cmx \ + parsing/asttypes.cmi asmcomp/arch.cmx asmcomp/cmmgen.cmi asmcomp/codegen.cmo : asmcomp/split.cmi asmcomp/spill.cmi asmcomp/reload.cmi \ asmcomp/reg.cmi asmcomp/printmach.cmi asmcomp/printlinear.cmi \ asmcomp/printcmm.cmi asmcomp/liveness.cmi asmcomp/linearize.cmi \ @@ -703,24 +713,26 @@ asmcomp/comballoc.cmo : asmcomp/reg.cmi asmcomp/mach.cmi utils/config.cmi \ asmcomp/arch.cmo asmcomp/comballoc.cmi asmcomp/comballoc.cmx : asmcomp/reg.cmx asmcomp/mach.cmx utils/config.cmx \ asmcomp/arch.cmx asmcomp/comballoc.cmi -asmcomp/compilenv.cmo : utils/misc.cmi parsing/location.cmi \ - bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi utils/config.cmi \ - asmcomp/cmx_format.cmi asmcomp/clambda.cmi asmcomp/compilenv.cmi -asmcomp/compilenv.cmx : utils/misc.cmx parsing/location.cmx \ - bytecomp/lambda.cmx typing/ident.cmx typing/env.cmx utils/config.cmx \ - asmcomp/cmx_format.cmi asmcomp/clambda.cmx asmcomp/compilenv.cmi +asmcomp/compilenv.cmo : utils/misc.cmi parsing/location.cmi typing/ident.cmi \ + typing/env.cmi utils/config.cmi asmcomp/cmx_format.cmi \ + asmcomp/clambda.cmi asmcomp/compilenv.cmi +asmcomp/compilenv.cmx : utils/misc.cmx parsing/location.cmx typing/ident.cmx \ + typing/env.cmx utils/config.cmx asmcomp/cmx_format.cmi \ + asmcomp/clambda.cmx asmcomp/compilenv.cmi asmcomp/debuginfo.cmo : parsing/location.cmi bytecomp/lambda.cmi \ asmcomp/debuginfo.cmi asmcomp/debuginfo.cmx : parsing/location.cmx bytecomp/lambda.cmx \ asmcomp/debuginfo.cmi asmcomp/emit.cmo : asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \ - asmcomp/mach.cmi asmcomp/linearize.cmi asmcomp/emitaux.cmi \ - asmcomp/debuginfo.cmi utils/config.cmi asmcomp/compilenv.cmi \ - asmcomp/cmm.cmi utils/clflags.cmi asmcomp/arch.cmo asmcomp/emit.cmi + asmcomp/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/emit.cmx : asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \ - asmcomp/mach.cmx asmcomp/linearize.cmx asmcomp/emitaux.cmx \ - asmcomp/debuginfo.cmx utils/config.cmx asmcomp/compilenv.cmx \ - asmcomp/cmm.cmx utils/clflags.cmx asmcomp/arch.cmx asmcomp/emit.cmi + asmcomp/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 \ @@ -730,49 +742,53 @@ asmcomp/interf.cmo : asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/mach.cmi \ asmcomp/interf.cmx : asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/mach.cmx \ asmcomp/interf.cmi asmcomp/linearize.cmo : asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \ - asmcomp/mach.cmi asmcomp/debuginfo.cmi asmcomp/cmm.cmi \ - asmcomp/linearize.cmi + asmcomp/mach.cmi bytecomp/lambda.cmi asmcomp/debuginfo.cmi \ + asmcomp/cmm.cmi asmcomp/linearize.cmi asmcomp/linearize.cmx : asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \ - asmcomp/mach.cmx asmcomp/debuginfo.cmx asmcomp/cmm.cmx \ - asmcomp/linearize.cmi + asmcomp/mach.cmx bytecomp/lambda.cmx asmcomp/debuginfo.cmx \ + asmcomp/cmm.cmx asmcomp/linearize.cmi asmcomp/liveness.cmo : asmcomp/reg.cmi asmcomp/proc.cmi \ asmcomp/printmach.cmi utils/misc.cmi asmcomp/mach.cmi \ asmcomp/liveness.cmi asmcomp/liveness.cmx : asmcomp/reg.cmx asmcomp/proc.cmx \ asmcomp/printmach.cmx utils/misc.cmx asmcomp/mach.cmx \ asmcomp/liveness.cmi -asmcomp/mach.cmo : asmcomp/reg.cmi asmcomp/debuginfo.cmi asmcomp/cmm.cmi \ - asmcomp/arch.cmo asmcomp/mach.cmi -asmcomp/mach.cmx : asmcomp/reg.cmx asmcomp/debuginfo.cmx asmcomp/cmm.cmx \ - asmcomp/arch.cmx asmcomp/mach.cmi +asmcomp/mach.cmo : asmcomp/reg.cmi bytecomp/lambda.cmi asmcomp/debuginfo.cmi \ + asmcomp/cmm.cmi asmcomp/arch.cmo asmcomp/mach.cmi +asmcomp/mach.cmx : asmcomp/reg.cmx bytecomp/lambda.cmx asmcomp/debuginfo.cmx \ + asmcomp/cmm.cmx asmcomp/arch.cmx asmcomp/mach.cmi asmcomp/printclambda.cmo : bytecomp/printlambda.cmi bytecomp/lambda.cmi \ typing/ident.cmi asmcomp/clambda.cmi parsing/asttypes.cmi \ asmcomp/printclambda.cmi asmcomp/printclambda.cmx : bytecomp/printlambda.cmx bytecomp/lambda.cmx \ typing/ident.cmx asmcomp/clambda.cmx parsing/asttypes.cmi \ asmcomp/printclambda.cmi -asmcomp/printcmm.cmo : typing/ident.cmi asmcomp/debuginfo.cmi \ - asmcomp/cmm.cmi asmcomp/printcmm.cmi -asmcomp/printcmm.cmx : typing/ident.cmx asmcomp/debuginfo.cmx \ - asmcomp/cmm.cmx asmcomp/printcmm.cmi +asmcomp/printcmm.cmo : bytecomp/lambda.cmi typing/ident.cmi \ + asmcomp/debuginfo.cmi asmcomp/cmm.cmi asmcomp/printcmm.cmi +asmcomp/printcmm.cmx : bytecomp/lambda.cmx typing/ident.cmx \ + asmcomp/debuginfo.cmx asmcomp/cmm.cmx asmcomp/printcmm.cmi asmcomp/printlinear.cmo : asmcomp/printmach.cmi asmcomp/mach.cmi \ - asmcomp/linearize.cmi asmcomp/debuginfo.cmi asmcomp/printlinear.cmi + asmcomp/linearize.cmi bytecomp/lambda.cmi asmcomp/debuginfo.cmi \ + asmcomp/printlinear.cmi asmcomp/printlinear.cmx : asmcomp/printmach.cmx asmcomp/mach.cmx \ - asmcomp/linearize.cmx asmcomp/debuginfo.cmx asmcomp/printlinear.cmi + asmcomp/linearize.cmx bytecomp/lambda.cmx asmcomp/debuginfo.cmx \ + asmcomp/printlinear.cmi asmcomp/printmach.cmo : asmcomp/reg.cmi asmcomp/proc.cmi \ - asmcomp/printcmm.cmi asmcomp/mach.cmi asmcomp/debuginfo.cmi \ - asmcomp/cmm.cmi asmcomp/arch.cmo asmcomp/printmach.cmi + asmcomp/printcmm.cmi asmcomp/mach.cmi bytecomp/lambda.cmi \ + asmcomp/debuginfo.cmi asmcomp/cmm.cmi asmcomp/arch.cmo \ + asmcomp/printmach.cmi asmcomp/printmach.cmx : asmcomp/reg.cmx asmcomp/proc.cmx \ - asmcomp/printcmm.cmx asmcomp/mach.cmx asmcomp/debuginfo.cmx \ - asmcomp/cmm.cmx asmcomp/arch.cmx asmcomp/printmach.cmi + asmcomp/printcmm.cmx asmcomp/mach.cmx bytecomp/lambda.cmx \ + asmcomp/debuginfo.cmx asmcomp/cmm.cmx asmcomp/arch.cmx \ + asmcomp/printmach.cmi asmcomp/proc.cmo : asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \ utils/config.cmi asmcomp/cmm.cmi utils/clflags.cmi utils/ccomp.cmi \ asmcomp/arch.cmo asmcomp/proc.cmi asmcomp/proc.cmx : asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \ utils/config.cmx asmcomp/cmm.cmx utils/clflags.cmx utils/ccomp.cmx \ asmcomp/arch.cmx asmcomp/proc.cmi -asmcomp/reg.cmo : asmcomp/cmm.cmi asmcomp/reg.cmi -asmcomp/reg.cmx : asmcomp/cmm.cmx asmcomp/reg.cmi +asmcomp/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 \ @@ -790,19 +806,19 @@ asmcomp/schedgen.cmx : asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/mach.cmx \ asmcomp/scheduling.cmo : asmcomp/schedgen.cmi asmcomp/scheduling.cmi asmcomp/scheduling.cmx : asmcomp/schedgen.cmx asmcomp/scheduling.cmi asmcomp/selectgen.cmo : utils/tbl.cmi bytecomp/simplif.cmi asmcomp/reg.cmi \ - asmcomp/proc.cmi utils/misc.cmi asmcomp/mach.cmi typing/ident.cmi \ - asmcomp/debuginfo.cmi asmcomp/cmm.cmi asmcomp/arch.cmo \ - asmcomp/selectgen.cmi + asmcomp/proc.cmi utils/misc.cmi asmcomp/mach.cmi bytecomp/lambda.cmi \ + typing/ident.cmi asmcomp/debuginfo.cmi asmcomp/cmm.cmi utils/clflags.cmi \ + asmcomp/arch.cmo asmcomp/selectgen.cmi asmcomp/selectgen.cmx : utils/tbl.cmx bytecomp/simplif.cmx asmcomp/reg.cmx \ - asmcomp/proc.cmx utils/misc.cmx asmcomp/mach.cmx typing/ident.cmx \ - asmcomp/debuginfo.cmx asmcomp/cmm.cmx asmcomp/arch.cmx \ - asmcomp/selectgen.cmi + asmcomp/proc.cmx utils/misc.cmx asmcomp/mach.cmx bytecomp/lambda.cmx \ + typing/ident.cmx asmcomp/debuginfo.cmx asmcomp/cmm.cmx utils/clflags.cmx \ + asmcomp/arch.cmx asmcomp/selectgen.cmi asmcomp/selection.cmo : asmcomp/selectgen.cmi asmcomp/proc.cmi \ - utils/misc.cmi asmcomp/mach.cmi asmcomp/cmm.cmi utils/clflags.cmi \ - asmcomp/arch.cmo asmcomp/selection.cmi + asmcomp/mach.cmi asmcomp/cmm.cmi utils/clflags.cmi asmcomp/arch.cmo \ + asmcomp/selection.cmi asmcomp/selection.cmx : asmcomp/selectgen.cmx asmcomp/proc.cmx \ - utils/misc.cmx asmcomp/mach.cmx asmcomp/cmm.cmx utils/clflags.cmx \ - asmcomp/arch.cmx asmcomp/selection.cmi + asmcomp/mach.cmx asmcomp/cmm.cmx utils/clflags.cmx asmcomp/arch.cmx \ + asmcomp/selection.cmi asmcomp/spill.cmo : asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \ asmcomp/mach.cmi asmcomp/spill.cmi asmcomp/spill.cmx : asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \ @@ -811,6 +827,10 @@ asmcomp/split.cmo : asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \ asmcomp/split.cmi asmcomp/split.cmx : asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \ asmcomp/split.cmi +asmcomp/strmatch.cmo : bytecomp/lambda.cmi typing/ident.cmi asmcomp/cmm.cmi \ + asmcomp/arch.cmo asmcomp/strmatch.cmi +asmcomp/strmatch.cmx : bytecomp/lambda.cmx typing/ident.cmx asmcomp/cmm.cmx \ + asmcomp/arch.cmx asmcomp/strmatch.cmi driver/compenv.cmi : driver/compile.cmi : driver/compmisc.cmi : typing/env.cmi @@ -5,13 +5,7 @@ expunge ocaml ocamlopt ocamlopt.opt +ocamlcomp.sh +ocamlcompopt.sh package-macosx -_boot_log1 -_boot_log2 -_build -_start -_buildtest -_log -myocamlbuild_config.ml -ocamlbuild-mixed-boot ocamlnat @@ -3,6 +3,14 @@ Next version: (Changes that can break existing programs are marked with a "*") +Language features: +- Attributes and extension nodes +- Generative functors +- Module aliases + +Build system for the OCaml distribution: +- Use -bin-annot when building. + Camlp4: - Removed from the official distribution @@ -13,11 +21,22 @@ Type system: * Keep typing of pattern cases independent in principal mode (i.e. information from previous cases is no longer used when typing patterns; cf. PR6235' in typing-warnings/records.ml) - -Language features: -- Attributes and extension nodes +- Allow opening a first-class module or applying a generative functor + in the body of a generative functor. Allow it also in the body of + an applicative functor if no types are created +* Module aliases are now typed in a specific way, which remembers their + identity. In particular this changes the signature inferred by + "module type of" +- PR#6331: Slight change in the criterion to distinguish private + abbreviations and private row types: create a private abbreviation for + closed objects and fixed polymorphic variants. +- PR#6333: Compare first class module types structurally rather than + nominally. Value subtyping allows module subtyping as long as the internal + representation is unchanged. Compilers: +- PR#6269 Optimization of string matching (patch by Benoit Vaugon + and Luc Maranget) - Experimental native code generator for AArch64 (ARM 64 bits) - Optimization of integer division and modulus by constant divisors (feature wish PR#6042) @@ -27,27 +46,46 @@ Compilers: - PR#5854: issue warning 3 when referring to a value marked with the [@@deprecated] attribute - PR#6203: Constant exception constructor no longer allocate +- PR#6311: Improve signature mismatch error messages +- PR#6345: Better compilation of optional arguments with default values +- PR#6260: Unnecessary boxing in let (patch by vbrankov) Runtime system: +- Fixed a major performance problem on large heaps (~1GB) by making heap + increments proportional to heap size - PR#4765: Structural equality should treat exception specifically - PR#5009: Extending exception tag blocks +Standard library: +- PR#4986: add List.sort_uniq and Set.of_list +- PR#5935: a faster version of "raise" which does not maintain the backtrace +- PR#6146: support "Unix.kill pid Sys.sigkill" under Windows +- PR#6148: speed improvement for Buffer (patch by John Whitington) +- PR#6180: efficient creation of uninitialized float arrays + +OCamldoc: +- PR#6257: handle full doc comments for variant constructors and + record fields +- PR#6310: fix ocamldoc's subscript/superscript CSS font size + (patch by Anil Madhavapeddy) + Bug fixes: - PR#4719: Sys.executable_name wrong if executable name contains dots (Windows) - PR#4855: 'camlp4 -I +dir' accepted, dir is relative to 'camlp4 -where' - PR#5201: ocamlbuild: add --norc to the bash invocation to help performances +- PR#5598: follow-up fix related to PR#6165 - PR#5820: Fix camlp4 lexer roll back problem - PR#6062: Fix a regression bug caused by commit 13047 - PR#6109: Typos in ocamlbuild error messages - PR#6116: more efficient implementation of Digest.to_hex (patch by ygrek) - PR#6174: OCaml compiler loops on an example using GADTs (-rectypes case) - -Standard library: -- PR#4986: add List.sort_uniq and Set.of_list -- PR#6148: speed improvement for Buffer (patch by John Whitington) -- PR#6146: support "Unix.kill pid Sys.sigkill" under Windows -- PR#6180: efficient creation of uninitialized float arrays -- PR#5935: a faster version of "raise" which does not maintain the backtrace +- PR#6184: ocamlbuild: `ocamlfind ocamldep` does not support -predicate + (report and patch by Jacques-Pascal Deplaix) +- PR#6262: equality of first-class modules take module aliases into account +- PR#6293: Assert_failure with invalid package type +- PR#6307: Behavior of 'module type of' w.r.t. module aliases +- fix -dsource printing of "external _pipe = ..." + (Gabriel Scherer) Features wishes: - PR#4243: make the Makefiles parallelizable @@ -55,20 +93,43 @@ Features wishes: hexa representations (patch by Zoe Paraskevopoulou) - PR#5547: Enable the "-use-ocamlfind" option by default - PR#5650: Camlp4FoldGenerator doesn't handle well "abstract" types +- PR#5808: allow simple patterns, not only identifiers, in "let p : t = ..." +- PR#6054: add support for M.[ foo ], M.[| foo |] etc. + (patch by Kaustuv Chaudhuri) +- PR#6064: GADT representation for Bigarray.kind + CAML_BA_CHAR runtime kind - PR#6071: Add a -noinit option to the toplevel (patch by David Sheets) - PR#6166: document -ocamldoc option of ocamlbuild - +- PR#6187: ocamlbuild: warn when using -plugin-tag(s) without myocamlbuild.ml + (patch by Jacques-Pascal Deplaix) +- PR#6246: allow wilcard _ as for-loop index +- ocamllex: user-definable refill action + (patch by Frédéric Bour, review by Gabriel Scherer and Luc Maranget) +- shorten syntax for functor signatures: "functor (M1:S1) (M2:S2) .. -> .." + (patches by Thomas Gazagnaire and Jeremy Yallop, review by Gabriel Scherer) OCaml 4.01.1: ------------- Bug fixes: +- PR#4855: 'camlp4 -I +dir' accepted, dir is related to 'camlp4 -where' +- PR#5820: Fix camlp4 lexer roll back problem +- PR#6062: Fix a regression bug caused by commit 13047 +- PR#6165: Alterations to handling of \013 in source files breaking other tools - PR#6173: Typing error message is worse that before - PR#6174: OCaml compiler loops on an example using GADTs (non -rectypes) +- PR#6175: Fix open! +- PR#6183: enhanced documentation for 'Unix.shutdown_connection' - PR#6216: inlining of GADT matches generates invalid assembly +- PR#6233: out-of-bounds exceptions lose their locations on ARM, PowerPC - PR#6235: Issue with type information flowing through a variant pattern +- PR#6239: sometimes wrong stack alignment when raising exceptions + in -g mode with backtraces active - PR#6240: Fail to expand module type abbreviation during substyping - PR#6241: Assumed inequality between paths involving functor arguments +- PR#6243: Make "ocamlopt -g" more resistant to ill-formed locations +- PR#6267: more information printed by "bt" command of ocamldebug +- PR#6275: Soundness bug related to type constraints + OCaml 4.01.0: ------------- @@ -141,6 +202,9 @@ Standard library: (Xavier Leroy) - infix application operators |> and @@ in Pervasives (Fabrice Le Fessant) +- PR#6176: new Format.asprintf function with a %a formatter + compatible with Format.fprintf (unlike Format.sprintf) + (Pierre Weis) Other libraries: - PR#5568: add O_CLOEXEC flag to Unix.openfile, so that the returned @@ -19,7 +19,7 @@ PREREQUISITES make is not GNU make, you need to define the GNUMAKE environment variable to the name of GNU make, typically with this command: - export GNUMAKE=gnumake + export GNUMAKE=gmake INSTALLATION INSTRUCTIONS @@ -317,6 +317,9 @@ Fix: do not pass the -j option to make, and be patient. * The Makefiles use the "include" directive, which is not supported by all versions of make. Use GNU make if this is a problem. +* Solaris make mishandles a space in our Makefiles, so you have to use GNU +make to build on Solaris. + * The Makefiles assume that make executes commands by calling /bin/sh. They won't work if /bin/csh is called instead. You may have to unset the SHELL environment variable, or set it to /bin/sh. @@ -16,22 +16,21 @@ include config/Makefile include stdlib/StdlibModules CAMLC=boot/ocamlrun boot/ocamlc -nostdlib -I boot -CAMLOPT=$(CAMLOPT_BIN) -nostdlib -I stdlib -I otherlibs/dynlink -COMPFLAGS=-strict-sequence -w +33..39 -warn-error A $(INCLUDES) +CAMLOPT=boot/ocamlrun ./ocamlopt -nostdlib -I stdlib -I otherlibs/dynlink +COMPFLAGS=-strict-sequence -w +33..39+48 -warn-error A -bin-annot $(INCLUDES) LINKFLAGS= -SWITCH_COMPILER=cd $(ROOTDIR)/config && $(MAKE) -f Makefile.switch-compiler CAMLYACC=boot/ocamlyacc YACCFLAGS=-v CAMLLEX=boot/ocamlrun boot/ocamllex CAMLDEP=boot/ocamlrun tools/ocamldep DEPFLAGS=$(INCLUDES) +CAMLRUN=byterun/ocamlrun SHELL=/bin/sh MKDIR=mkdir -p OCAMLBUILDBYTE=$(WITH_OCAMLBUILD:=.byte) OCAMLBUILDNATIVE=$(WITH_OCAMLBUILD:=.native) -OCAMLBUILDLIBNATIVE=$(WITH_OCAMLBUILD:=lib.native) OCAMLDOC_OPT=$(WITH_OCAMLDOC:=.opt) @@ -57,8 +56,8 @@ TYPING=typing/ident.cmo typing/path.cmo \ typing/typedtree.cmo typing/printtyped.cmo typing/ctype.cmo \ typing/printtyp.cmo typing/includeclass.cmo \ typing/mtype.cmo typing/envaux.cmo typing/includecore.cmo \ - typing/includemod.cmo typing/typetexp.cmo typing/parmatch.cmo \ typing/typedtreeIter.cmo typing/typedtreeMap.cmo typing/cmt_format.cmo \ + typing/includemod.cmo typing/typetexp.cmo typing/parmatch.cmo \ typing/stypes.cmo typing/typecore.cmo \ typing/typedecl.cmo typing/typeclass.cmo \ typing/typemod.cmo @@ -83,7 +82,7 @@ ASMCOMP=asmcomp/arch.cmo asmcomp/debuginfo.cmo \ asmcomp/cmm.cmo asmcomp/printcmm.cmo \ asmcomp/reg.cmo asmcomp/mach.cmo asmcomp/proc.cmo \ asmcomp/clambda.cmo asmcomp/printclambda.cmo asmcomp/compilenv.cmo \ - asmcomp/closure.cmo asmcomp/cmmgen.cmo \ + asmcomp/closure.cmo asmcomp/strmatch.cmo asmcomp/cmmgen.cmo \ asmcomp/printmach.cmo asmcomp/selectgen.cmo asmcomp/selection.cmo \ asmcomp/comballoc.cmo asmcomp/liveness.cmo \ asmcomp/spill.cmo asmcomp/split.cmo \ @@ -189,7 +188,7 @@ coldstart: cp byterun/ocamlrun$(EXE) boot/ocamlrun$(EXE) cd yacc; $(MAKE) all cp yacc/ocamlyacc$(EXE) boot/ocamlyacc$(EXE) - cd stdlib; $(MAKE) all CAMLC="../boot/ocamlrun ../boot/ocamlc -nostdlib -I ../boot" + cd stdlib; $(MAKE) COMPILER=../boot/ocamlc all cd stdlib; cp $(LIBFILES) ../boot if test -f boot/libcamlrun.a; then :; else \ ln -s ../byterun/libcamlrun.a boot/libcamlrun.a; fi @@ -324,12 +323,12 @@ install: (cd otherlibs/$$i; $(MAKE) install) || exit $$?; \ done if test -n "$(WITH_OCAMLDOC)"; then (cd ocamldoc; $(MAKE) install); else :; fi - if test -f ocamlopt; then $(MAKE) installopt; else :; fi - if test -n "$(WITH_OCAMLDEBUG)"; then (cd debugger; $(MAKE) install); \ + if test -n "$(WITH_DEBUGGER)"; then (cd debugger; $(MAKE) install); \ + else :; fi + if test -n "$(WITH_OCAMLBUILD)"; then (cd ocamlbuild; $(MAKE) install); \ else :; fi cp config/Makefile $(LIBDIR)/Makefile.config - BINDIR=$(BINDIR) LIBDIR=$(LIBDIR) PREFIX=$(PREFIX) \ - ./build/partial-install.sh + if test -f ocamlopt; then $(MAKE) installopt; else :; fi # Installation of the native-code compiler installopt: @@ -340,6 +339,8 @@ installopt: cp compilerlibs/ocamloptcomp.cma $(OPTSTART) $(COMPLIBDIR) if test -n "$(WITH_OCAMLDOC)"; then (cd ocamldoc; $(MAKE) installopt); \ else :; fi + if test -n "$(WITH_OCAMLBUILD)"; then (cd ocamlbuild; $(MAKE) installopt); \ + else :; fi for i in $(OTHERLIBRARIES); \ do (cd otherlibs/$$i; $(MAKE) installopt) || exit $$?; done if test -f ocamlopt.opt ; then $(MAKE) installoptopt; fi @@ -377,13 +378,9 @@ partialclean:: ocamlc: compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma $(BYTESTART) $(CAMLC) $(LINKFLAGS) -compat-32 -o ocamlc \ compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma $(BYTESTART) - $(SWITCH_COMPILER) enable COMPILER=CAMLC VARIANT=BYTE - $(SWITCH_COMPILER) disable COMPILER=CAMLC VARIANT=OPT - -partialclean:: - if [ -n "$(ROOTDIR)" ]; then \ - $(SWITCH_COMPILER) disable COMPILER=CAMLC VARIANT=BYTE ; \ - fi + @sed -e 's|@compiler@|$$topdir/boot/ocamlrun $$topdir/ocamlc|' \ + driver/ocamlcomp.sh.in > ocamlcomp.sh + @chmod +x ocamlcomp.sh # The native-code compiler @@ -395,14 +392,12 @@ partialclean:: ocamlopt: compilerlibs/ocamlcommon.cma compilerlibs/ocamloptcomp.cma $(OPTSTART) $(CAMLC) $(LINKFLAGS) -o ocamlopt \ compilerlibs/ocamlcommon.cma compilerlibs/ocamloptcomp.cma $(OPTSTART) - $(SWITCH_COMPILER) enable COMPILER=CAMLOPT VARIANT=BYTE - $(SWITCH_COMPILER) disable COMPILER=CAMLOPT VARIANT=OPT + @sed -e 's|@compiler@|$$topdir/boot/ocamlrun $$topdir/ocamlopt|' \ + driver/ocamlcomp.sh.in > ocamlcompopt.sh + @chmod +x ocamlcompopt.sh partialclean:: - rm -f ocamlopt - if [ -n "$(ROOTDIR)" ]; then \ - $(SWITCH_COMPILER) disable COMPILER=CAMLOPT VARIANT=BYTE ; \ - fi + rm -f ocamlopt ocamlcompopt.sh # The toplevel @@ -511,13 +506,12 @@ ocamlc.opt: compilerlibs/ocamlcommon.cmxa compilerlibs/ocamlbytecomp.cmxa \ $(CAMLOPT) $(LINKFLAGS) -ccopt "$(BYTECCLINKOPTS)" -o ocamlc.opt \ compilerlibs/ocamlcommon.cmxa compilerlibs/ocamlbytecomp.cmxa \ $(BYTESTART:.cmo=.cmx) -cclib "$(BYTECCLIBS)" - $(SWITCH_COMPILER) enable COMPILER=CAMLC VARIANT=OPT + @sed -e 's|@compiler@|$$topdir/ocamlc.opt|' \ + driver/ocamlcomp.sh.in > ocamlcomp.sh + @chmod +x ocamlcomp.sh partialclean:: rm -f ocamlc.opt - if [ -n "$(ROOTDIR)" ]; then \ - $(SWITCH_COMPILER) disable COMPILER=CAMLC VARIANT=OPT ; \ - fi # The native-code compiler compiled with itself @@ -531,13 +525,12 @@ ocamlopt.opt: compilerlibs/ocamlcommon.cmxa compilerlibs/ocamloptcomp.cmxa \ $(CAMLOPT) $(LINKFLAGS) -o ocamlopt.opt \ compilerlibs/ocamlcommon.cmxa compilerlibs/ocamloptcomp.cmxa \ $(OPTSTART:.cmo=.cmx) - $(SWITCH_COMPILER) enable COMPILER=CAMLOPT VARIANT=OPT + @sed -e 's|@compiler@|$$topdir/ocamlopt.opt|' \ + driver/ocamlcomp.sh.in > ocamlcompopt.sh + @chmod +x ocamlcompopt.sh partialclean:: rm -f ocamlopt.opt - if [ -n "$(ROOTDIR)" ]; then \ - $(SWITCH_COMPILER) disable COMPILER=CAMLOPT VARIANT=OPT ; \ - fi $(COMMON:.cmo=.cmx) $(BYTECOMP:.cmo=.cmx) $(ASMCOMP:.cmo=.cmx): ocamlopt @@ -625,7 +618,8 @@ partialclean:: beforedepend:: asmcomp/emit.ml tools/cvt_emit: tools/cvt_emit.mll - cd tools; $(MAKE) cvt_emit + cd tools; \ + $(MAKE) CAMLC="../$(CAMLRUN) ../boot/ocamlc -I ../stdlib" cvt_emit # The "expunge" utility @@ -706,13 +700,13 @@ clean:: # Tools -ocamltools: ocamlc ocamlyacc ocamllex asmcomp/cmx_format.cmi +ocamltools: ocamlc ocamlyacc ocamllex asmcomp/cmx_format.cmi asmcomp/printclambda.cmo cd tools; $(MAKE) all ocamltoolsopt: ocamlopt cd tools; $(MAKE) opt -ocamltoolsopt.opt: ocamlc.opt ocamlyacc ocamllex asmcomp/cmx_format.cmi +ocamltoolsopt.opt: ocamlc.opt ocamlyacc ocamllex asmcomp/cmx_format.cmi asmcomp/printclambda.cmx cd tools; $(MAKE) opt.opt partialclean:: @@ -770,30 +764,24 @@ alldepend:: cd debugger; $(MAKE) depend # Ocamlbuild -#ifeq ($(OCAMLBUILD_NOBOOT),"yes") -#ocamlbuild.byte: ocamlc -# $(MAKE) -C ocamlbuild -f Makefile.noboot -#else -ocamlbuild.byte: ocamlc ocamlbuild-mixed-boot - ./build/ocamlbuild-byte-only.sh -#endif - -ocamlbuild.native: ocamlopt ocamlbuild-mixed-boot otherlibrariesopt - ./build/ocamlbuild-native-only.sh -ocamlbuildlib.native: ocamlopt ocamlbuild-mixed-boot otherlibrariesopt - ./build/ocamlbuildlib-native-only.sh - -ocamlbuild-mixed-boot: ocamlc - ./build/mixed-boot.sh - touch ocamlbuild-mixed-boot + +ocamlbuild.byte: ocamlc otherlibraries + cd ocamlbuild && $(MAKE) all + +ocamlbuild.native: ocamlopt otherlibrariesopt + cd ocamlbuild && $(MAKE) allopt partialclean:: - rm -rf _build ocamlbuild-mixed-boot + cd ocamlbuild && $(MAKE) clean + +alldepend:: + cd ocamlbuild && $(MAKE) depend # Check that the stack limit is reasonable. checkstack: - @if $(BYTECC) -o tools/checkstack tools/checkstack.c; \ + @if $(BYTECC) $(BYTECCCOMPOPTS) $(BYTECCLINKOPTS) \ + -o tools/checkstack tools/checkstack.c; \ then tools/checkstack; \ else :; \ fi @@ -841,8 +829,13 @@ depend: beforedepend alldepend:: depend distclean: - ./build/distclean.sh - rm -f ocaml testsuite/_log + $(MAKE) clean + 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 + rm -f tools/*.bak tools/ocamlmklibconfig.ml + rm -f ocaml ocamlc ocamlcomp.sh + rm -f testsuite/_log .PHONY: all backup bootstrap checkstack clean .PHONY: partialclean beforedepend alldepend cleanboot coldstart diff --git a/Makefile.nt b/Makefile.nt index 8fd4547813..68a7e1d4d3 100644 --- a/Makefile.nt +++ b/Makefile.nt @@ -16,16 +16,15 @@ include config/Makefile include stdlib/StdlibModules CAMLC=boot/ocamlrun boot/ocamlc -nostdlib -I boot -CAMLOPT=$(CAMLOPT_BIN) -nostdlib -I stdlib -I otherlibs/dynlink -COMPFLAGS=-strict-sequence -warn-error A $(INCLUDES) +CAMLOPT=boot/ocamlrun ./ocamlopt -nostdlib -I stdlib -I otherlibs/dynlink +COMPFLAGS=-strict-sequence -w +33..39+48 -warn-error A -bin-annot $(INCLUDES) LINKFLAGS= -SWITCH_COMPILER=make -C $(ROOTDIR)/config -f Makefile.switch-compiler - CAMLYACC=boot/ocamlyacc YACCFLAGS= CAMLLEX=boot/ocamlrun boot/ocamllex CAMLDEP=boot/ocamlrun tools/ocamldep DEPFLAGS=$(INCLUDES) +CAMLRUN=byterun/ocamlrun OCAMLBUILDBYTE=$(WITH_OCAMLBUILD:=.byte) OCAMLBUILDNATIVE=$(WITH_OCAMLBUILD:=.native) @@ -54,8 +53,8 @@ TYPING=typing/ident.cmo typing/path.cmo \ typing/typedtree.cmo typing/printtyped.cmo typing/ctype.cmo \ typing/printtyp.cmo typing/includeclass.cmo \ typing/mtype.cmo typing/envaux.cmo typing/includecore.cmo \ - typing/includemod.cmo typing/typetexp.cmo typing/parmatch.cmo \ typing/typedtreeIter.cmo typing/typedtreeMap.cmo typing/cmt_format.cmo \ + typing/includemod.cmo typing/typetexp.cmo typing/parmatch.cmo \ typing/stypes.cmo typing/typecore.cmo \ typing/typedecl.cmo typing/typeclass.cmo \ typing/typemod.cmo @@ -80,7 +79,7 @@ ASMCOMP=asmcomp/arch.cmo asmcomp/debuginfo.cmo \ asmcomp/cmm.cmo asmcomp/printcmm.cmo \ asmcomp/reg.cmo asmcomp/mach.cmo asmcomp/proc.cmo \ asmcomp/clambda.cmo asmcomp/printclambda.cmo asmcomp/compilenv.cmo \ - asmcomp/closure.cmo asmcomp/cmmgen.cmo \ + asmcomp/closure.cmo asmcomp/strmatch.cmo asmcomp/cmmgen.cmo \ asmcomp/printmach.cmo asmcomp/selectgen.cmo asmcomp/selection.cmo \ asmcomp/comballoc.cmo asmcomp/liveness.cmo \ asmcomp/spill.cmo asmcomp/split.cmo \ @@ -142,15 +141,11 @@ LIBFILES=stdlib.cma std_exit.cmo *.cmi camlheader # Start up the system from the distribution compiler coldstart: - $(SWITCH_COMPILER) disable COMPILER=CAMLC VARIANT=BYTE - $(SWITCH_COMPILER) disable COMPILER=CAMLC VARIANT=OPT - $(SWITCH_COMPILER) disable COMPILER=CAMLOPT VARIANT=BYTE - $(SWITCH_COMPILER) disable COMPILER=CAMLOPT VARIANT=OPT cd byterun ; $(MAKEREC) all cp byterun/ocamlrun.exe boot/ocamlrun.exe cd yacc ; $(MAKEREC) all cp yacc/ocamlyacc.exe boot/ocamlyacc.exe - cd stdlib ; $(MAKEREC) all CAMLC="../boot/ocamlrun ../boot/ocamlc -nostdlib -I ../boot" + cd stdlib ; $(MAKEREC) COMPILER=../boot/ocamlc all cd stdlib ; cp $(LIBFILES) ../boot # Build the core system: the minimum needed to make depend and bootstrap @@ -207,8 +202,6 @@ opt-core: opt: $(MAKE) -f Makefile.nt opt-core $(MAKE) -f Makefile.nt otherlibrariesopt - if test -n "$(WITH_OCAMLBUILD)"; then \ - $(MAKE) -f Makefile.nt ocamlbuildlib.native; else :; fi # Native-code versions of the tools opt.opt: core opt-core ocamlc.opt all ocamlopt.opt ocamllex.opt \ @@ -245,9 +238,10 @@ installbyt: else :; fi mkdir -p $(STUBLIBDIR) for i in $(OTHERLIBRARIES); do $(MAKEREC) -C otherlibs/$$i install; done - if test -n "$(WITH_OCAMLDEBUG)"; then (cd debugger; $(MAKEREC) install); \ + if test -n "$(WITH_DEBUGGER)"; then (cd debugger; $(MAKEREC) install); \ + else :; fi + if test -n "$(WITH_OCAMLBUILD)"; then (cd ocamlbuild; $(MAKE) install); \ else :; fi - ./build/partial-install.sh cp config/Makefile $(LIBDIR)/Makefile.config cp README $(DISTRIB)/Readme.general.txt cp README.win32 $(DISTRIB)/Readme.windows.txt @@ -262,6 +256,8 @@ installopt: cp asmcomp/*.cmi driver/*.cmi $(COMPLIBDIR) cp compilerlibs/ocamloptcomp.cma $(OPTSTART) $(COMPLIBDIR) 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 if test -f ocamlopt.opt ; then $(MAKEREC) installoptopt; fi @@ -295,12 +291,12 @@ partialclean:: ocamlc: compilerlibs/ocamlcommon.cma compilerlibs/ocamlbytecomp.cma $(BYTESTART) $(CAMLC) $(LINKFLAGS) -compat-32 -o ocamlc compilerlibs/ocamlcommon.cma \ compilerlibs/ocamlbytecomp.cma $(BYTESTART) - $(SWITCH_COMPILER) enable COMPILER=CAMLC VARIANT=BYTE - $(SWITCH_COMPILER) disable COMPILER=CAMLC VARIANT=OPT + @sed -e 's|@compiler@|$$topdir/boot/ocamlrun $$topdir/ocamlc|' \ + driver/ocamlcomp.sh.in > ocamlcomp.sh + @chmod +x ocamlcomp.sh partialclean:: - rm -f ocamlc - $(SWITCH_COMPILER) disable COMPILER=CAMLC VARIANT=BYTE + rm -f ocamlc ocamlcomp.sh # The native-code compiler @@ -312,12 +308,12 @@ partialclean:: ocamlopt: compilerlibs/ocamlcommon.cma compilerlibs/ocamloptcomp.cma $(OPTSTART) $(CAMLC) $(LINKFLAGS) -o ocamlopt \ compilerlibs/ocamlcommon.cma compilerlibs/ocamloptcomp.cma $(OPTSTART) - $(SWITCH_COMPILER) enable COMPILER=CAMLOPT VARIANT=BYTE - $(SWITCH_COMPILER) disable COMPILER=CAMLOPT VARIANT=OPT + @sed -e 's|@compiler@|$$topdir/boot/ocamlrun $$topdir/ocamlopt|' \ + driver/ocamlcomp.sh.in > ocamlcompopt.sh + @chmod +x ocamlcompopt.sh partialclean:: - rm -f ocamlopt - $(SWITCH_COMPILER) disable COMPILER=CAMLOPT VARIANT=BYTE + rm -f ocamlopt ocamlcompopt.sh # The toplevel @@ -430,11 +426,12 @@ ocamlc.opt: compilerlibs/ocamlcommon.cmxa compilerlibs/ocamlbytecomp.cmxa \ $(CAMLOPT) $(LINKFLAGS) -ccopt "$(BYTECCLINKOPTS)" -o ocamlc.opt \ compilerlibs/ocamlcommon.cmxa compilerlibs/ocamlbytecomp.cmxa \ $(BYTESTART:.cmo=.cmx) -cclib "$(BYTECCLIBS)" - $(SWITCH_COMPILER) enable COMPILER=CAMLC VARIANT=OPT + @sed -e 's|@compiler@|$$topdir/ocamlc.opt|' \ + driver/ocamlcomp.sh.in > ocamlcomp.sh + @chmod +x ocamlcomp.sh partialclean:: rm -f ocamlc.opt - $(SWITCH_COMPILER) disable COMPILER=CAMLC VARIANT=OPT # The native-code compiler compiled with itself @@ -448,11 +445,12 @@ ocamlopt.opt: compilerlibs/ocamlcommon.cmxa compilerlibs/ocamloptcomp.cmxa \ $(CAMLOPT) $(LINKFLAGS) -o ocamlopt.opt \ compilerlibs/ocamlcommon.cmxa compilerlibs/ocamloptcomp.cmxa \ $(OPTSTART:.cmo=.cmx) - $(SWITCH_COMPILER) enable COMPILER=CAMLOPT VARIANT=OPT + @sed -e 's|@compiler@|$$topdir/ocamlopt.opt|' \ + driver/ocamlcomp.sh.in > ocamlcompopt.sh + @chmod +x ocamlcompopt.sh partialclean:: rm -f ocamlopt.opt - $(SWITCH_COMPILER) disable COMPILER=CAMLOPT VARIANT=OPT $(COMMON:.cmo=.cmx) $(BYTECOMP:.cmo=.cmx) $(ASMCOMP:.cmo=.cmx): ocamlopt @@ -616,9 +614,9 @@ clean:: # Tools -ocamltools: asmcomp/cmx_format.cmi +ocamltools: ocamlc ocamlyacc ocamllex asmcomp/cmx_format.cmi asmcomp/printclambda.cmo cd tools ; $(MAKEREC) all -ocamltoolsopt.opt: asmcomp/cmx_format.cmi +ocamltoolsopt.opt: ocamlc.opt ocamlyacc ocamllex asmcomp/cmx_format.cmi asmcomp/printclambda.cmx cd tools ; $(MAKEREC) opt.opt partialclean:: cd tools ; $(MAKEREC) clean @@ -660,19 +658,17 @@ alldepend:: # Ocamlbuild -ocamlbuild.byte: ocamlc otherlibraries ocamlbuild-mixed-boot - ./build/ocamlbuild-byte-only.sh -ocamlbuild.native: ocamlopt otherlibrariesopt ocamlbuild-mixed-boot - ./build/ocamlbuild-native-only.sh -ocamlbuildlib.native: ocamlopt otherlibrariesopt ocamlbuild-mixed-boot - ./build/ocamlbuildlib-native-only.sh +ocamlbuild.byte: ocamlc otherlibraries + cd ocamlbuild && $(MAKE) all +ocamlbuild.native: ocamlopt otherlibrariesopt + cd ocamlbuild && $(MAKE) allopt -.PHONY: ocamlbuild-mixed-boot -ocamlbuild-mixed-boot: - ./build/mixed-boot.sh partialclean:: - rm -rf _build + cd ocamlbuild && $(MAKE) clean + +alldepend:: + cd ocamlbuild && $(MAKE) depend # Make clean in the test suite @@ -1,4 +1,4 @@ -4.02.0+dev2-2013-09-12 +4.02.0+dev3-2013-12-19 # The version string is the first line of this file. # It must be in the format described in stdlib/sys.mli diff --git a/_tags b/_tags deleted file mode 100644 index 558a81f868..0000000000 --- a/_tags +++ /dev/null @@ -1,82 +0,0 @@ -######################################################################### -# # -# OCaml # -# # -# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # -# # -# Copyright 2007 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### - -# Ocamlbuild tags file - -true: -traverse - -# Traverse only these directories -<{bytecomp,driver,stdlib,tools,asmcomp,ocamlbuild,toplevel,ocamldoc,typing,otherlibs,utils,debugger,lex,parsing,byterun,asmrun}/**>: traverse - -"ocamlbuild/test" or "ocamlbuild/testsuite": -traverse - -"boot" or "byterun" or "asmrun" or "compilerlibs": not_hygienic - -# These should not be required but it fails on *BSD and Windows... -"yacc" or "win32caml": not_hygienic - -# We want -g everywhere it's possible -true: debug - -# By default everything we link needs the stdlib -true: use_stdlib - -# The stdlib neither requires the stdlib nor debug information -<stdlib/**>: -use_stdlib, -debug - -<**/*.ml*>: warn_error_A - -<{bytecomp,driver,stdlib,tools,asmcomp,toplevel,typing,utils,lex,parsing}/**>: strict_sequence - -"toplevel/topstart.byte": linkall - -<ocamldoc/**>: -debug -<ocamldoc/*.ml>: ocamldoc_sources -<ocamldoc/*.ml*>: include_unix, include_str, include_dynlink -<ocamldoc/odoc.{byte,native}>: use_unix, use_str, use_dynlink - -<ocamlbuild/*>: include_unix - -<**/pervasives.ml> or <**/pervasives.mli> or <**/camlinternalOO.mli>: nopervasives -<**/camlinternalOO*.cmx>: inline(0) -<**/scanf*.cmx>: inline(9) -<**/*Labels.ml*>: nolabels - -"tools/addlabels.ml": warn_s - -<debugger/main.byte> or <debugger/main.native>: use_unix, linkall -<debugger/*.ml*>: include_unix - -<otherlibs/{,win32}unix/unix.cm{,x}a> or <otherlibs/str/str.cm{,x}a>: ocamlmklib -<otherlibs/num/nums.cm{,x}a> or <otherlibs/dbm/dbm.cm{,x}a>: ocamlmklib -<otherlibs/{,win32}graph/graphics.cm{,x}a>: ocamlmklib -<otherlibs/threads/threads.cm{,x}a>: ocamlmklib -"otherlibs/threads/unix.cma": ocamlmklib -<otherlibs/bigarray/bigarray.cm{,x}a>: ocamlmklib - -<otherlibs/{bigarray,systhreads}/**.ml*>: include_unix - -# See the remark about static linking of threads.cmxa in myocamlbuild.ml -<otherlibs/systhreads/threads.cma>: ocamlmklib - -"otherlibs/threads/pervasives.ml": include_unix - -<otherlibs/**>: otherlibs -<otherlibs/{,win32}unix/**>: otherlibs_unix -<otherlibs/win32unix/**>: otherlibs_win32unix -<otherlibs/bigarray/**>: otherlibs_bigarray -<otherlibs/num/**>: otherlibs_num -<otherlibs/threads/**>: otherlibs_threads -"otherlibs/threads/unix.cma": -otherlibs_threads -<otherlibs/systhreads/**>: otherlibs_systhreads -<otherlibs/graph/**>: otherlibs_graph -<otherlibs/win32graph/**>: otherlibs_win32graph diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp index 674ed2adb2..bdcc3a18d3 100644 --- a/asmcomp/amd64/emit.mlp +++ b/asmcomp/amd64/emit.mlp @@ -22,6 +22,7 @@ open Emitaux let macosx = (Config.system = "macosx") let mingw64 = (Config.system = "mingw64") +let cygwin = (Config.system = "cygwin") let fp = Config.with_frame_pointers @@ -61,17 +62,17 @@ let emit_symbol s = Emitaux.emit_symbol '$' s let emit_call s = - if !Clflags.dlcode && not macosx && not mingw64 + if !Clflags.dlcode && not macosx && not mingw64 && not cygwin then `call {emit_symbol s}@PLT` else `call {emit_symbol s}` let emit_jump s = - if !Clflags.dlcode && not macosx && not mingw64 + if !Clflags.dlcode && not macosx && not mingw64 && not cygwin then `jmp {emit_symbol s}@PLT` else `jmp {emit_symbol s}` let load_symbol_addr s = - if !Clflags.dlcode && not mingw64 + if !Clflags.dlcode && not mingw64 && not cygwin then `movq {emit_symbol s}@GOTPCREL(%rip)` else if !pic_code then `leaq {emit_symbol s}(%rip)` @@ -372,7 +373,7 @@ let emit_instr fallthrough i = | _ -> ` movq {emit_reg src}, {emit_reg dst}\n` end - | Lop(Iconst_int n) -> + | Lop(Iconst_int n | Iconst_blockheader n) -> if n = 0n then begin match i.res.(0).loc with Reg n -> ` xorq {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n` @@ -636,7 +637,7 @@ let emit_instr fallthrough i = ` jmp *{emit_reg tmp1}\n`; if macosx then ` .const\n` - else if mingw64 then + else if mingw64 || cygwin then ` .section .rdata,\"dr\"\n` else ` .section .rodata\n`; @@ -790,7 +791,7 @@ let begin_assembly() = (* from amd64.S; could emit these constants on demand *) if macosx then ` .literal16\n` - else if mingw64 then + else if mingw64 || cygwin then ` .section .rdata,\"dr\"\n` else ` .section .rodata.cst8,\"a\",@progbits\n`; @@ -813,7 +814,7 @@ let end_assembly() = if !float_constants <> [] then begin if macosx then ` .literal8\n` - else if mingw64 then + else if mingw64 || cygwin then ` .section .rdata,\"dr\"\n` else ` .section .rodata.cst8,\"a\",@progbits\n`; diff --git a/asmcomp/amd64/emit_nt.mlp b/asmcomp/amd64/emit_nt.mlp index cb023bb8c0..77156b8f01 100644 --- a/asmcomp/amd64/emit_nt.mlp +++ b/asmcomp/amd64/emit_nt.mlp @@ -15,7 +15,6 @@ module StringSet = Set.Make(struct type t = string let compare (x:t) y = compare x y end) -open Misc open Cmm open Arch open Proc @@ -378,7 +377,7 @@ let emit_instr fallthrough i = | _ -> ` mov {emit_reg dst}, {emit_reg src}\n` end - | Lop(Iconst_int n) -> + | Lop(Iconst_int n | Iconst_blockheader n) -> if n = 0n then begin match i.res.(0).loc with Reg n -> ` xor {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n` diff --git a/asmcomp/amd64/proc.ml b/asmcomp/amd64/proc.ml index ddec43db79..b6e0fa94ab 100644 --- a/asmcomp/amd64/proc.ml +++ b/asmcomp/amd64/proc.ml @@ -24,7 +24,7 @@ let fp = Config.with_frame_pointers let win64 = match Config.system with - | "win64" | "mingw64" -> true + | "win64" | "mingw64" | "cygwin" -> true | _ -> false (* Which asm conventions to use *) diff --git a/asmcomp/amd64/reload.ml b/asmcomp/amd64/reload.ml index a7cb86028b..49070d299f 100644 --- a/asmcomp/amd64/reload.ml +++ b/asmcomp/amd64/reload.ml @@ -22,7 +22,8 @@ open Mach Operation Res Arg1 Arg2 Imove R S or S R - Iconst_int S if 32-bit signed, R otherwise + Iconst_int ] S if 32-bit signed, R otherwise + Iconst_blockheader ] Iconst_float R Iconst_symbol (not PIC) S Iconst_symbol (PIC) R @@ -87,7 +88,7 @@ method! reload_operation op arg res = | Ifloatofint | Iintoffloat -> (* Result must be in register, but argument can be on stack *) (arg, (if stackp res.(0) then [| self#makereg res.(0) |] else res)) - | Iconst_int n -> + | Iconst_int n | Iconst_blockheader n -> if n <= 0x7FFFFFFFn && n >= -0x80000000n then (arg, res) else super#reload_operation op arg res diff --git a/asmcomp/arm/emit.mlp b/asmcomp/arm/emit.mlp index 55a8f96b06..2f20ecf61a 100644 --- a/asmcomp/arm/emit.mlp +++ b/asmcomp/arm/emit.mlp @@ -387,7 +387,7 @@ let emit_instr i = ` ldr {emit_reg dst}, {emit_stack src}\n` end; 1 end - | Lop(Iconst_int n) -> + | Lop(Iconst_int n | Iconst_blockheader n) -> emit_intconst i.res.(0) (Nativeint.to_int32 n) | Lop(Iconst_float f) when !fpu = Soft -> ` @ {emit_string f}\n`; diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp index bc03c5d521..274e6ffcaf 100644 --- a/asmcomp/arm64/emit.mlp +++ b/asmcomp/arm64/emit.mlp @@ -323,7 +323,7 @@ let emit_instr i = | _ -> assert false end - | Lop(Iconst_int n) -> + | Lop(Iconst_int n | Iconst_blockheader n) -> emit_intconst i.res.(0) n | Lop(Iconst_float f) -> let b = Int64.bits_of_float(float_of_string f) in @@ -604,7 +604,7 @@ let emit_instr i = ` ldr {emit_reg reg_trap_ptr}, [sp], 16\n`; cfi_adjust_cfa_offset (-16); stack_offset := !stack_offset - 16 - | Lraise -> + | Lraise k -> begin match !Clflags.debug, k with | true, (Lambda.Raise_regular | Lambda.Raise_reraise) -> ` bl {emit_symbol "caml_raise_exn"}\n`; diff --git a/asmcomp/clambda.ml b/asmcomp/clambda.ml index dd53020d72..c4baf6cf9c 100644 --- a/asmcomp/clambda.ml +++ b/asmcomp/clambda.ml @@ -18,9 +18,23 @@ open Lambda type function_label = string +type ustructured_constant = + | Uconst_float of string + | Uconst_int32 of int32 + | Uconst_int64 of int64 + | Uconst_nativeint of nativeint + | Uconst_block of int * uconstant list + | Uconst_float_array of string list + | Uconst_string of string + +and uconstant = + | Uconst_ref of string * ustructured_constant + | Uconst_int of int + | Uconst_ptr of int + type ulambda = Uvar of Ident.t - | Uconst of structured_constant * string option + | Uconst of uconstant | Udirect_apply of function_label * ulambda list * Debuginfo.t | Ugeneric_apply of ulambda * ulambda list * Debuginfo.t | Uclosure of ufunction list * ulambda list @@ -29,6 +43,7 @@ type ulambda = | Uletrec of (Ident.t * ulambda) list * ulambda | Uprim of primitive * ulambda list * Debuginfo.t | Uswitch of ulambda * ulambda_switch + | Ustringswitch of ulambda * (string * ulambda) list * ulambda | Ustaticfail of int * ulambda list | Ucatch of int * Ident.t list * ulambda * ulambda | Utrywith of ulambda * Ident.t * ulambda @@ -67,5 +82,5 @@ type value_approximation = Value_closure of function_description * value_approximation | Value_tuple of value_approximation array | Value_unknown - | Value_integer of int - | Value_constptr of int + | Value_const of uconstant + | Value_global_field of string * int diff --git a/asmcomp/clambda.mli b/asmcomp/clambda.mli index 737965db86..1853933c91 100644 --- a/asmcomp/clambda.mli +++ b/asmcomp/clambda.mli @@ -18,9 +18,23 @@ open Lambda type function_label = string +type ustructured_constant = + | Uconst_float of string + | Uconst_int32 of int32 + | Uconst_int64 of int64 + | Uconst_nativeint of nativeint + | Uconst_block of int * uconstant list + | Uconst_float_array of string list + | Uconst_string of string + +and uconstant = + | Uconst_ref of string * ustructured_constant + | Uconst_int of int + | Uconst_ptr of int + type ulambda = Uvar of Ident.t - | Uconst of structured_constant * string option + | Uconst of uconstant | Udirect_apply of function_label * ulambda list * Debuginfo.t | Ugeneric_apply of ulambda * ulambda list * Debuginfo.t | Uclosure of ufunction list * ulambda list @@ -29,6 +43,7 @@ type ulambda = | Uletrec of (Ident.t * ulambda) list * ulambda | Uprim of primitive * ulambda list * Debuginfo.t | Uswitch of ulambda * ulambda_switch + | Ustringswitch of ulambda * (string * ulambda) list * ulambda | Ustaticfail of int * ulambda list | Ucatch of int * Ident.t list * ulambda * ulambda | Utrywith of ulambda * Ident.t * ulambda @@ -67,5 +82,5 @@ type value_approximation = Value_closure of function_description * value_approximation | Value_tuple of value_approximation array | Value_unknown - | Value_integer of int - | Value_constptr of int + | Value_const of uconstant + | Value_global_field of string * int diff --git a/asmcomp/closure.ml b/asmcomp/closure.ml index aca36cbe95..78357d3b11 100644 --- a/asmcomp/closure.ml +++ b/asmcomp/closure.ml @@ -48,7 +48,7 @@ let getglobal id = let occurs_var var u = let rec occurs = function Uvar v -> v = var - | Uconst (cst,_) -> false + | Uconst _ -> false | Udirect_apply(lbl, args, _) -> List.exists occurs args | Ugeneric_apply(funct, args, _) -> occurs funct || List.exists occurs args | Uclosure(fundecls, clos) -> List.exists occurs clos @@ -60,6 +60,10 @@ let occurs_var var u = | Uswitch(arg, s) -> occurs arg || occurs_array s.us_actions_consts || occurs_array s.us_actions_blocks + | Ustringswitch(arg,sw,d) -> + occurs arg || + List.exists (fun (_,e) -> occurs e) sw || + occurs d | Ustaticfail (_, args) -> List.exists occurs args | Ucatch(_, _, body, hdlr) -> occurs body || occurs hdlr | Utrywith(body, exn, hdlr) -> occurs body || occurs hdlr @@ -81,6 +85,52 @@ let occurs_var var u = true in occurs u +(* Split a function with default parameters into a wrapper and an + inner function. The wrapper fills in missing optional parameters + with their default value and tail-calls the inner function. The + wrapper can then hopefully be inlined on most call sites to avoid + the overhead associated with boxing an optional argument with a + 'Some' constructor, only to deconstruct it immediately in the + function's body. *) + +let split_default_wrapper fun_id kind params body = + let rec aux map = function + | Llet(Strict, id, (Lifthenelse(Lvar optparam, _, _) as def), rest) when + Ident.name optparam = "*opt*" && List.mem optparam params + && not (List.mem_assoc optparam map) + -> + let wrapper_body, inner = aux ((optparam, id) :: map) rest in + Llet(Strict, id, def, wrapper_body), inner + | _ when map = [] -> raise Exit + | body -> + (* Check that those *opt* identifiers don't appear in the remaining + body. This should not appear, but let's be on the safe side. *) + let fv = Lambda.free_variables body in + List.iter (fun (id, _) -> if IdentSet.mem id fv then raise Exit) map; + + let inner_id = Ident.create (Ident.name fun_id ^ "_inner") in + let map_param p = try List.assoc p map with Not_found -> p in + let args = List.map (fun p -> Lvar (map_param p)) params in + let wrapper_body = Lapply (Lvar inner_id, args, Location.none) in + + let inner_params = List.map map_param params in + let new_ids = List.map Ident.rename inner_params in + let subst = List.fold_left2 + (fun s id new_id -> + Ident.add id (Lvar new_id) s) + Ident.empty inner_params new_ids + in + let body = Lambda.subst_lambda subst body in + let inner_fun = Lfunction(Curried, new_ids, body) in + (wrapper_body, (inner_id, inner_fun)) + in + try + let wrapper_body, inner = aux [] body in + [(fun_id, Lfunction(kind, params, wrapper_body)); inner] + with Exit -> + [(fun_id, Lfunction(kind, params, body))] + + (* Determine whether the estimated size of a clambda term is below some threshold *) @@ -118,14 +168,7 @@ let lambda_smaller lam threshold = if !size > threshold then raise Exit; match lam with Uvar v -> () - | Uconst( - (Const_base(Const_int _ | Const_char _ | Const_float _ | - Const_int32 _ | Const_int64 _ | Const_nativeint _) | - Const_pointer _), _) -> incr size -(* Structured Constants are now emitted during closure conversion. *) - | Uconst (_, Some _) -> incr size - | Uconst _ -> - raise Exit (* avoid duplication of structured constants *) + | Uconst _ -> incr size | Udirect_apply(fn, args, _) -> size := !size + 4; lambda_list_size args | Ugeneric_apply(fn, args, _) -> @@ -147,6 +190,15 @@ let lambda_smaller lam threshold = lambda_size lam; lambda_array_size cases.us_actions_consts ; lambda_array_size cases.us_actions_blocks + | Ustringswitch (lam,sw,d) -> + lambda_size lam ; + (* as ifthenelse *) + List.iter + (fun (_,lam) -> + size := !size+2 ; + lambda_size lam) + sw ; + lambda_size d | Ustaticfail (_,args) -> lambda_list_size args | Ucatch(_, _, body, handler) -> incr size; lambda_size body; lambda_size handler @@ -187,8 +239,10 @@ let rec is_pure_clambda = function (* Simplify primitive operations on integers *) -let make_const_int n = (Uconst(Const_base(Const_int n), None), Value_integer n) -let make_const_ptr n = (Uconst(Const_pointer n, None), Value_constptr n) +let make_const c = (Uconst c, Value_const c) + +let make_const_int n = make_const (Uconst_int n) +let make_const_ptr n = make_const (Uconst_ptr n) let make_const_bool b = make_const_ptr(if b then 1 else 0) let make_comparison cmp (x: int) (y: int) = make_const_bool @@ -200,9 +254,9 @@ let make_comparison cmp (x: int) (y: int) = | Cle -> x <= y | Cge -> x >= y) -let simplif_prim_pure p (args, approxs) dbg = +let simplif_int_prim_pure p (args, approxs) dbg = match approxs with - [Value_integer x] -> + [Value_const (Uconst_int x)] -> begin match p with Pidentity -> make_const_int x | Pnegint -> make_const_int (-x) @@ -212,7 +266,7 @@ let simplif_prim_pure p (args, approxs) dbg = | Poffsetint y -> make_const_int (x + y) | _ -> (Uprim(p, args, dbg), Value_unknown) end - | [Value_integer x; Value_integer y] -> + | [Value_const (Uconst_int x); Value_const (Uconst_int y)] -> begin match p with Paddint -> make_const_int(x + y) | Psubint -> make_const_int(x - y) @@ -228,7 +282,7 @@ let simplif_prim_pure p (args, approxs) dbg = | Pintcomp cmp -> make_comparison cmp x y | _ -> (Uprim(p, args, dbg), Value_unknown) end - | [Value_constptr x] -> + | [Value_const (Uconst_ptr x)] -> begin match p with Pidentity -> make_const_ptr x | Pnot -> make_const_bool(x = 0) @@ -244,19 +298,19 @@ let simplif_prim_pure p (args, approxs) dbg = end | _ -> (Uprim(p, args, dbg), Value_unknown) end - | [Value_constptr x; Value_constptr y] -> + | [Value_const (Uconst_ptr x); Value_const (Uconst_ptr y)] -> begin match p with Psequand -> make_const_bool(x <> 0 && y <> 0) | Psequor -> make_const_bool(x <> 0 || y <> 0) | Pintcomp cmp -> make_comparison cmp x y | _ -> (Uprim(p, args, dbg), Value_unknown) end - | [Value_constptr x; Value_integer y] -> + | [Value_const (Uconst_ptr x); Value_const (Uconst_int y)] -> begin match p with | Pintcomp cmp -> make_comparison cmp x y | _ -> (Uprim(p, args, dbg), Value_unknown) end - | [Value_integer x; Value_constptr y] -> + | [Value_const (Uconst_int x); Value_const (Uconst_ptr y)] -> begin match p with | Pintcomp cmp -> make_comparison cmp x y | _ -> (Uprim(p, args, dbg), Value_unknown) @@ -264,10 +318,57 @@ let simplif_prim_pure p (args, approxs) dbg = | _ -> (Uprim(p, args, dbg), Value_unknown) + +let field_approx n = function + | Value_tuple a when n < Array.length a -> a.(n) + | Value_const (Uconst_ref(_, Uconst_block(_, l))) when n < List.length l -> + Value_const (List.nth l n) + | _ -> Value_unknown + +let simplif_prim_pure p (args, approxs) dbg = + match p, args, approxs with + | Pmakeblock(tag, Immutable), _, _ -> + let field = function + | Value_const c -> c + | _ -> raise Exit + in + begin try + let cst = Uconst_block (tag, List.map field approxs) in + let name = + Compilenv.new_structured_constant cst ~shared:true + in + make_const (Uconst_ref (name, cst)) + with Exit -> + (Uprim(p, args, dbg), Value_tuple (Array.of_list approxs)) + end + | Pfield n, _, [ Value_const(Uconst_ref(_, Uconst_block(_, l))) ] + when n < List.length l -> + make_const (List.nth l n) + + | Pfield n, [ Uprim(Pmakeblock _, ul, _) ], [approx] -> + assert(n < List.length ul); + List.nth ul n, field_approx n approx + + | Pstringlength, _, [ Value_const(Uconst_ref(_, Uconst_string s)) ] + -> + make_const_int (String.length s) + + | _ -> + simplif_int_prim_pure p (args, approxs) dbg + let simplif_prim p (args, approxs as args_approxs) dbg = if List.for_all is_pure_clambda args then simplif_prim_pure p args_approxs dbg - else (Uprim(p, args, dbg), Value_unknown) + else + (* XXX : always return the same approxs as simplif_prim_pure? *) + let approx = + match p with + | Pmakeblock(_, Immutable) -> + Value_tuple (Array.of_list approxs) + | _ -> + Value_unknown + in + (Uprim(p, args, dbg), approx) (* Substitute variables in a [ulambda] term (a body of an inlined function) and perform some more simplifications on integer primitives. @@ -279,9 +380,7 @@ let simplif_prim p (args, approxs as args_approxs) dbg = over functions. *) let approx_ulam = function - Uconst(Const_base(Const_int n),_) -> Value_integer n - | Uconst(Const_base(Const_char c),_) -> Value_integer(Char.code c) - | Uconst(Const_pointer n,_) -> Value_constptr n + Uconst c -> Value_const c | _ -> Value_unknown let rec substitute sb ulam = @@ -329,6 +428,11 @@ let rec substitute sb ulam = us_actions_blocks = Array.map (substitute sb) sw.us_actions_blocks; }) + | Ustringswitch(arg,sw,d) -> + Ustringswitch + (substitute sb arg, + List.map (fun (s,act) -> s,substitute sb act) sw, + substitute sb d) | Ustaticfail (nfail, args) -> Ustaticfail (nfail, List.map (substitute sb) args) | Ucatch(nfail, ids, u1, u2) -> @@ -338,8 +442,10 @@ let rec substitute sb ulam = Utrywith(substitute sb u1, id', substitute (Tbl.add id (Uvar id') sb) u2) | Uifthenelse(u1, u2, u3) -> begin match substitute sb u1 with - Uconst(Const_pointer n, _) -> + Uconst (Uconst_ptr n) -> if n <> 0 then substitute sb u2 else substitute sb u3 + | Uprim(Pmakeblock _, _, _) -> + substitute sb u2 | su1 -> Uifthenelse(su1, substitute sb u2, substitute sb u3) end @@ -363,16 +469,11 @@ let rec substitute sb ulam = (* Perform an inline expansion *) let is_simple_argument = function - Uvar _ -> true - | Uconst(Const_base(Const_int _ | Const_char _ | Const_float _ | - Const_int32 _ | Const_int64 _ | Const_nativeint _),_) -> - true - | Uconst(Const_pointer _, _) -> true + | Uvar _ | Uconst _ -> true | _ -> false let no_effects = function - Uclosure _ -> true - | Uconst(Const_base(Const_string _),_) -> true + | Uclosure _ -> true | u -> is_simple_argument u let rec bind_params_rec subst params args body = @@ -383,9 +484,16 @@ let rec bind_params_rec subst params args body = bind_params_rec (Tbl.add p1 a1 subst) pl al body else begin let p1' = Ident.rename p1 in + let u1, u2 = + match Ident.name p1, a1 with + | "*opt*", Uprim(Pmakeblock(0, Immutable), [a], dbg) -> + a, Uprim(Pmakeblock(0, Immutable), [Uvar p1'], dbg) + | _ -> + a1, Uvar p1' + in let body' = - bind_params_rec (Tbl.add p1 (Uvar p1') subst) pl al body in - if occurs_var p1 body then Ulet(p1', a1, body') + bind_params_rec (Tbl.add p1 u2 subst) pl al body in + if occurs_var p1 body then Ulet(p1', u1, body') else if no_effects a1 then body' else Usequence(a1, body') end @@ -432,7 +540,8 @@ let direct_apply fundesc funct ufunct uargs = let strengthen_approx appl approx = match approx_ulam appl with - (Value_integer _ | Value_constptr _) as intapprox -> intapprox + (Value_const _) as intapprox -> + intapprox | _ -> approx (* If a term has approximation Value_integer or Value_constptr and is pure, @@ -440,8 +549,16 @@ let strengthen_approx appl approx = let check_constant_result lam ulam approx = match approx with - Value_integer n when is_pure lam -> make_const_int n - | Value_constptr n when is_pure lam -> make_const_ptr n + Value_const c when is_pure lam -> make_const c + | Value_global_field (id, i) when is_pure lam -> + begin match ulam with + | Uprim(Pfield _, [Uprim(Pgetglobal _, _, _)], _) -> (ulam, approx) + | _ -> + let glb = + Uprim(Pgetglobal (Ident.create_persistent id), [], Debuginfo.none) + in + Uprim(Pfield i, [glb], Debuginfo.none), approx + end | _ -> (ulam, approx) (* Evaluate an expression with known value for its side effects only, @@ -492,13 +609,12 @@ let rec add_debug_info ev u = The closure environment [cenv] maps idents to [ulambda] terms. It is used to substitute environment accesses for free identifiers. *) +exception NotClosed + let close_approx_var fenv cenv id = let approx = try Tbl.find id fenv with Not_found -> Value_unknown in match approx with - Value_integer n -> - make_const_int n - | Value_constptr n -> - make_const_ptr n + Value_const c -> make_const c | approx -> let subst = try Tbl.find id cenv with Not_found -> Uvar id in (subst, approx) @@ -510,14 +626,33 @@ let rec close fenv cenv = function Lvar id -> close_approx_var fenv cenv id | Lconst cst -> - begin match cst with - Const_base(Const_int n) -> (Uconst (cst,None), Value_integer n) - | Const_base(Const_char c) -> (Uconst (cst,None), - Value_integer(Char.code c)) - | Const_pointer n -> (Uconst (cst, None), Value_constptr n) - | _ -> (Uconst (cst, Some (Compilenv.new_structured_constant cst true)), - Value_unknown) - end + let str ?(shared = true) cst = + let name = + Compilenv.new_structured_constant cst ~shared + in + Uconst_ref (name, cst) + in + let rec transl = function + | Const_base(Const_int n) -> Uconst_int n + | Const_base(Const_char c) -> Uconst_int (Char.code c) + | Const_pointer n -> Uconst_ptr n + | Const_block (tag, fields) -> + str (Uconst_block (tag, List.map transl fields)) + | Const_float_array sl -> + (* constant float arrays are really immutable *) + str (Uconst_float_array sl) + | Const_immstring s -> + str (Uconst_string s) + | Const_base (Const_string (s, _)) -> + (* strings (even literal ones) are mutable! *) + (* of course, the empty string is really immutable *) + str ~shared:false(*(String.length s = 0)*) (Uconst_string s) + | Const_base(Const_float x) -> str (Uconst_float x) + | Const_base(Const_int32 x) -> str (Uconst_int32 x) + | Const_base(Const_int64 x) -> str (Uconst_int64 x) + | Const_base(Const_nativeint x) -> str (Uconst_nativeint x) + in + make_const (transl cst) | Lfunction(kind, params, body) as funct -> close_one_function fenv cenv (Ident.create "fun") funct @@ -581,7 +716,7 @@ let rec close fenv cenv = function (Variable, _) -> let (ubody, abody) = close fenv cenv body in (Ulet(id, ulam, ubody), abody) - | (_, (Value_integer _ | Value_constptr _)) + | (_, Value_const _) when str = Alias || is_pure lam -> close (Tbl.add id alam fenv) cenv body | (_, _) -> @@ -627,24 +762,14 @@ let rec close fenv cenv = function check_constant_result lam (getglobal id) (Compilenv.global_approx id) - | Lprim(Pmakeblock(tag, mut) as prim, lams) -> - let (ulams, approxs) = List.split (List.map (close fenv cenv) lams) in - (Uprim(prim, ulams, Debuginfo.none), - begin match mut with - Immutable -> Value_tuple(Array.of_list approxs) - | Mutable -> Value_unknown - end) | Lprim(Pfield n, [lam]) -> let (ulam, approx) = close fenv cenv lam in - let fieldapprox = - match approx with - Value_tuple a when n < Array.length a -> a.(n) - | _ -> Value_unknown in check_constant_result lam (Uprim(Pfield n, [ulam], Debuginfo.none)) - fieldapprox + (field_approx n approx) | Lprim(Psetfield(n, _), [Lprim(Pgetglobal id, []); lam]) -> let (ulam, approx) = close fenv cenv lam in - (!global_approx).(n) <- approx; + if approx <> Value_unknown then + (!global_approx).(n) <- approx; (Uprim(Psetfield(n, false), [getglobal id; ulam], Debuginfo.none), Value_unknown) | Lprim(Praise k, [Levent(arg, ev)]) -> @@ -666,6 +791,16 @@ let rec close fenv cenv = function us_index_blocks = block_index; us_actions_blocks = block_actions}), Value_unknown) + | Lstringswitch(arg,sw,d) -> + let uarg,_ = close fenv cenv arg in + let usw = + List.map + (fun (s,act) -> + let uact,_ = close fenv cenv act in + s,uact) + sw in + let ud,_ = close fenv cenv d in + Ustringswitch (uarg,usw,ud),Value_unknown | Lstaticraise (i, args) -> (Ustaticfail (i, close_list fenv cenv args), Value_unknown) | Lstaticcatch(body, (i, vars), handler) -> @@ -678,7 +813,7 @@ let rec close fenv cenv = function (Utrywith(ubody, id, uhandler), Value_unknown) | Lifthenelse(arg, ifso, ifnot) -> begin match close fenv cenv arg with - (uarg, Value_constptr n) -> + (uarg, Value_const (Uconst_ptr n)) -> sequence_constant_expr arg uarg (close fenv cenv (if n = 0 then ifnot else ifso)) | (uarg, _ ) -> @@ -730,6 +865,17 @@ and close_named fenv cenv id = function (* Build a shared closure for a set of mutually recursive functions *) and close_functions fenv cenv fun_defs = + let fun_defs = + List.flatten + (List.map + (function + | (id, Lfunction(kind, params, body)) -> + split_default_wrapper id kind params body + | _ -> assert false + ) + fun_defs) + in + (* Update and check nesting depth *) incr function_nesting_depth; let initially_closed = @@ -783,31 +929,52 @@ and close_functions fenv cenv fun_defs = build_closure_env env_param (fv_pos - env_pos) fv in let cenv_body = List.fold_right2 - (fun (id, params, arity, body) pos env -> + (fun (id, params, body, fundesc) pos env -> Tbl.add id (Uoffset(Uvar env_param, pos - env_pos)) env) uncurried_defs clos_offsets cenv_fv in let (ubody, approx) = close fenv_rec cenv_body body in - if !useless_env && occurs_var env_param ubody then useless_env := false; + if !useless_env && occurs_var env_param ubody then raise NotClosed; let fun_params = if !useless_env then params else params @ [env_param] in - ({ label = fundesc.fun_label; - arity = fundesc.fun_arity; - params = fun_params; - body = ubody; - dbg }, - (id, env_pos, Value_closure(fundesc, approx))) in + let f = + { + label = fundesc.fun_label; + arity = fundesc.fun_arity; + params = fun_params; + body = ubody; + dbg; + } + in + (* give more chance of function with default parameters (i.e. + their wrapper functions) to be inlined *) + let n = + List.fold_left + (fun n id -> n + if Ident.name id = "*opt*" then 8 else 1) + 0 + fun_params + in + if lambda_smaller ubody + (!Clflags.inline_threshold + n) + then fundesc.fun_inline <- Some(fun_params, ubody); + + (f, (id, env_pos, Value_closure(fundesc, approx))) in (* Translate all function definitions. *) let clos_info_list = if initially_closed then begin - let cl = List.map2 clos_fundef uncurried_defs clos_offsets in + let snap = Compilenv.snapshot () in + try List.map2 clos_fundef uncurried_defs clos_offsets + with NotClosed -> (* If the hypothesis that the environment parameters are useless has been invalidated, then set [fun_closed] to false in all descriptions and recompile *) - if !useless_env then cl else begin + Compilenv.backtrack snap; (* PR#6337 *) List.iter - (fun (id, params, body, fundesc) -> fundesc.fun_closed <- false) + (fun (id, params, body, fundesc) -> + fundesc.fun_closed <- false; + fundesc.fun_inline <- None; + ) uncurried_defs; + useless_env := false; List.map2 clos_fundef uncurried_defs clos_offsets - end end else (* Excessive closure nesting: assume environment parameter is used *) List.map2 clos_fundef uncurried_defs clos_offsets @@ -817,20 +984,15 @@ and close_functions fenv cenv fun_defs = (* Return the Uclosure node and the list of all identifiers defined, with offsets and approximations. *) let (clos, infos) = List.split clos_info_list in + let fv = if !useless_env then [] else fv in (Uclosure(clos, List.map (close_var fenv cenv) fv), infos) (* Same, for one non-recursive function *) and close_one_function fenv cenv id funct = match close_functions fenv cenv [id, funct] with - ((Uclosure([f], _) as clos), - [_, _, (Value_closure(fundesc, _) as approx)]) -> - (* See if the function can be inlined *) - if lambda_smaller f.body - (!Clflags.inline_threshold + List.length f.params) - then fundesc.fun_inline <- Some(f.params, f.body); - (clos, approx) - | _ -> fatal_error "Closure.close_one_function" + | (clos, (i, _, approx) :: _) when id = i -> (clos, approx) + | _ -> fatal_error "Closure.close_one_function" (* Close a switch *) @@ -861,12 +1023,69 @@ and close_switch fenv cenv cases num_keys default = | _ -> index, actions +(* Collect exported symbols for structured constants *) + +let collect_exported_structured_constants a = + let rec approx = function + | Value_closure (fd, a) -> + approx a; + begin match fd.fun_inline with + | Some (_, u) -> ulam u + | None -> () + end + | Value_tuple a -> Array.iter approx a + | Value_const c -> const c + | Value_unknown | Value_global_field _ -> () + and const = function + | Uconst_ref (s, c) -> + Compilenv.add_exported_constant s; + structured_constant c + | Uconst_int _ | Uconst_ptr _ -> () + and structured_constant = function + | Uconst_block (_, ul) -> List.iter const ul + | Uconst_float _ | Uconst_int32 _ + | Uconst_int64 _ | Uconst_nativeint _ + | Uconst_float_array _ | Uconst_string _ -> () + and ulam = function + | Uvar _ -> () + | Uconst c -> const c + | Udirect_apply (_, ul, _) -> List.iter ulam ul + | Ugeneric_apply (u, ul, _) -> ulam u; List.iter ulam ul + | Uclosure (fl, ul) -> + List.iter (fun f -> ulam f.body) fl; + List.iter ulam ul + | Uoffset(u, _) -> ulam u + | Ulet (_, u1, u2) -> ulam u1; ulam u2 + | Uletrec (l, u) -> List.iter (fun (_, u) -> ulam u) l; ulam u + | Uprim (_, ul, _) -> List.iter ulam ul + | Uswitch (u, sl) -> + ulam u; + Array.iter ulam sl.us_actions_consts; + Array.iter ulam sl.us_actions_blocks + | Ustringswitch (u,sw,d) -> + ulam u ; + List.iter (fun (_,act) -> ulam act) sw ; + ulam d + | Ustaticfail (_, ul) -> List.iter ulam ul + | Ucatch (_, _, u1, u2) + | Utrywith (u1, _, u2) + | Usequence (u1, u2) + | Uwhile (u1, u2) -> ulam u1; ulam u2 + | Uifthenelse (u1, u2, u3) + | Ufor (_, u1, u2, _, u3) -> ulam u1; ulam u2; ulam u3 + | Uassign (_, u) -> ulam u + | Usend (_, u1, u2, ul, _) -> ulam u1; ulam u2; List.iter ulam ul + in + approx a + (* The entry point *) let intro size lam = function_nesting_depth := 0; - global_approx := Array.create size Value_unknown; + let id = Compilenv.make_symbol None in + global_approx := Array.init size (fun i -> Value_global_field (id, i)); Compilenv.set_global_approx(Value_tuple !global_approx); let (ulam, approx) = close Tbl.empty Tbl.empty lam in + collect_exported_structured_constants (Value_tuple !global_approx); global_approx := [||]; ulam diff --git a/asmcomp/cmm.ml b/asmcomp/cmm.ml index cdb8338960..9a5f3ec6b8 100644 --- a/asmcomp/cmm.ml +++ b/asmcomp/cmm.ml @@ -89,6 +89,7 @@ type expression = | Cconst_symbol of string | Cconst_pointer of int | Cconst_natpointer of nativeint + | Cconst_blockheader of nativeint | Cvar of Ident.t | Clet of Ident.t * expression * expression | Cassign of Ident.t * expression diff --git a/asmcomp/cmm.mli b/asmcomp/cmm.mli index 2ae9eb6584..be2bd41457 100644 --- a/asmcomp/cmm.mli +++ b/asmcomp/cmm.mli @@ -75,6 +75,7 @@ type expression = | Cconst_symbol of string | Cconst_pointer of int | Cconst_natpointer of nativeint + | Cconst_blockheader of nativeint | Cvar of Ident.t | Clet of Ident.t * expression * expression | Cassign of Ident.t * expression diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index 591822f560..a953ba924c 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -27,18 +27,19 @@ open Cmx_format let bind name arg fn = match arg with Cvar _ | Cconst_int _ | Cconst_natint _ | Cconst_symbol _ - | Cconst_pointer _ | Cconst_natpointer _ -> fn arg + | Cconst_pointer _ | Cconst_natpointer _ + | Cconst_blockheader _ -> fn arg | _ -> let id = Ident.create name in Clet(id, arg, fn (Cvar id)) let bind_nonvar name arg fn = match arg with Cconst_int _ | Cconst_natint _ | Cconst_symbol _ - | Cconst_pointer _ | Cconst_natpointer _ -> fn arg + | Cconst_pointer _ | Cconst_natpointer _ + | Cconst_blockheader _ -> fn arg | _ -> let id = Ident.create name in Clet(id, arg, fn (Cvar id)) (* Block headers. Meaning of the tag field: see stdlib/obj.ml *) -let float_tag = Cconst_int Obj.double_tag let floatarray_tag = Cconst_int Obj.double_array_tag let block_header tag sz = @@ -55,14 +56,14 @@ let boxedint32_header = block_header Obj.custom_tag 2 let boxedint64_header = block_header Obj.custom_tag (1 + 8 / size_addr) let boxedintnat_header = block_header Obj.custom_tag 2 -let alloc_block_header tag sz = Cconst_natint(block_header tag sz) -let alloc_float_header = Cconst_natint(float_header) -let alloc_floatarray_header len = Cconst_natint(floatarray_header len) -let alloc_closure_header sz = Cconst_natint(closure_header sz) -let alloc_infix_header ofs = Cconst_natint(infix_header ofs) -let alloc_boxedint32_header = Cconst_natint(boxedint32_header) -let alloc_boxedint64_header = Cconst_natint(boxedint64_header) -let alloc_boxedintnat_header = Cconst_natint(boxedintnat_header) +let alloc_block_header tag sz = Cconst_blockheader(block_header tag sz) +let alloc_float_header = Cconst_blockheader(float_header) +let alloc_floatarray_header len = Cconst_blockheader(floatarray_header len) +let alloc_closure_header sz = Cconst_blockheader(closure_header sz) +let alloc_infix_header ofs = Cconst_blockheader(infix_header ofs) +let alloc_boxedint32_header = Cconst_blockheader(boxedint32_header) +let alloc_boxedint64_header = Cconst_blockheader(boxedint64_header) +let alloc_boxedintnat_header = Cconst_blockheader(boxedintnat_header) (* Integers *) @@ -536,13 +537,15 @@ let float_array_set arr ofs newval = (* String length *) +(* Length of string block *) + let string_length exp = bind "str" exp (fun str -> let tmp_var = Ident.create "tmp" in Clet(tmp_var, Cop(Csubi, [Cop(Clsl, - [Cop(Clsr, [header str; Cconst_int 10]); + [get_size str; Cconst_int log2_size_addr]); Cconst_int 1]), Cop(Csubi, @@ -574,7 +577,7 @@ let call_cached_method obj tag cache pos args dbg = let make_alloc_generic set_fn tag wordsize args = if wordsize <= Config.max_young_wosize then - Cop(Calloc, Cconst_natint(block_header tag wordsize) :: args) + Cop(Calloc, Cconst_blockheader(block_header tag wordsize) :: args) else begin let id = Ident.create "alloc" in let rec fill_fields idx = function @@ -660,32 +663,20 @@ let transl_comparison = function (* Translate structured constants *) -(* Fabrice: moved to compilenv.ml ---- -let const_label = ref 0 - -let new_const_label () = - incr const_label; - !const_label - -let new_const_symbol () = - incr const_label; - Compilenv.make_symbol (Some (string_of_int !const_label)) - -let structured_constants = ref ([] : (string * structured_constant) list) -*) - let transl_constant = function - Const_base(Const_int n) -> + | Uconst_int n -> int_const n - | Const_base(Const_char c) -> - Cconst_int(((Char.code c) lsl 1) + 1) - | Const_pointer n -> + | Uconst_ptr n -> if n <= max_repr_int && n >= min_repr_int then Cconst_pointer((n lsl 1) + 1) else Cconst_natpointer (Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 1n) - | cst -> - Cconst_symbol (Compilenv.new_structured_constant cst false) + | Uconst_ref (label, _) -> + Cconst_symbol label + +let transl_structured_constant cst = + let label = Compilenv.new_structured_constant cst ~shared:true in + Cconst_symbol label (* Translate constant closures *) @@ -696,9 +687,9 @@ let constant_closures = let box_int_constant bi n = match bi with - Pnativeint -> Const_base(Const_nativeint n) - | Pint32 -> Const_base(Const_int32 (Nativeint.to_int32 n)) - | Pint64 -> Const_base(Const_int64 (Int64.of_nativeint n)) + Pnativeint -> Uconst_nativeint n + | Pint32 -> Uconst_int32 (Nativeint.to_int32 n) + | Pint64 -> Uconst_int64 (Int64.of_nativeint n) let operations_boxed_int bi = match bi with @@ -715,9 +706,9 @@ let alloc_header_boxed_int bi = let box_int bi arg = match arg with Cconst_int n -> - transl_constant (box_int_constant bi (Nativeint.of_int n)) + transl_structured_constant (box_int_constant bi (Nativeint.of_int n)) | Cconst_natint n -> - transl_constant (box_int_constant bi n) + transl_structured_constant (box_int_constant bi n) | _ -> let arg' = if bi = Pint32 && size_int = 8 && big_endian @@ -1114,6 +1105,41 @@ end module SwitcherBlocks = Switch.Make(SArgBlocks) +(* Int switcher, arg in [low..high], + cases is list of individual cases, and is sorted by first component *) + +let transl_int_switch arg low high cases default = match cases with +| [] -> assert false +| (k0,_)::_ -> + let nacts = List.length cases + 1 in + let actions = Array.create nacts default in + let rec set_acts idx = function + | [] -> assert false + | [i,act] -> + actions.(idx) <- act ; + if i = high then [(i,i,idx)] + else [(i,i,idx); (i+1,max_int,0)] + | (i,act)::((j,_)::_ as rem) -> + actions.(idx) <- act ; + let inters = set_acts (idx+1) rem in + (i,i,idx):: + begin + if j = i+1 then inters + else (i+1,j-1,0)::inters + end in + let inters = set_acts 1 cases in + let inters = + if k0 = low then inters else (low,k0-1,0)::inters in + bind "switcher" arg + (fun a -> + SwitcherBlocks.zyva + (low,high) + (fun i -> Cconst_int i) + a + (Array.of_list inters) actions) + + + (* Auxiliary functions for optimizing "let" of boxed numbers (floats and boxed integers *) @@ -1122,8 +1148,8 @@ type unboxed_number_kind = | Boxed_float | Boxed_integer of boxed_integer -let is_unboxed_number = function - Uconst(Const_base(Const_float f), _) -> +let rec is_unboxed_number = function + Uconst(Uconst_ref(_, Uconst_float _)) -> Boxed_float | Uprim(p, _, _) -> begin match simplif_primitive p with @@ -1164,6 +1190,7 @@ let is_unboxed_number = function | Pbbswap bi -> Boxed_integer bi | _ -> No_unboxing end + | Ulet (_, _, e) | Usequence (_, e) -> is_unboxed_number e | _ -> No_unboxing let subst_boxed_number unbox_fn boxed_id unboxed_id box_chunk box_offset exp = @@ -1205,12 +1232,19 @@ let subst_boxed_number unbox_fn boxed_id unboxed_id box_chunk box_offset exp = let functions = (Queue.create() : ufunction Queue.t) +let strmatch_compile = + let module S = + Strmatch.Make + (struct + let string_block_length = get_size + let transl_switch = transl_int_switch + end) in + S.compile + let rec transl = function Uvar id -> Cvar id - | Uconst (sc, Some const_label) -> - Cconst_symbol const_label - | Uconst (sc, None) -> + | Uconst sc -> transl_constant sc | Uclosure(fundecls, []) -> let lbl = Compilenv.new_const_symbol() in @@ -1295,7 +1329,7 @@ let rec transl = function (Pgetglobal id, []) -> Cconst_symbol (Ident.name id) | (Pmakeblock(tag, mut), []) -> - transl_constant(Const_block(tag, [])) + assert false | (Pmakeblock(tag, mut), args) -> make_alloc tag (List.map transl args) | (Pccall prim, args) -> @@ -1308,7 +1342,7 @@ let rec transl = function dbg), List.map transl args) | (Pmakearray kind, []) -> - transl_constant(Const_block(0, [])) + transl_structured_constant (Uconst_block(0, [])) | (Pmakearray kind, args) -> begin match kind with Pgenarray -> @@ -1380,6 +1414,11 @@ let rec transl = function (untag_int arg) s.us_index_consts s.us_actions_consts, transl_switch (get_tag arg) s.us_index_blocks s.us_actions_blocks)) + | Ustringswitch(arg,sw,d) -> + bind "switch" (transl arg) + (fun arg -> + strmatch_compile arg (transl d) + (List.map (fun (s,act) -> s,transl act) sw)) | Ustaticfail (nfail, args) -> Cexit (nfail, List.map transl args) | Ucatch(nfail, [], body, handler) -> @@ -1492,7 +1531,7 @@ and transl_prim_1 p arg dbg = if no_overflow_lsl n then add_const (transl arg) (n lsl 1) else - transl_prim_2 Paddint arg (Uconst (Const_base(Const_int n), None)) + transl_prim_2 Paddint arg (Uconst (Uconst_int n)) Debuginfo.none | Poffsetref n -> return_unit @@ -1922,17 +1961,17 @@ and transl_prim_3 p arg1 arg2 arg3 dbg = fatal_error "Cmmgen.transl_prim_3" and transl_unbox_float = function - Uconst(Const_base(Const_float f), _) -> Cconst_float f + Uconst(Uconst_ref(_, Uconst_float f)) -> Cconst_float f | exp -> unbox_float(transl exp) and transl_unbox_int bi = function - Uconst(Const_base(Const_int32 n), _) -> + Uconst(Uconst_ref(_, Uconst_int32 n)) -> Cconst_natint (Nativeint.of_int32 n) - | Uconst(Const_base(Const_nativeint n), _) -> + | Uconst(Uconst_ref(_, Uconst_nativeint n)) -> Cconst_natint n - | Uconst(Const_base(Const_int64 n), _) -> + | Uconst(Uconst_ref(_, Uconst_int64 n)) -> assert (size_int = 8); Cconst_natint (Int64.to_nativeint n) - | Uprim(Pbintofint bi',[Uconst(Const_base(Const_int i),_)],_) when bi = bi' -> + | Uprim(Pbintofint bi',[Uconst(Uconst_int i)],_) when bi = bi' -> Cconst_int i | exp -> unbox_int bi (transl exp) @@ -1966,8 +2005,8 @@ and make_catch2 mk_body handler = match handler with and exit_if_true cond nfail otherwise = match cond with - | Uconst (Const_pointer 0, _) -> otherwise - | Uconst (Const_pointer 1, _) -> Cexit (nfail,[]) + | Uconst (Uconst_ptr 0) -> otherwise + | Uconst (Uconst_ptr 1) -> Cexit (nfail,[]) | Uprim(Psequor, [arg1; arg2], _) -> exit_if_true arg1 nfail (exit_if_true arg2 nfail otherwise) | Uprim(Psequand, _, _) -> @@ -1996,8 +2035,8 @@ and exit_if_true cond nfail otherwise = and exit_if_false cond otherwise nfail = match cond with - | Uconst (Const_pointer 0, _) -> Cexit (nfail,[]) - | Uconst (Const_pointer 1, _) -> otherwise + | Uconst (Uconst_ptr 0) -> Cexit (nfail,[]) + | Uconst (Uconst_ptr 1) -> otherwise | Uprim(Psequand, [arg1; arg2], _) -> exit_if_false arg1 (exit_if_false arg2 otherwise nfail) nfail | Uprim(Psequor, _, _) -> @@ -2117,99 +2156,38 @@ let rec transl_all_functions already_translated cont = (* Emit structured constants *) -let immstrings = Hashtbl.create 17 +let emit_block header symb cont = + Cint header :: Cdefine_symbol symb :: cont -let rec emit_constant symb cst cont = +let rec emit_structured_constant symb cst cont = match cst with - Const_base(Const_float s) -> - Cint(float_header) :: Cdefine_symbol symb :: Cdouble s :: cont - | Const_base(Const_string (s, _)) | Const_immstring s -> - Cint(string_header (String.length s)) :: - Cdefine_symbol symb :: - emit_string_constant s cont - | Const_base(Const_int32 n) -> - Cint(boxedint32_header) :: Cdefine_symbol symb :: - emit_boxed_int32_constant n cont - | Const_base(Const_int64 n) -> - Cint(boxedint64_header) :: Cdefine_symbol symb :: - emit_boxed_int64_constant n cont - | Const_base(Const_nativeint n) -> - Cint(boxedintnat_header) :: Cdefine_symbol symb :: - emit_boxed_nativeint_constant n cont - | Const_block(tag, fields) -> - let (emit_fields, cont1) = emit_constant_fields fields cont in - Cint(block_header tag (List.length fields)) :: - Cdefine_symbol symb :: - emit_fields @ cont1 - | Const_float_array(fields) -> - Cint(floatarray_header (List.length fields)) :: - Cdefine_symbol symb :: - Misc.map_end (fun f -> Cdouble f) fields cont - | _ -> fatal_error "gencmm.emit_constant" - -and emit_constant_fields fields cont = - match fields with - [] -> ([], cont) - | f1 :: fl -> - let (data1, cont1) = emit_constant_field f1 cont in - let (datal, contl) = emit_constant_fields fl cont1 in - (data1 :: datal, contl) - -and emit_constant_field field cont = - match field with - Const_base(Const_int n) -> - (Cint(Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 1n), - cont) - | Const_base(Const_char c) -> - (Cint(Nativeint.of_int(((Char.code c) lsl 1) + 1)), cont) - | Const_base(Const_float s) -> - let lbl = Compilenv.new_const_label() in - (Clabel_address lbl, - Cint(float_header) :: Cdefine_label lbl :: Cdouble s :: cont) - | Const_base(Const_string (s, _)) -> - let lbl = Compilenv.new_const_label() in - (Clabel_address lbl, - Cint(string_header (String.length s)) :: Cdefine_label lbl :: - emit_string_constant s cont) - | Const_immstring s -> - begin try - (Clabel_address (Hashtbl.find immstrings s), cont) - with Not_found -> - let lbl = Compilenv.new_const_label() in - Hashtbl.add immstrings s lbl; - (Clabel_address lbl, - Cint(string_header (String.length s)) :: Cdefine_label lbl :: - emit_string_constant s cont) - end - | Const_base(Const_int32 n) -> - let lbl = Compilenv.new_const_label() in - (Clabel_address lbl, - Cint(boxedint32_header) :: Cdefine_label lbl :: - emit_boxed_int32_constant n cont) - | Const_base(Const_int64 n) -> - let lbl = Compilenv.new_const_label() in - (Clabel_address lbl, - Cint(boxedint64_header) :: Cdefine_label lbl :: - emit_boxed_int64_constant n cont) - | Const_base(Const_nativeint n) -> - let lbl = Compilenv.new_const_label() in - (Clabel_address lbl, - Cint(boxedintnat_header) :: Cdefine_label lbl :: - emit_boxed_nativeint_constant n cont) - | Const_pointer n -> - (Cint(Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 1n), - cont) - | Const_block(tag, fields) -> - let lbl = Compilenv.new_const_label() in - let (emit_fields, cont1) = emit_constant_fields fields cont in - (Clabel_address lbl, - Cint(block_header tag (List.length fields)) :: Cdefine_label lbl :: - emit_fields @ cont1) - | Const_float_array(fields) -> - let lbl = Compilenv.new_const_label() in - (Clabel_address lbl, - Cint(floatarray_header (List.length fields)) :: Cdefine_label lbl :: - Misc.map_end (fun f -> Cdouble f) fields cont) + | Uconst_float s-> + emit_block float_header symb (Cdouble s :: cont) + | Uconst_string s -> + emit_block (string_header (String.length s)) symb + (emit_string_constant s cont) + | Uconst_int32 n -> + emit_block boxedint32_header symb + (emit_boxed_int32_constant n cont) + | Uconst_int64 n -> + emit_block boxedint64_header symb + (emit_boxed_int64_constant n cont) + | Uconst_nativeint n -> + emit_block boxedintnat_header symb + (emit_boxed_nativeint_constant n cont) + | Uconst_block (tag, csts) -> + let cont = List.fold_right emit_constant csts cont in + emit_block (block_header tag (List.length csts)) symb cont + | Uconst_float_array fields -> + emit_block (floatarray_header (List.length fields)) symb + (Misc.map_end (fun f -> Cdouble f) fields cont) + +and emit_constant cst cont = + match cst with + | Uconst_int n | Uconst_ptr n -> + Cint(Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 1n) :: cont + | Uconst_ref (label, _) -> + Csymbol_address label :: cont and emit_string_constant s cont = let n = size_int - 1 - (String.length s) mod size_int in @@ -2275,14 +2253,12 @@ let emit_all_constants cont = let c = ref cont in List.iter (fun (lbl, global, cst) -> - let cst = emit_constant lbl cst [] in + let cst = emit_structured_constant lbl cst [] in let cst = if global then Cglobal_symbol lbl :: cst else cst in c:= Cdata(cst):: !c) (Compilenv.structured_constants()); -(* structured_constants := []; done in Compilenv.reset() *) - Hashtbl.clear immstrings; (* PR#3979 *) List.iter (fun (symb, fundecls) -> c := Cdata(emit_constant_closure symb fundecls []) :: !c) @@ -2648,8 +2624,8 @@ let reference_symbols namelist = let global_data name v = Cdata(Cglobal_symbol name :: - emit_constant name - (Const_base (Const_string (Marshal.to_string v [], None))) []) + emit_structured_constant name + (Uconst_string (Marshal.to_string v [])) []) let globals_map v = global_data "caml_globals_map" v @@ -2686,12 +2662,16 @@ let code_segment_table namelist = let predef_exception i name = let symname = "caml_exn_" ^ name in + let cst = Uconst_string name in + let label = Compilenv.new_const_symbol () in + let cont = emit_structured_constant label cst [] in Cdata(Cglobal_symbol symname :: - emit_constant symname - (Const_block(Obj.object_tag, - [Const_base(Const_string (name, None)); - Const_base(Const_int (-i-1)) - ])) []) + emit_structured_constant symname + (Uconst_block(Obj.object_tag, + [ + Uconst_ref(label, cst); + Uconst_int (-i-1); + ])) cont) (* Header for a plugin *) diff --git a/asmcomp/compilenv.ml b/asmcomp/compilenv.ml index 48d6be7d47..80be94e9f7 100644 --- a/asmcomp/compilenv.ml +++ b/asmcomp/compilenv.ml @@ -27,8 +27,30 @@ exception Error of error let global_infos_table = (Hashtbl.create 17 : (string, unit_infos option) Hashtbl.t) -let structured_constants = - ref ([] : (string * bool * Lambda.structured_constant) list) +module CstMap = + Map.Make(struct + type t = Clambda.ustructured_constant + let compare = Pervasives.compare + (* could use a better version, comparing on the + first arg of Uconst_ref *) + end) + +type structured_constants = + { + strcst_shared: string CstMap.t; + strcst_all: (string * Clambda.ustructured_constant) list; + } + +let structured_constants_empty = + { + strcst_shared = CstMap.empty; + strcst_all = []; + } + +let structured_constants = ref structured_constants_empty + + +let exported_constants = Hashtbl.create 17 let current_unit = { ui_name = ""; @@ -69,7 +91,8 @@ let reset ?packname name = current_unit.ui_apply_fun <- []; current_unit.ui_send_fun <- []; current_unit.ui_force_link <- false; - structured_constants := [] + Hashtbl.clear exported_constants; + structured_constants := structured_constants_empty let current_unit_infos () = current_unit @@ -223,12 +246,39 @@ let new_const_symbol () = incr const_label; make_symbol (Some (string_of_int !const_label)) -let new_structured_constant cst global = - let lbl = new_const_symbol() in - structured_constants := (lbl, global, cst) :: !structured_constants; - lbl +let snapshot () = !structured_constants +let backtrack s = structured_constants := s -let structured_constants () = !structured_constants +let new_structured_constant cst ~shared = + let {strcst_shared; strcst_all} = !structured_constants in + if shared then + try + CstMap.find cst strcst_shared + with Not_found -> + let lbl = new_const_symbol() in + structured_constants := + { + strcst_shared = CstMap.add cst lbl strcst_shared; + strcst_all = (lbl, cst) :: strcst_all; + }; + lbl + else + let lbl = new_const_symbol() in + structured_constants := + { + strcst_shared; + strcst_all = (lbl, cst) :: strcst_all; + }; + lbl + +let add_exported_constant s = + Hashtbl.replace exported_constants s () + +let structured_constants () = + List.map + (fun (lbl, cst) -> + (lbl, Hashtbl.mem exported_constants lbl, cst) + ) (!structured_constants).strcst_all (* Error report *) diff --git a/asmcomp/compilenv.mli b/asmcomp/compilenv.mli index 9ffb145a85..9c2eb62975 100644 --- a/asmcomp/compilenv.mli +++ b/asmcomp/compilenv.mli @@ -54,9 +54,18 @@ val need_send_fun: int -> unit val new_const_symbol : unit -> string val new_const_label : unit -> int -val new_structured_constant : Lambda.structured_constant -> bool -> string -val structured_constants : - unit -> (string * bool * Lambda.structured_constant) list + +val new_structured_constant: + Clambda.ustructured_constant -> + shared:bool -> (* can be shared with another structually equal constant *) + string +val structured_constants: unit -> (string * bool * Clambda.ustructured_constant) list +val add_exported_constant: string -> unit + +type structured_constants +val snapshot: unit -> structured_constants +val backtrack: structured_constants -> unit + val read_unit_info: string -> unit_infos * Digest.t (* Read infos and MD5 from a [.cmx] file. *) diff --git a/asmcomp/emitaux.ml b/asmcomp/emitaux.ml index 3ad467cbff..ccfa977ffa 100644 --- a/asmcomp/emitaux.ml +++ b/asmcomp/emitaux.ml @@ -221,9 +221,9 @@ let reset_debug_info () = let emit_debug_info dbg = if is_cfi_enabled () && (!Clflags.debug || Config.with_frame_pointers) - && not (Debuginfo.is_none dbg) then begin + && dbg.Debuginfo.dinfo_line > 0 (* PR#6243 *) + then begin let line = dbg.Debuginfo.dinfo_line in - assert (line <> 0); (* clang errors out on zero line numbers *) let file_name = dbg.Debuginfo.dinfo_file in let file_num = try List.assoc file_name !file_pos_nums diff --git a/asmcomp/i386/emit.mlp b/asmcomp/i386/emit.mlp index 3c77529ab7..2b90d37f64 100644 --- a/asmcomp/i386/emit.mlp +++ b/asmcomp/i386/emit.mlp @@ -458,7 +458,7 @@ let emit_instr fallthrough i = else ` movl {emit_reg src}, {emit_reg dst}\n` end - | Lop(Iconst_int n) -> + | Lop(Iconst_int n | Iconst_blockheader n) -> if n = 0n then begin match i.res.(0).loc with Reg n -> ` xorl {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n` diff --git a/asmcomp/i386/emit_nt.mlp b/asmcomp/i386/emit_nt.mlp index 145241d95c..495a29aecc 100644 --- a/asmcomp/i386/emit_nt.mlp +++ b/asmcomp/i386/emit_nt.mlp @@ -419,7 +419,7 @@ let emit_instr i = else ` mov {emit_reg dst}, {emit_reg src}\n` end - | Lop(Iconst_int n) -> + | Lop(Iconst_int n | Iconst_blockheader n) -> if n = 0n then begin match i.res.(0).loc with Reg n -> ` xor {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n` diff --git a/asmcomp/mach.ml b/asmcomp/mach.ml index 58d0c10769..a11910ec73 100644 --- a/asmcomp/mach.ml +++ b/asmcomp/mach.ml @@ -38,6 +38,7 @@ type operation = | Iconst_int of nativeint | Iconst_float of string | Iconst_symbol of string + | Iconst_blockheader of nativeint | Icall_ind | Icall_imm of string | Itailcall_ind diff --git a/asmcomp/mach.mli b/asmcomp/mach.mli index 03028b2ca8..000c3cf9f1 100644 --- a/asmcomp/mach.mli +++ b/asmcomp/mach.mli @@ -38,6 +38,7 @@ type operation = | Iconst_int of nativeint | Iconst_float of string | Iconst_symbol of string + | Iconst_blockheader of nativeint | Icall_ind | Icall_imm of string | Itailcall_ind diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp index e82f5ff790..f6ee1a2321 100644 --- a/asmcomp/power/emit.mlp +++ b/asmcomp/power/emit.mlp @@ -45,13 +45,6 @@ let slot_offset loc cls = | Incoming n -> frame_size() + n | Outgoing n -> n -(* Whether stack backtraces are supported *) - -let supports_backtraces = - match Config.system with - | "rhapsody" -> true - | _ -> false - (* Output a symbol *) let emit_symbol = @@ -267,7 +260,7 @@ let name_for_int_comparison = function let name_for_intop = function Iadd -> "add" - | Imul - > if ppc64 then "mulld" else "mullw" + | Imul -> if ppc64 then "mulld" else "mullw" | Imulh -> if ppc64 then "mulhd" else "mulhw" | Idiv -> if ppc64 then "divd" else "divw" | Iand -> "and" @@ -325,7 +318,8 @@ let load_store_size = function let instr_size = function Lend -> 0 | Lop(Imove | Ispill | Ireload) -> 1 - | Lop(Iconst_int n) -> if is_native_immediate n then 1 else 2 + | 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 @@ -459,7 +453,7 @@ let rec emit_instr i dslot = | (_, _) -> fatal_error "Emit: Imove" end - | Lop(Iconst_int n) -> + | Lop(Iconst_int n | Iconst_blockheader n) -> if is_native_immediate n then ` li {emit_reg i.res.(0)}, {emit_nativeint n}\n` else if n >= -0x8000_0000n && n <= 0x7FFF_FFFFn then begin @@ -596,7 +590,7 @@ let rec emit_instr i dslot = emit_set_comp c i.res.(0) end | Lop(Iintop Icheckbound) -> - if !Clflags.debug && supports_backtraces then + if !Clflags.debug then record_frame Reg.Set.empty i.dbg; ` {emit_string tglle} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` | Lop(Iintop op) -> @@ -614,7 +608,7 @@ let rec emit_instr i dslot = emit_set_comp c i.res.(0) end | Lop(Iintop_imm(Icheckbound, n)) -> - if !Clflags.debug && supports_backtraces then + if !Clflags.debug then record_frame Reg.Set.empty i.dbg; ` {emit_string tglle}i {emit_reg i.arg.(0)}, {emit_int n}\n` | Lop(Iintop_imm(op, n)) -> @@ -757,18 +751,21 @@ let rec emit_instr i dslot = ` addi {emit_gpr 1}, {emit_gpr 1}, 16\n`; stack_offset := !stack_offset - 16 | Lraise k -> - begin match !Clflags.debug && supports_backtraces, k with - | true, (Lambda.Raise_regular | Lambda.Raise_reraise) -> + begin match !Clflags.debug, k with + | true, Lambda.Raise_regular -> ` bl {emit_symbol "caml_raise_exn"}\n`; record_frame Reg.Set.empty i.dbg + | true, Lambda.Raise_reraise -> + ` bl {emit_symbol "caml_reraise_exn"}\n`; + record_frame Reg.Set.empty i.dbg | false, _ | true, Lambda.Raise_notrace -> ` {emit_string lg} {emit_gpr 0}, 0({emit_gpr 29})\n`; ` mr {emit_gpr 1}, {emit_gpr 29}\n`; - ` mtlr {emit_gpr 0}\n`; + ` mtctr {emit_gpr 0}\n`; ` {emit_string lg} {emit_gpr 29}, {emit_int size_addr}({emit_gpr 1})\n`; ` addi {emit_gpr 1}, {emit_gpr 1}, 16\n`; - ` blr\n` + ` bctr\n` end and emit_delay = function diff --git a/asmcomp/printclambda.ml b/asmcomp/printclambda.ml index a5081fc47e..3d4c32c0ae 100644 --- a/asmcomp/printclambda.ml +++ b/asmcomp/printclambda.ml @@ -15,15 +15,30 @@ open Format open Asttypes open Clambda -let rec pr_idents ppf = function - | [] -> () - | h::t -> fprintf ppf "%a %a" Ident.print h pr_idents t +let rec structured_constant ppf = function + | Uconst_float x -> fprintf ppf "%s" x + | Uconst_int32 x -> fprintf ppf "%ld" x + | Uconst_int64 x -> fprintf ppf "%Ld" x + | Uconst_nativeint x -> fprintf ppf "%nd" x + | Uconst_block (tag, l) -> + fprintf ppf "block(%i" tag; + List.iter (fun u -> fprintf ppf ",%a" uconstant u) l; + fprintf ppf ")" + | Uconst_float_array sl -> + fprintf ppf "floatarray(%s)" + (String.concat "," sl) + | Uconst_string s -> fprintf ppf "%S" s + +and uconstant ppf = function + | Uconst_ref (s, c) -> + fprintf ppf "%S=%a" s structured_constant c + | Uconst_int i -> fprintf ppf "%i" i + | Uconst_ptr i -> fprintf ppf "%ia" i let rec lam ppf = function | Uvar id -> Ident.print ppf id - | Uconst (cst,_) -> - Printlambda.structured_constant ppf cst + | Uconst c -> uconstant ppf c | Udirect_apply(f, largs, _) -> let lams ppf largs = List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in @@ -85,6 +100,19 @@ let rec lam ppf = function fprintf ppf "@[<1>(switch %a@ @[<v 0>%a@])@]" lam larg switch sw + | Ustringswitch(larg,sw,d) -> + let switch ppf sw = + let spc = ref false in + List.iter + (fun (s,l) -> + if !spc then fprintf ppf "@ " else spc := true; + fprintf ppf "@[<hv 1>case \"%s\":@ %a@]" + (String.escaped s) lam l) + sw ; + if !spc then fprintf ppf "@ " else spc := true; + fprintf ppf "@[<hv 1>default:@ %a@]" lam d in + fprintf ppf + "@[<1>(switch %a@ @[<v 0>%a@])@]" lam larg switch sw | Ustaticfail (i, ls) -> let lams ppf largs = List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in @@ -132,3 +160,30 @@ and sequence ppf ulam = match ulam with let clambda ppf ulam = fprintf ppf "%a@." lam ulam + + +let rec approx ppf = function + Value_closure(fundesc, a) -> + Format.fprintf ppf "@[<2>function %s@ arity %i" + fundesc.fun_label fundesc.fun_arity; + if fundesc.fun_closed then begin + Format.fprintf ppf "@ (closed)" + end; + if fundesc.fun_inline <> None then begin + Format.fprintf ppf "@ (inline)" + end; + Format.fprintf ppf "@ -> @ %a@]" approx a + | Value_tuple a -> + let tuple ppf a = + for i = 0 to Array.length a - 1 do + if i > 0 then Format.fprintf ppf ";@ "; + Format.fprintf ppf "%i: %a" i approx a.(i) + done in + Format.fprintf ppf "@[<hov 1>(%a)@]" tuple a + | Value_unknown -> + Format.fprintf ppf "_" + | Value_const c -> + fprintf ppf "@[const(%a)@]" uconstant c + | Value_global_field (s, i) -> + fprintf ppf "@[global(%s,%i)@]" s i + diff --git a/asmcomp/printclambda.mli b/asmcomp/printclambda.mli index ddc233af06..d138b958ac 100644 --- a/asmcomp/printclambda.mli +++ b/asmcomp/printclambda.mli @@ -14,3 +14,5 @@ open Clambda open Format val clambda: formatter -> ulambda -> unit +val approx: formatter -> value_approximation -> unit +val structured_constant: formatter -> ustructured_constant -> unit diff --git a/asmcomp/printcmm.ml b/asmcomp/printcmm.ml index f1c9243a08..008081fb47 100644 --- a/asmcomp/printcmm.ml +++ b/asmcomp/printcmm.ml @@ -87,7 +87,8 @@ let operation = function let rec expr ppf = function | Cconst_int n -> fprintf ppf "%i" n - | Cconst_natint n -> fprintf ppf "%s" (Nativeint.to_string n) + | Cconst_natint n | Cconst_blockheader n -> + fprintf ppf "%s" (Nativeint.to_string n) | Cconst_float s -> fprintf ppf "%s" s | Cconst_symbol s -> fprintf ppf "\"%s\"" s | Cconst_pointer n -> fprintf ppf "%ia" n diff --git a/asmcomp/printmach.ml b/asmcomp/printmach.ml index f260c3df78..824665cd9d 100644 --- a/asmcomp/printmach.ml +++ b/asmcomp/printmach.ml @@ -18,8 +18,8 @@ open Reg open Mach let reg ppf r = - if String.length r.name > 0 then - fprintf ppf "%s" r.name + if not (Reg.anonymous r) then + fprintf ppf "%s" (Reg.name r) else fprintf ppf "%s" (match r.typ with Addr -> "A" | Int -> "I" | Float -> "F"); fprintf ppf "/%i" r.stamp; @@ -103,7 +103,8 @@ let operation op arg ppf res = | Imove -> regs ppf arg | Ispill -> fprintf ppf "%a (spill)" regs arg | Ireload -> fprintf ppf "%a (reload)" regs arg - | Iconst_int n -> fprintf ppf "%s" (Nativeint.to_string n) + | Iconst_int n + | Iconst_blockheader n -> fprintf ppf "%s" (Nativeint.to_string n) | Iconst_float s -> fprintf ppf "%s" s | Iconst_symbol s -> fprintf ppf "\"%s\"" s | Icall_ind -> fprintf ppf "call %a" regs arg diff --git a/asmcomp/reg.ml b/asmcomp/reg.ml index 1ec0bf9eb9..a0fc7dfffa 100644 --- a/asmcomp/reg.ml +++ b/asmcomp/reg.ml @@ -12,12 +12,30 @@ open Cmm +module Raw_name = struct + type t = + | Anon + | R + | Ident of Ident.t + + let create_from_ident ident = Ident ident + + let to_string t = + match t with + | Anon -> None + | R -> Some "R" + | Ident ident -> + let name = Ident.name ident in + if String.length name <= 0 then None else Some name +end + type t = - { mutable name: string; + { mutable raw_name: Raw_name.t; stamp: int; typ: Cmm.machtype_component; mutable loc: location; mutable spill: bool; + mutable part: int option; mutable interf: t list; mutable prefer: (t * int) list; mutable degree: int; @@ -37,16 +55,18 @@ and stack_location = type reg = t let dummy = - { name = ""; stamp = 0; typ = Int; loc = Unknown; spill = false; - interf = []; prefer = []; degree = 0; spill_cost = 0; visited = false } + { raw_name = Raw_name.Anon; stamp = 0; typ = Int; loc = Unknown; + spill = false; interf = []; prefer = []; degree = 0; spill_cost = 0; + visited = false; part = None; + } let currstamp = ref 0 let reg_list = ref([] : t list) let create ty = - let r = { name = ""; stamp = !currstamp; typ = ty; loc = Unknown; - spill = false; interf = []; prefer = []; degree = 0; - spill_cost = 0; visited = false } in + let r = { raw_name = Raw_name.Anon; stamp = !currstamp; typ = ty; + loc = Unknown; spill = false; interf = []; prefer = []; degree = 0; + spill_cost = 0; visited = false; part = None; } in reg_list := r :: !reg_list; incr currstamp; r @@ -65,16 +85,35 @@ let createv_like rv = let clone r = let nr = create r.typ in - nr.name <- r.name; + nr.raw_name <- r.raw_name; nr let at_location ty loc = - let r = { name = "R"; stamp = !currstamp; typ = ty; loc = loc; spill = false; - interf = []; prefer = []; degree = 0; spill_cost = 0; - visited = false } in + let r = { raw_name = Raw_name.R; stamp = !currstamp; typ = ty; loc; + spill = false; interf = []; prefer = []; degree = 0; + spill_cost = 0; visited = false; part = None; } in incr currstamp; r +let anonymous t = + match Raw_name.to_string t.raw_name with + | None -> true + | Some _raw_name -> false + +let name t = + match Raw_name.to_string t.raw_name with + | None -> "" + | Some raw_name -> + let with_spilled = + if t.spill then + "spilled-" ^ raw_name + else + raw_name + in + match t.part with + | None -> with_spilled + | Some part -> with_spilled ^ "#" ^ string_of_int part + let first_virtual_reg_stamp = ref (-1) let reset() = diff --git a/asmcomp/reg.mli b/asmcomp/reg.mli index 889e026f2f..34e7498018 100644 --- a/asmcomp/reg.mli +++ b/asmcomp/reg.mli @@ -12,12 +12,18 @@ (* Pseudo-registers *) +module Raw_name : sig + type t + val create_from_ident : Ident.t -> t +end + type t = - { mutable name: string; (* Name (for printing) *) + { mutable raw_name: Raw_name.t; (* Name *) stamp: int; (* Unique stamp *) typ: Cmm.machtype_component; (* Type of contents *) mutable loc: location; (* Actual location *) mutable spill: bool; (* "true" to force stack allocation *) + mutable part: int option; (* Zero-based index of part of value *) mutable interf: t list; (* Other regs live simultaneously *) mutable prefer: (t * int) list; (* Preferences for other regs *) mutable degree: int; (* Number of other regs live sim. *) @@ -41,6 +47,11 @@ val createv_like: t array -> t array val clone: t -> t val at_location: Cmm.machtype_component -> location -> t +val anonymous : t -> bool + +(* Name for printing *) +val name : t -> string + module Set: Set.S with type elt = t module Map: Map.S with type key = t diff --git a/asmcomp/schedgen.ml b/asmcomp/schedgen.ml index 885c945404..e04eacd375 100644 --- a/asmcomp/schedgen.ml +++ b/asmcomp/schedgen.ml @@ -336,8 +336,8 @@ method private reschedule ready_queue date cont = if son.emitted_ancestors = son.ancestors then new_queue := son :: !new_queue) node.sons; - instr_cons node.instr.desc node.instr.arg node.instr.res - (self#reschedule !new_queue (date + issue_cycles) cont) + { node.instr with next = + self#reschedule !new_queue (date + issue_cycles) cont } end (* Entry point *) diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml index 8f1277a17e..0f1277f758 100644 --- a/asmcomp/selectgen.ml +++ b/asmcomp/selectgen.ml @@ -85,7 +85,7 @@ let swap_intcomp = function let all_regs_anonymous rv = try for i = 0 to Array.length rv - 1 do - if String.length rv.(i).name > 0 then raise Exit + if not (Reg.anonymous rv.(i)) then raise Exit done; true with Exit -> @@ -93,10 +93,11 @@ let all_regs_anonymous rv = let name_regs id rv = if Array.length rv = 1 then - rv.(0).name <- Ident.name id + rv.(0).raw_name <- Raw_name.create_from_ident id else for i = 0 to Array.length rv - 1 do - rv.(i).name <- Ident.name id ^ "#" ^ string_of_int i + rv.(i).raw_name <- Raw_name.create_from_ident id; + rv.(i).part <- Some i done (* "Join" two instruction sequences, making sure they return their results @@ -111,10 +112,10 @@ let join opt_r1 seq1 opt_r2 seq2 = assert (l1 = Array.length r2); let r = Array.create l1 Reg.dummy in for i = 0 to l1-1 do - if String.length r1.(i).name = 0 then begin + if Reg.anonymous r1.(i) then begin r.(i) <- r1.(i); seq2#insert_move r2.(i) r1.(i) - end else if String.length r2.(i).name = 0 then begin + end else if Reg.anonymous r2.(i) then begin r.(i) <- r2.(i); seq1#insert_move r1.(i) r2.(i) end else begin @@ -391,6 +392,9 @@ method emit_expr env exp = | Cconst_natint n -> let r = self#regs_for typ_int in Some(self#insert_op (Iconst_int n) [||] r) + | Cconst_blockheader n -> + let r = self#regs_for typ_int in + Some(self#insert_op (Iconst_blockheader n) [||] r) | Cconst_float n -> let r = self#regs_for typ_float in Some(self#insert_op (Iconst_float n) [||] r) @@ -433,6 +437,8 @@ method emit_expr env exp = Some(self#emit_tuple ext_env simple_list) end | Cop(Craise (k, dbg), [arg]) -> + if !Clflags.debug && k <> Lambda.Raise_notrace then + Proc.contains_calls := true; (* PR#6239 *) begin match self#emit_expr env arg with None -> None | Some r1 -> diff --git a/asmcomp/sparc/emit.mlp b/asmcomp/sparc/emit.mlp index 1d0699fb44..12d60ed327 100644 --- a/asmcomp/sparc/emit.mlp +++ b/asmcomp/sparc/emit.mlp @@ -302,7 +302,7 @@ let rec emit_instr i dslot = | (_, _) -> fatal_error "Emit: Imove" end - | Lop(Iconst_int n) -> + | Lop(Iconst_int n | Iconst_blockheader n) -> if is_native_immediate n then ` mov {emit_nativeint n}, {emit_reg i.res.(0)}\n` else begin @@ -609,7 +609,7 @@ let is_one_instr i = begin match op with Imove | Ispill | Ireload -> i.arg.(0).typ <> Float && i.res.(0).typ <> Float - | Iconst_int n -> is_native_immediate n + | Iconst_int n | Iconst_blockheader n -> is_native_immediate n | Istackoffset _ -> true | Iload(_, Iindexed n) -> i.res.(0).typ <> Float && is_immediate n | Istore(_, Iindexed n) -> i.arg.(0).typ <> Float && is_immediate n diff --git a/asmcomp/spill.ml b/asmcomp/spill.ml index 0d8fcdc9c5..ca17fe5bf6 100644 --- a/asmcomp/spill.ml +++ b/asmcomp/spill.ml @@ -40,7 +40,7 @@ let spill_reg r = with Not_found -> let spill_r = Reg.create r.typ in spill_r.spill <- true; - if String.length r.name > 0 then spill_r.name <- "spilled-" ^ r.name; + if not (Reg.anonymous r) then spill_r.raw_name <- r.raw_name; spill_env := Reg.Map.add r spill_r !spill_env; spill_r diff --git a/asmcomp/strmatch.ml b/asmcomp/strmatch.ml new file mode 100644 index 0000000000..760540d8a3 --- /dev/null +++ b/asmcomp/strmatch.ml @@ -0,0 +1,386 @@ +(***********************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + +(* Translation of string matching from closed lambda to C-- *) + +open Lambda +open Cmm + +module type I = sig + val string_block_length : Cmm.expression -> Cmm.expression + val transl_switch : + Cmm.expression -> int -> int -> + (int * Cmm.expression) list -> Cmm.expression -> + Cmm.expression +end + +module Make(I:I) = struct + +(* Debug *) + + let dbg = false + + let mask = + let open Nativeint in + sub (shift_left one 8) one + + let pat_as_string p = + let rec digits k n p = + if n <= 0 then k + else + let d = Nativeint.to_int (Nativeint.logand mask p) in + let d = Char.escaped (Char.chr d) in + digits (d::k) (n-1) (Nativeint.shift_right_logical p 8) in + let ds = digits [] Arch.size_addr p in + let ds = + if Arch.big_endian then ds else List.rev ds in + String.concat "" ds + + let do_pp_cases chan cases = + List.iter + (fun (ps,_) -> + Printf.fprintf chan " [%s]\n" + (String.concat "; " (List.map pat_as_string ps))) + cases + + let pp_cases chan tag cases = + Printf.eprintf "%s:\n" tag ; + do_pp_cases chan cases + + let pp_match chan tag idxs cases = + Printf.eprintf + "%s: idx=[%s]\n" tag + (String.concat "; " (List.map string_of_int idxs)) ; + do_pp_cases chan cases + +(* Utilities *) + + let gen_cell_id () = Ident.create "cell" + let gen_size_id () = Ident.create "size" + + let mk_let_cell id str ind body = + let cell = + Cop(Cload Word,[Cop(Cadda,[str;Cconst_int(Arch.size_int*ind)])]) in + Clet(id, cell, body) + + let mk_let_size id str body = + let size = I.string_block_length str in + Clet(id, size, body) + + let mk_cmp_gen cmp_op id nat ifso ifnot = + let test = Cop (Ccmpi cmp_op, [ Cvar id; Cconst_natpointer nat ]) in + Cifthenelse (test, ifso, ifnot) + + let mk_lt = mk_cmp_gen Clt + let mk_eq = mk_cmp_gen Ceq + + module IntArg = + struct + type t = int + let compare (x:int) (y:int) = + if x < y then -1 + else if x > y then 1 + else 0 + end + + let interval m0 n = + let rec do_rec m = + if m >= n then [] + else m::do_rec (m+1) in + do_rec m0 + + +(*****************************************************) +(* Compile strings to a lists of words [native ints] *) +(*****************************************************) + + let pat_of_string str = + let len = String.length str in + let n = len / Arch.size_addr + 1 in + let get_byte i = + if i < len then int_of_char str.[i] + else if i < n * Arch.size_addr - 1 then 0 + else n * Arch.size_addr - 1 - len in + let mk_word ind = + let w = ref 0n in + let imin = ind * Arch.size_addr + and imax = (ind + 1) * Arch.size_addr - 1 in + if Arch.big_endian then + for i = imin to imax do + w := Nativeint.logor (Nativeint.shift_left !w 8) + (Nativeint.of_int (get_byte i)); + done + else + for i = imax downto imin do + w := Nativeint.logor (Nativeint.shift_left !w 8) + (Nativeint.of_int (get_byte i)); + done; + !w in + let rec mk_words ind = + if ind >= n then [] + else mk_word ind::mk_words (ind+1) in + mk_words 0 + +(*****************************) +(* Discriminating heuristics *) +(*****************************) + + module IntSet = Set.Make(IntArg) + module NativeSet = Set.Make(Nativeint) + + let rec add_one sets ps = match sets,ps with + | [],[] -> [] + | set::sets,p::ps -> + let sets = add_one sets ps in + NativeSet.add p set::sets + | _,_ -> assert false + + let count_arities cases = match cases with + | [] -> assert false + | (ps,_)::_ -> + let sets = + List.fold_left + (fun sets (ps,_) -> add_one sets ps) + (List.map (fun _ -> NativeSet.empty) ps) cases in + List.map NativeSet.cardinal sets + + let count_arities_first cases = + let set = + List.fold_left + (fun set case -> match case with + | (p::_,_) -> NativeSet.add p set + | _ -> assert false) + NativeSet.empty cases in + NativeSet.cardinal set + + let count_arities_length cases = + let set = + List.fold_left + (fun set (ps,_) -> IntSet.add (List.length ps) set) + IntSet.empty cases in + IntSet.cardinal set + + let best_col = + let rec do_rec kbest best k = function + | [] -> kbest + | x::xs -> + if x < best then + do_rec k x (k+1) xs + else + do_rec kbest best (k+1) xs in + let smallest = do_rec (-1) max_int 0 in + fun cases -> + let ars = count_arities cases in + smallest ars + + let swap_list = + let rec do_rec k xs = match xs with + | [] -> assert false + | x::xs -> + if k <= 0 then [],x,xs + else + let xs,mid,ys = do_rec (k-1) xs in + x::xs,mid,ys in + fun k xs -> + let xs,x,ys = do_rec k xs in + x::xs @ ys + + let swap k idxs cases = + if k = 0 then idxs,cases + else + let idxs = swap_list k idxs + and cases = + List.map + (fun (ps,act) -> swap_list k ps,act) + cases in + if dbg then begin + pp_match stderr "SWAP" idxs cases + end ; + idxs,cases + + let best_first idxs cases = match idxs with + | []|[_] -> idxs,cases (* optimisation: one column only *) + | _ -> + let k = best_col cases in + swap k idxs cases + +(************************************) +(* Divide according to first column *) +(************************************) + + module Divide(O:Set.OrderedType) = struct + + module OMap = Map.Make(O) + + let do_find key env = + try OMap.find key env + with Not_found -> assert false + + + let divide cases = + let env = + List.fold_left + (fun env (p,psact) -> + let old = + try OMap.find p env + with Not_found -> [] in + OMap.add p ((psact)::old) env) + OMap.empty cases in + let r = OMap.fold (fun key v k -> (key,v)::k) env [] in + List.rev r (* Now sorted *) + end + +(***************) +(* Compilation *) +(***************) + +(* Group by cell *) + + module DivideNative = Divide(Nativeint) + + let by_cell cases = + DivideNative.divide + (List.map + (fun case -> match case with + | (p::ps),act -> p,(ps,act) + | [],_ -> assert false) + cases) + +(* Split into two halves *) + + let rec do_split idx env = match env with + | [] -> assert false + | (midkey,_ as x)::rem -> + if idx <= 0 then [],midkey,env + else + let lt,midkey,ge = do_split (idx-1) rem in + x::lt,midkey,ge + + let split_env len env = do_split (len/2) env + +(* Switch according to one cell *) + +(* + Emit the switch, here as a comparison tree. + Argument compile_rec is to be called to compile the rest of patterns, + as match_on_cell can be called in two different contexts : + from do_compile_pats and top_compile below. + *) + let match_oncell compile_rec str default idx env = + let id = gen_cell_id () in + let rec comp_rec env = + let len = List.length env in + if len <= 3 then + List.fold_right + (fun (key,cases) ifnot -> + mk_eq id key + (compile_rec str default cases) + ifnot) + env default + else + let lt,midkey,ge = split_env len env in + mk_lt id midkey (comp_rec lt) (comp_rec ge) in + mk_let_cell id str idx (comp_rec env) + + +(* + Recursive 'list of cells' compile function: + - choose the matched cell and switch on it + - notice: patterns (and idx) all have the same length + *) + + let rec do_compile_pats idxs str default cases = + if dbg then begin + pp_match stderr "COMPILE" idxs cases + end ; + match idxs with + | [] -> + begin match cases with + | [] -> default + | (_,e)::_ -> e + end + | _::_ -> + let idxs,cases = best_first idxs cases in + begin match idxs with + | [] -> assert false + | idx::idxs -> + match_oncell + (do_compile_pats idxs) str default idx (by_cell cases) + end + + +(* Group by size *) + + module DivideInt = Divide(IntArg) + + + let by_size cases = + DivideInt.divide + (List.map + (fun (ps,_ as case) -> List.length ps,case) + cases) +(* + Switch according to pattern size + Argument from_ind is the starting index, it can be zero + or one (when the swicth on the cell 0 has already been performed. + In that latter case pattern len is string length-1 and is corrected. + *) + + let compile_by_size from_ind str default cases = + let size_cases = + List.map + (fun (len,cases) -> + let len = len+from_ind in + let act = + do_compile_pats + (interval from_ind len) + str default cases in + (len,act)) + (by_size cases) in + let id = gen_size_id () in + let switch = I.transl_switch (Cvar id) 1 max_int size_cases default in + mk_let_size id str switch + +(* + Compilation entry point: we choose to switch + either on size or on first cell, using the + 'least discriminant' heuristics. + *) + let top_compile str default cases = + let a_len = count_arities_length cases + and a_fst = count_arities_first cases in + if a_len <= a_fst then begin + if dbg then pp_cases stderr "SIZE" cases ; + compile_by_size 0 str default cases + end else begin + if dbg then pp_cases stderr "FIRST COL" cases ; + let compile_size_rest str default cases = + compile_by_size 1 str default cases in + match_oncell compile_size_rest str default 0 (by_cell cases) + end + +(* Module entry point *) + + let catch arg k = match arg with + | Cexit (e,[]) -> k arg + | _ -> + let e = next_raise_count () in + Ccatch (e,[],k (Cexit (e,[])),arg) + + let compile str default cases = + let cases = + List.rev_map + (fun (s,act) -> pat_of_string s,act) + cases in + catch default (fun default -> top_compile str default cases) + + end diff --git a/asmcomp/strmatch.mli b/asmcomp/strmatch.mli new file mode 100644 index 0000000000..9be2b69451 --- /dev/null +++ b/asmcomp/strmatch.mli @@ -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 Q Public License version 1.0. *) +(* *) +(***********************************************************************) + +(* Translation of string matching from closed lambda to C-- *) + +module type I = sig + val string_block_length : Cmm.expression -> Cmm.expression + val transl_switch : + Cmm.expression -> int -> int -> + (int * Cmm.expression) list -> Cmm.expression -> + Cmm.expression +end + +module Make(I:I) : sig + (* Compile stringswitch (arg,cases,d) + Note: cases should not contain string duplicates *) + val compile : Cmm.expression (* arg *) -> Cmm.expression (* d *) -> + (string * Cmm.expression) list (* cases *)-> Cmm.expression +end diff --git a/asmrun/.depend b/asmrun/.depend index c8e6f5c783..bec9f0c076 100644 --- a/asmrun/.depend +++ b/asmrun/.depend @@ -1,753 +1,756 @@ 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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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/../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 + ../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 + ../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 + ../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 + ../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 + ../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 ../byterun/int64_native.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 ../byterun/int64_native.h intern.o: intern.c ../byterun/alloc.h ../byterun/misc.h \ - ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/mlvalues.h ../byterun/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 + ../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 ../byterun/int64_native.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 ../byterun/int64_native.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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 \ - ../byterun/int64_native.h + ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \ + ../byterun/fail.h ../byterun/mlvalues.h ../byterun/misc.h \ + ../byterun/int64_native.h sys.o: sys.c ../byterun/config.h ../byterun/../config/m.h \ - ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \ - ../byterun/config.h ../byterun/mlvalues.h ../byterun/debugger.h \ - ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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/../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 + ../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 + ../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 + ../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 + ../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 + ../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 ../byterun/int64_native.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 ../byterun/int64_native.h intern.d.o: intern.c ../byterun/alloc.h ../byterun/misc.h \ - ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/mlvalues.h ../byterun/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 + ../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 ../byterun/int64_native.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 ../byterun/int64_native.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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 \ - ../byterun/int64_native.h + ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \ + ../byterun/fail.h ../byterun/mlvalues.h ../byterun/misc.h \ + ../byterun/int64_native.h sys.d.o: sys.c ../byterun/config.h ../byterun/../config/m.h \ - ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \ - ../byterun/config.h ../byterun/mlvalues.h ../byterun/debugger.h \ - ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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/../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 + ../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 + ../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 + ../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 + ../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 + ../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 ../byterun/int64_native.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 ../byterun/int64_native.h intern.p.o: intern.c ../byterun/alloc.h ../byterun/misc.h \ - ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/mlvalues.h ../byterun/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 + ../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 ../byterun/int64_native.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 ../byterun/int64_native.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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 + ../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 \ - ../byterun/int64_native.h + ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \ + ../byterun/fail.h ../byterun/mlvalues.h ../byterun/misc.h \ + ../byterun/int64_native.h sys.p.o: sys.c ../byterun/config.h ../byterun/../config/m.h \ - ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \ - ../byterun/config.h ../byterun/mlvalues.h ../byterun/debugger.h \ - ../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 + ../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 + ../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 + ../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 + ../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 diff --git a/asmrun/amd64.S b/asmrun/amd64.S index 1b54c4ff39..d2e007529d 100644 --- a/asmrun/amd64.S +++ b/asmrun/amd64.S @@ -32,7 +32,7 @@ .align FUNCTION_ALIGN; \ name: -#elif defined(SYS_mingw64) +#elif defined(SYS_mingw64) || defined(SYS_cygwin) #define LBL(x) .L##x #define G(r) r @@ -90,7 +90,7 @@ #endif -#if defined(__PIC__) && !defined(SYS_mingw64) +#if defined(__PIC__) && !defined(SYS_mingw64) && !defined(SYS_cygwin) /* Position-independent operations on global variables. */ @@ -179,7 +179,7 @@ /* Save and restore all callee-save registers on stack. Keep the stack 16-aligned. */ -#if defined(SYS_mingw64) +#if defined(SYS_mingw64) || defined(SYS_cygwin) /* Win64 API: callee-save regs are rbx, rbp, rsi, rdi, r12-r15, xmm6-xmm15 */ @@ -249,7 +249,7 @@ #endif -#ifdef SYS_mingw64 +#if defined(SYS_mingw64) || defined (SYS_cygwin) /* Calls from OCaml to C must reserve 32 bytes of extra stack space */ # define PREPARE_FOR_C_CALL subq $32, %rsp; CFI_ADJUST(32) # define CLEANUP_AFTER_C_CALL addq $32, %rsp; CFI_ADJUST(-32) @@ -271,7 +271,7 @@ FUNCTION(G(caml_call_gc)) CFI_STARTPROC RECORD_STACK_FRAME(0) LBL(caml_call_gc): -#ifndef SYS_mingw64 +#if !defined(SYS_mingw64) && !defined(SYS_cygwin) /* Touch the stack to trigger a recoverable segfault if insufficient space remains */ subq $32768, %rsp @@ -448,7 +448,7 @@ LBL(caml_c_call): STORE_VAR(%r12, caml_last_return_address) STORE_VAR(%rsp, caml_bottom_of_stack) subq $8, %rsp; CFI_ADJUST(8) /* equivalent to pushq %r12 */ -#ifndef SYS_mingw64 +#if !defined(SYS_mingw64) && !defined(SYS_cygwin) /* Touch the stack to trigger a recoverable segfault if insufficient space remains */ subq $32768, %rsp @@ -517,7 +517,7 @@ CFI_ENDPROC /* Registers holding arguments of C functions. */ -#ifdef SYS_mingw64 +#if defined(SYS_mingw64) || defined(SYS_cygwin) #define C_ARG_1 %rcx #define C_ARG_2 %rdx #define C_ARG_3 %r8 @@ -674,7 +674,7 @@ G(caml_system__frametable): #if defined(SYS_macosx) .literal16 -#elif defined(SYS_mingw64) +#elif defined(SYS_mingw64) || defined(SYS_cygwin) .section .rdata,"dr" #else .section .rodata.cst8,"a",@progbits diff --git a/asmrun/power-elf.S b/asmrun/power-elf.S index 94f4a29d4c..dfbf5b97a3 100644 --- a/asmrun/power-elf.S +++ b/asmrun/power-elf.S @@ -200,31 +200,87 @@ caml_c_call: /* Reload allocation pointer and allocation limit*/ Loadglobal(31, caml_young_ptr, 11) Loadglobal(30, caml_young_limit, 11) - /* Say we are back into OCaml code */ - li 12, 0 - Storeglobal(12, caml_last_return_address, 11) /* Return to caller */ blr +/* Raise an exception from OCaml */ + .globl caml_raise_exn + .type caml_raise_exn, @function +caml_raise_exn: + Loadglobal(0, caml_backtrace_active, 11) + cmpwi 0, 0 + bne .L111 +.L110: + /* Pop trap frame */ + lwz 0, 0(29) + mr 1, 29 + mtctr 0 + lwz 29, 4(29) + addi 1, 1, 16 + /* Branch to handler */ + bctr +.L111: + li 0, 0 + Storeglobal(0, caml_backtrace_pos, 11) +.L112: + mr 28, 3 /* preserve exn bucket in callee-save reg */ + /* arg1: exception bucket, already in r3 */ + mflr 4 /* arg2: PC of raise */ + mr 5, 1 /* arg3: SP of raise */ + mr 6, 29 /* arg4: SP of handler */ + addi 1, 1, -16 /* reserve stack space for C call */ + bl caml_stash_backtrace + mr 3, 28 /* restore exn bucket */ + b .L110 /* raise the exn */ + + .globl caml_reraise_exn + .type caml_reraise_exn, @function +caml_reraise_exn: + Loadglobal(0, caml_backtrace_active, 11) + cmpwi 0, 0 + bne- .L112 + /* Pop trap frame */ + lwz 0, 0(29) + mr 1, 29 + mtctr 0 + lwz 29, 4(29) + addi 1, 1, 16 + /* Branch to handler */ + bctr + /* Raise an exception from C */ .globl caml_raise_exception .type caml_raise_exception, @function caml_raise_exception: + Loadglobal(0, caml_backtrace_active, 11) + cmpwi 0, 0 + bne .L121 +.L120: /* Reload OCaml global registers */ Loadglobal(1, caml_exception_pointer, 11) Loadglobal(31, caml_young_ptr, 11) Loadglobal(30, caml_young_limit, 11) - /* Say we are back into OCaml code */ - li 0, 0 - Storeglobal(0, caml_last_return_address, 11) /* Pop trap frame */ lwz 0, 0(1) lwz 29, 4(1) - mtlr 0 + mtctr 0 addi 1, 1, 16 /* Branch to handler */ - blr + bctr +.L121: + li 0, 0 + Storeglobal(0, caml_backtrace_pos, 11) + mr 28, 3 /* preserve exn bucket in callee-save reg */ + /* arg1: exception bucket, already in r3 */ + Loadglobal(4, caml_last_return_address, 11) /* arg2: PC of raise */ + Loadglobal(5, caml_bottom_of_stack, 11) /* arg3: SP of raise */ + Loadglobal(6, caml_exception_pointer, 11) /* arg4: SP of handler */ + addi 1, 1, -16 /* reserve stack space for C call */ + bl caml_stash_backtrace + mr 3, 28 /* restore exn bucket */ + b .L120 /* raise the exn */ + /* Start the OCaml program */ diff --git a/asmrun/power-rhapsody.S b/asmrun/power-rhapsody.S index 309c955b19..a228cc1d53 100644 --- a/asmrun/power-rhapsody.S +++ b/asmrun/power-rhapsody.S @@ -36,6 +36,14 @@ addis $2, 0, ha16($1) stg $0, lo16($1)($2) .endmacro +.macro Loadglobal32 /* reg,glob,tmp */ + addis $2, 0, ha16($1) + lwz $0, lo16($1)($2) +.endmacro +.macro Storeglobal32 /* reg,glob,tmp */ + addis $2, 0, ha16($1) + stw $0, lo16($1)($2) +.endmacro .text @@ -234,21 +242,22 @@ _caml_c_call: /* Raise an exception from OCaml */ .globl _caml_raise_exn _caml_raise_exn: - addis r11, 0, ha16(_caml_backtrace_active) - lwz r11, lo16(_caml_backtrace_active)(r11) + Loadglobal32 r11, _caml_backtrace_active, r11 cmpwi r11, 0 bne L110 L111: /* Pop trap frame */ lg r0, 0(r29) mr r1, r29 - mtlr r0 + mtctr r0 lg r29, WORD(r1) addi r1, r1, 16 /* Branch to handler */ - blr - + bctr L110: + li r0, 0 + Storeglobal32 r0, _caml_backtrace_pos, r11 +L114: mr r28, r3 /* preserve exn bucket in callee-save */ /* arg 1: exception bucket (already in r3) */ mflr r4 /* arg 2: PC of raise */ @@ -259,12 +268,25 @@ L110: mr r3, r28 b L111 -/* Raise an exception from C */ + .globl _caml_reraise_exn +_caml_reraise_exn: + Loadglobal32 r11, _caml_backtrace_active, r11 + cmpwi r11, 0 + bne- L114 + /* Pop trap frame */ + lg r0, 0(r29) + mr r1, r29 + mtctr r0 + lg r29, WORD(r1) + addi r1, r1, 16 + /* Branch to handler */ + bctr + + /* Raise an exception from C */ .globl _caml_raise_exception _caml_raise_exception: - addis r11, 0, ha16(_caml_backtrace_active) - lwz r11, lo16(_caml_backtrace_active)(r11) + Loadglobal32 r11, _caml_backtrace_active, r11 cmpwi r11, 0 bne L112 L113: @@ -278,10 +300,10 @@ L113: /* Pop trap frame */ lg r0, 0(r1) lg r29, WORD(r1) - mtlr r0 + mtctr r0 addi r1, r1, 16 /* Branch to handler */ - blr + bctr L112: mr r28, r3 /* preserve exn bucket in callee-save */ /* arg 1: exception bucket (already in r3) */ diff --git a/asmrun/signals_asm.c b/asmrun/signals_asm.c index 4f62bd38a9..df76c50102 100644 --- a/asmrun/signals_asm.c +++ b/asmrun/signals_asm.c @@ -166,10 +166,8 @@ DECLARE_SIGNAL_HANDLER(trap_handler) #endif caml_exception_pointer = (char *) CONTEXT_EXCEPTION_POINTER; caml_young_ptr = (char *) CONTEXT_YOUNG_PTR; -#if defined(SYS_rhapsody) caml_bottom_of_stack = (char *) CONTEXT_SP; caml_last_return_address = (uintnat) CONTEXT_PC; -#endif caml_array_bound_error(); } #endif diff --git a/asmrun/signals_osdep.h b/asmrun/signals_osdep.h index 68ec837997..573e3a5716 100644 --- a/asmrun/signals_osdep.h +++ b/asmrun/signals_osdep.h @@ -253,6 +253,7 @@ #define CONTEXT_EXCEPTION_POINTER (context->regs->gpr[29]) #define CONTEXT_YOUNG_LIMIT (context->regs->gpr[30]) #define CONTEXT_YOUNG_PTR (context->regs->gpr[31]) + #define CONTEXT_SP (context->regs->gpr[1]) /****************** PowerPC, BSD */ diff --git a/boot/.ignore b/boot/.ignore index 8165156d9a..30c5866b7c 100644 --- a/boot/.ignore +++ b/boot/.ignore @@ -4,5 +4,3 @@ ocamlrun.exe ocamlyacc ocamlyacc.exe camlheader -myocamlbuild -myocamlbuild.native diff --git a/boot/myocamlbuild.boot b/boot/myocamlbuild.boot Binary files differdeleted file mode 100755 index 3437423b91..0000000000 --- a/boot/myocamlbuild.boot +++ /dev/null diff --git a/boot/ocamlc b/boot/ocamlc Binary files differindex 96bd4ced63..60a2ecb429 100755 --- a/boot/ocamlc +++ b/boot/ocamlc diff --git a/boot/ocamldep b/boot/ocamldep Binary files differindex 2e31e4c6e4..f2e26672a4 100755 --- a/boot/ocamldep +++ b/boot/ocamldep diff --git a/boot/ocamllex b/boot/ocamllex Binary files differindex 88da8bab4c..51eadf10ce 100755 --- a/boot/ocamllex +++ b/boot/ocamllex diff --git a/build/.ignore b/build/.ignore deleted file mode 100644 index 274c6e555b..0000000000 --- a/build/.ignore +++ /dev/null @@ -1 +0,0 @@ -ocamlbuild_mixed_mode diff --git a/build/boot-c-parts.sh b/build/boot-c-parts.sh deleted file mode 100755 index fd5a35c72b..0000000000 --- a/build/boot-c-parts.sh +++ /dev/null @@ -1,50 +0,0 @@ -#!/bin/sh - -######################################################################### -# # -# OCaml # -# # -# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # -# # -# Copyright 2007 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### - -cd `dirname $0`/.. -set -ex - -. config/config.sh - -if "$WINDOWS"; then - MAKEOPTS='-f Makefile.nt' - LINK='cp -f' -else - MAKEOPTS='' - LINK='ln -s -f' -fi - -(cd byterun && make $MAKEOPTS) -(cd asmrun && make $MAKEOPTS all meta."$O" dynlink."$O") -(cd yacc && make $MAKEOPTS) - -if "$WINDOWS"; then - (cd win32caml && make) -fi - -mkdir -p _build/boot - -# Create a bunch of symlinks (or copies) to _build/boot -(cd _build/boot && -$LINK ../../byterun/ocamlrun$EXE \ - ../../byterun/libcamlrun.$A \ - ../../asmrun/libasmrun.$A \ - ../../yacc/ocamlyacc$EXE \ - ../../boot/ocamlc \ - ../../boot/ocamllex \ - ../../boot/ocamldep \ - . ) - -(cd boot && -[ -f boot/ocamlrun$EXE ] || $LINK ../byterun/ocamlrun$EXE . ) diff --git a/build/boot.sh b/build/boot.sh deleted file mode 100755 index ca6eaabacd..0000000000 --- a/build/boot.sh +++ /dev/null @@ -1,39 +0,0 @@ -#!/bin/sh - -######################################################################### -# # -# OCaml # -# # -# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # -# # -# Copyright 2007 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### - -cd `dirname $0`/.. -set -ex -TAG_LINE='true: -use_stdlib' - -STDLIB_MODULES='Pervasives,Arg,Array,Buffer,Char,Digest,Filename,Format,Hashtbl,Lazy,Lexing,List,Map,Printexc,Printf,Scanf,Set,String,Sys,Parsing,Int32,Int64,Nativeint,Obj,Queue,Sort,Stream,Stack' - -./boot/ocamlrun boot/myocamlbuild.boot -ignore "$STDLIB_MODULES" \ - -tag-line "$TAG_LINE" -no-ocamlfind \ - boot/stdlib.cma boot/std_exit.cmo - -boot/ocamlrun boot/myocamlbuild.boot \ - -tag-line "$TAG_LINE" -no-ocamlfind -log _boot_log1 \ - ocamlbuild/ocamlbuildlightlib.cma ocamlbuild/ocamlbuildlight.byte - -rm -f _build/myocamlbuild - -boot/ocamlrun boot/myocamlbuild.boot \ - -just-plugin -install-lib-dir _build/ocamlbuild -byte-plugin \ - -no-ocamlfind || exit 1 - -cp _build/myocamlbuild boot/myocamlbuild - -./boot/ocamlrun boot/myocamlbuild -no-ocamlfind \ - -tag-line "$TAG_LINE" \ - $@ -log _boot_log2 boot/camlheader ocamlc diff --git a/build/buildbot b/build/buildbot deleted file mode 100755 index d7e010365f..0000000000 --- a/build/buildbot +++ /dev/null @@ -1,119 +0,0 @@ -#!/bin/sh - -######################################################################### -# # -# OCaml # -# # -# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # -# # -# Copyright 2007 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### - -# If you want to help me by participating to the build/test effort: -# http://gallium.inria.fr/~pouillar/ocaml-testing.html -# -- Nicolas Pouillard - -usage() { - echo "Usage: $0 (make|ocb|ocamlbuild) (win (mingw|msvc|msvc64) | <configure-arg>*)" - exit 1 -} - -logfile="buildbot.log" - -finish() { - curl -s -0 -F "log=@$logfile" \ - -F "host=`hostname`" \ - -F "mode=$mode-$opt_win-$opt_win2" \ - http://buildbot.feydakins.org/dropbox || : -} - -rm -f buildbot.failed -rm -f $logfile - -bad() { - touch buildbot.failed -} - -finish_if_bad() { - if [ -f buildbot.failed ]; then - finish - exit 2 - fi -} - -if figlet "test" > /dev/null 2> /dev/null; then - draw="figlet" -else - draw="echo ----------- " -fi - -if echo | tee -a tee.log > /dev/null 2> /dev/null; then - tee="tee -a $logfile" -else - tee=: -fi - -rm -f tee.log - -log() { - $draw $@ - $tee -} - -mode=$1 -shift 1 - -case "$mode" in - make|ocb|ocamlbuild) : ;; - *) usage;; -esac - -case "$1" in - win) - opt_win=win - opt_win2=$2 - shift 2 - Makefile=Makefile.nt;; - *) Makefile=Makefile;; -esac - -( [ -f config/Makefile ] && make -f $Makefile clean || : ) 2>&1 | log clean - -( ./build/distclean.sh || : ) 2>&1 | log distclean - -(cvs -q up -dP -r release311 || bad) 2>&1 | log cvs up -finish_if_bad - -case "$opt_win" in -win) - cp config/m-nt.h config/m.h || bad - finish_if_bad - cp config/s-nt.h config/s.h || bad - finish_if_bad - ;; - -*) - (./configure --prefix `pwd`/_install $@ || bad) 2>&1 | log configure - finish_if_bad - ;; -esac - -case "$mode" in - make) - (make -f $Makefile world opt opt.opt install || bad) 2>&1 | log build install - finish_if_bad - ;; - ocb|ocamlbuild) - (./build/fastworld.sh || bad) 2>&1 | log build - finish_if_bad - (./build/install.sh || bad) 2>&1 | log install - finish_if_bad - ;; -esac - -(cat _build/not_installed || bad) 2>&1 | log not_installed - -finish diff --git a/build/camlp4-bootstrap-recipe.txt b/build/camlp4-bootstrap-recipe.txt deleted file mode 100644 index 8a3a7b1226..0000000000 --- a/build/camlp4-bootstrap-recipe.txt +++ /dev/null @@ -1,180 +0,0 @@ -######################################################################### -# # -# OCaml # -# # -# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # -# # -# Copyright 2010 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### - -=== Initial setup === - make clean - ./build/distclean.sh - ./configure -prefix `pwd`/_install - ./build/fastworld.sh - # Go to "Bootstrap camlp4" - -=== Install the bootstrapping camlp4 processor === - ./build/install.sh - -=== Build camlp4 === - # This step is not needed right after a "./build/world.sh byte" - ./build/camlp4-byte-only.sh - -=== Bootstrap camlp4 === - # First "Build camlp4" - # Then "Install the bootstrapping camlp4 processor" - # Indeed the following bootstrapping script - # does use the installed version! - ./build/camlp4-bootstrap.sh - # If the fixpoint not is reached yet - # Go to "Bootstrap camlp4" - # Otherwise - # Have a look at the changes in - # camlp4/boot it may be a good idea to commit them - -=== Generate Camlp4Ast.ml === - # First "Install the bootstrapping camlp4 processor" - # Indeed the following bootstrapping script - # does use the installed version! - ./build/camlp4-mkCamlp4Ast.sh - -=== Case study "let open M in e" === - - Open the revised parser - Camlp4Parsers/Camlp4OCamlRevisedParser.ml - - Look for similar constructs, indeed rules - that start by the same prefix should in - the same entry. It is simpler to stick - them close to each other. - - [ "let"; r = opt_rec; ... - | "let"; "module"; m = a_UIDENT; ... - - So we naturally add something like - - | "let"; "open"; ... - - Then have a look to the "open" construct: - - | "open"; i = module_longident -> - - So we need a module_longident, it becomes: - - | "let"; "open"; i = module_longident; "in"; e = SELF -> - - Then we leave a dummy action but very close to what we want - in the end: - - | "let"; "open"; i = module_longident; "in"; e = SELF -> - <:expr< open_in $id:i$ $e$ >> - - Here it is just calling a (non-existing) function called open_in. - - Check that there is no other place where we have to duplicate this - rule (yuk!). In our case it is! The sequence entry have the "let" - rules again. - - Then go into Camlp4Parsers/Camlp4OCamlParser.ml and look for other - occurences. - - When copy/pasting the rule take care of SELF occurences, you may - have to replace it by expr and expr LEVEL ";" in our case. - - The return type of the production might be different from expr in - our case an action become <:str_item<...>> instead of <:expr<...> - - Watch the DELETE_RULE as well, in our case I'm searching for the - literal string "let" in the source: - - DELETE_RULE Gram expr: "let"; "open"; module_longident; "in"; SELF END; - - Then build and bootstrap. - - Then you can at last extend the AST, go in: - - Camlp4/Camlp4Ast.partial.ml - - And add the "open in" constructor (at the end). - - (* let open i in e *) - | ExOpI of loc and ident and expr - - Then "Generate Camlp4Ast.ml" and build. - - We get a single warning in Camlp4/Struct/Camlp4Ast2OCamlAst.ml but - don't fix it now. Notice that you may need to disable '-warn-error' - in order to be able to successfully compile, despite of the warning. - - Then I hacked the camlp4/boot/camlp4boot.ml to generate: - Ast.ExOpI(_loc, i, e) - instead of - Ast.ExApp(_loc .... "open_in" ... i ... e ...) - - Build. Bootstrap once and build again. - - Then change the parsers again and replace the - open_in $id:i$ $e$ - by - let open $i$ in $e$ - - Then change the Parsetree generation in - Camlp4/Struct/Camlp4Ast2OCamlAst.ml - - | <:expr@loc< let open $i$ in $e$ >> -> - mkexp loc (Pexp_open (long_uident i) (expr e)) - - Change the pretty-printers as well (drawing inspiration in - "let module" in this case): - - In Camlp4/Printers/OCaml.ml: - | <:expr< let open $i$ in $e$ >> -> - pp f "@[<2>let open %a@]@ @[<2>in@ %a@]" - o#ident i o#reset_semi#expr e - And at the end of #simple_expr: - <:expr< let open $_$ in $_$ >> - - Have a look in Camlp4/Printers/OCamlr.ml as well. - -=== Second case study "with t := ..." === - -1/ Change the revised parser first. -Add new parsing rules for := but keep the old actions for now. - -2/ Change Camlp4Ast.partial.ml, add: - (* type t := t *) - | WcTyS of loc and ctyp and ctyp - (* module i := i *) - | WcMoS of loc and ident and ident - -3/ "Generate Camlp4Ast.ml" and build. - -4/ Change the generated camlp4/boot/camlp4boot.ml: - Look for ":=" and change occurences of - WcMod by WcMoS and WcTyp by WcTyS - -5/ Build (DO NOT bootstrap) - "Install the bootstrapping camlp4 processor" - -6/ Change the required files: - Camlp4/Printers/OCaml.ml: - just copy/paste&adapt what is done for - "... with type t = u" and - "... with module M = N" - Camlp4/Struct/Camlp4Ast2OCamlAst.ml: - I've factored out a common part under - another function and then copy/pasted. - Camlp4Parsers/Camlp4OCamlRevisedParser.ml: - Change the <:with_constr< type $...$ = $...$ >> - we've introduced earlier by replacing the '=' - by ':='. - Camlp4Parsers/Camlp4OCamlParser.ml: - Copy paste what we have done in Camlp4OCamlRevisedParser - and but we need to call opt_private_ctyp instead of - ctyp (just like the "type =" construct). - -7/ Build & Bootstrap diff --git a/build/camlp4-bootstrap.sh b/build/camlp4-bootstrap.sh deleted file mode 100755 index 70600c09b9..0000000000 --- a/build/camlp4-bootstrap.sh +++ /dev/null @@ -1,51 +0,0 @@ -#!/bin/sh - -######################################################################### -# # -# OCaml # -# # -# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # -# # -# Copyright 2007 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### - -# README: to bootstrap camlp4 have a look at build/camlp4-bootstrap-recipe.txt - -set -e -cd `dirname $0`/.. - -. config/config.sh -export PATH=$BINDIR:$PATH - -TMPTARGETS="\ - camlp4/boot/Lexer.ml" - -TARGETS="\ - camlp4/Camlp4/Struct/Camlp4Ast.ml \ - camlp4/boot/Camlp4.ml \ - camlp4/boot/camlp4boot.ml" - -for target in $TARGETS camlp4/boot/Camlp4Ast.ml; do - [ -f "$target" ] && mv "$target" "$target.old" - rm -f "_build/$target" -done - -if [ -x ./boot/myocamlbuild.native ]; then - OCAMLBUILD=./boot/myocamlbuild.native -no-ocamlfind -else - OCAMLBUILD="./boot/ocamlrun boot/myocamlbuild -no-ocamlfind" -fi -$OCAMLBUILD $TMPTARGETS $TARGETS - -for t in $TARGETS; do - echo promote $t - cp _build/$t camlp4/boot/`basename $t` - if cmp _build/$t camlp4/boot/`basename $t`.old; then - echo fixpoint for $t - else - echo $t is different, you should rebootstrap it by cleaning, building and call this script - fi -done diff --git a/build/camlp4-byte-only.sh b/build/camlp4-byte-only.sh deleted file mode 100755 index 8f4ed4e208..0000000000 --- a/build/camlp4-byte-only.sh +++ /dev/null @@ -1,23 +0,0 @@ -#!/bin/sh - -######################################################################### -# # -# OCaml # -# # -# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # -# # -# Copyright 2008 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### - -set -e -cd `dirname $0`/.. -. build/targets.sh -set -x - -# If you modify this list, modify it also in boot.sh -STDLIB_MODULES='Pervasives,Arg,Array,Buffer,Char,Digest,Filename,Format,Hashtbl,Lazy,Lexing,List,Map,Printexc,Printf,Scanf,Set,String,Sys,Parsing,Int32,Int64,Nativeint,Obj,Queue,Sort,Stream,Stack' - -$OCAMLBUILD -ignore "$STDLIB_MODULES" $@ byte_stdlib_mixed_mode $OCAMLC_BYTE $OCAMLLEX_BYTE $CAMLP4_BYTE diff --git a/build/camlp4-mkCamlp4Ast.sh b/build/camlp4-mkCamlp4Ast.sh deleted file mode 100755 index 0ff20e8b28..0000000000 --- a/build/camlp4-mkCamlp4Ast.sh +++ /dev/null @@ -1,36 +0,0 @@ -#!/bin/sh - -######################################################################### -# # -# OCaml # -# # -# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # -# # -# Copyright 2010 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### - -set -e -cd `dirname $0`/.. - -. config/config.sh -export PATH=$BINDIR:$PATH - -CAMLP4AST=camlp4/Camlp4/Struct/Camlp4Ast.ml -BOOTP4AST=camlp4/boot/Camlp4Ast.ml - -[ -f "$BOOTP4AST" ] && mv "$BOOTP4AST" "$BOOTP4AST.old" -rm -f "_build/$BOOTP4AST" -rm -f "_build/$CAMLP4AST" - -if [ -x ./boot/myocamlbuild.native ]; then - OCAMLBUILD=./boot/myocamlbuild.native -else - OCAMLBUILD="./boot/ocamlrun boot/myocamlbuild" -fi -$OCAMLBUILD $CAMLP4AST - -echo promote $CAMLP4AST -cp _build/$CAMLP4AST camlp4/boot/`basename $CAMLP4AST` diff --git a/build/camlp4-native-only.sh b/build/camlp4-native-only.sh deleted file mode 100755 index d53395c238..0000000000 --- a/build/camlp4-native-only.sh +++ /dev/null @@ -1,23 +0,0 @@ -#!/bin/sh - -######################################################################### -# # -# OCaml # -# # -# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # -# # -# Copyright 2008 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### - -set -e -cd `dirname $0`/.. -. build/targets.sh -set -x - -# If you modify this list, modify it also in boot.sh -STDLIB_MODULES='Pervasives,Arg,Array,Buffer,Char,Digest,Filename,Format,Hashtbl,Lazy,Lexing,List,Map,Printexc,Printf,Scanf,Set,String,Sys,Parsing,Int32,Int64,Nativeint,Obj,Queue,Sort,Stream,Stack' - -$OCAMLBUILD -ignore "$STDLIB_MODULES" $@ native_stdlib_mixed_mode $OCAMLOPT_BYTE $OCAMLLEX_BYTE $CAMLP4_NATIVE diff --git a/build/camlp4-targets.sh b/build/camlp4-targets.sh deleted file mode 100644 index 8fbaafb590..0000000000 --- a/build/camlp4-targets.sh +++ /dev/null @@ -1,46 +0,0 @@ -#!/bin/sh - -######################################################################### -# # -# OCaml # -# # -# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # -# # -# Copyright 2007 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### - -CAMLP4_COMMON="\ - camlp4/Camlp4/Camlp4Ast.partial.ml \ - camlp4/boot/camlp4boot.byte" -CAMLP4_BYTE="$CAMLP4_COMMON \ - camlp4/Camlp4.cmo \ - camlp4/Camlp4Top.cmo \ - camlp4/camlp4prof.byte$EXE \ - camlp4/mkcamlp4.byte$EXE \ - camlp4/camlp4.byte$EXE \ - camlp4/camlp4fulllib.cma" -CAMLP4_NATIVE="$CAMLP4_COMMON \ - camlp4/Camlp4.cmx \ - camlp4/Camlp4Top.cmx \ - camlp4/camlp4prof.native$EXE \ - camlp4/mkcamlp4.native$EXE \ - camlp4/camlp4.native$EXE \ - camlp4/camlp4fulllib.cmxa" - -for i in camlp4boot camlp4r camlp4rf camlp4o camlp4of camlp4oof camlp4orf; do - CAMLP4_BYTE="$CAMLP4_BYTE camlp4/$i.byte$EXE camlp4/$i.cma" - CAMLP4_NATIVE="$CAMLP4_NATIVE camlp4/$i.native$EXE" -done - -cd camlp4 -for dir in Camlp4Parsers Camlp4Printers Camlp4Filters; do - for file in $dir/*.ml; do - base=camlp4/$dir/`basename $file .ml` - CAMLP4_BYTE="$CAMLP4_BYTE $base.cmo" - CAMLP4_NATIVE="$CAMLP4_NATIVE $base.cmx $base.$O" - done -done -cd .. diff --git a/build/distclean.sh b/build/distclean.sh deleted file mode 100755 index 6e978eeccc..0000000000 --- a/build/distclean.sh +++ /dev/null @@ -1,37 +0,0 @@ -#!/bin/sh - -######################################################################### -# # -# OCaml # -# # -# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # -# # -# Copyright 2007 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### - -cd `dirname $0`/.. -set -ex -(cd byterun && make clean) || : -(cd asmrun && make clean) || : -(cd yacc && make clean) || : -rm -f build/ocamlbuild_mixed_mode -rm -rf _build -rm -f boot/ocamlrun boot/ocamlrun.exe boot/camlheader \ - boot/myocamlbuild boot/myocamlbuild.native boot/myocamlbuild.native.exe \ - myocamlbuild_config.ml config/config.sh config/Makefile \ - boot/ocamlyacc tools/cvt_emit.bak tools/*.bak \ - config/s.h config/m.h boot/*.cm* _log _*_log* - -# from partial boot -rm -f driver/main.byte driver/optmain.byte lex/main.byte \ - tools/ocamlmklib.byte \ - tools/myocamlbuild_config.ml - -# from ocamlbuild bootstrap -rm -f ocamlbuild/_log ocamlbuild/,ocamlbuild.byte.start \ - ocamlbuild/boot/ocamlbuild ocamlbuild/myocamlbuild_config.ml \ - ocamlbuild/myocamlbuild_config.mli -rm -rf ocamlbuild/_build ocamlbuild/_start diff --git a/build/fastworld.sh b/build/fastworld.sh deleted file mode 100755 index b9fa1248f1..0000000000 --- a/build/fastworld.sh +++ /dev/null @@ -1,47 +0,0 @@ -#!/bin/sh - -######################################################################### -# # -# OCaml # -# # -# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # -# # -# Copyright 2008 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### - -cd `dirname $0` -set -e -if [ -e ocamlbuild_mixed_mode ]; then - echo ocamlbuild mixed mode detected - echo 'please cleanup and re-launch (make clean ; ./build/distclean.sh)' - exit 1 -fi -./mk_shell_and_ocamlbuild_config.sh -./boot-c-parts.sh -./boot.sh $@ - -cd .. -. build/targets.sh -OCAMLMKLIB_BYTE="tools/ocamlmklib.byte" -set -x -$OCAMLBUILD $@ -log _boot_fast_log \ - $STDLIB_BYTE $OCAMLOPT_BYTE $STDLIB_NATIVE \ - $OCAMLOPT_NATIVE $OCAMLMKLIB_BYTE $OTHERLIBS_UNIX_NATIVE $OCAMLBUILD_NATIVE - -rm -f _build/myocamlbuild -boot/ocamlrun boot/myocamlbuild \ - -just-plugin -install-lib-dir _build/ocamlbuild \ - -ocamlopt "../_build/ocamlopt.opt -nostdlib -I boot -I stdlib -I $UNIXDIR" -cp _build/myocamlbuild boot/myocamlbuild.native - -./boot/myocamlbuild.native $@ \ - $OCAMLC_NATIVE $TOPLEVEL $OTHERLIBS_BYTE $OTHERLIBS_NATIVE $OCAMLLEX_BYTE \ - $OCAMLLEX_NATIVE $TOOLS_BYTE $TOOLS_NATIVE $DEBUGGER \ - $OCAMLDOC_BYTE $OCAMLDOC_NATIVE $OCAMLBUILD_BYTE - -cd tools -make objinfo_helper -cd .. diff --git a/build/install.sh b/build/install.sh deleted file mode 100755 index de2802e708..0000000000 --- a/build/install.sh +++ /dev/null @@ -1,475 +0,0 @@ -#!/bin/sh - -######################################################################### -# # -# OCaml # -# # -# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # -# # -# Copyright 2007 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### - -set -e - -cd `dirname $0`/.. - -. config/config.sh - -not_installed=$PWD/_build/not_installed - -rm -f "$not_installed" -touch "$not_installed" - -wontinstall() { - echo "$1" >> "$not_installed" - echo " don't install $1" -} - -installbin() { - if [ -f "$1" ]; then - echo " install binary $2" - cp -f "$1" "$2" - [ -x "$2" ] || chmod +x "$2" - else - wontinstall "$1" - fi -} - -installbestbin() { - if [ -f "$1" ]; then - echo " install binary $3 (with `basename $1`)" - cp -f "$1" "$3" - else - if [ -f "$2" ]; then - echo " install binary $3 (with `basename $2`)" - cp -f "$2" "$3" - else - echo "None of $1, $2 exists" - exit 3 - fi - fi - [ -x "$3" ] || chmod +x "$3" -} - -installlib() { - if [ -f "$1" ]; then - dest="$2/`basename $1`" - echo " install library $dest" - cp -f "$1" "$2" - if [ "$RANLIB" != "" ]; then - "$RANLIB" "$dest" - fi - else - wontinstall "$1" - fi -} - -installdir() { - args="" - while [ $# -gt 1 ]; do - if [ -f "$1" ]; then - args="$args $1" - else - wontinstall "$1" - fi - shift - done - last="$1" - for file in $args; do - echo " install $last/`basename $file`" - cp -f "$file" "$last" - done -} - -installlibdir() { - args="" - while [ $# -gt 1 ]; do - args="$args $1" - shift - done - last="$1" - for file in $args; do - installlib "$file" "$last" - done -} - -mkdir -p $BINDIR -mkdir -p $LIBDIR -mkdir -p $LIBDIR/caml -mkdir -p $LIBDIR/vmthreads -mkdir -p $LIBDIR/threads -mkdir -p $LIBDIR/ocamlbuild -mkdir -p $LIBDIR/ocamldoc -mkdir -p $LIBDIR/ocamldoc/custom -mkdir -p $STUBLIBDIR -mkdir -p $MANDIR/man1 -mkdir -p $MANDIR/man3 -mkdir -p $MANDIR/man$MANEXT - -echo "Installing core libraries..." -installlibdir byterun/libcamlrun.$A asmrun/libasmrun.$A asmrun/libasmrunp.$A \ - $LIBDIR -installdir byterun/libcamlrun_shared$EXT_DLL $LIBDIR - -PUBLIC_INCLUDES="\ - alloc.h callback.h config.h custom.h fail.h intext.h \ - memory.h misc.h mlvalues.h printexc.h signals.h compatibility.h" - -cd byterun -for i in $PUBLIC_INCLUDES; do - echo " install caml/$i" - sed -f ../tools/cleanup-header $i > $LIBDIR/caml/$i -done -cd .. - -WIN32="" -if [ "x$EXE" = "x.exe" ]; then - installbin win32caml/ocamlwin.exe $PREFIX/OCamlWin.exe - WIN32=win32 -fi - -installdir otherlibs/"$WIN32"unix/unixsupport.h \ - otherlibs/bigarray/bigarray.h \ - $LIBDIR/caml - -installdir yacc/ocamlyacc$EXE byterun/ocamlrun$EXE $BINDIR - -installdir config/Makefile $LIBDIR/Makefile.config -installdir byterun/ld.conf $LIBDIR - -cd _build - -echo "Installing the toplevel and compilers..." -installbin ocaml$EXE $BINDIR/ocaml$EXE -installbin ocamlc$EXE $BINDIR/ocamlc$EXE -installbin ocamlopt$EXE $BINDIR/ocamlopt$EXE -installbin ocamlc.opt$EXE $BINDIR/ocamlc.opt$EXE -installbin ocamlopt.opt$EXE $BINDIR/ocamlopt.opt$EXE - -set=set # coloration workaround - -echo "Installing the standard library..." -installdir \ - stdlib/stdlib.cma \ - stdlib/stdlib.cmxa stdlib/stdlib.p.cmxa \ - stdlib/camlheader \ - stdlib/camlheader_ur \ - stdlib/std_exit.cm[io] stdlib/std_exit.ml \ - stdlib/arg.cmi stdlib/arg.ml stdlib/arg.mli \ - stdlib/array.cmi stdlib/array.ml stdlib/array.mli \ - stdlib/arrayLabels.cmi stdlib/arrayLabels.ml stdlib/arrayLabels.mli \ - stdlib/buffer.cmi stdlib/buffer.ml stdlib/buffer.mli \ - stdlib/callback.cmi stdlib/callback.ml stdlib/callback.mli \ - stdlib/camlinternalLazy.cmi stdlib/camlinternalLazy.ml stdlib/camlinternalLazy.mli \ - stdlib/camlinternalMod.cmi stdlib/camlinternalMod.ml stdlib/camlinternalMod.mli \ - stdlib/camlinternalOO.cmi stdlib/camlinternalOO.ml stdlib/camlinternalOO.mli \ - stdlib/char.cmi stdlib/char.ml stdlib/char.mli \ - stdlib/complex.cmi stdlib/complex.ml stdlib/complex.mli \ - stdlib/digest.cmi stdlib/digest.ml stdlib/digest.mli \ - stdlib/filename.cmi stdlib/filename.ml stdlib/filename.mli \ - stdlib/format.cmi stdlib/format.ml stdlib/format.mli \ - stdlib/gc.cmi stdlib/gc.ml stdlib/gc.mli \ - stdlib/genlex.cmi stdlib/genlex.ml stdlib/genlex.mli \ - stdlib/hashtbl.cmi stdlib/hashtbl.ml stdlib/hashtbl.mli \ - stdlib/int32.cmi stdlib/int32.ml stdlib/int32.mli \ - stdlib/int64.cmi stdlib/int64.ml stdlib/int64.mli \ - stdlib/lazy.cmi stdlib/lazy.ml stdlib/lazy.mli \ - stdlib/lexing.cmi stdlib/lexing.ml stdlib/lexing.mli \ - stdlib/list.cmi stdlib/list.ml stdlib/list.mli \ - stdlib/listLabels.cmi stdlib/listLabels.ml stdlib/listLabels.mli \ - stdlib/map.cmi stdlib/map.ml stdlib/map.mli \ - stdlib/marshal.cmi stdlib/marshal.ml stdlib/marshal.mli \ - stdlib/moreLabels.cmi stdlib/moreLabels.ml stdlib/moreLabels.mli \ - stdlib/nativeint.cmi stdlib/nativeint.ml stdlib/nativeint.mli \ - stdlib/obj.cmi stdlib/obj.ml stdlib/obj.mli \ - stdlib/oo.cmi stdlib/oo.ml stdlib/oo.mli \ - stdlib/parsing.cmi stdlib/parsing.ml stdlib/parsing.mli \ - stdlib/pervasives.cmi stdlib/pervasives.ml stdlib/pervasives.mli \ - stdlib/printexc.cmi stdlib/printexc.ml stdlib/printexc.mli \ - stdlib/printf.cmi stdlib/printf.ml stdlib/printf.mli \ - stdlib/queue.cmi stdlib/queue.ml stdlib/queue.mli \ - stdlib/random.cmi stdlib/random.ml stdlib/random.mli \ - stdlib/scanf.cmi stdlib/scanf.ml stdlib/scanf.mli \ - stdlib/sort.cmi stdlib/sort.ml stdlib/sort.mli \ - stdlib/stack.cmi stdlib/stack.ml stdlib/stack.mli \ - stdlib/stdLabels.cmi stdlib/stdLabels.ml stdlib/stdLabels.mli \ - stdlib/stream.cmi stdlib/stream.ml stdlib/stream.mli \ - stdlib/string.cmi stdlib/string.ml stdlib/string.mli \ - stdlib/stringLabels.cmi stdlib/stringLabels.ml stdlib/stringLabels.mli \ - stdlib/sys.cmi stdlib/sys.ml stdlib/sys.mli \ - stdlib/weak.cmi stdlib/weak.ml stdlib/weak.mli \ - stdlib/$set.cmi stdlib/$set.ml stdlib/$set.mli \ - stdlib/arg.cmx stdlib/arg.p.cmx \ - stdlib/array.cmx stdlib/array.p.cmx \ - stdlib/arrayLabels.cmx stdlib/arrayLabels.p.cmx \ - stdlib/buffer.cmx stdlib/buffer.p.cmx \ - stdlib/callback.cmx stdlib/callback.p.cmx \ - stdlib/camlinternalLazy.cmx stdlib/camlinternalLazy.p.cmx \ - stdlib/camlinternalMod.cmx stdlib/camlinternalMod.p.cmx \ - stdlib/camlinternalOO.cmx stdlib/camlinternalOO.p.cmx \ - stdlib/char.cmx stdlib/char.p.cmx \ - stdlib/complex.cmx stdlib/complex.p.cmx \ - stdlib/digest.cmx stdlib/digest.p.cmx \ - stdlib/filename.cmx stdlib/filename.p.cmx \ - stdlib/format.cmx stdlib/format.p.cmx \ - stdlib/gc.cmx stdlib/gc.p.cmx \ - stdlib/genlex.cmx stdlib/genlex.p.cmx \ - stdlib/hashtbl.cmx stdlib/hashtbl.p.cmx \ - stdlib/int32.cmx stdlib/int32.p.cmx \ - stdlib/int64.cmx stdlib/int64.p.cmx \ - stdlib/lazy.cmx stdlib/lazy.p.cmx \ - stdlib/lexing.cmx stdlib/lexing.p.cmx \ - stdlib/list.cmx stdlib/list.p.cmx \ - stdlib/listLabels.cmx stdlib/listLabels.p.cmx \ - stdlib/map.cmx stdlib/map.p.cmx \ - stdlib/marshal.cmx stdlib/marshal.p.cmx \ - stdlib/moreLabels.cmx stdlib/moreLabels.p.cmx \ - stdlib/nativeint.cmx stdlib/nativeint.p.cmx \ - stdlib/obj.cmx stdlib/obj.p.cmx \ - stdlib/oo.cmx stdlib/oo.p.cmx \ - stdlib/parsing.cmx stdlib/parsing.p.cmx \ - stdlib/pervasives.cmx stdlib/pervasives.p.cmx \ - stdlib/printexc.cmx stdlib/printexc.p.cmx \ - stdlib/printf.cmx stdlib/printf.p.cmx \ - stdlib/queue.cmx stdlib/queue.p.cmx \ - stdlib/random.cmx stdlib/random.p.cmx \ - stdlib/scanf.cmx stdlib/scanf.p.cmx \ - stdlib/sort.cmx stdlib/sort.p.cmx \ - stdlib/stack.cmx stdlib/stack.p.cmx \ - stdlib/stdLabels.cmx stdlib/stdLabels.p.cmx \ - stdlib/std_exit.cmx stdlib/std_exit.p.cmx stdlib/std_exit.$O stdlib/std_exit.p.$O \ - stdlib/stream.cmx stdlib/stream.p.cmx \ - stdlib/string.cmx stdlib/string.p.cmx \ - stdlib/stringLabels.cmx stdlib/stringLabels.p.cmx \ - stdlib/sys.cmx stdlib/sys.p.cmx \ - stdlib/weak.cmx stdlib/weak.p.cmx \ - stdlib/$set.cmx stdlib/$set.p.cmx \ - $LIBDIR - -installlibdir \ - stdlib/stdlib.$A stdlib/stdlib.p.$A \ - $LIBDIR - -echo "Installing ocamllex, ocamldebug..." -installbin lex/ocamllex$EXE $BINDIR/ocamllex$EXE -installbin debugger/ocamldebug$EXE $BINDIR/ocamldebug$EXE -installbin lex/ocamllex.opt$EXE $BINDIR/ocamllex.opt$EXE -installbin tools/ocamldep.native$EXE $BINDIR/ocamldep.opt$EXE - -echo "Installing some tools..." -installbin tools/objinfo.byte$EXE $BINDIR/ocamlobjinfo$EXE -installbin ../tools/objinfo_helper$EXE $LIBDIR/objinfo_helper$EXE -installbin tools/ocamlcp.byte$EXE $BINDIR/ocamlcp$EXE -installbin tools/ocamldep.byte$EXE $BINDIR/ocamldep$EXE -installbin tools/ocamlmklib.byte$EXE $BINDIR/ocamlmklib$EXE -installbin tools/ocamlmktop.byte$EXE $BINDIR/ocamlmktop$EXE -installbin tools/ocamlprof.byte$EXE $BINDIR/ocamlprof$EXE -installbin toplevel/expunge.byte$EXE $LIBDIR/expunge$EXE -installbin tools/addlabels.byte $LIBDIR/addlabels -installbin tools/scrapelabels.byte $LIBDIR/scrapelabels -installbin otherlibs/dynlink/extract_crc.byte $LIBDIR/extract_crc - -echo "Installing libraries..." -installdir \ - otherlibs/bigarray/bigarray.cma \ - otherlibs/dbm/dbm.cma \ - otherlibs/dynlink/dynlink.cma \ - otherlibs/"$WIN32"graph/graphics.cma \ - otherlibs/num/nums.cma \ - otherlibs/str/str.cma \ - otherlibs/"$WIN32"unix/unix.cma \ - otherlibs/bigarray/bigarray.cmxa \ - otherlibs/dbm/dbm.cmxa \ - otherlibs/dynlink/dynlink.cmxa \ - otherlibs/"$WIN32"graph/graphics.cmxa \ - otherlibs/num/nums.cmxa \ - otherlibs/str/str.cmxa \ - otherlibs/"$WIN32"unix/unix.cmxa \ - toplevel/toplevellib.cma \ - otherlibs/systhreads/thread.mli \ - otherlibs/systhreads/mutex.mli \ - otherlibs/systhreads/condition.mli \ - otherlibs/systhreads/event.mli \ - otherlibs/systhreads/threadUnix.mli \ - $LIBDIR - -installdir \ - otherlibs/systhreads/threads.cma \ - otherlibs/systhreads/threads.cmxa \ - otherlibs/systhreads/thread.cmi \ - otherlibs/systhreads/thread.cmx \ - otherlibs/systhreads/mutex.cmi \ - otherlibs/systhreads/mutex.cmx \ - otherlibs/systhreads/condition.cmi \ - otherlibs/systhreads/condition.cmx \ - otherlibs/systhreads/event.cmi \ - otherlibs/systhreads/event.cmx \ - otherlibs/systhreads/threadUnix.cmi \ - otherlibs/systhreads/threadUnix.cmx \ - $LIBDIR/threads - -installdir \ - otherlibs/bigarray/dllbigarray$EXT_DLL \ - otherlibs/dbm/dllmldbm$EXT_DLL \ - otherlibs/"$WIN32"graph/dllgraphics$EXT_DLL \ - otherlibs/num/dllnums$EXT_DLL \ - otherlibs/str/dllstr$EXT_DLL \ - otherlibs/systhreads/dllthreads$EXT_DLL \ - otherlibs/"$WIN32"unix/dllunix$EXT_DLL \ - otherlibs/threads/dllvmthreads$EXT_DLL \ - $STUBLIBDIR - -installlibdir \ - otherlibs/threads/libvmthreads.$A \ - $LIBDIR/vmthreads - -installdir \ - otherlibs/threads/thread.cmi \ - otherlibs/threads/thread.mli \ - otherlibs/threads/mutex.cmi \ - otherlibs/threads/mutex.mli \ - otherlibs/threads/condition.cmi \ - otherlibs/threads/condition.mli \ - otherlibs/threads/event.cmi \ - otherlibs/threads/event.mli \ - otherlibs/threads/threadUnix.cmi \ - otherlibs/threads/threadUnix.mli \ - otherlibs/threads/threads.cma \ - otherlibs/threads/stdlib.cma \ - otherlibs/threads/unix.cma \ - $LIBDIR/vmthreads - -installlibdir \ - otherlibs/bigarray/libbigarray.$A \ - otherlibs/dbm/libmldbm.$A \ - otherlibs/"$WIN32"graph/libgraphics.$A \ - otherlibs/num/libnums.$A \ - otherlibs/str/libstr.$A \ - otherlibs/systhreads/libthreads.$A \ - otherlibs/systhreads/libthreadsnat.$A \ - otherlibs/"$WIN32"unix/libunix.$A \ - $LIBDIR - -echo "Installing object files and interfaces..." -installdir \ - tools/profiling.cm[oi] \ - toplevel/topstart.cmo \ - toplevel/toploop.cmi \ - toplevel/topdirs.cmi \ - toplevel/topmain.cmi \ - typing/outcometree.cmi \ - typing/outcometree.mli \ - otherlibs/graph/graphicsX11.cmi \ - otherlibs/graph/graphicsX11.mli \ - otherlibs/dynlink/dynlink.cmi \ - otherlibs/dynlink/dynlink.mli \ - otherlibs/num/arith_status.cmi \ - otherlibs/num/arith_status.mli \ - otherlibs/num/big_int.cmi \ - otherlibs/num/big_int.mli \ - otherlibs/num/nat.cmi \ - otherlibs/num/nat.mli \ - otherlibs/num/num.cmi \ - otherlibs/num/num.mli \ - otherlibs/num/ratio.cmi \ - otherlibs/num/ratio.mli \ - otherlibs/bigarray/bigarray.cmi \ - otherlibs/bigarray/bigarray.mli \ - otherlibs/dbm/dbm.cmi \ - otherlibs/dbm/dbm.mli \ - otherlibs/dynlink/dynlink.cmx \ - otherlibs/"$WIN32"graph/graphics.cmi \ - otherlibs/"$WIN32"graph/graphics.mli \ - otherlibs/str/str.cmi \ - otherlibs/str/str.mli \ - otherlibs/"$WIN32"unix/unix.cmi \ - otherlibs/"$WIN32"unix/unix.mli \ - otherlibs/"$WIN32"unix/unixLabels.cmi \ - otherlibs/"$WIN32"unix/unixLabels.mli \ - otherlibs/num/arith_flags.cmx \ - otherlibs/num/int_misc.cmx \ - otherlibs/num/arith_status.cmx \ - otherlibs/num/big_int.cmx \ - otherlibs/num/nat.cmx \ - otherlibs/num/num.cmx \ - otherlibs/num/ratio.cmx \ - otherlibs/bigarray/bigarray.cmx \ - otherlibs/dbm/dbm.cmx \ - otherlibs/"$WIN32"graph/graphics.cmx \ - otherlibs/graph/graphicsX11.cmx \ - otherlibs/str/str.cmx \ - otherlibs/"$WIN32"unix/unix.cmx \ - otherlibs/"$WIN32"unix/unixLabels.cmx \ - $LIBDIR - -installlibdir \ - otherlibs/bigarray/bigarray.$A \ - otherlibs/dbm/dbm.$A \ - otherlibs/dynlink/dynlink.$A \ - otherlibs/"$WIN32"graph/graphics.$A \ - otherlibs/num/nums.$A \ - otherlibs/str/str.$A \ - otherlibs/"$WIN32"unix/unix.$A \ - stdlib/stdlib.$A \ - $LIBDIR - -installlibdir \ - otherlibs/systhreads/threads.$A \ - $LIBDIR/threads - -echo "Installing manuals..." -(cd ../man && make install) - -echo "Installing ocamldoc..." -installbin ocamldoc/ocamldoc $BINDIR/ocamldoc$EXE -installbin ocamldoc/ocamldoc.opt $BINDIR/ocamldoc.opt$EXE - -installdir \ - ../ocamldoc/ocamldoc.hva \ - ocamldoc/*.cmi \ - ocamldoc/odoc_info.mli ocamldoc/odoc_info.cm[ia] ocamldoc/odoc_info.cmxa \ - ocamldoc/odoc_info.$A \ - $LIBDIR/ocamldoc - -installdir \ - ocamldoc/stdlib_man/* \ - $MANDIR/man3 - -echo "Installing ocamlbuild..." - -cd ocamlbuild -installbin ocamlbuild.byte$EXE $BINDIR/ocamlbuild.byte$EXE -installbin ocamlbuild.native$EXE $BINDIR/ocamlbuild.native$EXE -installbestbin ocamlbuild.native$EXE ocamlbuild.byte$EXE $BINDIR/ocamlbuild$EXE - -installlibdir \ - ocamlbuildlib.$A \ - $LIBDIR/ocamlbuild - -installdir \ - ocamlbuildlib.cmxa \ - ocamlbuildlib.cma \ - ocamlbuild_plugin.cmi \ - ocamlbuild_plugin.cmo \ - ocamlbuild_plugin.cmx \ - ocamlbuild_pack.cmi \ - ocamlbuild_unix_plugin.cmi \ - ocamlbuild_unix_plugin.cmo \ - ocamlbuild_unix_plugin.cmx \ - ocamlbuild_unix_plugin.$O \ - ocamlbuild_executor.cmi \ - ocamlbuild_executor.cmo \ - ocamlbuild_executor.cmx \ - ocamlbuild_executor.$O \ - ocamlbuild.cmo \ - ocamlbuild.cmx \ - ocamlbuild.$O \ - $LIBDIR/ocamlbuild -cd .. - -installdir \ - ../ocamlbuild/man/ocamlbuild.1 \ - $MANDIR/man1 diff --git a/build/mixed-boot.sh b/build/mixed-boot.sh deleted file mode 100755 index 057b523332..0000000000 --- a/build/mixed-boot.sh +++ /dev/null @@ -1,21 +0,0 @@ -#!/bin/sh - -######################################################################### -# # -# OCaml # -# # -# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # -# # -# Copyright 2007 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### - -set -ex -cd `dirname $0`/.. -touch build/ocamlbuild_mixed_mode -mkdir -p _build -cp -rf boot _build/ -./build/mk_shell_and_ocamlbuild_config.sh -./build/boot.sh diff --git a/build/mk_shell_and_ocamlbuild_config.sh b/build/mk_shell_and_ocamlbuild_config.sh deleted file mode 100755 index cdaf8e528e..0000000000 --- a/build/mk_shell_and_ocamlbuild_config.sh +++ /dev/null @@ -1,65 +0,0 @@ -#!/bin/sh -eux - -# Generate config.sh and myocamlbuild_config.ml from config/Makefile. -# -# The approach is to create a new Makefile that "include" the config one and has -# a single rule that prints the value of each variable config/Makefile. - -# Replace a variable name like "VAR" with [echo 'VAR="$(VAR)"; \\] for use in a -# Makefile rule. -print_value_shell='s/.*/ echo &="\\"$(&)\\""; \\/' - -# Replace a variable name like "VAR" with [echo 'let var = "$(VAR)";;'; \\] for -# use in a Makefile rule. -# It's fairly annoying to have to rely on tr but there is no portable way to -# get the lowercase value of a variable in make. -print_value_ocaml='s/.*/ echo let $$(echo & | tr "[:upper:]" "[:lower:]") = "\\"$(&)\\";;"; \\/' - -main() { - # Command to run to output a line of code to set a variable to its value. - local print_value="${1}" - - # List the variables in a Makefile except the ones that are commented out. - local list_variables='/[^#].*=/ s/\([^ \t:=]\{1,\}\).*=.*$/\1/ p' - - # Variables we don't want to retrieve. - local exclude='^#|\<CAML(C|OPT)_BIN\>|\<(MKLIB|SYSLIB|FLEXDIR|IFLEXDIR|^SET_LD_PATH)\>' - - # Some variables in the config have a value that is shell script and has to be - # evaluated to make sense for the outputs. - local eval_command='s/\\"\(.*\)\\"/\\"$$(\1)\\"/' - local eval_commands_1='/CAMLC_BIN_CMD_TO_EVAL/ '"${eval_command}" - local eval_commands_2='/CAMLOPT_BIN_CMD_TO_EVAL/ '"${eval_command}" - - printf "include Makefile\n\n" - printf "p:\n\t@true; \\\\\n" - sed -n "${list_variables}" Makefile \ - | grep -v -E "${exclude}" \ - | sed "${print_value}" \ - | sed -e "${eval_commands_1}" -e "${eval_commands_2}" - printf "\ttrue\n\n" - printf ".PHONY: p" -} - -# Unset both MAKEFLAGS and MAKELEVEL which we inherit from the recursive make -# calls in the build system. This prevents (gnu) make from printing the current -# directory [ make[4]: Leaving directory `/foo/ocaml/config' ]. -unset MAKEFLAGS -unset MAKELEVEL - -cd `dirname $0`/../config - -main "${print_value_shell}" > mkconfig.Makefile -make -f mkconfig.Makefile > config.sh - -main "${print_value_ocaml}" > mkconfig.Makefile -# The OCaml code expects bools instead of strings for true and false. -make -f mkconfig.Makefile \ - | sed -e 's/"true"/true/' -e 's/"false"/false/' \ - > ../myocamlbuild_config.ml -# ./configure outputs in config/Makefile some OCaml functions which we need; -# they are commented out and preceded with '#ml '; since they depend on other -# values, output them at the very end of the output. -sed -n 's/^#ml // p' Makefile >> ../myocamlbuild_config.ml - -rm -f mkconfig.Makefile diff --git a/build/mkruntimedef.sh b/build/mkruntimedef.sh deleted file mode 100755 index a1bf141eda..0000000000 --- a/build/mkruntimedef.sh +++ /dev/null @@ -1,21 +0,0 @@ -#!/bin/sh - -######################################################################### -# # -# OCaml # -# # -# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # -# # -# Copyright 2007 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### - -echo 'let builtin_exceptions = [|'; \ -sed -n -e 's|.*/\* \("[A-Za-z_]*"\) \*/$| \1;|p' byterun/fail.h | \ -sed -e '$s/;$//'; \ -echo '|]'; \ -echo 'let builtin_primitives = [|'; \ -sed -e 's/.*/ "&";/' -e '$s/;$//' byterun/primitives; \ -echo '|]' diff --git a/build/myocamlbuild.sh b/build/myocamlbuild.sh deleted file mode 100755 index 34ad894f9f..0000000000 --- a/build/myocamlbuild.sh +++ /dev/null @@ -1,31 +0,0 @@ -#!/bin/sh - -######################################################################### -# # -# 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. # -# # -######################################################################### - -cd `dirname $0`/.. -set -xe -if [ ! -x _build/ocamlbuild/ocamlbuildlight.byte ]; then - if [ ! -x ocamlbuild/_build/ocamlbuildlight.byte ]; then - (cd ocamlbuild && ${GNUMAKE:-make}) - fi - mkdir -p _build/ocamlbuild - for i in "light.cmo" "light.byte" "lightlib.cma" "_plugin.cmi" "_pack.cmi" - do - cp ocamlbuild/_build/ocamlbuild$i _build/ocamlbuild - done -fi -rm -f ocamlbuild/myocamlbuild_config.ml ocamlbuild/myocamlbuild_config.mli -rm -rf _build/myocamlbuild boot/myocamlbuild boot/myocamlbuild.native -./boot/ocamlrun _build/ocamlbuild/ocamlbuildlight.byte -no-hygiene \ - -tag debug -install-lib-dir _build/ocamlbuild -byte-plugin -just-plugin -cp _build/myocamlbuild boot/myocamlbuild.boot diff --git a/build/new-build-system b/build/new-build-system deleted file mode 100644 index f76f07cebc..0000000000 --- a/build/new-build-system +++ /dev/null @@ -1,46 +0,0 @@ -######################################################################### -# # -# OCaml # -# # -# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # -# # -# Copyright 2007 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### - -_tags # Defines tags to setup exceptions -myocamlbuild.ml # Contains all needed rules that are differents -boot/ocamldep -myocamlbuild_config.mli -utils/config.mlbuild # Should be renamed as utils/config.ml - -# Files that just contain module names of object files. -**/*.mllib # Files that describe the contents of an OCaml library -**/*.mlpack # Files that describe the contents of an OCaml package -**/*.cilb # Files that describe the contents of an C static library -**/*.dilb # Files that describe the contents of an C dynamic library - -build/ - world.sh # Build all the OCaml world - world.byte.sh # Build the bytecode world - world.native.sh # Build the native world - world.all.sh # Build all the world the don't bootstrap - fastworld.sh # Same as above but faster - boot-c-parts.sh # Compile byterun, ocamlyacc and asmrun with the Makefiles - boot.sh # Compile the stdlib and ocamlc - otherlibs-targets.sh # Setup otherlibs targets - targets.sh # All targets of the OCaml distribution - - - install.sh # Install all needed files - distclean.sh # Clean all generated files - - myocamlbuild.sh # Regenerate the boot/myocamlbuild program - mk_shell_and_ocamlbuild_config.sh # Generate config/config.sh and myocamlbuild_config.ml - - # Partial stuffs - mixed-boot.sh - ocamlbuild-byte-only.sh - ocamlbuild-native-only.sh diff --git a/build/ocamlbuildlib-native-only.sh b/build/ocamlbuildlib-native-only.sh deleted file mode 100755 index 285c561a04..0000000000 --- a/build/ocamlbuildlib-native-only.sh +++ /dev/null @@ -1,19 +0,0 @@ -#!/bin/sh - -######################################################################### -# # -# OCaml # -# # -# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # -# # -# Copyright 2008 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### - -set -e -cd `dirname $0`/.. -. build/targets.sh -set -x -$OCAMLBUILD $@ native_stdlib_mixed_mode $OCAMLOPT_BYTE $OCAMLLEX_BYTE $OCAMLBUILDLIB_NATIVE diff --git a/build/otherlibs-targets.sh b/build/otherlibs-targets.sh deleted file mode 100644 index 9b470c8430..0000000000 --- a/build/otherlibs-targets.sh +++ /dev/null @@ -1,103 +0,0 @@ -#!/bin/sh - -######################################################################### -# # -# OCaml # -# # -# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # -# # -# Copyright 2008 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### - -OTHERLIBS_BYTE="" -OTHERLIBS_NATIVE="" -OTHERLIBS_UNIX_NATIVE="" -UNIXDIR="otherlibs/unix" - -add_native() { - for native_file in $@; do - OTHERLIBS_NATIVE="$OTHERLIBS_NATIVE otherlibs/$lib/$native_file" - case $lib in - unix|win32unix) - OTHERLIBS_UNIX_NATIVE="$OTHERLIBS_UNIX_NATIVE otherlibs/$lib/$native_file";; - esac - done -} - -add_byte() { - for byte_file in $@; do - OTHERLIBS_BYTE="$OTHERLIBS_BYTE otherlibs/$lib/$byte_file" - done -} - -add_file() { - add_byte $@ - add_native $@ -} - -add_bin() { - for bin_file in $@; do - add_byte $bin_file.byte$EXE - add_native $bin_file.native$EXE - done -} - -add_c_lib() { - add_file "lib$1.$A" -} - -add_ocaml_lib() { - add_native "$1.cmxa" - add_native "$1.$A" - add_byte "$1.cma" -} - -add_dll() { - add_file "dll$1$EXT_DLL" -} - -add() { - add_c_lib $1 - add_ocaml_lib $1 - add_dll $1 -} - -THREADS_CMIS="thread.cmi mutex.cmi condition.cmi event.cmi threadUnix.cmi" - -for lib in $OTHERLIBRARIES; do - case $lib in - num) - add nums;; - systhreads) - add_ocaml_lib threads - add_dll threads - add_file $THREADS_CMIS - add_byte libthreads.$A - add_native libthreadsnat.$A;; - graph|win32graph) - add graphics;; - threads) - add_byte pervasives.cmi pervasives.mli \ - $THREADS_CMIS marshal.cmi marshal.mli \ - stdlib.cma unix.cma threads.cma libvmthreads.$A;; - dbm) - add_ocaml_lib dbm - add_c_lib mldbm;; - dynlink) - add_ocaml_lib dynlink - add_native dynlink.cmx dynlink.$O - add_file $lib.cmi extract_crc;; - win32unix) - UNIXDIR="otherlibs/win32unix" - add_file unixsupport.h cst2constr.h socketaddr.h - add unix;; - unix) - add_file unixsupport.h - add unix;; - *) - add $lib - esac -done diff --git a/build/partial-install.sh b/build/partial-install.sh deleted file mode 100755 index 7af60188cc..0000000000 --- a/build/partial-install.sh +++ /dev/null @@ -1,159 +0,0 @@ -#!/bin/sh - -######################################################################### -# # -# OCaml # -# # -# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # -# # -# Copyright 2007 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### - -###################################### -######### Copied from build/install.sh -###################################### - -set -e - -cd `dirname $0`/.. - -# Save the following environment variables before sourcing config.sh since it -# will overwrite them and the user might have set them to emulate $(DESTDIR) -# which is unfortunately not supported. -SAVED_BINDIR="${BINDIR}" -SAVED_LIBDIR="${LIBDIR}" -SAVED_MANDIR="${MANDIR}" - -. config/config.sh - -BINDIR="${SAVED_BINDIR:-${BINDIR}}" -LIBDIR="${SAVED_LIBDIR:-${LIBDIR}}" -MANDIR="${SAVED_MANDIR:-${MANDIR}}" - -not_installed=$PWD/_build/not_installed - -rm -f "$not_installed" -mkdir -p "$PWD/_build" -touch "$not_installed" - -wontinstall() { - echo "$1" >> "$not_installed" - echo " don't install $1" -} - -installbin() { - if [ -f "$1" ]; then - echo " install binary $2" - cp -f "$1" "$2" - [ -x "$2" ] || chmod +x "$2" - else - wontinstall "$1" - fi -} - -installbestbin() { - if [ -f "$1" ]; then - echo " install binary $3 (with `basename $1`)" - cp -f "$1" "$3" - else - if [ -f "$2" ]; then - echo " install binary $3 (with `basename $2`)" - cp -f "$2" "$3" - else - echo "None of $1, $2 exists" - exit 3 - fi - fi - [ -x "$3" ] || chmod +x "$3" -} - -installlib() { - if [ -f "$1" ]; then - dest="$2/`basename $1`" - echo " install library $dest" - cp -f "$1" "$2" - if [ "$RANLIB" != "" ]; then - "$RANLIB" "$dest" - fi - else - wontinstall "$1" - fi -} - -installdir() { - args="" - while [ $# -gt 1 ]; do - if [ -f "$1" ]; then - args="$args $1" - else - wontinstall "$1" - fi - shift - done - last="$1" - for file in $args; do - echo " install $last/`basename $file`" - cp -f "$file" "$last" - done -} - -installlibdir() { - args="" - while [ $# -gt 1 ]; do - args="$args $1" - shift - done - last="$1" - for file in $args; do - installlib "$file" "$last" - done -} - -mkdir -p $BINDIR -mkdir -p $LIBDIR -mkdir -p $LIBDIR/ocamlbuild -mkdir -p $MANDIR/man1 -mkdir -p $MANDIR/man3 - -cd _build - -if [ -n "${WITH_OCAMLBUILD}" ]; then - echo "Installing ocamlbuild..." - cd ocamlbuild - installbin ocamlbuild.byte$EXE $BINDIR/ocamlbuild.byte$EXE - installbin ocamlbuild.native$EXE $BINDIR/ocamlbuild.native$EXE - installbestbin ocamlbuild.native$EXE ocamlbuild.byte$EXE \ - $BINDIR/ocamlbuild$EXE - - installlibdir \ - ocamlbuildlib.$A \ - $LIBDIR/ocamlbuild - - installdir \ - ocamlbuildlib.cmxa \ - ocamlbuildlib.cma \ - ocamlbuild_plugin.cmi \ - ocamlbuild_plugin.cmo \ - ocamlbuild_plugin.cmx \ - ocamlbuild_pack.cmi \ - ocamlbuild_unix_plugin.cmi \ - ocamlbuild_unix_plugin.cmo \ - ocamlbuild_unix_plugin.cmx \ - ocamlbuild_unix_plugin.$O \ - ocamlbuild_executor.cmi \ - ocamlbuild_executor.cmo \ - ocamlbuild_executor.cmx \ - ocamlbuild_executor.$O \ - ocamlbuild.cmo \ - ocamlbuild.cmx \ - ocamlbuild.$O \ - $LIBDIR/ocamlbuild - cd .. - - installdir \ - ../ocamlbuild/man/ocamlbuild.1 \ - $MANDIR/man1 -fi diff --git a/build/targets.sh b/build/targets.sh deleted file mode 100644 index edc6c66bcd..0000000000 --- a/build/targets.sh +++ /dev/null @@ -1,63 +0,0 @@ -######################################################################### -# # -# OCaml # -# # -# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # -# # -# Copyright 2007 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### - -. config/config.sh -. build/otherlibs-targets.sh - -INSTALL_BIN="$BINDIR" -export INSTALL_BIN - -STDLIB_BYTE="stdlib/libcamlrun.$A stdlib/stdlib.cma \ - stdlib/std_exit.cmo stdlib/camlheader stdlib/camlheader_ur" -OCAMLLEX_BYTE=lex/ocamllex$EXE -OCAMLC_BYTE=ocamlc$EXE -OCAMLOPT_BYTE=ocamlopt$EXE -OCAMLBUILD_BYTE="ocamlbuild/ocamlbuildlib.cma \ - ocamlbuild/ocamlbuildlightlib.cma \ - ocamlbuild/ocamlbuild.byte$EXE \ - ocamlbuild/ocamlbuildlight.byte$EXE" -TOPLEVEL=ocaml$EXE -TOOLS_BYTE="tools/objinfo.byte$EXE \ - tools/ocamldep.byte$EXE tools/profiling.cmo \ - tools/ocamlprof.byte$EXE tools/ocamlcp.byte$EXE \ - tools/ocamlmktop.byte$EXE tools/ocamlmklib$EXE \ - tools/scrapelabels.byte tools/addlabels.byte \ - tools/dumpobj.byte$EXE" -if [ ! -z "$DEBUGGER" ]; then - DEBUGGER=debugger/ocamldebug$EXE -fi -OCAMLDOC_BYTE="ocamldoc/ocamldoc$EXE ocamldoc/odoc_info.cma" -STDLIB_NATIVE="stdlib/stdlib.cmxa stdlib/std_exit.cmx asmrun/libasmrun.$A" -case $PROFILING in -prof) - STDLIB_NATIVE="$STDLIB_NATIVE asmrun/libasmrunp.$A \ - stdlib/stdlib.p.cmxa stdlib/std_exit.p.cmx";; -noprof) ;; -*) echo "unexpected PROFILING value $PROFILING"; exit 1;; -esac -OCAMLC_NATIVE=ocamlc.opt$EXE -OCAMLOPT_NATIVE=ocamlopt.opt$EXE -OCAMLLEX_NATIVE=lex/ocamllex.opt$EXE -TOOLS_NATIVE=tools/ocamldep.native$EXE -OCAMLDOC_NATIVE="ocamldoc/ocamldoc.opt$EXE ocamldoc/odoc_info.cmxa ocamldoc/stdlib_man/Pervasives.3o" -OCAMLBUILDLIB_NATIVE="ocamlbuild/ocamlbuildlib.cmxa \ - ocamlbuild/ocamlbuildlightlib.cmxa" -OCAMLBUILD_NATIVE="$OCAMLBUILDLIB_NATIVE \ - ocamlbuild/ocamlbuild.native$EXE \ - ocamlbuild/ocamlbuildlight.native$EXE" -if [ -x boot/myocamlbuild.native ]; then - OCAMLBUILD=./boot/myocamlbuild.native -else - OCAMLBUILD="./boot/ocamlrun boot/myocamlbuild" -fi - -OCAMLBUILD="$OCAMLBUILD -no-ocamlfind" diff --git a/build/world.all.sh b/build/world.all.sh deleted file mode 100755 index dffd88ed1d..0000000000 --- a/build/world.all.sh +++ /dev/null @@ -1,24 +0,0 @@ -#!/bin/sh - -######################################################################### -# # -# OCaml # -# # -# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # -# # -# Copyright 2007 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### - -set -e -cd `dirname $0`/.. -. build/targets.sh -set -x -$OCAMLBUILD $@ \ - $STDLIB_BYTE $OCAMLC_BYTE $OCAMLLEX_BYTE $OCAMLOPT_BYTE $TOPLEVEL \ - $TOOLS_BYTE $OTHERLIBS_BYTE $OCAMLBUILD_BYTE $DEBUGGER $OCAMLDOC_BYTE \ - $STDLIB_NATIVE $OCAMLC_NATIVE $OCAMLOPT_NATIVE \ - $OCAMLLEX_NATIVE $TOOLS_NATIVE $OTHERLIBS_NATIVE \ - $OCAMLBUILD_NATIVE $OCAMLDOC_NATIVE diff --git a/build/world.byte.sh b/build/world.byte.sh deleted file mode 100755 index d66f0a809d..0000000000 --- a/build/world.byte.sh +++ /dev/null @@ -1,21 +0,0 @@ -#!/bin/sh - -######################################################################### -# # -# OCaml # -# # -# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # -# # -# Copyright 2007 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### - -set -e -cd `dirname $0`/.. -. build/targets.sh -set -x -$OCAMLBUILD $@ \ - $STDLIB_BYTE $OCAMLC_BYTE $OCAMLLEX_BYTE $OCAMLOPT_BYTE $TOPLEVEL $TOOLS_BYTE \ - $OTHERLIBS_BYTE $OCAMLBUILD_BYTE $DEBUGGER $OCAMLDOC_BYTE diff --git a/build/world.native.sh b/build/world.native.sh deleted file mode 100755 index 039cfbf3e5..0000000000 --- a/build/world.native.sh +++ /dev/null @@ -1,22 +0,0 @@ -#!/bin/sh - -######################################################################### -# # -# OCaml # -# # -# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # -# # -# Copyright 2007 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### - -set -e -cd `dirname $0`/.. -. build/targets.sh -set -x -$OCAMLBUILD $@ \ - $STDLIB_NATIVE $OCAMLC_NATIVE $OCAMLOPT_NATIVE \ - $OCAMLLEX_NATIVE $TOOLS_NATIVE $OTHERLIBS_NATIVE \ - $OCAMLBUILD_NATIVE $OCAMLDOC_NATIVE diff --git a/build/world.sh b/build/world.sh deleted file mode 100755 index 6475a9fca0..0000000000 --- a/build/world.sh +++ /dev/null @@ -1,34 +0,0 @@ -#!/bin/sh - -######################################################################### -# # -# OCaml # -# # -# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # -# # -# Copyright 2008 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the Q Public License version 1.0. # -# # -######################################################################### - -cd `dirname $0` -set -e -if [ -e ocamlbuild_mixed_mode ]; then - echo ocamlbuild mixed mode detected - echo 'please cleanup and re-launch (make clean ; ./build/distclean.sh)' - exit 1 -fi -case "$1" in - all|a|al) mode=all;; - byte|b|by|byt) mode=byte;; - native|na|nat|nati|nativ) mode=native;; - *) echo 'Unexpected target. Expected targets are: all,byte,native' \ - >/dev/stderr - exit 1;; -esac -shift -./mk_shell_and_ocamlbuild_config.sh -./boot-c-parts.sh -./boot.sh "$@" -./world."$mode".sh "$@" diff --git a/bytecomp/bytegen.ml b/bytecomp/bytegen.ml index 6ecd41dde1..3b25c3db3b 100644 --- a/bytecomp/bytegen.ml +++ b/bytecomp/bytegen.ml @@ -275,6 +275,10 @@ let compunit_name = ref "" let max_stack_used = ref 0 + +(* Sequence of string tests *) + + (* Translate a primitive to a bytecode instruction (possibly a call to a C function) *) @@ -618,7 +622,7 @@ let rec comp_expr env exp sz cont = comp_args env args sz (comp_primitive p args :: cont) | Lprim(p, args) -> comp_args env args sz (comp_primitive p args :: cont) - | Lstaticcatch (body, (i, vars) , handler) -> + | Lstaticcatch (body, (i, vars) , handler) -> let nvars = List.length vars in let branch1, cont1 = make_branch cont in let r = @@ -703,7 +707,6 @@ let rec comp_expr env exp sz cont = (fun (n, act) -> act_consts.(n) <- store.act_store act) sw.sw_consts; List.iter (fun (n, act) -> act_blocks.(n) <- store.act_store act) sw.sw_blocks; - (* Compile and label actions *) let acts = store.act_get () in let lbls = Array.create (Array.length acts) 0 in @@ -723,6 +726,8 @@ let rec comp_expr env exp sz cont = lbl_consts.(i) <- lbls.(act_consts.(i)) done; comp_expr env arg sz (Kswitch(lbl_consts, lbl_blocks) :: !c) + | Lstringswitch (arg,sw,d) -> + comp_expr env (Matching.expand_stringswitch arg sw d) sz cont | Lassign(id, expr) -> begin try let pos = Ident.find_same id env.ce_stack in @@ -827,6 +832,10 @@ and comp_binary_test env cond ifso ifnot sz cont = comp_expr env cond sz cont_cond +(* Compile string switch *) + +and comp_string_switch env arg cases default sz cont = () + (**** Compilation of a code block (with tracking of stack usage) ****) let comp_block env exp sz cont = diff --git a/bytecomp/bytepackager.ml b/bytecomp/bytepackager.ml index 8ba2f5321f..9c9c1b842f 100644 --- a/bytecomp/bytepackager.ml +++ b/bytecomp/bytepackager.ml @@ -182,6 +182,8 @@ let build_global_target oc target_name members mapping pos coercion = let lam = Translmod.transl_package components (Ident.create_persistent target_name) coercion in + if !Clflags.dump_lambda then + Format.printf "%a@." Printlambda.lambda lam; let instrs = Bytegen.compile_implementation target_name lam in let rel = diff --git a/bytecomp/lambda.ml b/bytecomp/lambda.ml index b64dee2acd..83c00a32da 100644 --- a/bytecomp/lambda.ml +++ b/bytecomp/lambda.ml @@ -166,6 +166,7 @@ type lambda = | Lletrec of (Ident.t * lambda) list * lambda | Lprim of primitive * lambda list | Lswitch of lambda * lambda_switch + | Lstringswitch of lambda * (string * lambda) list * lambda | Lstaticraise of int * lambda list | Lstaticcatch of lambda * (int * Ident.t list) * lambda | Ltrywith of lambda * Ident.t * lambda @@ -204,6 +205,8 @@ let rec same l1 l2 = match (l1, l2) with | Lvar v1, Lvar v2 -> Ident.same v1 v2 + | Lconst (Const_base (Const_string _)), _ -> + false (* do not share strings *) | Lconst c1, Lconst c2 -> c1 = c2 | Lapply(a1, bl1, _), Lapply(a2, bl2, _) -> @@ -258,10 +261,10 @@ and sameswitch sw1 sw2 = | (Some a1, Some a2) -> same a1 a2 | _ -> false) -let name_lambda arg fn = +let name_lambda strict arg fn = match arg with Lvar id -> fn id - | _ -> let id = Ident.create "let" in Llet(Strict, id, arg, fn id) + | _ -> let id = Ident.create "let" in Llet(strict, id, arg, fn id) let name_lambda_list args fn = let rec name_list names = function @@ -295,6 +298,10 @@ let iter f = function | None -> () | Some l -> f l end + | Lstringswitch (arg,cases,default) -> + f arg ; + List.iter (fun (_,act) -> f act) cases ; + f default | Lstaticraise (_,args) -> List.iter f args | Lstaticcatch(e1, (_,vars), e2) -> @@ -345,7 +352,7 @@ let free_ids get l = | Lassign(id, e) -> fv := IdentSet.add id !fv | Lvar _ | Lconst _ | Lapply _ - | Lprim _ | Lswitch _ | Lstaticraise _ + | Lprim _ | Lswitch _ | Lstringswitch _ | Lstaticraise _ | Lifthenelse _ | Lsequence _ | Lwhile _ | Lsend _ | Levent _ | Lifused _ -> () in free l; !fv @@ -383,14 +390,19 @@ let rec patch_guarded patch = function (* Translate an access path *) -let rec transl_path = function +let rec transl_normal_path = function Pident id -> if Ident.global id then Lprim(Pgetglobal id, []) else Lvar id | Pdot(p, s, pos) -> - Lprim(Pfield pos, [transl_path p]) + Lprim(Pfield pos, [transl_normal_path p]) | Papply(p1, p2) -> fatal_error "Lambda.transl_path" +(* Translation of value identifiers *) + +let transl_path ?(loc=Location.none) env path = + transl_normal_path (Env.normalize_path (Some loc) env path) + (* Compile a sequence of expressions *) let rec make_sequence fn = function @@ -423,7 +435,9 @@ let subst_lambda s lam = match sw.sw_failaction with | None -> None | Some l -> Some (subst l)}) - + | Lstringswitch (arg,cases,default) -> + Lstringswitch + (subst arg,List.map subst_strcase cases,subst default) | Lstaticraise (i,args) -> Lstaticraise (i, List.map subst args) | Lstaticcatch(e1, io, e2) -> Lstaticcatch(subst e1, io, subst e2) | Ltrywith(e1, exn, e2) -> Ltrywith(subst e1, exn, subst e2) @@ -438,6 +452,7 @@ let subst_lambda s lam = | Lifused (v, e) -> Lifused (v, subst e) and subst_decl (id, exp) = (id, subst exp) and subst_case (key, case) = (key, subst case) + and subst_strcase (key, case) = (key, subst case) in subst lam diff --git a/bytecomp/lambda.mli b/bytecomp/lambda.mli index ccc5fc640f..6748fefe1a 100644 --- a/bytecomp/lambda.mli +++ b/bytecomp/lambda.mli @@ -175,6 +175,9 @@ type lambda = | Lletrec of (Ident.t * lambda) list * lambda | Lprim of primitive * lambda list | Lswitch of lambda * lambda_switch +(* switch on strings, clauses are sorted by string order, + strings are pairwise distinct *) + | Lstringswitch of lambda * (string * lambda) list * lambda | Lstaticraise of int * lambda list | Lstaticcatch of lambda * (int * Ident.t list) * lambda | Ltrywith of lambda * Ident.t * lambda @@ -207,7 +210,7 @@ and lambda_event_kind = val same: lambda -> lambda -> bool val const_unit: structured_constant val lambda_unit: lambda -val name_lambda: lambda -> (Ident.t -> lambda) -> lambda +val name_lambda: let_kind -> lambda -> (Ident.t -> lambda) -> lambda val name_lambda_list: lambda list -> (lambda list -> lambda) -> lambda val iter: (lambda -> unit) -> lambda -> unit @@ -215,7 +218,8 @@ module IdentSet: Set.S with type elt = Ident.t val free_variables: lambda -> IdentSet.t val free_methods: lambda -> IdentSet.t -val transl_path: Path.t -> lambda +val transl_normal_path: Path.t -> lambda (* Path.t is already normal *) +val transl_path: ?loc:Location.t -> Env.t -> Path.t -> lambda val make_sequence: ('a -> lambda) -> 'a list -> lambda val subst_lambda: lambda Ident.tbl -> lambda -> lambda diff --git a/bytecomp/matching.ml b/bytecomp/matching.ml index 7387ea64ae..e981483195 100644 --- a/bytecomp/matching.ml +++ b/bytecomp/matching.ml @@ -443,7 +443,9 @@ let pretty_precompiled_res first nexts = -(* A slight attempt to identify semantically equivalent lambda-expressions *) +(* A slight attempt to identify semantically equivalent lambda-expressions, + We could have used Lambda.same, but our goal here is also to + find alpha-equivalent (simple) terms *) exception Not_simple let rec raw_rec env : lambda -> lambda = function @@ -454,6 +456,8 @@ let rec raw_rec env : lambda -> lambda = function end | Lprim (Pfield i,args) -> Lprim (Pfield i, List.map (raw_rec env) args) + | Lconst (Const_base (Const_string _)) -> + raise Not_simple (* do not share strings *) | Lconst _ as l -> l | Lstaticraise (i,args) -> Lstaticraise (i, List.map (raw_rec env) args) @@ -1648,10 +1652,110 @@ let divide_array kind ctx pm = (make_array_matching kind) (=) get_key_array get_args_array ctx pm +(* + Specific string test sequence + Will be called by the bytecode compiler, from bytegen.ml. + The strategy is first dichotomic search (we perform 3-way tests + with compare_string), then sequence of equality tests + when there are less then T=strings_test_threshold static strings to match. + + Increasing T entails (slightly) less code, decreasing T + (slightly) favors runtime speed. + T=8 looks a decent tradeoff. +*) + +(* Utlities *) + +let strings_test_threshold = 8 + +let prim_string_notequal = + Pccall{prim_name = "caml_string_notequal"; + prim_arity = 2; prim_alloc = false; + prim_native_name = ""; prim_native_float = false} + +let prim_string_compare = + Pccall{prim_name = "caml_string_compare"; + prim_arity = 2; prim_alloc = false; + prim_native_name = ""; prim_native_float = false} + +let bind_sw arg k = match arg with +| Lvar _ -> k arg +| _ -> + let id = Ident.create "switch" in + Llet (Strict,id,arg,k (Lvar id)) + + +(* Sequential equality tests *) + +let make_test_sequence arg sw d = + bind_sw arg + (fun arg -> + List.fold_right + (fun (s,lam) k -> + Lifthenelse + (Lprim + (prim_string_notequal, + [arg; Lconst (Const_immstring s)]), + k,lam)) + sw d) + +let catch_sw d k = match d with +| Lstaticraise (_,[]) -> k d +| _ -> + let e = next_raise_count () in + Lstaticcatch (k (Lstaticraise (e,[])),(e,[]),d) + +let rec split k xs = match xs with +| [] -> assert false +| x0::xs -> + if k <= 1 then [],x0,xs + else + let xs,y0,ys = split (k-2) xs in + x0::xs,y0,ys + +let zero_lam = Lconst (Const_base (Const_int 0)) + +let tree_way_test arg lt eq gt = + Lifthenelse + (Lprim (Pintcomp Clt,[arg;zero_lam]),lt, + Lifthenelse(Lprim (Pintcomp Clt,[zero_lam;arg]),gt,eq)) + +(* Dichotomic tree *) + +let rec do_make_tree arg sw d = + let len = List.length sw in + if len <= strings_test_threshold then make_test_sequence arg sw d + else + let lt,(s,act),gt = split len sw in + bind_sw + (Lprim + (prim_string_compare, + [arg; Lconst (Const_immstring s)];)) + (fun r -> + tree_way_test r + (do_make_tree arg lt d) + act + (do_make_tree arg gt d)) + +(* Entry point *) +let expand_stringswitch arg sw d = + bind_sw arg (fun arg -> catch_sw d (fun d -> do_make_tree arg sw d)) + +(*************************************) (* To combine sub-matchings together *) +(*************************************) + +(* Note: dichotomic search requires sorted input with no duplicates *) +let rec uniq_lambda_list sw = match sw with + | []|[_] -> sw + | (c1,_ as p1)::((c2,_)::sw2 as sw1) -> + if const_compare c1 c2 = 0 then uniq_lambda_list (p1::sw2) + else p1::uniq_lambda_list sw1 let sort_lambda_list l = - List.sort (fun (x,_) (y,_) -> const_compare x y) l + let l = + List.stable_sort (fun (x,_) (y,_) -> const_compare x y) l in + uniq_lambda_list l let rec cut n l = if n = 0 then [],l @@ -1694,13 +1798,6 @@ let make_test_sequence fail tst lt_tst arg const_lambda_list = let make_offset x arg = if x=0 then arg else Lprim(Poffsetint(x), [arg]) - - -let prim_string_notequal = - Pccall{prim_name = "caml_string_notequal"; - prim_arity = 2; prim_alloc = false; - prim_native_name = ""; prim_native_float = false} - let rec explode_inter offset i j act k = if i <= j then explode_inter offset i (j-1) act ((j-offset,act)::k) @@ -2097,8 +2194,22 @@ let combine_constant arg cst partial ctx def (fun i -> Lconst (Const_base (Const_int i))) fail arg 0 255 int_lambda_list | Const_string _ -> - make_test_sequence - fail prim_string_notequal Pignore arg const_lambda_list +(* Note as the bytecode compiler may resort to dichotmic search, + the clauses of strinswitch are sorted with duplicate removed. + This partly applies to the native code compiler, which requires + no duplicates *) + let fail,const_lambda_list = match fail with + | Some fail -> fail,sort_lambda_list const_lambda_list + | None -> + let cls,(_,lst) = Misc.split_last const_lambda_list in + lst,sort_lambda_list cls in + let sw = + List.map + (fun (c,act) -> match c with + | Const_string (s,_) -> s,act + | _ -> assert false) + const_lambda_list in + Lstringswitch (arg,sw,fail) | Const_float _ -> make_test_sequence fail @@ -2163,7 +2274,9 @@ let combine_constructor arg ex_pat cstr partial ctx def else Lprim(Pfield 0, [arg]) in Lifthenelse(Lprim(Pintcomp Ceq, - [slot; transl_path path]), + [slot; + transl_path ~loc:ex_pat.pat_loc + ex_pat.pat_env path]), act, rem) | _ -> assert false) tests default in @@ -2734,7 +2847,7 @@ let partial_function loc () = (* [Location.get_pos_info] is too expensive *) let (fname, line, char) = Location.get_pos_info loc.Location.loc_start in Lprim(Praise Raise_regular, [Lprim(Pmakeblock(0, Immutable), - [transl_path Predef.path_match_failure; + [transl_normal_path Predef.path_match_failure; Lconst(Const_block(0, [Const_base(Const_string (fname, None)); Const_base(Const_int line); diff --git a/bytecomp/matching.mli b/bytecomp/matching.mli index 5c8577b26b..398143778b 100644 --- a/bytecomp/matching.mli +++ b/bytecomp/matching.mli @@ -15,6 +15,8 @@ open Typedtree open Lambda + +(* Entry points to match compiler *) val for_function: Location.t -> int ref option -> lambda -> (pattern * lambda) list -> partial -> lambda @@ -34,8 +36,14 @@ exception Cannot_flatten val flatten_pattern: int -> pattern -> pattern list +(* Expand stringswitch to string test tree *) + +val expand_stringswitch: lambda -> (string * lambda) list -> lambda -> lambda + +(* val make_test_sequence: lambda option -> primitive -> primitive -> lambda -> (Asttypes.constant * lambda) list -> lambda +*) val inline_lazy_force : lambda -> Location.t -> lambda diff --git a/bytecomp/printlambda.ml b/bytecomp/printlambda.ml index 3ef160fe21..e02196f9b9 100644 --- a/bytecomp/printlambda.ml +++ b/bytecomp/printlambda.ml @@ -255,12 +255,15 @@ let rec lam ppf = function fprintf ppf ")" in fprintf ppf "@[<2>(function%a@ %a)@]" pr_params params lam body | Llet(str, id, arg, body) -> + let kind = function + Alias -> "a" | Strict -> "" | StrictOpt -> "o" | Variable -> "v" in let rec letbody = function | Llet(str, id, arg, body) -> - fprintf ppf "@ @[<2>%a@ %a@]" Ident.print id lam arg; + fprintf ppf "@ @[<2>%a =%s@ %a@]" Ident.print id (kind str) lam arg; letbody body | expr -> expr in - fprintf ppf "@[<2>(let@ @[<hv 1>(@[<2>%a@ %a@]" Ident.print id lam arg; + fprintf ppf "@[<2>(let@ @[<hv 1>(@[<2>%a =%s@ %a@]" + Ident.print id (kind str) lam arg; let expr = letbody body in fprintf ppf ")@]@ %a)@]" lam expr | Lletrec(id_arg_list, body) -> @@ -296,11 +299,22 @@ let rec lam ppf = function if !spc then fprintf ppf "@ " else spc := true; fprintf ppf "@[<hv 1>default:@ %a@]" lam l end in - fprintf ppf "@[<1>(%s %a@ @[<v 0>%a@])@]" (match sw.sw_failaction with None -> "switch*" | _ -> "switch") lam larg switch sw + | Lstringswitch(arg, cases, default) -> + let switch ppf cases = + let spc = ref false in + List.iter + (fun (s, l) -> + if !spc then fprintf ppf "@ " else spc := true; + fprintf ppf "@[<hv 1>case \"%s\":@ %a@]" (String.escaped s) lam l) + cases; + if !spc then fprintf ppf "@ " else spc := true; + fprintf ppf "@[<hv 1>default:@ %a@]" lam default in + fprintf ppf + "@[<1>(stringswitch %a@ @[<v 0>%a@])@]" lam arg switch cases | Lstaticraise (i, ls) -> let lams ppf largs = List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in diff --git a/bytecomp/simplif.ml b/bytecomp/simplif.ml index e60bb6d168..c03cd857e7 100644 --- a/bytecomp/simplif.ml +++ b/bytecomp/simplif.ml @@ -54,6 +54,11 @@ let rec eliminate_ref id = function sw_failaction = match sw.sw_failaction with | None -> None | Some l -> Some (eliminate_ref id l)}) + | Lstringswitch(e, sw, default) -> + Lstringswitch + (eliminate_ref id e, + List.map (fun (s, e) -> (s, eliminate_ref id e)) sw, + eliminate_ref id default) | Lstaticraise (i,args) -> Lstaticraise (i,List.map (eliminate_ref id) args) | Lstaticcatch(e1, i, e2) -> @@ -115,6 +120,10 @@ let simplify_exits lam = count l; List.iter (fun (_, l) -> count l) sw.sw_consts; List.iter (fun (_, l) -> count l) sw.sw_blocks + | Lstringswitch(l, sw, d) -> + count l; + List.iter (fun (_, l) -> count l) sw; + count d | Lstaticraise (i,ls) -> incr_exit i ; List.iter count ls | Lstaticcatch (l1,(i,[]),Lstaticraise (j,[])) -> (* i will be replaced by j in l1, so each occurence of i in l1 @@ -216,6 +225,9 @@ let simplify_exits lam = (new_l, {sw with sw_consts = new_consts ; sw_blocks = new_blocks; sw_failaction = new_fail}) + | Lstringswitch(l,sw,d) -> + Lstringswitch + (simplif l,List.map (fun (s,l) -> s,simplif l) sw,simplif d) | Lstaticraise (i,[]) as l -> begin try let _,handler = Hashtbl.find subst i in @@ -361,6 +373,10 @@ let simplify_lets lam = count bv l; List.iter (fun (_, l) -> count bv l) sw.sw_consts; List.iter (fun (_, l) -> count bv l) sw.sw_blocks + | Lstringswitch(l, sw, d) -> + count bv l ; + List.iter (fun (_, l) -> count bv l) sw ; + count bv d | Lstaticraise (i,ls) -> List.iter (count bv) ls | Lstaticcatch(l1, (i,_), l2) -> count bv l1; count bv l2 | Ltrywith(l1, v, l2) -> count bv l1; count bv l2 @@ -460,6 +476,9 @@ let simplify_lets lam = (new_l, {sw with sw_consts = new_consts ; sw_blocks = new_blocks; sw_failaction = new_fail}) + | Lstringswitch (l,sw,d) -> + Lstringswitch + (simplif l,List.map (fun (s,l) -> s,simplif l) sw,simplif d) | Lstaticraise (i,ls) -> Lstaticraise (i, List.map simplif ls) | Lstaticcatch(l1, (i,args), l2) -> @@ -521,6 +540,12 @@ let rec emit_tail_infos is_tail lambda = emit_tail_infos false lam; list_emit_tail_infos_fun snd is_tail sw.sw_consts; list_emit_tail_infos_fun snd is_tail sw.sw_blocks + | Lstringswitch (lam, sw, d) -> + emit_tail_infos false lam; + List.iter + (fun (_,lam) -> emit_tail_infos is_tail lam) + sw ; + emit_tail_infos is_tail d | Lstaticraise (_, l) -> list_emit_tail_infos false l | Lstaticcatch (body, _, handler) -> diff --git a/bytecomp/translclass.ml b/bytecomp/translclass.ml index b22c0adafb..55ddab3bc8 100644 --- a/bytecomp/translclass.ml +++ b/bytecomp/translclass.ml @@ -115,6 +115,9 @@ let name_pattern default p = | Tpat_alias(p, id, _) -> id | _ -> Ident.create default +let normalize_cl_path cl path = + Env.normalize_path (Some cl.cl_loc) cl.cl_env path + let rec build_object_init cl_table obj params inh_init obj_init cl = match cl.cl_desc with Tcl_ident ( path, _, _) -> @@ -124,7 +127,8 @@ let rec build_object_init cl_table obj params inh_init obj_init cl = match envs with None -> [] | Some envs -> [Lprim(Pfield (List.length inh_init + 1), [Lvar envs])] in - ((envs, (obj_init, path)::inh_init), + ((envs, (obj_init, normalize_cl_path cl path) + ::inh_init), mkappl(Lvar obj_init, env @ [obj])) | Tcl_structure str -> create_object cl_table obj (fun obj -> @@ -253,7 +257,7 @@ let rec build_class_init cla cstr super inh_init cl_init msubst top cl = Tcl_ident ( path, _, _) -> begin match inh_init with (obj_init, path')::inh_init -> - let lpath = transl_path path in + let lpath = transl_path ~loc:cl.cl_loc cl.cl_env path in (inh_init, Llet (Strict, obj_init, mkappl(Lprim(Pfield 1, [lpath]), Lvar cla :: @@ -331,8 +335,8 @@ let rec build_class_init cla cstr super inh_init cl_init msubst top cl = let cl = ignore_cstrs cl in begin match cl.cl_desc, inh_init with Tcl_ident (path, _, _), (obj_init, path')::inh_init -> - assert (Path.same path path'); - let lpath = transl_path path in + assert (Path.same (normalize_cl_path cl path) path'); + let lpath = transl_normal_path path' in let inh = Ident.create "inh" and ofs = List.length vals + 1 and valids, methids = super in @@ -398,7 +402,7 @@ let rec transl_class_rebind obj_init cl vf = try if (Env.find_class path cl.cl_env).cty_new = None then raise Exit with Not_found -> raise Exit end; - (path, obj_init) + (normalize_cl_path cl path, obj_init) | Tcl_fun (_, pat, _, cl, partial) -> let path, obj_init = transl_class_rebind obj_init cl vf in let build params rem = @@ -446,7 +450,7 @@ let transl_class_rebind ids cl vf = 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 - if id then transl_path path else + if id then transl_normal_path path else let cla = Ident.create "class" and new_init = Ident.create "new_init" @@ -456,7 +460,7 @@ let transl_class_rebind ids cl vf = Llet( Strict, new_init, lfunction [obj_init] obj_init', Llet( - Alias, cla, transl_path path, + Alias, cla, transl_normal_path path, Lprim(Pmakeblock(0, Immutable), [mkappl(Lvar new_init, [lfield cla 0]); lfunction [table] @@ -741,7 +745,7 @@ let transl_class ids cl_id pub_meths cl vflag = Lprim(Pmakeblock(0, Immutable), menv :: List.map (fun id -> Lvar id) !new_ids_init) and linh_envs = - List.map (fun (_, p) -> Lprim(Pfield 3, [transl_path p])) + List.map (fun (_, p) -> Lprim(Pfield 3, [transl_normal_path p])) (List.rev inh_init) in let make_envs lam = @@ -758,7 +762,7 @@ let transl_class ids cl_id pub_meths cl vflag = List.filter (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 + List.map (fun (_,p) -> Lprim(Pfield 1, [transl_normal_path p])) inh_paths in let lclass lam = Llet(Strict, class_init, Lfunction(Curried, [cla], def_ids cla cl_init), lam) diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml index d63381631c..526c0f576f 100644 --- a/bytecomp/translcore.ml +++ b/bytecomp/translcore.ml @@ -589,7 +589,7 @@ let assert_failed exp = Location.get_pos_info exp.exp_loc.Location.loc_start in Lprim(Praise Raise_regular, [event_after exp (Lprim(Pmakeblock(0, Immutable), - [transl_path Predef.path_assert_failure; + [transl_normal_path Predef.path_assert_failure; Lconst(Const_block(0, [Const_base(Const_string (fname, None)); Const_base(Const_int line); @@ -635,7 +635,7 @@ and transl_exp0 e = | Texp_ident(path, _, {val_kind = Val_anc _}) -> raise(Error(e.exp_loc, Free_super_var)) | Texp_ident(path, _, {val_kind = Val_reg | Val_self _}) -> - transl_path path + transl_path ~loc:e.exp_loc e.exp_env path | Texp_ident _ -> fatal_error "Translcore.transl_exp: bad Texp_ident" | Texp_constant cst -> Lconst(Const_base cst) @@ -734,7 +734,7 @@ and transl_exp0 e = Lprim(Pmakeblock(n, Immutable), ll) end | Cstr_exception (path, _) -> - let slot = transl_path path in + let slot = transl_path ~loc:e.exp_loc e.exp_env path in if cstr.cstr_arity = 0 then slot else Lprim(Pmakeblock(0, Immutable), slot :: ll) end @@ -813,16 +813,18 @@ and transl_exp0 e = Lsend (kind, tag, obj, cache, e.exp_loc) in event_after e lam - | Texp_new (cl, _, _) -> - Lapply(Lprim(Pfield 0, [transl_path cl]), [lambda_unit], Location.none) + | Texp_new (cl, {Location.loc=loc}, _) -> + Lapply(Lprim(Pfield 0, [transl_path ~loc e.exp_env cl]), + [lambda_unit], Location.none) | Texp_instvar(path_self, path, _) -> - Lprim(Parrayrefu Paddrarray, [transl_path path_self; transl_path path]) + Lprim(Parrayrefu Paddrarray, + [transl_normal_path path_self; transl_normal_path path]) | Texp_setinstvar(path_self, path, _, expr) -> - transl_setinstvar (transl_path path_self) path expr + transl_setinstvar (transl_normal_path path_self) path expr | Texp_override(path_self, modifs) -> let cpy = Ident.create "copy" in Llet(Strict, cpy, - Lapply(Translobj.oo_prim "copy", [transl_path path_self], + Lapply(Translobj.oo_prim "copy", [transl_normal_path path_self], Location.none), List.fold_right (fun (path, _, expr) rem -> @@ -887,7 +889,7 @@ and transl_exp0 e = (* other cases compile to a lazy block holding a function *) | _ -> let fn = Lfunction (Curried, [Ident.create "param"], transl_exp e) in - Lprim(Pmakeblock(Config.lazy_tag, Immutable), [fn]) + Lprim(Pmakeblock(Config.lazy_tag, Mutable), [fn]) end | Texp_object (cs, meths) -> let cty = cs.cstr_type in @@ -1044,7 +1046,7 @@ and transl_let rec_flag pat_expr_list body = and transl_setinstvar self var expr = Lprim(Parraysetu (if maybe_pointer expr then Paddrarray else Pintarray), - [self; transl_path var; transl_exp expr]) + [self; transl_normal_path var; transl_exp expr]) and transl_record all_labels repres lbl_expr_list opt_init_expr = let size = Array.length all_labels in diff --git a/bytecomp/translmod.ml b/bytecomp/translmod.ml index 10915d8533..4b3141ad90 100644 --- a/bytecomp/translmod.ml +++ b/bytecomp/translmod.ml @@ -44,32 +44,48 @@ let transl_exception path decl = | Some p -> Path.name p in Lprim(prim_set_oo_id, - [Lprim(Pmakeblock(Obj.object_tag, Immutable), + [Lprim(Pmakeblock(Obj.object_tag, Mutable), [Lconst(Const_base(Const_string (name,None))); Lconst(Const_base(Const_int 0))])]) (* Compile a coercion *) -let rec apply_coercion restr arg = +let rec apply_coercion strict restr arg = match restr with Tcoerce_none -> arg - | Tcoerce_structure pos_cc_list -> - name_lambda arg (fun id -> - Lprim(Pmakeblock(0, Immutable), - List.map (apply_coercion_field id) pos_cc_list)) + | Tcoerce_structure(pos_cc_list, id_pos_list) -> + name_lambda strict arg (fun id -> + let lam = + Lprim(Pmakeblock(0, Immutable), + List.map (apply_coercion_field id) pos_cc_list) in + let fv = free_variables lam in + let (lam,s) = + List.fold_left (fun (lam,s) (id',pos,c) -> + if IdentSet.mem id' fv then + let id'' = Ident.create (Ident.name id') in + (Llet(Alias,id'', + apply_coercion Alias c (Lprim(Pfield pos,[Lvar id])),lam), + Ident.add id' (Lvar id'') s) + else (lam,s)) + (lam, Ident.empty) id_pos_list + in + if s == Ident.empty then lam else subst_lambda s lam) | Tcoerce_functor(cc_arg, cc_res) -> let param = Ident.create "funarg" in - name_lambda arg (fun id -> + name_lambda strict arg (fun id -> Lfunction(Curried, [param], - apply_coercion cc_res - (Lapply(Lvar id, [apply_coercion cc_arg (Lvar param)], + apply_coercion Strict cc_res + (Lapply(Lvar id, [apply_coercion Alias cc_arg (Lvar param)], Location.none)))) | Tcoerce_primitive p -> transl_primitive Location.none p + | Tcoerce_alias (path, cc) -> + name_lambda strict arg + (fun id -> apply_coercion Alias cc (transl_normal_path path)) and apply_coercion_field id (pos, cc) = - apply_coercion cc (Lprim(Pfield pos, [Lvar id])) + apply_coercion Alias cc (Lprim(Pfield pos, [Lvar id])) (* Compose two coercions apply_coercion c1 (apply_coercion c2 e) behaves like @@ -79,18 +95,26 @@ let rec compose_coercions c1 c2 = match (c1, c2) with (Tcoerce_none, c2) -> c2 | (c1, Tcoerce_none) -> c1 - | (Tcoerce_structure pc1, Tcoerce_structure pc2) -> + | (Tcoerce_structure (pc1, ids1), Tcoerce_structure (pc2, ids2)) -> let v2 = Array.of_list pc2 in + let ids1 = + List.map (fun (id,pos1,c1) -> + let (pos2,c2) = v2.(pos1) in (id, pos2, compose_coercions c1 c2)) + ids1 + in Tcoerce_structure (List.map (function (p1, Tcoerce_primitive p) -> (p1, Tcoerce_primitive p) | (p1, c1) -> let (p2, c2) = v2.(p1) in (p2, compose_coercions c1 c2)) - pc1) + pc1, + ids1 @ ids2) | (Tcoerce_functor(arg1, res1), Tcoerce_functor(arg2, res2)) -> Tcoerce_functor(compose_coercions arg2 arg1, compose_coercions res1 res2) + | (c1, Tcoerce_alias (path, c2)) -> + Tcoerce_alias (path, compose_coercions c1 c2) | (_, _) -> fatal_error "Translmod.compose_coercions" @@ -119,7 +143,7 @@ let field_path path field = let mod_prim name = try - transl_path + transl_normal_path (fst (Env.lookup_value (Ldot (Lident "CamlinternalMod", name)) Env.empty)) with Not_found -> @@ -137,6 +161,8 @@ let init_shape modl = match Mtype.scrape env mty with Mty_ident _ -> raise Not_found + | Mty_alias _ -> + Const_block (1, [Const_pointer 0]) | Mty_signature sg -> Const_block(0, [Const_block(0, init_shape_struct env sg)]) | Mty_functor(id, arg, res) -> @@ -264,9 +290,13 @@ let rec bound_value_identifiers = function (* Compile a module expression *) let rec transl_module cc rootpath mexp = + match mexp.mod_type with + Mty_alias _ -> apply_coercion Alias cc lambda_unit + | _ -> match mexp.mod_desc with Tmod_ident (path,_) -> - apply_coercion cc (transl_path path) + apply_coercion StrictOpt cc + (transl_path ~loc:mexp.mod_loc mexp.mod_env path) | Tmod_structure str -> transl_struct [] cc rootpath str | Tmod_functor( param, _, mty, body) -> @@ -279,20 +309,21 @@ let rec transl_module cc rootpath mexp = | Tcoerce_functor(ccarg, ccres) -> let param' = Ident.create "funarg" in Lfunction(Curried, [param'], - Llet(Alias, param, apply_coercion ccarg (Lvar param'), + Llet(Alias, param, + apply_coercion Alias ccarg (Lvar param'), transl_module ccres bodypath body)) | _ -> fatal_error "Translmod.transl_module") cc | Tmod_apply(funct, arg, ccarg) -> oo_wrap mexp.mod_env true - (apply_coercion cc) + (apply_coercion Strict cc) (Lapply(transl_module Tcoerce_none None funct, [transl_module ccarg None arg], mexp.mod_loc)) | Tmod_constraint(arg, mty, _, ccarg) -> transl_module (compose_coercions cc ccarg) rootpath arg | Tmod_unpack(arg, _) -> - apply_coercion cc (Translcore.transl_exp arg) + apply_coercion Strict cc (Translcore.transl_exp arg) and transl_struct fields cc rootpath str = transl_structure fields cc rootpath str.str_items @@ -303,15 +334,19 @@ and transl_structure fields cc rootpath = function Tcoerce_none -> Lprim(Pmakeblock(0, Immutable), List.map (fun id -> Lvar id) (List.rev fields)) - | Tcoerce_structure pos_cc_list -> + | Tcoerce_structure(pos_cc_list, id_pos_list) -> + (* ignore id_pos_list as the ids are already bound *) let v = Array.of_list (List.rev fields) in - Lprim(Pmakeblock(0, Immutable), + (*List.fold_left + (fun lam (id, pos) -> Llet(Alias, id, Lvar v.(pos), lam))*) + (Lprim(Pmakeblock(0, Immutable), List.map (fun (pos, cc) -> match cc with Tcoerce_primitive p -> transl_primitive Location.none p - | _ -> apply_coercion cc (Lvar v.(pos))) - pos_cc_list) + | _ -> apply_coercion Strict cc (Lvar v.(pos))) + pos_cc_list)) + (*id_pos_list*) | _ -> fatal_error "Translmod.transl_structure" end @@ -332,12 +367,12 @@ and transl_structure fields cc rootpath = function let id = decl.cd_id in Llet(Strict, id, transl_exception (field_path rootpath id) decl, transl_structure (id :: fields) cc rootpath rem) - | Tstr_exn_rebind( id, _, path, _, _) -> - Llet(Strict, id, transl_path path, + | Tstr_exn_rebind( id, _, path, {Location.loc=loc}, _) -> + Llet(Strict, id, transl_path ~loc item.str_env path, transl_structure (id :: fields) cc rootpath rem) | Tstr_module mb -> let id = mb.mb_id in - Llet(Strict, id, + Llet(pure_module mb.mb_expr, id, transl_module Tcoerce_none (field_path rootpath id) mb.mb_expr, transl_structure (id :: fields) cc rootpath rem) | Tstr_recmodule bindings -> @@ -367,7 +402,7 @@ and transl_structure fields cc rootpath = function | id :: ids -> Llet(Alias, id, Lprim(Pfield pos, [Lvar mid]), rebind_idents (pos + 1) (id :: newfields) ids) in - Llet(Strict, mid, transl_module Tcoerce_none None modl, + Llet(pure_module modl, mid, transl_module Tcoerce_none None modl, rebind_idents 0 fields ids) | Tstr_modtype _ @@ -376,6 +411,12 @@ and transl_structure fields cc rootpath = function | Tstr_attribute _ -> transl_structure fields cc rootpath rem +and pure_module m = + match m.mod_desc with + Tmod_ident _ -> Alias + | Tmod_constraint (m,_,_,_) -> pure_module m + | _ -> Strict + (* Update forward declaration in Translcore *) let _ = Translcore.transl_module := transl_module @@ -414,7 +455,7 @@ let rec defined_idents = function List.map (fun (ci, _, _) -> ci.ci_id_class) cl_list @ defined_idents rem | Tstr_class_type cl_list -> defined_idents rem | Tstr_include(modl, sg, _) -> bound_value_identifiers sg @ defined_idents rem - | Tstr_attribute _ -> [] + | Tstr_attribute _ -> defined_idents rem (* second level idents (module M = struct ... let id = ... end), and all sub-levels idents *) @@ -437,7 +478,7 @@ let rec more_idents = function | Tstr_module {mb_expr={mod_desc = Tmod_structure str}} -> all_idents str.str_items @ more_idents rem | Tstr_module _ -> more_idents rem - | Tstr_attribute _ -> [] + | Tstr_attribute _ -> more_idents rem and all_idents = function [] -> [] @@ -461,7 +502,7 @@ and all_idents = function | Tstr_module {mb_id;mb_expr={mod_desc = Tmod_structure str}} -> mb_id :: all_idents str.str_items @ all_idents rem | Tstr_module mb -> mb.mb_id :: all_idents rem - | Tstr_attribute _ -> [] + | Tstr_attribute _ -> all_idents rem (* A variant of transl_structure used to compile toplevel structure definitions @@ -509,8 +550,8 @@ let transl_store_structure glob map prims str = let lam = transl_exception (field_path rootpath id) decl in Lsequence(Llet(Strict, id, lam, store_ident id), transl_store rootpath (add_ident false id subst) rem) - | Tstr_exn_rebind( id, _, path, _, _) -> - let lam = subst_lambda subst (transl_path path) in + | Tstr_exn_rebind( id, _, path, {Location.loc=loc}, _) -> + let lam = subst_lambda subst (transl_path ~loc item.str_env path) in Lsequence(Llet(Strict, id, lam, store_ident id), transl_store rootpath (add_ident false id subst) rem) | Tstr_module{mb_id=id; mb_expr={mod_desc = Tmod_structure str}} -> @@ -527,8 +568,7 @@ let transl_store_structure glob map prims str = transl_store rootpath (add_ident true id subst) rem))) | Tstr_module{mb_id=id; mb_expr=modl} -> - let lam = - transl_module Tcoerce_none (field_path rootpath id) modl in + let lam = transl_module Tcoerce_none (field_path rootpath id) modl in (* Careful: the module value stored in the global may be different from the local module value, in case a coercion is applied. If so, keep using the local module value (id) in the remainder of @@ -580,7 +620,7 @@ let transl_store_structure glob map prims str = and store_ident id = try let (pos, cc) = Ident.find_same id map in - let init_val = apply_coercion cc (Lvar id) in + let init_val = apply_coercion Alias cc (Lvar id) in Lprim(Psetfield(pos, false), [Lprim(Pgetglobal glob, []); init_val]) with Not_found -> fatal_error("Translmod.store_ident: " ^ Ident.unique_name id) @@ -633,7 +673,8 @@ let build_ident_map restr idlist more_ids = match restr with Tcoerce_none -> natural_map 0 Ident.empty [] idlist - | Tcoerce_structure pos_cc_list -> + | Tcoerce_structure (pos_cc_list, _id_pos_list) -> + (* ignore _id_pos_list as the ids are already bound *) let idarray = Array.of_list idlist in let rec export_map pos map prims undef = function [] -> @@ -721,14 +762,14 @@ let transl_toplevel_item item = (make_sequence toploop_setvalue_id idents) | Tstr_exception decl -> toploop_setvalue decl.cd_id (transl_exception None decl) - | Tstr_exn_rebind(id, _, path, _, _) -> - toploop_setvalue id (transl_path path) + | Tstr_exn_rebind(id, _, path, {Location.loc=loc}, _) -> + toploop_setvalue id (transl_path ~loc item.str_env path) | Tstr_module {mb_id=id; mb_expr=modl} -> (* we need to use the unique name for the module because of issues with "open" (PR#1672) *) set_toplevel_unique_name id; - toploop_setvalue id - (transl_module Tcoerce_none (Some(Pident id)) modl) + let lam = transl_module Tcoerce_none (Some(Pident id)) modl in + toploop_setvalue id lam | Tstr_recmodule bindings -> let idents = List.map (fun mb -> mb.mb_id) bindings in compile_recmodule @@ -782,17 +823,23 @@ let get_component = function let transl_package component_names target_name coercion = let components = + Lprim(Pmakeblock(0, Immutable), List.map get_component component_names) in + Lprim(Psetglobal target_name, [apply_coercion Strict coercion components]) + (* + let components = match coercion with Tcoerce_none -> List.map get_component component_names - | Tcoerce_structure pos_cc_list -> + | Tcoerce_structure (pos_cc_list, id_pos_list) -> + (* ignore id_pos_list as the ids are already bound *) let g = Array.of_list component_names in List.map - (fun (pos, cc) -> apply_coercion cc (get_component g.(pos))) + (fun (pos, cc) -> apply_coercion Strict cc (get_component g.(pos))) pos_cc_list | _ -> assert false in 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 = @@ -808,15 +855,30 @@ let transl_store_package component_names target_name coercion = [Lprim(Pgetglobal target_name, []); get_component id])) 0 component_names) - | Tcoerce_structure pos_cc_list -> + | Tcoerce_structure (pos_cc_list, id_pos_list) -> + let components = + Lprim(Pmakeblock(0, Immutable), List.map get_component component_names) + in + let blk = Ident.create "block" in + (List.length pos_cc_list, + Llet (Strict, blk, apply_coercion Strict coercion components, + make_sequence + (fun pos id -> + Lprim(Psetfield(pos, false), + [Lprim(Pgetglobal target_name, []); + Lprim(Pfield pos, [Lvar blk])])) + 0 pos_cc_list)) + (* + (* ignore id_pos_list as the ids are already bound *) let id = Array.of_list component_names in (List.length pos_cc_list, make_sequence (fun dst (src, cc) -> Lprim(Psetfield(dst, false), [Lprim(Pgetglobal target_name, []); - apply_coercion cc (get_component id.(src))])) + apply_coercion Strict cc (get_component id.(src))])) 0 pos_cc_list) + *) | _ -> assert false (* Error report *) diff --git a/bytecomp/translobj.ml b/bytecomp/translobj.ml index 437c3d71e3..7f0d8577eb 100644 --- a/bytecomp/translobj.ml +++ b/bytecomp/translobj.ml @@ -20,7 +20,7 @@ open Lambda let oo_prim name = try - transl_path + transl_normal_path (fst (Env.lookup_value (Ldot (Lident "CamlinternalOO", name)) Env.empty)) with Not_found -> fatal_error ("Primitive " ^ name ^ " not found.") @@ -93,12 +93,19 @@ let prim_makearray = { prim_name = "caml_make_vect"; prim_arity = 2; prim_alloc = true; prim_native_name = ""; prim_native_float = false } +(* Also use it for required globals *) let transl_label_init expr = let expr = Hashtbl.fold (fun c id expr -> Llet(Alias, id, Lconst c, expr)) consts expr in + let expr = + List.fold_right + (fun id expr -> Lsequence(Lprim(Pgetglobal id, []), expr)) + (Env.get_required_globals ()) expr + in + Env.reset_required_globals (); reset_labels (); expr diff --git a/byterun/.depend b/byterun/.depend index 2f1780db9e..a68ab0904e 100644 --- a/byterun/.depend +++ b/byterun/.depend @@ -1,422 +1,419 @@ 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 + ../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 + ../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 + 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 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 + ../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 + 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 + ../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 + ../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 + ../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 + 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 + ../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 + ../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 + ../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 + 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 + ../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 + 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 + ../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 + ../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 int64_native.h + ../config/s.h misc.h custom.h memory.h gc.h major_gc.h freelist.h \ + minor_gc.h hash.h int64_native.h instrtrace.o: instrtrace.c intern.o: intern.c alloc.h compatibility.h misc.h config.h ../config/m.h \ - ../config/s.h mlvalues.h 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 + ../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 + ../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 int64_native.h + ../config/s.h mlvalues.h custom.h fail.h intext.h io.h memory.h gc.h \ + major_gc.h freelist.h minor_gc.h int64_native.h io.o: io.c config.h ../config/m.h ../config/s.h compatibility.h alloc.h \ - misc.h mlvalues.h custom.h fail.h io.h memory.h gc.h major_gc.h \ - freelist.h minor_gc.h signals.h sys.h + 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 + ../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 + ../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 + 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 + ../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 + ../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 + ../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 + 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 + 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 + ../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 + 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 + ../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 + ../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 + ../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 + ../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 + 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 + 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 + 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 int64_native.h + ../config/s.h mlvalues.h fail.h int64_native.h sys.o: sys.c config.h ../config/m.h ../config/s.h compatibility.h alloc.h \ - misc.h mlvalues.h debugger.h fail.h instruct.h osdeps.h signals.h \ - stacks.h memory.h gc.h major_gc.h freelist.h minor_gc.h sys.h + 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 + 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 + 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 + ../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 + ../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 + ../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 + ../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 + 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 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 + ../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 + 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 + ../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 + ../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 + ../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 + 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 + ../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 + ../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 + ../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 + 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 + ../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 + 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 + ../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 + ../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 int64_native.h + ../config/s.h misc.h custom.h memory.h gc.h major_gc.h freelist.h \ + minor_gc.h hash.h int64_native.h instrtrace.d.o: instrtrace.c instruct.h misc.h compatibility.h config.h \ - ../config/m.h ../config/s.h mlvalues.h opnames.h prims.h stacks.h \ - memory.h gc.h major_gc.h freelist.h minor_gc.h + ../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 + ../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 + ../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 int64_native.h + ../config/s.h mlvalues.h custom.h fail.h intext.h io.h memory.h gc.h \ + major_gc.h freelist.h minor_gc.h int64_native.h io.d.o: io.c config.h ../config/m.h ../config/s.h compatibility.h alloc.h \ - misc.h mlvalues.h custom.h fail.h io.h memory.h gc.h major_gc.h \ - freelist.h minor_gc.h signals.h sys.h + 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 + ../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 + ../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 + 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 + ../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 + ../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 + ../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 + 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 + 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 + ../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 + 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 + ../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 + ../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 + ../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 + ../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 + 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 + 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 + 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 int64_native.h + ../config/s.h mlvalues.h fail.h int64_native.h sys.d.o: sys.c config.h ../config/m.h ../config/s.h compatibility.h alloc.h \ - misc.h mlvalues.h debugger.h fail.h instruct.h osdeps.h signals.h \ - stacks.h memory.h gc.h major_gc.h freelist.h minor_gc.h sys.h + 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 + 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 + 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 + ../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 + ../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 + ../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 + ../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 + 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 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 + ../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 + 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 + ../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 + ../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 + ../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 + 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 + ../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 + ../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 + ../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 + 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 + ../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 + 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 + ../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 + ../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 int64_native.h + ../config/s.h misc.h custom.h memory.h gc.h major_gc.h freelist.h \ + minor_gc.h hash.h int64_native.h instrtrace.pic.o: instrtrace.c intern.pic.o: intern.c alloc.h compatibility.h misc.h config.h ../config/m.h \ - ../config/s.h mlvalues.h 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 + ../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 + ../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 int64_native.h + ../config/s.h mlvalues.h custom.h fail.h intext.h io.h memory.h gc.h \ + major_gc.h freelist.h minor_gc.h int64_native.h io.pic.o: io.c config.h ../config/m.h ../config/s.h compatibility.h alloc.h \ - misc.h mlvalues.h custom.h fail.h io.h memory.h gc.h major_gc.h \ - freelist.h minor_gc.h signals.h sys.h + 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 + ../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 + ../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 + 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 + ../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 + ../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 + ../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 + 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 + 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 + ../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 + 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 + ../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 + ../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 + ../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 + ../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 + 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 + 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 + 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 int64_native.h + ../config/s.h mlvalues.h fail.h int64_native.h sys.pic.o: sys.c config.h ../config/m.h ../config/s.h compatibility.h alloc.h \ - misc.h mlvalues.h debugger.h fail.h instruct.h osdeps.h signals.h \ - stacks.h memory.h gc.h major_gc.h freelist.h minor_gc.h sys.h + 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 + 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 + 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 + ../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 + ../config/s.h mlvalues.h memory.h gc.h major_gc.h freelist.h minor_gc.h \ + osdeps.h signals.h sys.h diff --git a/byterun/array.c b/byterun/array.c index a8830d58ed..327f2b5647 100644 --- a/byterun/array.c +++ b/byterun/array.c @@ -137,12 +137,23 @@ CAMLprim value caml_array_unsafe_set(value array, value index, value newval) CAMLprim value caml_make_float_vect(value len) { - mlsize_t wsize = Long_val(len) * Double_wosize; - if (wsize == 0) + mlsize_t wosize = Long_val(len) * Double_wosize; + value result; + if (wosize == 0) return Atom(0); - if (wsize > Max_wosize) - caml_invalid_argument("Array.make"); - return caml_alloc(wsize, Double_array_tag); + else if (wosize <= Max_young_wosize){ +#define Setup_for_gc +#define Restore_after_gc + Alloc_small (result, wosize, Double_array_tag); +#undef Setup_for_gc +#undef Restore_after_gc + }else if (wosize > Max_wosize) + caml_invalid_argument("Array.make_float"); + else { + result = caml_alloc_shr (wosize, Double_array_tag); + result = caml_check_urgent_gc (result); + } + return result; } CAMLprim value caml_make_vect(value len, value init) diff --git a/byterun/config.h b/byterun/config.h index 24f4e59324..8cf851613d 100644 --- a/byterun/config.h +++ b/byterun/config.h @@ -139,16 +139,17 @@ typedef struct { uint32 l, h; } uint64, int64; /* Minimum size increment when growing the heap (words). Must be a multiple of [Page_size / sizeof (value)]. */ -#define Heap_chunk_min (2 * Page_size / sizeof (value)) +#define Heap_chunk_min (15 * Page_size) -/* Default size increment when growing the heap. (words) - Must be a multiple of [Page_size / sizeof (value)]. - (Approx 512 Kb for a 32-bit platform, 1 Mb for a 64-bit platform.) */ -#define Heap_chunk_def (31 * 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); - same constraints as for Heap_chunk_def. */ + 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 diff --git a/byterun/gc_ctrl.c b/byterun/gc_ctrl.c index 84327fa289..7e61f0c1b6 100644 --- a/byterun/gc_ctrl.c +++ b/byterun/gc_ctrl.c @@ -43,10 +43,10 @@ intnat caml_stat_minor_collections = 0, caml_stat_compactions = 0, caml_stat_heap_chunks = 0; -extern uintnat caml_major_heap_increment; /* bytes; see major_gc.c */ -extern uintnat caml_percent_free; /* see major_gc.c */ -extern uintnat caml_percent_max; /* see compact.c */ -extern uintnat caml_allocation_policy; /* see freelist.c */ +extern uintnat caml_major_heap_increment; /* percent or words; see major_gc.c */ +extern uintnat caml_percent_free; /* see major_gc.c */ +extern uintnat caml_percent_max; /* see compact.c */ +extern uintnat caml_allocation_policy; /* see freelist.c */ #define Next(hp) ((hp) + Bhsize_hp (hp)) @@ -346,14 +346,6 @@ static uintnat norm_pmax (uintnat p) return p; } -static intnat norm_heapincr (uintnat i) -{ -#define Psv (Wsize_bsize (Page_size)) - i = ((i + Psv - 1) / Psv) * Psv; - if (i < Heap_chunk_min) i = Heap_chunk_min; - return i; -} - static intnat norm_minsize (intnat s) { if (s < Minor_heap_min) s = Minor_heap_min; @@ -386,11 +378,16 @@ CAMLprim value caml_gc_set(value v) caml_gc_message (0x20, "New max overhead: %d%%\n", caml_percent_max); } - newheapincr = Bsize_wsize (norm_heapincr (Long_val (Field (v, 1)))); + newheapincr = Long_val (Field (v, 1)); if (newheapincr != caml_major_heap_increment){ caml_major_heap_increment = newheapincr; - caml_gc_message (0x20, "New heap increment size: %luk bytes\n", - caml_major_heap_increment/1024); + if (newheapincr > 1000){ + caml_gc_message (0x20, "New heap increment size: %luk words\n", + caml_major_heap_increment/1024); + }else{ + caml_gc_message (0x20, "New heap increment size: %lu%%\n", + caml_major_heap_increment); + } } oldpolicy = caml_allocation_policy; caml_set_allocation_policy (Long_val (Field (v, 6))); @@ -475,17 +472,26 @@ CAMLprim value caml_gc_compaction(value v) return Val_unit; } +uintnat caml_normalize_heap_increment (uintnat i) +{ + if (i < Bsize_wsize (Heap_chunk_min)){ + i = Bsize_wsize (Heap_chunk_min); + } + return ((i + Page_size - 1) >> Page_log) << Page_log; +} + void caml_init_gc (uintnat minor_size, uintnat major_size, uintnat major_incr, uintnat percent_fr, uintnat percent_m) { - uintnat major_heap_size = Bsize_wsize (norm_heapincr (major_size)); + uintnat major_heap_size = + Bsize_wsize (caml_normalize_heap_increment (major_size)); if (caml_page_table_initialize(Bsize_wsize(minor_size) + major_heap_size)){ caml_fatal_error ("OCaml runtime error: cannot initialize page table\n"); } caml_set_minor_heap_size (Bsize_wsize (norm_minsize (minor_size))); - caml_major_heap_increment = Bsize_wsize (norm_heapincr (major_incr)); + caml_major_heap_increment = major_incr; caml_percent_free = norm_pfree (percent_fr); caml_percent_max = norm_pmax (percent_m); caml_init_major_heap (major_heap_size); @@ -495,8 +501,13 @@ void caml_init_gc (uintnat minor_size, uintnat major_size, major_heap_size / 1024); caml_gc_message (0x20, "Initial space overhead: %lu%%\n", caml_percent_free); caml_gc_message (0x20, "Initial max overhead: %lu%%\n", caml_percent_max); - caml_gc_message (0x20, "Initial heap increment: %luk bytes\n", - caml_major_heap_increment / 1024); + if (caml_major_heap_increment > 1000){ + caml_gc_message (0x20, "Initial heap increment: %luk words\n", + caml_major_heap_increment / 1024); + }else{ + caml_gc_message (0x20, "Initial heap increment: %lu%%\n", + caml_major_heap_increment); + } caml_gc_message (0x20, "Initial allocation policy: %d\n", caml_allocation_policy); } diff --git a/byterun/gc_ctrl.h b/byterun/gc_ctrl.h index 5f9d87354d..de6933e8ab 100644 --- a/byterun/gc_ctrl.h +++ b/byterun/gc_ctrl.h @@ -29,6 +29,8 @@ extern intnat caml_stat_compactions, caml_stat_heap_chunks; +uintnat caml_normalize_heap_increment (uintnat); + void caml_init_gc (uintnat, uintnat, uintnat, uintnat, uintnat); diff --git a/byterun/io.c b/byterun/io.c index 676cb5b2bf..c1566b72c9 100644 --- a/byterun/io.c +++ b/byterun/io.c @@ -22,6 +22,9 @@ #ifdef HAS_UNISTD #include <unistd.h> #endif +#ifdef __CYGWIN__ +#include </usr/include/io.h> +#endif #include "alloc.h" #include "custom.h" #include "fail.h" diff --git a/byterun/major_gc.c b/byterun/major_gc.c index 6adef1224f..68a2a4c23b 100644 --- a/byterun/major_gc.c +++ b/byterun/major_gc.c @@ -469,15 +469,23 @@ static asize_t clip_heap_chunk_size (asize_t request) return ((request + Page_size - 1) >> Page_log) << Page_log; } -/* Make sure the request is >= caml_major_heap_increment, then call - clip_heap_chunk_size, then make sure the result is >= request. +/* Compute the heap increment, make sure the request is at least that big, + then call clip_heap_chunk_size, then make sure the result is >= request. */ asize_t caml_round_heap_chunk_size (asize_t request) { asize_t result = request; + uintnat incr; - if (result < caml_major_heap_increment){ - result = caml_major_heap_increment; + /* Compute the heap increment as a byte size. */ + if (caml_major_heap_increment > 1000){ + incr = Bsize_wsize (caml_major_heap_increment); + }else{ + incr = caml_stat_heap_size / 100 * caml_major_heap_increment; + } + + if (result < incr){ + result = incr; } result = clip_heap_chunk_size (result); diff --git a/byterun/memory.c b/byterun/memory.c index 90f58b755e..ae1d440c76 100644 --- a/byterun/memory.c +++ b/byterun/memory.c @@ -581,6 +581,14 @@ CAMLexport void * caml_stat_alloc (asize_t sz) return result; } +CAMLexport char * caml_stat_alloc_string(value str) +{ + mlsize_t sz = caml_string_length(str) + 1; + char * p = caml_stat_alloc(sz); + memcpy(p, String_val(str), sz); + return p; +} + CAMLexport void caml_stat_free (void * blk) { free (blk); diff --git a/byterun/memory.h b/byterun/memory.h index 0761070177..d1c8f9917f 100644 --- a/byterun/memory.h +++ b/byterun/memory.h @@ -41,6 +41,7 @@ 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 char * caml_stat_alloc_string (value); 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. */ diff --git a/byterun/sys.c b/byterun/sys.c index 332887b138..8b2551a004 100644 --- a/byterun/sys.c +++ b/byterun/sys.c @@ -125,8 +125,7 @@ CAMLprim value caml_sys_open(value path, value vflags, value vperm) int fd, flags, perm; char * p; - p = caml_stat_alloc(caml_string_length(path) + 1); - strcpy(p, String_val(path)); + p = caml_stat_alloc_string(path); flags = caml_convert_flag_list(vflags, sys_open_flags); perm = Int_val(vperm); /* open on a named FIFO can block (PR#1533) */ @@ -145,46 +144,91 @@ CAMLprim value caml_sys_open(value path, value vflags, value vperm) CAMLprim value caml_sys_close(value fd) { + caml_enter_blocking_section(); close(Int_val(fd)); + caml_leave_blocking_section(); return Val_unit; } CAMLprim value caml_sys_file_exists(value name) { struct stat st; - return Val_bool(stat(String_val(name), &st) == 0); + char * p; + int ret; + + p = caml_stat_alloc_string(name); + caml_enter_blocking_section(); + ret = stat(p, &st); + caml_leave_blocking_section(); + caml_stat_free(p); + + return Val_bool(ret == 0); } CAMLprim value caml_sys_is_directory(value name) { + CAMLparam1(name); struct stat st; - if (stat(String_val(name), &st) == -1) caml_sys_error(name); + char * p; + int ret; + + p = caml_stat_alloc_string(name); + caml_enter_blocking_section(); + ret = stat(p, &st); + caml_leave_blocking_section(); + caml_stat_free(p); + + if (ret == -1) caml_sys_error(name); #ifdef S_ISDIR - return Val_bool(S_ISDIR(st.st_mode)); + CAMLreturn(Val_bool(S_ISDIR(st.st_mode))); #else - return Val_bool(st.st_mode & S_IFDIR); + CAMLreturn(Val_bool(st.st_mode & S_IFDIR)); #endif } CAMLprim value caml_sys_remove(value name) { + CAMLparam1(name); + char * p; int ret; - ret = unlink(String_val(name)); + p = caml_stat_alloc_string(name); + caml_enter_blocking_section(); + ret = unlink(p); + caml_leave_blocking_section(); + caml_stat_free(p); if (ret != 0) caml_sys_error(name); - return Val_unit; + CAMLreturn(Val_unit); } CAMLprim value caml_sys_rename(value oldname, value newname) { - if (rename(String_val(oldname), String_val(newname)) != 0) + char * p_old; + char * p_new; + int ret; + p_old = caml_stat_alloc_string(oldname); + p_new = caml_stat_alloc_string(newname); + caml_enter_blocking_section(); + ret = rename(p_old, p_new); + caml_leave_blocking_section(); + caml_stat_free(p_new); + caml_stat_free(p_old); + if (ret != 0) caml_sys_error(NO_ARG); return Val_unit; } CAMLprim value caml_sys_chdir(value dirname) { - if (chdir(String_val(dirname)) != 0) caml_sys_error(dirname); - return Val_unit; + CAMLparam1(dirname); + char * p; + int ret; + p = caml_stat_alloc_string(dirname); + caml_enter_blocking_section(); + ret = chdir(p); + caml_leave_blocking_section(); + caml_stat_free(p); + if (ret != 0) caml_sys_error(dirname); + CAMLreturn(Val_unit); } CAMLprim value caml_sys_getcwd(value unit) @@ -244,11 +288,8 @@ CAMLprim value caml_sys_system_command(value command) CAMLparam1 (command); int status, retcode; char *buf; - intnat len; - len = caml_string_length (command); - buf = caml_stat_alloc (len + 1); - memmove (buf, String_val (command), len + 1); + buf = caml_stat_alloc_string(command); caml_enter_blocking_section (); status = system(buf); caml_leave_blocking_section (); @@ -385,9 +426,16 @@ CAMLprim value caml_sys_read_directory(value path) CAMLparam1(path); CAMLlocal1(result); struct ext_table tbl; + char * p; + int ret; caml_ext_table_init(&tbl, 50); - if (caml_read_directory(String_val(path), &tbl) == -1){ + p = caml_stat_alloc_string(path); + caml_enter_blocking_section(); + ret = caml_read_directory(p, &tbl); + caml_leave_blocking_section(); + caml_stat_free(p); + if (ret == -1){ caml_ext_table_free(&tbl, 1); caml_sys_error(path); } diff --git a/config/.ignore b/config/.ignore index 24fdb45cad..259ce3f6e3 100644 --- a/config/.ignore +++ b/config/.ignore @@ -1,5 +1,3 @@ m.h s.h Makefile -config.sh -ocamlcomp diff --git a/config/Makefile.mingw b/config/Makefile.mingw index 78f5228c21..63030dd1fe 100644 --- a/config/Makefile.mingw +++ b/config/Makefile.mingw @@ -84,6 +84,8 @@ NATDYNLINK=true CMXS=cmxs RUNTIMED=noruntimed ASM_CFI_SUPPORTED=false +UNIXLIB=win32unix +GRAPHLIB=win32graph ########## Configuration for the bytecode compiler @@ -173,23 +175,3 @@ CYGPATH=cygpath -m DIFF=diff -q --strip-trailing-cr CANKILL=false SET_LD_PATH=PATH="$(PATH):$(LD_PATH)" - -THIS_MAKEFILE=$(filter %config/Makefile,$(MAKEFILE_LIST)) -ifeq ($(filter /%,$(THIS_MAKEFILE)),) -ROOTDIR:=$(abspath $(dir $(CURDIR)/$(THIS_MAKEFILE))/..) -else -ROOTDIR:=$(abspath $(dir $(THIS_MAKEFILE))/..) -endif -CAMLRUN:=$(ROOTDIR)/boot/ocamlrun$(EXE) -OCAMLRUN:=$(CAMLRUN) -ROOTDIR_COMPAT:=$(shell $(CYGPATH) $(ROOTDIR)) -CAMLC_BIN_BOOT = $(CAMLRUN) $(ROOTDIR_COMPAT)/boot/ocamlc -CAMLC_BIN_BYTE = $(CAMLRUN) $(ROOTDIR_COMPAT)/ocamlc -CAMLC_BIN_OPT = $(ROOTDIR_COMPAT)/ocamlc.opt -CAMLOPT_BIN_BYTE = $(CAMLRUN) $(ROOTDIR_COMPAT)/ocamlopt -CAMLOPT_BIN_OPT = $(ROOTDIR_COMPAT)/ocamlopt.opt - -CAMLC_BIN = @ . $(ROOTDIR)/config/ocamlcomp; PS4=""; set -x; $${CAMLC_BIN} -CAMLOPT_BIN = @ . $(ROOTDIR)/config/ocamlcomp; PS4=""; set -x; $${CAMLOPT_BIN} -CAMLC_BIN_CMD_TO_EVAL = . $(ROOTDIR)/config/ocamlcomp; echo $${CAMLC_BIN} -CAMLOPT_BIN_CMD_TO_EVAL = . $(ROOTDIR)/config/ocamlcomp; echo $${CAMLOPT_BIN} diff --git a/config/Makefile.mingw64 b/config/Makefile.mingw64 index 2c3ecfe506..44784b68ac 100644 --- a/config/Makefile.mingw64 +++ b/config/Makefile.mingw64 @@ -84,6 +84,8 @@ NATDYNLINK=true CMXS=cmxs RUNTIMED=noruntimed ASM_CFI_SUPPORTED=false +UNIXLIB=win32unix +GRAPHLIB=win32graph ########## Configuration for the bytecode compiler @@ -173,23 +175,3 @@ CYGPATH=cygpath -m DIFF=diff -q --strip-trailing-cr CANKILL=false SET_LD_PATH=PATH="$(PATH):$(LD_PATH)" - -THIS_MAKEFILE=$(filter %config/Makefile,$(MAKEFILE_LIST)) -ifeq ($(filter /%,$(THIS_MAKEFILE)),) -ROOTDIR:=$(abspath $(dir $(CURDIR)/$(THIS_MAKEFILE))/..) -else -ROOTDIR:=$(abspath $(dir $(THIS_MAKEFILE))/..) -endif -CAMLRUN:=$(ROOTDIR)/boot/ocamlrun$(EXE) -OCAMLRUN:=$(CAMLRUN) -ROOTDIR_COMPAT:=$(shell $(CYGPATH) $(ROOTDIR)) -CAMLC_BIN_BOOT = $(CAMLRUN) $(ROOTDIR_COMPAT)/boot/ocamlc -CAMLC_BIN_BYTE = $(CAMLRUN) $(ROOTDIR_COMPAT)/ocamlc -CAMLC_BIN_OPT = $(ROOTDIR_COMPAT)/ocamlc.opt -CAMLOPT_BIN_BYTE = $(CAMLRUN) $(ROOTDIR_COMPAT)/ocamlopt -CAMLOPT_BIN_OPT = $(ROOTDIR_COMPAT)/ocamlopt.opt - -CAMLC_BIN = @ . $(ROOTDIR)/config/ocamlcomp; PS4=""; set -x; $${CAMLC_BIN} -CAMLOPT_BIN = @ . $(ROOTDIR)/config/ocamlcomp; PS4=""; set -x; $${CAMLOPT_BIN} -CAMLC_BIN_CMD_TO_EVAL = . $(ROOTDIR)/config/ocamlcomp; echo $${CAMLC_BIN} -CAMLOPT_BIN_CMD_TO_EVAL = . $(ROOTDIR)/config/ocamlcomp; echo $${CAMLOPT_BIN} diff --git a/config/Makefile.msvc b/config/Makefile.msvc index f7124ec8cf..3ab6c6ebf4 100644 --- a/config/Makefile.msvc +++ b/config/Makefile.msvc @@ -75,6 +75,8 @@ CMXS=cmxs NATDYNLINK=true RUNTIMED=noruntimed ASM_CFI_SUPPORTED=false +UNIXLIB=win32unix +GRAPHLIB=win32graph ########## Configuration for the bytecode compiler @@ -176,23 +178,3 @@ CANKILL=false FIND=/usr/bin/find SORT=/usr/bin/sort SET_LD_PATH=PATH="$(PATH):$(LD_PATH)" - -THIS_MAKEFILE=$(filter %config/Makefile,$(MAKEFILE_LIST)) -ifeq ($(filter /%,$(THIS_MAKEFILE)),) -ROOTDIR:=$(abspath $(dir $(CURDIR)/$(THIS_MAKEFILE))/..) -else -ROOTDIR:=$(abspath $(dir $(THIS_MAKEFILE))/..) -endif -CAMLRUN:=$(ROOTDIR)/boot/ocamlrun$(EXE) -OCAMLRUN:=$(CAMLRUN) -ROOTDIR_COMPAT:=$(shell $(CYGPATH) $(ROOTDIR)) -CAMLC_BIN_BOOT = $(CAMLRUN) $(ROOTDIR_COMPAT)/boot/ocamlc -CAMLC_BIN_BYTE = $(CAMLRUN) $(ROOTDIR_COMPAT)/ocamlc -CAMLC_BIN_OPT = $(ROOTDIR_COMPAT)/ocamlc.opt -CAMLOPT_BIN_BYTE = $(CAMLRUN) $(ROOTDIR_COMPAT)/ocamlopt -CAMLOPT_BIN_OPT = $(ROOTDIR_COMPAT)/ocamlopt.opt - -CAMLC_BIN = @ . $(ROOTDIR)/config/ocamlcomp; PS4=""; set -x; $${CAMLC_BIN} -CAMLOPT_BIN = @ . $(ROOTDIR)/config/ocamlcomp; PS4=""; set -x; $${CAMLOPT_BIN} -CAMLC_BIN_CMD_TO_EVAL = . $(ROOTDIR)/config/ocamlcomp; echo $${CAMLC_BIN} -CAMLOPT_BIN_CMD_TO_EVAL = . $(ROOTDIR)/config/ocamlcomp; echo $${CAMLOPT_BIN} diff --git a/config/Makefile.msvc64 b/config/Makefile.msvc64 index e3617b5778..8437cf4bd0 100644 --- a/config/Makefile.msvc64 +++ b/config/Makefile.msvc64 @@ -74,6 +74,8 @@ CMXS=cmxs NATDYNLINK=true RUNTIMED=noruntimed ASM_CFI_SUPPORTED=false +UNIXLIB=win32unix +GRAPHLIB=win32graph ########## Configuration for the bytecode compiler @@ -180,23 +182,3 @@ CANKILL=false FIND=/usr/bin/find SORT=/usr/bin/sort SET_LD_PATH=PATH="$(PATH):$(LD_PATH)" - -THIS_MAKEFILE=$(filter %config/Makefile,$(MAKEFILE_LIST)) -ifeq ($(filter /%,$(THIS_MAKEFILE)),) -ROOTDIR:=$(abspath $(dir $(CURDIR)/$(THIS_MAKEFILE))/..) -else -ROOTDIR:=$(abspath $(dir $(THIS_MAKEFILE))/..) -endif -CAMLRUN:=$(ROOTDIR)/boot/ocamlrun$(EXE) -OCAMLRUN:=$(CAMLRUN) -ROOTDIR_COMPAT:=$(shell $(CYGPATH) $(ROOTDIR)) -CAMLC_BIN_BOOT = $(CAMLRUN) $(ROOTDIR_COMPAT)/boot/ocamlc -CAMLC_BIN_BYTE = $(CAMLRUN) $(ROOTDIR_COMPAT)/ocamlc -CAMLC_BIN_OPT = $(ROOTDIR_COMPAT)/ocamlc.opt -CAMLOPT_BIN_BYTE = $(CAMLRUN) $(ROOTDIR_COMPAT)/ocamlopt -CAMLOPT_BIN_OPT = $(ROOTDIR_COMPAT)/ocamlopt.opt - -CAMLC_BIN = @ . $(ROOTDIR)/config/ocamlcomp; PS4=""; set -x; $${CAMLC_BIN} -CAMLOPT_BIN = @ . $(ROOTDIR)/config/ocamlcomp; PS4=""; set -x; $${CAMLOPT_BIN} -CAMLC_BIN_CMD_TO_EVAL = . $(ROOTDIR)/config/ocamlcomp; echo $${CAMLC_BIN} -CAMLOPT_BIN_CMD_TO_EVAL = . $(ROOTDIR)/config/ocamlcomp; echo $${CAMLOPT_BIN} diff --git a/config/Makefile.switch-compiler b/config/Makefile.switch-compiler deleted file mode 100644 index b7cb2c7a70..0000000000 --- a/config/Makefile.switch-compiler +++ /dev/null @@ -1,22 +0,0 @@ -include Makefile - -enable disable: - @case "$@" in \ - "enable") C1="#"; C2=" ";; \ - "disable") C1=" "; C2="#";; \ - *) echo "Unknown action." 1>&2 ; exit 1;; \ - esac; \ - \ - if ! test -e "ocamlcomp"; then \ - echo ' CAMLC_BIN="$(CAMLC_BIN_BOOT)" # BOOT' >> "ocamlcomp"; \ - echo '# CAMLC_BIN="$(CAMLC_BIN_BYTE)" # BYTE' >> "ocamlcomp"; \ - echo '# CAMLC_BIN="$(CAMLC_BIN_OPT)" # OPT ' >> "ocamlcomp"; \ - echo ' CAMLOPT_BIN="no-opt-compiler-available" # NONE' >> "ocamlcomp"; \ - echo '# CAMLOPT_BIN="$(CAMLOPT_BIN_BYTE)" # BYTE' >> "ocamlcomp"; \ - echo '# CAMLOPT_BIN="$(CAMLOPT_BIN_OPT)" # OPT ' >> "ocamlcomp"; \ - fi; \ - \ - sed -e "/^$${C1} \($(COMPILER)_BIN\).*# $(VARIANT)/ s/$${C1}/$${C2}/" \ - "ocamlcomp" \ - > "ocamlcomp.tmp" ; \ - mv "ocamlcomp.tmp" "ocamlcomp" @@ -309,7 +309,7 @@ dllccompopts="" ostype="Unix" exe="" iflexdir="" -SO=".so" +SO="so" TOOLCHAIN="cc" case "$bytecc,$target" in @@ -381,6 +381,10 @@ case "$bytecc,$target" in mkexedebugflag="-link -g" fi fi + if test $with_sharedlibs = no; then + mkexe="$mkexe -Wl,--stack,16777216" + bytecclinkopts="-Wl,--stack,16777216" + fi exe=".exe" ostype="Cygwin";; *gcc*,*-*-mingw*) @@ -405,7 +409,7 @@ case "$bytecc,$target" in exe=".exe" ostype="Win32" TOOLCHAIN="mingw" - SO=".dll" + SO="dll" ;; *gcc*,x86_64-*-linux*) bytecccompopts="-fno-defer-pop $gcc_warnings" @@ -445,25 +449,26 @@ esac # "ocamlrun" executable must be available on the system. if test x"$target" != x"$host"; then if ! sh ./searchpath ocamlrun; then - err "Cross-compilation requires an ocaml runtime environment (the ocamlrun binary). Moreover, its version must be the same as the one you're trying to build (`cut -f1 -d+ < ../../VERSION`)." + 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 - # Make sure the version of the system ocaml and the version of these - # sources match. Don't compare "+devXX" on purpose as it would be too - # annoying during development and people using SVN are expected to know - # what they're doing and how to handle basic issues. - ocaml_system_version=`ocamlc -version | cut -f1 -d+` + 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 "The system OCaml toolchain is $ocaml_system_version but these sources are $ocaml_source_version.\nBuilding a cross-compiler requires versions to match." + 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" + CAMLRUN="ocamlrun" fi fi else - rootdir=`cd ../.. && pwd` - camlrun=$rootdir/boot/ocamlrun + CAMLRUN=`cd ../.. && pwd`/boot/ocamlrun fi +echo "CAMLRUN=$CAMLRUN" >> Makefile + # Check the sizes of data types # OCaml needs a 32 or 64bit architectue and a 32-bit integer type. @@ -857,6 +862,7 @@ case "$target" in x86_64-*-darwin*) arch=amd64; system=macosx;; x86_64-*-mingw*) arch=amd64; system=mingw;; aarch64-*-linux*) arch=arm64; system=linux;; + x86_64-*-cygwin*) arch=amd64; system=cygwin;; esac # Some platforms exist both in 32-bit and 64-bit variants, not distinguished @@ -1690,7 +1696,7 @@ echo "SO=$SO" >> Makefile echo "EXT_OBJ=.o" >> Makefile echo "EXT_ASM=.s" >> Makefile echo "EXT_LIB=.a" >> Makefile -echo "EXT_DLL=$SO" >> Makefile +echo "EXT_DLL=.$SO" >> Makefile echo "EXTRALIBS=" >> Makefile echo "CCOMPTYPE=cc" >> Makefile echo "TOOLCHAIN=$TOOLCHAIN" >> Makefile @@ -1712,29 +1718,11 @@ if [ "$ostype" = Cygwin ]; then echo "DIFF=diff -q --strip-trailing-cr" >>Makefile fi -cat >> Makefile << EOF -ROOTDIR=$rootdir -CAMLRUN=${camlrun}\$(EXE) -OCAMLRUN=\$(CAMLRUN) -CAMLC_BIN_BOOT = \$(CAMLRUN) \$(ROOTDIR)/boot/ocamlc -CAMLC_BIN_BYTE = \$(CAMLRUN) \$(ROOTDIR)/ocamlc -CAMLC_BIN_OPT = \$(ROOTDIR)/ocamlc.opt -CAMLOPT_BIN_BYTE = \$(CAMLRUN) \$(ROOTDIR)/ocamlopt -CAMLOPT_BIN_OPT = \$(ROOTDIR)/ocamlopt.opt - -CAMLC_BIN = @ . \$(ROOTDIR)/config/ocamlcomp; PS4=""; set -x; \$\${CAMLC_BIN} -CAMLOPT_BIN = @ . \$(ROOTDIR)/config/ocamlcomp; PS4=""; set -x; \$\${CAMLOPT_BIN} -CAMLC_BIN_CMD_TO_EVAL = . \$(ROOTDIR)/config/ocamlcomp; echo \$\${CAMLC_BIN} -CAMLOPT_BIN_CMD_TO_EVAL = . \$(ROOTDIR)/config/ocamlcomp; echo \$\${CAMLOPT_BIN} -EOF rm -f tst hasgot.c rm -f ../m.h ../s.h ../Makefile mv m.h s.h Makefile .. -rm -f ../ocamlcomp -cd .. && make -f Makefile.switch-compiler disable COMPILER="CAMLC" VARIANT="BYTE" - # Print a summary inf diff --git a/debugger/.depend b/debugger/.depend index 60b0baeff6..13de8ede13 100644 --- a/debugger/.depend +++ b/debugger/.depend @@ -172,11 +172,13 @@ program_management.cmx : unix_tools.cmx $(UNIXDIR)/unix.cmx \ question.cmo : primitives.cmi lexer.cmi input_handling.cmi question.cmi question.cmx : primitives.cmx lexer.cmx input_handling.cmx question.cmi show_information.cmo : symbols.cmi source.cmi show_source.cmi printval.cmi \ - ../utils/misc.cmi ../bytecomp/instruct.cmi frames.cmi events.cmi \ - debugcom.cmi checkpoints.cmi breakpoints.cmi show_information.cmi + parameters.cmi ../utils/misc.cmi ../bytecomp/instruct.cmi frames.cmi \ + events.cmi debugcom.cmi checkpoints.cmi breakpoints.cmi \ + show_information.cmi show_information.cmx : symbols.cmx source.cmx show_source.cmx printval.cmx \ - ../utils/misc.cmx ../bytecomp/instruct.cmx frames.cmx events.cmx \ - debugcom.cmx checkpoints.cmx breakpoints.cmx show_information.cmi + parameters.cmx ../utils/misc.cmx ../bytecomp/instruct.cmx frames.cmx \ + events.cmx debugcom.cmx checkpoints.cmx breakpoints.cmx \ + show_information.cmi show_source.cmo : source.cmi primitives.cmi parameters.cmi \ ../parsing/location.cmi ../bytecomp/instruct.cmi events.cmi \ debugger_config.cmi show_source.cmi diff --git a/debugger/Makefile.shared b/debugger/Makefile.shared index 815ab3258b..d85419eb0c 100644 --- a/debugger/Makefile.shared +++ b/debugger/Makefile.shared @@ -12,9 +12,9 @@ include ../config/Makefile -CAMLC=$(CAMLC_BIN) -nostdlib -I ../stdlib -COMPFLAGS=-g -warn-error A $(INCLUDES) -LINKFLAGS=-g -linkall -I $(UNIXDIR) +CAMLC=../ocamlcomp.sh +COMPFLAGS=-warn-error A $(INCLUDES) +LINKFLAGS=-linkall -I $(UNIXDIR) CAMLYACC=../boot/ocamlyacc YACCFLAGS= CAMLLEX=../boot/ocamlrun ../boot/ocamllex diff --git a/debugger/command_line.ml b/debugger/command_line.ml index d108621545..a4647110d6 100644 --- a/debugger/command_line.ml +++ b/debugger/command_line.ml @@ -234,16 +234,22 @@ let instr_env ppf lexbuf = let cmdarg = argument_list_eol argument lexbuf in let cmdarg = string_trim (String.concat " " cmdarg) in if cmdarg <> "" then - try - if (String.index cmdarg '=') > 0 then - Debugger_config.environment := cmdarg :: !Debugger_config.environment - else - eprintf "Environment variables should not have an empty name\n%!" - with Not_found -> - eprintf "Environment variables should have the \"name=value\" format\n%!" + if ask_kill_program () then begin + try + let eqpos = String.index cmdarg '=' in + if eqpos = 0 then raise Not_found; + let name = String.sub cmdarg 0 eqpos in + let value = + String.sub cmdarg (eqpos + 1) (String.length cmdarg - eqpos - 1) + in + Debugger_config.environment := + (name, value) :: List.remove_assoc name !Debugger_config.environment + with Not_found -> + eprintf "Environment variable must be in name=value format\n%!" + end else List.iter - (printf "%s\n%!") + (fun (vvar, vval) -> printf "%s=%s\n%!" vvar vval) (List.rev !Debugger_config.environment) let instr_pwd ppf lexbuf = diff --git a/debugger/debugger_config.mli b/debugger/debugger_config.mli index f725acecf8..ab935d9324 100644 --- a/debugger/debugger_config.mli +++ b/debugger/debugger_config.mli @@ -34,4 +34,4 @@ val make_checkpoints : bool ref (*** Environment variables for debugee. ***) -val environment : string list ref +val environment : (string * string) list ref diff --git a/debugger/main.ml b/debugger/main.ml index 85bc9afb6b..52c1ed9952 100644 --- a/debugger/main.ml +++ b/debugger/main.ml @@ -26,10 +26,7 @@ open Primitives let line_buffer = Lexing.from_function read_user_input -let rec loop ppf = - line_loop ppf line_buffer; - if !loaded && (not (yes_or_no "The program is running. Quit anyway")) then - loop ppf +let rec loop ppf = line_loop ppf line_buffer let current_duration = ref (-1L) @@ -170,10 +167,12 @@ let speclist = [ "<count> Set max number of checkpoints kept"; "-cd", Arg.String set_directory, "<dir> Change working directory"; - "-emacs", Arg.Set emacs, - "For running the debugger under emacs"; + "-emacs", Arg.Tuple [Arg.Set emacs; Arg.Set machine_readable], + "For running the debugger under emacs; implies -machine-readable"; "-I", Arg.String add_include, "<dir> Add <dir> to the list of include directories"; + "-machine-readable", Arg.Set machine_readable, + "Print information in a format more suitable for machines"; "-s", Arg.String set_socket, "<filename> Set the name of the communication socket"; "-version", Arg.Unit print_version, diff --git a/debugger/parameters.ml b/debugger/parameters.ml index 2e1d4a7530..d8c85efe00 100644 --- a/debugger/parameters.ml +++ b/debugger/parameters.ml @@ -35,3 +35,5 @@ let add_path_for mdl dir = (* Used by emacs ? *) let emacs = ref false + +let machine_readable = ref false diff --git a/debugger/parameters.mli b/debugger/parameters.mli index 244d24b35f..44c850d5c7 100644 --- a/debugger/parameters.mli +++ b/debugger/parameters.mli @@ -23,3 +23,5 @@ val add_path_for : string -> string -> unit (* Used by emacs ? *) val emacs : bool ref + +val machine_readable : bool ref diff --git a/debugger/printval.ml b/debugger/printval.ml index 0fa2eced2d..5170ef3b24 100644 --- a/debugger/printval.ml +++ b/debugger/printval.ml @@ -47,7 +47,7 @@ module EvalPath = struct type valu = Debugcom.Remote_value.t exception Error - let rec eval_path = function + let rec eval_path env = function Pident id -> begin try Debugcom.Remote_value.global (Symtable.get_global_position id) @@ -55,7 +55,7 @@ module EvalPath = raise Error end | Pdot(root, fieldname, pos) -> - let v = eval_path root in + let v = eval_path env root in if not (Debugcom.Remote_value.is_block v) then raise Error else Debugcom.Remote_value.field v pos diff --git a/debugger/program_loading.ml b/debugger/program_loading.ml index 99bfe6b478..b2d472a7dc 100644 --- a/debugger/program_loading.ml +++ b/debugger/program_loading.ml @@ -33,38 +33,19 @@ let load_program () = (*** Launching functions. ***) -(* Returns the environment to be passed to debugee *) -let get_environment () = - let env = Unix.environment () in - let have_same_name x y = - let split = Primitives.split_string '=' in - match split x, split y with - (hd1 :: _), (hd2 :: _) -> hd1 = hd2 - | _ -> false in - let have_name_in_config_env x = - List.exists - (have_same_name x) - !Debugger_config.environment in - let env = - Array.fold_right - (fun elem acc -> - if have_name_in_config_env elem then - acc - else - elem :: acc) - env - [] in - Array.of_list (env @ !Debugger_config.environment) - -(* Returns the environment to be passed to debugee *) +(* Returns a command line prefix to set environment for the debuggee *) +let get_unix_environment () = + let f (vname, vvalue) = + Printf.sprintf "%s=%s " vname (Filename.quote vvalue) + in + String.concat "" (List.map f !Debugger_config.environment) +;; + +(* Returns a command line prefix to set environment for the debuggee *) let get_win32_environment () = - let res = Buffer.create 256 in - let env = get_environment () in - let len = Array.length env in - for i = 0 to pred len do - Buffer.add_string res (Printf.sprintf "set %s && " env.(i)) - done; - Buffer.contents res + (* Note: no space before the & or Windows will add it to the value *) + let f (vname, vvalue) = Printf.sprintf "set %s=%s&" vname vvalue in + String.concat "" (List.map f !Debugger_config.environment) (* A generic function for launching the program *) let generic_exec_unix cmdline = function () -> @@ -83,7 +64,7 @@ let generic_exec_unix cmdline = function () -> 0 -> (* Try to detach the process from the controlling terminal, so that it does not receive SIGINT on ctrl-C. *) begin try ignore(setsid()) with Invalid_argument _ -> () end; - execve shell [| shell; "-c"; cmdline() |] (get_environment ()) + execv shell [| shell; "-c"; cmdline() |] | _ -> exit 0 with x -> Unix_tools.report_error x; @@ -113,18 +94,19 @@ let exec_with_runtime = (function () -> match Sys.os_type with "Win32" -> - (* This fould fail on a file name with spaces + (* This would fail on a file name with spaces but quoting is even worse because Unix.create_process thinks each command line parameter is a file. So no good solution so far *) - Printf.sprintf "%sset CAML_DEBUG_SOCKET=%s && %s %s %s" + Printf.sprintf "%sset CAML_DEBUG_SOCKET=%s& %s %s %s" (get_win32_environment ()) !socket_name runtime_program !program_name !arguments | _ -> - Printf.sprintf "CAML_DEBUG_SOCKET=%s %s %s %s" + Printf.sprintf "%sCAML_DEBUG_SOCKET=%s %s %s %s" + (get_unix_environment ()) !socket_name (Filename.quote runtime_program) (Filename.quote !program_name) @@ -137,13 +119,14 @@ let exec_direct = match Sys.os_type with "Win32" -> (* See the comment above *) - Printf.sprintf "%sset CAML_DEBUG_SOCKET=%s && %s %s" + Printf.sprintf "%sset CAML_DEBUG_SOCKET=%s& %s %s" (get_win32_environment ()) !socket_name !program_name !arguments | _ -> - Printf.sprintf "CAML_DEBUG_SOCKET=%s %s %s" + Printf.sprintf "%sCAML_DEBUG_SOCKET=%s %s %s" + (get_unix_environment ()) !socket_name (Filename.quote !program_name) !arguments) diff --git a/debugger/show_information.ml b/debugger/show_information.ml index 89111d3cc9..690645dfe2 100644 --- a/debugger/show_information.ml +++ b/debugger/show_information.ml @@ -21,6 +21,7 @@ open Frames open Source open Show_source open Breakpoints +open Parameters (* Display information about the current event. *) let show_current_event ppf = @@ -73,9 +74,15 @@ let show_one_frame framenum ppf event = let buffer = get_buffer pos event.ev_module in snd (start_and_cnum buffer pos) with _ -> pos.Lexing.pos_cnum in - fprintf ppf "#%i Pc: %i %s char %i@." - framenum event.ev_pos event.ev_module - cnum + if !machine_readable then + fprintf ppf "#%i Pc: %i %s char %i@." + framenum event.ev_pos event.ev_module + cnum + else + fprintf ppf "#%i %s %s:%i:%i@." + framenum event.ev_module + pos.Lexing.pos_fname pos.Lexing.pos_lnum + (pos.Lexing.pos_cnum - pos.Lexing.pos_bol + 1) (* Display information about the current frame. *) (* --- `select frame' must have succeded before calling this function. *) diff --git a/driver/compenv.ml b/driver/compenv.ml index 5990a65647..6196707643 100644 --- a/driver/compenv.ml +++ b/driver/compenv.ml @@ -167,6 +167,7 @@ let read_OCAMLPARAM ppf position = | "no-app-funct" -> clear "no-app-funct" [ applicative_functors ] v | "nodynlink" -> clear "nodynlink" [ dlcode ] v | "short-paths" -> clear "short-paths" [ real_paths ] v + | "trans-mod" -> set "trans-mod" [ transparent_modules ] v | "pp" -> preprocessor := Some v | "runtime-variant" -> runtime_variant := v diff --git a/driver/main.ml b/driver/main.ml index 2d5bb394fd..cbb6459993 100644 --- a/driver/main.ml +++ b/driver/main.ml @@ -112,6 +112,7 @@ module Options = Main_args.Make_bytecomp_options (struct let _short_paths = unset real_paths let _strict_sequence = set strict_sequence let _thread = set use_threads + let _trans_mod = set transparent_modules let _vmthread = set use_vmthreads let _unsafe = set fast let _use_prims s = use_prims := s diff --git a/driver/main_args.ml b/driver/main_args.ml index d21ec66521..aba306b54a 100644 --- a/driver/main_args.ml +++ b/driver/main_args.ml @@ -265,6 +265,10 @@ let mk_thread f = " Generate code that supports the system threads library" ;; +let mk_trans_mod f = + "-trans-mod", Arg.Unit f, + " Make typing and linking only depend on normalized paths" + let mk_unsafe f = "-unsafe", Arg.Unit f, " Do not compile bounds checking on array and string access" @@ -465,6 +469,7 @@ module type Bytecomp_options = sig val _runtime_variant : string -> unit val _short_paths : unit -> unit val _strict_sequence : unit -> unit + val _trans_mod : unit -> unit val _thread : unit -> unit val _vmthread : unit -> unit val _unsafe : unit -> unit @@ -508,6 +513,7 @@ module type Bytetop_options = sig val _short_paths : unit -> unit val _stdin: unit -> unit val _strict_sequence : unit -> unit + val _trans_mod : unit -> unit val _unsafe : unit -> unit val _version : unit -> unit val _vnum : unit -> unit @@ -566,6 +572,7 @@ module type Optcomp_options = sig val _shared : unit -> unit val _short_paths : unit -> unit val _strict_sequence : unit -> unit + val _trans_mod : unit -> unit val _thread : unit -> unit val _unsafe : unit -> unit val _v : unit -> unit @@ -622,6 +629,7 @@ module type Opttop_options = sig val _short_paths : unit -> unit val _stdin : unit -> unit val _strict_sequence : unit -> unit + val _trans_mod : unit -> unit val _unsafe : unit -> unit val _version : unit -> unit val _vnum : unit -> unit @@ -702,6 +710,7 @@ struct mk_runtime_variant F._runtime_variant; mk_short_paths F._short_paths; mk_strict_sequence F._strict_sequence; + mk_trans_mod F._trans_mod; mk_thread F._thread; mk_unsafe F._unsafe; mk_use_runtime F._use_runtime; @@ -749,6 +758,7 @@ struct mk_short_paths F._short_paths; mk_stdin F._stdin; mk_strict_sequence F._strict_sequence; + mk_trans_mod F._trans_mod; mk_unsafe F._unsafe; mk_version F._version; mk_vnum F._vnum; @@ -811,6 +821,7 @@ struct mk_shared F._shared; mk_short_paths F._short_paths; mk_strict_sequence F._strict_sequence; + mk_trans_mod F._trans_mod; mk_thread F._thread; mk_unsafe F._unsafe; mk_v F._v; @@ -869,6 +880,7 @@ module Make_opttop_options (F : Opttop_options) = struct mk_short_paths F._short_paths; mk_stdin F._stdin; mk_strict_sequence F._strict_sequence; + mk_trans_mod F._trans_mod; mk_unsafe F._unsafe; mk_version F._version; mk_vnum F._vnum; diff --git a/driver/main_args.mli b/driver/main_args.mli index 9372d85dea..67a6c681d2 100644 --- a/driver/main_args.mli +++ b/driver/main_args.mli @@ -50,6 +50,7 @@ module type Bytecomp_options = val _runtime_variant : string -> unit val _short_paths : unit -> unit val _strict_sequence : unit -> unit + val _trans_mod : unit -> unit val _thread : unit -> unit val _vmthread : unit -> unit val _unsafe : unit -> unit @@ -94,6 +95,7 @@ module type Bytetop_options = sig val _short_paths : unit -> unit val _stdin : unit -> unit val _strict_sequence : unit -> unit + val _trans_mod : unit -> unit val _unsafe : unit -> unit val _version : unit -> unit val _vnum : unit -> unit @@ -152,6 +154,7 @@ module type Optcomp_options = sig val _shared : unit -> unit val _short_paths : unit -> unit val _strict_sequence : unit -> unit + val _trans_mod : unit -> unit val _thread : unit -> unit val _unsafe : unit -> unit val _v : unit -> unit @@ -208,6 +211,7 @@ module type Opttop_options = sig val _short_paths : unit -> unit val _stdin : unit -> unit val _strict_sequence : unit -> unit + val _trans_mod : unit -> unit val _unsafe : unit -> unit val _version : unit -> unit val _vnum : unit -> unit diff --git a/build/ocamlbuild-byte-only.sh b/driver/ocamlcomp.sh.in index aeb5bcba9e..fc0a8e113f 100755..100644 --- a/build/ocamlbuild-byte-only.sh +++ b/driver/ocamlcomp.sh.in @@ -4,16 +4,14 @@ # # # OCaml # # # -# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # +# Jacques Garrigue, Kyoto University RIMS # # # -# Copyright 2008 Institut National de Recherche en Informatique et # +# Copyright 2002 Institut National de Recherche en Informatique et # # en Automatique. All rights reserved. This file is distributed # # under the terms of the Q Public License version 1.0. # # # ######################################################################### -set -e -cd `dirname $0`/.. -. build/targets.sh -set -x -$OCAMLBUILD $@ byte_stdlib_mixed_mode $OCAMLC_BYTE $OCAMLLEX_BYTE $OCAMLBUILD_BYTE +topdir=`dirname $0` + +exec @compiler@ -nostdlib -I $topdir/stdlib "$@" diff --git a/driver/optmain.ml b/driver/optmain.ml index 84e07183bb..d04ad76b19 100644 --- a/driver/optmain.ml +++ b/driver/optmain.ml @@ -110,6 +110,7 @@ module Options = Main_args.Make_optcomp_options (struct let _runtime_variant s = runtime_variant := s let _short_paths = clear real_paths let _strict_sequence = set strict_sequence + let _trans_mod = set transparent_modules let _shared () = shared := true; dlcode := true let _S = set keep_asm_file let _thread = set use_threads diff --git a/experimental/frisch/unused_exported_values.ml b/experimental/frisch/unused_exported_values.ml index 0174d7f11f..7b2d2f90ed 100644 --- a/experimental/frisch/unused_exported_values.ml +++ b/experimental/frisch/unused_exported_values.ml @@ -24,7 +24,7 @@ let rec collect_export fn = function *) if unit fn = unit val_loc.Location.loc_start.Lexing.pos_fname then vds := val_loc :: !vds - | Sig_module (_, Mty_signature sg, _) -> List.iter (collect_export fn) sg + | Sig_module (_, {Types.md_type=Mty_signature sg; _}, _) -> List.iter (collect_export fn) sg | _ -> () let collect_references = object diff --git a/lex/Makefile b/lex/Makefile index 6da5f0c576..f54de0020b 100644 --- a/lex/Makefile +++ b/lex/Makefile @@ -11,12 +11,9 @@ ######################################################################### # The lexer generator - -include ../config/Makefile - CAMLC=../boot/ocamlrun ../boot/ocamlc -strict-sequence -nostdlib -I ../boot CAMLOPT=../boot/ocamlrun ../ocamlopt -nostdlib -I ../stdlib -COMPFLAGS=-w +33..39 -warn-error A +COMPFLAGS=-w +33..39 -warn-error A -bin-annot CAMLYACC=../boot/ocamlyacc YACCFLAGS=-v CAMLLEX=../boot/ocamlrun ../boot/ocamllex diff --git a/lex/common.ml b/lex/common.ml index 36f8225e31..13b48fac6d 100644 --- a/lex/common.ml +++ b/lex/common.ml @@ -159,5 +159,13 @@ let output_env ic oc tr env = let output_args oc args = List.iter (fun x -> (output_string oc x; output_char oc ' ')) args +let output_refill_handler ic oc oci = function + | None -> false + | Some location -> + output_string oc "let __ocaml_lex_refill : \ + (Lexing.lexbuf -> 'a) -> (Lexing.lexbuf -> 'a) =\n"; + copy_chunk ic oc oci location true; + true + (* quiet flag *) let quiet_mode = ref false;; diff --git a/lex/common.mli b/lex/common.mli index c71febe8c6..de23959cae 100644 --- a/lex/common.mli +++ b/lex/common.mli @@ -22,5 +22,7 @@ val output_env : in_channel -> out_channel -> line_tracker -> (Lexgen.ident * Lexgen.ident_info) list -> unit val output_args : out_channel -> string list -> unit +val output_refill_handler : + in_channel -> out_channel -> line_tracker -> Syntax.location option -> bool val quiet_mode : bool ref;; diff --git a/lex/lexer.mll b/lex/lexer.mll index 8fc472e684..eebd7115ea 100644 --- a/lex/lexer.mll +++ b/lex/lexer.mll @@ -30,6 +30,7 @@ let string_buff = Buffer.create 256 let reset_string_buffer () = Buffer.clear string_buff let store_string_char c = Buffer.add_char string_buff c +let store_string_chars s = Buffer.add_string string_buff s let get_stored_string () = Buffer.contents string_buff @@ -140,6 +141,7 @@ rule main = parse | "eof" -> Teof | "let" -> Tlet | "as" -> Tas + | "refill" -> Trefill | s -> Tident s } | '"' { reset_string_buffer(); @@ -197,7 +199,7 @@ rule main = parse and string = parse '"' { () } - | '\\' ("\010" | "\013" | "\013\010") ([' ' '\009'] * as spaces) + | '\\' ('\013'* '\010') ([' ' '\009'] * as spaces) { incr_loc lexbuf (String.length spaces); string lexbuf } | '\\' (backslash_escapes as c) @@ -208,7 +210,7 @@ and string = parse if in_pattern () && v > 255 then warning lexbuf (Printf.sprintf - "illegal backslash escape in string: `\\%c%c%c'" c d u) ; + "illegal backslash escape in string: '\\%c%c%c'" c d u) ; store_string_char (Char.chr v); string lexbuf } | '\\' 'x' (['0'-'9' 'a'-'f' 'A'-'F'] as d) (['0'-'9' 'a'-'f' 'A'-'F'] as u) @@ -217,14 +219,15 @@ and string = parse | '\\' (_ as c) {if in_pattern () then warning lexbuf - (Printf.sprintf "illegal backslash escape in string: `\\%c'" c) ; + (Printf.sprintf "illegal backslash escape in string: '\\%c'" c) ; store_string_char '\\' ; store_string_char c ; string lexbuf } | eof { raise(Lexical_error("unterminated string", "", 0, 0)) } - | '\010' - { store_string_char '\010'; + | '\013'* '\010' as s + { warning lexbuf (Printf.sprintf "unescaped newline in string") ; + store_string_chars s; incr_loc lexbuf 0; string lexbuf } | _ as c diff --git a/lex/main.ml b/lex/main.ml index 521632b2ff..076873f103 100644 --- a/lex/main.ml +++ b/lex/main.ml @@ -75,11 +75,11 @@ let main () = if !ml_automata then begin Outputbis.output_lexdef source_name ic oc tr - def.header entries transitions def.trailer + def.header def.refill_handler entries transitions def.trailer end else begin let tables = Compact.compact_tables transitions in Output.output_lexdef source_name ic oc tr - def.header tables entries def.trailer + def.header def.refill_handler tables entries def.trailer end; close_in ic; close_out oc; diff --git a/lex/output.ml b/lex/output.ml index d99f2f9010..2e7700257c 100644 --- a/lex/output.ml +++ b/lex/output.ml @@ -69,7 +69,7 @@ let output_tables oc tbl = (* Output the entries *) -let output_entry sourcefile ic oc oci e = +let output_entry sourcefile ic oc has_refill oci e = let init_num, init_moves = e.auto_initial_state in fprintf oc "%s %alexbuf =\ \n %a%a __ocaml_lex_%s_rec %alexbuf %d\n" @@ -96,15 +96,23 @@ let output_entry sourcefile ic oc oci e = copy_chunk ic oc oci loc true; fprintf oc "\n") e.auto_actions; - fprintf oc " | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; \ - __ocaml_lex_%s_rec %alexbuf __ocaml_lex_state\n\n" - e.auto_name output_args e.auto_args + if has_refill then + fprintf oc + " | __ocaml_lex_state -> __ocaml_lex_refill \ + \n (fun lexbuf -> lexbuf.Lexing.refill_buff lexbuf; \ + \n __ocaml_lex_%s_rec %alexbuf __ocaml_lex_state) lexbuf\n\n" + e.auto_name output_args e.auto_args + else + fprintf oc + " | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; \ + \n __ocaml_lex_%s_rec %alexbuf __ocaml_lex_state\n\n" + e.auto_name output_args e.auto_args (* Main output function *) exception Table_overflow -let output_lexdef sourcefile ic oc oci header tables entry_points trailer = +let output_lexdef sourcefile ic oc oci header rh tables entry_points trailer = if not !Common.quiet_mode then Printf.printf "%d states, %d transitions, table size %d bytes\n" (Array.length tables.tbl_base) @@ -124,13 +132,17 @@ let output_lexdef sourcefile ic oc oci header tables entry_points trailer = flush stdout; if Array.length tables.tbl_trans > 0x8000 then raise Table_overflow; copy_chunk ic oc oci header false; + let has_refill = output_refill_handler ic oc oci rh in output_tables oc tables; begin match entry_points with [] -> () | entry1 :: entries -> - output_string oc "let rec "; output_entry sourcefile ic oc oci entry1; + output_string oc "let rec "; + output_entry sourcefile ic oc has_refill oci entry1; List.iter - (fun e -> output_string oc "and "; output_entry sourcefile ic oc oci e) + (fun e -> + output_string oc "and "; + output_entry sourcefile ic oc has_refill oci e) entries; output_string oc ";;\n\n"; end; diff --git a/lex/output.mli b/lex/output.mli index 96d8a4d6cb..9d0bd9fc80 100644 --- a/lex/output.mli +++ b/lex/output.mli @@ -15,6 +15,7 @@ val output_lexdef: string -> in_channel -> out_channel -> Common.line_tracker -> Syntax.location -> + Syntax.location option -> Compact.lex_tables -> (string list, Syntax.location) Lexgen.automata_entry list -> Syntax.location -> diff --git a/lex/outputbis.ml b/lex/outputbis.ml index 7e8cba6e17..333cbc2a22 100644 --- a/lex/outputbis.ml +++ b/lex/outputbis.ml @@ -16,8 +16,9 @@ open Printf open Lexgen open Common -let output_auto_defs oc = - fprintf oc "let __ocaml_lex_init_lexbuf lexbuf mem_size =\ +let output_auto_defs oc has_refill = + output_string oc + "let __ocaml_lex_init_lexbuf lexbuf mem_size =\ \n let pos = lexbuf.Lexing.lex_curr_pos in\ \n lexbuf.Lexing.lex_mem <- Array.create mem_size (-1) ;\ \n lexbuf.Lexing.lex_start_pos <- pos ;\ @@ -26,8 +27,28 @@ let output_auto_defs oc = \n\n\ " ; - output_string oc - "let rec __ocaml_lex_next_char lexbuf =\ + if has_refill then + output_string oc + "let rec __ocaml_lex_next_char lexbuf state k =\ +\n if lexbuf.Lexing.lex_curr_pos >= lexbuf.Lexing.lex_buffer_len then begin\ +\n if lexbuf.Lexing.lex_eof_reached then\ +\n state lexbuf k 256\ +\n else begin\ +\n __ocaml_lex_refill (fun lexbuf -> +\n lexbuf.Lexing.refill_buff lexbuf ;\ +\n __ocaml_lex_next_char lexbuf state k)\ +\n lexbuf\ +\n end\ +\n end else begin\ +\n let i = lexbuf.Lexing.lex_curr_pos in\ +\n let c = lexbuf.Lexing.lex_buffer.[i] in\ +\n lexbuf.Lexing.lex_curr_pos <- i+1 ;\ +\n state lexbuf k (Char.code c)\ +\n end\ +\n\n" + else + output_string oc + "let rec __ocaml_lex_next_char lexbuf =\ \n if lexbuf.Lexing.lex_curr_pos >= lexbuf.Lexing.lex_buffer_len then begin\ \n if lexbuf.Lexing.lex_eof_reached then\ \n 256\ @@ -41,21 +62,24 @@ let output_auto_defs oc = \n lexbuf.Lexing.lex_curr_pos <- i+1 ;\ \n Char.code c\ \n end\ -\n\n\ -" +\n\n" let output_pats oc pats = List.iter (fun p -> fprintf oc "|%d" p) pats -let output_action oc mems r = +let output_action oc has_refill mems r = output_memory_actions " " oc mems ; match r with | Backtrack -> fprintf oc " lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_last_pos ;\n" ; - fprintf oc " lexbuf.Lexing.lex_last_action\n" + if has_refill then + fprintf oc " k lexbuf lexbuf.Lexing.lex_last_action\n" + else + fprintf oc " lexbuf.Lexing.lex_last_action\n" | Goto n -> - fprintf oc " __ocaml_lex_state%d lexbuf\n" n + fprintf oc " __ocaml_lex_state%d lexbuf%s\n" n + (if has_refill then " k" else "") let output_pat oc i = if i >= 256 then @@ -63,17 +87,18 @@ let output_pat oc i = else fprintf oc "|'%s'" (Char.escaped (Char.chr i)) -let output_clause oc pats mems r = +let output_clause oc has_refill pats mems r = fprintf oc "(* " ; List.iter (output_pat oc) pats ; fprintf oc " *)\n" ; - fprintf oc " %a ->\n" output_pats pats ; output_action oc mems r + fprintf oc " %a ->\n" output_pats pats ; + output_action oc has_refill mems r -let output_default_clause oc mems r = - fprintf oc " | _ ->\n" ; output_action oc mems r +let output_default_clause oc has_refill mems r = + fprintf oc " | _ ->\n" ; output_action oc has_refill mems r -let output_moves oc moves = +let output_moves oc has_refill moves = let t = Hashtbl.create 17 in let add_move i (m,mems) = let mems,r = try Hashtbl.find t m with Not_found -> mems,[] in @@ -97,9 +122,10 @@ let output_moves oc moves = t ; Hashtbl.iter (fun m (mems,pats) -> - if m <> !most_frequent then output_clause oc (List.rev pats) mems m) + if m <> !most_frequent then + output_clause oc has_refill (List.rev pats) mems m) t ; - output_default_clause oc !most_mems !most_frequent + output_default_clause oc has_refill !most_mems !most_frequent let output_tag_actions pref oc mvs = @@ -120,47 +146,61 @@ let output_tag_actions pref oc mvs = pref output_mem_access t) mvs -let output_trans pref oc i trans = - fprintf oc "%s __ocaml_lex_state%d lexbuf = " pref i ; +let output_trans pref oc has_refill i trans = + let entry = sprintf "__ocaml_lex_state%d" i in + fprintf oc "%s %s lexbuf %s= " pref entry + (if has_refill then "k " else ""); match trans with | Perform (n,mvs) -> output_tag_actions " " oc mvs ; - fprintf oc " %d\n" n + fprintf oc " %s%d\n" + (if has_refill then "k lexbuf " else "") + n | Shift (trans, move) -> - begin match trans with + begin match trans with | Remember (n,mvs) -> - output_tag_actions " " oc mvs ; - fprintf oc - " lexbuf.Lexing.lex_last_pos <- lexbuf.Lexing.lex_curr_pos ;\n" ; - fprintf oc " lexbuf.Lexing.lex_last_action <- %d ;\n" n + output_tag_actions " " oc mvs ; + fprintf oc + " lexbuf.Lexing.lex_last_pos <- lexbuf.Lexing.lex_curr_pos ;\n" ; + fprintf oc " lexbuf.Lexing.lex_last_action <- %d ;\n" n; | No_remember -> () - end ; - fprintf oc " match __ocaml_lex_next_char lexbuf with\n" ; - output_moves oc move - -let output_automata oc auto = - output_auto_defs oc ; + end; + if has_refill then + let next = entry ^ "_next" in + fprintf oc " __ocaml_lex_next_char lexbuf %s k\n" next; + fprintf oc "and %s lexbuf k = function " next + else + output_string oc "match __ocaml_lex_next_char lexbuf with\n"; + output_moves oc has_refill move + +let output_automata oc has_refill auto = + output_auto_defs oc has_refill; let n = Array.length auto in - output_trans "let rec" oc 0 auto.(0) ; + output_trans "let rec" oc has_refill 0 auto.(0) ; for i = 1 to n-1 do - output_trans "\nand" oc i auto.(i) + output_trans "\nand" oc has_refill i auto.(i) done ; output_char oc '\n' (* Output the entries *) -let output_entry sourcefile ic oc tr e = +let output_entry sourcefile ic oc has_refill tr e = let init_num, init_moves = e.auto_initial_state in - fprintf oc "%s %alexbuf =\ -\n __ocaml_lex_init_lexbuf lexbuf %d; %a\ -\n let __ocaml_lex_result = __ocaml_lex_state%d lexbuf in\ + fprintf oc "%s %alexbuf =\n __ocaml_lex_init_lexbuf lexbuf %d; %a" + e.auto_name output_args e.auto_args + e.auto_mem_size + (output_memory_actions " ") init_moves; + fprintf oc + (if has_refill + then "\n __ocaml_lex_state%d lexbuf (fun lexbuf __ocaml_lex_result ->" + else "\n let __ocaml_lex_result = __ocaml_lex_state%d lexbuf in") + init_num; + output_string oc "\ \n lexbuf.Lexing.lex_start_p <- lexbuf.Lexing.lex_curr_p;\ \n lexbuf.Lexing.lex_curr_p <- {lexbuf.Lexing.lex_curr_p with\ \n Lexing.pos_cnum = lexbuf.Lexing.lex_abs_pos+lexbuf.Lexing.lex_curr_pos};\ -\n match __ocaml_lex_result with\n" - e.auto_name output_args e.auto_args - e.auto_mem_size (output_memory_actions " ") init_moves init_num ; +\n match __ocaml_lex_result with\n"; List.iter (fun (num, env, loc) -> fprintf oc " | "; @@ -169,21 +209,29 @@ let output_entry sourcefile ic oc tr e = copy_chunk ic oc tr loc true; fprintf oc "\n") e.auto_actions; - fprintf oc " | _ -> raise (Failure \"lexing: empty token\")\n\n\n" + fprintf oc " | _ -> raise (Failure \"lexing: empty token\")\n"; + if has_refill then + output_string oc " )\n\n" + else + output_string oc "\n\n" (* Main output function *) -let output_lexdef sourcefile ic oc tr header entry_points transitions trailer = +let output_lexdef sourcefile ic oc tr header rh + entry_points transitions trailer = copy_chunk ic oc tr header false; - output_automata oc transitions ; + let has_refill = output_refill_handler ic oc tr rh in + output_automata oc has_refill transitions; begin match entry_points with [] -> () | entry1 :: entries -> - output_string oc "let rec "; output_entry sourcefile ic oc tr entry1; + output_string oc "let rec "; + output_entry sourcefile ic oc has_refill tr entry1; List.iter - (fun e -> output_string oc "and "; output_entry sourcefile ic oc tr e) + (fun e -> output_string oc "and "; + output_entry sourcefile ic oc has_refill tr e) entries; output_string oc ";;\n\n"; end; diff --git a/lex/outputbis.mli b/lex/outputbis.mli index 6c04512254..fb51cdec7c 100644 --- a/lex/outputbis.mli +++ b/lex/outputbis.mli @@ -16,5 +16,6 @@ val output_lexdef : out_channel -> Common.line_tracker -> Syntax.location -> + Syntax.location option -> (string list, Syntax.location) Lexgen.automata_entry list -> Lexgen.automata array -> Syntax.location -> unit diff --git a/lex/parser.mly b/lex/parser.mly index b42cced949..f0742e38e4 100644 --- a/lex/parser.mly +++ b/lex/parser.mly @@ -49,7 +49,7 @@ let as_cset = function %token <string> Tstring %token <Syntax.location> Taction %token Trule Tparse Tparse_shortest Tand Tequal Tend Tor Tunderscore Teof - Tlbracket Trbracket + Tlbracket Trbracket Trefill %token Tstar Tmaybe Tplus Tlparen Trparen Tcaret Tdash Tlet Tas Tsharp %right Tas @@ -65,10 +65,11 @@ let as_cset = function %% lexer_definition: - header named_regexps Trule definition other_definitions header Tend + header named_regexps refill_handler Trule definition other_definitions header Tend { {header = $1; - entrypoints = $4 :: List.rev $5; - trailer = $6} } + refill_handler = $3; + entrypoints = $5 :: List.rev $6; + trailer = $7} } ; header: Taction @@ -89,6 +90,10 @@ other_definitions: | /*epsilon*/ { [] } ; +refill_handler: + | Trefill Taction { Some $2 } + | /*empty*/ { None } +; definition: Tident arguments Tequal Tparse entry { {name=$1 ; shortest=false ; args=$2 ; clauses=$5} } diff --git a/lex/syntax.ml b/lex/syntax.ml index 72f101e253..b2993eaa02 100644 --- a/lex/syntax.ml +++ b/lex/syntax.ml @@ -38,7 +38,9 @@ type ('arg,'action) entry = args : 'arg ; clauses : (regular_expression * 'action) list} -type lexer_definition = - { header: location; - entrypoints: ((string list, location) entry) list; - trailer: location } +type lexer_definition = { + header: location; + entrypoints: ((string list, location) entry) list; + trailer: location; + refill_handler : location option; +} diff --git a/lex/syntax.mli b/lex/syntax.mli index 55c3c117a1..6871dd118d 100644 --- a/lex/syntax.mli +++ b/lex/syntax.mli @@ -35,7 +35,9 @@ type ('arg,'action) entry = args : 'arg ; clauses : (regular_expression * 'action) list} -type lexer_definition = - { header: location; - entrypoints: ((string list, location) entry) list; - trailer: location } +type lexer_definition = { + header: location; + entrypoints: ((string list, location) entry) list; + trailer: location; + refill_handler : location option; +} diff --git a/man/ocamlc.m b/man/ocamlc.m index 38542b502d..1d3c56faa0 100644 --- a/man/ocamlc.m +++ b/man/ocamlc.m @@ -335,14 +335,16 @@ that file to remove all declarations of unexported names. Add the given directory to the list of directories searched for compiled interface files (.cmi), compiled object code files (.cmo), libraries (.cma), and C libraries specified with -.B \-cclib\ \-l -.IR xxx . +.BI \-cclib\ \-l xxx +.RB . By default, the current directory is searched first, then the standard library directory. Directories added with -.B -I +.B \-I are searched after the current directory, in the order in which they were given on -the command line, but before the standard library directory. +the command line, but before the standard library directory. See also +option +.BR \-nostdlib . If the given directory starts with .BR + , @@ -421,10 +423,14 @@ Ignore non-optional labels in types. Labels cannot be used in applications, and parameter order becomes strict. .TP .B \-nostdlib -Do not include the standard library directory in the list of -directories searched for compiled interfaces (see option -.B \-I -). +Do not automatically add the standard library directory to the list of +directories searched for compiled interface files (.cmi), compiled +object code files (.cmo), libraries (.cma), and C libraries specified +with +.BI \-cclib\ \-l xxx +.RB . +See also option +.BR \-I . .TP .BI \-o \ exec\-file Specify the name of the output file produced by the linker. The diff --git a/man/ocamldebug.m b/man/ocamldebug.m index a470150a6f..50354d93c5 100644 --- a/man/ocamldebug.m +++ b/man/ocamldebug.m @@ -58,6 +58,8 @@ command.) Tell the debugger it is executed under Emacs. (See .I "The OCaml user's manual" for information on how to run the debugger under Emacs.) +Implies +.BR \-machine-readable . .TP .BI \-I \ directory Add @@ -67,6 +69,13 @@ compiled files. (See also the .B directory command.) .TP +.BI -machine-readable +Print information in a format more suitable for machines instead of human +operators where applicable. For example, when describing a location in a +program, such as when printing a backtrace, print the program counter and +character offset in a file instead of the filename, line number, and character +offset in that line. +.TP .BI \-s \ socket Use .I socket diff --git a/man/ocamlopt.m b/man/ocamlopt.m index 6efb909aea..d00cbf99d2 100644 --- a/man/ocamlopt.m +++ b/man/ocamlopt.m @@ -248,11 +248,13 @@ and edit that file to remove all declarations of unexported names. .TP .BI \-I \ directory Add the given directory to the list of directories searched for -compiled interface files (.cmi) and compiled object code files -(.cmo). By default, the current directory is searched first, then the -standard library directory. Directories added with \-I are searched -after the current directory, in the order in which they were given on -the command line, but before the standard library directory. +compiled interface files (.cmi), compiled object code files (.cmx), +and libraries (.cmxa). By default, the current directory is searched +first, then the standard library directory. Directories added with \-I +are searched after the current directory, in the order in which they +were given on the command line, but before the standard library +directory. See also option +.BR \-nostdlib . If the given directory starts with .BR + , @@ -340,6 +342,12 @@ and pass the correct C libraries and options on the command line. Allow the compiler to use some optimizations that are valid only for code that is never dynlinked. .TP +.B -nostdlib +Do not automatically add the standard library directory the list of +directories searched for compiled interface files (.cmi), compiled +object code files (.cmx), and libraries (.cmxa). See also option +.BR \-I . +.TP .B \-nolabels Ignore non-optional labels in types. Labels cannot be used in applications, and parameter order becomes strict. @@ -522,7 +530,7 @@ standard library directory, then exit. Print all external commands before they are executed, in particular invocations of the assembler, C compiler, and linker. .TP -.BR \-vnum or \-version +.BR \-version \ or\ \-vnum Print the version number of the compiler in short form (e.g. "3.11.0"), then exit. .TP @@ -563,7 +571,6 @@ The default setting is .B \-warn\-help Show the description of all available warning numbers. .TP -.TP .B \-where Print the location of the standard library, then exit. .TP diff --git a/myocamlbuild.ml b/myocamlbuild.ml deleted file mode 100644 index 7d08b07e54..0000000000 --- a/myocamlbuild.ml +++ /dev/null @@ -1,615 +0,0 @@ -(***********************************************************************) -(* *) -(* OCaml *) -(* *) -(* Nicolas Pouillard, projet Gallium, INRIA Rocquencourt *) -(* *) -(* Copyright 2007 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -open Ocamlbuild_plugin -open Command -open Arch -open Format - -module C = Myocamlbuild_config - -let () = mark_tag_used "windows";; -let windows = Sys.os_type = "Win32";; -if windows then tag_any ["windows"];; -let ccomptype = C.ccomptype -(*let () = if ccomptype <> "cc" then eprintf "ccomptype: %s@." ccomptype;;*) - -let fp_cat oc f = with_input_file ~bin:true f (fun ic -> copy_chan ic oc) - -(* Improve using the command module in Myocamlbuild_config - with the variant version (`S, `A...) *) -let mkdll out files opts = - let s = Command.string_of_command_spec in - Cmd(Sh(Printf.sprintf "%s -o %s %s %s" C.mkdll out (s files) (s opts))) - -let mkexe out files opts = - let s = Command.string_of_command_spec in - Cmd(Sh(Printf.sprintf "%s -o %s %s %s" C.mkexe out (s files) (s opts))) - -let mklib out files opts = - let s = Command.string_of_command_spec in - Cmd(Sh(C.mklib out (s files) (s opts))) - -let syslib x = A(C.syslib x);; -let syscamllib x = - if ccomptype = "msvc" then A(Printf.sprintf "lib%s.lib" x) - else A("-l"^x) - -let ccoutput cc obj file = - if ccomptype = "msvc" then - Seq[Cmd(S[cc; A"-c"; Px file]); - mv (Pathname.basename (Pathname.update_extension C.o file)) obj] - else - Cmd(S[cc; A"-c"; P file; A"-o"; Px obj]) - -let mkobj obj file opts = - let tags = tags_of_pathname file++"c"++"compile"++ccomptype in - let bytecc_with_opts = S[Sh C.bytecc; Sh C.bytecccompopts; opts; T tags] in - ccoutput bytecc_with_opts obj file - -let mknatobj obj file opts = - let nativecc_with_opts = S[Sh C.nativecc; opts; Sh C.nativecccompopts] in - ccoutput nativecc_with_opts obj file - -let add_exe a = - if not windows || Pathname.check_extension a "exe" then a - else a-.-"exe";; - -let add_exe_if_exists a = - if not windows || Pathname.check_extension a "exe" then a - else - let exe = a-.-"exe" in - if Pathname.exists exe then exe else a;; - -let convert_command_for_windows_shell spec = - if not windows then spec else - let rec self specs acc = - match specs with - | N :: specs -> self specs acc - | S[] :: specs -> self specs acc - | S[x] :: specs -> self (x :: specs) acc - | S specs :: specs' -> self (specs @ specs') acc - | (P(a) | A(a)) :: specs -> - let dirname = Pathname.dirname a in - let basename = Pathname.basename a in - let p = - if dirname = Pathname.current_dir_name then Sh(add_exe_if_exists basename) - else Sh(add_exe_if_exists (dirname ^ "\\" ^ basename)) in - if String.contains_string basename 0 "ocamlrun" = None then - List.rev (p :: acc) @ specs - else - self specs (p :: acc) - | [] | (Px _ | T _ | V _ | Sh _ | Quote _) :: _ -> - invalid_arg "convert_command_for_windows_shell: invalid atom in head position" - in S(self [spec] []) - -let convert_for_windows_shell solver () = - convert_command_for_windows_shell (solver ()) - -let ocamlrun = A"boot/ocamlrun" -let full_ocamlrun = P((Sys.getcwd ()) / "boot/ocamlrun") - -let boot_ocamlc = S[ocamlrun; A"boot/ocamlc"; A"-I"; A"boot"; A"-nostdlib"] - -let mixed = Pathname.exists "build/ocamlbuild_mixed_mode";; - -let if_mixed_dir dir = - if mixed then ".."/dir else dir;; - -let unix_dir = - if Sys.os_type = "Win32" || C.system = "mingw" then - if_mixed_dir "otherlibs/win32unix" - else - if_mixed_dir "otherlibs/unix";; - -let threads_dir = if_mixed_dir "otherlibs/threads";; -let systhreads_dir = if_mixed_dir "otherlibs/systhreads";; -let dynlink_dir = if_mixed_dir "otherlibs/dynlink";; -let str_dir = if_mixed_dir "otherlibs/str";; -let toplevel_dir = if_mixed_dir "toplevel";; - -let systhreads_file f = "otherlibs/systhreads"/f -let systhreads_obj f = "otherlibs/systhreads"/f-.-C.o -let systhreads_lib f = "otherlibs/systhreads"/f-.-C.a -let systhreads_dll f = "otherlibs/systhreads"/f-.-C.so - -let test_nt native byte = - (Ocamlbuild_pack.My_std.sys_command (sprintf "test '%s' -nt '%s'" native byte)) = 0 - -let ocamlc_solver = - let common_deps = [ "../stdlib/stdlib.cma"; "../stdlib/std_exit.cmo"] in - let byte = "../ocamlc" in - let native = byte ^ ".opt" in - fun () -> - if List.for_all Pathname.exists (byte :: common_deps) then ( - if Pathname.exists native && test_nt native byte then - S[A native; A"-I"; A"../stdlib"; A"-nostdlib"] - else - S[ocamlrun; A byte; A"-I"; A"../stdlib"; A"-nostdlib"] - ) - else boot_ocamlc;; - -Command.setup_virtual_command_solver "OCAMLC" ocamlc_solver;; -Command.setup_virtual_command_solver "OCAMLCWIN" (convert_for_windows_shell ocamlc_solver);; - -let ocamlopt_solver () = - let byte = "../ocamlopt" in - let native = byte ^ ".opt" in - if List.for_all Pathname.exists [ byte; "../stdlib/stdlib.cmxa" ] then - if Pathname.exists native && test_nt native byte then - S[A native ; A"-I"; A"../stdlib"; A"-nostdlib"] - else - S[ocamlrun; A byte; A"-I"; A"../stdlib"; A"-nostdlib"] - else - failwith "Native compiler is not available.";; - -Command.setup_virtual_command_solver "OCAMLOPT" ocamlopt_solver;; -Command.setup_virtual_command_solver "OCAMLOPTWIN" (convert_for_windows_shell ocamlopt_solver);; - -let ocamlc = V"OCAMLC";; -let ocamlopt = V"OCAMLOPT";; - -let ar = A"ar";; - -dispatch begin function -| Before_hygiene -> - if mixed then - let patt = String.concat "," - ["asmcomp"; "bytecomp"; "debugger"; "driver"; - "lex"; "ocamldoc"; "otherlibs"; "parsing"; "stdlib"; "tools"; - "toplevel"; "typing"; "utils"] - in Ocamlbuild_pack.Configuration.parse_string - (sprintf "<{%s}/**>: not_hygienic, -traverse" patt) - -| After_options -> - begin - Options.ocamlrun := ocamlrun; - Options.ocamllex := S[ocamlrun; P"boot/ocamllex"]; - Options.ocamlyacc := if windows then P"./boot/ocamlyacc.exe" else P"boot/ocamlyacc"; - Options.ocamlmklib := S[ocamlrun; P"tools/ocamlmklib.byte"; A"-ocamlc"; Quote (V"OCAMLCWIN"); - A"-ocamlopt"; Quote (V"OCAMLOPTWIN")(* ; A"-v" *)]; - Options.ocamldep := S[ocamlrun; P"boot/ocamldep"]; - - Options.ext_obj := C.o; - Options.ext_lib := C.a; - Options.ext_dll := String.after C.ext_dll 1; - - Options.nostdlib := true; - Options.make_links := false; - if !Options.just_plugin then - Options.ocamlc := boot_ocamlc - else begin - Options.ocamlc := ocamlc; - Options.plugin := false; - Options.ocamlopt := ocamlopt; - end; - end -| After_rules -> - let module M = struct - - -flag ["ocaml"; "ocamlyacc"] (A"-v");; - -flag ["ocaml"; "compile"; "strict_sequence"] (A"-strict-sequence");; - -non_dependency "otherlibs/threads/pervasives.ml" "Unix";; -non_dependency "otherlibs/threads/pervasives.ml" "String";; - -let add_extensions extensions modules = - List.fold_right begin fun x -> - List.fold_right begin fun ext acc -> - x-.-ext :: acc - end extensions - end modules [];; - - -use_lib "toplevel/topstart" "toplevel/toplevellib";; -use_lib "otherlibs/dynlink/extract_crc" "otherlibs/dynlink/dynlink";; - -hide_package_contents "otherlibs/dynlink/dynlinkaux";; - -flag ["ocaml"; "link"; "file:driver/main.native"; "native"] begin - S[A"-ccopt"; A C.bytecclinkopts; A"-cclib"; A C.bytecclibs] -end;; - -dep ["ocaml"; "link"; "file:driver/main.native"; "native"] - ["asmrun/meta"-.-C.o; "asmrun/dynlink"-.-C.o];; - -dep ["ocaml"; "compile"; "native"] ["stdlib/libasmrun"-.-C.a];; - -flag ["ocaml"; "link"] (S[A"-I"; P "stdlib"]);; -flag ["ocaml"; "compile"; "include_unix"] (S[A"-I"; P unix_dir]);; -flag ["ocaml"; "compile"; "include_str"] (S[A"-I"; P str_dir]);; -flag ["ocaml"; "compile"; "include_dynlink"] (S[A"-I"; P dynlink_dir]);; -flag ["ocaml"; "compile"; "include_toplevel"] (S[A"-I"; P toplevel_dir]);; -flag ["ocaml"; "link"; "use_unix"] (S[A"-I"; P unix_dir]);; -flag ["ocaml"; "link"; "use_dynlink"] (S[A"-I"; P dynlink_dir]);; -flag ["ocaml"; "link"; "use_str"] (S[A"-I"; P str_dir]);; -flag ["ocaml"; "link"; "use_toplevel"] (S[A"-I"; P toplevel_dir]);; - -let setup_arch arch = - let annotated_arch = annotate arch in - let (_include_dirs_table, _for_pack_table) = mk_tables annotated_arch in - (* Format.eprintf "%a@." (Ocaml_arch.print_table (List.print pp_print_string)) include_dirs_table;; *) - iter_info begin fun i -> - Pathname.define_context i.current_path i.include_dirs - end annotated_arch;; - - -Pathname.define_context "" ["stdlib"];; -Pathname.define_context "utils" [Pathname.current_dir_name; "stdlib"];; -Pathname.define_context "parsing" ["parsing"; "utils"; "stdlib"];; -Pathname.define_context "typing" ["typing"; "parsing"; "utils"; "stdlib"];; -Pathname.define_context "ocamldoc" ["typing"; "parsing"; "utils"; "tools"; "bytecomp"; "stdlib"];; -Pathname.define_context "bytecomp" ["bytecomp"; "parsing"; "typing"; "utils"; "stdlib"];; -Pathname.define_context "tools" ["tools"; (* "toplevel"; *) "parsing"; "utils"; "driver"; "bytecomp"; "asmcomp"; "typing"; "stdlib"];; -Pathname.define_context "toplevel" ["toplevel"; "parsing"; "typing"; "bytecomp"; "utils"; "driver"; "stdlib"];; -Pathname.define_context "driver" ["driver"; "asmcomp"; "bytecomp"; "typing"; "utils"; "parsing"; "stdlib"];; -Pathname.define_context "debugger" ["bytecomp"; "utils"; "typing"; "parsing"; "toplevel"; "stdlib"];; -Pathname.define_context "otherlibs/dynlink" ["otherlibs/dynlink"; "bytecomp"; "utils"; "typing"; "parsing"; "stdlib"];; -Pathname.define_context "otherlibs/dynlink/nat" ["otherlibs/dynlink/nat"; "asmcomp"; "stdlib"];; -Pathname.define_context "asmcomp" ["asmcomp"; "bytecomp"; "parsing"; "typing"; "utils"; "stdlib"];; -Pathname.define_context "ocamlbuild" ["ocamlbuild"; "."];; -Pathname.define_context "lex" ["lex"; "stdlib"];; - -List.iter (fun x -> let x = "otherlibs"/x in Pathname.define_context x [x; "stdlib"]) - ["bigarray"; "graph"; "num"; "str"; "systhreads"; "unix"; "win32graph"; "win32unix"];; - -(* The bootstrap standard library *) -copy_rule "The bootstrap standard library" "stdlib/%" "boot/%";; - -(* About the standard library *) -copy_rule "stdlib asmrun" ("asmrun/%"-.-C.a) ("stdlib/%"-.-C.a);; -copy_rule "stdlib byterun" ("byterun/%"-.-C.a) ("stdlib/%"-.-C.a);; - -(* The thread specific standard library *) -copy_rule "The thread specific standard library (mllib)" ~insert:`bottom "stdlib/%.mllib" "otherlibs/threads/%.mllib";; -copy_rule "The thread specific standard library (cmo)" ~insert:`bottom "stdlib/%.cmo" "otherlibs/threads/%.cmo";; -copy_rule "The thread specific standard library (cmi)" ~insert:`top "stdlib/%.cmi" "otherlibs/threads/%.cmi";; -copy_rule "The thread specific standard library (mli)" ~insert:`bottom "stdlib/%.mli" "otherlibs/threads/%.mli";; -copy_rule "The thread specific unix library (mli)" ~insert:`bottom "otherlibs/unix/%.mli" "otherlibs/threads/%.mli";; -copy_rule "The thread specific unix library (ml)" ~insert:`bottom "otherlibs/unix/%.ml" "otherlibs/threads/%.ml";; -copy_rule "The thread specific unix library (mllib)" ~insert:`bottom "otherlibs/unix/%.mllib" "otherlibs/threads/%.mllib";; - -(* Temporary rule, waiting for a full usage of ocamlbuild *) -copy_rule "Temporary rule, waiting for a full usage of ocamlbuild" "%.mlbuild" "%.ml";; - -copy_rule "graph/graphics.ml -> win32graph/graphics.ml" "otherlibs/graph/graphics.ml" "otherlibs/win32graph/graphics.ml";; -copy_rule "graph/graphics.mli -> win32graph/graphics.mli" "otherlibs/graph/graphics.mli" "otherlibs/win32graph/graphics.mli";; - -rule "the ocaml toplevel" - ~prod:"ocaml" - ~deps:["stdlib/stdlib.mllib"; "toplevel/topstart.byte"; "toplevel/expunge.byte"] - begin fun _ _ -> - let modules = string_list_of_file "stdlib/stdlib.mllib" in - Cmd(S[ocamlrun; A"toplevel/expunge.byte"; A"toplevel/topstart.byte"; Px"ocaml"; - A"outcometree"; A"topdirs"; A"toploop"; atomize modules]) - end;; - -let copy_rule' ?insert src dst = copy_rule (sprintf "%s -> %s" src dst) ?insert src dst;; - -copy_rule' "driver/main.byte" "ocamlc";; -copy_rule' "driver/main.native" "ocamlc.opt";; -copy_rule' "driver/optmain.byte" "ocamlopt";; -copy_rule' "driver/optmain.native" "ocamlopt.opt";; -copy_rule' "lex/main.byte" "lex/ocamllex";; -copy_rule' "lex/main.native" "lex/ocamllex.opt";; -copy_rule' "debugger/main.byte" "debugger/ocamldebug";; -copy_rule' "ocamldoc/odoc.byte" "ocamldoc/ocamldoc";; -copy_rule' "ocamldoc/odoc.native" "ocamldoc/ocamldoc.opt";; -copy_rule' "tools/ocamlmklib.byte" "tools/ocamlmklib";; -copy_rule' "otherlibs/dynlink/extract_crc.byte" "otherlibs/dynlink/extract_crc";; -copy_rule' "myocamlbuild_config.mli" "ocamlbuild/ocamlbuild_Myocamlbuild_config.mli";; -copy_rule' "myocamlbuild_config.ml" "ocamlbuild/ocamlbuild_Myocamlbuild_config.ml";; - -copy_rule' ~insert:`bottom "%" "%.exe";; - -ocaml_lib "stdlib/stdlib";; - -let stdlib_mllib_contents = - lazy (string_list_of_file "stdlib/stdlib.mllib");; - -let import_stdlib_contents build exts = - let l = - List.fold_right begin fun x -> - List.fold_right begin fun ext acc -> - ["stdlib"/(String.uncapitalize x)-.-ext] :: acc - end exts - end !*stdlib_mllib_contents [] - in - let res = build l in - List.iter Outcome.ignore_good res -;; - -rule "byte stdlib in mixed mode" - ~stamp:"byte_stdlib_mixed_mode" - ~deps:["stdlib/stdlib.mllib"; "stdlib/stdlib.cma"; - "stdlib/std_exit.cmo"; "stdlib/libcamlrun"-.-C.a; - "stdlib/camlheader"; "stdlib/camlheader_ur"] - begin fun env build -> - let (_ : Command.t) = - Ocamlbuild_pack.Ocaml_compiler.byte_library_link_mllib - "stdlib/stdlib.mllib" "stdlib/stdlib.cma" env build - in - import_stdlib_contents build ["cmi"]; - Nop - end;; - -rule "native stdlib in mixed mode" - ~stamp:"native_stdlib_mixed_mode" - ~deps:["stdlib/stdlib.mllib"; "stdlib/stdlib.cmxa"; - "stdlib/stdlib"-.-C.a; "stdlib/std_exit.cmx"; - "stdlib/std_exit"-.-C.o; "stdlib/libasmrun"-.-C.a; - "stdlib/camlheader"; "stdlib/camlheader_ur"] - begin fun env build -> - let (_ : Command.t) = - Ocamlbuild_pack.Ocaml_compiler.native_library_link_mllib - "stdlib/stdlib.mllib" "stdlib/stdlib.cmxa" env build - in - import_stdlib_contents build ["cmi"]; - Nop - end;; - -copy_rule' ~insert:`top "otherlibs/dynlink/natdynlink.ml" "otherlibs/dynlink/nat/dynlink.ml";; -copy_rule' ~insert:`top "otherlibs/dynlink/dynlink.mli" "otherlibs/dynlink/nat/dynlink.mli";; -copy_rule' ~insert:`top "otherlibs/dynlink/nat/dynlink.cmx" "otherlibs/dynlink/dynlink.cmx";; -copy_rule' ~insert:`top ("otherlibs/dynlink/nat/dynlink"-.-C.o) ("otherlibs/dynlink/dynlink"-.-C.o);; -copy_rule' ~insert:`top "otherlibs/dynlink/nat/dynlink.cmxa" "otherlibs/dynlink/dynlink.cmxa";; -copy_rule' ~insert:`top ("otherlibs/dynlink/nat/dynlink"-.-C.a) ("otherlibs/dynlink/dynlink"-.-C.a);; -dep ["ocaml"; "compile"; "native"; "file:otherlibs/dynlink/nat/dynlink.cmx"] ["otherlibs/dynlink/nat/dynlink.cmi"];; - -rule "C files" - ~prod:("%"-.-C.o) - ~dep:"%.c" - ~insert:(`before "ocaml C stubs: c -> o") - begin fun env _ -> - mkobj (env ("%"-.-C.o)) (env "%.c") N - end;; - -let () = - (* define flags otherlibs_unix, otherlibs_bigarray... *) - let otherlibs = "otherlibs" in - let open Pathname in - Array.iter (fun file -> - if is_directory (concat "otherlibs" file) then - mark_tag_used ("otherlibs_" ^ file) - ) (readdir otherlibs);; - -(* ../ is because .h files are not dependencies so they are not imported in build dir *) -flag ["c"; "compile"; "otherlibs_bigarray"] (S[A"-I"; P"../otherlibs/bigarray"]);; -flag [(* "ocaml" or "c"; *) "ocamlmklib"; "otherlibs_graph"] (S[Sh C.x11_link]);; -flag ["c"; "compile"; "otherlibs_graph"] (S[Sh C.x11_includes; A"-I../otherlibs/graph"]);; -flag ["c"; "compile"; "otherlibs_win32graph"] (A"-I../otherlibs/win32graph");; -flag ["ocaml"; "ocamlmklib"; "otherlibs_threads"] (S[A"-oc"; A"otherlibs/threads/vmthreads"]);; -flag ["c"; "compile"; "otherlibs_num"] begin - S[A("-DBNG_ARCH_"^C.bng_arch); - A("-DBNG_ASM_LEVEL="^C.bng_asm_level); - A"-I"; P"../otherlibs/num"] -end;; -flag ["c"; "compile"; "otherlibs_win32unix"] (A"-I../otherlibs/win32unix");; -flag [(* "ocaml" or "c"; *) "ocamlmklib"; "otherlibs_win32unix"] (S[A"-cclib"; Quote (syslib "ws2_32")]);; -flag ["c"; "link"; "dll"; "otherlibs_win32unix"] (syslib "ws2_32");; -let flags = S[syslib "kernel32"; syslib "gdi32"; syslib "user32"] in -flag ["c"; "ocamlmklib"; "otherlibs_win32graph"] (S[A"-cclib"; Quote flags]); -flag ["c"; "link"; "dll"; "otherlibs_win32graph"] flags;; - -if windows then flag ["c"; "compile"; "otherlibs_bigarray"] (A"-DIN_OCAML_BIGARRAY");; - -if windows then flag ["ocamlmklib"] (A"-custom");; - -flag ["ocaml"; "pp"; "ocamldoc_sources"] begin - if windows then - S[A"grep"; A"-v"; A"DEBUG"] - else - A"../ocamldoc/remove_DEBUG" -end;; - -let ocamldoc = P"./ocamldoc/ocamldoc.opt" in -let stdlib_mlis = - List.fold_right - (fun x acc -> "stdlib"/(String.uncapitalize x)-.-"mli" :: acc) - (string_list_of_file "stdlib/stdlib.mllib") - ["otherlibs/unix/unix.mli"; "otherlibs/str/str.mli"; - "otherlibs/bigarray/bigarray.mli"; "otherlibs/num/num.mli"] in -rule "Standard library manual" - ~prod:"ocamldoc/stdlib_man/Pervasives.3o" - ~stamp:"ocamldoc/stdlib_man.stamp" (* Depend on this file if you want to depends on all files of stdlib_man/* *) - ~deps:stdlib_mlis - begin fun _ _ -> - Seq[Cmd(S[A"mkdir"; A"-p"; P"ocamldoc/stdlib_man"]); - Cmd(S[ocamldoc; A"-man"; A"-d"; P"ocamldoc/stdlib_man"; - A"-I"; P "stdlib"; A"-I"; P"otherlibs/unix"; A"-I"; P"otherlibs/num"; - A"-t"; A"OCaml library"; A"-man-mini"; atomize stdlib_mlis])] - end;; - -flag ["ocaml"; "compile"; "bootstrap_thread"] - (S[A"-I"; P systhreads_dir; A"-I"; P threads_dir]);; - -flag ["ocaml"; "link"; "bootstrap_thread"] - (S[A"-I"; P systhreads_dir; A"-I"; P threads_dir]);; - -(* Sys threads *) - -let systhreads_stubs_headers = - List.map systhreads_file - [if windows then "st_win32.h" else "st_posix.h"; "threads.h"] -;; - -rule "native systhreads" - ~prod:(systhreads_obj "st_stubs_n") - ~deps:(systhreads_file "st_stubs.c" :: systhreads_stubs_headers) - ~insert:`top - begin fun _ _ -> - mknatobj (systhreads_obj "st_stubs_n") - (systhreads_file "st_stubs.c") - (S[A"-I../asmrun"; A"-I../byterun"; A"-Iotherlibs/systhreads"; - if windows then N else Sh C.sharedcccompopts; - A"-DNATIVE_CODE"; A("-DTARGET_"^C.arch); A("-DSYS_"^C.system)]) - end;; - -rule "bytecode systhreads" - ~prod:(systhreads_obj "st_stubs_b") - ~deps:(systhreads_file "st_stubs.c" :: systhreads_stubs_headers) - ~insert:`top - begin fun _ _ -> - mkobj (systhreads_obj "st_stubs_b") (systhreads_file "st_stubs.c") - (S[A"-I../byterun"; A"-Iotherlibs/systhreads"; Sh C.sharedcccompopts]) - end;; - -rule "libthreadsnat.a" - ~prod:(systhreads_lib "libthreadsnat") - ~dep:(systhreads_obj "st_stubs_n") - ~insert:`top - begin fun _ _ -> - if windows then - mklib (systhreads_lib "libthreadsnat") (P(systhreads_obj "st_stubs_n")) N - else - (* Dynamic linking with -lpthread is risky on many platforms, so - do not create a shared object for libthreadsnat. *) - Cmd(S[ar; A"rc"; Px(systhreads_lib "libthreadsnat"); - P(systhreads_obj "st_stubs_n")]) - end; - -(* See remark above: force static linking of libthreadsnat.a *) -if windows then - flag ["ocaml"; "link"; "library"; "otherlibs_systhreads"; "native"] begin - S[A"-cclib"; syscamllib "threadsnat"; (* A"-cclib"; syscamllib "unix"; seems to be useless and can be dangerous during bootstrap *) Sh C.pthread_link] - end;; - -flag ["ocaml"; "ocamlmklib"; "otherlibs_systhreads"] (S[(* A"-cclib"; syscamllib "unix";; seems to be useless and can be dangerous during bootstrap *) Sh C.pthread_link]);; - -flag ["c"; "compile"; "otherlibs"] begin - S[A"-I"; P"../byterun"; - A"-I"; P(".."/unix_dir); - Sh C.bytecccompopts; - Sh C.sharedcccompopts] -end;; - -flag ["c"; "compile"; "otherlibs"; "cc"] (A"-O");; -flag ["c"; "compile"; "otherlibs"; "mingw"] (A"-O");; - -(* The numeric opcodes *) -rule "The numeric opcodes" - ~prod:"bytecomp/opcodes.ml" - ~dep:"byterun/instruct.h" - ~insert:`top - begin fun _ _ -> - Cmd(Sh "sed -n -e '/^enum/p' -e 's/,//g' -e '/^ /p' byterun/instruct.h | \ - awk -f ../tools/make-opcodes > bytecomp/opcodes.ml") - end;; - -rule "tools/opnames.ml" - ~prod:"tools/opnames.ml" - ~dep:"byterun/instruct.h" - begin fun _ _ -> - Cmd(Sh"unset LC_ALL || : ; \ - unset LC_CTYPE || : ; \ - unset LC_COLLATE LANG || : ; \ - sed -e '/\\/\\*/d' \ - -e '/^#/d' \ - -e 's/enum \\(.*\\) {/let names_of_\\1 = [|/' \ - -e 's/};$/ |]/' \ - -e 's/\\([A-Z][A-Z_0-9a-z]*\\)/\"\\1\"/g' \ - -e 's/,/;/g' \ - byterun/instruct.h > tools/opnames.ml") - end;; - -(* The version number *) -rule "stdlib/sys.ml" - ~prod:"stdlib/sys.ml" - ~deps:["stdlib/sys.mlp"; "VERSION"] - begin fun _ _ -> - let version = with_input_file "VERSION" input_line in - Seq [rm_f "stdlib/sys.ml"; - Cmd (S[A"sed"; A"-e"; - A(sprintf "s,%%%%VERSION%%%%,%s," version); - Sh"<"; P"stdlib/sys.mlp"; Sh">"; Px"stdlib/sys.ml"]); - chmod (A"-w") "stdlib/sys.ml"] - end;; - -(* The predefined exceptions and primitives *) - -rule "camlheader" - ~prods:["stdlib/camlheader"; "stdlib/camlheader_ur"] - ~deps:["stdlib/header.c"; "stdlib/headernt.c"] - begin fun _ _ -> - if C.sharpbangscripts then - Cmd(Sh("echo '#!"^C.bindir^"/ocamlrun' > stdlib/camlheader && \ - echo '#!' | tr -d '\\012' > stdlib/camlheader_ur")) - else if windows then - Seq[mkexe "tmpheader.exe" (P"stdlib/headernt.c") (S[A"-I../byterun"; Sh C.extralibs]); - rm_f "camlheader.exe"; - mv "tmpheader.exe" "stdlib/camlheader"; - cp "stdlib/camlheader" "stdlib/camlheader_ur"] - else - let tmpheader = "tmpheader"^C.exe in - Cmd(S[Sh C.bytecc; Sh C.bytecccompopts; Sh C.bytecclinkopts; - A"-I"; A"../stdlib"; - A("-DRUNTIME_NAME='\""^C.bindir^"/ocamlrun\"'"); - A"stdlib/header.c"; A"-o"; Px tmpheader; Sh"&&"; - A"strip"; P tmpheader; Sh"&&"; - A"mv"; P tmpheader; A"stdlib/camlheader"; Sh"&&"; - A"cp"; A"stdlib/camlheader"; A"stdlib/camlheader_ur"]) - end;; - -(* Private copy of dynlink.{ml,mli} in debugger/ *) -copy_rule "otherlibs/dynlink/dynlink.mli -> debugger/dynlink.mli" "otherlibs/dynlink/dynlink.mli" "debugger/dynlink.mli";; -rule "debugger/dynlink.ml" - ~prod: "debugger/dynlink.ml" - ~dep: "otherlibs/dynlink/dynlink.ml" - begin fun _ _ -> - Cmd(Sh"grep -v 'REMOVE_ME for ../../debugger/dynlink.ml' \ - < otherlibs/dynlink/dynlink.ml >debugger/dynlink.ml") - end;; - - -copy_rule "win32unix use some unix files" "otherlibs/unix/%" "otherlibs/win32unix/%";; - -(* Temporary rule *) -rule "tools/ocamlmklib.ml" - ~prod:"tools/ocamlmklib.ml" - ~dep:"tools/ocamlmklib.mlp" - (fun _ _ -> cp "tools/ocamlmklib.mlp" "tools/ocamlmklib.ml");; - - -rule "bytecomp/runtimedef.ml" - ~prod:"bytecomp/runtimedef.ml" - ~deps:["byterun/primitives"; "byterun/fail.h"] - begin fun _ _ -> - Cmd(S[A"../build/mkruntimedef.sh";Sh">"; Px"bytecomp/runtimedef.ml"]) - end;; - -(* Choose the right machine-dependent files *) - -let mk_arch_rule ~src ~dst = - let prod = "asmcomp"/dst in - let dep = "asmcomp"/C.arch/src in - rule (sprintf "arch specific files %S%%" dst) ~prod ~dep begin - if windows then fun env _ -> cp (env dep) (env prod) - else fun env _ -> ln_s (env (C.arch/src)) (env prod) - end;; - -mk_arch_rule ~src:(if ccomptype = "msvc" then "proc_nt.ml" else "proc.ml") ~dst:"proc.ml";; -List.iter (fun x -> mk_arch_rule ~src:x ~dst:x) - ["arch.ml"; "reload.ml"; "scheduling.ml"; "selection.ml"];; - -let emit_mlp = "asmcomp"/C.arch/(if ccomptype = "msvc" then "emit_nt.mlp" else "emit.mlp") in -rule "emit.mlp" - ~prod:"asmcomp/emit.ml" - ~deps:[emit_mlp; "tools/cvt_emit.byte"] - begin fun _ _ -> - Cmd(S[ocamlrun; P"tools/cvt_emit.byte"; Sh "<"; P emit_mlp; - Sh">"; Px"asmcomp/emit.ml"]) - end;; - end in () - | _ -> () -end diff --git a/myocamlbuild_config.mli b/myocamlbuild_config.mli deleted file mode 100644 index d19a39aed9..0000000000 --- a/myocamlbuild_config.mli +++ /dev/null @@ -1,72 +0,0 @@ -(*************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Nicolas Pouillard, projet Gallium, INRIA Rocquencourt *) -(* *) -(* Copyright 2007 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(*************************************************************************) - -val prefix : string -val bindir : string -val libdir : string -val manext : string -val ranlib : string -val ranlibcmd : string -val arcmd : string -val sharpbangscripts : bool -val bng_arch : string -val bng_asm_level : string -val pthread_link : string -val x11_includes : string -val x11_link : string -val bytecc : string -val bytecccompopts : string -val bytecclinkopts : string -val bytecclibs : string -val byteccrpath : string -val exe : string -val supports_shared_libraries : bool -val sharedcccompopts : string -val mksharedlibrpath : string -val arch : string -val model : string -val system : string -val nativecc : string -val nativecccompopts : string -val nativeccprofopts : string -val nativecclinkopts : string -val nativeccrpath : string -val nativecclibs : string -val packld : string -val dllcccompopts : string -val asm : string -val aspp : string -val asppprofflags : string -val profiling : string -val dynlinkopts : string -val otherlibraries : string -val with_debugger : string -val cc_profile : string -val systhread_support : bool -val syslib : string -> string -val mkexe : string -val mkdll : string -val mkmaindll : string -val mklib : string -> string -> string -> string -val ext_lib : string -val ext_obj : string -val ext_asm : string -val ext_dll : string -val o : string -val a : string -val so : string -val toolchain : string -val ccomptype : string -val extralibs : string -val asm_cfi_supported : bool -val target : string -val host : string diff --git a/ocamlbuild/.depend b/ocamlbuild/.depend index 5344160e84..5e0c7e6607 100644 --- a/ocamlbuild/.depend +++ b/ocamlbuild/.depend @@ -13,7 +13,8 @@ glob_ast.cmi : bool.cmi glob_lexer.cmi : glob_ast.cmi hooks.cmi : hygiene.cmi : slurp.cmi -lexers.cmi : glob.cmi +lexers.cmi : loc.cmi glob.cmi +loc.cmi : log.cmi : tags.cmi signatures.cmi main.cmi : my_std.cmi : signatures.cmi @@ -31,7 +32,7 @@ ocamlbuild_unix_plugin.cmi : ocamlbuild_where.cmi : ocamlbuildlight.cmi : options.cmi : slurp.cmi signatures.cmi command.cmi -param_tags.cmi : tags.cmi +param_tags.cmi : tags.cmi loc.cmi pathname.cmi : signatures.cmi plugin.cmi : ppcache.cmi : @@ -49,11 +50,11 @@ bool.cmx : bool.cmi command.cmo : tags.cmi shell.cmi param_tags.cmi my_unix.cmi my_std.cmi \ log.cmi lexers.cmi command.cmi command.cmx : tags.cmx shell.cmx param_tags.cmx my_unix.cmx my_std.cmx \ - log.cmx lexers.cmi command.cmi -configuration.cmo : tags.cmi param_tags.cmi my_std.cmi log.cmi lexers.cmi \ - glob.cmi configuration.cmi -configuration.cmx : tags.cmx param_tags.cmx my_std.cmx log.cmx lexers.cmi \ - glob.cmx configuration.cmi + log.cmx lexers.cmx command.cmi +configuration.cmo : tags.cmi param_tags.cmi my_std.cmi log.cmi loc.cmi \ + lexers.cmi glob.cmi configuration.cmi +configuration.cmx : tags.cmx param_tags.cmx my_std.cmx log.cmx loc.cmx \ + lexers.cmx glob.cmx configuration.cmi digest_cache.cmo : shell.cmi pathname.cmi options.cmi my_unix.cmi my_std.cmi \ digest_cache.cmi digest_cache.cmx : shell.cmx pathname.cmx options.cmx my_unix.cmx my_std.cmx \ @@ -67,31 +68,39 @@ exit_codes.cmx : exit_codes.cmi fda.cmo : pathname.cmi options.cmi log.cmi hygiene.cmi fda.cmi fda.cmx : pathname.cmx options.cmx log.cmx hygiene.cmx fda.cmi findlib.cmo : my_unix.cmi my_std.cmi lexers.cmi command.cmi findlib.cmi -findlib.cmx : my_unix.cmx my_std.cmx lexers.cmi command.cmx findlib.cmi -flags.cmo : tags.cmi param_tags.cmi command.cmi bool.cmi flags.cmi -flags.cmx : tags.cmx param_tags.cmx command.cmx bool.cmx flags.cmi +findlib.cmx : my_unix.cmx my_std.cmx lexers.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.cmi glob_ast.cmx bool.cmx 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 hooks.cmo : hooks.cmi hooks.cmx : hooks.cmi hygiene.cmo : slurp.cmi shell.cmi pathname.cmi options.cmi my_std.cmi \ log.cmi hygiene.cmi hygiene.cmx : slurp.cmx shell.cmx pathname.cmx options.cmx my_std.cmx \ log.cmx hygiene.cmi +lexers.cmo : my_std.cmi loc.cmi glob_ast.cmi glob.cmi bool.cmi lexers.cmi +lexers.cmx : my_std.cmx loc.cmx glob_ast.cmx glob.cmx bool.cmx lexers.cmi +loc.cmo : loc.cmi +loc.cmx : loc.cmi log.cmo : my_unix.cmi my_std.cmi display.cmi log.cmi log.cmx : my_unix.cmx my_std.cmx display.cmx log.cmi main.cmo : tools.cmi tags.cmi solver.cmi slurp.cmi shell.cmi rule.cmi \ resource.cmi report.cmi plugin.cmi pathname.cmi param_tags.cmi \ options.cmi ocaml_utils.cmi ocaml_specific.cmi ocaml_dependencies.cmi \ - my_unix.cmi my_std.cmi log.cmi lexers.cmi hooks.cmi flags.cmi fda.cmi \ - exit_codes.cmi digest_cache.cmi configuration.cmi command.cmi main.cmi + my_unix.cmi my_std.cmi log.cmi loc.cmi lexers.cmi hooks.cmi flags.cmi \ + fda.cmi exit_codes.cmi digest_cache.cmi configuration.cmi command.cmi \ + main.cmi main.cmx : tools.cmx tags.cmx solver.cmx slurp.cmx shell.cmx rule.cmx \ resource.cmx report.cmx plugin.cmx pathname.cmx param_tags.cmx \ options.cmx ocaml_utils.cmx ocaml_specific.cmx ocaml_dependencies.cmx \ - my_unix.cmx my_std.cmx log.cmx lexers.cmi hooks.cmx flags.cmx fda.cmx \ - exit_codes.cmx digest_cache.cmx configuration.cmx command.cmx main.cmi + my_unix.cmx my_std.cmx log.cmx loc.cmx lexers.cmx hooks.cmx flags.cmx \ + fda.cmx exit_codes.cmx digest_cache.cmx configuration.cmx command.cmx \ + main.cmi my_std.cmo : my_std.cmi my_std.cmx : my_std.cmi my_unix.cmo : my_std.cmi my_unix.cmi @@ -109,11 +118,13 @@ ocaml_dependencies.cmo : tools.cmi resource.cmi pathname.cmi ocaml_utils.cmi \ ocaml_dependencies.cmx : tools.cmx resource.cmx pathname.cmx ocaml_utils.cmx \ my_std.cmx log.cmx ocaml_dependencies.cmi ocaml_specific.cmo : tools.cmi tags.cmi rule.cmi pathname.cmi options.cmi \ - ocaml_utils.cmi ocaml_tools.cmi ocaml_compiler.cmi my_std.cmi log.cmi \ - flags.cmi findlib.cmi configuration.cmi command.cmi ocaml_specific.cmi + ocamlbuild_config.cmo ocaml_utils.cmi ocaml_tools.cmi ocaml_compiler.cmi \ + my_std.cmi log.cmi flags.cmi findlib.cmi configuration.cmi command.cmi \ + ocaml_specific.cmi ocaml_specific.cmx : tools.cmx tags.cmx rule.cmx pathname.cmx options.cmx \ - ocaml_utils.cmx ocaml_tools.cmx ocaml_compiler.cmx my_std.cmx log.cmx \ - flags.cmx findlib.cmx configuration.cmx command.cmx ocaml_specific.cmi + ocamlbuild_config.cmx ocaml_utils.cmx ocaml_tools.cmx ocaml_compiler.cmx \ + my_std.cmx log.cmx flags.cmx findlib.cmx configuration.cmx command.cmx \ + ocaml_specific.cmi ocaml_tools.cmo : tools.cmi tags.cmi rule.cmi pathname.cmi options.cmi \ ocaml_utils.cmi ocaml_compiler.cmi my_std.cmi flags.cmi command.cmi \ ocaml_tools.cmi @@ -123,11 +134,11 @@ ocaml_tools.cmx : tools.cmx tags.cmx rule.cmx pathname.cmx options.cmx \ ocaml_utils.cmo : tools.cmi tags.cmi pathname.cmi param_tags.cmi options.cmi \ my_std.cmi log.cmi lexers.cmi flags.cmi command.cmi ocaml_utils.cmi ocaml_utils.cmx : tools.cmx tags.cmx pathname.cmx param_tags.cmx options.cmx \ - my_std.cmx log.cmx lexers.cmi flags.cmx command.cmx ocaml_utils.cmi + my_std.cmx log.cmx lexers.cmx flags.cmx command.cmx ocaml_utils.cmi ocamlbuild.cmo : ocamlbuild_unix_plugin.cmi ocamlbuild.cmi ocamlbuild.cmx : ocamlbuild_unix_plugin.cmx ocamlbuild.cmi -ocamlbuild_Myocamlbuild_config.cmo : -ocamlbuild_Myocamlbuild_config.cmx : +ocamlbuild_config.cmo : +ocamlbuild_config.cmx : ocamlbuild_executor.cmo : ocamlbuild_executor.cmi ocamlbuild_executor.cmx : ocamlbuild_executor.cmi ocamlbuild_plugin.cmo : ocamlbuild_plugin.cmi @@ -136,30 +147,28 @@ ocamlbuild_unix_plugin.cmo : ocamlbuild_executor.cmi my_unix.cmi my_std.cmi \ exit_codes.cmi ocamlbuild_unix_plugin.cmi ocamlbuild_unix_plugin.cmx : ocamlbuild_executor.cmx my_unix.cmx my_std.cmx \ exit_codes.cmx ocamlbuild_unix_plugin.cmi -ocamlbuild_where.cmo : ocamlbuild_Myocamlbuild_config.cmo \ - ocamlbuild_where.cmi -ocamlbuild_where.cmx : ocamlbuild_Myocamlbuild_config.cmx \ - ocamlbuild_where.cmi +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_Myocamlbuild_config.cmo my_std.cmi log.cmi lexers.cmi \ - command.cmi options.cmi -options.cmx : shell.cmx ocamlbuild_where.cmx \ - ocamlbuild_Myocamlbuild_config.cmx my_std.cmx log.cmx lexers.cmi \ - command.cmx options.cmi -param_tags.cmo : my_std.cmi log.cmi lexers.cmi param_tags.cmi -param_tags.cmx : my_std.cmx log.cmx lexers.cmi param_tags.cmi +options.cmo : shell.cmi ocamlbuild_where.cmi ocamlbuild_config.cmo \ + my_std.cmi log.cmi lexers.cmi command.cmi options.cmi +options.cmx : shell.cmx ocamlbuild_where.cmx ocamlbuild_config.cmx \ + my_std.cmx log.cmx lexers.cmx command.cmx options.cmi +param_tags.cmo : tags.cmi my_std.cmi log.cmi loc.cmi lexers.cmi \ + param_tags.cmi +param_tags.cmx : tags.cmx my_std.cmx log.cmx loc.cmx lexers.cmx \ + param_tags.cmi pathname.cmo : shell.cmi options.cmi my_unix.cmi my_std.cmi log.cmi glob.cmi \ pathname.cmi pathname.cmx : shell.cmx options.cmx my_unix.cmx my_std.cmx log.cmx glob.cmx \ pathname.cmi -plugin.cmo : tools.cmi tags.cmi shell.cmi rule.cmi pathname.cmi options.cmi \ - ocamlbuild_where.cmi my_unix.cmi my_std.cmi log.cmi command.cmi \ - plugin.cmi -plugin.cmx : tools.cmx tags.cmx shell.cmx rule.cmx pathname.cmx options.cmx \ - ocamlbuild_where.cmx my_unix.cmx my_std.cmx log.cmx command.cmx \ - plugin.cmi +plugin.cmo : tools.cmi tags.cmi shell.cmi rule.cmi pathname.cmi \ + param_tags.cmi options.cmi ocamlbuild_where.cmi my_unix.cmi my_std.cmi \ + log.cmi command.cmi plugin.cmi +plugin.cmx : tools.cmx tags.cmx shell.cmx rule.cmx pathname.cmx \ + param_tags.cmx options.cmx ocamlbuild_where.cmx my_unix.cmx my_std.cmx \ + log.cmx command.cmx plugin.cmi ppcache.cmo : shell.cmi pathname.cmi my_std.cmi log.cmi command.cmi \ ppcache.cmi ppcache.cmx : shell.cmx pathname.cmx my_std.cmx log.cmx command.cmx \ @@ -170,12 +179,12 @@ resource.cmo : slurp.cmi shell.cmi pathname.cmi options.cmi my_unix.cmi \ my_std.cmi log.cmi lexers.cmi glob_ast.cmi glob.cmi digest_cache.cmi \ command.cmi resource.cmi resource.cmx : slurp.cmx shell.cmx pathname.cmx options.cmx my_unix.cmx \ - my_std.cmx log.cmx lexers.cmi glob_ast.cmx glob.cmx digest_cache.cmx \ + my_std.cmx log.cmx lexers.cmx glob_ast.cmx glob.cmx digest_cache.cmx \ command.cmx resource.cmi -rule.cmo : tags.cmi shell.cmi resource.cmi pathname.cmi options.cmi \ - my_std.cmi log.cmi digest_cache.cmi command.cmi rule.cmi -rule.cmx : tags.cmx shell.cmx resource.cmx pathname.cmx options.cmx \ - my_std.cmx log.cmx digest_cache.cmx command.cmx rule.cmi +rule.cmo : shell.cmi resource.cmi pathname.cmi options.cmi my_std.cmi \ + log.cmi digest_cache.cmi command.cmi rule.cmi +rule.cmx : shell.cmx resource.cmx pathname.cmx options.cmx my_std.cmx \ + log.cmx digest_cache.cmx command.cmx rule.cmi shell.cmo : tags.cmi my_unix.cmi my_std.cmi log.cmi shell.cmi shell.cmx : tags.cmx my_unix.cmx my_std.cmx log.cmx shell.cmi slurp.cmo : my_unix.cmi my_std.cmi slurp.cmi diff --git a/ocamlbuild/Makefile b/ocamlbuild/Makefile index fe011bd688..ec3b999ea6 100644 --- a/ocamlbuild/Makefile +++ b/ocamlbuild/Makefile @@ -10,119 +10,190 @@ # # ######################################################################### -.PHONY: all byte native profile debug ppcache doc - -ifndef INSTALL_PREFIX -INSTALL_PREFIX := $(PWD)/_install -endif - -ifndef INSTALL_LIB -INSTALL_LIB := $(INSTALL_PREFIX)/lib/ocamlbuild -endif - -ifndef INSTALL_BIN -INSTALL_BIN := $(INSTALL_PREFIX)/bin -endif - -ifndef BUILDDIR -BUILDDIR := "_build" -endif - -ifndef OCAMLBUILDCMD -OCAMLBUILDCMD := ./boot/ocamlbuild -endif - -ifdef O -OCAMLBUILD_OPTIONS := $(OCAMLBUILD_OPTIONS) $(O) -endif - -ifeq ($(wildcard ./ocamlbuild_Myocamlbuil*_config.ml),./ocamlbuild_Myocamlbuild_config.ml) -ifeq ($(wildcard ./boot/oc*build),./boot/ocamlbuild) -OCAMLBUILD=INSTALL_LIB=$(INSTALL_LIB) INSTALL_BIN=$(INSTALL_BIN) $(OCAMLBUILDCMD) -build-dir $(BUILDDIR) -no-links $(OCAMLBUILD_OPTIONS) -LIBS=ocamlbuildlib ocamlbuildlightlib -PROGRAMS=ocamlbuild ocamlbuildlight -BYTE=$(LIBS:=.cma) $(PROGRAMS:=.byte) -NATIVE=$(LIBS:=.cmxa) $(PROGRAMS:=.native) - -all: - $(OCAMLBUILD) $(BYTE) $(NATIVE) -byte: - $(OCAMLBUILD) $(BYTE) -native: - $(OCAMLBUILD) $(NATIVE) -profile: - $(OCAMLBUILD) $(LIBS:=.p.cmxa) $(PROGRAMS:=.p.native) -debug: - $(OCAMLBUILD) $(LIBS:=.d.cma) $(PROGRAMS:=.d.byte) -ppcache: - $(OCAMLBUILD) ppcache.byte ppcache.native -doc: - $(OCAMLBUILD) ocamlbuild.docdir/index.html - ln -s -f $(BUILDDIR)/ocamlbuild.docdir doc -else -all byte native: ocamlbuild.byte.start - mkdir -p boot - cp ocamlbuild.byte.start boot/ocamlbuild - $(MAKE) $(MFLAGS) $(MAKECMDGOALS) - cp $(BUILDDIR)/ocamlbuild.native boot/ocamlbuild - $(MAKE) $(MFLAGS) $(MAKECMDGOALS) OCAMLBUILD_OPTIONS="-nothing-should-be-rebuilt -verbose -1" -endif -else -all byte native: - @echo "Please copy the myocamlbuild_config.ml of the OCaml source distribution" - @echo " as ocamlbuild_Myocamlbuild_config.ml" - @echo - @echo "$$ cp ../myocamlbuild_config.ml ocamlbuild_Myocamlbuild_config.ml" -endif - -ocamlbuild.byte.start: - ./start.sh - -promote: - cp $(BUILDDIR)/ocamlbuild.native boot/ocamlbuild - -clean: - rm -rf $(BUILDDIR) - -distclean: clean - rm -rf _log _start ocamlbuild.byte.start boot/ocamlbuild - -install: all - mkdir -p $(INSTALL_BIN) - mkdir -p $(INSTALL_LIB) - install $(BUILDDIR)/ocamlbuild.byte \ - $(BUILDDIR)/ocamlbuild.native \ - $(BUILDDIR)/ocamlbuildlight.byte \ - $(BUILDDIR)/ocamlbuildlight.native \ - $(INSTALL_BIN) - install $(BUILDDIR)/ocamlbuild.native $(INSTALL_BIN)/ocamlbuild - install $(BUILDDIR)/ocamlbuildlight.byte $(INSTALL_BIN)/ocamlbuildlight - install -m 644 \ - $(BUILDDIR)/ocamlbuildlib.cmxa \ - $(BUILDDIR)/ocamlbuildlib.a \ - $(BUILDDIR)/ocamlbuildlib.cma \ - $(BUILDDIR)/ocamlbuildlightlib.cmxa \ - $(BUILDDIR)/ocamlbuildlightlib.a \ - $(BUILDDIR)/ocamlbuildlightlib.cma \ - $(BUILDDIR)/ocamlbuild_unix_plugin.cmx \ - $(BUILDDIR)/ocamlbuild_unix_plugin.o \ - $(BUILDDIR)/ocamlbuild_unix_plugin.cmo \ - $(BUILDDIR)/ocamlbuild_unix_plugin.cmi \ - $(BUILDDIR)/ocamlbuild_executor.cmi \ - $(BUILDDIR)/ocamlbuild_executor.cmo \ - $(BUILDDIR)/ocamlbuild_executor.cmx \ - $(BUILDDIR)/ocamlbuild_executor.o \ - $(BUILDDIR)/ocamlbuild_pack.cmi \ - $(BUILDDIR)/ocamlbuild_pack.cmo \ - $(BUILDDIR)/ocamlbuild_pack.cmx \ - $(BUILDDIR)/ocamlbuild_pack.o \ - $(BUILDDIR)/ocamlbuild.cmi \ - $(BUILDDIR)/ocamlbuild_plugin.cmi \ - $(BUILDDIR)/ocamlbuild.cmx \ - $(BUILDDIR)/ocamlbuild.o \ - $(BUILDDIR)/ocamlbuild.cmo \ - $(BUILDDIR)/ocamlbuildlight.cmx \ - $(BUILDDIR)/ocamlbuildlight.o \ - $(BUILDDIR)/ocamlbuildlight.cmo $(INSTALL_LIB) - ranlib $(INSTALL_LIB)/ocamlbuildlib.a - ranlib $(INSTALL_LIB)/ocamlbuildlightlib.a +include ../config/Makefile + +OCAMLRUN = ../boot/ocamlrun +OCAMLC = ../ocamlcomp.sh +OCAMLOPT = ../ocamlcompopt.sh +OCAMLDEP = $(OCAMLRUN) ../tools/ocamldep +OCAMLLEX = $(OCAMLRUN) ../boot/ocamllex +CP = cp +COMPFLAGS= -warn-error A -w L -w R -w Z -I ../otherlibs/$(UNIXLIB) +LINKFLAGS= -I ../otherlibs/$(UNIXLIB) + +PACK_CMO=\ + loc.cmo \ + discard_printf.cmo \ + signatures.cmi \ + my_std.cmo \ + my_unix.cmo \ + tags.cmo \ + display.cmo \ + log.cmo \ + shell.cmo \ + bool.cmo \ + glob_ast.cmo \ + glob_lexer.cmo \ + glob.cmo \ + lexers.cmo \ + param_tags.cmo \ + command.cmo \ + ocamlbuild_config.cmo \ + ocamlbuild_where.cmo \ + slurp.cmo \ + options.cmo \ + pathname.cmo \ + configuration.cmo \ + flags.cmo \ + hygiene.cmo \ + digest_cache.cmo \ + resource.cmo \ + rule.cmo \ + solver.cmo \ + report.cmo \ + tools.cmo \ + fda.cmo \ + findlib.cmo \ + ocaml_arch.cmo \ + ocaml_utils.cmo \ + ocaml_dependencies.cmo \ + ocaml_compiler.cmo \ + ocaml_tools.cmo \ + ocaml_specific.cmo \ + plugin.cmo \ + exit_codes.cmo \ + hooks.cmo \ + main.cmo + +EXTRA_CMO=\ + ocamlbuild_plugin.cmo \ + ocamlbuild_executor.cmo \ + ocamlbuild_unix_plugin.cmo + +PACK_CMX=$(PACK_CMO:.cmo=.cmx) +EXTRA_CMX=$(EXTRA_CMO:.cmo=.cmx) + +INSTALL_LIB=\ + ocamlbuildlib.cma \ + ocamlbuild.cmo \ + ocamlbuild_pack.cmi \ + $(EXTRA_CMO:.cmo=.cmi) + +INSTALL_LIB_OPT=\ + ocamlbuildlib.cmxa ocamlbuildlib.$(A) \ + ocamlbuild.cmx ocamlbuild.$(O) \ + ocamlbuild_pack.cmx \ + $(EXTRA_CMO:.cmo=.cmx) $(EXTRA_CMO:.cmo=.$(O)) + +all: ocamlbuild.byte ocamlbuildlib.cma + # ocamlbuildlight.byte ocamlbuildlightlib.cma +allopt: ocamlbuild.native ocamlbuildlib.cmxa + +# The executables + +ocamlbuild.byte: ocamlbuild_pack.cmo $(EXTRA_CMO) ocamlbuild.cmo + $(OCAMLC) $(LINKFLAGS) -o ocamlbuild.byte \ + unix.cma ocamlbuild_pack.cmo $(EXTRA_CMO) ocamlbuild.cmo + +ocamlbuildlight.byte: ocamlbuild_pack.cmo ocamlbuildlight.cmo + $(OCAMLC) $(LINKFLAGS) -o ocamlbuildlight.byte \ + ocamlbuild_pack.cmo ocamlbuildlight.cmo + +ocamlbuild.native: ocamlbuild_pack.cmx $(EXTRA_CMX) ocamlbuild.cmx + $(OCAMLOPT) $(LINKFLAGS) -o ocamlbuild.native \ + unix.cmxa ocamlbuild_pack.cmx $(EXTRA_CMX) ocamlbuild.cmx + +# The libraries + +ocamlbuildlib.cma: ocamlbuild_pack.cmo $(EXTRA_CMO) + $(OCAMLC) -a -o ocamlbuildlib.cma \ + ocamlbuild_pack.cmo $(EXTRA_CMO) + +ocamlbuildlightlib.cma: ocamlbuild_pack.cmo ocamlbuildlight.cmo + $(OCAMLC) -a -o ocamlbuildlightlib.cma \ + ocamlbuild_pack.cmo ocamlbuildlight.cmo + +ocamlbuildlib.cmxa: ocamlbuild_pack.cmx $(EXTRA_CMX) + $(OCAMLOPT) -a -o ocamlbuildlib.cmxa \ + ocamlbuild_pack.cmx $(EXTRA_CMX) + +# The packs + +ocamlbuild_pack.cmo ocamlbuild_pack.cmi: $(PACK_CMO) + $(OCAMLC) -pack $(PACK_CMO) -o ocamlbuild_pack.cmo + +ocamlbuild_pack.cmx: $(PACK_CMX) + $(OCAMLOPT) -pack $(PACK_CMX) -o ocamlbuild_pack.cmx + +# The config file + +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 +clean:: + rm -f ocamlbuild_config.ml +beforedepend:: ocamlbuild_config.ml + +# The lexers + +lexers.ml: lexers.mll + $(OCAMLLEX) lexers.mll +clean:: + rm -f lexers.ml +beforedepend:: lexers.ml + +glob_lexer.ml: glob_lexer.mll + $(OCAMLLEX) glob_lexer.mll +clean:: + rm -f glob_lexer.ml +beforedepend:: glob_lexer.ml + +# Installation + +install: + $(CP) ocamlbuild.byte $(BINDIR)/ocamlbuild$(EXE) + $(CP) ocamlbuild.byte $(BINDIR)/ocamlbuild.byte$(EXE) + mkdir -p $(LIBDIR)/ocamlbuild + $(CP) $(INSTALL_LIB) $(LIBDIR)/ocamlbuild/ + +installopt: + if test -f ocamlbuild.native; then $(MAKE) installopt_really; fi + +installopt_really: + $(CP) ocamlbuild.native $(BINDIR)/ocamlbuild$(EXE) + $(CP) ocamlbuild.native $(BINDIR)/ocamlbuild.native$(EXE) + mkdir -p $(LIBDIR)/ocamlbuild + $(CP) $(INSTALL_LIB_OPT) $(LIBDIR)/ocamlbuild/ + +# The generic rules + +.SUFFIXES: .ml .mli .cmo .cmi .cmx + +.ml.cmo: + $(OCAMLC) $(COMPFLAGS) -c $< + +.mli.cmi: + $(OCAMLC) $(COMPFLAGS) -c $< + +.ml.cmx: + $(OCAMLOPT) -for-pack Ocamlbuild_pack $(COMPFLAGS) -c $< + +clean:: + rm -f *.cm? *.$(O) *.cmxa *.$(A) + rm -f *.byte *.native + +# The dependencies + +depend: beforedepend + $(OCAMLDEP) *.mli *.ml > .depend + +include .depend + +.PHONY: all allopt clean beforedepend +.PHONY: install installopt installopt_really depend diff --git a/ocamlbuild/Makefile.noboot b/ocamlbuild/Makefile.noboot index 2543c585e1..0679e0ccd7 100644 --- a/ocamlbuild/Makefile.noboot +++ b/ocamlbuild/Makefile.noboot @@ -17,8 +17,9 @@ include ../config/Makefile # Various commands and dir ########################## -OCAMLC = $(CAMLC_BIN) -nostdlib -I ../stdlib -OCAMLOPT = $(CAMLOPT_BIN) -nostdlib -I ../stdlib +CAMLRUN = ../boot/ocamlrun +OCAMLC = ../ocamlcomp.sh +OCAMLOPT = ../ocamlcompopt.sh OCAMLDEP = $(CAMLRUN) ../tools/ocamldep OCAMLLEX = $(CAMLRUN) ../boot/ocamllex OCAMLLIB = $(LIBDIR) diff --git a/ocamlbuild/ocaml_specific.ml b/ocamlbuild/ocaml_specific.ml index cd852f6264..1b41c0842b 100644 --- a/ocamlbuild/ocaml_specific.ml +++ b/ocamlbuild/ocaml_specific.ml @@ -269,7 +269,7 @@ rule "ocaml: cmo* -> cma" rule "ocaml C stubs: clib & (o|obj)* -> (a|lib) & (so|dll)" ~prods:(["%(path:<**/>)lib%(libname:<*> and not <*.*>)"-.-ext_lib] @ - if Ocamlbuild_Myocamlbuild_config.supports_shared_libraries then + if Ocamlbuild_config.supports_shared_libraries then ["%(path:<**/>)dll%(libname:<*> and not <*.*>)"-.-ext_dll] else []) @@ -573,7 +573,9 @@ let () = (* tags package(X), predicate(X) and syntax(X) *) List.iter begin fun tags -> pflag tags "package" (fun pkg -> S [A "-package"; A pkg]); - pflag tags "predicate" (fun pkg -> S [A "-predicates"; A pkg]); + if not (List.mem "ocamldep" tags) then + (* PR#6184: 'ocamlfind ocamldep' does not support -predicate *) + pflag tags "predicate" (fun pkg -> S [A "-predicates"; A pkg]); pflag tags "syntax" (fun pkg -> S [A "-syntax"; A pkg]) end all_tags end else begin diff --git a/ocamlbuild/ocamlbuild_where.ml b/ocamlbuild/ocamlbuild_where.ml index a05230a51a..6cea4fdff1 100644 --- a/ocamlbuild/ocamlbuild_where.ml +++ b/ocamlbuild/ocamlbuild_where.ml @@ -10,10 +10,10 @@ (* *) (***********************************************************************) -let bindir = ref Ocamlbuild_Myocamlbuild_config.bindir;; +let bindir = ref Ocamlbuild_config.bindir;; let libdir = ref begin Filename.concat (try Sys.getenv "OCAMLLIB" - with Not_found -> Ocamlbuild_Myocamlbuild_config.libdir) + with Not_found -> Ocamlbuild_config.libdir) "ocamlbuild" end;; diff --git a/ocamlbuild/options.ml b/ocamlbuild/options.ml index 4c9d45c09c..78cee63734 100644 --- a/ocamlbuild/options.ml +++ b/ocamlbuild/options.ml @@ -98,10 +98,10 @@ let program_to_execute = ref false let must_clean = ref false let show_documentation = ref false let recursive = ref false -let ext_lib = ref Ocamlbuild_Myocamlbuild_config.a -let ext_obj = ref Ocamlbuild_Myocamlbuild_config.o -let ext_dll = ref Ocamlbuild_Myocamlbuild_config.so -let exe = ref Ocamlbuild_Myocamlbuild_config.exe +let ext_lib = ref Ocamlbuild_config.a +let ext_obj = ref Ocamlbuild_config.o +let ext_dll = ref Ocamlbuild_config.so +let exe = ref Ocamlbuild_config.exe let targets_internal = ref [] let ocaml_libs_internal = ref [] diff --git a/ocamlbuild/plugin.ml b/ocamlbuild/plugin.ml index 6e533bb902..eb831e7223 100644 --- a/ocamlbuild/plugin.ml +++ b/ocamlbuild/plugin.ml @@ -248,6 +248,9 @@ module Make(U:sig end) = let rc = sys_command (Command.string_of_command_spec spec) in raise (Exit_silently_with_code rc); end + else if not (sys_file_exists plugin_file) && !Options.plugin_tags <> [] then + eprintf "Warning: option -plugin-tag(s) has no effect \ + in absence of plugin file %S" plugin_file else () end diff --git a/ocamlbuild/testsuite/findlibonly.ml b/ocamlbuild/testsuite/findlibonly.ml index aea0168e38..7be8b0fddf 100644 --- a/ocamlbuild/testsuite/findlibonly.ml +++ b/ocamlbuild/testsuite/findlibonly.ml @@ -25,4 +25,11 @@ let () = test "SyntaxFlag" ~matching:[M.f "dummy.native"] ~targets:("dummy.native",[]) ();; +let () = test "PredicateFlag" + ~description:"ocamlfind ocamldep does not support the -predicate option" + ~options:[`use_ocamlfind; `tag "\"predicate(byte)\""] + ~tree:[T.f "test.ml" ~content:"let x = List.map"] + ~matching:[_build [M.f "test.ml.depends"]] + ~targets:("test.ml.depends", []) ();; + run ~root:"_test_findlibonly";; diff --git a/ocamlbuild/testsuite/internal.ml b/ocamlbuild/testsuite/internal.ml index b25594f888..5d3c288400 100644 --- a/ocamlbuild/testsuite/internal.ml +++ b/ocamlbuild/testsuite/internal.ml @@ -239,6 +239,16 @@ let () = test "PluginCompilation3" T.f "myocamlbuild.ml" ~content:"print_endline \"foo\";;"] (* if the plugin were executed we'd get "foo" in failing_msg *) ~failing_msg:"" - ~targets:("main,byte", []) ();; + ~targets:("main.byte", []) ();; + +let () = test "PluginTagsWarning" + ~description:"check that a warning is raised if -plugin-tags \ + is used without a plugin file" + ~options:[`no_ocamlfind; `plugin_tag "use_str"] + ~tree:[T.f "main.ml" ~content:""] + ~matching:[_build [M.f "main.cmo"]] + ~failing_msg:"Warning: option -plugin-tag(s) has no effect \ + in absence of plugin file \"myocamlbuild.ml\"" + ~targets:("main.ml", []) ();; run ~root:"_test_internal";; diff --git a/ocamldoc/.depend b/ocamldoc/.depend index 61c131a694..38e932e35b 100644 --- a/ocamldoc/.depend +++ b/ocamldoc/.depend @@ -6,30 +6,22 @@ odoc.cmx : ../typing/typedtree.cmx odoc_messages.cmx odoc_info.cmx \ odoc_global.cmx odoc_gen.cmx odoc_config.cmx odoc_args.cmx \ odoc_analyse.cmx ../utils/misc.cmx ../utils/config.cmx \ ../utils/clflags.cmx -odoc_analyse.cmo : ../utils/warnings.cmi ../typing/typetexp.cmi \ - ../typing/types.cmi ../typing/typemod.cmi ../typing/typedtree.cmi \ - ../typing/typedecl.cmi ../typing/typecore.cmi ../typing/typeclass.cmi \ - ../bytecomp/translcore.cmi ../bytecomp/translclass.cmi \ - ../parsing/syntaxerr.cmi ../driver/pparse.cmi ../parsing/parse.cmi \ - odoc_types.cmi odoc_text.cmi odoc_sig.cmi odoc_module.cmo odoc_misc.cmi \ - odoc_messages.cmo odoc_merge.cmi odoc_global.cmi odoc_dep.cmo \ - odoc_cross.cmi odoc_comments.cmi odoc_class.cmo odoc_ast.cmi \ - ../utils/misc.cmi ../parsing/location.cmi ../parsing/lexer.cmi \ - ../typing/includemod.cmi ../typing/env.cmi ../typing/ctype.cmi \ - ../utils/config.cmi ../typing/cmi_format.cmi ../utils/clflags.cmi \ - odoc_analyse.cmi -odoc_analyse.cmx : ../utils/warnings.cmx ../typing/typetexp.cmx \ - ../typing/types.cmx ../typing/typemod.cmx ../typing/typedtree.cmx \ - ../typing/typedecl.cmx ../typing/typecore.cmx ../typing/typeclass.cmx \ - ../bytecomp/translcore.cmx ../bytecomp/translclass.cmx \ - ../parsing/syntaxerr.cmx ../driver/pparse.cmx ../parsing/parse.cmx \ - odoc_types.cmx odoc_text.cmx odoc_sig.cmx odoc_module.cmx odoc_misc.cmx \ - odoc_messages.cmx odoc_merge.cmx odoc_global.cmx odoc_dep.cmx \ - odoc_cross.cmx odoc_comments.cmx odoc_class.cmx odoc_ast.cmx \ - ../utils/misc.cmx ../parsing/location.cmx ../parsing/lexer.cmx \ - ../typing/includemod.cmx ../typing/env.cmx ../typing/ctype.cmx \ - ../utils/config.cmx ../typing/cmi_format.cmx ../utils/clflags.cmx \ - odoc_analyse.cmi +odoc_analyse.cmo : ../utils/warnings.cmi ../typing/types.cmi \ + ../typing/typemod.cmi ../typing/typedtree.cmi ../parsing/syntaxerr.cmi \ + ../driver/pparse.cmi ../parsing/parse.cmi odoc_types.cmi odoc_text.cmi \ + odoc_sig.cmi odoc_module.cmo odoc_misc.cmi odoc_messages.cmo \ + odoc_merge.cmi odoc_global.cmi odoc_dep.cmo odoc_cross.cmi \ + odoc_comments.cmi odoc_class.cmo odoc_ast.cmi ../utils/misc.cmi \ + ../parsing/location.cmi ../typing/env.cmi ../utils/config.cmi \ + ../utils/clflags.cmi odoc_analyse.cmi +odoc_analyse.cmx : ../utils/warnings.cmx ../typing/types.cmx \ + ../typing/typemod.cmx ../typing/typedtree.cmx ../parsing/syntaxerr.cmx \ + ../driver/pparse.cmx ../parsing/parse.cmx odoc_types.cmx odoc_text.cmx \ + odoc_sig.cmx odoc_module.cmx odoc_misc.cmx odoc_messages.cmx \ + odoc_merge.cmx odoc_global.cmx odoc_dep.cmx odoc_cross.cmx \ + odoc_comments.cmx odoc_class.cmx odoc_ast.cmx ../utils/misc.cmx \ + ../parsing/location.cmx ../typing/env.cmx ../utils/config.cmx \ + ../utils/clflags.cmx odoc_analyse.cmi odoc_args.cmo : odoc_types.cmi odoc_texi.cmo odoc_messages.cmo odoc_man.cmo \ odoc_latex.cmo odoc_html.cmo odoc_global.cmi odoc_gen.cmi odoc_dot.cmo \ odoc_config.cmi ../utils/misc.cmi ../utils/config.cmi odoc_args.cmi @@ -85,11 +77,11 @@ odoc_dep.cmx : ../parsing/parsetree.cmi odoc_type.cmx odoc_print.cmx \ odoc_dot.cmo : odoc_messages.cmo odoc_info.cmi odoc_dot.cmx : odoc_messages.cmx odoc_info.cmx odoc_env.cmo : ../typing/types.cmi ../typing/printtyp.cmi \ - ../typing/predef.cmi ../typing/path.cmi odoc_name.cmi ../typing/btype.cmi \ - odoc_env.cmi + ../typing/predef.cmi ../typing/path.cmi odoc_name.cmi ../utils/misc.cmi \ + ../typing/btype.cmi odoc_env.cmi odoc_env.cmx : ../typing/types.cmx ../typing/printtyp.cmx \ - ../typing/predef.cmx ../typing/path.cmx odoc_name.cmx ../typing/btype.cmx \ - odoc_env.cmi + ../typing/predef.cmx ../typing/path.cmx odoc_name.cmx ../utils/misc.cmx \ + ../typing/btype.cmx odoc_env.cmi odoc_exception.cmo : ../typing/types.cmi odoc_types.cmi odoc_name.cmi odoc_exception.cmx : ../typing/types.cmx odoc_types.cmx odoc_name.cmx odoc_gen.cmo : odoc_texi.cmo odoc_module.cmo odoc_man.cmo odoc_latex.cmo \ @@ -129,9 +121,9 @@ odoc_lexer.cmo : odoc_parser.cmi odoc_messages.cmo odoc_global.cmi \ odoc_lexer.cmx : odoc_parser.cmx odoc_messages.cmx odoc_global.cmx \ odoc_comments_global.cmx odoc_man.cmo : odoc_str.cmi odoc_print.cmi odoc_misc.cmi odoc_messages.cmo \ - odoc_info.cmi ../parsing/asttypes.cmi + odoc_info.cmi ../utils/misc.cmi ../parsing/asttypes.cmi odoc_man.cmx : odoc_str.cmx odoc_print.cmx odoc_misc.cmx odoc_messages.cmx \ - odoc_info.cmx ../parsing/asttypes.cmi + odoc_info.cmx ../utils/misc.cmx ../parsing/asttypes.cmi odoc_merge.cmo : odoc_value.cmo odoc_types.cmi odoc_type.cmo \ odoc_parameter.cmo odoc_name.cmi odoc_module.cmo odoc_messages.cmo \ odoc_global.cmi odoc_exception.cmo odoc_class.cmo odoc_merge.cmi @@ -160,8 +152,10 @@ odoc_parameter.cmo : ../typing/types.cmi odoc_types.cmi odoc_parameter.cmx : ../typing/types.cmx odoc_types.cmx odoc_parser.cmo : odoc_types.cmi odoc_comments_global.cmi odoc_parser.cmi odoc_parser.cmx : odoc_types.cmx odoc_comments_global.cmx odoc_parser.cmi -odoc_print.cmo : ../typing/types.cmi ../typing/printtyp.cmi odoc_print.cmi -odoc_print.cmx : ../typing/types.cmx ../typing/printtyp.cmx odoc_print.cmi +odoc_print.cmo : ../typing/types.cmi ../typing/printtyp.cmi \ + ../utils/misc.cmi odoc_print.cmi +odoc_print.cmx : ../typing/types.cmx ../typing/printtyp.cmx \ + ../utils/misc.cmx odoc_print.cmi odoc_scan.cmo : odoc_value.cmo odoc_types.cmi odoc_type.cmo odoc_module.cmo \ odoc_exception.cmo odoc_class.cmo odoc_scan.cmx : odoc_value.cmx odoc_types.cmx odoc_type.cmx odoc_module.cmx \ diff --git a/ocamldoc/Makefile b/ocamldoc/Makefile index 36fbd82de9..6de33180de 100644 --- a/ocamldoc/Makefile +++ b/ocamldoc/Makefile @@ -14,8 +14,9 @@ include ../config/Makefile # Various commands and dir ########################## -OCAMLC = $(CAMLC_BIN) -nostdlib -I ../stdlib -OCAMLOPT = $(CAMLOPT_BIN) -nostdlib -I ../stdlib +CAMLRUN=../boot/ocamlrun +OCAMLC = ../ocamlcomp.sh +OCAMLOPT = ../ocamlcompopt.sh OCAMLDEP = $(CAMLRUN) ../tools/ocamldep OCAMLLEX = $(CAMLRUN) ../boot/ocamllex OCAMLYACC= ../boot/ocamlyacc diff --git a/ocamldoc/Makefile.nt b/ocamldoc/Makefile.nt index 328a37489c..ff4b3fdc24 100644 --- a/ocamldoc/Makefile.nt +++ b/ocamldoc/Makefile.nt @@ -14,8 +14,9 @@ include ../config/Makefile # Various commands and dir ########################## -OCAMLC = $(CAMLC_BIN) -nostdlib -I ../stdlib -OCAMLOPT = $(CAMLOPT_BIN) -nostdlib -I ../stdlib +CAMLRUN=../boot/ocamlrun +OCAMLC = ../ocamlcomp.sh +OCAMLOPT = ../ocamlcompopt.sh OCAMLDEP = $(CAMLRUN) ../tools/ocamldep OCAMLLEX = $(CAMLRUN) ../boot/ocamllex OCAMLYACC= ../boot/ocamlyacc diff --git a/ocamldoc/generators/odoc_literate.ml b/ocamldoc/generators/odoc_literate.ml index fe993f8c7a..0e2718a301 100644 --- a/ocamldoc/generators/odoc_literate.ml +++ b/ocamldoc/generators/odoc_literate.ml @@ -126,8 +126,8 @@ class html = "a:active {color : Red; text-decoration : underline; }" ; ".keyword { font-weight : bold ; color : Red }" ; ".keywordsign { color : #C04600 }" ; - ".superscript { font-size : 4 }" ; - ".subscript { font-size : 4 }" ; + ".superscript { font-size : 0.6em }" ; + ".subscript { font-size : 0.6em }" ; ".comment { color : Green }" ; ".constructor { color : Blue }" ; ".type { color : #5C6585 }" ; diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml index 6f0a8d572b..18e474a794 100644 --- a/ocamldoc/odoc_ast.ml +++ b/ocamldoc/odoc_ast.ml @@ -1606,18 +1606,25 @@ module Analyser = | (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 ; } diff --git a/ocamldoc/odoc_cross.ml b/ocamldoc/odoc_cross.ml index fcd60dc3bf..70c3c0eb26 100644 --- a/ocamldoc/odoc_cross.ml +++ b/ocamldoc/odoc_cross.ml @@ -950,11 +950,11 @@ and assoc_comments_type module_list t = Type_abstract -> () | Type_variant vl -> List.iter - (fun vc -> vc.vc_text <- ao (assoc_comments_text parent module_list) vc.vc_text) + (fun vc -> vc.vc_text <- ao (assoc_comments_info parent module_list) vc.vc_text) vl | Type_record fl -> List.iter - (fun rf -> rf.rf_text <- ao (assoc_comments_text parent module_list) rf.rf_text) + (fun rf -> rf.rf_text <- ao (assoc_comments_info parent module_list) rf.rf_text) fl ); t diff --git a/ocamldoc/odoc_env.ml b/ocamldoc/odoc_env.ml index 5fd1f05080..02d1e3a211 100644 --- a/ocamldoc/odoc_env.ml +++ b/ocamldoc/odoc_env.ml @@ -220,10 +220,11 @@ let subst_module_type env t = Types.Mty_ident p -> let new_p = Odoc_name.to_path (full_module_type_name env (Odoc_name.from_path p)) in Types.Mty_ident new_p + | Types.Mty_alias _ | 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 diff --git a/ocamldoc/odoc_html.ml b/ocamldoc/odoc_html.ml index a35df03b99..3bee9838b6 100644 --- a/ocamldoc/odoc_html.ml +++ b/ocamldoc/odoc_html.ml @@ -1384,7 +1384,8 @@ class html = (** Print html code to display the type of a module parameter.. *) method html_of_module_parameter_type b m_name p = - self#html_of_module_type b m_name ~code: p.mp_type_code p.mp_type + match p.mp_type with None -> bs b "<code>()</code>" + | Some mty -> self#html_of_module_type b m_name ~code: p.mp_type_code mty (** Generate a file containing the module type in the given file name. *) method output_module_type in_title file mtyp = @@ -1530,7 +1531,7 @@ class html = bs b "(*"; bs b "</code></td>"; bs b "<td class=\"typefieldcomment\" align=\"left\" valign=\"top\" >"; - self#html_of_text b t; + self#html_of_info b (Some t); bs b "</td>"; bs b "<td class=\"typefieldcomment\" align=\"left\" valign=\"bottom\" >"; bs b "<code>"; @@ -1573,7 +1574,7 @@ class html = bs b "(*"; bs b "</code></td>"; bs b "<td class=\"typefieldcomment\" align=\"left\" valign=\"top\" >"; - self#html_of_text b t; + self#html_of_info b (Some t); bs b "</td><td class=\"typefieldcomment\" align=\"left\" valign=\"bottom\" >"; bs b "<code>*)</code></td>"; ); diff --git a/ocamldoc/odoc_info.mli b/ocamldoc/odoc_info.mli index ae888300e6..76e28df64b 100644 --- a/ocamldoc/odoc_info.mli +++ b/ocamldoc/odoc_info.mli @@ -203,7 +203,7 @@ module Type : vc_name : string ; (** Name of the constructor. *) vc_args : Types.type_expr list ; (** Arguments of the constructor. *) vc_ret : Types.type_expr option ; - mutable vc_text : text option ; (** Optional description in the associated comment. *) + mutable vc_text : info option ; (** Optional description in the associated comment. *) } (** Description of a record type field. *) @@ -212,7 +212,7 @@ module Type : rf_name : string ; (** Name of the field. *) rf_mutable : bool ; (** [true] if mutable. *) rf_type : Types.type_expr ; (** Type of the field. *) - mutable rf_text : text option ; (** Optional description in the associated comment.*) + mutable rf_text : info option ; (** Optional description in the associated comment.*) } (** The various kinds of a type. *) @@ -434,7 +434,7 @@ module Module : 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 *) } diff --git a/ocamldoc/odoc_latex.ml b/ocamldoc/odoc_latex.ml index 7d026f46d0..90dba5fa3f 100644 --- a/ocamldoc/odoc_latex.ml +++ b/ocamldoc/odoc_latex.ml @@ -584,7 +584,7 @@ class latex = | Some t -> let s = ps fmt2 "\\begin{ocamldoccomment}\n"; - self#latex_of_text fmt2 t; + self#latex_of_info fmt2 (Some t); ps fmt2 "\n\\end{ocamldoccomment}\n"; flush2 () in @@ -612,7 +612,7 @@ class latex = | Some t -> let s = ps fmt2 "\\begin{ocamldoccomment}\n"; - self#latex_of_text fmt2 t; + self#latex_of_info fmt2 (Some t); ps fmt2 "\n\\end{ocamldoccomment}\n"; flush2 () in diff --git a/ocamldoc/odoc_man.ml b/ocamldoc/odoc_man.ml index 7e01f8d4fb..8a252d6311 100644 --- a/ocamldoc/odoc_man.ml +++ b/ocamldoc/odoc_man.ml @@ -29,6 +29,8 @@ let new_buf () = Buffer.create 1024 let bp = Printf.bprintf let bs = Buffer.add_string +let linebreak = "\n.sp\n";; + (** A class used to get a [text] for info structures. *) class virtual info = object (self) @@ -40,170 +42,193 @@ class virtual info = (** Return man code for a [text]. *) method virtual man_of_text : Buffer.t -> Odoc_info.text -> unit + method str_man_of_text t = + let b = Buffer.create 256 in + self#man_of_text b t ; + Buffer.contents b + (** Print groff string for an author list. *) - method man_of_author_list b l = + method str_man_of_author_list l = match l with - [] -> () + [] -> "" | _ -> + let b = Buffer.create 256 in bs b ".B \""; bs b Odoc_messages.authors; bs b "\"\n:\n"; bs b (String.concat ", " l); - bs b "\n.sp\n" + bs b "\n"; + (*bs b "\n.sp\n"*) + Buffer.contents b (** Print groff string for the given optional version information.*) - method man_of_version_opt b v_opt = + method str_man_of_version_opt v_opt = match v_opt with - None -> () + None -> "" | Some v -> + let b = Buffer.create 256 in bs b ".B \""; bs b Odoc_messages.version; bs b "\"\n:\n"; bs b v; - bs b "\n.sp\n" + bs b "\n"; + (*".sp\n"*) + Buffer.contents b (** Printf groff string for the \@before information. *) - method man_of_before b = function - [] -> () + method str_man_of_before = function + [] -> "" | l -> - List.iter - (fun (v, text) -> + let b = Buffer.create 256 in + let rec iter = function + [] -> () + | (v, text) :: q -> bp b ".B \"%s" Odoc_messages.before; bs b v; bs b "\"\n"; self#man_of_text b text; bs b "\n"; - bs b "\n.sp\n" - ) - l - + bs b "\n"; + match q with + [] -> () + | _ -> bs b linebreak ; iter q + in + iter l; + Buffer.contents b (** Print groff string for the given optional since information.*) - method man_of_since_opt b s_opt = + method str_man_of_since_opt s_opt = match s_opt with - None -> () + None -> "" | Some s -> + let b = Buffer.create 256 in bs b ".B \""; bs b Odoc_messages.since; bs b "\"\n"; bs b s; - bs b "\n.sp\n" + bs b "\n";(*".sp\n"*) + Buffer.contents b (** Print groff string for the given list of raised exceptions.*) - method man_of_raised_exceptions b l = + method str_man_of_raised_exceptions l = match l with - [] -> () - | (s, t) :: [] -> - bs b ".B \""; - bs b Odoc_messages.raises; - bs b (" "^s^"\"\n"); - self#man_of_text b t; - bs b "\n.sp\n" + [] -> "" | _ -> - bs b ".B \""; - bs b Odoc_messages.raises; - bs b "\"\n"; - List.iter - (fun (ex, desc) -> - bs b ".sp\n.B \""; - bs b ex; - bs b "\"\n"; - self#man_of_text b desc; - bs b "\n" - ) - l; - bs b "\n.sp\n" + let b = Buffer.create 256 in + let rec iter = function + [] -> () + | (s, t) :: q -> + bs b ".B \""; + bs b Odoc_messages.raises; + bs b (" "^s^"\"\n"); + self#man_of_text b t; + bs b "\n"; + match q with + [] -> () + | _ -> bs b linebreak; iter q + in + iter l; + Buffer.contents b (** Print groff string for the given "see also" reference. *) - method man_of_see b (see_ref, t) = + method str_man_of_see (see_ref, t) = let t_ref = match see_ref with Odoc_info.See_url s -> [ Odoc_info.Link (s, t) ] | Odoc_info.See_file s -> (Odoc_info.Code s) :: (Odoc_info.Raw " ") :: t | Odoc_info.See_doc s -> (Odoc_info.Italic [Odoc_info.Raw s]) :: (Odoc_info.Raw " ") :: t in - self#man_of_text b t_ref + self#str_man_of_text t_ref (** Print groff string for the given list of "see also" references.*) - method man_of_sees b l = + method str_man_of_sees l = match l with - [] -> () - | see :: [] -> - bs b ".B \""; - bs b Odoc_messages.see_also; - bs b "\"\n"; - self#man_of_see b see; - bs b "\n.sp\n" + [] -> "" | _ -> - bs b ".B \""; - bs b Odoc_messages.see_also; - bs b "\"\n"; - List.iter - (fun see -> - bs b ".sp\n"; - self#man_of_see b see; - bs b "\n" - ) - l; - bs b "\n.sp\n" + let b = Buffer.create 256 in + let rec iter = function + [] -> () + | see :: q -> + bs b ".B \""; + bs b Odoc_messages.see_also; + bs b "\"\n"; + bs b (self#str_man_of_see see); + bs b "\n"; + match q with + [] -> () + | _ -> bs b linebreak; iter q + in + iter l; + Buffer.contents b (** Print groff string for the given optional return information.*) - method man_of_return_opt b return_opt = + method str_man_of_return_opt return_opt = match return_opt with - None -> () + None -> "" | Some s -> + let b = Buffer.create 256 in bs b ".B "; bs b Odoc_messages.returns; bs b "\n"; self#man_of_text b s; - bs b "\n.sp\n" + bs b "\n"; + Buffer.contents b (** Print man code for the given list of custom tagged texts. *) - method man_of_custom b l = - let buf = Buffer.create 50 in - List.iter - (fun (tag, text) -> - try - let f = List.assoc tag tag_functions in - Buffer.add_string buf (f text) + method str_man_of_custom l = + List.fold_left + (fun acc (tag, text) -> + try + let f = List.assoc tag tag_functions in + let buf = Buffer.create 50 in + Buffer.add_string buf (f text); + (Buffer.contents buf) :: acc with Not_found -> - Odoc_info.warning (Odoc_messages.tag_not_handled tag) + Odoc_info.warning (Odoc_messages.tag_not_handled tag); + acc ) - l + [] l (** Print the groff string to display an optional info structure. *) - method man_of_info b info_opt = + method man_of_info ?(margin=0) b info_opt = match info_opt with None -> () | Some info -> let module M = Odoc_info in - ( + let l = + ( match info.M.i_deprecated with - None -> () + None -> [] | Some d -> + let b = Buffer.create 256 in bs b ".B \""; bs b Odoc_messages.deprecated; bs b "\"\n"; self#man_of_text b d; - bs b "\n.sp\n" - ); - ( - match info.M.i_desc with - None -> () - | Some d when d = [Odoc_info.Raw ""] -> () - | Some d -> - self#man_of_text b d; - bs b "\n.sp\n" - ); - self#man_of_author_list b info.M.i_authors; - self#man_of_version_opt b info.M.i_version; - self#man_of_before b info.M.i_before; - self#man_of_since_opt b info.M.i_since; - self#man_of_raised_exceptions b info.M.i_raised_exceptions; - self#man_of_return_opt b info.M.i_return_value; - self#man_of_sees b info.M.i_sees; - self#man_of_custom b info.M.i_custom + bs b "\n"; + [ Buffer.contents b ] + ) @ + ( + match info.M.i_desc with + None -> [] + | Some d when d = [Odoc_info.Raw ""] -> [] + | Some d -> + [ (self#str_man_of_text d)^"\n" ] + ) @ + [ + self#str_man_of_author_list info.M.i_authors; + self#str_man_of_version_opt info.M.i_version; + self#str_man_of_before info.M.i_before; + self#str_man_of_since_opt info.M.i_since; + self#str_man_of_raised_exceptions info.M.i_raised_exceptions; + self#str_man_of_return_opt info.M.i_return_value; + self#str_man_of_sees info.M.i_sees; + ] @ + (self#str_man_of_custom info.M.i_custom) + in + let l = List.filter ((<>) "") l in + Buffer.add_string b (String.concat "\n.sp\n" l) end module Generator = @@ -463,9 +488,9 @@ class man = match constr.vc_args, constr.vc_text,constr.vc_ret with | [], None, None -> bs b "\n " | [], (Some t), None -> - bs b " (* "; - self#man_of_text b t; - bs b " *)\n " + bs b " (*\n"; + self#man_of_info b (Some t); + bs b "*)\n " | l, None, None -> bs b "\n.B of "; self#man_of_type_expr_list ~par: false b father " * " l; @@ -474,9 +499,9 @@ class man = bs b "\n.B of "; self#man_of_type_expr_list ~par: false b father " * " l; bs b ".I \" \"\n"; - bs b "(* "; - self#man_of_text b t; - bs b " *)\n " + bs b "(*\n"; + self#man_of_info b (Some t); + bs b "*)\n" | [], None, Some r -> bs b "\n.B : "; self#man_of_type_expr b father r; @@ -485,9 +510,9 @@ class man = bs b "\n.B : "; self#man_of_type_expr b father r; bs b ".I \" \"\n"; - bs b "(* "; - self#man_of_text b t; - bs b " *)\n " + bs b "(*\n"; + self#man_of_info b (Some t); + bs b "*)\n " | l, None, Some r -> bs b "\n.B : "; self#man_of_type_expr_list ~par: false b father " * " l; @@ -500,9 +525,9 @@ class man = bs b ".B -> "; self#man_of_type_expr b father r; bs b ".I \" \"\n"; - bs b "(* "; - self#man_of_text b t; - bs b " *)\n " + bs b "(*\n"; + self#man_of_info b (Some t); + bs b "*)\n " ) ) l @@ -520,9 +545,9 @@ class man = match r.rf_text with None -> () | Some t -> - bs b " (* "; - self#man_of_text b t; - bs b " *) " + bs b " (*\n"; + self#man_of_info b (Some t); + bs b "*) " ); ) l; @@ -612,7 +637,7 @@ class man = (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 diff --git a/ocamldoc/odoc_merge.ml b/ocamldoc/odoc_merge.ml index 1e94c27377..eda6491ec9 100644 --- a/ocamldoc/odoc_merge.ml +++ b/ocamldoc/odoc_merge.ml @@ -245,7 +245,7 @@ let merge_types merge_options mli ml = | None, Some d -> Some d | Some d1, Some d2 -> if List.mem Merge_description merge_options then - Some (d1 @ d2) + Some (merge_info merge_options d1 d2) else Some d1 in @@ -273,7 +273,7 @@ let merge_types merge_options mli ml = | None, Some d -> Some d | Some d1, Some d2 -> if List.mem Merge_description merge_options then - Some (d1 @ d2) + Some (merge_info merge_options d1 d2) else Some d1 in diff --git a/ocamldoc/odoc_module.ml b/ocamldoc/odoc_module.ml index 216f1cfb38..b1bedfa77f 100644 --- a/ocamldoc/odoc_module.ml +++ b/ocamldoc/odoc_module.ml @@ -46,7 +46,7 @@ and module_alias = { 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 *) } diff --git a/ocamldoc/odoc_print.ml b/ocamldoc/odoc_print.ml index aa6dea1281..3fa826af97 100644 --- a/ocamldoc/odoc_print.ml +++ b/ocamldoc/odoc_print.ml @@ -55,6 +55,7 @@ let simpl_module_type ?code t = let rec iter t = match t with Types.Mty_ident p -> t + | Types.Mty_alias p -> t | Types.Mty_signature _ -> ( match code with @@ -62,7 +63,7 @@ let simpl_module_type ?code t = | 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 diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml index 6f6eaedf12..6279384537 100644 --- a/ocamldoc/odoc_sig.ml +++ b/ocamldoc/odoc_sig.ml @@ -222,10 +222,7 @@ module Analyser = let f {Types.cd_id=constructor_name;cd_args=type_expr_list;cd_res=ret_type} = let constructor_name = Ident.name constructor_name in let comment_opt = - try - match List.assoc constructor_name name_comment_list with - None -> None - | Some d -> d.Odoc_types.i_desc + try List.assoc constructor_name name_comment_list with Not_found -> None in { @@ -241,10 +238,7 @@ module Analyser = let f {Types.ld_id=field_name;ld_mutable=mutable_flag;ld_type=type_expr} = let field_name = Ident.name field_name in let comment_opt = - try - match List.assoc field_name name_comment_list with - None -> None - | Some d -> d.Odoc_types.i_desc + try List.assoc field_name name_comment_list with Not_found -> None in { @@ -876,6 +870,8 @@ module Analyser = let rec f = function Parsetree.Pmty_ident longident -> Name.from_longident longident.txt + | Parsetree.Pmty_alias longident -> + Name.from_longident longident.txt | Parsetree.Pmty_signature _ -> "??" | Parsetree.Pmty_functor _ -> @@ -1066,6 +1062,16 @@ module Analyser = Module_type_alias { mta_name = Odoc_env.full_module_type_name env name ; mta_module = None } + | Parsetree.Pmty_alias longident -> + let name = + match sig_module_type with + Types.Mty_alias path -> Name.from_path path + | _ -> Name.from_longident longident.txt + in + (* Wrong naming... *) + Module_type_alias { mta_name = Odoc_env.full_module_name env name ; + mta_module = None } + | Parsetree.Pmty_signature ast -> ( let ast = filter_out_erased_items_from_signature erased ast in @@ -1082,19 +1088,26 @@ module Analyser = | 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 ; } @@ -1135,7 +1148,8 @@ module Analyser = and analyse_module_kind ?(erased = Name.Set.empty) env current_module_name module_type sig_module_type = match module_type.Parsetree.pmty_desc with - Parsetree.Pmty_ident longident -> + Parsetree.Pmty_ident longident + | Parsetree.Pmty_alias longident -> let k = analyse_module_type_kind env current_module_name module_type sig_module_type in Module_with ( k, "" ) @@ -1161,17 +1175,23 @@ module Analyser = ( 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 ; } diff --git a/ocamldoc/odoc_str.ml b/ocamldoc/odoc_str.ml index b36ad95965..3c45c50705 100644 --- a/ocamldoc/odoc_str.ml +++ b/ocamldoc/odoc_str.ml @@ -201,7 +201,7 @@ let string_of_type t = None -> "" | Some t -> - "(* "^(Odoc_misc.string_of_text t)^" *)" + "(* "^(Odoc_misc.string_of_info t)^" *)" )^"\n" ) l @@ -219,7 +219,7 @@ let string_of_type t = None -> "" | Some t -> - "(* "^(Odoc_misc.string_of_text t)^" *)" + "(* "^(Odoc_misc.string_of_info t)^" *)" )^"\n" ) l diff --git a/ocamldoc/odoc_texi.ml b/ocamldoc/odoc_texi.ml index 067586b826..95354caac8 100644 --- a/ocamldoc/odoc_texi.ml +++ b/ocamldoc/odoc_texi.ml @@ -676,8 +676,8 @@ class texi = (match constr.vc_text with | None -> [ Newline ] | Some t -> - (Raw (indent 5 "\n(* ") :: - self#soft_fix_linebreaks 8 t) @ + (Raw (indent 5 "\n(*\n ") :: + self#soft_fix_linebreaks 8 (self#text_of_info (Some t))) @ [ Raw " *)" ; Newline ] ) ) l ) ) | Type_record l -> @@ -693,7 +693,8 @@ class texi = (match r.rf_text with | None -> [ Newline ] | Some t -> - ((Raw (indent 5 "\n(* ")) :: (self#soft_fix_linebreaks 8 t)) @ + ((Raw (indent 5 "\n(*\n ")) :: + (self#soft_fix_linebreaks 8 (self#text_of_info (Some t)))) @ [ Raw " *)" ; Newline ] ) ) l ) ) @ [ Raw " }" ] diff --git a/ocamldoc/odoc_to_text.ml b/ocamldoc/odoc_to_text.ml index 7b08417e7e..c913875704 100644 --- a/ocamldoc/odoc_to_text.ml +++ b/ocamldoc/odoc_to_text.ml @@ -428,8 +428,11 @@ class virtual to_text = 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) diff --git a/ocamldoc/odoc_type.ml b/ocamldoc/odoc_type.ml index fefd007c86..ef9699e607 100644 --- a/ocamldoc/odoc_type.ml +++ b/ocamldoc/odoc_type.ml @@ -22,7 +22,7 @@ type variant_constructor = { vc_name : string ; vc_args : Types.type_expr list ; (** arguments of the constructor *) vc_ret : Types.type_expr option ; - mutable vc_text : Odoc_types.text option ; (** optional user description *) + mutable vc_text : Odoc_types.info option ; (** optional user description *) } (** Description of a record type field. *) @@ -30,7 +30,7 @@ type record_field = { rf_name : string ; rf_mutable : bool ; (** true if mutable *) rf_type : Types.type_expr ; - mutable rf_text : Odoc_types.text option ; (** optional user description *) + mutable rf_text : Odoc_types.info option ; (** optional user description *) } (** The various kinds of type. *) diff --git a/otherlibs/Makefile b/otherlibs/Makefile index 274b9583ad..6c3e58aa65 100644 --- a/otherlibs/Makefile +++ b/otherlibs/Makefile @@ -13,11 +13,9 @@ # Common Makefile for otherlibs on the Unix ports -CAMLC=$(CAMLC_BIN) -nostdlib -I ../../stdlib -CAMLOPT=$(CAMLOPT_BIN) -nostdlib -I ../../stdlib -CAMLC_BIN_CMD=$$($(CAMLC_BIN_CMD_TO_EVAL) -nostdlib -I ../../stdlib) -CAMLOPT_BIN_CMD=$$($(CAMLOPT_BIN_CMD_TO_EVAL) -nostdlib -I ../../stdlib) -CFLAGS=-I../../byterun -O $(SHAREDCCCOMPOPTS) $(EXTRACFLAGS) +CAMLC=$(ROOTDIR)/ocamlcomp.sh +CAMLOPT=$(ROOTDIR)/ocamlcompopt.sh +CFLAGS=-I$(ROOTDIR)/byterun -O $(SHAREDCCCOMPOPTS) $(EXTRACFLAGS) include ../Makefile.shared # Note .. is the current directory (this makefile is included from diff --git a/otherlibs/Makefile.nt b/otherlibs/Makefile.nt index f3e7f200da..aafb4217cb 100644 --- a/otherlibs/Makefile.nt +++ b/otherlibs/Makefile.nt @@ -13,11 +13,9 @@ # Common Makefile for otherlibs on the Win32/MinGW ports -CAMLC=$(CAMLC_BIN) -nostdlib -I ../../stdlib -w s -CAMLOPT=$(CAMLOPT_BIN) -nostdlib -I ../../stdlib -w s -CAMLC_BIN_CMD=$(shell cygpath -m $(shell $(CAMLC_BIN_CMD_TO_EVAL))) -nostdlib -I ../../stdlib -CAMLOPT_BIN_CMD=$(shell cygpath -m $(shell $(CAMLOPT_BIN_CMD_TO_EVAL))) -nostdlib -I ../../stdlib -CFLAGS=-I../../byterun $(SHAREDCCCOMPOPTS) $(EXTRACFLAGS) +CAMLC=$(CAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib -w s +CAMLOPT=$(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib -w s +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 1163f9e6c2..751a15870d 100644 --- a/otherlibs/Makefile.shared +++ b/otherlibs/Makefile.shared @@ -13,12 +13,14 @@ # Common Makefile for otherlibs -include ../../config/Makefile +ROOTDIR=../.. +include $(ROOTDIR)/config/Makefile # Compilation options CC=$(BYTECC) -COMPFLAGS=-w +33..39 -warn-error A -g $(EXTRACAMLFLAGS) -MKLIB=$(CAMLRUN) ../../tools/ocamlmklib +CAMLRUN=$(ROOTDIR)/boot/ocamlrun +COMPFLAGS=-w +33..39 -warn-error A -bin-annot -g $(EXTRACAMLFLAGS) +MKLIB=$(CAMLRUN) $(ROOTDIR)/tools/ocamlmklib # Variables to be defined by individual libraries: #LIBNAME= @@ -41,12 +43,12 @@ all: lib$(CLIBNAME).$(A) $(LIBNAME).cma $(CMIFILES) allopt: lib$(CLIBNAME).$(A) $(LIBNAME).cmxa $(LIBNAME).$(CMXS) $(CMIFILES) $(LIBNAME).cma: $(CAMLOBJS) - $(MKLIB) -o $(LIBNAME) -oc $(CLIBNAME) -ocamlc "$(CAMLC_BIN_CMD)" \ - -linkall $(CAMLOBJS) $(LINKOPTS) + $(MKLIB) -o $(LIBNAME) -oc $(CLIBNAME) -ocamlc '$(CAMLC)' -linkall \ + $(CAMLOBJS) $(LINKOPTS) $(LIBNAME).cmxa: $(CAMLOBJS_NAT) - $(MKLIB) -o $(LIBNAME) -oc $(CLIBNAME) -ocamlopt "$(CAMLOPT_BIN_CMD)" \ - -linkall $(CAMLOBJS_NAT) $(LINKOPTS) + $(MKLIB) -o $(LIBNAME) -oc $(CLIBNAME) -ocamlopt '$(CAMLOPT)' -linkall \ + $(CAMLOBJS_NAT) $(LINKOPTS) $(LIBNAME).cmxs: $(LIBNAME).cmxa lib$(CLIBNAME).$(A) $(CAMLOPT) -shared -o $(LIBNAME).cmxs -I . $(LIBNAME).cmxa diff --git a/otherlibs/bigarray/.depend b/otherlibs/bigarray/.depend index d705f2022e..4df63a3e32 100644 --- a/otherlibs/bigarray/.depend +++ b/otherlibs/bigarray/.depend @@ -1,21 +1,21 @@ 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 ../../byterun/int64_native.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 ../../byterun/int64_native.h mmap_unix.o: mmap_unix.c bigarray.h ../../byterun/config.h \ - ../../byterun/../config/m.h ../../byterun/../config/s.h \ - ../../byterun/mlvalues.h ../../byterun/config.h ../../byterun/misc.h \ - ../../byterun/custom.h ../../byterun/mlvalues.h ../../byterun/fail.h \ - ../../byterun/io.h ../../byterun/sys.h ../../byterun/signals.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 + ../../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.cmi : bigarray.cmo : bigarray.cmi bigarray.cmx : bigarray.cmi diff --git a/otherlibs/bigarray/bigarray.h b/otherlibs/bigarray/bigarray.h index 26fdcc9ed1..c10e20cfb3 100644 --- a/otherlibs/bigarray/bigarray.h +++ b/otherlibs/bigarray/bigarray.h @@ -44,15 +44,25 @@ enum caml_ba_kind { CAML_BA_NATIVE_INT, /* Platform-native long integers (32 or 64 bits) */ CAML_BA_COMPLEX32, /* Single-precision complex */ CAML_BA_COMPLEX64, /* Double-precision complex */ + CAML_BA_CHAR, /* Characters */ CAML_BA_KIND_MASK = 0xFF /* Mask for kind in flags field */ }; +#define Caml_ba_kind_val(v) Int_val(v) + +#define Val_caml_ba_kind(k) Val_int(k) + enum caml_ba_layout { CAML_BA_C_LAYOUT = 0, /* Row major, indices start at 0 */ CAML_BA_FORTRAN_LAYOUT = 0x100, /* Column major, indices start at 1 */ - CAML_BA_LAYOUT_MASK = 0x100 /* Mask for layout in flags field */ + CAML_BA_LAYOUT_MASK = 0x100, /* Mask for layout in flags field */ + CAML_BA_LAYOUT_SHIFT = 8 /* Bit offset of layout flag */ }; +#define Caml_ba_layout_val(v) (Int_val(v) << CAML_BA_LAYOUT_SHIFT) + +#define Val_caml_ba_layout(l) Val_int(l >> CAML_BA_LAYOUT_SHIFT) + enum caml_ba_managed { CAML_BA_EXTERNAL = 0, /* Data is not allocated by OCaml */ CAML_BA_MANAGED = 0x200, /* Data is allocated by OCaml */ diff --git a/otherlibs/bigarray/bigarray.ml b/otherlibs/bigarray/bigarray.ml index 0aea1f4cba..960c972416 100644 --- a/otherlibs/bigarray/bigarray.ml +++ b/otherlibs/bigarray/bigarray.ml @@ -17,48 +17,63 @@ external init : unit -> unit = "caml_ba_init" let _ = init() -type ('a, 'b) kind = int +type float32_elt = Float32_elt +type float64_elt = Float64_elt +type int8_signed_elt = Int8_signed_elt +type int8_unsigned_elt = Int8_unsigned_elt +type int16_signed_elt = Int16_signed_elt +type int16_unsigned_elt = Int16_unsigned_elt +type int32_elt = Int32_elt +type int64_elt = Int64_elt +type int_elt = Int_elt +type nativeint_elt = Nativeint_elt +type complex32_elt = Complex32_elt +type complex64_elt = Complex64_elt -type int8_signed_elt -type int8_unsigned_elt -type int16_signed_elt -type int16_unsigned_elt -type int_elt -type int32_elt -type int64_elt -type nativeint_elt -type float32_elt -type float64_elt -type complex32_elt -type complex64_elt +type ('a, 'b) kind = + Float32 : (float, float32_elt) kind + | Float64 : (float, float64_elt) kind + | Int8_signed : (int, int8_signed_elt) kind + | Int8_unsigned : (int, int8_unsigned_elt) kind + | Int16_signed : (int, int16_signed_elt) kind + | Int16_unsigned : (int, int16_unsigned_elt) kind + | Int32 : (int32, int32_elt) kind + | Int64 : (int64, int64_elt) kind + | Int : (int, int_elt) kind + | Nativeint : (nativeint, nativeint_elt) kind + | Complex32 : (Complex.t, complex32_elt) kind + | Complex64 : (Complex.t, complex64_elt) kind + | Char : (char, int8_unsigned_elt) kind (* Keep those constants in sync with the caml_ba_kind enumeration in bigarray.h *) -let float32 = 0 -let float64 = 1 -let int8_signed = 2 -let int8_unsigned = 3 -let int16_signed = 4 -let int16_unsigned = 5 -let int32 = 6 -let int64 = 7 -let int = 8 -let nativeint = 9 -let char = int8_unsigned -let complex32 = 10 -let complex64 = 11 +let float32 = Float32 +let float64 = Float64 +let int8_signed = Int8_signed +let int8_unsigned = Int8_unsigned +let int16_signed = Int16_signed +let int16_unsigned = Int16_unsigned +let int32 = Int32 +let int64 = Int64 +let int = Int +let nativeint = Nativeint +let complex32 = Complex32 +let complex64 = Complex64 +let char = Char -type 'a layout = int +type c_layout = C_layout_typ +type fortran_layout = Fortran_layout_typ -type c_layout -type fortran_layout +type 'a layout = + C_layout: c_layout layout + | Fortran_layout: fortran_layout layout (* Keep those constants in sync with the caml_ba_layout enumeration in bigarray.h *) -let c_layout = 0 -let fortran_layout = 0x100 +let c_layout = C_layout +let fortran_layout = Fortran_layout module Genarray = struct type ('a, 'b, 'c) t @@ -114,9 +129,13 @@ module Array1 = struct external sub: ('a, 'b, 'c) t -> int -> int -> ('a, 'b, 'c) t = "caml_ba_sub" external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit" external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill" - let of_array kind layout data = + let of_array (type t) kind (layout: t layout) data = let ba = create kind layout (Array.length data) in - let ofs = if layout = c_layout then 0 else 1 in + let ofs = + match layout with + C_layout -> 0 + | Fortran_layout -> 1 + in for i = 0 to Array.length data - 1 do unsafe_set ba (i + ofs) data.(i) done; ba let map_file fd ?pos kind layout shared dim = @@ -146,11 +165,15 @@ module Array2 = struct let slice_right a n = Genarray.slice_right a [|n|] external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit" external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill" - let of_array kind layout data = + let of_array (type t) kind (layout: t layout) data = let dim1 = Array.length data in let dim2 = if dim1 = 0 then 0 else Array.length data.(0) in let ba = create kind layout dim1 dim2 in - let ofs = if layout = c_layout then 0 else 1 in + let ofs = + match layout with + C_layout -> 0 + | Fortran_layout -> 1 + in for i = 0 to dim1 - 1 do let row = data.(i) in if Array.length row <> dim2 then @@ -191,12 +214,16 @@ module Array3 = struct let slice_right_2 a n = Genarray.slice_right a [|n|] external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit" external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill" - let of_array kind layout data = + let of_array (type t) kind (layout: t layout) data = let dim1 = Array.length data in let dim2 = if dim1 = 0 then 0 else Array.length data.(0) in let dim3 = if dim2 = 0 then 0 else Array.length data.(0).(0) in let ba = create kind layout dim1 dim2 dim3 in - let ofs = if layout = c_layout then 0 else 1 in + let ofs = + match layout with + C_layout -> 0 + | Fortran_layout -> 1 + in for i = 0 to dim1 - 1 do let row = data.(i) in if Array.length row <> dim2 then diff --git a/otherlibs/bigarray/bigarray.mli b/otherlibs/bigarray/bigarray.mli index eb9f3c5c3a..058c25904a 100644 --- a/otherlibs/bigarray/bigarray.mli +++ b/otherlibs/bigarray/bigarray.mli @@ -52,24 +52,38 @@ - platform-native signed integers (32 bits on 32-bit architectures, 64 bits on 64-bit architectures) ({!Bigarray.nativeint_elt}). - Each element kind is represented at the type level by one - of the abstract types defined below. + Each element kind is represented at the type level by one of the + [*_elt] types defined below (defined with a single constructor instead + of abstract types for technical injectivity reasons). *) -type float32_elt -type float64_elt -type complex32_elt -type complex64_elt -type int8_signed_elt -type int8_unsigned_elt -type int16_signed_elt -type int16_unsigned_elt -type int_elt -type int32_elt -type int64_elt -type nativeint_elt - -type ('a, 'b) kind +type float32_elt = Float32_elt +type float64_elt = Float64_elt +type int8_signed_elt = Int8_signed_elt +type int8_unsigned_elt = Int8_unsigned_elt +type int16_signed_elt = Int16_signed_elt +type int16_unsigned_elt = Int16_unsigned_elt +type int32_elt = Int32_elt +type int64_elt = Int64_elt +type int_elt = Int_elt +type nativeint_elt = Nativeint_elt +type complex32_elt = Complex32_elt +type complex64_elt = Complex64_elt + +type ('a, 'b) kind = + Float32 : (float, float32_elt) kind + | Float64 : (float, float64_elt) kind + | Int8_signed : (int, int8_signed_elt) kind + | Int8_unsigned : (int, int8_unsigned_elt) kind + | Int16_signed : (int, int16_signed_elt) kind + | Int16_unsigned : (int, int16_unsigned_elt) kind + | Int32 : (int32, int32_elt) kind + | Int64 : (int64, int64_elt) kind + | Int : (int, int_elt) kind + | Nativeint : (nativeint, nativeint_elt) kind + | Complex32 : (Complex.t, complex32_elt) kind + | Complex64 : (Complex.t, complex64_elt) kind + | Char : (char, int8_unsigned_elt) kind (** To each element kind is associated an OCaml type, which is the type of OCaml values that can be stored in the big array or read back from it. This type is not necessarily the same @@ -79,12 +93,28 @@ type ('a, 'b) kind its elements from OCaml uses the OCaml type [float], which is 64-bit double precision floats. - The abstract type [('a, 'b) kind] captures this association + The GADT type [('a, 'b) kind] captures this association of an OCaml type ['a] for values read or written in the big array, and of an element kind ['b] which represents the actual contents - of the big array. The following predefined values of type - [kind] list all possible associations of OCaml types with - element kinds: *) + of the big array. Its constructors list all possible associations + of OCaml types with element kinds, and are re-exported below for + backward-compatibility reasons. + + Using a generalized algebraic datatype (GADT) here allows to write + well-typed polymorphic functions whose return type depend on the + argument type, such as: + +{[ + let zero : type a b. (a, b) kind -> a = function + | Float32 -> 0.0 | Complex32 -> Complex.zero + | Float64 -> 0.0 | Complex64 -> Complex.zero + | Int8_signed -> 0 | Int8_unsigned -> 0 + | Int16_signed -> 0 | Int16_unsigned -> 0 + | Int32 -> 0l | Int64 -> 0L + | Int -> 0 | Nativeint -> 0n + | Char -> '\000' +]} +*) val float32 : (float, float32_elt) kind (** See {!Bigarray.char}. *) @@ -127,7 +157,7 @@ val char : (char, int8_unsigned_elt) kind big arrays of kind [float32_elt] and [float64_elt] are accessed using the OCaml type [float]. Big arrays of complex kinds [complex32_elt], [complex64_elt] are accessed with the OCaml type - {!Complex.t}. Big arrays of + {!Complex.t}. Big arrays of integer kinds are accessed using the smallest OCaml integer type large enough to represent the array elements: [int] for 8- and 16-bit integer bigarrays, as well as OCaml-integer @@ -140,10 +170,10 @@ val char : (char, int8_unsigned_elt) kind (** {6 Array layouts} *) -type c_layout +type c_layout = C_layout_typ (** See {!Bigarray.fortran_layout}.*) -type fortran_layout +type fortran_layout = Fortran_layout_typ (** To facilitate interoperability with existing C and Fortran code, this library supports two different memory layouts for big arrays, one compatible with the C conventions, @@ -164,20 +194,20 @@ type fortran_layout and [(x+1, y)] are adjacent in memory. Each layout style is identified at the type level by the - abstract types {!Bigarray.c_layout} and [fortran_layout] respectively. *) - -type 'a layout -(** The type ['a layout] represents one of the two supported - memory layouts: C-style if ['a] is {!Bigarray.c_layout}, Fortran-style - if ['a] is {!Bigarray.fortran_layout}. *) - + phantom types {!Bigarray.c_layout} and {!Bigarray.fortran_layout} + respectively. *) (** {7 Supported layouts} - The abstract values [c_layout] and [fortran_layout] represent - the two supported layouts at the level of values. + The GADT type ['a layout] represents one of the two supported + memory layouts: C-style or Fortran-style. Its constructors are + re-exported as values below for backward-compatibility reasons. *) +type 'a layout = + C_layout: c_layout layout + | Fortran_layout: fortran_layout layout + val c_layout : c_layout layout val fortran_layout : fortran_layout layout diff --git a/otherlibs/bigarray/bigarray_stubs.c b/otherlibs/bigarray/bigarray_stubs.c index f30fa4cc94..b8c768afa6 100644 --- a/otherlibs/bigarray/bigarray_stubs.c +++ b/otherlibs/bigarray/bigarray_stubs.c @@ -50,7 +50,8 @@ int caml_ba_element_size[] = 2 /*SINT16*/, 2 /*UINT16*/, 4 /*INT32*/, 8 /*INT64*/, sizeof(value) /*CAML_INT*/, sizeof(value) /*NATIVE_INT*/, - 8 /*COMPLEX32*/, 16 /*COMPLEX64*/ + 8 /*COMPLEX32*/, 16 /*COMPLEX64*/, + 1 /*CHAR*/ }; /* Compute the number of bytes for the elements of a big array */ @@ -141,7 +142,7 @@ caml_ba_alloc(int flags, int num_dims, void * data, intnat * dim) intnat dimcopy[CAML_BA_MAX_NUM_DIMS]; Assert(num_dims >= 1 && num_dims <= CAML_BA_MAX_NUM_DIMS); - Assert((flags & CAML_BA_KIND_MASK) <= CAML_BA_COMPLEX64); + Assert((flags & CAML_BA_KIND_MASK) <= CAML_BA_CHAR); for (i = 0; i < num_dims; i++) dimcopy[i] = dim[i]; size = 0; if (data == NULL) { @@ -203,7 +204,7 @@ CAMLprim value caml_ba_create(value vkind, value vlayout, value vdim) if (dim[i] < 0) caml_invalid_argument("Bigarray.create: negative dimension"); } - flags = Int_val(vkind) | Int_val(vlayout); + flags = Caml_ba_kind_val(vkind) | Caml_ba_layout_val(vlayout); return caml_ba_alloc(flags, num_dims, NULL, dim); } @@ -291,6 +292,8 @@ value caml_ba_get_N(value vb, value * vind, int nind) case CAML_BA_COMPLEX64: { double * p = ((double *) b->data) + offset * 2; return copy_two_doubles(p[0], p[1]); } + case CAML_BA_CHAR: + return Val_int(((char *) b->data)[offset]); } } @@ -439,6 +442,7 @@ static value caml_ba_set_aux(value vb, value * vind, intnat nind, value newval) ((float *) b->data)[offset] = Double_val(newval); break; case CAML_BA_FLOAT64: ((double *) b->data)[offset] = Double_val(newval); break; + case CAML_BA_CHAR: case CAML_BA_SINT8: case CAML_BA_UINT8: ((int8 *) b->data)[offset] = Int_val(newval); break; @@ -649,14 +653,15 @@ CAMLprim value caml_ba_dim_3(value vb) CAMLprim value caml_ba_kind(value vb) { - return Val_int(Caml_ba_array_val(vb)->flags & CAML_BA_KIND_MASK); + return Val_caml_ba_kind(Caml_ba_array_val(vb)->flags & CAML_BA_KIND_MASK); } /* Return the layout of a big array */ CAMLprim value caml_ba_layout(value vb) { - return Val_int(Caml_ba_array_val(vb)->flags & CAML_BA_LAYOUT_MASK); + int layout = Caml_ba_array_val(vb)->flags & CAML_BA_LAYOUT_MASK; + return Val_caml_ba_layout(layout); } /* Finalization of a big array */ @@ -749,6 +754,8 @@ static int caml_ba_compare(value v1, value v2) num_elts *= 2; /*fallthrough*/ case CAML_BA_FLOAT64: DO_FLOAT_COMPARISON(double); + case CAML_BA_CHAR: + DO_INTEGER_COMPARISON(char); case CAML_BA_SINT8: DO_INTEGER_COMPARISON(int8); case CAML_BA_UINT8: @@ -799,6 +806,7 @@ static intnat caml_ba_hash(value v) h = 0; switch (b->flags & CAML_BA_KIND_MASK) { + case CAML_BA_CHAR: case CAML_BA_SINT8: case CAML_BA_UINT8: { uint8 * p = b->data; @@ -917,6 +925,7 @@ static void caml_ba_serialize(value v, for (i = 0; i < b->num_dims; i++) num_elts = num_elts * b->dim[i]; /* Serialize elements */ switch (b->flags & CAML_BA_KIND_MASK) { + case CAML_BA_CHAR: case CAML_BA_SINT8: case CAML_BA_UINT8: caml_serialize_block_1(b->data, num_elts); break; @@ -980,7 +989,7 @@ uintnat caml_ba_deserialize(void * dst) /* Compute total number of elements */ num_elts = caml_ba_num_elts(b); /* Determine element size in bytes */ - if ((b->flags & CAML_BA_KIND_MASK) > CAML_BA_COMPLEX64) + if ((b->flags & CAML_BA_KIND_MASK) > CAML_BA_CHAR) caml_deserialize_error("input_value: bad bigarray kind"); elt_size = caml_ba_element_size[b->flags & CAML_BA_KIND_MASK]; /* Allocate room for data */ @@ -989,6 +998,7 @@ uintnat caml_ba_deserialize(void * dst) caml_deserialize_error("input_value: out of memory for bigarray"); /* Read data */ switch (b->flags & CAML_BA_KIND_MASK) { + case CAML_BA_CHAR: case CAML_BA_SINT8: case CAML_BA_UINT8: caml_deserialize_block_1(b->data, num_elts); break; @@ -1173,6 +1183,7 @@ CAMLprim value caml_ba_fill(value vb, value vinit) for (p = b->data; num_elts > 0; p++, num_elts--) *p = init; break; } + case CAML_BA_CHAR: case CAML_BA_SINT8: case CAML_BA_UINT8: { int init = Int_val(vinit); diff --git a/otherlibs/bigarray/mmap_unix.c b/otherlibs/bigarray/mmap_unix.c index 5ba8cbf6d9..8a93a06b11 100644 --- a/otherlibs/bigarray/mmap_unix.c +++ b/otherlibs/bigarray/mmap_unix.c @@ -101,7 +101,7 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout, void * addr; fd = Int_val(vfd); - flags = Int_val(vkind) | Int_val(vlayout); + flags = Caml_ba_kind_val(vkind) | Caml_ba_layout_val(vlayout); startpos = File_offset_val(vstart); num_dims = Wosize_val(vdim); major_dim = flags & CAML_BA_FORTRAN_LAYOUT ? num_dims - 1 : 0; diff --git a/otherlibs/bigarray/mmap_win32.c b/otherlibs/bigarray/mmap_win32.c index 4eca668aa5..cd9da4af38 100644 --- a/otherlibs/bigarray/mmap_win32.c +++ b/otherlibs/bigarray/mmap_win32.c @@ -56,7 +56,7 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout, SYSTEM_INFO sysinfo; fd = Handle_val(vfd); - flags = Int_val(vkind) | Int_val(vlayout); + flags = Caml_ba_kind_val(vkind) | Caml_ba_layout_val(vlayout); startpos = Int64_val(vstart); num_dims = Wosize_val(vdim); major_dim = flags & CAML_BA_FORTRAN_LAYOUT ? num_dims - 1 : 0; diff --git a/otherlibs/dynlink/Makefile b/otherlibs/dynlink/Makefile index ab03704903..67b160aa49 100644 --- a/otherlibs/dynlink/Makefile +++ b/otherlibs/dynlink/Makefile @@ -15,10 +15,10 @@ include ../../config/Makefile -CAMLC=$(CAMLC_BIN) -nostdlib -I ../../stdlib -CAMLOPT=$(CAMLOPT_BIN) -nostdlib -I ../../stdlib +CAMLC=../../boot/ocamlrun ../../ocamlc +CAMLOPT=../../ocamlcompopt.sh INCLUDES=-I ../../utils -I ../../typing -I ../../bytecomp -I ../../asmcomp -COMPFLAGS=-w +33..39 -warn-error A $(INCLUDES) +COMPFLAGS=-w +33..39 -warn-error A -bin-annot -I ../../stdlib $(INCLUDES) OBJS=dynlinkaux.cmo dynlink.cmo diff --git a/otherlibs/graph/.depend b/otherlibs/graph/.depend index ab9faa619a..b4b531d43a 100644 --- a/otherlibs/graph/.depend +++ b/otherlibs/graph/.depend @@ -1,103 +1,63 @@ -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/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 graphics.cmi : graphicsX11.cmi : graphics.cmo : graphics.cmi diff --git a/otherlibs/num/.depend b/otherlibs/num/.depend index 51b180f5d8..32d691cc80 100644 --- a/otherlibs/num/.depend +++ b/otherlibs/num/.depend @@ -1,6 +1,6 @@ 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 + ../../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_digit.o: bng_digit.c @@ -8,14 +8,14 @@ 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 + ../../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 arith_flags.cmi : arith_status.cmi : big_int.cmi : nat.cmi diff --git a/otherlibs/str/.depend b/otherlibs/str/.depend index 5be8377c2d..b0ff35895b 100644 --- a/otherlibs/str/.depend +++ b/otherlibs/str/.depend @@ -1,9 +1,9 @@ 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 + ../../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 str.cmi : str.cmo : str.cmi str.cmx : str.cmi diff --git a/otherlibs/str/str.mli b/otherlibs/str/str.mli index 1eb92378bb..448cbd5ac3 100644 --- a/otherlibs/str/str.mli +++ b/otherlibs/str/str.mli @@ -121,6 +121,7 @@ val matched_string : string -> string - {!Str.string_partial_match} - {!Str.global_substitute} - {!Str.substitute_first} + provided that none of the following functions was called inbetween: - {!Str.global_replace} - {!Str.replace_first} diff --git a/otherlibs/systhreads/.depend b/otherlibs/systhreads/.depend index 85add2e592..93b01d6876 100644 --- a/otherlibs/systhreads/.depend +++ b/otherlibs/systhreads/.depend @@ -1,14 +1,14 @@ 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 + ../../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 condition.cmi : mutex.cmi event.cmi : mutex.cmi : diff --git a/otherlibs/systhreads/Makefile b/otherlibs/systhreads/Makefile index 138d056946..3da02c2601 100644 --- a/otherlibs/systhreads/Makefile +++ b/otherlibs/systhreads/Makefile @@ -13,11 +13,10 @@ include ../../config/Makefile -CAMLC=$(CAMLC_BIN) -nostdlib -I ../../stdlib -I ../unix -CAMLOPT=$(CAMLOPT_BIN) -nostdlib -I ../../stdlib -I ../unix +CAMLC=../../ocamlcomp.sh -I ../unix +CAMLOPT=../../ocamlcompopt.sh -I ../unix MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib -COMPFLAGS=-w +33..39 -warn-error A -g -CAMLC_BIN_CMD=$(CAMLC_BIN_CMD_TO_EVAL) -nostdlib -I ../../stdlib +COMPFLAGS=-w +33..39 -warn-error A -g -bin-annot BYTECODE_C_OBJS=st_stubs_b.o NATIVECODE_C_OBJS=st_stubs_n.o @@ -48,7 +47,7 @@ st_stubs_n.o: st_stubs.c st_posix.h mv st_stubs.o st_stubs_n.o threads.cma: $(THREAD_OBJS) - $(MKLIB) -ocamlc "$$($(CAMLC_BIN_CMD))" -o threads $(THREAD_OBJS) \ + $(MKLIB) -ocamlc '$(CAMLC)' -o threads $(THREAD_OBJS) \ -cclib -lunix $(PTHREAD_LINK) # See remark above: force static linking of libthreadsnat.a diff --git a/otherlibs/systhreads/Makefile.nt b/otherlibs/systhreads/Makefile.nt index 2d86f84c0f..225146cced 100644 --- a/otherlibs/systhreads/Makefile.nt +++ b/otherlibs/systhreads/Makefile.nt @@ -14,10 +14,9 @@ include ../../config/Makefile # Compilation options -CAMLC=$(CAMLC_BIN) -nostdlib -I ../../stdlib -I ../win32unix -CAMLOPT=$(CAMLOPT_BIN) -nostdlib -I ../../stdlib -I ../win32unix +CAMLC=../../boot/ocamlrun ../../ocamlc -I ../../stdlib -I ../win32unix +CAMLOPT=../../boot/ocamlrun ../../ocamlopt -I ../../stdlib -I ../win32unix COMPFLAGS=-w +33 -warn-error A -g -CAMLC_BIN_CMD=$(CAMLC_BIN_CMD_TO_EVAL) -nostdlib -I ../../stdlib MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib CFLAGS=-I../../byterun $(EXTRACFLAGS) diff --git a/otherlibs/threads/.depend b/otherlibs/threads/.depend index c96a6715fe..091feb6394 100644 --- a/otherlibs/threads/.depend +++ b/otherlibs/threads/.depend @@ -1,32 +1,35 @@ 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 + ../../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 condition.cmi : mutex.cmi event.cmi : +marshal.cmi : mutex.cmi : -thread.cmi : unix.cmo -threadUnix.cmi : unix.cmo +pervasives.cmi : +thread.cmi : unix.cmi +threadUnix.cmi : unix.cmi +unix.cmi : condition.cmo : thread.cmi mutex.cmi condition.cmi condition.cmx : thread.cmx mutex.cmx condition.cmi event.cmo : mutex.cmi condition.cmi event.cmi event.cmx : mutex.cmx condition.cmx event.cmi -marshal.cmo : pervasives.cmo -marshal.cmx : pervasives.cmx +marshal.cmo : pervasives.cmi marshal.cmi +marshal.cmx : pervasives.cmx marshal.cmi mutex.cmo : thread.cmi mutex.cmi mutex.cmx : thread.cmx mutex.cmi -pervasives.cmo : unix.cmo -pervasives.cmx : unix.cmx -thread.cmo : unix.cmo thread.cmi +pervasives.cmo : unix.cmi pervasives.cmi +pervasives.cmx : unix.cmx pervasives.cmi +thread.cmo : unix.cmi thread.cmi thread.cmx : unix.cmx thread.cmi -threadUnix.cmo : unix.cmo thread.cmi threadUnix.cmi +threadUnix.cmo : unix.cmi thread.cmi threadUnix.cmi threadUnix.cmx : unix.cmx thread.cmx threadUnix.cmi -unix.cmo : -unix.cmx : +unix.cmo : unix.cmi +unix.cmx : unix.cmi diff --git a/otherlibs/threads/Makefile b/otherlibs/threads/Makefile index 359f2d4298..3aa6c2acf8 100644 --- a/otherlibs/threads/Makefile +++ b/otherlibs/threads/Makefile @@ -15,10 +15,9 @@ include ../../config/Makefile CC=$(BYTECC) CFLAGS=-I../../byterun -O $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) -g -CAMLC=$(CAMLC_BIN) -nostdlib -I ../../stdlib -I ../unix +CAMLC=../../ocamlcomp.sh -I ../unix MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib -COMPFLAGS=-w +33..39 -warn-error A -CAMLC_BIN_CMD=$(CAMLC_BIN_CMD_TO_EVAL) -nostdlib -I ../../stdlib +COMPFLAGS=-w +33..39 -warn-error A -bin-annot C_OBJS=scheduler.o @@ -54,13 +53,13 @@ libvmthreads.a: $(C_OBJS) $(MKLIB) -o threads -oc vmthreads $(C_OBJS) threads.cma: $(CAML_OBJS) - $(MKLIB) -ocamlc "$$($(CAMLC_BIN_CMD))" -o threads -oc vmthreads $(CAML_OBJS) + $(MKLIB) -ocamlc '$(CAMLC)' -o threads -oc vmthreads $(CAML_OBJS) stdlib.cma: $(LIB_OBJS) $(CAMLC) -a -o stdlib.cma $(LIB_OBJS) unix.cma: $(UNIXLIB_OBJS) - $(MKLIB) -ocamlc "$$($(CAMLC_BIN_CMD))" -o unix -linkall $(UNIXLIB_OBJS) + $(MKLIB) -ocamlc '$(CAMLC)' -o unix -linkall $(UNIXLIB_OBJS) pervasives.cmo: pervasives.mli pervasives.cmi pervasives.ml $(CAMLC) ${COMPFLAGS} -nopervasives -c pervasives.ml @@ -117,7 +116,6 @@ installopt: $(CAMLC) -c $(COMPFLAGS) $< .ml.cmx: - exit 1 $(CAMLOPT) -c $(COMPFLAGS) $< depend: diff --git a/otherlibs/unix/.depend b/otherlibs/unix/.depend index 7cd527b19f..f3f79821d1 100644 --- a/otherlibs/unix/.depend +++ b/otherlibs/unix/.depend @@ -1,456 +1,498 @@ 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 + ../../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 unixsupport.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 + ../../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 + ../../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 + ../../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 unixsupport.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 unixsupport.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 unixsupport.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 unixsupport.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 unixsupport.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 unixsupport.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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 unixsupport.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 unixsupport.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 + ../../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 + ../../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 unixsupport.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/signals.h unixsupport.h \ - cst2constr.h socketaddr.h ../../byterun/misc.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 \ + cst2constr.h socketaddr.h ../../byterun/misc.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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 unixsupport.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 + ../../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 + ../../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 + ../../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 unixsupport.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 unixsupport.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 + ../../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/signals.h unixsupport.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 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/alloc.h ../../byterun/mlvalues.h \ - unixsupport.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 + ../../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 + ../../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 + ../../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 unixsupport.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/alloc.h ../../byterun/mlvalues.h \ - ../../byterun/fail.h unixsupport.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 unixsupport.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 + ../../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 unixsupport.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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 + ../../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 \ - unixsupport.h cst2constr.h ../../byterun/io.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 + ../../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 unixsupport.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 + ../../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 + ../../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 + ../../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/fail.h ../../byterun/mlvalues.h \ - ../../byterun/io.h unixsupport.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 + ../../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 + ../../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 unixsupport.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 unixsupport.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 + ../../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 + ../../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 : unixLabels.cmi : unix.cmi unix.cmo : unix.cmi diff --git a/otherlibs/unix/access.c b/otherlibs/unix/access.c index 3a612a3406..9af8a6f959 100644 --- a/otherlibs/unix/access.c +++ b/otherlibs/unix/access.c @@ -13,6 +13,8 @@ #include <mlvalues.h> #include <alloc.h> +#include <memory.h> +#include <signals.h> #include "unixsupport.h" #ifdef HAS_UNISTD @@ -40,11 +42,17 @@ static int access_permission_table[] = { CAMLprim value unix_access(value path, value perms) { + CAMLparam2(path, perms); + char * p; int ret, cv_flags; cv_flags = convert_flag_list(perms, access_permission_table); - ret = access(String_val(path), cv_flags); + p = caml_stat_alloc_string(path); + caml_enter_blocking_section(); + ret = access(p, cv_flags); + caml_leave_blocking_section(); + caml_stat_free(p); if (ret == -1) uerror("access", path); - return Val_unit; + CAMLreturn(Val_unit); } diff --git a/otherlibs/unix/chdir.c b/otherlibs/unix/chdir.c index e7ea6f5058..4b93b5fc80 100644 --- a/otherlibs/unix/chdir.c +++ b/otherlibs/unix/chdir.c @@ -12,12 +12,20 @@ /***********************************************************************/ #include <mlvalues.h> +#include <memory.h> +#include <signals.h> #include "unixsupport.h" CAMLprim value unix_chdir(value path) { + CAMLparam1(path); + char * p; int ret; - ret = chdir(String_val(path)); + p = caml_stat_alloc_string(path); + caml_enter_blocking_section(); + ret = chdir(p); + caml_leave_blocking_section(); + caml_stat_free(p); if (ret == -1) uerror("chdir", path); - return Val_unit; + CAMLreturn(Val_unit); } diff --git a/otherlibs/unix/chmod.c b/otherlibs/unix/chmod.c index ed2e88c8d7..a042155211 100644 --- a/otherlibs/unix/chmod.c +++ b/otherlibs/unix/chmod.c @@ -14,12 +14,20 @@ #include <sys/types.h> #include <sys/stat.h> #include <mlvalues.h> +#include <memory.h> +#include <signals.h> #include "unixsupport.h" CAMLprim value unix_chmod(value path, value perm) { + CAMLparam2(path, perm); + char * p; int ret; - ret = chmod(String_val(path), Int_val(perm)); + p = caml_stat_alloc_string(path); + caml_enter_blocking_section(); + ret = chmod(p, Int_val(perm)); + caml_leave_blocking_section(); + caml_stat_free(p); if (ret == -1) uerror("chmod", path); - return Val_unit; + CAMLreturn(Val_unit); } diff --git a/otherlibs/unix/chown.c b/otherlibs/unix/chown.c index a26f7a8690..0b118fb40a 100644 --- a/otherlibs/unix/chown.c +++ b/otherlibs/unix/chown.c @@ -12,12 +12,20 @@ /***********************************************************************/ #include <mlvalues.h> +#include <memory.h> +#include <signals.h> #include "unixsupport.h" CAMLprim value unix_chown(value path, value uid, value gid) { + CAMLparam1(path); + char * p; int ret; - ret = chown(String_val(path), Int_val(uid), Int_val(gid)); + p = caml_stat_alloc_string(path); + caml_enter_blocking_section(); + ret = chown(p, Int_val(uid), Int_val(gid)); + caml_leave_blocking_section(); + caml_stat_free(p); if (ret == -1) uerror("chown", path); - return Val_unit; + CAMLreturn(Val_unit); } diff --git a/otherlibs/unix/chroot.c b/otherlibs/unix/chroot.c index 02a46aedcf..7c9517c117 100644 --- a/otherlibs/unix/chroot.c +++ b/otherlibs/unix/chroot.c @@ -12,12 +12,20 @@ /***********************************************************************/ #include <mlvalues.h> +#include <memory.h> +#include <signals.h> #include "unixsupport.h" CAMLprim value unix_chroot(value path) { + CAMLparam1(path); + char * p; int ret; - ret = chroot(String_val(path)); + p = caml_stat_alloc_string(path); + caml_enter_blocking_section(); + ret = chroot(p); + caml_leave_blocking_section(); + caml_stat_free(p); if (ret == -1) uerror("chroot", path); - return Val_unit; + CAMLreturn(Val_unit); } diff --git a/otherlibs/unix/close.c b/otherlibs/unix/close.c index 425502aac4..8a56c413b9 100644 --- a/otherlibs/unix/close.c +++ b/otherlibs/unix/close.c @@ -12,10 +12,15 @@ /***********************************************************************/ #include <mlvalues.h> +#include <signals.h> #include "unixsupport.h" CAMLprim value unix_close(value fd) { - if (close(Int_val(fd)) == -1) uerror("close", Nothing); + int ret; + caml_enter_blocking_section(); + ret = close(Int_val(fd)); + caml_leave_blocking_section(); + if (ret == -1) uerror("close", Nothing); return Val_unit; } diff --git a/otherlibs/unix/closedir.c b/otherlibs/unix/closedir.c index ba9e743754..4196acd4e1 100644 --- a/otherlibs/unix/closedir.c +++ b/otherlibs/unix/closedir.c @@ -12,6 +12,8 @@ /***********************************************************************/ #include <mlvalues.h> +#include <memory.h> +#include <signals.h> #include "unixsupport.h" #include <errno.h> #include <sys/types.h> @@ -23,9 +25,12 @@ CAMLprim value unix_closedir(value vd) { + CAMLparam1(vd); DIR * d = DIR_Val(vd); if (d == (DIR *) NULL) unix_error(EBADF, "closedir", Nothing); + caml_enter_blocking_section(); closedir(d); + caml_leave_blocking_section(); DIR_Val(vd) = (DIR *) NULL; - return Val_unit; + CAMLreturn(Val_unit); } diff --git a/otherlibs/unix/fchmod.c b/otherlibs/unix/fchmod.c index a6e8ee9033..711097eb47 100644 --- a/otherlibs/unix/fchmod.c +++ b/otherlibs/unix/fchmod.c @@ -15,13 +15,18 @@ #include <sys/stat.h> #include <fail.h> #include <mlvalues.h> +#include <signals.h> #include "unixsupport.h" #ifdef HAS_FCHMOD CAMLprim value unix_fchmod(value fd, value perm) { - if (fchmod(Int_val(fd), Int_val(perm)) == -1) uerror("fchmod", Nothing); + int result; + caml_enter_blocking_section(); + result = fchmod(Int_val(fd), Int_val(perm)); + caml_leave_blocking_section(); + if (result == -1) uerror("fchmod", Nothing); return Val_unit; } diff --git a/otherlibs/unix/fchown.c b/otherlibs/unix/fchown.c index 574d3c42b8..2a6746ca64 100644 --- a/otherlibs/unix/fchown.c +++ b/otherlibs/unix/fchown.c @@ -13,14 +13,18 @@ #include <fail.h> #include <mlvalues.h> +#include <signals.h> #include "unixsupport.h" #ifdef HAS_FCHMOD CAMLprim value unix_fchown(value fd, value uid, value gid) { - if (fchown(Int_val(fd), Int_val(uid), Int_val(gid)) == -1) - uerror("fchown", Nothing); + int result; + caml_enter_blocking_section(); + result = fchown(Int_val(fd), Int_val(uid), Int_val(gid)); + caml_leave_blocking_section(); + if (result == -1) uerror("fchown", Nothing); return Val_unit; } diff --git a/otherlibs/unix/ftruncate.c b/otherlibs/unix/ftruncate.c index f539a6450d..ec494ba525 100644 --- a/otherlibs/unix/ftruncate.c +++ b/otherlibs/unix/ftruncate.c @@ -15,6 +15,7 @@ #include <fail.h> #include <mlvalues.h> #include <io.h> +#include <signals.h> #include "unixsupport.h" #ifdef HAS_UNISTD #include <unistd.h> @@ -24,15 +25,22 @@ CAMLprim value unix_ftruncate(value fd, value len) { - if (ftruncate(Int_val(fd), Long_val(len)) == -1) - uerror("ftruncate", Nothing); + int result; + caml_enter_blocking_section(); + result = ftruncate(Int_val(fd), Long_val(len)); + caml_leave_blocking_section(); + if (result == -1) uerror("ftruncate", Nothing); return Val_unit; } CAMLprim value unix_ftruncate_64(value fd, value len) { - if (ftruncate(Int_val(fd), File_offset_val(len)) == -1) - uerror("ftruncate", Nothing); + int result; + file_offset ofs = File_offset_val(len); + caml_enter_blocking_section(); + result = ftruncate(Int_val(fd), ofs); + caml_leave_blocking_section(); + if (result == -1) uerror("ftruncate", Nothing); return Val_unit; } diff --git a/otherlibs/unix/gethost.c b/otherlibs/unix/gethost.c index e155152f8f..607b6c35f8 100644 --- a/otherlibs/unix/gethost.c +++ b/otherlibs/unix/gethost.c @@ -127,8 +127,7 @@ CAMLprim value unix_gethostbyname(value name) char * hostname; #if HAS_GETHOSTBYNAME_R || GETHOSTBYNAME_IS_REENTRANT - hostname = caml_stat_alloc(string_length(name) + 1); - strcpy(hostname, String_val(name)); + hostname = caml_stat_alloc_string(name); #else hostname = String_val(name); #endif diff --git a/otherlibs/unix/link.c b/otherlibs/unix/link.c index b5051cd96e..8110bf5830 100644 --- a/otherlibs/unix/link.c +++ b/otherlibs/unix/link.c @@ -12,10 +12,23 @@ /***********************************************************************/ #include <mlvalues.h> +#include <memory.h> +#include <signals.h> #include "unixsupport.h" CAMLprim value unix_link(value path1, value path2) { - if (link(String_val(path1), String_val(path2)) == -1) uerror("link", path2); - return Val_unit; + CAMLparam2(path1, path2); + char * p1; + char * p2; + int ret; + p1 = caml_stat_alloc_string(path1); + p2 = caml_stat_alloc_string(path2); + caml_enter_blocking_section(); + ret = link(p1, p2); + caml_leave_blocking_section(); + caml_stat_free(p1); + caml_stat_free(p2); + if (ret == -1) uerror("link", path2); + CAMLreturn(Val_unit); } diff --git a/otherlibs/unix/mkdir.c b/otherlibs/unix/mkdir.c index 0bb1f4f5fe..6a7bb18c24 100644 --- a/otherlibs/unix/mkdir.c +++ b/otherlibs/unix/mkdir.c @@ -14,10 +14,20 @@ #include <sys/types.h> #include <sys/stat.h> #include <mlvalues.h> +#include <memory.h> +#include <signals.h> #include "unixsupport.h" CAMLprim value unix_mkdir(value path, value perm) { - if (mkdir(String_val(path), Int_val(perm)) == -1) uerror("mkdir", path); - return Val_unit; + CAMLparam2(path, perm); + char * p; + int ret; + p = caml_stat_alloc_string(path); + caml_enter_blocking_section(); + ret = mkdir(p, Int_val(perm)); + caml_leave_blocking_section(); + caml_stat_free(p); + if (ret == -1) uerror("mkdir", path); + CAMLreturn(Val_unit); } diff --git a/otherlibs/unix/mkfifo.c b/otherlibs/unix/mkfifo.c index ec3bed4bbd..ef440a25bc 100644 --- a/otherlibs/unix/mkfifo.c +++ b/otherlibs/unix/mkfifo.c @@ -15,15 +15,25 @@ #include <sys/stat.h> #include <fail.h> #include <mlvalues.h> +#include <memory.h> +#include <signals.h> #include "unixsupport.h" #ifdef HAS_MKFIFO CAMLprim value unix_mkfifo(value path, value mode) { - if (mkfifo(String_val(path), Int_val(mode)) == -1) + CAMLparam2(path, mode); + char * p; + int ret; + p = caml_stat_alloc_string(path); + caml_enter_blocking_section(); + ret = mkfifo(p, Int_val(mode)); + caml_leave_blocking_section(); + caml_stat_free(p); + if (ret == -1) uerror("mkfifo", path); - return Val_unit; + CAMLreturn(Val_unit); } #else @@ -35,9 +45,17 @@ CAMLprim value unix_mkfifo(value path, value mode) CAMLprim value unix_mkfifo(value path, value mode) { - if (mknod(String_val(path), (Int_val(mode) & 07777) | S_IFIFO, 0) == -1) + CAMLparam2(path, mode); + char * p; + int ret; + p = caml_stat_alloc_string(path); + caml_enter_blocking_section(); + ret = mknod(p, (Int_val(mode) & 07777) | S_IFIFO, 0); + caml_leave_blocking_section(); + caml_stat_free(p); + if (ret == -1) uerror("mkfifo", path); - return Val_unit; + CAMLreturn(Val_unit); } #else diff --git a/otherlibs/unix/open.c b/otherlibs/unix/open.c index ecee013898..c98819aab4 100644 --- a/otherlibs/unix/open.c +++ b/otherlibs/unix/open.c @@ -62,8 +62,7 @@ CAMLprim value unix_open(value path, value flags, value perm) char * p; cv_flags = convert_flag_list(flags, open_flag_table); - p = caml_stat_alloc(string_length(path) + 1); - strcpy(p, String_val(path)); + p = caml_stat_alloc_string(path); /* open on a named FIFO can block (PR#1533) */ enter_blocking_section(); fd = open(p, cv_flags, Int_val(perm)); diff --git a/otherlibs/unix/opendir.c b/otherlibs/unix/opendir.c index f70e708bdc..57a3318889 100644 --- a/otherlibs/unix/opendir.c +++ b/otherlibs/unix/opendir.c @@ -12,7 +12,9 @@ /***********************************************************************/ #include <mlvalues.h> +#include <memory.h> #include <alloc.h> +#include <signals.h> #include "unixsupport.h" #include <sys/types.h> #ifdef HAS_DIRENT @@ -23,11 +25,18 @@ CAMLprim value unix_opendir(value path) { + CAMLparam1(path); DIR * d; value res; - d = opendir(String_val(path)); + char * p; + + p = caml_stat_alloc_string(path); + caml_enter_blocking_section(); + d = opendir(p); + caml_leave_blocking_section(); + caml_stat_free(p); if (d == (DIR *) NULL) uerror("opendir", path); res = alloc_small(1, Abstract_tag); DIR_Val(res) = d; - return res; + CAMLreturn(res); } diff --git a/otherlibs/unix/readdir.c b/otherlibs/unix/readdir.c index 08dad1a06d..e6daf5f61c 100644 --- a/otherlibs/unix/readdir.c +++ b/otherlibs/unix/readdir.c @@ -14,6 +14,7 @@ #include <mlvalues.h> #include <fail.h> #include <alloc.h> +#include <signals.h> #include "unixsupport.h" #include <errno.h> #include <sys/types.h> @@ -31,7 +32,9 @@ CAMLprim value unix_readdir(value vd) directory_entry * e; d = DIR_Val(vd); if (d == (DIR *) NULL) unix_error(EBADF, "readdir", Nothing); + caml_enter_blocking_section(); e = readdir((DIR *) d); + caml_leave_blocking_section(); if (e == (directory_entry *) NULL) raise_end_of_file(); return copy_string(e->d_name); } diff --git a/otherlibs/unix/readlink.c b/otherlibs/unix/readlink.c index 9534a42bde..d129aebfed 100644 --- a/otherlibs/unix/readlink.c +++ b/otherlibs/unix/readlink.c @@ -12,8 +12,10 @@ /***********************************************************************/ #include <mlvalues.h> +#include <memory.h> #include <alloc.h> #include <fail.h> +#include <signals.h> #ifdef HAS_SYMLINK @@ -30,12 +32,18 @@ CAMLprim value unix_readlink(value path) { + CAMLparam1(path); char buffer[PATH_MAX]; int len; - len = readlink(String_val(path), buffer, sizeof(buffer) - 1); + char * p; + p = caml_stat_alloc_string(path); + caml_enter_blocking_section(); + len = readlink(p, buffer, sizeof(buffer) - 1); + caml_leave_blocking_section(); + caml_stat_free(p); if (len == -1) uerror("readlink", path); buffer[len] = '\0'; - return copy_string(buffer); + CAMLreturn(copy_string(buffer)); } #else diff --git a/otherlibs/unix/rename.c b/otherlibs/unix/rename.c index 2d34a8833f..e63a06e364 100644 --- a/otherlibs/unix/rename.c +++ b/otherlibs/unix/rename.c @@ -13,11 +13,24 @@ #include <stdio.h> #include <mlvalues.h> +#include <memory.h> +#include <signals.h> #include "unixsupport.h" CAMLprim value unix_rename(value path1, value path2) { - if (rename(String_val(path1), String_val(path2)) == -1) + CAMLparam2(path1, path2); + char * p1; + char * p2; + int ret; + p1 = caml_stat_alloc_string(path1); + p2 = caml_stat_alloc_string(path2); + caml_enter_blocking_section(); + ret = rename(p1, p2); + caml_leave_blocking_section(); + caml_stat_free(p2); + caml_stat_free(p1); + if (ret == -1) uerror("rename", path1); - return Val_unit; + CAMLreturn(Val_unit); } diff --git a/otherlibs/unix/rmdir.c b/otherlibs/unix/rmdir.c index 631b47c0e3..28cef33d8f 100644 --- a/otherlibs/unix/rmdir.c +++ b/otherlibs/unix/rmdir.c @@ -12,10 +12,20 @@ /***********************************************************************/ #include <mlvalues.h> +#include <memory.h> +#include <signals.h> #include "unixsupport.h" CAMLprim value unix_rmdir(value path) { - if (rmdir(String_val(path)) == -1) uerror("rmdir", path); - return Val_unit; + CAMLparam1(path); + char * p; + int ret; + p = caml_stat_alloc_string(path); + caml_enter_blocking_section(); + ret = rmdir(p); + caml_leave_blocking_section(); + caml_stat_free(p); + if (ret == -1) uerror("rmdir", path); + CAMLreturn(Val_unit); } diff --git a/otherlibs/unix/stat.c b/otherlibs/unix/stat.c index a0f4c343d9..9825802a0a 100644 --- a/otherlibs/unix/stat.c +++ b/otherlibs/unix/stat.c @@ -15,6 +15,7 @@ #include <mlvalues.h> #include <memory.h> #include <alloc.h> +#include <signals.h> #include "unixsupport.h" #include "cst2constr.h" #include <sys/types.h> @@ -70,35 +71,49 @@ static value stat_aux(int use_64, struct stat *buf) CAMLprim value unix_stat(value path) { + CAMLparam1(path); int ret; struct stat buf; - ret = stat(String_val(path), &buf); + char * p; + p = caml_stat_alloc_string(path); + caml_enter_blocking_section(); + ret = stat(p, &buf); + caml_leave_blocking_section(); + caml_stat_free(p); if (ret == -1) uerror("stat", path); if (buf.st_size > Max_long && (buf.st_mode & S_IFMT) == S_IFREG) unix_error(EOVERFLOW, "stat", path); - return stat_aux(0, &buf); + CAMLreturn(stat_aux(0, &buf)); } CAMLprim value unix_lstat(value path) { + CAMLparam1(path); int ret; struct stat buf; + char * p; + p = caml_stat_alloc_string(path); + caml_enter_blocking_section(); #ifdef HAS_SYMLINK - ret = lstat(String_val(path), &buf); + ret = lstat(p, &buf); #else - ret = stat(String_val(path), &buf); + ret = stat(p, &buf); #endif + caml_leave_blocking_section(); + caml_stat_free(p); if (ret == -1) uerror("lstat", path); if (buf.st_size > Max_long && (buf.st_mode & S_IFMT) == S_IFREG) unix_error(EOVERFLOW, "lstat", path); - return stat_aux(0, &buf); + CAMLreturn(stat_aux(0, &buf)); } CAMLprim value unix_fstat(value fd) { int ret; struct stat buf; + caml_enter_blocking_section(); ret = fstat(Int_val(fd), &buf); + caml_leave_blocking_section(); if (ret == -1) uerror("fstat", Nothing); if (buf.st_size > Max_long && (buf.st_mode & S_IFMT) == S_IFREG) unix_error(EOVERFLOW, "fstat", Nothing); @@ -107,31 +122,45 @@ CAMLprim value unix_fstat(value fd) CAMLprim value unix_stat_64(value path) { + CAMLparam1(path); int ret; struct stat buf; - ret = stat(String_val(path), &buf); + char * p; + p = caml_stat_alloc_string(path); + caml_enter_blocking_section(); + ret = stat(p, &buf); + caml_leave_blocking_section(); + caml_stat_free(p); if (ret == -1) uerror("stat", path); - return stat_aux(1, &buf); + CAMLreturn(stat_aux(1, &buf)); } CAMLprim value unix_lstat_64(value path) { + CAMLparam1(path); int ret; struct stat buf; + char * p; + p = caml_stat_alloc_string(path); + caml_enter_blocking_section(); #ifdef HAS_SYMLINK - ret = lstat(String_val(path), &buf); + ret = lstat(p, &buf); #else - ret = stat(String_val(path), &buf); + ret = stat(p, &buf); #endif + caml_leave_blocking_section(); + caml_stat_free(p); if (ret == -1) uerror("lstat", path); - return stat_aux(1, &buf); + CAMLreturn(stat_aux(1, &buf)); } CAMLprim value unix_fstat_64(value fd) { int ret; struct stat buf; + caml_enter_blocking_section(); ret = fstat(Int_val(fd), &buf); + caml_leave_blocking_section(); if (ret == -1) uerror("fstat", Nothing); return stat_aux(1, &buf); } diff --git a/otherlibs/unix/symlink.c b/otherlibs/unix/symlink.c index 26c9aa43ce..41ba020190 100644 --- a/otherlibs/unix/symlink.c +++ b/otherlibs/unix/symlink.c @@ -13,15 +13,28 @@ #include <fail.h> #include <mlvalues.h> +#include <memory.h> +#include <signals.h> #include "unixsupport.h" #ifdef HAS_SYMLINK CAMLprim value unix_symlink(value path1, value path2) { - if (symlink(String_val(path1), String_val(path2)) == -1) + CAMLparam2(path1, path2); + char * p1; + char * p2; + int ret; + p1 = caml_stat_alloc_string(path1); + p2 = caml_stat_alloc_string(path2); + caml_enter_blocking_section(); + ret = symlink(p1, p2); + caml_leave_blocking_section(); + caml_stat_free(p1); + caml_stat_free(p2); + if (ret == -1) uerror("symlink", path2); - return Val_unit; + CAMLreturn(Val_unit); } #else diff --git a/otherlibs/unix/truncate.c b/otherlibs/unix/truncate.c index 638ef79947..c5b3a11591 100644 --- a/otherlibs/unix/truncate.c +++ b/otherlibs/unix/truncate.c @@ -13,7 +13,9 @@ #include <sys/types.h> #include <mlvalues.h> +#include <memory.h> #include <fail.h> +#include <signals.h> #include <io.h> #include "unixsupport.h" #ifdef HAS_UNISTD @@ -24,16 +26,33 @@ CAMLprim value unix_truncate(value path, value len) { - if (truncate(String_val(path), Long_val(len)) == -1) + CAMLparam2(path, len); + char * p; + int ret; + p = caml_stat_alloc_string(path); + caml_enter_blocking_section(); + ret = truncate(p, Long_val(len)); + caml_leave_blocking_section(); + caml_stat_free(p); + if (ret == -1) uerror("truncate", path); - return Val_unit; + CAMLreturn(Val_unit); } -CAMLprim value unix_truncate_64(value path, value len) +CAMLprim value unix_truncate_64(value path, value vlen) { - if (truncate(String_val(path), File_offset_val(len)) == -1) + CAMLparam2(path, vlen); + char * p; + int ret; + file_offset len = File_offset_val(vlen); + p = caml_stat_alloc_string(path); + caml_enter_blocking_section(); + ret = truncate(p, len); + caml_leave_blocking_section(); + caml_stat_free(p); + if (ret == -1) uerror("truncate", path); - return Val_unit; + CAMLreturn(Val_unit); } #else diff --git a/otherlibs/unix/unix.mli b/otherlibs/unix/unix.mli index ef93d4e012..d8a15753eb 100644 --- a/otherlibs/unix/unix.mli +++ b/otherlibs/unix/unix.mli @@ -244,7 +244,6 @@ type open_flag = while still open *) | O_CLOEXEC (** Set the close-on-exec flag on the descriptor returned by {!openfile} *) - (** The flags to {!Unix.openfile}. *) @@ -1102,7 +1101,9 @@ val open_connection : sockaddr -> in_channel * out_channel val shutdown_connection : in_channel -> unit (** ``Shut down'' a connection established with {!Unix.open_connection}; that is, transmit an end-of-file condition to the server reading - on the other side of the connection. *) + on the other side of the connection. This does not fully close the + file descriptor associated with the channel, which you must remember + to free via {!Pervasives.close_in}. *) val establish_server : (in_channel -> out_channel -> unit) -> sockaddr -> unit (** Establish a server on the given address. diff --git a/otherlibs/unix/unlink.c b/otherlibs/unix/unlink.c index 76ec913109..4a4a513e39 100644 --- a/otherlibs/unix/unlink.c +++ b/otherlibs/unix/unlink.c @@ -12,10 +12,20 @@ /***********************************************************************/ #include <mlvalues.h> +#include <memory.h> +#include <signals.h> #include "unixsupport.h" CAMLprim value unix_unlink(value path) { - if (unlink(String_val(path)) == -1) uerror("unlink", path); - return Val_unit; + CAMLparam1(path); + char * p; + int ret; + p = caml_stat_alloc_string(path); + caml_enter_blocking_section(); + ret = unlink(p); + caml_leave_blocking_section(); + caml_stat_free(p); + if (ret == -1) uerror("unlink", path); + CAMLreturn(Val_unit); } diff --git a/otherlibs/unix/utimes.c b/otherlibs/unix/utimes.c index 825fc4cdfe..bb84c43e50 100644 --- a/otherlibs/unix/utimes.c +++ b/otherlibs/unix/utimes.c @@ -13,6 +13,8 @@ #include <fail.h> #include <mlvalues.h> +#include <memory.h> +#include <signals.h> #include "unixsupport.h" #ifdef HAS_UTIME @@ -26,15 +28,23 @@ CAMLprim value unix_utimes(value path, value atime, value mtime) { + CAMLparam3(path, atime, mtime); struct utimbuf times, * t; + char * p; + int ret; times.actime = Double_val(atime); times.modtime = Double_val(mtime); if (times.actime || times.modtime) t = × else t = (struct utimbuf *) NULL; - if (utime(String_val(path), t) == -1) uerror("utimes", path); - return Val_unit; + p = caml_stat_alloc_string(path); + caml_enter_blocking_section(); + ret = utime(p, t); + caml_leave_blocking_section(); + caml_stat_free(p); + if (ret == -1) uerror("utimes", path); + CAMLreturn(Val_unit); } #else @@ -46,7 +56,10 @@ CAMLprim value unix_utimes(value path, value atime, value mtime) CAMLprim value unix_utimes(value path, value atime, value mtime) { + CAMLparam3(path, atime, mtime); struct timeval tv[2], * t; + char * p; + int ret; double at = Double_val(atime); double mt = Double_val(mtime); tv[0].tv_sec = at; @@ -57,8 +70,13 @@ CAMLprim value unix_utimes(value path, value atime, value mtime) t = tv; else t = (struct timeval *) NULL; - if (utimes(String_val(path), t) == -1) uerror("utimes", path); - return Val_unit; + p = caml_stat_alloc_string(path); + caml_enter_blocking_section(); + ret = utimes(p, t); + caml_leave_blocking_section(); + caml_stat_free(p); + if (ret == -1) uerror("utimes", path); + CAMLreturn(Val_unit); } #else diff --git a/otherlibs/win32unix/select.c b/otherlibs/win32unix/select.c index 9f06024f99..d4afe49866 100644 --- a/otherlibs/win32unix/select.c +++ b/otherlibs/win32unix/select.c @@ -602,7 +602,7 @@ LPSELECTDATA socket_poll_add (LPSELECTDATA lpSelectData, { LPSELECTDATA res; LPSELECTDATA candidate; - DWORD i; + long i; LPSELECTQUERY aQueries; res = lpSelectData; diff --git a/parsing/ast_helper.ml b/parsing/ast_helper.ml index ed49f65a33..46696bc1cb 100644 --- a/parsing/ast_helper.ml +++ b/parsing/ast_helper.ml @@ -125,6 +125,7 @@ module Mty = struct let attr d a = {d with pmty_attributes = d.pmty_attributes @ [a]} let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a) + let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a) let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a) let functor_ ?loc ?attrs a b c = mk ?loc ?attrs (Pmty_functor (a, b, c)) let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b)) @@ -263,29 +264,32 @@ module Val = struct end module Md = struct - let mk ?(attrs = []) name typ = + let mk ?(loc = !default_loc) ?(attrs = []) name typ = { pmd_name = name; pmd_type = typ; pmd_attributes = attrs; + pmd_loc = loc; } end module Mtd = struct - let mk ?(attrs = []) ?typ name = + let mk ?(loc = !default_loc) ?(attrs = []) ?typ name = { pmtd_name = name; pmtd_type = typ; pmtd_attributes = attrs; + pmtd_loc = loc; } end module Mb = struct - let mk ?(attrs = []) name expr = + let mk ?(loc = !default_loc) ?(attrs = []) name expr = { pmb_name = name; pmb_expr = expr; pmb_attributes = attrs; + pmb_loc = loc; } end @@ -370,7 +374,7 @@ module Convenience = struct let may_tuple tup = function | [] -> None | [x] -> Some x - | l -> Some (tup l) + | l -> Some (tup ?loc:None ?attrs:None l) let lid s = mkloc (Longident.parse s) !default_loc let tuple l = Exp.tuple l diff --git a/parsing/ast_helper.mli b/parsing/ast_helper.mli index 562f519898..a0768a4ee1 100644 --- a/parsing/ast_helper.mli +++ b/parsing/ast_helper.mli @@ -100,7 +100,7 @@ module Exp: val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression option -> expression val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression - val for_: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression -> direction_flag -> expression -> expression + val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression -> direction_flag -> expression -> expression val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option -> core_type -> expression val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type -> expression val send: ?loc:loc -> ?attrs:attrs -> expression -> string -> expression @@ -144,8 +144,10 @@ module Mty: val attr: module_type -> attribute -> module_type val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type + val alias: ?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 +161,8 @@ module Mod: 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 @@ -210,19 +213,19 @@ module Str: (** Module declarations *) module Md: sig - val mk: ?attrs:attrs -> str -> module_type -> module_declaration + val mk: ?loc:loc -> ?attrs:attrs -> str -> module_type -> module_declaration end (** Module type declarations *) module Mtd: sig - val mk: ?attrs:attrs -> ?typ:module_type -> str -> module_type_declaration + val mk: ?loc:loc -> ?attrs:attrs -> ?typ:module_type -> str -> module_type_declaration end (** Module bindings *) module Mb: sig - val mk: ?attrs:attrs -> str -> module_expr -> module_binding + val mk: ?loc:loc -> ?attrs:attrs -> str -> module_expr -> module_binding end (** Value bindings *) diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml index e10e32cbd1..03371b0cea 100644 --- a/parsing/ast_mapper.ml +++ b/parsing/ast_mapper.ml @@ -12,6 +12,10 @@ (* A generic Parsetree mapping class *) +;; [@@warning "+9"] + (* Ensure that record patterns don't miss any field. *) + + open Parsetree open Ast_helper open Location @@ -159,9 +163,11 @@ module MT = struct let attrs = sub.attributes sub attrs in match desc with | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s) + | Pmty_alias s -> alias ~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 +219,8 @@ module M = struct | 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) @@ -292,8 +299,8 @@ module E = struct | Pexp_sequence (e1, e2) -> sequence ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) | Pexp_while (e1, e2) -> while_ ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) - | Pexp_for (id, e1, e2, d, e3) -> - for_ ~loc ~attrs (map_loc sub id) (sub.expr sub e1) (sub.expr sub e2) d + | Pexp_for (p, e1, e2, d, e3) -> + for_ ~loc ~attrs (sub.pat sub p) (sub.expr sub e1) (sub.expr sub e2) d (sub.expr sub e3) | Pexp_coerce (e, t1, t2) -> coerce ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t1) @@ -425,15 +432,18 @@ let default_mapper = signature_item = MT.map_signature_item; module_type = MT.map; with_constraint = MT.map_with_constraint; - class_declaration = (fun this -> CE.class_infos this (this.class_expr this)); + class_declaration = + (fun this -> CE.class_infos this (this.class_expr this)); class_expr = CE.map; class_field = CE.map_field; class_structure = CE.map_structure; class_type = CT.map; class_type_field = CT.map_field; class_signature = CT.map_signature; - class_type_declaration = (fun this -> CE.class_infos this (this.class_type this)); - class_description = (fun this -> CE.class_infos this (this.class_type this)); + class_type_declaration = + (fun this -> CE.class_infos this (this.class_type this)); + class_description = + (fun this -> CE.class_infos this (this.class_type this)); type_declaration = T.map_type_declaration; type_kind = T.map_type_kind; typ = T.map; @@ -453,26 +463,28 @@ let default_mapper = expr = E.map; module_declaration = - (fun this {pmd_name; pmd_type; pmd_attributes} -> + (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} -> Md.mk (map_loc this pmd_name) (this.module_type this pmd_type) ~attrs:(this.attributes this pmd_attributes) + ~loc:(this.location this pmd_loc) ); module_type_declaration = - (fun this {pmtd_name; pmtd_type; pmtd_attributes} -> - { - pmtd_name = map_loc this pmtd_name; - pmtd_type =map_opt (this.module_type this) pmtd_type; - pmtd_attributes = this.attributes this pmtd_attributes; - } + (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} -> + Mtd.mk + (map_loc this pmtd_name) + ?typ:(map_opt (this.module_type this) pmtd_type) + ~attrs:(this.attributes this pmtd_attributes) + ~loc:(this.location this pmtd_loc) ); module_binding = - (fun this {pmb_name; pmb_expr; pmb_attributes} -> + (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} -> Mb.mk (map_loc this pmb_name) (this.module_expr this pmb_expr) ~attrs:(this.attributes this pmb_attributes) + ~loc:(this.location this pmb_loc) ); value_binding = diff --git a/parsing/lexer.mli b/parsing/lexer.mli index b067b2aa3e..b54f111041 100644 --- a/parsing/lexer.mli +++ b/parsing/lexer.mli @@ -21,7 +21,7 @@ type error = | Illegal_escape of string | Unterminated_comment of Location.t | Unterminated_string - | Unterminated_string_in_comment of Location.t + | Unterminated_string_in_comment of Location.t * Location.t | Keyword_as_label of string | Literal_overflow of string ;; diff --git a/parsing/lexer.mll b/parsing/lexer.mll index 8aed03b2fc..910027c044 100644 --- a/parsing/lexer.mll +++ b/parsing/lexer.mll @@ -22,7 +22,7 @@ type error = | Illegal_escape of string | Unterminated_comment of Location.t | Unterminated_string - | Unterminated_string_in_comment of Location.t + | Unterminated_string_in_comment of Location.t * Location.t | Keyword_as_label of string | Literal_overflow of string ;; @@ -235,8 +235,9 @@ let report_error ppf = function fprintf ppf "Comment not terminated" | Unterminated_string -> fprintf ppf "String literal not terminated" - | Unterminated_string_in_comment _ -> - fprintf ppf "This comment contains an unterminated string literal" + | Unterminated_string_in_comment (_, loc) -> + fprintf ppf "This comment contains an unterminated string literal@.%aString literal begins here" + Location.print_error loc | Keyword_as_label kwd -> fprintf ppf "`%s' is a keyword, it cannot be used as label name" kwd | Literal_overflow ty -> @@ -254,7 +255,7 @@ let () = } -let newline = ('\010' | "\013\010" ) +let newline = ('\013'* '\010' ) let blank = [' ' '\009' '\012'] let lowercase = ['a'-'z' '_'] let uppercase = ['A'-'Z'] @@ -492,13 +493,14 @@ and comment = parse store_string_char '"'; is_in_string := true; begin try string lexbuf - with Error (Unterminated_string, _) -> + with Error (Unterminated_string, str_start) -> match !comment_start_loc with | [] -> assert false | loc :: _ -> let start = List.hd (List.rev !comment_start_loc) in comment_start_loc := []; - raise (Error (Unterminated_string_in_comment start, loc)) + raise (Error (Unterminated_string_in_comment (start, str_start), + loc)) end; is_in_string := false; store_string_char '"'; @@ -511,13 +513,13 @@ and comment = parse store_lexeme lexbuf; is_in_string := true; begin try quoted_string delim lexbuf - with Error (Unterminated_string, _) -> + with Error (Unterminated_string, str_start) -> match !comment_start_loc with | [] -> assert false | loc :: _ -> let start = List.hd (List.rev !comment_start_loc) in comment_start_loc := []; - raise (Error (Unterminated_string_in_comment start, loc)) + raise (Error (Unterminated_string_in_comment (start, str_start), loc)) end; is_in_string := false; store_string_char '|'; diff --git a/parsing/parser.mly b/parsing/parser.mly index 8b69f265ea..5a414ef848 100644 --- a/parsing/parser.mly +++ b/parsing/parser.mly @@ -510,16 +510,18 @@ top_structure_tail: ; use_file: use_file_tail { $1 } - | seq_expr post_item_attributes use_file_tail { Ptop_def[mkstrexp $1 $2] :: $3 } + | seq_expr post_item_attributes use_file_tail + { Ptop_def[mkstrexp $1 $2] :: $3 } ; use_file_tail: - EOF { [] } - | SEMISEMI EOF { [] } - | 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 } + EOF { [] } + | SEMISEMI EOF { [] } + | 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 } ; parse_core_type: core_type EOF { $1 } @@ -533,6 +535,25 @@ parse_pattern: /* Module expressions */ +functor_arg: + LPAREN RPAREN + { mkrhs "()" 2, None } + | LPAREN functor_arg_name COLON module_type RPAREN + { mkrhs $2 2, Some $4 } +; + +functor_arg_name: + UIDENT { $1 } + | UNDERSCORE { "_" } +; + +functor_args: + functor_args functor_arg + { $2 :: $1 } + | functor_arg + { [ $1 ] } +; + module_expr: mod_longident { mkmod(Pmod_ident (mkrhs $1 1)) } @@ -540,10 +561,12 @@ module_expr: { mkmod(Pmod_structure($2)) } | STRUCT structure error { unclosed "struct" 1 "end" 3 } - | FUNCTOR LPAREN UIDENT COLON module_type RPAREN MINUSGREATER module_expr - { mkmod(Pmod_functor(mkrhs $3 3, $5, $8)) } + | FUNCTOR functor_args MINUSGREATER module_expr + { List.fold_left (fun acc (n, t) -> mkmod(Pmod_functor(n, t, acc))) $4 $2 } | 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 @@ -595,7 +618,8 @@ 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}] -> + [ {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 -> @@ -605,7 +629,8 @@ structure_item: | None, _ :: _ -> not_expecting 2 "attribute" end } - | EXTERNAL val_ident COLON core_type EQUAL primitive_declaration post_item_attributes + | 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 ()))) } @@ -620,9 +645,11 @@ structure_item: | 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)) } + { 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)) } + { mkstr(Pstr_modtype (Mtd.mk (mkrhs $3 3) + ~typ:$5 ~attrs:$6 ~loc:(symbol_rloc()))) } | OPEN override_flag mod_longident post_item_attributes { mkstr(Pstr_open ($2, mkrhs $3 3, $4)) } | CLASS class_declarations @@ -639,8 +666,8 @@ module_binding_body: { $2 } | 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)) } + | functor_arg module_binding_body + { mkmod(Pmod_functor(fst $1, snd $1, $2)) } ; module_bindings: module_binding { [$1] } @@ -648,7 +675,7 @@ module_bindings: ; module_binding: UIDENT module_binding_body post_item_attributes - { Mb.mk (mkrhs $1 1) $2 ~attrs:$3 } + { Mb.mk (mkrhs $1 1) $2 ~attrs:$3 ~loc:(symbol_rloc ()) } ; /* Module types */ @@ -660,13 +687,15 @@ module_type: { mkmty(Pmty_signature $2) } | SIG signature error { unclosed "sig" 1 "end" 3 } - | FUNCTOR LPAREN UIDENT COLON module_type RPAREN MINUSGREATER module_type + | FUNCTOR functor_args MINUSGREATER module_type %prec below_WITH - { mkmty(Pmty_functor(mkrhs $3 3, $5, $8)) } + { List.fold_left (fun acc (n, t) -> mkmty(Pmty_functor(n, t, acc))) $4 $2 } | module_type WITH with_constraints { mkmty(Pmty_with($1, List.rev $3)) } | MODULE TYPE OF module_expr %prec below_LBRACKETAT { mkmty(Pmty_typeof $4) } + | LPAREN MODULE mod_longident RPAREN + { mkmty (Pmty_alias (mkrhs $3 3)) } | LPAREN module_type RPAREN { $2 } | LPAREN module_type error @@ -692,7 +721,8 @@ 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 + | 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()))) } @@ -701,13 +731,23 @@ signature_item: | EXCEPTION exception_declaration { mksig(Psig_exception $2) } | MODULE UIDENT module_declaration post_item_attributes - { mksig(Psig_module (Md.mk (mkrhs $2 2) $3 ~attrs:$4)) } + { 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)) } + { 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 ~attrs:$6)) } + { mksig(Psig_modtype (Mtd.mk (mkrhs $3 3) ~typ:$5 + ~loc:(symbol_rloc()) + ~attrs:$6)) } | OPEN override_flag mod_longident post_item_attributes { mksig(Psig_open ($2, mkrhs $3 3, $4)) } | INCLUDE module_type post_item_attributes %prec below_WITH @@ -724,7 +764,9 @@ module_declaration: 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] } @@ -732,7 +774,7 @@ module_rec_declarations: ; module_rec_declaration: UIDENT COLON module_type post_item_attributes - { Md.mk (mkrhs $1 1) $3 ~attrs:$4 } + { Md.mk (mkrhs $1 1) $3 ~attrs:$4 ~loc:(symbol_rloc()) } ; /* Class expressions */ @@ -1048,8 +1090,8 @@ expr: { mkexp_attrs (Pexp_ifthenelse($3, $5, None)) $2 } | WHILE ext_attributes seq_expr DO seq_expr DONE { mkexp_attrs (Pexp_while($3, $5)) $2 } - | FOR ext_attributes val_ident EQUAL seq_expr direction_flag seq_expr DO seq_expr DONE - { mkexp_attrs(Pexp_for(mkrhs $3 3, $5, $7, $6, $9)) $2 } + | FOR ext_attributes pattern EQUAL seq_expr direction_flag seq_expr DO seq_expr DONE + { mkexp_attrs(Pexp_for($3, $5, $7, $6, $9)) $2 } | expr COLONCOLON expr { mkexp_cons (rhs_loc 2) (ghexp(Pexp_tuple[$1;$3])) (symbol_rloc()) } | LPAREN COLONCOLON RPAREN LPAREN expr COMMA expr RPAREN @@ -1165,16 +1207,31 @@ simple_expr: { let (exten, fields) = $2 in mkexp (Pexp_record(fields, exten)) } | LBRACE record_expr error { unclosed "{" 1 "}" 3 } + | mod_longident DOT LBRACE record_expr RBRACE + { let (exten, fields) = $4 in + let rec_exp = mkexp(Pexp_record(fields, exten)) in + mkexp(Pexp_open(Fresh, mkrhs $1 1, rec_exp)) } + | mod_longident DOT LBRACE record_expr error + { unclosed "{" 3 "}" 5 } | LBRACKETBAR expr_semi_list opt_semi BARRBRACKET { mkexp (Pexp_array(List.rev $2)) } | LBRACKETBAR expr_semi_list opt_semi error { unclosed "[|" 1 "|]" 4 } | LBRACKETBAR BARRBRACKET { mkexp (Pexp_array []) } + | mod_longident DOT LBRACKETBAR expr_semi_list opt_semi BARRBRACKET + { mkexp(Pexp_open(Fresh, mkrhs $1 1, mkexp(Pexp_array(List.rev $4)))) } + | mod_longident DOT LBRACKETBAR expr_semi_list opt_semi error + { unclosed "[|" 3 "|]" 6 } | LBRACKET expr_semi_list opt_semi RBRACKET { reloc_exp (mktailexp (rhs_loc 4) (List.rev $2)) } | LBRACKET expr_semi_list opt_semi error { unclosed "[" 1 "]" 4 } + | mod_longident DOT LBRACKET expr_semi_list opt_semi RBRACKET + { let list_exp = reloc_exp (mktailexp (rhs_loc 6) (List.rev $4)) in + mkexp(Pexp_open(Fresh, mkrhs $1 1, list_exp)) } + | mod_longident DOT LBRACKET expr_semi_list opt_semi error + { unclosed "[" 3 "]" 6 } | PREFIXOP simple_expr { mkexp(Pexp_apply(mkoperator $1 1, ["",$2])) } | BANG simple_expr @@ -1187,6 +1244,10 @@ simple_expr: { unclosed "{<" 1 ">}" 4 } | LBRACELESS GREATERRBRACE { mkexp (Pexp_override [])} + | mod_longident DOT LBRACELESS field_expr_list opt_semi GREATERRBRACE + { mkexp(Pexp_open(Fresh, mkrhs $1 1, mkexp (Pexp_override(List.rev $4)))) } + | mod_longident DOT LBRACELESS field_expr_list opt_semi error + { unclosed "{<" 3 ">}" 6 } | simple_expr SHARP label { mkexp(Pexp_send($1, $3)) } | LPAREN MODULE module_expr RPAREN @@ -1196,6 +1257,12 @@ simple_expr: ghtyp (Ptyp_package $5))) } | LPAREN MODULE module_expr COLON error { unclosed "(" 1 ")" 5 } + | mod_longident DOT LPAREN MODULE module_expr COLON package_type RPAREN + { mkexp(Pexp_open(Fresh, mkrhs $1 1, + mkexp (Pexp_constraint (ghexp (Pexp_pack $5), + ghtyp (Ptyp_package $7))))) } + | mod_longident DOT LPAREN MODULE module_expr COLON error + { unclosed "(" 3 ")" 7 } | extension { mkexp (Pexp_extension $1) } ; @@ -1248,6 +1315,8 @@ let_binding_: (ghpat(Ppat_constraint(mkpatvar $1 1, poly)), exp) } | pattern EQUAL seq_expr { ($1, $3) } + | simple_pattern_not_ident COLON core_type EQUAL seq_expr + { (ghpat(Ppat_constraint($1, $3)), $5) } ; fun_binding: strict_binding @@ -1356,6 +1425,9 @@ pattern: simple_pattern: val_ident %prec below_EQUAL { mkpat(Ppat_var (mkrhs $1 1)) } + | simple_pattern_not_ident { $1 } +; +simple_pattern_not_ident: | UNDERSCORE { mkpat(Ppat_any) } | signed_constant diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli index 5de17d439c..7bf5537c6b 100644 --- a/parsing/parsetree.mli +++ b/parsing/parsetree.mli @@ -244,7 +244,7 @@ and expression_desc = | Pexp_while of expression * expression (* while E1 do E2 done *) | Pexp_for of - string loc * expression * expression * direction_flag * expression + pattern * expression * expression * direction_flag * expression (* for i = E1 to E2 do E3 done (flag = Upto) for i = E1 downto E2 do E3 done (flag = Downto) *) @@ -543,7 +543,7 @@ and module_type_desc = (* 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 ... *) @@ -551,6 +551,8 @@ and module_type_desc = (* module type of ME *) | Pmty_extension of extension (* [%id] *) + | Pmty_alias of Longident.t loc + (* (module M) *) and signature = signature_item list @@ -597,6 +599,7 @@ and module_declaration = pmd_name: string loc; pmd_type: module_type; pmd_attributes: attributes; (* ... [@@id1] [@@id2] *) + pmd_loc: Location.t; } (* S : MT *) @@ -605,6 +608,7 @@ and module_type_declaration = pmtd_name: string loc; pmtd_type: module_type option; pmtd_attributes: attributes; (* ... [@@id1] [@@id2] *) + pmtd_loc: Location.t; } (* S = MT S (abstract module type declaration, pmtd_type = None) @@ -637,7 +641,7 @@ and module_expr_desc = (* 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) *) @@ -704,6 +708,7 @@ and module_binding = pmb_name: string loc; pmb_expr: module_expr; pmb_attributes: attributes; + pmb_loc: Location.t; } (* X = ME *) diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml index f8db3d646a..7496ee2525 100644 --- a/parsing/pprintast.ml +++ b/parsing/pprintast.ml @@ -31,7 +31,6 @@ let numeric_chars = [ '0'; '1'; '2'; '3'; '4'; '5'; '6'; '7'; '8'; '9' ] (* type fixity = Infix| Prefix *) - let special_infix_strings = ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; ":="; "!=" ] @@ -56,6 +55,30 @@ let is_predef_option = function | (Ldot (Lident "*predef*","option")) -> true | _ -> false +(* which identifiers are in fact operators needing parentheses *) +let needs_parens txt = + is_infix (fixity_of_string txt) + || List.mem txt.[0] prefix_symbols + +(* some infixes need spaces around parens to avoid clashes with comment syntax *) +let needs_spaces txt = + txt.[0]='*' || txt.[String.length txt - 1] = '*' + +(* add parentheses to binders when they are in fact infix or prefix operators *) +let protect_ident ppf txt = + let format : (_, _, _) format = + if not (needs_parens txt) then "%s" + else if needs_spaces txt then "(@;%s@;)" + else "(%s)" + in fprintf ppf format txt + +let protect_longident ppf print_longident longprefix txt = + let format : (_, _, _) format = + if not (needs_parens txt) then "%a.%s" + else if needs_spaces txt then "(@;%a.%s@;)" + else "(%a.%s)" in + fprintf ppf format print_longident longprefix txt + type space_formatter = (unit, Format.formatter, unit) format let override = function @@ -160,17 +183,8 @@ class printer ()= object(self:'self) method longident f = function - | Lident s -> - (match s.[0] with - | 'a' .. 'z' | 'A' .. 'Z' | '_' - when not (is_infix (fixity_of_string s)) -> - pp f "%s" s - | _ -> pp f "(@;%s@;)" s ) - | Ldot(y,s) -> (match s.[0] with - | 'a'..'z' | 'A' .. 'Z' | '_' when not(is_infix (fixity_of_string s)) -> - pp f "%a.%s" self#longident y s - | _ -> - pp f "%a.(@;%s@;)@ " self#longident y s) + | Lident s -> protect_ident f s + | Ldot(y,s) -> protect_longident f self#longident y s | Lapply (y,s) -> pp f "%a(%a)" self#longident y self#longident s method longident_loc f x = pp f "%a" self#longident x.txt @@ -337,12 +351,7 @@ class printer ()= object(self:'self) end else match x.ppat_desc with | Ppat_alias (p, s) -> pp f "@[<2>%a@;as@;%a@]" - self#pattern p - (fun f s-> - if is_infix (fixity_of_string s.txt) - || List.mem s.txt.[0] prefix_symbols - then pp f "( %s )" s.txt - else pp f "%s" s.txt ) s (* RA*) + self#pattern p protect_ident s.txt (* RA*) | Ppat_or (p1, p2) -> (* *) pp f "@[<hov0>%a@]" (self#list ~sep:"@,|" self#pattern) (list_of_pattern [] x) | _ -> self#pattern1 f x @@ -372,14 +381,7 @@ class printer ()= object(self:'self) match x.ppat_desc with | Ppat_construct (({txt=Lident ("()"|"[]" as x);_}), _) -> pp f "%s" x | Ppat_any -> pp f "_"; - | Ppat_var ({txt = txt;_}) -> - if (is_infix (fixity_of_string txt)) || List.mem txt.[0] prefix_symbols then - if txt.[0]='*' || txt.[String.length txt - 1] = '*' then - pp f "(@;%s@;)@ " txt - else - pp f "(%s)" txt - else - pp f "%s" txt + | Ppat_var ({txt = txt;_}) -> protect_ident f txt | Ppat_array l -> pp f "@[<2>[|%a|]@]" (self#list self#pattern1 ~sep:";") l | Ppat_unpack (s) -> @@ -680,8 +682,8 @@ class printer ()= object(self:'self) pp f fmt self#expression e1 self#expression e2 | Pexp_for (s, e1, e2, df, e3) -> let fmt:(_,_,_)format = - "@[<hv0>@[<hv2>@[<2>for %s =@;%a@;%a%a@;do@]@;%a@]@;done@]" in - pp f fmt s.txt self#expression e1 self#direction_flag df self#expression e2 self#expression e3 + "@[<hv0>@[<hv2>@[<2>for %a =@;%a@;%a%a@;do@]@;%a@]@;done@]" in + pp f fmt self#pattern s self#expression e1 self#direction_flag df self#expression e2 self#expression e3 | _ -> self#paren true self#expression f x method attributes f l = @@ -831,10 +833,14 @@ class printer ()= object(self:'self) match x.pmty_desc with | Pmty_ident li -> pp f "%a" self#longident_loc li; + | Pmty_alias li -> + pp f "(module %a)" self#longident_loc li; | Pmty_signature (s) -> pp f "@[<hv0>@[<hv2>sig@ %a@]@ end@]" (* "@[<hov>sig@ %a@ end@]" *) (self#list self#signature_item ) s (* FIXME wrong indentation*) - | Pmty_functor (s, mt1, mt2) -> + | Pmty_functor (_, None, mt2) -> + pp f "@[<hov2>functor () ->@ %a@]" self#module_type mt2 + | Pmty_functor (s, Some mt1, mt2) -> pp f "@[<hov2>functor@ (%s@ :@ %a)@ ->@ %a@]" s.txt self#module_type mt1 self#module_type mt2 | Pmty_with (mt, l) -> @@ -873,10 +879,7 @@ class printer ()= object(self:'self) pp f "@[<2>%a@]" (fun f vd -> let intro = if vd.pval_prim = [] then "val" else "external" in - if (is_infix (fixity_of_string vd.pval_name.txt)) || List.mem vd.pval_name.txt.[0] prefix_symbols then - pp f "%s@ (@ %s@ )@ :@ " intro vd.pval_name.txt - else - pp f "%s@ %s@ :@ " intro vd.pval_name.txt; + pp f "%s@ %a@ :@ " intro protect_ident vd.pval_name.txt; self#value_description f vd;) vd | Psig_exception ed -> self#exception_declaration f ed @@ -891,8 +894,13 @@ class printer ()= object(self:'self) (fun f l -> match l with |[] ->() |[x] -> pp f "@[<2>class %a@]" class_description x - |_ -> self#list ~first:"@[<v0>class @[<2>" ~sep:"@]@;and @[" ~last:"@]@]" - class_description f l) l + |_ -> + self#list ~first:"@[<v0>class @[<2>" ~sep:"@]@;and @[" + ~last:"@]@]" class_description f l) + l + | Psig_module {pmd_name; pmd_type={pmty_desc=Pmty_alias alias}} -> + pp f "@[<hov>module@ %s@ =@ %a@]" + pmd_name.txt self#longident_loc alias | Psig_module pmd -> pp f "@[<hov>module@ %s@ :@ %a@]" pmd.pmd_name.txt @@ -940,7 +948,9 @@ class printer ()= object(self:'self) 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 +1035,8 @@ class printer ()= object(self:'self) | Pstr_module x -> let rec module_helper me = match me.pmod_desc with | Pmod_functor(s,mt,me) -> - pp f "(%s:%a)" s.txt self#module_type mt ; + if mt = None then pp f "()" + else Misc.may (pp f "(%s:%a)" s.txt self#module_type) mt; module_helper me | _ -> me in pp f "@[<hov2>module %s%a@]" @@ -1088,13 +1099,7 @@ class printer ()= object(self:'self) | Pstr_class_type (l) -> self#class_type_declaration_list f l ; | Pstr_primitive vd -> - let need_parens = - match vd.pval_name.txt with - | "or" | "mod" | "land"| "lor" | "lxor" | "lsl" | "lsr" | "asr" -> true - | _ -> match vd.pval_name.txt.[0] with - 'a'..'z' -> false | _ -> true in - pp f "@[<hov2>external@ %s@ :@ %a@]" - (if need_parens then "( "^vd.pval_name.txt^" )" else vd.pval_name.txt) + pp f "@[<hov2>external@ %a@ :@ %a@]" protect_ident vd.pval_name.txt self#value_description vd | Pstr_include (me, _attrs) -> pp f "@[<hov2>include@ %a@]" self#module_expr me diff --git a/parsing/printast.ml b/parsing/printast.ml index dfaf8ce8be..48bfe9f5ba 100644 --- a/parsing/printast.ml +++ b/parsing/printast.ml @@ -299,8 +299,9 @@ and expression i ppf x = line i ppf "Pexp_while\n"; expression i ppf e1; expression i ppf e2; - | Pexp_for (s, e1, e2, df, e3) -> - line i ppf "Pexp_for %a %a\n" fmt_direction_flag df fmt_string_loc s; + | Pexp_for (p, e1, e2, df, e3) -> + line i ppf "Pexp_for %a\n" fmt_direction_flag df; + pattern i ppf p; expression i ppf e1; expression i ppf e2; expression i ppf e3; @@ -571,12 +572,13 @@ and module_type i ppf x = let i = i+1 in match x.pmty_desc with | Pmty_ident li -> line i ppf "Pmty_ident %a\n" fmt_longident_loc li; + | Pmty_alias li -> line i ppf "Pmty_alias %a\n" fmt_longident_loc li; | Pmty_signature (s) -> line i ppf "Pmty_signature\n"; signature i ppf s; | Pmty_functor (s, mt1, mt2) -> line i ppf "Pmty_functor %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 +672,7 @@ and module_expr i ppf x = 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"; diff --git a/parsing/syntaxerr.ml b/parsing/syntaxerr.ml index 13212eecd3..e239d6fe2a 100644 --- a/parsing/syntaxerr.ml +++ b/parsing/syntaxerr.ml @@ -46,7 +46,7 @@ let prepare_error = function are not supported when the option -no-app-func is set." | Variable_in_scope (loc, var) -> Location.errorf ~loc - "Error: In this scoped type, variable '%s@ \ + "Error: In this scoped type, variable '%s \ is reserved for the local type %s." var var | Other loc -> diff --git a/stdlib/.depend b/stdlib/.depend index 5d0147afe4..e5b65ad513 100644 --- a/stdlib/.depend +++ b/stdlib/.depend @@ -36,7 +36,7 @@ scanf.cmi : pervasives.cmi set.cmi : sort.cmi : stack.cmi : -stdLabels.cmi : +stdLabels.cmi : stringLabels.cmi listLabels.cmi arrayLabels.cmi stream.cmi : string.cmi : stringLabels.cmi : @@ -61,15 +61,15 @@ camlinternalMod.cmo : obj.cmi camlinternalOO.cmi array.cmi \ camlinternalMod.cmx : obj.cmx camlinternalOO.cmx array.cmx \ camlinternalMod.cmi camlinternalOO.cmo : sys.cmi string.cmi obj.cmi map.cmi list.cmi char.cmi \ - callback.cmi array.cmi camlinternalOO.cmi + array.cmi camlinternalOO.cmi camlinternalOO.cmx : sys.cmx string.cmx obj.cmx map.cmx list.cmx char.cmx \ - callback.cmx array.cmx camlinternalOO.cmi + array.cmx camlinternalOO.cmi char.cmo : char.cmi char.cmx : char.cmi complex.cmo : complex.cmi complex.cmx : complex.cmi -digest.cmo : string.cmi printf.cmi char.cmi digest.cmi -digest.cmx : string.cmx printf.cmx char.cmx digest.cmi +digest.cmo : string.cmi char.cmi digest.cmi +digest.cmx : string.cmx char.cmx digest.cmi filename.cmo : sys.cmi string.cmi random.cmi printf.cmi lazy.cmi buffer.cmi \ filename.cmi filename.cmx : sys.cmx string.cmx random.cmx printf.cmx lazy.cmx buffer.cmx \ @@ -171,15 +171,15 @@ camlinternalMod.cmo : obj.cmi camlinternalOO.cmi array.cmi \ camlinternalMod.p.cmx : obj.p.cmx camlinternalOO.p.cmx array.p.cmx \ camlinternalMod.cmi camlinternalOO.cmo : sys.cmi string.cmi obj.cmi map.cmi list.cmi char.cmi \ - callback.cmi array.cmi camlinternalOO.cmi + array.cmi camlinternalOO.cmi camlinternalOO.p.cmx : sys.p.cmx string.p.cmx obj.p.cmx map.p.cmx list.p.cmx char.p.cmx \ - callback.p.cmx array.p.cmx camlinternalOO.cmi + array.p.cmx camlinternalOO.cmi char.cmo : char.cmi char.p.cmx : char.cmi complex.cmo : complex.cmi complex.p.cmx : complex.cmi -digest.cmo : string.cmi printf.cmi char.cmi digest.cmi -digest.p.cmx : string.p.cmx printf.p.cmx char.p.cmx digest.cmi +digest.cmo : string.cmi char.cmi digest.cmi +digest.p.cmx : string.p.cmx char.p.cmx digest.cmi filename.cmo : sys.cmi string.cmi random.cmi printf.cmi lazy.cmi buffer.cmi \ filename.cmi filename.p.cmx : sys.p.cmx string.p.cmx random.p.cmx printf.p.cmx lazy.p.cmx buffer.p.cmx \ diff --git a/stdlib/Compflags b/stdlib/Compflags index 707487fd02..d0938af89a 100755 --- a/stdlib/Compflags +++ b/stdlib/Compflags @@ -20,9 +20,6 @@ case $1 in # make sure add_char is inlined (PR#5872) buffer.cm[io]|printf.cm[io]|format.cm[io]|scanf.cm[io]) echo ' -w A';; scanf.cmx|scanf.p.cmx) echo ' -inline 9';; - arrayLabels.cm[ox]|arrayLabels.p.cmx) echo ' -nolabels';; - listLabels.cm[ox]|listLabels.p.cmx) echo ' -nolabels';; - stringLabels.cm[ox]|stringLabels.p.cmx) echo ' -nolabels';; - moreLabels.cm[ox]|moreLabels.p.cmx) echo ' -nolabels';; + *Labels.cm[ox]|*Labels.p.cmx) echo ' -nolabels -trans-mod';; *) echo ' ';; esac diff --git a/stdlib/Makefile.shared b/stdlib/Makefile.shared index bb2ef88fda..80c40d6002 100755 --- a/stdlib/Makefile.shared +++ b/stdlib/Makefile.shared @@ -12,10 +12,13 @@ ######################################################################### include ../config/Makefile -CAMLC=$(CAMLC_BIN) -COMPFLAGS=-strict-sequence -w +33..39 -g -warn-error A -nostdlib -CAMLOPT=$(CAMLOPT_BIN) -OPTCOMPFLAGS=-warn-error A -nostdlib -g +RUNTIME=../boot/ocamlrun +COMPILER=../ocamlc +CAMLC=$(RUNTIME) $(COMPILER) +COMPFLAGS=-strict-sequence -w +33..39 -g -warn-error A -bin-annot -nostdlib +OPTCOMPILER=../ocamlopt +CAMLOPT=$(RUNTIME) $(OPTCOMPILER) +OPTCOMPFLAGS=-warn-error A -nostdlib -g -bin-annot CAMLDEP=../boot/ocamlrun ../tools/ocamldep OBJS=pervasives.cmo $(OTHERS) @@ -75,6 +78,12 @@ clean:: .ml.p.cmx: $(CAMLOPT) $(OPTCOMPFLAGS) `./Compflags $@` -p -c -o $*.p.cmx $< +# Dependencies on the compiler +$(OBJS) std_exit.cmo: $(COMPILER) +$(OBJS:.cmo=.cmi) std_exit.cmi: $(COMPILER) +$(OBJS:.cmo=.cmx) std_exit.cmx: $(OPTCOMPILER) +$(OBJS:.cmo=.p.cmx) std_exit.p.cmx: $(OPTCOMPILER) + # Dependencies on Pervasives (not tracked by ocamldep) $(OBJS) std_exit.cmo: pervasives.cmi $(OTHERS:.cmo=.cmi) std_exit.cmi: pervasives.cmi diff --git a/stdlib/arg.mli b/stdlib/arg.mli index 869d030e2c..e6e07316dc 100644 --- a/stdlib/arg.mli +++ b/stdlib/arg.mli @@ -94,7 +94,7 @@ val parse : *) val parse_dynamic : - (string * spec * string) list ref -> anon_fun -> string -> unit + (key * spec * doc) list ref -> anon_fun -> string -> unit (** Same as {!Arg.parse}, except that the [speclist] argument is a reference and may be updated during the parsing. A typical use for this feature is to parse command lines of the form: @@ -116,7 +116,7 @@ val parse_argv : ?current: int ref -> string array -> *) val parse_argv_dynamic : ?current:int ref -> string array -> - (string * spec * string) list ref -> anon_fun -> string -> unit + (key * spec * doc) list ref -> anon_fun -> string -> unit (** Same as {!Arg.parse_argv}, except that the [speclist] argument is a reference and may be updated during the parsing. See {!Arg.parse_dynamic}. diff --git a/stdlib/camlinternalMod.ml b/stdlib/camlinternalMod.ml index 20a65207f0..5f1882a2b4 100644 --- a/stdlib/camlinternalMod.ml +++ b/stdlib/camlinternalMod.ml @@ -16,6 +16,7 @@ type shape = | Lazy | Class | Module of shape array + | Value of Obj.t let rec init_mod loc shape = match shape with @@ -32,6 +33,8 @@ let rec init_mod loc shape = Obj.repr (CamlinternalOO.dummy_class loc) | Module comps -> Obj.repr (Array.map (init_mod loc) comps) + | Value v -> + v let overwrite o n = assert (Obj.size o >= Obj.size n); @@ -64,3 +67,5 @@ let rec update_mod shape o n = for i = 0 to Array.length comps - 1 do update_mod comps.(i) (Obj.field o i) (Obj.field n i) done + | Value v -> + overwrite o n diff --git a/stdlib/camlinternalMod.mli b/stdlib/camlinternalMod.mli index 4ec4fde1f2..96535d0e3a 100644 --- a/stdlib/camlinternalMod.mli +++ b/stdlib/camlinternalMod.mli @@ -20,6 +20,7 @@ type shape = | Lazy | Class | Module of shape array + | Value of Obj.t val init_mod: string * int * int -> shape -> Obj.t val update_mod: shape -> Obj.t -> Obj.t -> unit diff --git a/stdlib/camlinternalOO.ml b/stdlib/camlinternalOO.ml index c085096668..872a56065b 100644 --- a/stdlib/camlinternalOO.ml +++ b/stdlib/camlinternalOO.ml @@ -403,9 +403,12 @@ type tables = Empty | Cons of closure * tables * tables type mut_tables = {key: closure; mutable data: tables; mutable next: tables} external mut : tables -> mut_tables = "%identity" +external demut : mut_tables -> tables = "%identity" let build_path n keys tables = - let res = Cons (Obj.magic 0, Empty, Empty) in + (* Be careful not to create a seemingly immutable block, otherwise it could + be statically allocated. See #5779. *) + let res = demut {key = Obj.magic 0; data = Empty; next = Empty} in let r = ref res in for i = 0 to n do r := Cons (keys.(i), !r, Empty) diff --git a/stdlib/format.mli b/stdlib/format.mli index 1d8662bc6d..e7cbe506e6 100644 --- a/stdlib/format.mli +++ b/stdlib/format.mli @@ -381,21 +381,21 @@ type formatter_out_functions = { ;; val set_formatter_out_functions : formatter_out_functions -> unit;; -(** [set_formatter_out_functions out_funs] - Redirect the pretty-printer output to the functions [out_funs.out_string] - and [out_funs.out_flush] as described in +(** [set_formatter_out_functions f] + Redirect the pretty-printer output to the functions [f.out_string] + and [f.out_flush] as described in [set_formatter_output_functions]. In addition, the pretty-printer function - that outputs a newline is set to the function [out_funs.out_newline] and + that outputs a newline is set to the function [f.out_newline] and the function that outputs indentation spaces is set to the function - [out_funs.out_spaces]. + [f.out_spaces]. This way, you can change the meaning of indentation (which can be something else than just printing space characters) and the meaning of new lines opening (which can be connected to any other action needed by the - application at hand). The two functions [out_spaces] and [out_newline] are - normally connected to [out_string] and [out_flush]: respective default - values for [out_space] and [out_newline] are - [out_string (String.make n ' ') 0 n] and [out_string "\n" 0 1]. *) + application at hand). The two functions [f.out_spaces] and [f.out_newline] + are normally connected to [f.out_string] and [f.out_flush]: respective + 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;; (** Return the current output functions of the pretty-printer, @@ -567,14 +567,14 @@ val pp_get_formatter_out_functions : (** {6 Convenience formatting functions.} *) val pp_print_list: - ?pp_sep:(formatter -> unit -> unit) -> + ?pp_sep:(formatter -> unit -> unit) -> (formatter -> 'a -> unit) -> (formatter -> 'a list -> unit) (** [pp_print_list ?pp_sep pp_v ppf l] prints the list [l]. [pp_v] is used on the elements of [l] and each element is separated by a call to [pp_sep] (defaults to {!pp_print_cut}). Does nothing on empty lists. - @since 4.02 + @since 4.02.0 *) val pp_print_text : formatter -> string -> unit @@ -582,7 +582,7 @@ val pp_print_text : formatter -> string -> unit respectively printed with {!pp_print_space} and {!pp_force_newline}. - @since 4.02 + @since 4.02.0 *) (** {6 [printf] like functions for pretty-printing.} *) @@ -652,9 +652,7 @@ val fprintf : formatter -> ('a, formatter, unit) format -> 'a;; It prints [x = 1] within a pretty-printing box. Note: If you need to prevent the interpretation of a [@] character as a - pretty-printing indication, escape it with a [%] character, as usual in - format strings. - @since 3.12.2 + pretty-printing indication, you can also escape it with a [%] character. *) @@ -717,14 +715,14 @@ val ksprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b;; (** {6 Deprecated} *) val bprintf : Buffer.t -> ('a, formatter, unit) format -> 'a;; -(** A deprecated and error prone function. Do not use it. +(** @deprecated This function is error prone. Do not use it. If you need to print to some buffer [b], you must first define a formatter writing to [b], using [let to_b = formatter_of_buffer b]; then use regular calls to [Format.fprintf] on formatter [to_b]. *) val kprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b;; -(** A deprecated synonym for [ksprintf]. *) +(** @deprecated An alias for [ksprintf]. *) val set_all_formatter_output_functions : out:(string -> int -> int -> unit) -> @@ -733,8 +731,7 @@ val set_all_formatter_output_functions : spaces:(int -> unit) -> unit ;; -(** Deprecated. Subsumed by [set_formatter_out_functions]. - @since 4.00.0 +(** @deprecated Subsumed by [set_formatter_out_functions]. *) val get_all_formatter_output_functions : @@ -744,15 +741,13 @@ val get_all_formatter_output_functions : (unit -> unit) * (int -> unit) ;; -(** Deprecated. Subsumed by [get_formatter_out_functions]. - @since 4.00.0 +(** @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 ;; -(** Deprecated. Subsumed by [pp_set_formatter_out_functions]. - @since 4.01.0 +(** @deprecated Subsumed by [pp_set_formatter_out_functions]. *) val pp_get_all_formatter_output_functions : @@ -760,6 +755,5 @@ val pp_get_all_formatter_output_functions : (string -> int -> int -> unit) * (unit -> unit) * (unit -> unit) * (int -> unit) ;; -(** Deprecated. Subsumed by [pp_get_formatter_out_functions]. - @since 4.01.0 +(** @deprecated Subsumed by [pp_get_formatter_out_functions]. *) diff --git a/stdlib/gc.mli b/stdlib/gc.mli index 5437ac0a44..d2f2d97611 100644 --- a/stdlib/gc.mli +++ b/stdlib/gc.mli @@ -86,8 +86,11 @@ type control = this parameter will trigger a minor collection. Default: 32k. *) mutable major_heap_increment : int; - (** The minimum number of words to add to the - major heap when increasing it. Default: 124k. *) + (** How much to add to the major heap when increasing it. If this + number is less than or equal to 1000, it is a percentage of + the current heap size (i.e. setting it to 100 will double the heap + size at each increase). If it is more than 1000, it is a fixed + number of words that will be added to the heap. Default: 15. *) mutable space_overhead : int; (** The major GC speed is computed from this parameter. diff --git a/stdlib/hashtbl.mli b/stdlib/hashtbl.mli index bb75751fe6..5424df40d1 100644 --- a/stdlib/hashtbl.mli +++ b/stdlib/hashtbl.mli @@ -68,7 +68,8 @@ val clear : ('a, 'b) t -> unit val reset : ('a, 'b) t -> unit (** Empty a hash table and shrink the size of the bucket table - to its initial size. *) + to its initial size. + @since 4.00.0 *) val copy : ('a, 'b) t -> ('a, 'b) t (** Return a copy of the given hashtable. *) diff --git a/stdlib/pervasives.ml b/stdlib/pervasives.ml index 43e23cc525..e4a07c3dea 100644 --- a/stdlib/pervasives.ml +++ b/stdlib/pervasives.ml @@ -85,8 +85,8 @@ external ( lsl ) : int -> int -> int = "%lslint" external ( lsr ) : int -> int -> int = "%lsrint" external ( asr ) : int -> int -> int = "%asrint" -let min_int = 1 lsl (if 1 lsl 31 = 0 then 30 else 62) -let max_int = min_int - 1 +let max_int = (-1) lsr 1 +let min_int = max_int + 1 (* Floating-point operations *) diff --git a/stdlib/scanf.mli b/stdlib/scanf.mli index 43bd3d05cb..a1b3d1acbf 100644 --- a/stdlib/scanf.mli +++ b/stdlib/scanf.mli @@ -322,30 +322,30 @@ val bscanf : Scanning.in_channel -> ('a, 'b, 'c, 'd) scanner;; the format specified by the second letter for regular integers. - [Ld], [Li], [Lu], [Lx], [LX], [Lo]: reads an [int64] argument to the format specified by the second letter for regular integers. - - [\[ range \]]: reads characters that matches one of the characters + - [[ range ]]: reads characters that matches one of the characters mentioned in the range of characters [range] (or not mentioned in it, if the range starts with [^]). Reads a [string] that can be empty, if the next input character does not match the range. The set of characters from [c1] to [c2] (inclusively) is denoted by [c1-c2]. - Hence, [%\[0-9\]] returns a string representing a decimal number + Hence, [%[0-9]] returns a string representing a decimal number or an empty string if no decimal digit is found; similarly, - [%\[\\048-\\057\\065-\\070\]] returns a string of hexadecimal digits. + [%[0-9a-f]] returns a string of hexadecimal digits. If a closing bracket appears in a range, it must occur as the first character of the range (or just after the [^] in case of - range negation); hence [\[\]\]] matches a [\]] character and - [\[^\]\]] matches any character that is not [\]]. - Use [%%] and [%\@] to include a [%] or a [\@] in a range. + range negation); hence [[\]]] matches a [\]] character and + [[^\]]] matches any character that is not [\]]. + Use [%%] and [%@] to include a [%] or a [@] in a range. - [r]: user-defined reader. Takes the next [ri] formatted input function and applies it to the scanning buffer [ib] to read the next argument. The input function [ri] must therefore have type [Scanning.in_channel -> 'a] and the argument read has type ['a]. - - [\{ fmt %\}]: reads a format string argument. The format string + - [{ fmt %}]: reads a format string argument. The format string read must have the same type as the format string specification [fmt]. For instance, ["%{ %i %}"] reads any format string that can read a value of type [int]; hence, if [s] is the string ["fmt:\"number is %u\""], then [Scanf.sscanf s "fmt: %{%i%}"] succeeds and returns the format string ["number is %u"]. - - [\( fmt %\)]: scanning sub-format substitution. + - [( fmt %)]: scanning sub-format substitution. Reads a format string [rf] in the input, then goes on scanning with [rf] instead of scanning with [fmt]. The format string [rf] must have the same type as the format string @@ -357,21 +357,19 @@ val bscanf : Scanning.in_channel -> ('a, 'b, 'c, 'd) scanner;; Hence, if [s] is the string ["\"%4d\"1234.00"], then [Scanf.sscanf s "%(%i%)" (fun fmt i -> fmt, i)] evaluates to [("%4d", 1234)]. - This behaviour is not mere format substitution, since the conversion returns the format string read as additional argument. If you need pure format substitution, use special flag [_] to discard the - extraneous argument: conversion [%_\( fmt %\)] reads a format string + extraneous argument: conversion [%_( fmt %)] reads a format string [rf] and then behaves the same as format string [rf]. Hence, if [s] is the string ["\"%4d\"1234.00"], then [Scanf.sscanf s "%_(%i%)"] is simply equivalent to [Scanf.sscanf "1234.00" "%4d"]. - - [l]: returns the number of lines read so far. - [n]: returns the number of characters read so far. - [N] or [L]: returns the number of tokens read so far. - [!]: matches the end of input condition. - [%]: matches one [%] character in the input. - - [\@]: matches one [\@] character in the input. + - [@]: matches one [@] character in the input. - [,]: does nothing. Following the [%] character that introduces a conversion, there may be @@ -383,7 +381,7 @@ val bscanf : Scanning.in_channel -> ('a, 'b, 'c, 'd) scanner;; The field width is composed of an optional integer literal indicating the maximal width of the token to read. For instance, [%6d] reads an integer, having at most 6 decimal digits; - [%4f] reads a float with at most 4 characters; and [%8[\\000-\\255]] + [%4f] reads a float with at most 4 characters; and [%8[\000-\255]] returns the next 8 characters (or all the characters still available, if fewer than 8 characters are available in the input). @@ -408,18 +406,18 @@ val bscanf : Scanning.in_channel -> ('a, 'b, 'c, 'd) scanner;; (** Scanning indications appear just after the string conversions [%s] and [%[ range ]] to delimit the end of the token. A scanning - indication is introduced by a [\@] character, followed by some + indication is introduced by a [@] character, followed by some plain character [c]. It means that the string token should end just before the next matching [c] (which is skipped). If no [c] character is encountered, the string token spreads as much as possible. For instance, ["%s@\t"] reads a string up to the next - tab character or to the end of input. If a [\@] character appears + tab character or to the end of input. If a [@] character appears anywhere else in the format string, it is treated as a plain character. Note: - - As usual in format strings, [%] and [\@] characters must be escaped - using [%%] and [%\@]; this rule still holds within range specifications + - As usual in format strings, [%] and [@] characters must be escaped + using [%%] and [%@]; this rule still holds within range specifications and scanning indications. For instance, ["%s@%%"] reads a string up to the next [%] character. - The scanning indications introduce slight differences in the syntax of @@ -428,7 +426,7 @@ val bscanf : Scanning.in_channel -> ('a, 'b, 'c, 'd) scanner;; the [Format] module; hence, when producing formatted text to be scanned by [!Scanf.bscanf], it is wise to use printing functions from the [Format] module (or, if you need to use functions from [Printf], banish - or carefully double check the format strings that contain ['\@'] + or carefully double check the format strings that contain ['@'] characters). *) diff --git a/stdlib/stdLabels.mli b/stdlib/stdLabels.mli index bf9ef6547a..144936f170 100644 --- a/stdlib/stdLabels.mli +++ b/stdlib/stdLabels.mli @@ -20,123 +20,6 @@ in [arrayLabels.mli], [listLabels.mli] and [stringLabels.mli]. *) -module Array : - sig - external length : 'a array -> int = "%array_length" - external get : 'a array -> int -> 'a = "%array_safe_get" - external set : 'a array -> int -> 'a -> unit = "%array_safe_set" - external make : int -> 'a -> 'a array = "caml_make_vect" - external create : int -> 'a -> 'a array = "caml_make_vect" - val init : int -> f:(int -> 'a) -> 'a array - val make_matrix : dimx:int -> dimy:int -> 'a -> 'a array array - val create_matrix : dimx:int -> dimy:int -> 'a -> 'a array array - val append : 'a array -> 'a array -> 'a array - val concat : 'a array list -> 'a array - val sub : 'a array -> pos:int -> len:int -> 'a array - val copy : 'a array -> 'a array - 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 - val to_list : 'a array -> 'a list - val of_list : 'a list -> 'a array - val iter : f:('a -> unit) -> 'a array -> unit - val map : f:('a -> 'b) -> 'a array -> 'b array - val iteri : f:(int -> 'a -> unit) -> 'a array -> unit - val mapi : f:(int -> 'a -> 'b) -> 'a array -> 'b array - val fold_left : f:('a -> 'b -> 'a) -> init:'a -> 'b array -> 'a - val fold_right : f:('a -> 'b -> 'b) -> 'a array -> init:'b -> 'b - val sort : cmp:('a -> 'a -> int) -> 'a array -> unit - val stable_sort : cmp:('a -> 'a -> int) -> 'a array -> unit - val fast_sort : cmp:('a -> 'a -> int) -> 'a array -> unit - external unsafe_get : 'a array -> int -> 'a = "%array_unsafe_get" - external unsafe_set : 'a array -> int -> 'a -> unit = "%array_unsafe_set" - end - -module List : - sig - val length : 'a list -> int - val hd : 'a list -> 'a - val tl : 'a list -> 'a list - val nth : 'a list -> int -> 'a - val rev : 'a list -> 'a list - val append : 'a list -> 'a list -> 'a list - val rev_append : 'a list -> 'a list -> 'a list - val concat : 'a list list -> 'a list - val flatten : 'a list list -> 'a list - val iter : f:('a -> unit) -> 'a list -> unit - val map : f:('a -> 'b) -> 'a list -> 'b list - val rev_map : f:('a -> 'b) -> 'a list -> 'b list - val fold_left : f:('a -> 'b -> 'a) -> init:'a -> 'b list -> 'a - val fold_right : f:('a -> 'b -> 'b) -> 'a list -> init:'b -> 'b - val iter2 : f:('a -> 'b -> unit) -> 'a list -> 'b list -> unit - val map2 : f:('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list - val rev_map2 : f:('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list - val fold_left2 : - f:('a -> 'b -> 'c -> 'a) -> init:'a -> 'b list -> 'c list -> 'a - val fold_right2 : - f:('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> init:'c -> 'c - val for_all : f:('a -> bool) -> 'a list -> bool - val exists : f:('a -> bool) -> 'a list -> bool - val for_all2 : f:('a -> 'b -> bool) -> 'a list -> 'b list -> bool - val exists2 : f:('a -> 'b -> bool) -> 'a list -> 'b list -> bool - val mem : 'a -> set:'a list -> bool - val memq : 'a -> set:'a list -> bool - val find : f:('a -> bool) -> 'a list -> 'a - val filter : f:('a -> bool) -> 'a list -> 'a list - val find_all : f:('a -> bool) -> 'a list -> 'a list - val partition : f:('a -> bool) -> 'a list -> 'a list * 'a list - val assoc : 'a -> ('a * 'b) list -> 'b - val assq : 'a -> ('a * 'b) list -> 'b - val mem_assoc : 'a -> map:('a * 'b) list -> bool - val mem_assq : 'a -> map:('a * 'b) list -> bool - val remove_assoc : 'a -> ('a * 'b) list -> ('a * 'b) list - val remove_assq : 'a -> ('a * 'b) list -> ('a * 'b) list - val split : ('a * 'b) list -> 'a list * 'b list - val combine : 'a list -> 'b list -> ('a * 'b) list - val sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list - val stable_sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list - val fast_sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list - val merge : cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list - end - -module String : - sig - external length : string -> int = "%string_length" - external get : string -> int -> char = "%string_safe_get" - external set : string -> int -> char -> unit = "%string_safe_set" - external create : int -> string = "caml_create_string" - val make : int -> char -> string - val copy : string -> string - val sub : string -> pos:int -> len:int -> string - val fill : string -> pos:int -> len:int -> char -> unit - val blit : - src:string -> src_pos:int -> dst:string -> dst_pos:int -> len:int -> - unit - val concat : sep:string -> string list -> string - val iter : f:(char -> unit) -> string -> unit - val iteri : f:(int -> char -> unit) -> string -> unit - val map : f:(char -> char) -> string -> string - val trim : string -> string - val escaped : string -> string - val index : string -> char -> int - val rindex : string -> char -> int - val index_from : string -> int -> char -> int - val rindex_from : string -> int -> char -> int - val contains : string -> char -> bool - val contains_from : string -> int -> char -> bool - val rcontains_from : string -> int -> char -> bool - val uppercase : string -> string - val lowercase : string -> string - val capitalize : string -> string - val uncapitalize : string -> string - type t = string - val compare: t -> t -> int - external unsafe_get : string -> int -> char = "%string_unsafe_get" - external unsafe_set : string -> int -> char -> unit = "%string_unsafe_set" - external unsafe_blit : - src:string -> src_pos:int -> dst:string -> dst_pos:int -> len:int -> - unit = "caml_blit_string" "noalloc" - external unsafe_fill : string -> pos:int -> len:int -> char -> unit - = "caml_fill_string" "noalloc" - end +module Array = ArrayLabels +module List = ListLabels +module String = StringLabels diff --git a/testsuite/Makefile b/testsuite/Makefile index e84d826c6d..813f4dabb7 100644 --- a/testsuite/Makefile +++ b/testsuite/Makefile @@ -10,7 +10,7 @@ # # ######################################################################### -BASEDIR=${PWD} +BASEDIR := $(shell pwd) NO_PRINT=`$(MAKE) empty --no-print-directory >/dev/null 2>&1 && echo '--no-print-directory'` FIND=find diff --git a/testsuite/external/.ignore b/testsuite/external/.ignore index 1ebcf4357b..8d1415349c 100644 --- a/testsuite/external/.ignore +++ b/testsuite/external/.ignore @@ -38,7 +38,7 @@ compcert-1.13 configfile config-file-1.1 coq -coq-8.4pl1 +coq-8.4pl2 core core-109.37.00 coreextended diff --git a/testsuite/external/Makefile b/testsuite/external/Makefile index 6159ed64bf..c91e98084c 100644 --- a/testsuite/external/Makefile +++ b/testsuite/external/Makefile @@ -40,14 +40,14 @@ default: all-cygwin: findlib ounit res pcre react ocamltext ocamlssl camlzip cryptokit \ sqlite ocgi xmllight configfile xmlm omake \ camomile zen vsyml extlib fileutils ocamlify ocamlmod \ - calendar dbm ocamlscript + calendar dbm ocamlscript coq compcert all-macos: findlib lablgtk ocamlgraph ounit res pcre core react ocamltext \ ocamlssl lwt camlzip cryptokit sqlite menhir hevea \ unison ocgi xmllight configfile xmlm lablgtkextras sks omake \ altergo boomerang camomile zen vsyml ocamlnet extlib fileutils \ odn ocamlify expect ocamlmod oasis calendar camlimages advi \ - dbm ocsigen ocamlscript framac + dbm ocsigen ocamlscript coq compcert framac platform: case `uname -s` in \ @@ -1018,7 +1018,7 @@ all: zarith ALTERGO=alt-ergo-0.95.2 ${ALTERGO}.tar.gz: ${WGET} http://alt-ergo.ocamlpro.com/download_manager.php?target=$@ -O $@ -altergo: ${ALTERGO}.tar.gz ocamlgraph +altergo: ${ALTERGO}.tar.gz ocamlgraph zarith printf "%s " "$@" >/dev/tty test -d ${PREFIX} rm -rf ${ALTERGO} @@ -1595,29 +1595,27 @@ all: camlpdf # rm -f ${GENEWEB}.tgz # all: geneweb -# disabled: Cannot find file q_coqast.cmo -# maybe because of the camlp5 -> camlp4 switch # http://coq.inria.fr/download -# COQ=coq-8.4pl1 -# ${COQ}.tar.gz: -# ${WGET} http://coq.inria.fr/distrib/V8.4pl1/files/$@ -# coq: ${COQ}.tar.gz -# printf "%s " "$@" >/dev/tty -# test -d ${PREFIX} -# rm -rf ${COQ} -# tar zxf ${COQ}.tar.gz -# ./Patcher.sh ${COQ} -# ( cd ${COQ} && \ -# export PATH=${PREFIX}/bin:$$PATH && \ -# ./configure -prefix ${PREFIX} -with-doc no && \ -# ${MAKE} world && \ -# ${MAKE} install ) -# echo ${VERSION} >$@ -# clean:: -# rm -rf ${COQ} coq -# distclean:: -# rm -f ${COQ}.tar.gz -# all: coq +COQ=coq-8.4pl2 +${COQ}.tar.gz: + ${WGET} http://coq.inria.fr/distrib/V8.4pl2/files/$@ +coq: ${COQ}.tar.gz + printf "%s " "$@" >/dev/tty + test -d ${PREFIX} + rm -rf ${COQ} + tar zxf ${COQ}.tar.gz + ./Patcher.sh ${COQ} + ( cd ${COQ} && \ + export PATH=${PREFIX}/bin:$$PATH && \ + ./configure -prefix ${PREFIX} -with-doc no && \ + ${MAKE} world && \ + ${MAKE} install ) + echo ${VERSION} >$@ +clean:: + rm -rf ${COQ} coq +distclean:: + rm -f ${COQ}.tar.gz +all: coq # http://code.google.com/p/bitstring/ @@ -1645,34 +1643,33 @@ distclean:: rm -f ${BITSTRING}.tar.gz all: bitstring -# disabled: depends on coq # http://compcert.inria.fr -# COMPCERT=compcert-1.13 -# ${COMPCERT}.tgz: -# ${WGET} http://compcert.inria.fr/release/$@ -# compcert: ${COMPCERT}.tgz coq bitstring -# printf "%s " "$@" >/dev/tty -# test -d ${PREFIX} -# rm -rf ${COMPCERT} -# tar zxf ${COMPCERT}.tgz -# ./Patcher.sh ${COMPCERT} -# ( cd ${COMPCERT} && \ -# export PATH=${PREFIX}/bin:$$PATH && \ -# sh ./configure -prefix ${PREFIX} ppc-linux && \ -# ${MAKE} all && \ -# ${MAKE} install ) -# echo ${VERSION} >$@ -# clean:: -# rm -rf ${COMPCERT} compcert -# distclean:: -# rm -f ${COMPCERT}.tgz -# all: compcert +COMPCERT=compcert-1.13 +${COMPCERT}.tgz: + ${WGET} http://compcert.inria.fr/release/$@ +compcert: ${COMPCERT}.tgz coq bitstring + printf "%s " "$@" >/dev/tty + test -d ${PREFIX} + rm -rf ${COMPCERT} + tar zxf ${COMPCERT}.tgz + ./Patcher.sh ${COMPCERT} + ( cd ${COMPCERT} && \ + export PATH=${PREFIX}/bin:$$PATH && \ + sh ./configure -prefix ${PREFIX} ppc-linux && \ + ${MAKE} all && \ + ${MAKE} install ) + echo ${VERSION} >$@ +clean:: + rm -rf ${COMPCERT} compcert +distclean:: + rm -f ${COMPCERT}.tgz +all: compcert # http://frama-c.com/ FRAMAC=frama-c-Oxygen-20120901 ${FRAMAC}.tar.gz: ${WGET} http://frama-c.com/download/$@ -framac: ${FRAMAC}.tar.gz lablgtk ocamlgraph altergo # coq removed (disabled) +framac: ${FRAMAC}.tar.gz lablgtk ocamlgraph altergo coq printf "%s " "$@" >/dev/tty test -d ${PREFIX} rm -rf ${FRAMAC} diff --git a/testsuite/external/coq-8.4pl2.patch b/testsuite/external/coq-8.4pl2.patch new file mode 100644 index 0000000000..50a94edb47 --- /dev/null +++ b/testsuite/external/coq-8.4pl2.patch @@ -0,0 +1,11 @@ +--- coq-8.4pl2/kernel/univ.ml.orig 2013-11-27 15:53:01.000000000 +0100 ++++ coq-8.4pl2/kernel/univ.ml 2013-11-27 15:53:20.000000000 +0100 +@@ -226,7 +226,7 @@ + + + (* between : UniverseLevel.t -> canonical_arc -> canonical_arc list *) +-(* between u v = {w|u<=w<=v, w canonical} *) ++(* between u v = {w |u<=w<=v, w canonical} *) + (* between is the most costly operation *) + + let between g arcu arcv = diff --git a/testsuite/makefiles/Makefile.common b/testsuite/makefiles/Makefile.common index 20af7ea4b9..ae6aceaa2e 100644 --- a/testsuite/makefiles/Makefile.common +++ b/testsuite/makefiles/Makefile.common @@ -37,19 +37,27 @@ SET_LD_PATH=CAML_LD_LIBRARY_PATH="$(LD_PATH)" # SORT is the Unix "sort" command. Usually a simple command, but may be an # absolute name if the Windows "sort" command is in the PATH. # SET_LD_PATH is a command prefix that sets the path for dynamic libraries -# (LD_LIBRARY_PATH for Unix, PATH for Windows) using the LD_PATH shell +# (CAML_LD_LIBRARY_PATH for Unix, PATH for Windows) using the LD_PATH shell # variable. Note that for Windows we add Unix-syntax directory names in # PATH, and Cygwin will translate it to Windows syntax. include $(TOPDIR)/config/Makefile +OCAMLRUN=$(TOPDIR)/boot/ocamlrun$(EXE) + OCFLAGS=-nostdlib -I $(OTOPDIR)/stdlib $(COMPFLAGS) OCOPTFLAGS= +ifeq ($(SUPPORTS_SHARED_LIBRARIES),false) + CUSTOM = -custom +else + CUSTOM = +endif + OCAML=$(OCAMLRUN) $(OTOPDIR)/ocaml $(OCFLAGS) \ -init $(OTOPDIR)/testsuite/lib/empty -OCAMLC=$$($(CAMLC_BIN_CMD_TO_EVAL)) $(OCFLAGS) -OCAMLOPT=$$($(CAMLOPT_BIN_CMD_TO_EVAL)) $(OCFLAGS) $(OCOPTFLAGS) +OCAMLC=$(OCAMLRUN) $(OTOPDIR)/ocamlc $(CUSTOM) $(OCFLAGS) +OCAMLOPT=$(OCAMLRUN) $(OTOPDIR)/ocamlopt $(OCFLAGS) OCAMLDOC=$(OCAMLRUN) $(OTOPDIR)/ocamldoc/ocamldoc OCAMLLEX=$(OCAMLRUN) $(OTOPDIR)/lex/ocamllex OCAMLMKLIB=$(OCAMLRUN) $(OTOPDIR)/tools/ocamlmklib \ @@ -84,23 +92,23 @@ defaultclean: .SUFFIXES: .mli .ml .mly .mll .cmi .cmo .cmx .cmm .cmxa .s .S .o .so .c .f .mli.cmi: - $(OCAMLC) -c $(ADD_COMPFLAGS) $< + @$(OCAMLC) -c $(ADD_COMPFLAGS) $< .ml.cmi: - $(OCAMLC) -c $(ADD_COMPFLAGS) $< + @$(OCAMLC) -c $(ADD_COMPFLAGS) $< .ml.cmo: @if [ -f $<i ]; then $(OCAMLC) -c $(ADD_COMPFLAGS) $<i; fi - $(OCAMLC) -c $(ADD_COMPFLAGS) $< + @$(OCAMLC) -c $(ADD_COMPFLAGS) $< .ml.cmx: - $(OCAMLOPT) -c $(ADD_COMPFLAGS) $< + @$(OCAMLOPT) -c $(ADD_COMPFLAGS) $< .cmx.so: - $(OCAMLOPT) -o $@ -shared $(ADD_COMPFLAGS) $< + @$(OCAMLOPT) -o $@ -shared $(ADD_COMPFLAGS) $< .cmxa.so: - $(OCAMLOPT) -o $@ -shared -linkall $(ADD_COMPFLAGS) $< + @$(OCAMLOPT) -o $@ -shared -linkall $(ADD_COMPFLAGS) $< .mly.ml: @$(OCAMLYACC) -q $< 2> /dev/null diff --git a/testsuite/makefiles/Makefile.one b/testsuite/makefiles/Makefile.one index 16d02e8e33..9f95b3656d 100644 --- a/testsuite/makefiles/Makefile.one +++ b/testsuite/makefiles/Makefile.one @@ -27,13 +27,14 @@ GENERATED_SOURCES=$(ML_LEX_FILES) $(ML_YACC_FILES) $(MLI_YACC_FILES) CUSTOM_FLAG=`if [ -n "$(C_FILES)" ]; then echo '-custom'; fi` ADD_CFLAGS+=$(CUSTOM_FLAG) -MYRUNTIME=`if [ -z "$(C_FILES)" ]; then echo '$(OCAMLRUN)'; fi` +MYRUNTIME=`if [ -z "$(C_FILES)$(CUSTOM)" ]; then echo '$(OCAMLRUN)'; fi` CC=$(NATIVECC) $(NATIVECCCOMPOPTS) .PHONY: default default: - @$(SET_LD_PATH) $(MAKE) compile run + @$(MAKE) compile + @$(SET_LD_PATH) $(MAKE) run .PHONY: compile compile: $(ML_FILES) $(CMO_FILES) $(MAIN_MODULE).cmo diff --git a/testsuite/makefiles/Makefile.several b/testsuite/makefiles/Makefile.several index d3cf3b1e59..3482e3af30 100644 --- a/testsuite/makefiles/Makefile.several +++ b/testsuite/makefiles/Makefile.several @@ -20,7 +20,7 @@ O_FILES=$(C_FILES:=.o) CUSTOM_FLAG=`if [ -n "$(C_FILES)" ]; then echo '-custom'; fi` ADD_CFLAGS+=$(CUSTOM_FLAG) -MYRUNTIME=`if [ -z "$(C_FILES)" ]; then echo '$(OCAMLRUN)'; fi` +MYRUNTIME=`if [ -z "$(C_FILES)$(CUSTOM)" ]; then echo '$(OCAMLRUN)'; fi` FORTRAN_LIB=`if [ -n "$(F_FILES)" ]; then echo '$(FORTRAN_LIBRARY)'; fi` ADD_CFLAGS+=$(FORTRAN_LIB) ADD_OPTFLAGS+=$(FORTRAN_LIB) @@ -44,7 +44,7 @@ run-all: CANKILL=$(CANKILL) sh `basename $$file ml`precheck || continue; \ fi; \ printf " ... testing '$$file':"; \ - $(MAKE) run-file DESC=ocamlc COMP="$(OCAMLC)" \ + $(MAKE) run-file DESC=ocamlc COMP='$(OCAMLC)' \ RUNTIME='$(MYRUNTIME)' \ COMPFLAGS='-w a $(ADD_COMPFLAGS) $(ADD_CFLAGS) $(O_FILES) \ $(CMA_FILES) -I $(OTOPDIR)/testsuite/lib \ @@ -52,7 +52,7 @@ run-all: FILE=$$file PROGRAM_ARGS=$(PROGRAM_ARGS) \ && \ if $(BYTECODE_ONLY); then : ; else \ - $(MAKE) run-file DESC=ocamlopt COMP="$(OCAMLOPT)" \ + $(MAKE) run-file DESC=ocamlopt COMP='$(OCAMLOPT)' \ RUNTIME= \ COMPFLAGS='-w a $(ADD_COMPFLAGS) $(ADD_OPTFLAGS) \ $(O_FILES) $(CMXA_FILES) \ @@ -61,7 +61,7 @@ run-all: fi \ && \ if [ -n "$(UNSAFE)" ]; then \ - $(MAKE) run-file DESC=ocamlc-unsafe COMP="$(OCAMLC)" \ + $(MAKE) run-file DESC=ocamlc-unsafe COMP='$(OCAMLC)' \ RUNTIME='$(MYRUNTIME)' \ COMPFLAGS='-w a -unsafe $(ADD_COMPFLAGS) $(ADD_CFLAGS) \ $(O_FILES) $(CMA_FILES) \ @@ -69,7 +69,7 @@ run-all: FILE=$$file \ && \ if $(BYTECODE_ONLY); then : ; else \ - $(MAKE) run-file DESC=ocamlopt-unsafe COMP="$(OCAMLOPT)" \ + $(MAKE) run-file DESC=ocamlopt-unsafe COMP='$(OCAMLOPT)' \ RUNTIME= \ COMPFLAGS='-w a -unsafe $(ADD_COMPFLAGS) $(ADD_OPTFLAGS)\ $(O_FILES) $(CMXA_FILES) \ diff --git a/testsuite/tests/asmcomp/Makefile b/testsuite/tests/asmcomp/Makefile index d83b79d2d2..aa37bf9e4b 100644 --- a/testsuite/tests/asmcomp/Makefile +++ b/testsuite/tests/asmcomp/Makefile @@ -22,91 +22,8 @@ INCLUDES=\ -I $(OTOPDIR)/asmcomp OTHEROBJS=\ - $(OTOPDIR)/utils/misc.cmo \ - $(OTOPDIR)/utils/tbl.cmo \ - $(OTOPDIR)/utils/config.cmo \ - $(OTOPDIR)/utils/clflags.cmo \ - $(OTOPDIR)/utils/terminfo.cmo \ - $(OTOPDIR)/utils/ccomp.cmo \ - $(OTOPDIR)/utils/warnings.cmo \ - $(OTOPDIR)/utils/consistbl.cmo \ - $(OTOPDIR)/parsing/location.cmo \ - $(OTOPDIR)/parsing/longident.cmo \ - $(OTOPDIR)/parsing/syntaxerr.cmo \ - $(OTOPDIR)/parsing/ast_helper.cmo \ - $(OTOPDIR)/parsing/ast_mapper.cmo \ - $(OTOPDIR)/parsing/parser.cmo \ - $(OTOPDIR)/parsing/lexer.cmo \ - $(OTOPDIR)/parsing/parse.cmo \ - $(OTOPDIR)/parsing/printast.cmo \ - $(OTOPDIR)/typing/ident.cmo \ - $(OTOPDIR)/typing/path.cmo \ - $(OTOPDIR)/typing/primitive.cmo \ - $(OTOPDIR)/typing/types.cmo \ - $(OTOPDIR)/typing/btype.cmo \ - $(OTOPDIR)/typing/oprint.cmo \ - $(OTOPDIR)/typing/subst.cmo \ - $(OTOPDIR)/typing/predef.cmo \ - $(OTOPDIR)/typing/datarepr.cmo \ - $(OTOPDIR)/typing/cmi_format.cmo \ - $(OTOPDIR)/typing/env.cmo \ - $(OTOPDIR)/typing/typedtree.cmo \ - $(OTOPDIR)/typing/ctype.cmo \ - $(OTOPDIR)/typing/printtyp.cmo \ - $(OTOPDIR)/typing/includeclass.cmo \ - $(OTOPDIR)/typing/mtype.cmo \ - $(OTOPDIR)/typing/includecore.cmo \ - $(OTOPDIR)/typing/includemod.cmo \ - $(OTOPDIR)/typing/parmatch.cmo \ - $(OTOPDIR)/typing/typetexp.cmo \ - $(OTOPDIR)/typing/typedtreeMap.cmo \ - $(OTOPDIR)/typing/cmt_format.cmo \ - $(OTOPDIR)/typing/stypes.cmo \ - $(OTOPDIR)/typing/typecore.cmo \ - $(OTOPDIR)/typing/typedecl.cmo \ - $(OTOPDIR)/typing/typeclass.cmo \ - $(OTOPDIR)/typing/typemod.cmo \ - $(OTOPDIR)/bytecomp/lambda.cmo \ - $(OTOPDIR)/bytecomp/printlambda.cmo \ - $(OTOPDIR)/bytecomp/typeopt.cmo \ - $(OTOPDIR)/bytecomp/switch.cmo \ - $(OTOPDIR)/bytecomp/matching.cmo \ - $(OTOPDIR)/bytecomp/translobj.cmo \ - $(OTOPDIR)/bytecomp/translcore.cmo \ - $(OTOPDIR)/bytecomp/translclass.cmo \ - $(OTOPDIR)/bytecomp/translmod.cmo \ - $(OTOPDIR)/bytecomp/simplif.cmo \ - $(OTOPDIR)/bytecomp/runtimedef.cmo \ - $(OTOPDIR)/asmcomp/arch.cmo \ - $(OTOPDIR)/asmcomp/debuginfo.cmo \ - $(OTOPDIR)/asmcomp/cmm.cmo \ - $(OTOPDIR)/asmcomp/printcmm.cmo \ - $(OTOPDIR)/asmcomp/reg.cmo \ - $(OTOPDIR)/asmcomp/mach.cmo \ - $(OTOPDIR)/asmcomp/proc.cmo \ - $(OTOPDIR)/asmcomp/clambda.cmo \ - $(OTOPDIR)/asmcomp/compilenv.cmo \ - $(OTOPDIR)/asmcomp/closure.cmo \ - $(OTOPDIR)/asmcomp/cmmgen.cmo \ - $(OTOPDIR)/asmcomp/printmach.cmo \ - $(OTOPDIR)/asmcomp/selectgen.cmo \ - $(OTOPDIR)/asmcomp/selection.cmo \ - $(OTOPDIR)/asmcomp/comballoc.cmo \ - $(OTOPDIR)/asmcomp/liveness.cmo \ - $(OTOPDIR)/asmcomp/spill.cmo \ - $(OTOPDIR)/asmcomp/split.cmo \ - $(OTOPDIR)/asmcomp/interf.cmo \ - $(OTOPDIR)/asmcomp/coloring.cmo \ - $(OTOPDIR)/asmcomp/reloadgen.cmo \ - $(OTOPDIR)/asmcomp/reload.cmo \ - $(OTOPDIR)/asmcomp/printlinear.cmo \ - $(OTOPDIR)/asmcomp/linearize.cmo \ - $(OTOPDIR)/asmcomp/schedgen.cmo \ - $(OTOPDIR)/asmcomp/scheduling.cmo \ - $(OTOPDIR)/asmcomp/emitaux.cmo \ - $(OTOPDIR)/asmcomp/emit.cmo \ - $(OTOPDIR)/asmcomp/printclambda.cmo \ - $(OTOPDIR)/asmcomp/asmgen.cmo + $(OTOPDIR)/compilerlibs/ocamlcommon.cma \ + $(OTOPDIR)/compilerlibs/ocamloptcomp.cma OBJS=parsecmmaux.cmo parsecmm.cmo lexcmm.cmo @@ -117,7 +34,9 @@ default: $(MAKE) all; \ fi -all: arch codegen tests +all: + $(MAKE) arch codegen + $(MAKE) tests codegen: parsecmm.ml lexcmm.ml $(OBJS:.cmo=.cmi) $(OBJS) main.cmo @$(OCAMLC) $(LINKFLAGS) -o codegen $(OTHEROBJS) $(OBJS) main.cmo @@ -128,6 +47,8 @@ parsecmm.mli parsecmm.ml: parsecmm.mly lexcmm.ml: lexcmm.mll @$(OCAMLLEX) -q lexcmm.mll +MLCASES=optargs staticalloc + CASES=fib tak quicksort quicksort2 soli \ arith checkbound tagged-fib tagged-integr tagged-quicksort tagged-tak ARGS_fib=-DINT_INT -DFUN=fib main.c @@ -148,13 +69,21 @@ tests: $(CASES:=.o) printf " ... testing '$$c':"; \ $(MAKE) one CC="$(CC) $(CFLAGS)" NAME=$$c; \ done + @for c in $(MLCASES); do \ + printf " ... testing '$$c':"; \ + $(MAKE) one_ml NAME=$$c; \ + done + +one_ml: + @$(OCAMLOPT) -o $(NAME).exe $(NAME).ml && \ + ./$(NAME).exe && echo " => passed" || echo " => failed" one: @$(CC) -o $(NAME).out $(ARGS_$(NAME)) $(NAME).o $(ARCH).o \ && echo " => passed" || echo " => failed" clean: defaultclean - @rm -f ./codegen *.out + @rm -f ./codegen *.out *.o *.obj *.exe @rm -f parsecmm.ml parsecmm.mli lexcmm.ml @rm -f $(CASES:=.s) diff --git a/testsuite/tests/asmcomp/amd64.S b/testsuite/tests/asmcomp/amd64.S index 846eab951b..16dbaec11b 100644 --- a/testsuite/tests/asmcomp/amd64.S +++ b/testsuite/tests/asmcomp/amd64.S @@ -58,7 +58,7 @@ CAML_C_CALL: #ifdef SYS_macosx .literal16 -#elif defined(SYS_mingw64) +#elif defined(SYS_mingw64) || defined(SYS_cygwin) .section .rodata.cst8 #else .section .rodata.cst8,"aM",@progbits,8 diff --git a/testsuite/tests/asmcomp/optargs.ml b/testsuite/tests/asmcomp/optargs.ml new file mode 100644 index 0000000000..d508672394 --- /dev/null +++ b/testsuite/tests/asmcomp/optargs.ml @@ -0,0 +1,23 @@ +(* Check the effectiveness of inlining the wrapper which fills in + default values for optional arguments. + + Ref: http://caml.inria.fr/mantis/view.php?id=6345 +*) + + +let rec f ?(flag = false) ?(acc = 0) = function + | [] -> if flag then acc else acc + 1 + | hd :: tl -> f ~flag ~acc:(acc + hd) tl + +let () = + let l = [1;2;3;4;5;6;7;8;9] in + let x0 = Gc.allocated_bytes () in + let x1 = Gc.allocated_bytes () in + for i = 1 to 1000 do + ignore (f l) + done; + let x2 = Gc.allocated_bytes () in + assert(x1 -. x0 = x2 -. x1) + (* check that we did not allocated anything between x1 and x2 *) + + diff --git a/testsuite/tests/asmcomp/staticalloc.ml b/testsuite/tests/asmcomp/staticalloc.ml new file mode 100644 index 0000000000..e21fdee633 --- /dev/null +++ b/testsuite/tests/asmcomp/staticalloc.ml @@ -0,0 +1,19 @@ +(* Check the effectiveness of structured constant propagation and + static allocation. + + Ref: http://caml.inria.fr/mantis/view.php?id=5779 +*) + +let () = + let x0 = Gc.allocated_bytes () in + let x1 = Gc.allocated_bytes () in + let pair x y = (x, y) in + let a = pair 1 2 in + let b = pair a ["x";"y"] in + let g () = (a, fst b) in + assert (g () == ((1,2), (1,2))); + assert (fst (pair a a) == (1, 2)); + assert (snd b != ["x"; "y"]); (* mutable "constant", cannot be shared *) + let x2 = Gc.allocated_bytes () in + assert(x1 -. x0 = x2 -. x1) + (* check that we did not allocated anything between x1 and x2 *) diff --git a/testsuite/tests/backtrace/Makefile b/testsuite/tests/backtrace/Makefile index 83f94721fb..32533fd606 100644 --- a/testsuite/tests/backtrace/Makefile +++ b/testsuite/tests/backtrace/Makefile @@ -62,7 +62,7 @@ native: @for file in $(OTHERFILES); do \ rm -f program program.exe; \ $(OCAMLOPT) -g -o $(EXECNAME) $$file; \ - printf " ... testing '$$file' with ocamlc:"; \ + printf " ... testing '$$file' with ocamlopt:"; \ F="`basename $$file .ml`"; \ (OCAMLRUNPARAM=b=1 ./$(EXECNAME) $$arg || true) \ >$$F.native.result 2>&1; \ diff --git a/testsuite/tests/basic/patmatch.ml b/testsuite/tests/basic/patmatch.ml index 476d237559..e3f1453c05 100644 --- a/testsuite/tests/basic/patmatch.ml +++ b/testsuite/tests/basic/patmatch.ml @@ -155,3 +155,15 @@ let test e b = let () = let r = test Foo false in if r = 0 then printf "PR#5788=Ok\n" + + +(* No string sharing PR#6322 *) +let test x = match x with + | true -> "a" + | false -> "a" + +let () = + let s1 = test true in + let s2 = test false in + s1.[0] <- 'p'; + if s1 <> s2 then printf "PR#6322=Ok\n%!" diff --git a/testsuite/tests/basic/patmatch.reference b/testsuite/tests/basic/patmatch.reference index 069400b10e..fbe0167c91 100644 --- a/testsuite/tests/basic/patmatch.reference +++ b/testsuite/tests/basic/patmatch.reference @@ -69,3 +69,4 @@ l([|4;5;6|]) = 15 PR#5992=Ok PR#5788=Ok PR#5788=Ok +PR#6322=Ok diff --git a/testsuite/tests/basic/stringmatch.ml b/testsuite/tests/basic/stringmatch.ml new file mode 100644 index 0000000000..e1f4bdb471 --- /dev/null +++ b/testsuite/tests/basic/stringmatch.ml @@ -0,0 +1,738 @@ +(* Empty string oddities *) + +let rec tst01 s = match s with +| "" -> 0 +| _ -> 1 + +let () = + assert (tst01 "" = 0) ; + assert (tst01 "\000\000\000\003" = 1) ; + assert (tst01 "\000\000\000\000\000\000\000\007" = 1) ; + () + +(* A few when clauses *) + +let tst02 s = + let len = String.length s in + match s with + | "" when len < 0 -> assert false + | "" -> 1 + | _ when len = 0 -> assert false + | "A" -> 2 + | _ -> 3 + +let () = + assert (tst02 "" = 1) ; + assert (tst02 "A" = 2) ; + assert (tst02 "B" = 3) ; + assert (tst02 "\000\000\000\000\000\000\000\007" = 3) ; + assert (tst02 "\000\000\000\003" = 3) ; + () + +(* Keword reckognition *) + +let s00 = "get_const" +let t00 = "set_congt" +let s01 = "get_var" +let t01 = "gat_ver" +let s02 = "get_env" +let t02 = "get_env" +let s03 = "get_meth" +let t03 = "met_geth" +let s04 = "set_var" +let t04 = "sev_tar" +let s05 = "app_const" +let t05 = "ppa_const" +let s06 = "app_var" +let t06 = "app_var" +let s07 = "app_env" +let t07 = "epp_anv" +let s08 = "app_meth" +let t08 = "atp_meph" +let s09 = "app_const_const" +let t09 = "app_const_const" +let s10 = "app_const_var" +let t10 = "atp_consp_var" +let s11 = "app_const_env" +let t11 = "app_constne_v" +let s12 = "app_const_meth" +let t12 = "spp_conat_meth" +let s13 = "app_var_const" +let t13 = "app_va_rconst" +let s14 = "app_env_const" +let t14 = "app_env_const" +let s15 = "app_meth_const" +let t15 = "app_teth_consm" +let s16 = "meth_app_const" +let t16 = "math_epp_const" +let s17 = "meth_app_var" +let t17 = "meth_app_var" +let s18 = "meth_app_env" +let t18 = "eeth_app_mnv" +let s19 = "meth_app_meth" +let t19 = "meth_apt_meph" +let s20 = "send_const" +let t20 = "tend_conss" +let s21 = "send_var" +let t21 = "serd_van" +let s22 = "send_env" +let t22 = "sen_denv" +let s23 = "send_meth" +let t23 = "tend_mesh" + +let tst03 s = match s with +| "get_const" -> 0 +| "get_var" -> 1 +| "get_env" -> 2 +| "get_meth" -> 3 +| "set_var" -> 4 +| "app_const" -> 5 +| "app_var" -> 6 +| "app_env" -> 7 +| "app_meth" -> 8 +| "app_const_const" -> 9 +| "app_const_var" -> 10 +| "app_const_env" -> 11 +| "app_const_meth" -> 12 +| "app_var_const" -> 13 +| "app_env_const" -> 14 +| "app_meth_const" -> 15 +| "meth_app_const" -> 16 +| "meth_app_var" -> 17 +| "meth_app_env" -> 18 +| "meth_app_meth" -> 19 +| "send_const" -> 20 +| "send_var" -> 21 +| "send_env" -> 22 +| "send_meth" -> 23 +| _ -> -1 + +let () = + assert (tst03 s00 = 0) ; + assert (tst03 t00 = -1) ; + assert (tst03 s01 = 1) ; + assert (tst03 t01 = -1) ; + assert (tst03 s02 = 2) ; + assert (tst03 t02 = 2) ; + assert (tst03 s03 = 3) ; + assert (tst03 t03 = -1) ; + assert (tst03 s04 = 4) ; + assert (tst03 t04 = -1) ; + assert (tst03 s05 = 5) ; + assert (tst03 t05 = -1) ; + assert (tst03 s06 = 6) ; + assert (tst03 t06 = 6) ; + assert (tst03 s07 = 7) ; + assert (tst03 t07 = -1) ; + assert (tst03 s08 = 8) ; + assert (tst03 t08 = -1) ; + assert (tst03 s09 = 9) ; + assert (tst03 t09 = 9) ; + assert (tst03 s10 = 10) ; + assert (tst03 t10 = -1) ; + assert (tst03 s11 = 11) ; + assert (tst03 t11 = -1) ; + assert (tst03 s12 = 12) ; + assert (tst03 t12 = -1) ; + assert (tst03 s13 = 13) ; + assert (tst03 t13 = -1) ; + assert (tst03 s14 = 14) ; + assert (tst03 t14 = 14) ; + assert (tst03 s15 = 15) ; + assert (tst03 t15 = -1) ; + assert (tst03 s16 = 16) ; + assert (tst03 t16 = -1) ; + assert (tst03 s17 = 17) ; + assert (tst03 t17 = 17) ; + assert (tst03 s18 = 18) ; + assert (tst03 t18 = -1) ; + assert (tst03 s19 = 19) ; + assert (tst03 t19 = -1) ; + assert (tst03 s20 = 20) ; + assert (tst03 t20 = -1) ; + assert (tst03 s21 = 21) ; + assert (tst03 t21 = -1) ; + assert (tst03 s22 = 22) ; + assert (tst03 t22 = -1) ; + assert (tst03 s23 = 23) ; + assert (tst03 t23 = -1) ; + () + +(* Activate the test first column first heuristics *) + +let s00 = "AAAAAAAA" +let s01 = "AAAAAAAAAAAAAAAA" +let s02 = "AAAAAAAAAAAAAAAAAAAAAAAA" +let s03 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" +let s04 = "BBBBBBBB" +let s05 = "BBBBBBBBBBBBBBBB" +let s06 = "BBBBBBBBBBBBBBBBBBBBBBBB" +let s07 = "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB" +let s08 = "CCCCCCCC" +let s09 = "CCCCCCCCCCCCCCCC" +let s10 = "CCCCCCCCCCCCCCCCCCCCCCCC" +let s11 = "CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC" + +let tst04 s = match s with +| "AAAAAAAA" -> 0 +| "AAAAAAAAAAAAAAAA" -> 1 +| "AAAAAAAAAAAAAAAAAAAAAAAA" -> 2 +| "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" -> 3 +| "BBBBBBBB" -> 4 +| "BBBBBBBBBBBBBBBB" -> 5 +| "BBBBBBBBBBBBBBBBBBBBBBBB" -> 6 +| "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB" -> 7 +| "CCCCCCCC" -> 8 +| "CCCCCCCCCCCCCCCC" -> 9 +| "CCCCCCCCCCCCCCCCCCCCCCCC" -> 10 +| "CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC" -> 11 +| _ -> -1 + +let () = + assert (tst04 s00 = 0) ; + assert (tst04 s01 = 1) ; + assert (tst04 s02 = 2) ; + assert (tst04 s03 = 3) ; + assert (tst04 s04 = 4) ; + assert (tst04 s05 = 5) ; + assert (tst04 s06 = 6) ; + assert (tst04 s07 = 7) ; + assert (tst04 s08 = 8) ; + assert (tst04 s09 = 9) ; + assert (tst04 s10 = 10) ; + assert (tst04 s11 = 11) ; + assert (tst04 "" = -1) ; + assert (tst04 "DDD" = -1) ; + assert (tst04 "DDDDDDD" = -1) ; + assert (tst04 "AAADDDD" = -1) ; + assert (tst04 "AAAAAAADDDDDDDD" = -1) ; + assert (tst04 "AAAAAAADDDD" = -1) ; + assert (tst04 "AAAAAAAAAAAAAAADDDD" = -1) ; + () + +(* Similar *) + +let s00 = "AAA" +let s01 = "AAAA" +let s02 = "AAAAA" +let s03 = "AAAAAA" +let s04 = "AAAAAAA" +let s05 = "AAAAAAAAAAAA" +let s06 = "AAAAAAAAAAAAAAAA" +let s07 = "AAAAAAAAAAAAAAAAAAAA" +let s08 = "BBB" +let s09 = "BBBB" +let s10 = "BBBBB" +let s11 = "BBBBBB" +let s12 = "BBBBBBB" + +let tst05 s = match s with +| "AAA" -> 0 +| "AAAA" -> 1 +| "AAAAA" -> 2 +| "AAAAAA" -> 3 +| "AAAAAAA" -> 4 +| "AAAAAAAAAAAA" -> 5 +| "AAAAAAAAAAAAAAAA" -> 6 +| "AAAAAAAAAAAAAAAAAAAA" -> 7 +| "BBB" -> 8 +| "BBBB" -> 9 +| "BBBBB" -> 10 +| "BBBBBB" -> 11 +| "BBBBBBB" -> 12 +| _ -> -1 + +let () = + assert (tst05 s00 = 0) ; + assert (tst05 s01 = 1) ; + assert (tst05 s02 = 2) ; + assert (tst05 s03 = 3) ; + assert (tst05 s04 = 4) ; + assert (tst05 s05 = 5) ; + assert (tst05 s06 = 6) ; + assert (tst05 s07 = 7) ; + assert (tst05 s08 = 8) ; + assert (tst05 s09 = 9) ; + assert (tst05 s10 = 10) ; + assert (tst05 s11 = 11) ; + assert (tst05 s12 = 12) ; + assert (tst05 "" = -1) ; + assert (tst05 "AAD" = -1) ; + assert (tst05 "AAAD" = -1) ; + assert (tst05 "AAAAAAD" = -1) ; + assert (tst05 "AAAAAAAD" = -1) ; + assert (tst05 "BBD" = -1) ; + assert (tst05 "BBBD" = -1) ; + assert (tst05 "BBBBBBD" = -1) ; + assert (tst05 "BBBBBBBD" = -1) ; + () + +(* Big test *) + +let s00 = "and" +let t00 = "nad" +let s01 = "as" +let t01 = "sa" +let s02 = "assert" +let t02 = "asesrt" +let s03 = "begin" +let t03 = "negib" +let s04 = "class" +let t04 = "lcass" +let s05 = "constraint" +let t05 = "constiarnt" +let s06 = "do" +let t06 = "od" +let s07 = "done" +let t07 = "eond" +let s08 = "downto" +let t08 = "dowtno" +let s09 = "else" +let t09 = "lese" +let s10 = "end" +let t10 = "edn" +let s11 = "exception" +let t11 = "exception" +let s12 = "external" +let t12 = "external" +let s13 = "false" +let t13 = "fslae" +let s14 = "for" +let t14 = "ofr" +let s15 = "fun" +let t15 = "fnu" +let s16 = "function" +let t16 = "function" +let s17 = "functor" +let t17 = "ounctfr" +let s18 = "if" +let t18 = "fi" +let s19 = "in" +let t19 = "in" +let s20 = "include" +let t20 = "inculde" +let s21 = "inherit" +let t21 = "iehnrit" +let s22 = "initializer" +let t22 = "enitializir" +let s23 = "lazy" +let t23 = "zaly" +let s24 = "let" +let t24 = "elt" +let s25 = "match" +let t25 = "match" +let s26 = "method" +let t26 = "methdo" +let s27 = "module" +let t27 = "modelu" +let s28 = "mutable" +let t28 = "butamle" +let s29 = "new" +let t29 = "wen" +let s30 = "object" +let t30 = "objcet" +let s31 = "of" +let t31 = "of" +let s32 = "open" +let t32 = "epon" +let s33 = "or" +let t33 = "ro" +let s34 = "private" +let t34 = "privaet" +let s35 = "rec" +let t35 = "rec" +let s36 = "sig" +let t36 = "gis" +let s37 = "struct" +let t37 = "scrutt" +let s38 = "then" +let t38 = "hten" +let s39 = "to" +let t39 = "to" +let s40 = "true" +let t40 = "teur" +let s41 = "try" +let t41 = "try" +let s42 = "type" +let t42 = "pyte" +let s43 = "val" +let t43 = "val" +let s44 = "virtual" +let t44 = "vritual" +let s45 = "when" +let t45 = "whne" +let s46 = "while" +let t46 = "wlihe" +let s47 = "with" +let t47 = "iwth" +let s48 = "mod" +let t48 = "mod" +let s49 = "land" +let t49 = "alnd" +let s50 = "lor" +let t50 = "rol" +let s51 = "lxor" +let t51 = "lxor" +let s52 = "lsl" +let t52 = "lsl" +let s53 = "lsr" +let t53 = "lsr" +let s54 = "asr" +let t54 = "sar" +let s55 = "A" +let t55 = "A" +let s56 = "AA" +let t56 = "AA" +let s57 = "AAA" +let t57 = "AAA" +let s58 = "AAAA" +let t58 = "AAAA" +let s59 = "AAAAA" +let t59 = "AAAAA" +let s60 = "AAAAAA" +let t60 = "AAAAAA" +let s61 = "AAAAAAA" +let t61 = "AAAAAAA" +let s62 = "AAAAAAAA" +let t62 = "AAAAAAAA" +let s63 = "AAAAAAAAA" +let t63 = "AAAAAAAAA" +let s64 = "AAAAAAAAAA" +let t64 = "AAAAAAAAAA" +let s65 = "AAAAAAAAAAA" +let t65 = "AAAAAAAAAAA" +let s66 = "AAAAAAAAAAAA" +let t66 = "AAAAAAAAAAAA" +let s67 = "AAAAAAAAAAAAA" +let t67 = "AAAAAAAAAAAAA" +let s68 = "AAAAAAAAAAAAAA" +let t68 = "AAAAAAAAAAAAAA" +let s69 = "AAAAAAAAAAAAAAA" +let t69 = "AAAAAAAAAAAAAAA" +let s70 = "AAAAAAAAAAAAAAAA" +let t70 = "AAAAAAAAAAAAAAAA" +let s71 = "AAAAAAAAAAAAAAAAA" +let t71 = "AAAAAAAAAAAAAAAAA" +let s72 = "AAAAAAAAAAAAAAAAAA" +let t72 = "AAAAAAAAAAAAAAAAAA" +let s73 = "AAAAAAAAAAAAAAAAAAA" +let t73 = "AAAAAAAAAAAAAAAAAAA" +let s74 = "AAAAAAAAAAAAAAAAAAAA" +let t74 = "AAAAAAAAAAAAAAAAAAAA" +let s75 = "AAAAAAAAAAAAAAAAAAAAA" +let t75 = "AAAAAAAAAAAAAAAAAAAAA" +let s76 = "AAAAAAAAAAAAAAAAAAAAAA" +let t76 = "AAAAAAAAAAAAAAAAAAAAAA" +let s77 = "AAAAAAAAAAAAAAAAAAAAAAA" +let t77 = "AAAAAAAAAAAAAAAAAAAAAAA" +let s78 = "AAAAAAAAAAAAAAAAAAAAAAAA" +let t78 = "AAAAAAAAAAAAAAAAAAAAAAAA" +let s79 = "AAAAAAAAAAAAAAAAAAAAAAAAA" +let t79 = "AAAAAAAAAAAAAAAAAAAAAAAAA" +let s80 = "AAAAAAAAAAAAAAAAAAAAAAAAAA" +let t80 = "AAAAAAAAAAAAAAAAAAAAAAAAAA" +let s81 = "AAAAAAAAAAAAAAAAAAAAAAAAAAA" +let t81 = "AAAAAAAAAAAAAAAAAAAAAAAAAAA" +let s82 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAA" +let t82 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAA" +let s83 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAA" +let t83 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAA" +let s84 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" +let t84 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" +let s85 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" +let t85 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" +let s86 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" +let t86 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" +let s87 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" +let t87 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" +let s88 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" +let t88 = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" +let s89 = "BBBBBBBBBBBBBBB" +let t89 = "BBBBBBBBBBBBBBB" +let s90 = "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB" +let t90 = "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB" +let s91 = "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB" +let t91 = "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB" + +let tst06 s = match s with +| "and" -> 0 +| "as" -> 1 +| "assert" -> 2 +| "begin" -> 3 +| "class" -> 4 +| "constraint" -> 5 +| "do" -> 6 +| "done" -> 7 +| "downto" -> 8 +| "else" -> 9 +| "end" -> 10 +| "exception" -> 11 +| "external" -> 12 +| "false" -> 13 +| "for" -> 14 +| "fun" -> 15 +| "function" -> 16 +| "functor" -> 17 +| "if" -> 18 +| "in" -> 19 +| "include" -> 20 +| "inherit" -> 21 +| "initializer" -> 22 +| "lazy" -> 23 +| "let" -> 24 +| "match" -> 25 +| "method" -> 26 +| "module" -> 27 +| "mutable" -> 28 +| "new" -> 29 +| "object" -> 30 +| "of" -> 31 +| "open" -> 32 +| "or" -> 33 +| "private" -> 34 +| "rec" -> 35 +| "sig" -> 36 +| "struct" -> 37 +| "then" -> 38 +| "to" -> 39 +| "true" -> 40 +| "try" -> 41 +| "type" -> 42 +| "val" -> 43 +| "virtual" -> 44 +| "when" -> 45 +| "while" -> 46 +| "with" -> 47 +| "mod" -> 48 +| "land" -> 49 +| "lor" -> 50 +| "lxor" -> 51 +| "lsl" -> 52 +| "lsr" -> 53 +| "asr" -> 54 +| "A" -> 55 +| "AA" -> 56 +| "AAA" -> 57 +| "AAAA" -> 58 +| "AAAAA" -> 59 +| "AAAAAA" -> 60 +| "AAAAAAA" -> 61 +| "AAAAAAAA" -> 62 +| "AAAAAAAAA" -> 63 +| "AAAAAAAAAA" -> 64 +| "AAAAAAAAAAA" -> 65 +| "AAAAAAAAAAAA" -> 66 +| "AAAAAAAAAAAAA" -> 67 +| "AAAAAAAAAAAAAA" -> 68 +| "AAAAAAAAAAAAAAA" -> 69 +| "AAAAAAAAAAAAAAAA" -> 70 +| "AAAAAAAAAAAAAAAAA" -> 71 +| "AAAAAAAAAAAAAAAAAA" -> 72 +| "AAAAAAAAAAAAAAAAAAA" -> 73 +| "AAAAAAAAAAAAAAAAAAAA" -> 74 +| "AAAAAAAAAAAAAAAAAAAAA" -> 75 +| "AAAAAAAAAAAAAAAAAAAAAA" -> 76 +| "AAAAAAAAAAAAAAAAAAAAAAA" -> 77 +| "AAAAAAAAAAAAAAAAAAAAAAAA" -> 78 +| "AAAAAAAAAAAAAAAAAAAAAAAAA" -> 79 +| "AAAAAAAAAAAAAAAAAAAAAAAAAA" -> 80 +| "AAAAAAAAAAAAAAAAAAAAAAAAAAA" -> 81 +| "AAAAAAAAAAAAAAAAAAAAAAAAAAAA" -> 82 +| "AAAAAAAAAAAAAAAAAAAAAAAAAAAAA" -> 83 +| "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" -> 84 +| "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" -> 85 +| "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" -> 86 +| "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" -> 87 +| "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" -> 88 +| "BBBBBBBBBBBBBBB" -> 89 +| "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB" -> 90 +| "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB" -> 91 +| _ -> -1 + +let () = + assert (tst06 s00 = 0) ; + assert (tst06 t00 = -1) ; + assert (tst06 s01 = 1) ; + assert (tst06 t01 = -1) ; + assert (tst06 s02 = 2) ; + assert (tst06 t02 = -1) ; + assert (tst06 s03 = 3) ; + assert (tst06 t03 = -1) ; + assert (tst06 s04 = 4) ; + assert (tst06 t04 = -1) ; + assert (tst06 s05 = 5) ; + assert (tst06 t05 = -1) ; + assert (tst06 s06 = 6) ; + assert (tst06 t06 = -1) ; + assert (tst06 s07 = 7) ; + assert (tst06 t07 = -1) ; + assert (tst06 s08 = 8) ; + assert (tst06 t08 = -1) ; + assert (tst06 s09 = 9) ; + assert (tst06 t09 = -1) ; + assert (tst06 s10 = 10) ; + assert (tst06 t10 = -1) ; + assert (tst06 s11 = 11) ; + assert (tst06 t11 = 11) ; + assert (tst06 s12 = 12) ; + assert (tst06 t12 = 12) ; + assert (tst06 s13 = 13) ; + assert (tst06 t13 = -1) ; + assert (tst06 s14 = 14) ; + assert (tst06 t14 = -1) ; + assert (tst06 s15 = 15) ; + assert (tst06 t15 = -1) ; + assert (tst06 s16 = 16) ; + assert (tst06 t16 = 16) ; + assert (tst06 s17 = 17) ; + assert (tst06 t17 = -1) ; + assert (tst06 s18 = 18) ; + assert (tst06 t18 = -1) ; + assert (tst06 s19 = 19) ; + assert (tst06 t19 = 19) ; + assert (tst06 s20 = 20) ; + assert (tst06 t20 = -1) ; + assert (tst06 s21 = 21) ; + assert (tst06 t21 = -1) ; + assert (tst06 s22 = 22) ; + assert (tst06 t22 = -1) ; + assert (tst06 s23 = 23) ; + assert (tst06 t23 = -1) ; + assert (tst06 s24 = 24) ; + assert (tst06 t24 = -1) ; + assert (tst06 s25 = 25) ; + assert (tst06 t25 = 25) ; + assert (tst06 s26 = 26) ; + assert (tst06 t26 = -1) ; + assert (tst06 s27 = 27) ; + assert (tst06 t27 = -1) ; + assert (tst06 s28 = 28) ; + assert (tst06 t28 = -1) ; + assert (tst06 s29 = 29) ; + assert (tst06 t29 = -1) ; + assert (tst06 s30 = 30) ; + assert (tst06 t30 = -1) ; + assert (tst06 s31 = 31) ; + assert (tst06 t31 = 31) ; + assert (tst06 s32 = 32) ; + assert (tst06 t32 = -1) ; + assert (tst06 s33 = 33) ; + assert (tst06 t33 = -1) ; + assert (tst06 s34 = 34) ; + assert (tst06 t34 = -1) ; + assert (tst06 s35 = 35) ; + assert (tst06 t35 = 35) ; + assert (tst06 s36 = 36) ; + assert (tst06 t36 = -1) ; + assert (tst06 s37 = 37) ; + assert (tst06 t37 = -1) ; + assert (tst06 s38 = 38) ; + assert (tst06 t38 = -1) ; + assert (tst06 s39 = 39) ; + assert (tst06 t39 = 39) ; + assert (tst06 s40 = 40) ; + assert (tst06 t40 = -1) ; + assert (tst06 s41 = 41) ; + assert (tst06 t41 = 41) ; + assert (tst06 s42 = 42) ; + assert (tst06 t42 = -1) ; + assert (tst06 s43 = 43) ; + assert (tst06 t43 = 43) ; + assert (tst06 s44 = 44) ; + assert (tst06 t44 = -1) ; + assert (tst06 s45 = 45) ; + assert (tst06 t45 = -1) ; + assert (tst06 s46 = 46) ; + assert (tst06 t46 = -1) ; + assert (tst06 s47 = 47) ; + assert (tst06 t47 = -1) ; + assert (tst06 s48 = 48) ; + assert (tst06 t48 = 48) ; + assert (tst06 s49 = 49) ; + assert (tst06 t49 = -1) ; + assert (tst06 s50 = 50) ; + assert (tst06 t50 = -1) ; + assert (tst06 s51 = 51) ; + assert (tst06 t51 = 51) ; + assert (tst06 s52 = 52) ; + assert (tst06 t52 = 52) ; + assert (tst06 s53 = 53) ; + assert (tst06 t53 = 53) ; + assert (tst06 s54 = 54) ; + assert (tst06 t54 = -1) ; + assert (tst06 s55 = 55) ; + assert (tst06 t55 = 55) ; + assert (tst06 s56 = 56) ; + assert (tst06 t56 = 56) ; + assert (tst06 s57 = 57) ; + assert (tst06 t57 = 57) ; + assert (tst06 s58 = 58) ; + assert (tst06 t58 = 58) ; + assert (tst06 s59 = 59) ; + assert (tst06 t59 = 59) ; + assert (tst06 s60 = 60) ; + assert (tst06 t60 = 60) ; + assert (tst06 s61 = 61) ; + assert (tst06 t61 = 61) ; + assert (tst06 s62 = 62) ; + assert (tst06 t62 = 62) ; + assert (tst06 s63 = 63) ; + assert (tst06 t63 = 63) ; + assert (tst06 s64 = 64) ; + assert (tst06 t64 = 64) ; + assert (tst06 s65 = 65) ; + assert (tst06 t65 = 65) ; + assert (tst06 s66 = 66) ; + assert (tst06 t66 = 66) ; + assert (tst06 s67 = 67) ; + assert (tst06 t67 = 67) ; + assert (tst06 s68 = 68) ; + assert (tst06 t68 = 68) ; + assert (tst06 s69 = 69) ; + assert (tst06 t69 = 69) ; + assert (tst06 s70 = 70) ; + assert (tst06 t70 = 70) ; + assert (tst06 s71 = 71) ; + assert (tst06 t71 = 71) ; + assert (tst06 s72 = 72) ; + assert (tst06 t72 = 72) ; + assert (tst06 s73 = 73) ; + assert (tst06 t73 = 73) ; + assert (tst06 s74 = 74) ; + assert (tst06 t74 = 74) ; + assert (tst06 s75 = 75) ; + assert (tst06 t75 = 75) ; + assert (tst06 s76 = 76) ; + assert (tst06 t76 = 76) ; + assert (tst06 s77 = 77) ; + assert (tst06 t77 = 77) ; + assert (tst06 s78 = 78) ; + assert (tst06 t78 = 78) ; + assert (tst06 s79 = 79) ; + assert (tst06 t79 = 79) ; + assert (tst06 s80 = 80) ; + assert (tst06 t80 = 80) ; + assert (tst06 s81 = 81) ; + assert (tst06 t81 = 81) ; + assert (tst06 s82 = 82) ; + assert (tst06 t82 = 82) ; + assert (tst06 s83 = 83) ; + assert (tst06 t83 = 83) ; + assert (tst06 s84 = 84) ; + assert (tst06 t84 = 84) ; + assert (tst06 s85 = 85) ; + assert (tst06 t85 = 85) ; + assert (tst06 s86 = 86) ; + assert (tst06 t86 = 86) ; + assert (tst06 s87 = 87) ; + assert (tst06 t87 = 87) ; + assert (tst06 s88 = 88) ; + assert (tst06 t88 = 88) ; + assert (tst06 s89 = 89) ; + assert (tst06 t89 = 89) ; + assert (tst06 s90 = 90) ; + assert (tst06 t90 = 90) ; + assert (tst06 s91 = 91) ; + assert (tst06 t91 = 91) ; + assert (tst06 "" = -1) ; + () diff --git a/testsuite/tests/basic/stringmatch.reference b/testsuite/tests/basic/stringmatch.reference new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/basic/stringmatch.reference diff --git a/testsuite/tests/callback/Makefile b/testsuite/tests/callback/Makefile index 26d02ea8ab..58b5ed8aa9 100644 --- a/testsuite/tests/callback/Makefile +++ b/testsuite/tests/callback/Makefile @@ -19,7 +19,8 @@ LD_PATH=$(TOPDIR)/otherlibs/unix .PHONY: default default: @case " $(OTHERLIBRARIES) " in \ - *' unix '*) $(SET_LD_PATH) $(MAKE) run-byte run-opt;; \ + *' unix '*) $(SET_LD_PATH) $(MAKE) run-byte; \ + $(SET_LD_PATH) $(MAKE) run-opt;; \ esac .PHONY: common diff --git a/testsuite/tests/embedded/Makefile b/testsuite/tests/embedded/Makefile index 2a01c20848..a8de4dc00e 100644 --- a/testsuite/tests/embedded/Makefile +++ b/testsuite/tests/embedded/Makefile @@ -13,7 +13,9 @@ BASEDIR=../.. .PHONY: default -default: compile run +default: + $(MAKE) compile + $(MAKE) run .PHONY: compile compile: caml diff --git a/testsuite/tests/lib-dynlink-bytecode/Makefile b/testsuite/tests/lib-dynlink-bytecode/Makefile index 74f27b9f52..832e367ee6 100644 --- a/testsuite/tests/lib-dynlink-bytecode/Makefile +++ b/testsuite/tests/lib-dynlink-bytecode/Makefile @@ -17,7 +17,11 @@ LD_PATH=.:$(TOPDIR)/otherlibs/dynlink .PHONY: default default: - @$(SET_LD_PATH) $(MAKE) compile run + @if ! $(SUPPORTS_SHARED_LIBRARIES); then \ + echo 'skipped (shared libraries not available)'; \ + else \ + $(SET_LD_PATH) $(MAKE) compile run; \ + fi .PHONY: compile compile: caml diff --git a/testsuite/tests/lib-dynlink-csharp/Makefile b/testsuite/tests/lib-dynlink-csharp/Makefile index 17eeea4364..c576a09909 100644 --- a/testsuite/tests/lib-dynlink-csharp/Makefile +++ b/testsuite/tests/lib-dynlink-csharp/Makefile @@ -18,7 +18,11 @@ LD_PATH=$(TOPDIR)/otherlibs/bigarray .PHONY: default default: - @if $(BYTECODE_ONLY); then : ; else \ + @if ! $(SUPPORTS_SHARED_LIBRARIES); then \ + echo 'skipped (shared libraries not available)'; \ + elif $(BYTECODE_ONLY); then \ + echo 'skipped (native compiler not available)' ; \ + else \ $(SET_LD_PATH) $(MAKE) all; \ fi diff --git a/testsuite/tests/lib-dynlink-native/Makefile b/testsuite/tests/lib-dynlink-native/Makefile index 80e422121b..54126ff59d 100644 --- a/testsuite/tests/lib-dynlink-native/Makefile +++ b/testsuite/tests/lib-dynlink-native/Makefile @@ -19,7 +19,11 @@ LD_PATH=$(TOPDIR)/otherlibs/$(UNIXLIBVAR)unix:$(TOPDIR)/otherlibs/systhreads:$(T .PHONY: default default: - @if $(BYTECODE_ONLY); then : ; else \ + @if ! $(SUPPORTS_SHARED_LIBRARIES); then \ + echo 'skipped (shared libraries not available)'; \ + elif $(BYTECODE_ONLY); then \ + echo 'skipped (native compiler not available)' ; \ + else \ $(SET_LD_PATH) $(MAKE) all; \ fi diff --git a/testsuite/tests/lib-scanf-2/Makefile b/testsuite/tests/lib-scanf-2/Makefile index 6b8d56b08b..b41f72c9b5 100644 --- a/testsuite/tests/lib-scanf-2/Makefile +++ b/testsuite/tests/lib-scanf-2/Makefile @@ -15,9 +15,12 @@ BASEDIR=../.. COMPFLAGS=-I $(OTOPDIR)/otherlibs/$(UNIXLIBVAR)unix LD_PATH=$(TOPDIR)/otherlibs/$(UNIXLIBVAR)unix +MYRUNTIME=`if [ -z "$(CUSTOM)" ]; then echo '$(OCAMLRUN)'; fi` + .PHONY: default default: - @$(SET_LD_PATH) $(MAKE) compile run + @$(MAKE) compile + @$(SET_LD_PATH) $(MAKE) run .PHONY: compile compile: tscanf2_io.cmo @@ -34,7 +37,7 @@ compile: tscanf2_io.cmo run: @printf " ... testing with ocamlc" - @$(OCAMLRUN) ./master.byte "$(OTOPDIR)/boot/ocamlrun$(EXE) \ + @$(MYRUNTIME) ./master.byte "$(OTOPDIR)/boot/ocamlrun$(EXE) \ `$(CYGPATH) ./slave.byte`" \ >result.byte 2>&1 @$(DIFF) reference result.byte >/dev/null \ diff --git a/testsuite/tests/runtime-errors/Makefile b/testsuite/tests/runtime-errors/Makefile index b5d1d7bb4b..2c0bed9b63 100644 --- a/testsuite/tests/runtime-errors/Makefile +++ b/testsuite/tests/runtime-errors/Makefile @@ -13,7 +13,9 @@ BASEDIR=../.. .PHONY: default -default: compile run +default: + $(MAKE) compile + $(MAKE) run .PHONY: compile compile: diff --git a/testsuite/tests/tool-debugger/.ignore b/testsuite/tests/tool-debugger/.ignore new file mode 100644 index 0000000000..e09cf9eb6e --- /dev/null +++ b/testsuite/tests/tool-debugger/.ignore @@ -0,0 +1 @@ +compiler-libs diff --git a/testsuite/tests/tool-debugger/Makefile b/testsuite/tests/tool-debugger/Makefile new file mode 100644 index 0000000000..f95b4803b6 --- /dev/null +++ b/testsuite/tests/tool-debugger/Makefile @@ -0,0 +1,58 @@ +######################################################################### +# # +# OCaml # +# # +# Damien Doligez, EPI Gallium, INRIA Rocquencourt # +# # +# Copyright 2013 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the Q Public License version 1.0. # +# # +######################################################################### + +BASEDIR=../.. +MAIN_MODULE=debuggee +ADD_COMPFLAGS=-g -custom +LD_PATH=$(TOPDIR)/otherlibs/$(UNIXLIBVAR)unix + +.PHONY: default +default: + @if ! $(SUPPORTS_SHARED_LIBRARIES); then \ + echo 'skipped (shared libraries not available)'; \ + else \ + $(MAKE) compile; \ + $(SET_LD_PATH) OCAMLLIB=. $(MAKE) run; \ + fi + +.PHONY: compile +compile: $(ML_FILES) $(CMO_FILES) $(MAIN_MODULE).cmo + @rm -f program.byte program.byte.exe + @$(OCAMLC) $(ADD_COMPFLAGS) $(ADD_CFLAGS) -o program.byte$(EXE) \ + $(O_FILES) $(CMA_FILES) $(CMO_FILES) $(ADD_CMO_FILES) \ + $(MAIN_MODULE).cmo + @mkdir -p compiler-libs + @cp $(TOPDIR)/toplevel/topdirs.cmi compiler-libs/ + +.PHONY: run +run: + @printf " ... testing with ocamlc" + @rm -f $(MAIN_MODULE).result + @echo 'source input_script' | \ + $(OCAMLRUN) `$(CYGPATH) $(TOPDIR)/debugger/ocamldebug$(EXE)` \ + program.byte$(EXE) >$(MAIN_MODULE).raw.result 2>&1 \ + && sed -e '/Debugger version/d' -e '/^Time:/d' -e '$$d' \ + $(MAIN_MODULE).raw.result >$(MAIN_MODULE).result \ + && $(DIFF) $(MAIN_MODULE).reference $(MAIN_MODULE).result >/dev/null \ + && echo " => passed" || echo " => failed" + +.PHONY: promote +promote: defaultpromote + +.PHONY: clean +clean: defaultclean + @rm -f *.result program.byte program.byte.exe \ + program.native program.native.exe \ + $(GENERATED_SOURCES) $(O_FILES) $(TEST_TEMP_FILES) + @rm -rf compiler-libs + +include $(BASEDIR)/makefiles/Makefile.common diff --git a/testsuite/tests/tool-debugger/debuggee.ml b/testsuite/tests/tool-debugger/debuggee.ml new file mode 100644 index 0000000000..341d0b369f --- /dev/null +++ b/testsuite/tests/tool-debugger/debuggee.ml @@ -0,0 +1,2 @@ +print_endline Sys.argv.(1);; +print_endline (Sys.getenv "foo");; diff --git a/testsuite/tests/tool-debugger/debuggee.reference b/testsuite/tests/tool-debugger/debuggee.reference new file mode 100644 index 0000000000..e998926c3d --- /dev/null +++ b/testsuite/tests/tool-debugger/debuggee.reference @@ -0,0 +1,5 @@ + +(ocd) Loading program... done. +arg1 +notbar +Program exit. diff --git a/testsuite/tests/tool-debugger/input_script b/testsuite/tests/tool-debugger/input_script new file mode 100755 index 0000000000..2caf06dd4d --- /dev/null +++ b/testsuite/tests/tool-debugger/input_script @@ -0,0 +1,5 @@ +set arguments arg1 arg2 +environment foo=bar +environment foo=notbar +run +quit diff --git a/testsuite/tests/tool-ocamldoc/Makefile b/testsuite/tests/tool-ocamldoc/Makefile index cf454149ab..976010e5f0 100644 --- a/testsuite/tests/tool-ocamldoc/Makefile +++ b/testsuite/tests/tool-ocamldoc/Makefile @@ -18,7 +18,11 @@ DOCFLAGS=-I $(OTOPDIR)/stdlib $(COMPFLAGS) .PHONY: default default: - @$(SET_LD_PATH) $(MAKE) run + @if ! $(SUPPORTS_SHARED_LIBRARIES); then \ + echo 'skipped (shared libraries not available)'; \ + else \ + $(SET_LD_PATH) $(MAKE) run; \ + fi .PHONY: run run: $(CUSTOM_MODULE).cmo diff --git a/testsuite/tests/typing-fstclassmod/fstclassmod.ml b/testsuite/tests/typing-fstclassmod/fstclassmod.ml index 268d35d492..82af377bec 100644 --- a/testsuite/tests/typing-fstclassmod/fstclassmod.ml +++ b/testsuite/tests/typing-fstclassmod/fstclassmod.ml @@ -139,3 +139,18 @@ end let () = print_endline (Print.to_string int 10); print_endline (Print.to_string (pair int (pair str int)) (123, ("A", 456))) + + +(* #6262: first-class modules and module type aliases *) + +module type S1 = sig end +module type S2 = S1 + +let f (x : (module S1)) : (module S2) = x + +module X = struct + module type S +end +module Y = struct include X end + +let f (x : (module X.S)) : (module Y.S) = x diff --git a/testsuite/tests/typing-gadts/omega07.ml b/testsuite/tests/typing-gadts/omega07.ml index 364364a0cf..9b3bd7e2bf 100644 --- a/testsuite/tests/typing-gadts/omega07.ml +++ b/testsuite/tests/typing-gadts/omega07.ml @@ -48,11 +48,9 @@ let rec app : type a n m. (a,n) seq -> (a,m) seq -> (a,n,m) app = match xs with | Snil -> App (ys, PlusZ (length ys)) | Scons (x, xs') -> - match app xs' ys with - | App (xs'', pl) -> App (Scons (x, xs''), PlusS pl) + let App (xs'', pl) = app xs' ys in + App (Scons (x, xs''), PlusS pl) ;; -(* Note: it would be nice to be able to handle existentials in - let definitions *) (* 3.1 Feature: kinds *) diff --git a/testsuite/tests/typing-gadts/omega07.ml.principal.reference b/testsuite/tests/typing-gadts/omega07.ml.principal.reference index 75739ee39c..47565e3acb 100644 --- a/testsuite/tests/typing-gadts/omega07.ml.principal.reference +++ b/testsuite/tests/typing-gadts/omega07.ml.principal.reference @@ -14,7 +14,7 @@ type _ nat = NZ : zero nat | NS : 'a nat -> 'a succ nat # * type (_, _, _) app = App : ('a, 'p) seq * ('n, 'm, 'p) plus -> ('a, 'n, 'm) app val app : ('a, 'n) seq -> ('a, 'm) seq -> ('a, 'n, 'm) app = <fun> -# * type tp = TP +# type tp = TP type nd = ND type ('a, 'b) fk = FK type _ shape = diff --git a/testsuite/tests/typing-gadts/omega07.ml.reference b/testsuite/tests/typing-gadts/omega07.ml.reference index 75739ee39c..47565e3acb 100644 --- a/testsuite/tests/typing-gadts/omega07.ml.reference +++ b/testsuite/tests/typing-gadts/omega07.ml.reference @@ -14,7 +14,7 @@ type _ nat = NZ : zero nat | NS : 'a nat -> 'a succ nat # * type (_, _, _) app = App : ('a, 'p) seq * ('n, 'm, 'p) plus -> ('a, 'n, 'm) app val app : ('a, 'n) seq -> ('a, 'm) seq -> ('a, 'n, 'm) app = <fun> -# * type tp = TP +# type tp = TP type nd = ND type ('a, 'b) fk = FK type _ shape = diff --git a/testsuite/tests/typing-gadts/pr5985.ml b/testsuite/tests/typing-gadts/pr5985.ml index fdc66e8238..6d0bbcee7b 100644 --- a/testsuite/tests/typing-gadts/pr5985.ml +++ b/testsuite/tests/typing-gadts/pr5985.ml @@ -26,6 +26,14 @@ module F(T:sig type 'a t end) = struct object constraint 'a = 'b T.t val x' : 'b = x method x = x' end end;; (* fail *) +(* Another (more direct) instance using polymorphic variants *) +(* PR#6275 *) +type 'x t = A of 'a constraint 'x = [< `X of 'a ] ;; (* fail *) +let magic (x : int) : bool = + let A x = A x in + x;; (* fail *) +type 'a t = A : 'a -> [< `X of 'a ] t;; (* fail *) + (* It is not OK to allow modules exported by other compilation units *) type (_,_) eq = Eq : ('a,'a) eq;; let eq = Obj.magic Eq;; diff --git a/testsuite/tests/typing-gadts/pr5985.ml.reference b/testsuite/tests/typing-gadts/pr5985.ml.reference index e9fa3461e4..af6154dda7 100644 --- a/testsuite/tests/typing-gadts/pr5985.ml.reference +++ b/testsuite/tests/typing-gadts/pr5985.ml.reference @@ -13,6 +13,20 @@ Error: Syntax error 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: + 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: + type 'a t = A : 'a -> [< `X of 'a ] t;; (* fail *) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: In this definition, a type variable cannot be deduced + from the type parameters. # type (_, _) eq = Eq : ('a, 'a) eq # val eq : 'a = <poly> # val eq : ('a Queue.t, 'b Queue.t) eq = Eq diff --git a/testsuite/tests/typing-gadts/pr6241.ml.principal.reference b/testsuite/tests/typing-gadts/pr6241.ml.principal.reference index 65ea143c84..cb3095a018 100644 --- a/testsuite/tests/typing-gadts/pr6241.ml.principal.reference +++ b/testsuite/tests/typing-gadts/pr6241.ml.principal.reference @@ -7,9 +7,8 @@ Warning 8: this pattern-matching is not exhaustive. Here is an example of a value that is not matched: A module M : - functor (A : sig module type T end) -> - functor (B : sig module type T end) -> - sig val f : ((module A.T), (module B.T)) t -> string end + functor (A : sig module type T end) (B : sig module type T end) -> + sig val f : ((module A.T), (module B.T)) t -> string end # module A : sig module type T = sig end end # module N : sig val f : ((module A.T), (module A.T)) t -> string end # Exception: Match_failure ("//toplevel//", 7, 52). diff --git a/testsuite/tests/typing-gadts/pr6241.ml.reference b/testsuite/tests/typing-gadts/pr6241.ml.reference index 65ea143c84..cb3095a018 100644 --- a/testsuite/tests/typing-gadts/pr6241.ml.reference +++ b/testsuite/tests/typing-gadts/pr6241.ml.reference @@ -7,9 +7,8 @@ Warning 8: this pattern-matching is not exhaustive. Here is an example of a value that is not matched: A module M : - functor (A : sig module type T end) -> - functor (B : sig module type T end) -> - sig val f : ((module A.T), (module B.T)) t -> string end + functor (A : sig module type T end) (B : sig module type T end) -> + sig val f : ((module A.T), (module B.T)) t -> string end # module A : sig module type T = sig end end # module N : sig val f : ((module A.T), (module A.T)) t -> string end # Exception: Match_failure ("//toplevel//", 7, 52). diff --git a/testsuite/tests/typing-gadts/test.ml.principal.reference b/testsuite/tests/typing-gadts/test.ml.principal.reference index 551f9cb2d9..0d40f674a5 100644 --- a/testsuite/tests/typing-gadts/test.ml.principal.reference +++ b/testsuite/tests/typing-gadts/test.ml.principal.reference @@ -311,7 +311,7 @@ Error: This expression has type < bar : int; foo : int; .. > as 'a # val g : 'a ty -> 'a = <fun> # module M : sig type _ t = int end # module M : sig type _ t = T : int t end -# module N : sig type 'a t = 'a M.t = T : int t end +# module N = M # val f : ('a, 'b) eq -> ('a, int) eq -> 'a -> 'b -> unit = <fun> # val f : ('a, 'b) eq -> ('b, int) eq -> 'a -> 'b -> unit = <fun> # diff --git a/testsuite/tests/typing-gadts/test.ml.reference b/testsuite/tests/typing-gadts/test.ml.reference index 41b756766c..e6aa47b415 100644 --- a/testsuite/tests/typing-gadts/test.ml.reference +++ b/testsuite/tests/typing-gadts/test.ml.reference @@ -298,7 +298,7 @@ Error: This expression has type < bar : int; foo : int; .. > as 'a # val g : 'a ty -> 'a = <fun> # module M : sig type _ t = int end # module M : sig type _ t = T : int t end -# module N : sig type 'a t = 'a M.t = T : int t end +# module N = M # val f : ('a, 'b) eq -> ('a, int) eq -> 'a -> 'b -> unit = <fun> # val f : ('a, 'b) eq -> ('b, int) eq -> 'a -> 'b -> unit = <fun> # diff --git a/build/ocamlbuild-native-only.sh b/testsuite/tests/typing-misc-bugs/Makefile index 4d7decfc03..04ded44514 100755..100644 --- a/build/ocamlbuild-native-only.sh +++ b/testsuite/tests/typing-misc-bugs/Makefile @@ -1,19 +1,14 @@ -#!/bin/sh - ######################################################################### # # # OCaml # # # -# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # +# Xavier Clerc, SED, INRIA Rocquencourt # # # -# Copyright 2008 Institut National de Recherche en Informatique et # +# Copyright 2010 Institut National de Recherche en Informatique et # # en Automatique. All rights reserved. This file is distributed # # under the terms of the Q Public License version 1.0. # # # ######################################################################### -set -e -cd `dirname $0`/.. -. build/targets.sh -set -x -$OCAMLBUILD $@ native_stdlib_mixed_mode $OCAMLOPT_BYTE $OCAMLLEX_BYTE $OCAMLBUILD_NATIVE +include ../../makefiles/Makefile.okbad +include ../../makefiles/Makefile.common diff --git a/testsuite/tests/typing-misc-bugs/pr6303_bad.ml b/testsuite/tests/typing-misc-bugs/pr6303_bad.ml new file mode 100644 index 0000000000..7d4539c5f8 --- /dev/null +++ b/testsuite/tests/typing-misc-bugs/pr6303_bad.ml @@ -0,0 +1,3 @@ +type 'a foo = {x: 'a; y: int} +let r = {{x = 0; y = 0} with x = 0} +let r' : string foo = r diff --git a/testsuite/tests/typing-modules-bugs/gatien_baron_20131019_ok.ml b/testsuite/tests/typing-modules-bugs/gatien_baron_20131019_ok.ml new file mode 100644 index 0000000000..5887445493 --- /dev/null +++ b/testsuite/tests/typing-modules-bugs/gatien_baron_20131019_ok.ml @@ -0,0 +1,31 @@ +module Std = struct module Hash = Hashtbl end;; + +open Std;; +module Hash1 : module type of Hash = Hash;; +module Hash2 : sig include (module type of Hash) end = Hash;; +let f1 (x : (_,_) Hash1.t) = (x : (_,_) Hashtbl.t);; +let f2 (x : (_,_) Hash2.t) = (x : (_,_) Hashtbl.t);; + +(* Another case, not using include *) + +module Std2 = struct module M = struct type t end end;; +module Std' = Std2;; +module M' : module type of Std'.M = Std2.M;; +let f3 (x : M'.t) = (x : Std2.M.t);; + +(* original report required Core_kernel: +module type S = sig +open Core_kernel.Std + +module Hashtbl1 : module type of Hashtbl +module Hashtbl2 : sig + include (module type of Hashtbl) +end + +module Coverage : Core_kernel.Std.Hashable + +type types = unit constraint 'a Coverage.Table.t = (Coverage.t, 'a) Hashtbl1.t +type doesnt_type = unit + constraint 'a Coverage.Table.t = (Coverage.t, 'a) Hashtbl2.t +end +*) diff --git a/testsuite/tests/typing-modules-bugs/pr6293_bad.ml b/testsuite/tests/typing-modules-bugs/pr6293_bad.ml new file mode 100644 index 0000000000..fe16fe4db5 --- /dev/null +++ b/testsuite/tests/typing-modules-bugs/pr6293_bad.ml @@ -0,0 +1,2 @@ +module type S = sig type t = { a : int; b : int; } end;; +let f (module M : S with type t = int) = { M.a = 0 };; diff --git a/testsuite/tests/typing-modules/a.mli b/testsuite/tests/typing-modules/a.mli new file mode 100644 index 0000000000..ea15bf005b --- /dev/null +++ b/testsuite/tests/typing-modules/a.mli @@ -0,0 +1,3 @@ +module L = List +module S = String +module D' = D diff --git a/testsuite/tests/typing-modules/aliases.ml b/testsuite/tests/typing-modules/aliases.ml new file mode 100644 index 0000000000..0b7e7ae2b0 --- /dev/null +++ b/testsuite/tests/typing-modules/aliases.ml @@ -0,0 +1,194 @@ +module C = Char;; +C.chr 66;; + +module C' : module type of Char = C;; +C'.chr 66;; + +module C'' : (module C) = C';; (* fails *) + +module C'' : (module Char) = C;; +C''.chr 66;; + +module C3 = struct include Char end;; +C3.chr 66;; + +let f x = let module M = struct module L = List end in M.L.length x;; +let g x = let module L = List in L.length (L.map succ x);; + +module F(X:sig end) = Char;; +module C4 = F(struct end);; +C4.chr 66;; + +module G(X:sig end) = struct module M = X end;; (* does not alias X *) +module M = G(struct end);; + +module M' = struct + module N = struct let x = 1 end + module N' = N +end;; +M'.N'.x;; + +module M'' : sig module N' : sig val x : int end end = M';; +M''.N'.x;; +module M2 = struct include M' end;; +module M3 : sig module N' : sig val x : int end end = struct include M' end;; +M3.N'.x;; +module M3' : sig module N' : sig val x : int end end = M2;; +M3'.N'.x;; + +module M4 : sig module N' : sig val x : int end end = struct + module N = struct let x = 1 end + module N' = N +end;; +M4.N'.x;; + +module F(X:sig end) = struct + module N = struct let x = 1 end + module N' = N +end;; +module G : functor(X:sig end) -> sig module N' : sig val x : int end end = F;; +module M5 = G(struct end);; +M5.N'.x;; + +module M = struct + module D = struct let y = 3 end + module N = struct let x = 1 end + module N' = N +end;; + +module M1 : sig module N : sig val x : int end module N' = N end = M;; +M1.N'.x;; +module M2 : sig module N' : sig val x : int end end = + (M : sig module N : sig val x : int end module N' = N end);; +M2.N'.x;; + +open M;; +N'.x;; + +module M = struct + module C = Char + module C' = C +end;; +module M1 + : sig module C : sig val escaped : char -> string end module C' = C end + = M;; (* sound, but should probably fail *) +M1.C'.escaped 'A';; +module M2 : sig module C' : sig val chr : int -> char end end = + (M : sig module C : sig val chr : int -> char end module C' = C end);; +M2.C'.chr 66;; + +StdLabels.List.map;; + +module Q = Queue;; +exception QE = Q.Empty;; +try Q.pop (Q.create ()) with QE -> "Ok";; + +module type Complex = module type of Complex with type t = Complex.t;; +module M : sig module C : Complex end = struct module C = Complex end;; + +module C = Complex;; +C.one.Complex.re;; +include C;; + +module F(X:sig module C = Char end) = struct module C = X.C end;; + +(* Applicative functors *) +module S = String +module StringSet = Set.Make(String) +module SSet = Set.Make(S);; +let f (x : StringSet.t) = (x : SSet.t);; + +(* Also using include (cf. Leo's mail 2013-11-16) *) +module F (M : sig end) : sig type t end = struct type t = int end +module T = struct + module M = struct end + include F(M) +end;; +include T;; +let f (x : t) : T.t = x ;; + +(* PR#4049 *) +(* This works thanks to abbreviations *) +module A = struct + module B = struct type t let compare x y = 0 end + module S = Set.Make(B) + let empty = S.empty +end +module A1 = A;; +A1.empty = A.empty;; + +(* PR#3476 *) +(* Does not work yet *) +module FF(X : sig end) = struct type t end +module M = struct + module X = struct end + module Y = FF (X) (* XXX *) + type t = Y.t +end +module F (Y : sig type t end) (M : sig type t = Y.t end) = struct end;; + +module G = F (M.Y);; +(*module N = G (M);; +module N = F (M.Y) (M);;*) + +(* PR#6307 *) + +module A1 = struct end +module A2 = struct end +module L1 = struct module X = A1 end +module L2 = struct module X = A2 end;; + +module F (L : (module type of L1)) = struct end;; + +module F1 = F(L1);; (* ok *) +module F2 = F(L2);; (* should succeed too *) + +(* Counter example: why we need to be careful with PR#6307 *) +module Int = struct type t = int let compare = compare end +module SInt = Set.Make(Int) +type (_,_) eq = Eq : ('a,'a) eq +type wrap = W of (SInt.t, SInt.t) eq + +module M = struct + module I = Int + type wrap' = wrap = W of (Set.Make(Int).t, Set.Make(I).t) eq +end;; +module type S = module type of M;; (* keep alias *) + +module Int2 = struct type t = int let compare x y = compare y x end;; +module type S' = sig + module I = Int2 + include S with module I := I +end;; (* fail *) + +(* (* if the above succeeded, one could break invariants *) +module rec M2 : S' = M2;; (* should succeed! (but this is bad) *) + +let M2.W eq = W Eq;; + +let s = List.fold_right SInt.add [1;2;3] SInt.empty;; +module SInt2 = Set.Make(Int2);; +let conv : type a b. (a,b) eq -> a -> b = fun Eq x -> x;; +let s' : SInt2.t = conv eq s;; +SInt2.elements s';; +SInt2.mem 2 s';; (* invariants are broken *) +*) + +(* Check behavior with submodules *) +module M = struct + module N = struct module I = Int end + module P = struct module I = N.I end + module Q = struct + type wrap' = wrap = W of (Set.Make(Int).t, Set.Make(P.I).t) eq + end +end;; +module type S = module type of M ;; + +module M = struct + module N = struct module I = Int end + module P = struct module I = N.I end + module Q = struct + type wrap' = wrap = W of (Set.Make(Int).t, Set.Make(N.I).t) eq + end +end;; +module type S = module type of M ;; diff --git a/testsuite/tests/typing-modules/aliases.ml.reference b/testsuite/tests/typing-modules/aliases.ml.reference new file mode 100644 index 0000000000..730252b580 --- /dev/null +++ b/testsuite/tests/typing-modules/aliases.ml.reference @@ -0,0 +1,350 @@ + +# module C = Char +# - : char = 'B' +# module C' : + sig + external code : char -> int = "%identity" + val chr : int -> char + val escaped : char -> string + val lowercase : char -> char + val uppercase : char -> char + type t = char + val compare : t -> t -> int + external unsafe_chr : int -> char = "%identity" + end +# - : char = 'B' +# Characters 27-29: + module C'' : (module C) = C';; (* fails *) + ^^ +Error: Signature mismatch: + Modules do not match: (module C') is not included in (module C) +# module C'' = Char +# - : char = 'B' +# module C3 : + sig + external code : char -> int = "%identity" + val chr : int -> char + val escaped : char -> string + val lowercase : char -> char + val uppercase : char -> char + type t = char + val compare : t -> t -> int + external unsafe_chr : int -> char = "%identity" + end +# - : char = 'B' +# val f : 'a list -> int = <fun> +# val g : int list -> int = <fun> +# module F : + functor (X : sig end) -> + sig + external code : char -> int = "%identity" + val chr : int -> char + val escaped : char -> string + val lowercase : char -> char + val uppercase : char -> char + type t = char + val compare : t -> t -> int + external unsafe_chr : int -> char = "%identity" + end +# module C4 : + sig + external code : char -> int = "%identity" + val chr : int -> char + val escaped : char -> string + val lowercase : char -> char + val uppercase : char -> char + type t = char + val compare : t -> t -> int + external unsafe_chr : int -> char = "%identity" + end +# - : char = 'B' +# module G : functor (X : sig end) -> sig module M : sig end end +# module M : sig module M : sig end end +# module M' : sig module N : sig val x : int end module N' = N end +# - : int = 1 +# module M'' : sig module N' : sig val x : int end end +# - : int = 1 +# module M2 : sig module N = M'.N module N' = M'.N' end +# module M3 : sig module N' : sig val x : int end end +# - : int = 1 +# module M3' : sig module N' : sig val x : int end end +# - : int = 1 +# module M4 : sig module N' : sig val x : int end end +# - : int = 1 +# module F : + functor (X : sig end) -> + sig module N : sig val x : int end module N' = N end +# module G : functor (X : sig end) -> sig module N' : sig val x : int end end +# module M5 : sig module N' : sig val x : int end end +# - : int = 1 +# module M : + sig + module D : sig val y : int end + module N : sig val x : int end + module N' = N + end +# module M1 : sig module N : sig val x : int end module N' = N end +# - : int = 1 +# module M2 : sig module N' : sig val x : int end end +# - : int = 1 +# # - : int = 1 +# module M : sig module C = Char module C' = C end +# module M1 : + sig module C : sig val escaped : char -> string end module C' = C end +# - : string = "A" +# module M2 : sig module C' : sig val chr : int -> char end end +# - : char = 'B' +# - : f:('a -> 'b) -> 'a list -> 'b list = <fun> +# module Q = Queue +# exception QE +# - : string = "Ok" +# module type Complex = + sig + type t = Complex.t = { re : float; im : float; } + val zero : t + val one : t + val i : t + val neg : t -> t + val conj : t -> t + val add : t -> t -> t + val sub : t -> t -> t + val mul : t -> t -> t + val inv : t -> t + val div : t -> t -> t + val sqrt : t -> t + val norm2 : t -> float + val norm : t -> float + val arg : t -> float + val polar : float -> float -> t + val exp : t -> t + val log : t -> t + val pow : t -> t -> t + end +# module M : sig module C : Complex end +# module C = Complex +# - : float = 1. +# type t = Complex.t = { re : float; im : float; } +val zero : t = {re = 0.; im = 0.} +val one : t = {re = 1.; im = 0.} +val i : t = {re = 0.; im = 1.} +val neg : t -> t = <fun> +val conj : t -> t = <fun> +val add : t -> t -> t = <fun> +val sub : t -> t -> t = <fun> +val mul : t -> t -> t = <fun> +val inv : t -> t = <fun> +val div : t -> t -> t = <fun> +val sqrt : t -> t = <fun> +val norm2 : t -> float = <fun> +val norm : t -> float = <fun> +val arg : t -> float = <fun> +val polar : float -> float -> t = <fun> +val exp : t -> t = <fun> +val log : t -> t = <fun> +val pow : t -> t -> t = <fun> +# module F : functor (X : sig module C = Char end) -> sig module C = Char end +# module S = String +module StringSet : + sig + type elt = String.t + type t = Set.Make(String).t + val empty : t + val is_empty : t -> bool + val mem : elt -> t -> bool + val add : elt -> t -> t + val singleton : elt -> t + val remove : elt -> t -> t + val union : t -> t -> t + val inter : t -> t -> t + val diff : t -> t -> t + val compare : t -> t -> int + val equal : t -> t -> bool + val subset : t -> t -> bool + val iter : (elt -> unit) -> t -> unit + val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a + val for_all : (elt -> bool) -> t -> bool + val exists : (elt -> bool) -> t -> bool + val filter : (elt -> bool) -> t -> t + val partition : (elt -> bool) -> t -> t * t + val cardinal : t -> int + val elements : t -> elt list + val min_elt : t -> elt + val max_elt : t -> elt + val choose : t -> elt + val split : elt -> t -> t * bool * t + val find : elt -> t -> elt + val of_list : elt list -> t + end +module SSet : + sig + type elt = S.t + type t = Set.Make(S).t + val empty : t + val is_empty : t -> bool + val mem : elt -> t -> bool + val add : elt -> t -> t + val singleton : elt -> t + val remove : elt -> t -> t + val union : t -> t -> t + val inter : t -> t -> t + val diff : t -> t -> t + val compare : t -> t -> int + val equal : t -> t -> bool + val subset : t -> t -> bool + val iter : (elt -> unit) -> t -> unit + val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a + val for_all : (elt -> bool) -> t -> bool + val exists : (elt -> bool) -> t -> bool + val filter : (elt -> bool) -> t -> t + val partition : (elt -> bool) -> t -> t * t + val cardinal : t -> int + val elements : t -> elt list + val min_elt : t -> elt + val max_elt : t -> elt + val choose : t -> elt + val split : elt -> t -> t * bool * t + val find : elt -> t -> elt + val of_list : elt list -> t + end +# val f : StringSet.t -> SSet.t = <fun> +# module F : functor (M : sig end) -> sig type t end +module T : sig module M : sig end type t = F(M).t end +# module M = T.M +type t = F(M).t +# val f : t -> T.t = <fun> +# module A : + sig + module B : sig type t val compare : 'a -> 'b -> int end + module S : + sig + type elt = B.t + type t = Set.Make(B).t + val empty : t + val is_empty : t -> bool + val mem : elt -> t -> bool + val add : elt -> t -> t + val singleton : elt -> t + val remove : elt -> t -> t + val union : t -> t -> t + val inter : t -> t -> t + val diff : t -> t -> t + val compare : t -> t -> int + val equal : t -> t -> bool + val subset : t -> t -> bool + val iter : (elt -> unit) -> t -> unit + val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a + val for_all : (elt -> bool) -> t -> bool + val exists : (elt -> bool) -> t -> bool + val filter : (elt -> bool) -> t -> t + val partition : (elt -> bool) -> t -> t * t + val cardinal : t -> int + val elements : t -> elt list + val min_elt : t -> elt + val max_elt : t -> elt + val choose : t -> elt + val split : elt -> t -> t * bool * t + val find : elt -> t -> elt + val of_list : elt list -> t + end + val empty : S.t + end +module A1 = A +# - : bool = true +# module FF : functor (X : sig end) -> sig type t end +module M : + sig + module X : sig end + module Y : sig type t = FF(X).t end + type t = Y.t + end +module F : + functor (Y : sig type t end) (M : sig type t = Y.t end) -> sig end +# module G : functor (M : sig type t = M.Y.t end) -> sig end +# * module A1 : sig end +module A2 : sig end +module L1 : sig module X = A1 end +module L2 : sig module X = A2 end +# module F : functor (L : sig module X : sig end end) -> sig end +# module F1 : sig end +# module F2 : sig end +# module Int : sig type t = int val compare : 'a -> 'a -> int end +module SInt : + sig + type elt = Int.t + type t = Set.Make(Int).t + val empty : t + val is_empty : t -> bool + val mem : elt -> t -> bool + val add : elt -> t -> t + val singleton : elt -> t + val remove : elt -> t -> t + val union : t -> t -> t + val inter : t -> t -> t + val diff : t -> t -> t + val compare : t -> t -> int + val equal : t -> t -> bool + val subset : t -> t -> bool + val iter : (elt -> unit) -> t -> unit + val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a + val for_all : (elt -> bool) -> t -> bool + val exists : (elt -> bool) -> t -> bool + val filter : (elt -> bool) -> t -> t + val partition : (elt -> bool) -> t -> t * t + val cardinal : t -> int + val elements : t -> elt list + val min_elt : t -> elt + val max_elt : t -> elt + val choose : t -> elt + val split : elt -> t -> t * bool * t + val find : elt -> t -> elt + val of_list : elt list -> t + end +type (_, _) eq = Eq : ('a, 'a) eq +type wrap = W of (SInt.t, SInt.t) eq +module M : + sig + module I = Int + type wrap' = wrap = W of (Set.Make(Int).t, Set.Make(I).t) eq + end +# module type S = + sig + module I = Int + type wrap' = wrap = W of (Set.Make(Int).t, Set.Make(I).t) eq + end +# module Int2 : sig type t = int val compare : 'a -> 'a -> int end +# Characters 49-69: + include S with module I := I + ^^^^^^^^^^^^^^^^^^^^ +Error: In this `with' constraint, the new definition of I + does not match its original definition in the constrained signature: + Modules do not match: (module Int2) is not included in (module Int) +# * * * * * * * * * * * module M : + sig + module N : sig module I = Int end + module P : sig module I = N.I end + module Q : + sig type wrap' = wrap = W of (Set.Make(Int).t, Set.Make(P.I).t) eq end + end +# module type S = + sig + module N : sig module I = Int end + module P : sig module I = N.I end + module Q : + sig type wrap' = wrap = W of (Set.Make(Int).t, Set.Make(P.I).t) eq end + end +# module M : + sig + module N : sig module I = Int end + module P : sig module I = N.I end + module Q : + sig type wrap' = wrap = W of (Set.Make(Int).t, Set.Make(N.I).t) eq end + end +# module type S = + sig + module N : sig module I = Int end + module P : + sig module I : sig type t = int val compare : 'a -> 'a -> int end end + module Q : + sig type wrap' = wrap = W of (Set.Make(Int).t, Set.Make(N.I).t) eq end + end +# diff --git a/testsuite/tests/typing-modules/b.ml b/testsuite/tests/typing-modules/b.ml new file mode 100644 index 0000000000..4c43e809fd --- /dev/null +++ b/testsuite/tests/typing-modules/b.ml @@ -0,0 +1,18 @@ +open A +let f = + L.map S.capitalize + +let () = + L.iter print_endline (f ["jacques"; "garrigue"]) + +module C : sig module L : module type of List end = struct include A end + +(* The following introduces a (useless) dependency on A: +module C : sig module L : module type of List end = A +*) + +include D' +(* +let () = + print_endline (string_of_int D'.M.y) +*) diff --git a/testsuite/tests/typing-modules/b2.ml b/testsuite/tests/typing-modules/b2.ml new file mode 100644 index 0000000000..034e432c34 --- /dev/null +++ b/testsuite/tests/typing-modules/b2.ml @@ -0,0 +1,14 @@ +open A +let f = + L.map S.capitalize + +let () = + L.iter print_endline (f ["jacques"; "garrigue"]) + +module C : sig module L : module type of List end = struct include A end + +(* The following introduces a (useless) dependency on A: +module C : sig module L : module type of List end = A +*) + +(* No dependency on D *) diff --git a/testsuite/tests/typing-modules/b3.mli b/testsuite/tests/typing-modules/b3.mli new file mode 100644 index 0000000000..04599abe34 --- /dev/null +++ b/testsuite/tests/typing-modules/b3.mli @@ -0,0 +1,4 @@ +open A +(*module type S = module type of D'.M*) +type t = Complex.t +type s = String.t diff --git a/testsuite/tests/typing-modules/d.ml b/testsuite/tests/typing-modules/d.ml new file mode 100644 index 0000000000..55d311f408 --- /dev/null +++ b/testsuite/tests/typing-modules/d.ml @@ -0,0 +1,2 @@ +let x = 3 +module M = struct let y = 5 end diff --git a/testsuite/tests/typing-modules/firstclass.ml b/testsuite/tests/typing-modules/firstclass.ml new file mode 100644 index 0000000000..b778443a8d --- /dev/null +++ b/testsuite/tests/typing-modules/firstclass.ml @@ -0,0 +1,21 @@ +module type S = sig type u type t end;; +module type S' = sig type t = int type u = bool end;; + +(* ok to convert between structurally equal signatures, and parameters + are inferred *) +let f (x : (module S with type t = 'a and type u = 'b)) = (x : (module S'));; +let g x = (x : (module S with type t = 'a and type u = 'b) :> (module S'));; + +(* with subtyping it is also ok to forget some types *) +module type S2 = sig type u type t type w end;; +let g2 x = (x : (module S2 with type t = 'a and type u = 'b) :> (module S'));; +let h x = (x : (module S2 with type t = 'a) :> (module S with type t = 'a));; +let f2 (x : (module S2 with type t = 'a and type u = 'b)) = + (x : (module S'));; (* fail *) +let k (x : (module S2 with type t = 'a)) = + (x : (module S with type t = 'a));; (* fail *) + +(* but you cannot forget values (no physical coercions) *) +module type S3 = sig type u type t val x : int end;; +let g3 x = + (x : (module S3 with type t = 'a and type u = 'b) :> (module S'));; (* fail *) diff --git a/testsuite/tests/typing-modules/firstclass.ml.reference b/testsuite/tests/typing-modules/firstclass.ml.reference new file mode 100644 index 0000000000..db376005a1 --- /dev/null +++ b/testsuite/tests/typing-modules/firstclass.ml.reference @@ -0,0 +1,27 @@ + +# module type S = sig type u type t end +# module type S' = sig type t = int type u = bool end +# * val f : (module S with type t = int and type u = bool) -> (module S') = <fun> +# val g : (module S with type t = int and type u = bool) -> (module S') = <fun> +# module type S2 = sig type u type t type w end +# val g2 : (module S2 with type t = int and type u = bool) -> (module S') = + <fun> +# val h : (module S2 with type t = 'a) -> (module S with type t = 'a) = <fun> +# Characters 63-64: + (x : (module S'));; (* fail *) + ^ +Error: This expression has type + (module S2 with type t = int and type u = bool) + but an expression was expected of type (module S') +# Characters 46-47: + (x : (module S with type t = 'a));; (* fail *) + ^ +Error: This expression has type (module S2 with type t = 'a) + but an expression was expected of type (module S with type t = 'a) +# module type S3 = sig type u type t val x : int end +# Characters 13-78: + (x : (module S3 with type t = 'a and type u = 'b) :> (module S'));; (* fail *) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: Type (module S3 with type t = int and type u = bool) + is not a subtype of (module S') +# diff --git a/testsuite/tests/typing-modules/generative.ml b/testsuite/tests/typing-modules/generative.ml new file mode 100644 index 0000000000..2768aba619 --- /dev/null +++ b/testsuite/tests/typing-modules/generative.ml @@ -0,0 +1,33 @@ +(* Using generative functors *) + +(* Without type *) +module type S = sig val x : int end;; +let v = (module struct let x = 3 end : S);; +module F() = (val v);; (* ok *) +module G (X : sig end) : S = F ();; (* ok *) +module H (X : sig end) = (val v);; (* ok *) + +(* With type *) +module type S = sig type t val x : t end;; +let v = (module struct type t = int let x = 3 end : S);; +module F() = (val v);; (* ok *) +module G (X : sig end) : S = F ();; (* fail *) +module H() = F();; (* ok *) + +(* Alias *) +module U = struct end;; +module M = F(struct end);; (* ok *) +module M = F(U);; (* fail *) + +(* Cannot coerce between applicative and generative *) +module F1 (X : sig end) = struct end;; +module F2 : functor () -> sig end = F1;; (* fail *) +module F3 () = struct end;; +module F4 : functor (X : sig end) -> sig end = F3;; (* fail *) + +(* tests for shortened functor notation () *) +module X (X: sig end) (Y: sig end) = functor (Z: sig end) -> struct end;; +module Y = functor (X: sig end) (Y:sig end) -> functor (Z: sig end) -> struct end;; +module Z = functor (_: sig end) (_:sig end) (_: sig end) -> struct end;; +module GZ : functor (X: sig end) () (Z: sig end) -> sig end + = functor (X: sig end) () (Z: sig end) -> struct end;; diff --git a/testsuite/tests/typing-modules/generative.ml.reference b/testsuite/tests/typing-modules/generative.ml.reference new file mode 100644 index 0000000000..19aaa12842 --- /dev/null +++ b/testsuite/tests/typing-modules/generative.ml.reference @@ -0,0 +1,44 @@ + +# module type S = sig val x : int end +# val v : (module S) = <module> +# module F : functor () -> S +# module G : functor (X : sig end) -> S +# module H : functor (X : sig end) -> S +# module type S = sig type t val x : t end +# val v : (module S) = <module> +# module F : functor () -> S +# Characters 29-33: + module G (X : sig end) : S = F ();; (* fail *) + ^^^^ +Error: This expression creates fresh types. + It is not allowed inside applicative functors. +# module H : functor () -> S +# module U : sig end +# module M : S +# Characters 11-12: + module M = F(U);; (* fail *) + ^ +Error: This is a generative functor. It can only be applied to () +# module F1 : functor (X : sig end) -> sig end +# Characters 36-38: + module F2 : functor () -> sig end = F1;; (* fail *) + ^^ +Error: Signature mismatch: + Modules do not match: + functor (X : sig end) -> sig end + is not included in + functor () -> sig end +# module F3 : functor () -> sig end +# Characters 47-49: + module F4 : functor (X : sig end) -> sig end = F3;; (* fail *) + ^^ +Error: Signature mismatch: + Modules do not match: + functor () -> sig end + is not included in + functor (X : sig end) -> sig end +# module X : functor (X : sig end) (Y : sig end) (Z : sig end) -> sig end +# module Y : functor (X : sig end) (Y : sig end) (Z : sig end) -> sig end +# module Z : functor (_ : sig end) (_ : sig end) (_ : sig end) -> sig end +# module GZ : functor (X : sig end) () (Z : sig end) -> sig end +# diff --git a/testsuite/tests/typing-private/private.ml b/testsuite/tests/typing-private/private.ml index 2ad0018398..bab86eb845 100644 --- a/testsuite/tests/typing-private/private.ml +++ b/testsuite/tests/typing-private/private.ml @@ -103,3 +103,11 @@ let a = Test2.A;; (* fail *) (* The following should fail from a semantical point of view, but allow it for backward compatibility *) module Test2 : module type of Test with type t = private Test.t = Test;; + +(* PR#6331 *) +type t = private < x : int; .. > as 'a;; +type t = private (< x : int; .. > as 'a) as 'a;; +type t = private < x : int > as 'a;; +type t = private (< x : int > as 'a) as 'b;; +type 'a t = private < x : int; .. > as 'a;; +type 'a t = private 'a constraint 'a = < x : int; .. >;; diff --git a/testsuite/tests/typing-private/private.ml.principal.reference b/testsuite/tests/typing-private/private.ml.principal.reference new file mode 100644 index 0000000000..03e7957016 --- /dev/null +++ b/testsuite/tests/typing-private/private.ml.principal.reference @@ -0,0 +1,125 @@ + +# module Foobar : sig type t = private int end +# module F0 : sig type t = private int end +# Characters 21-22: + let f (x : F0.t) = (x : Foobar.t);; (* fails *) + ^ +Error: This expression has type F0.t but an expression was expected of type + Foobar.t +# module F = Foobar +# val f : F.t -> Foobar.t = <fun> +# module M : sig type t = < m : int > end +# module M1 : sig type t = private < m : int; .. > end +# module M2 : sig type t = private < m : int; .. > end +# Characters 19-20: + fun (x : M1.t) -> (x : M2.t);; (* fails *) + ^ +Error: This expression has type M1.t but an expression was expected of type + M2.t +# module M3 : sig type t = private M1.t end +# - : M3.t -> M1.t = <fun> +# - : M3.t -> M.t = <fun> +# Characters 44-46: + module M4 : sig type t = private M3.t end = M2;; (* fails *) + ^^ +Error: Signature mismatch: + Modules do not match: + sig type t = M2.t end + is not included in + sig type t = private M3.t end + Type declarations do not match: + type t = M2.t + is not included in + type t = private M3.t +# Characters 44-45: + module M4 : sig type t = private M3.t end = M;; (* fails *) + ^ +Error: Signature mismatch: + Modules do not match: + sig type t = < m : int > end + is not included in + sig type t = private M3.t end + Type declarations do not match: + type t = < m : int > + is not included in + type t = private M3.t +# Characters 44-46: + module M4 : sig type t = private M3.t end = M1;; (* might be ok *) + ^^ +Error: Signature mismatch: + Modules do not match: + sig type t = M1.t end + is not included in + sig type t = private M3.t end + Type declarations do not match: + type t = M1.t + is not included in + type t = private M3.t +# module M5 : sig type t = private M1.t end +# Characters 53-55: + module M6 : sig type t = private < n:int; .. > end = M1;; (* fails *) + ^^ +Error: Signature mismatch: + Modules do not match: + sig type t = M1.t end + is not included in + sig type t = private < n : int; .. > end + Type declarations do not match: + type t = M1.t + is not included in + type t = private < n : int; .. > +# Characters 69-118: + struct type t = int let f (x : int) = (x : t) end;; (* must fail *) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: Signature mismatch: + Modules do not match: + sig type t = int val f : int -> t end + is not included in + sig type t = private Foobar.t val f : int -> t end + Type declarations do not match: + type t = int + is not included in + type t = private Foobar.t +# module M : sig type t = private T of int val mk : int -> t end +# module M1 : sig type t = M.t val mk : int -> t end +# module M2 : sig type t = M.t val mk : int -> t end +# module M3 : sig type t = M.t val mk : int -> t end +# Characters 26-44: + type t = M.t = T of int + ^^^^^^^^^^^^^^^^^^ +Error: This variant or record definition does not match that of type M.t + A private type would be revealed. +# module M5 : sig type t = M.t = private T of int val mk : int -> t end +# module M6 : sig type t = private T of int val mk : int -> t end +# module M' : + sig type t_priv = private T of int type t = t_priv val mk : int -> t end +# module M3' : sig type t = M'.t val mk : int -> t end +# module M : sig type 'a t = private T of 'a end +# module M1 : sig type 'a t = 'a M.t = private T of 'a end +# module Test : sig type t = private A end +module Test2 : sig type t = Test.t = private A end +# val f : Test.t -> Test2.t = <fun> +# val f : Test2.t -> unit = <fun> +# Characters 8-15: + let a = Test2.A;; (* fail *) + ^^^^^^^ +Error: Cannot create values of the private type Test2.t +# * Characters 148-171: + module Test2 : module type of Test with type t = private Test.t = Test;; + ^^^^^^^^^^^^^^^^^^^^^^^ +Warning 3: deprecated feature: spurious use of private +module Test2 : sig type t = Test.t = private A end +# type t = private < x : int; .. > +# type t = private < x : int; .. > +# type t = private < x : int > +# type t = private < x : int > +# Characters -1--1: + type 'a t = private < x : int; .. > as 'a;; + +Error: Type declarations do not match: + type 'a t = private 'a constraint 'a = < x : int; .. > + is not included in + type 'a t + Their constraints differ. +# type 'a t = private 'a constraint 'a = < x : int; .. > +# diff --git a/testsuite/tests/typing-private/private.ml.reference b/testsuite/tests/typing-private/private.ml.reference index 3d217802b6..360940c927 100644 --- a/testsuite/tests/typing-private/private.ml.reference +++ b/testsuite/tests/typing-private/private.ml.reference @@ -6,7 +6,7 @@ ^ Error: This expression has type F0.t but an expression was expected of type Foobar.t -# module F : sig type t = Foobar.t end +# module F = Foobar # val f : F.t -> Foobar.t = <fun> # module M : sig type t = < m : int > end # module M1 : sig type t = private < m : int; .. > end @@ -109,4 +109,17 @@ Error: Cannot create values of the private type Test2.t ^^^^^^^^^^^^^^^^^^^^^^^ Warning 3: deprecated feature: spurious use of private module Test2 : sig type t = Test.t = private A end +# type t = private < x : int; .. > +# type t = private < x : int; .. > +# type t = private < x : int > +# type t = private < x : int > +# Characters -1--1: + type 'a t = private < x : int; .. > as 'a;; + +Error: Type declarations do not match: + type 'a t = private < x : int; .. > constraint 'a = 'a t + is not included in + type 'a t + Their constraints differ. +# type 'a t = private 'a constraint 'a = < x : int; .. > # diff --git a/testsuite/tests/typing-recmod/t19ok.ml b/testsuite/tests/typing-recmod/t19ok.ml index 62e5f45486..e51fa5c922 100644 --- a/testsuite/tests/typing-recmod/t19ok.ml +++ b/testsuite/tests/typing-recmod/t19ok.ml @@ -5,8 +5,11 @@ module PR_4758 = struct module type Mod = sig module Other : S end - module rec A : S = struct - end and C : sig include Mod with module Other = A end = struct + module rec A : S = struct end + and C : sig include Mod with module Other = A end = struct module Other = A end + module C' = C (* check that we can take an alias *) + module F(X:sig end) = struct type t end + let f (x : F(C).t) = (x : F(C').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 4c1a991a50..657a52145f 100644 --- a/testsuite/tests/typing-short-paths/short-paths.ml.reference +++ b/testsuite/tests/typing-short-paths/short-paths.ml.reference @@ -44,52 +44,7 @@ val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t end end - module Std : - sig - module Int : - sig - module T : - sig - type t = int - val compare : 'a -> 'a -> t - val ( + ) : t -> t -> t - end - type t = int - val compare : 'a -> 'a -> t - val ( + ) : t -> t -> t - module Map : - sig - type key = t - type 'a t = 'a Map.Make(T).t - val empty : 'a t - val is_empty : 'a t -> bool - val mem : key -> 'a t -> bool - val add : key -> 'a -> 'a t -> 'a t - val singleton : key -> 'a -> 'a t - val remove : key -> 'a t -> 'a t - val merge : - (key -> 'a option -> 'b option -> 'c option) -> - 'a t -> 'b t -> 'c t - val compare : ('a -> 'a -> key) -> 'a t -> 'a t -> key - val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool - val iter : (key -> 'a -> unit) -> 'a t -> unit - val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b - val for_all : (key -> 'a -> bool) -> 'a t -> bool - val exists : (key -> 'a -> bool) -> 'a t -> bool - val filter : (key -> 'a -> bool) -> 'a t -> 'a t - val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t - val cardinal : 'a t -> key - val bindings : 'a t -> (key * 'a) list - val min_binding : 'a t -> key * 'a - val max_binding : 'a t -> key * 'a - val choose : 'a t -> key * 'a - val split : key -> 'a t -> 'a t * 'a option * 'a t - val find : key -> 'a t -> 'a - val map : ('a -> 'b) -> 'a t -> 'b t - val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t - end - end - end + module Std : sig module Int = Int end end # # val x : 'a Int.Map.t = <abstr> # Characters 8-9: diff --git a/testsuite/tests/typing-signatures/els.ml b/testsuite/tests/typing-signatures/els.ml index 3713b64e5c..dfc2e07450 100644 --- a/testsuite/tests/typing-signatures/els.ml +++ b/testsuite/tests/typing-signatures/els.ml @@ -90,3 +90,6 @@ module type WEAPON_LIB = sig module Make : functor (TV : TYPEVIEW with type t = t) -> USERCODE(TV).F end;; + +module type X = functor (X: CORE) -> BARECODE;; +module type X = functor (_: CORE) -> BARECODE;; diff --git a/testsuite/tests/typing-signatures/els.ml.reference b/testsuite/tests/typing-signatures/els.ml.reference index 91b4a32f1d..407ced1d18 100644 --- a/testsuite/tests/typing-signatures/els.ml.reference +++ b/testsuite/tests/typing-signatures/els.ml.reference @@ -90,4 +90,6 @@ end) -> USERCODE(TV).F end +# module type X = functor (X : CORE) -> BARECODE +# module type X = functor (_ : CORE) -> BARECODE # diff --git a/testsuite/typing b/testsuite/typing index b2e68dc5cf..ff3818c1ce 100644 --- a/testsuite/typing +++ b/testsuite/typing @@ -3,6 +3,7 @@ tests/typing-gadts tests/typing-implicit_unpack tests/typing-labels tests/typing-misc +tests/typing-misc-bugs tests/typing-modules tests/typing-modules-bugs tests/typing-objects diff --git a/tools/.depend b/tools/.depend index bc45dc7616..a058ee37f3 100644 --- a/tools/.depend +++ b/tools/.depend @@ -27,14 +27,6 @@ depend.cmo : ../parsing/parsetree.cmi ../utils/misc.cmi \ depend.cmx : ../parsing/parsetree.cmi ../utils/misc.cmx \ ../parsing/longident.cmx ../parsing/location.cmx ../parsing/asttypes.cmi \ depend.cmi -dump_ast.cmo : ../typing/typetexp.cmi ../typing/typedtree.cmi \ - ../toplevel/toploop.cmi ../parsing/parse.cmi ../typing/outcometree.cmi \ - ../typing/oprint.cmi ../driver/errors.cmi ../typing/env.cmi \ - ../utils/config.cmi -dump_ast.cmx : ../typing/typetexp.cmx ../typing/typedtree.cmx \ - ../toplevel/toploop.cmx ../parsing/parse.cmx ../typing/outcometree.cmi \ - ../typing/oprint.cmx ../driver/errors.cmx ../typing/env.cmx \ - ../utils/config.cmx dumpobj.cmo : ../utils/tbl.cmi opnames.cmo ../bytecomp/opcodes.cmo \ ../utils/misc.cmi ../parsing/location.cmi ../bytecomp/lambda.cmi \ ../bytecomp/instruct.cmi ../typing/ident.cmi ../utils/config.cmi \ @@ -49,40 +41,34 @@ eqparsetree.cmo : ../parsing/parsetree.cmi ../parsing/longident.cmi \ ../parsing/location.cmi ../parsing/asttypes.cmi eqparsetree.cmx : ../parsing/parsetree.cmi ../parsing/longident.cmx \ ../parsing/location.cmx ../parsing/asttypes.cmi -myocamlbuild_config.cmo : -myocamlbuild_config.cmx : -objinfo.cmo : ../utils/misc.cmi ../utils/config.cmi \ - ../asmcomp/cmx_format.cmi ../bytecomp/cmo_format.cmi \ - ../typing/cmi_format.cmi ../asmcomp/clambda.cmi \ - ../bytecomp/bytesections.cmi -objinfo.cmx : ../utils/misc.cmx ../utils/config.cmx \ - ../asmcomp/cmx_format.cmi ../bytecomp/cmo_format.cmi \ - ../typing/cmi_format.cmx ../asmcomp/clambda.cmx \ - ../bytecomp/bytesections.cmx +objinfo.cmo : ../asmcomp/printclambda.cmi ../utils/misc.cmi \ + ../utils/config.cmi ../asmcomp/cmx_format.cmi ../bytecomp/cmo_format.cmi \ + ../typing/cmi_format.cmi ../bytecomp/bytesections.cmi +objinfo.cmx : ../asmcomp/printclambda.cmx ../utils/misc.cmx \ + ../utils/config.cmx ../asmcomp/cmx_format.cmi ../bytecomp/cmo_format.cmi \ + ../typing/cmi_format.cmx ../bytecomp/bytesections.cmx ocaml299to3.cmo : ocaml299to3.cmx : ocamlcp.cmo : ../driver/main_args.cmi ocamlcp.cmx : ../driver/main_args.cmx -ocamldep.cmo : ../parsing/syntaxerr.cmi ../driver/pparse.cmi \ - ../parsing/parsetree.cmi ../parsing/parse.cmi ../utils/misc.cmi \ - ../parsing/location.cmi ../parsing/lexer.cmi depend.cmi \ +ocamldep.cmo : ../driver/pparse.cmi ../parsing/parsetree.cmi \ + ../parsing/parse.cmi ../utils/misc.cmi ../parsing/location.cmi depend.cmi \ ../utils/config.cmi ../driver/compenv.cmi ../utils/clflags.cmi -ocamldep.cmx : ../parsing/syntaxerr.cmx ../driver/pparse.cmx \ - ../parsing/parsetree.cmi ../parsing/parse.cmx ../utils/misc.cmx \ - ../parsing/location.cmx ../parsing/lexer.cmx depend.cmx \ +ocamldep.cmx : ../driver/pparse.cmx ../parsing/parsetree.cmi \ + ../parsing/parse.cmx ../utils/misc.cmx ../parsing/location.cmx depend.cmx \ ../utils/config.cmx ../driver/compenv.cmx ../utils/clflags.cmx -ocamlmklib.cmo : myocamlbuild_config.cmo -ocamlmklib.cmx : myocamlbuild_config.cmx +ocamlmklib.cmo : ocamlmklibconfig.cmo +ocamlmklib.cmx : ocamlmklibconfig.cmx +ocamlmklibconfig.cmo : +ocamlmklibconfig.cmx : ocamlmktop.cmo : ../utils/ccomp.cmi ocamlmktop.cmx : ../utils/ccomp.cmx ocamloptp.cmo : ../driver/main_args.cmi ocamloptp.cmx : ../driver/main_args.cmx -ocamlprof.cmo : ../utils/warnings.cmi ../parsing/syntaxerr.cmi \ - ../parsing/parsetree.cmi ../parsing/parse.cmi ../parsing/location.cmi \ - ../parsing/lexer.cmi -ocamlprof.cmx : ../utils/warnings.cmx ../parsing/syntaxerr.cmx \ - ../parsing/parsetree.cmi ../parsing/parse.cmx ../parsing/location.cmx \ - ../parsing/lexer.cmx +ocamlprof.cmo : ../utils/warnings.cmi ../parsing/parsetree.cmi \ + ../parsing/parse.cmi ../parsing/location.cmi +ocamlprof.cmx : ../utils/warnings.cmx ../parsing/parsetree.cmi \ + ../parsing/parse.cmx ../parsing/location.cmx opnames.cmo : opnames.cmx : primreq.cmo : ../utils/config.cmi ../bytecomp/cmo_format.cmi @@ -93,13 +79,13 @@ read_cmt.cmo : ../typing/cmt_format.cmi cmt2annot.cmo ../utils/clflags.cmi read_cmt.cmx : ../typing/cmt_format.cmx cmt2annot.cmx ../utils/clflags.cmx scrapelabels.cmo : scrapelabels.cmx : -tast_iter.cmo : ../typing/typedtree.cmi ../parsing/asttypes.cmi \ - tast_iter.cmi -tast_iter.cmx : ../typing/typedtree.cmx ../parsing/asttypes.cmi \ - tast_iter.cmi +tast_iter.cmo : ../typing/typedtree.cmi ../utils/misc.cmi tast_iter.cmi +tast_iter.cmx : ../typing/typedtree.cmx ../utils/misc.cmx tast_iter.cmi untypeast.cmo : ../typing/typedtree.cmi ../typing/path.cmi \ - ../parsing/parsetree.cmi ../parsing/longident.cmi ../typing/ident.cmi \ - ../parsing/asttypes.cmi untypeast.cmi + ../parsing/parsetree.cmi ../utils/misc.cmi ../parsing/longident.cmi \ + ../typing/ident.cmi ../parsing/asttypes.cmi ../parsing/ast_helper.cmi \ + untypeast.cmi untypeast.cmx : ../typing/typedtree.cmx ../typing/path.cmx \ - ../parsing/parsetree.cmi ../parsing/longident.cmx ../typing/ident.cmx \ - ../parsing/asttypes.cmi untypeast.cmi + ../parsing/parsetree.cmi ../utils/misc.cmx ../parsing/longident.cmx \ + ../typing/ident.cmx ../parsing/asttypes.cmi ../parsing/ast_helper.cmx \ + untypeast.cmi diff --git a/tools/.ignore b/tools/.ignore index ce14846de2..5f3f25bf13 100644 --- a/tools/.ignore +++ b/tools/.ignore @@ -18,11 +18,9 @@ keywords lexer299.ml ocaml299to3 ocamlmklib -ocamlmklib.ml lexer301.ml scrapelabels addlabels -myocamlbuild_config.ml objinfo_helper read_cmt read_cmt.opt diff --git a/tools/Makefile.shared b/tools/Makefile.shared index 28ecac8288..39be1db4e9 100644 --- a/tools/Makefile.shared +++ b/tools/Makefile.shared @@ -12,12 +12,13 @@ include ../config/Makefile -CAMLC=../boot/ocamlrun ../boot/ocamlc -strict-sequence -nostdlib -I ../boot -CAMLOPT=../boot/ocamlrun ../ocamlopt -nostdlib -I ../stdlib +CAMLRUN=../boot/ocamlrun +CAMLC=$(CAMLRUN) ../boot/ocamlc -strict-sequence -nostdlib -I ../boot +CAMLOPT=$(CAMLRUN) ../ocamlopt -nostdlib -I ../stdlib CAMLLEX=$(CAMLRUN) ../boot/ocamllex INCLUDES=-I ../utils -I ../parsing -I ../typing -I ../bytecomp -I ../asmcomp \ -I ../driver -I ../toplevel -COMPFLAGS= -w +33..39 -warn-error A $(INCLUDES) +COMPFLAGS= -w +32..39 -warn-error A $(INCLUDES) LINKFLAGS=$(INCLUDES) all: ocamldep ocamlprof ocamlcp ocamloptp ocamlmktop ocamlmklib dumpobj \ @@ -92,17 +93,8 @@ clean:: # To help building mixed-mode libraries (OCaml + C) -ocamlmklib: myocamlbuild_config.cmo ocamlmklib.cmo - $(CAMLC) $(LINKFLAGS) -o ocamlmklib myocamlbuild_config.cmo \ - ocamlmklib.cmo - -ocamlmklib.cmo: myocamlbuild_config.cmi - -myocamlbuild_config.cmi: myocamlbuild_config.cmo - -myocamlbuild_config.ml: ../config/Makefile ../build/mk_shell_and_ocamlbuild_config.sh - ../build/mk_shell_and_ocamlbuild_config.sh - cp ../myocamlbuild_config.ml . +ocamlmklib: ocamlmklibconfig.cmo ocamlmklib.cmo + $(CAMLC) $(LINKFLAGS) -o ocamlmklib ocamlmklibconfig.cmo ocamlmklib.cmo install:: cp ocamlmklib $(BINDIR)/ocamlmklib$(EXE) @@ -110,22 +102,23 @@ install:: clean:: rm -f ocamlmklib -ocamlmklib.ml: ocamlmklib.mlp ../config/Makefile - echo '(* THIS FILE IS GENERATED FROM ocamlmklib.mlp *)' >ocamlmklib.ml - sed -e "s|%%BINDIR%%|$(BINDIR)|" \ - -e "s|%%SUPPORTS_SHARED_LIBRARIES%%|$(SUPPORTS_SHARED_LIBRARIES)|" \ - -e "s|%%MKSHAREDLIB%%|$(MKSHAREDLIB)|" \ - -e "s|%%BYTECCRPATH%%|$(BYTECCRPATH)|" \ - -e "s|%%NATIVECCRPATH%%|$(NATIVECCRPATH)|" \ - -e "s|%%MKSHAREDLIBRPATH%%|$(MKSHAREDLIBRPATH)|" \ - -e "s|%%RANLIB%%|$(RANLIB)|" \ - ocamlmklib.mlp >> ocamlmklib.ml - -beforedepend:: ocamlmklib.ml +ocamlmklibconfig.ml: ../config/Makefile + (echo 'let bindir = "$(BINDIR)"'; \ + echo 'let ext_lib = "$(EXT_LIB)"'; \ + echo 'let ext_dll = "$(EXT_DLL)"'; \ + echo 'let supports_shared_libraries = $(SUPPORTS_SHARED_LIBRARIES)';\ + echo 'let mkdll = "$(MKDLL)"'; \ + echo 'let byteccrpath = "$(BYTECCRPATH)"'; \ + echo 'let nativeccrpath = "$(NATIVECCRPATH)"'; \ + echo 'let mksharedlibrpath = "$(MKSHAREDLIBRPATH)"'; \ + echo 'let toolpref = "$(TOOLPREF)"'; \ + sed -n -e 's/^#ml //p' ../config/Makefile) \ + > ocamlmklibconfig.ml + +beforedepend:: ocamlmklibconfig.ml clean:: - rm -f ocamlmklib.ml - + rm -f ocamlmklibconfig.ml # Converter olabl/ocaml 2.99 to ocaml 3 @@ -283,9 +276,9 @@ objinfo_helper$(EXE): objinfo_helper.c ../config/s.h $(BYTECC) -o objinfo_helper$(EXE) $(BYTECCCOMPOPTS) \ objinfo_helper.c $(LIBBFD_LINK) -OBJINFO=../utils/misc.cmo ../utils/config.cmo \ - ../utils/warnings.cmo ../parsing/location.cmo \ - ../typing/cmi_format.cmo ../bytecomp/bytesections.cmo \ +OBJINFO=../compilerlibs/ocamlcommon.cma \ + ../compilerlibs/ocamlbytecomp.cma \ + ../asmcomp/printclambda.cmo \ objinfo.cmo objinfo: objinfo_helper$(EXE) $(OBJINFO) diff --git a/tools/depend.ml b/tools/depend.ml index a1b851e24d..7ff6704f70 100644 --- a/tools/depend.ml +++ b/tools/depend.ml @@ -199,9 +199,11 @@ and add_bindings recf bv pel = and add_modtype bv mty = match mty.pmty_desc with Pmty_ident l -> add bv l + | Pmty_alias l -> addmodule 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 +260,7 @@ and add_module bv modl = 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 diff --git a/tools/eqparsetree.ml b/tools/eqparsetree.ml index 6326d67e02..332efa3e14 100644 --- a/tools/eqparsetree.ml +++ b/tools/eqparsetree.ml @@ -666,7 +666,7 @@ and eq_expression_desc : eq_list (fun ((a0, a1), (b0, b1)) -> (eq_pattern (a0, b0)) && (eq_expression (a1, b1))) - (a2, b2)) + (a2, b2) | (Pexp_apply (a0, a1), Pexp_apply (b0, b1)) -> (eq_expression (a0, b0)) && (eq_list diff --git a/tools/objinfo.ml b/tools/objinfo.ml index eb88a8b29c..6f3ec75665 100644 --- a/tools/objinfo.ml +++ b/tools/objinfo.ml @@ -20,7 +20,6 @@ open Printf open Misc open Config open Cmo_format -open Clambda let input_stringlist ic len = let get_string_list sect len = @@ -54,31 +53,6 @@ let print_cmo_infos cu = List.iter print_line l); printf "Force link: %s\n" (if cu.cu_force_link then "YES" else "no") -let rec print_approx_infos ppf = function - Value_closure(fundesc, approx) -> - Format.fprintf ppf "@[<2>function %s@ arity %i" - fundesc.fun_label fundesc.fun_arity; - if fundesc.fun_closed then begin - Format.fprintf ppf "@ (closed)" - end; - if fundesc.fun_inline <> None then begin - Format.fprintf ppf "@ (inline)" - end; - Format.fprintf ppf "@ -> @ %a@]" print_approx_infos approx - | Value_tuple approx -> - let tuple ppf approx = - for i = 0 to Array.length approx - 1 do - if i > 0 then Format.fprintf ppf ";@ "; - Format.fprintf ppf "%i: %a" i print_approx_infos approx.(i) - done in - Format.fprintf ppf "@[<hov 1>(%a)@]" tuple approx - | Value_unknown -> - Format.fprintf ppf "_" - | Value_integer n -> - Format.fprintf ppf "%d" n - | Value_constptr n -> - Format.fprintf ppf "%dp" n - let print_spaced_string s = printf " %s" s @@ -116,7 +90,7 @@ let print_cmx_infos (ui, crc) = print_general_infos ui.ui_name crc ui.ui_defines ui.ui_imports_cmi ui.ui_imports_cmx; printf "Approximation:\n"; - Format.fprintf Format.std_formatter " %a@." print_approx_infos ui.ui_approx; + Format.fprintf Format.std_formatter " %a@." Printclambda.approx ui.ui_approx; let pr_funs _ fns = List.iter (fun arity -> printf " %d" arity) fns in printf "Currying functions:%a\n" pr_funs ui.ui_curry_fun; diff --git a/tools/ocamlcp.ml b/tools/ocamlcp.ml index 82b0174a87..bca5ae63c5 100644 --- a/tools/ocamlcp.ml +++ b/tools/ocamlcp.ml @@ -79,6 +79,7 @@ module Options = Main_args.Make_bytecomp_options (struct let _runtime_variant s = option_with_arg "-runtime-variant" s let _short_paths = option "-short-paths" let _strict_sequence = option "-strict-sequence" + let _trans_mod = option "-trans-mod" let _thread () = option "-thread" () let _vmthread () = option "-vmthread" () let _unsafe = option "-unsafe" diff --git a/tools/ocamlmklib.mlp b/tools/ocamlmklib.ml index 9a47d1b5e6..0ef86979b9 100644 --- a/tools/ocamlmklib.mlp +++ b/tools/ocamlmklib.ml @@ -11,7 +11,7 @@ (***********************************************************************) open Printf -open Myocamlbuild_config +open Ocamlmklibconfig (* PR#4783: under Windows, don't use absolute paths because we do not know where the binary distribution will be installed. *) diff --git a/tools/ocamloptp.ml b/tools/ocamloptp.ml index 23a439a11b..6d730f2c3c 100644 --- a/tools/ocamloptp.ml +++ b/tools/ocamloptp.ml @@ -84,6 +84,7 @@ module Options = Main_args.Make_optcomp_options (struct let _strict_sequence = option "-strict-sequence" let _shared = option "-shared" let _thread = option "-thread" + let _trans_mod = option "-trans-mod" let _unsafe = option "-unsafe" let _v = option "-v" let _version = option "-version" diff --git a/tools/tast_iter.ml b/tools/tast_iter.ml index 776e33522f..c8af136701 100644 --- a/tools/tast_iter.ml +++ b/tools/tast_iter.ml @@ -191,9 +191,10 @@ let class_type_declaration sub cd = let module_type sub mty = match mty.mty_desc with | Tmty_ident (_path, _) -> () + | Tmty_alias (_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 +213,7 @@ let module_expr sub mexpr = | 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; diff --git a/tools/untypeast.ml b/tools/untypeast.ml index 75f7ebdecc..26993440ae 100644 --- a/tools/untypeast.ml +++ b/tools/untypeast.ml @@ -62,7 +62,8 @@ and untype_structure_item item = | Tstr_recmodule list -> Pstr_recmodule (List.map untype_module_binding list) | Tstr_modtype mtd -> - Pstr_modtype {pmtd_name=mtd.mtd_name; pmtd_type=option untype_module_type mtd.mtd_type; pmtd_attributes=mtd.mtd_attributes} + Pstr_modtype {pmtd_name=mtd.mtd_name; pmtd_type=option untype_module_type mtd.mtd_type; + pmtd_loc=mtd.mtd_loc;pmtd_attributes=mtd.mtd_attributes;} | Tstr_open (ovf, _path, lid, attrs) -> Pstr_open (ovf, lid, attrs) | Tstr_class list -> Pstr_class (List.map (fun (ci, _, _) -> @@ -106,6 +107,7 @@ and untype_module_binding mb = pmb_name = mb.mb_name; pmb_expr = untype_module_expr mb.mb_expr; pmb_attributes = mb.mb_attributes; + pmb_loc = mb.mb_loc; } and untype_type_declaration decl = @@ -330,14 +332,15 @@ and untype_signature_item item = Psig_exception (untype_constructor_declaration decl) | Tsig_module md -> Psig_module {pmd_name = md.md_name; pmd_type = untype_module_type md.md_type; - pmd_attributes = md.md_attributes; + pmd_attributes = md.md_attributes; pmd_loc = md.md_loc; } | Tsig_recmodule list -> Psig_recmodule (List.map (fun md -> {pmd_name = md.md_name; pmd_type = untype_module_type md.md_type; - pmd_attributes = md.md_attributes}) list) + pmd_attributes = md.md_attributes; pmd_loc = md.md_loc}) list) | Tsig_modtype mtd -> - Psig_modtype {pmtd_name=mtd.mtd_name; pmtd_type=option untype_module_type mtd.mtd_type; pmtd_attributes=mtd.mtd_attributes} + Psig_modtype {pmtd_name=mtd.mtd_name; pmtd_type=option untype_module_type mtd.mtd_type; + pmtd_attributes=mtd.mtd_attributes; pmtd_loc=mtd.mtd_loc} | Tsig_open (ovf, _path, lid, attrs) -> Psig_open (ovf, lid, attrs) | Tsig_include (mty, _, attrs) -> Psig_include (untype_module_type mty, attrs) | Tsig_class list -> @@ -374,9 +377,10 @@ and untype_class_type_declaration cd = and untype_module_type mty = let desc = match mty.mty_desc with Tmty_ident (_path, lid) -> Pmty_ident (lid) + | Tmty_alias (_path, lid) -> Pmty_alias (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 +409,7 @@ and untype_module_expr mexpr = 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) diff --git a/toplevel/genprintval.ml b/toplevel/genprintval.ml index c37b2884cd..10f4fdeb71 100644 --- a/toplevel/genprintval.ml +++ b/toplevel/genprintval.ml @@ -32,7 +32,7 @@ module type OBJ = module type EVALPATH = sig type valu - val eval_path: Path.t -> valu + val eval_path: Env.t -> Path.t -> valu exception Error val same_value: valu -> valu -> bool end @@ -368,7 +368,7 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct (* Make sure this is the right exception and not an homonym, by evaluating the exception found and comparing with the identifier contained in the exception bucket *) - if not (EVP.same_value slot (EVP.eval_path path)) + if not (EVP.same_value slot (EVP.eval_path env path)) then raise Not_found; tree_of_constr_with_args (fun x -> Oide_ident x) name 1 depth bucket cstr.cstr_args diff --git a/toplevel/genprintval.mli b/toplevel/genprintval.mli index 8ddf0796b0..3f7b85ab69 100644 --- a/toplevel/genprintval.mli +++ b/toplevel/genprintval.mli @@ -28,7 +28,7 @@ module type OBJ = module type EVALPATH = sig type valu - val eval_path: Path.t -> valu + val eval_path: Env.t -> Path.t -> valu exception Error val same_value: valu -> valu -> bool end diff --git a/toplevel/topdirs.ml b/toplevel/topdirs.ml index 044e94da94..20fe39b260 100644 --- a/toplevel/topdirs.ml +++ b/toplevel/topdirs.ml @@ -221,7 +221,7 @@ 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 v = eval_path path 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)) @@ -262,7 +262,7 @@ let dir_trace ppf lid = fprintf ppf "%a is an external function and cannot be traced.@." Printtyp.longident lid | _ -> - let clos = eval_path path in + let clos = eval_path !toplevel_env path in (* Nothing to do if it's not a closure *) if Obj.is_block clos && (Obj.tag clos = Obj.closure_tag || Obj.tag clos = Obj.infix_tag) diff --git a/toplevel/toploop.ml b/toplevel/toploop.ml index f556fb65ec..503a11e5e0 100644 --- a/toplevel/toploop.ml +++ b/toplevel/toploop.ml @@ -61,12 +61,15 @@ let rec eval_path = function | Papply(p1, p2) -> fatal_error "Toploop.eval_path" +let eval_path env path = + eval_path (Env.normalize_path (Some Location.none) env path) + (* To print values *) module EvalPath = struct type valu = Obj.t exception Error - let eval_path p = try eval_path p with Symtable.Error _ -> raise Error + let eval_path env p = try eval_path env p with Symtable.Error _ -> raise Error let same_value v1 v2 = (v1 == v2) end diff --git a/toplevel/toploop.mli b/toplevel/toploop.mli index da607de9d7..324857a835 100644 --- a/toplevel/toploop.mli +++ b/toplevel/toploop.mli @@ -60,7 +60,7 @@ val mod_use_file : formatter -> string -> bool [use_file] prints the types and values of the results. [use_silently] does not print them. [mod_use_file] wrap the file contents into a module. *) -val eval_path: Path.t -> Obj.t +val eval_path: Env.t -> Path.t -> Obj.t (* Return the toplevel object referred to by the given path *) (* Printing of values *) diff --git a/toplevel/topmain.ml b/toplevel/topmain.ml index 3091ca0d2a..0f3ac66f9d 100644 --- a/toplevel/topmain.ml +++ b/toplevel/topmain.ml @@ -79,6 +79,7 @@ module Options = Main_args.Make_bytetop_options (struct let _short_paths = clear real_paths let _stdin () = file_argument "" let _strict_sequence = set strict_sequence + let _trans_mod = set transparent_modules let _unsafe = set fast let _version () = print_version () let _vnum () = print_version_num () diff --git a/typing/btype.ml b/typing/btype.ml index c76639d56f..366e09e9a3 100644 --- a/typing/btype.ml +++ b/typing/btype.ml @@ -12,6 +12,7 @@ (* Basic operations on core types *) +open Misc open Types (**** Sets, maps and hashtables of types ****) @@ -56,6 +57,9 @@ let is_Tvar = function {desc=Tvar _} -> true | _ -> false 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 ****) @@ -232,6 +236,101 @@ let rec iter_abbrev f = function | Mcons(_, _, ty, ty', rem) -> f ty; f ty'; iter_abbrev f rem | Mlink rem -> iter_abbrev f !rem +type type_iterators = + { it_signature: type_iterators -> signature -> unit; + it_signature_item: type_iterators -> signature_item -> unit; + it_value_description: type_iterators -> value_description -> unit; + it_type_declaration: type_iterators -> type_declaration -> unit; + it_exception_declaration: type_iterators -> exception_declaration -> unit; + it_module_declaration: type_iterators -> module_declaration -> unit; + it_modtype_declaration: type_iterators -> modtype_declaration -> unit; + it_class_declaration: type_iterators -> class_declaration -> unit; + it_class_type_declaration: type_iterators -> class_type_declaration -> unit; + it_module_type: type_iterators -> module_type -> unit; + it_class_type: type_iterators -> class_type -> unit; + it_type_kind: type_iterators -> type_kind -> unit; + it_type_expr: type_iterators -> type_expr -> unit; + it_path: Path.t -> unit; } + +let type_iterators = + let it_signature it = + List.iter (it.it_signature_item it) + and it_signature_item it = function + Sig_value (_, vd) -> it.it_value_description it vd + | Sig_type (_, td, _) -> it.it_type_declaration it td + | Sig_exception (_, ed) -> it.it_exception_declaration it ed + | Sig_module (_, md, _) -> it.it_module_declaration it md + | Sig_modtype (_, mtd) -> it.it_modtype_declaration it mtd + | Sig_class (_, cd, _) -> it.it_class_declaration it cd + | Sig_class_type (_, ctd, _) -> it.it_class_type_declaration it ctd + and it_value_description it vd = + it.it_type_expr it vd.val_type + and it_type_declaration it td = + List.iter (it.it_type_expr it) td.type_params; + may (it.it_type_expr it) td.type_manifest; + it.it_type_kind it td.type_kind + and it_exception_declaration it ed = + List.iter (it.it_type_expr it) ed.exn_args + and it_module_declaration it md = + it.it_module_type it md.md_type + and it_modtype_declaration it mtd = + may (it.it_module_type it) mtd.mtd_type + and it_class_declaration it cd = + List.iter (it.it_type_expr it) cd.cty_params; + it.it_class_type it cd.cty_type; + may (it.it_type_expr it) cd.cty_new; + it.it_path cd.cty_path + and it_class_type_declaration it ctd = + List.iter (it.it_type_expr it) ctd.clty_params; + it.it_class_type it ctd.clty_type; + it.it_path ctd.clty_path + and it_module_type it = function + Mty_ident p + | Mty_alias p -> it.it_path p + | Mty_signature sg -> it.it_signature it sg + | Mty_functor (_, mto, mt) -> + may (it.it_module_type it) mto; + it.it_module_type it mt + and it_class_type it = function + Cty_constr (p, tyl, cty) -> + it.it_path p; + List.iter (it.it_type_expr it) tyl; + it.it_class_type it cty + | Cty_signature cs -> + it.it_type_expr it cs.csig_self; + Vars.iter (fun _ (_,_,ty) -> it.it_type_expr it ty) cs.csig_vars; + List.iter + (fun (p, tl) -> it.it_path p; List.iter (it.it_type_expr it) tl) + cs.csig_inher + | Cty_arrow (_, ty, cty) -> + it.it_type_expr it ty; + it.it_class_type it cty + and it_type_kind it = function + Type_abstract -> () + | Type_record (ll, _) -> + List.iter (fun ld -> it.it_type_expr it ld.ld_type) ll + | Type_variant cl -> + List.iter (fun cd -> + List.iter (it.it_type_expr it) cd.cd_args; + may (it.it_type_expr it) cd.cd_res) + cl + and it_type_expr it ty = + iter_type_expr (it.it_type_expr it) ty; + match ty.desc with + Tconstr (p, _, _) + | Tobject (_, {contents=Some (p, _)}) + | Tpackage (p, _, _) -> + it.it_path p + | Tvariant row -> + may (fun (p,_) -> it.it_path p) (row_repr row).row_name + | _ -> () + and it_path p = () + in + { it_path; it_type_expr; it_type_kind; it_class_type; it_module_type; + it_signature; it_class_type_declaration; it_class_declaration; + it_modtype_declaration; it_module_declaration; it_exception_declaration; + it_type_declaration; it_value_description; it_signature_item; } + let copy_row f fixed row keep more = let fields = List.map (fun (l, fi) -> l, diff --git a/typing/btype.mli b/typing/btype.mli index 88019ff297..8717600932 100644 --- a/typing/btype.mli +++ b/typing/btype.mli @@ -39,9 +39,12 @@ val newmarkedgenvar: unit -> type_expr (* 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. *) @@ -87,6 +90,24 @@ val iter_row: (type_expr -> unit) -> row_desc -> unit val iter_abbrev: (type_expr -> unit) -> abbrev_memo -> unit (* Iteration on types in an abbreviation list *) +type type_iterators = + { it_signature: type_iterators -> signature -> unit; + it_signature_item: type_iterators -> signature_item -> unit; + it_value_description: type_iterators -> value_description -> unit; + it_type_declaration: type_iterators -> type_declaration -> unit; + it_exception_declaration: type_iterators -> exception_declaration -> unit; + it_module_declaration: type_iterators -> module_declaration -> unit; + it_modtype_declaration: type_iterators -> modtype_declaration -> unit; + it_class_declaration: type_iterators -> class_declaration -> unit; + it_class_type_declaration: type_iterators -> class_type_declaration -> unit; + it_module_type: type_iterators -> module_type -> unit; + it_class_type: type_iterators -> class_type -> unit; + it_type_kind: type_iterators -> type_kind -> unit; + it_type_expr: type_iterators -> type_expr -> unit; + it_path: Path.t -> unit; } +val type_iterators : type_iterators + (* Iteration on arbitrary type information *) + val copy_type_desc: ?keep_names:bool -> (type_expr -> type_expr) -> type_desc -> type_desc (* Copy on types *) diff --git a/typing/cmt_format.ml b/typing/cmt_format.ml index 9d117cd3f7..c2e3791f07 100644 --- a/typing/cmt_format.ml +++ b/typing/cmt_format.ml @@ -47,6 +47,8 @@ and binary_part = type cmt_infos = { cmt_modname : string; cmt_annots : binary_annots; + cmt_value_dependencies : + (Types.value_description * Types.value_description) list; cmt_comments : (string * Location.t) list; cmt_args : string array; cmt_sourcefile : string option; @@ -185,11 +187,20 @@ let read_cmi filename = | Some cmi, _ -> cmi let saved_types = ref [] +let value_deps = ref [] + +let clear () = + saved_types := []; + value_deps := [] let add_saved_type b = saved_types := b :: !saved_types let get_saved_types () = !saved_types let set_saved_types l = saved_types := l +let record_value_dependency vd1 vd2 = + if vd1.Types.val_loc <> vd2.Types.val_loc then + value_deps := (vd1, vd2) :: !value_deps + let save_cmt filename modname binary_annots sourcefile initial_env sg = if !Clflags.binary_annotations && not !Clflags.print_types then begin let imports = Env.imported_units () in @@ -211,6 +222,7 @@ let save_cmt filename modname binary_annots sourcefile initial_env sg = let cmt = { cmt_modname = modname; cmt_annots = clear_env binary_annots; + cmt_value_dependencies = !value_deps; cmt_comments = Lexer.comments (); cmt_args = Sys.argv; cmt_sourcefile = sourcefile; @@ -225,6 +237,6 @@ let save_cmt filename modname binary_annots sourcefile initial_env sg = } in output_cmt oc cmt; close_out oc; - set_saved_types []; end; - set_saved_types [] + clear () + diff --git a/typing/cmt_format.mli b/typing/cmt_format.mli index 578d1743f3..30493063dc 100644 --- a/typing/cmt_format.mli +++ b/typing/cmt_format.mli @@ -48,6 +48,8 @@ and binary_part = type cmt_infos = { cmt_modname : string; cmt_annots : binary_annots; + cmt_value_dependencies : + (Types.value_description * Types.value_description) list; cmt_comments : (string * Location.t) list; cmt_args : string array; cmt_sourcefile : string option; @@ -94,10 +96,14 @@ val save_cmt : val read_magic_number : in_channel -> string +val clear: unit -> unit + val add_saved_type : binary_part -> unit val get_saved_types : unit -> binary_part list val set_saved_types : binary_part list -> unit +val record_value_dependency: Types.value_description -> Types.value_description -> unit + (* diff --git a/typing/ctype.ml b/typing/ctype.ml index cc56c8b3f7..d75dea43e0 100644 --- a/typing/ctype.ml +++ b/typing/ctype.ml @@ -717,6 +717,15 @@ let get_level env p = (* no newtypes in predef *) Path.binding_time p +let rec normalize_package_path env p = + let t = + try (Env.find_modtype p env).mtd_type + with Not_found -> None + in + match t with + | Some (Mty_ident p) -> normalize_package_path env p + | Some (Mty_signature _ | Mty_functor _ | Mty_alias _) | None -> p + let rec update_level env level ty = let ty = repr ty in if ty.level > level then begin @@ -737,8 +746,11 @@ let rec update_level env level ty = if level < get_level env p then raise (Unify [(ty, newvar2 level)]); iter_type_expr (update_level env level) ty end - | Tpackage (p, _, _) when level < get_level env p -> - raise (Unify [(ty, newvar2 level)]) + | Tpackage (p, nl, tl) when level < get_level env p -> + let p' = normalize_package_path env p in + if Path.same p p' then raise (Unify [(ty, newvar2 level)]); + log_type ty; ty.desc <- Tpackage (p', nl, tl); + update_level env level ty | Tobject(_, ({contents=Some(p, tl)} as nm)) when level < get_level env p -> set_name nm None; @@ -1049,6 +1061,8 @@ let rec copy ?env ?partial ?keep_names ty = end; t +let simple_copy t = copy t + (**** Variants of instantiations ****) let gadt_env env = @@ -1074,7 +1088,7 @@ let instance_def sch = let instance_list env schl = let env = gadt_env env in - let tyl = List.map (copy ?env) schl in + let tyl = List.map (fun t -> copy ?env t) schl in cleanup_types (); tyl @@ -1125,35 +1139,35 @@ let instance_constructor ?in_pattern cstr = List.iter process cstr.cstr_existentials end; let ty_res = copy cstr.cstr_res in - let ty_args = List.map copy cstr.cstr_args in + let ty_args = List.map simple_copy cstr.cstr_args in cleanup_types (); (ty_args, ty_res) let instance_parameterized_type ?keep_names sch_args sch = - let ty_args = List.map (copy ?keep_names) sch_args in + let ty_args = List.map (fun t -> copy ?keep_names t) sch_args in let ty = copy sch in cleanup_types (); (ty_args, ty) let instance_parameterized_type_2 sch_args sch_lst sch = - let ty_args = List.map copy sch_args in - let ty_lst = List.map copy sch_lst in + let ty_args = List.map simple_copy sch_args in + let ty_lst = List.map simple_copy sch_lst in let ty = copy sch in cleanup_types (); (ty_args, ty_lst, ty) let instance_declaration decl = let decl = - {decl with type_params = List.map copy decl.type_params; - type_manifest = may_map copy decl.type_manifest; + {decl with type_params = List.map simple_copy decl.type_params; + type_manifest = may_map simple_copy decl.type_manifest; type_kind = match decl.type_kind with | Type_abstract -> Type_abstract | Type_variant cl -> Type_variant ( List.map (fun c -> - {c with cd_args=List.map copy c.cd_args; - cd_res=may_map copy c.cd_res}) + {c with cd_args=List.map simple_copy c.cd_args; + cd_res=may_map simple_copy c.cd_res}) cl) | Type_record (fl, rr) -> Type_record ( @@ -1170,7 +1184,7 @@ let instance_class params cty = let rec copy_class_type = function Cty_constr (path, tyl, cty) -> - Cty_constr (path, List.map copy tyl, copy_class_type cty) + Cty_constr (path, List.map simple_copy tyl, copy_class_type cty) | Cty_signature sign -> Cty_signature {csig_self = copy sign.csig_self; @@ -1178,11 +1192,12 @@ let instance_class params cty = Vars.map (function (m, v, ty) -> (m, v, copy ty)) sign.csig_vars; csig_concr = sign.csig_concr; csig_inher = - List.map (fun (p,tl) -> (p, List.map copy tl)) sign.csig_inher} + List.map (fun (p,tl) -> (p, List.map simple_copy tl)) + sign.csig_inher} | Cty_arrow (l, ty, cty) -> Cty_arrow (l, copy ty, copy_class_type cty) in - let params' = List.map copy params in + let params' = List.map simple_copy params in let cty' = copy_class_type cty in cleanup_types (); (params', cty') @@ -1379,7 +1394,7 @@ let expand_abbrev_gen kind find_type_expansion env ty = ty | None -> let (params, body, lv) = - try find_type_expansion level path env with Not_found -> + try find_type_expansion path env with Not_found -> raise Cannot_expand in (* prerr_endline @@ -1405,10 +1420,9 @@ let expand_abbrev_gen kind find_type_expansion env ty = | _ -> assert false -(* inside objects and variants we do not want to - use local constraints *) +(* Expand respecting privacy *) let expand_abbrev ty = - expand_abbrev_gen Public (fun level -> Env.find_type_expansion ~level) ty + expand_abbrev_gen Public Env.find_type_expansion ty (* Expand once the head of a type *) let expand_head_once env ty = @@ -1486,7 +1500,7 @@ let rec extract_concrete_typedecl env ty = the private abbreviation. *) let expand_abbrev_opt = - expand_abbrev_gen Private (fun level -> Env.find_type_expansion_opt) + expand_abbrev_gen Private Env.find_type_expansion_opt let try_expand_once_opt env ty = let ty = repr ty in @@ -1991,8 +2005,11 @@ let rec mcomp type_pairs env t1 t2 = | (Tconstr (p, _, _), _) | (_, Tconstr (p, _, _)) -> let decl = Env.find_type p env in if non_aliasable p decl then raise (Unify []) + (* | (Tpackage (p1, n1, tl1), Tpackage (p2, n2, tl2)) when n1 = n2 -> mcomp_list type_pairs env tl1 tl2 + *) + | (Tpackage _, Tpackage _) -> () | (Tvariant row1, Tvariant row2) -> mcomp_row type_pairs env row1 row2 | (Tobject (fi1, _), Tobject (fi2, _)) -> @@ -2169,6 +2186,68 @@ let order_type_pair t1 t2 = let add_type_equality t1 t2 = TypePairs.add unify_eq_set (order_type_pair t1 t2) () +let eq_package_path env p1 p2 = + Path.same p1 p2 || + Path.same (normalize_package_path env p1) (normalize_package_path env p2) + +let nondep_type' = ref (fun _ _ _ -> assert false) +let package_subtype = ref (fun _ _ _ _ _ _ _ -> assert false) + +let rec concat_longident lid1 = + let open Longident in + function + Lident s -> Ldot (lid1, s) + | Ldot (lid2, s) -> Ldot (concat_longident lid1 lid2, s) + | Lapply (lid2, lid) -> Lapply (concat_longident lid1 lid2, lid) + +let nondep_instance env level id ty = + let ty = !nondep_type' env id ty in + if level = generic_level then duplicate_type ty else + let old = !current_level in + current_level := level; + let ty = instance env ty in + current_level := old; + ty + +(* Find the type paths nl1 in the module type mty2, and add them to the + list (nl2, tl2). raise Not_found if impossible *) +let complete_type_list ?(allow_absent=false) env nl1 lv2 mty2 nl2 tl2 = + let id2 = Ident.create "Pkg" in + let env' = Env.add_module id2 mty2 env in + let rec complete nl1 ntl2 = + match nl1, ntl2 with + [], _ -> ntl2 + | n :: nl, (n2, _ as nt2) :: ntl' when n >= n2 -> + nt2 :: complete (if n = n2 then nl else nl1) ntl' + | n :: nl, _ -> + try + let (_, decl) = + Env.lookup_type (concat_longident (Longident.Lident "Pkg") n) env' + in + match decl with + {type_arity = 0; type_kind = Type_abstract; + type_private = Public; type_manifest = Some t2} -> + (n, nondep_instance env' lv2 id2 t2) :: complete nl ntl2 + | {type_arity = 0; type_kind = Type_abstract; + type_private = Public; type_manifest = None} when allow_absent -> + complete nl ntl2 + | _ -> raise Exit + with + | Not_found when allow_absent -> complete nl ntl2 + | Exit -> raise Not_found + in + complete nl1 (List.combine nl2 tl2) + +(* raise Not_found rather than Unify if the module types are incompatible *) +let unify_package env unify_list lv1 p1 n1 tl1 lv2 p2 n2 tl2 = + let ntl2 = complete_type_list env n1 lv2 (Mty_ident p2) n2 tl2 + and ntl1 = complete_type_list env n2 lv2 (Mty_ident p1) n1 tl1 in + unify_list (List.map snd ntl1) (List.map snd ntl2); + if eq_package_path env p1 p2 + || !package_subtype env p1 n1 tl1 p2 n2 tl2 + && !package_subtype env p2 n2 tl2 p1 n1 tl1 then () else raise Not_found + + let unify_eq env t1 t2 = t1 == t2 || match !umode with @@ -2397,11 +2476,14 @@ and unify3 env t1 t1' t2 t2' = unify env t1 t2 | (Tpoly (t1, tl1), Tpoly (t2, tl2)) -> enter_poly !env univar_pairs t1 tl1 t2 tl2 (unify env) - | (Tpackage (p1, n1, tl1), Tpackage (p2, n2, tl2)) when n1 = n2 -> - if Path.same p1 p2 then unify_list env tl1 tl2 else - if !umode = Expression then raise (Unify []) else begin + | (Tpackage (p1, n1, tl1), Tpackage (p2, n2, tl2)) -> + begin try + unify_package !env (unify_list env) + t1.level p1 n1 tl1 t2.level p2 n2 tl2 + with Not_found -> + if !umode = Expression then raise (Unify []); List.iter (reify env) (tl1 @ tl2); - if !generate_equations then List.iter2 (mcomp !env) tl1 tl2 + (* if !generate_equations then List.iter2 (mcomp !env) tl1 tl2 *) end | (_, _) -> raise (Unify []) @@ -2828,9 +2910,12 @@ let rec moregen inst_nongen type_pairs env t1 t2 = | (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _)) when Path.same p1 p2 -> moregen_list inst_nongen type_pairs env tl1 tl2 - | (Tpackage (p1, n1, tl1), Tpackage (p2, n2, tl2)) - when Path.same p1 p2 && n1 = n2 -> - moregen_list inst_nongen type_pairs env tl1 tl2 + | (Tpackage (p1, n1, tl1), Tpackage (p2, n2, tl2)) -> + begin try + unify_package env (moregen_list inst_nongen type_pairs env) + t1'.level p1 n1 tl1 t2'.level p2 n2 tl2 + with Not_found -> raise (Unify []) + end | (Tvariant row1, Tvariant row2) -> moregen_row inst_nongen type_pairs env row1 row2 | (Tobject (fi1, nm1), Tobject (fi2, nm2)) -> @@ -3096,9 +3181,12 @@ let rec eqtype rename type_pairs subst env t1 t2 = | (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _)) when Path.same p1 p2 -> eqtype_list rename type_pairs subst env tl1 tl2 - | (Tpackage (p1, n1, tl1), Tpackage (p2, n2, tl2)) - when Path.same p1 p2 && n1 = n2 -> - eqtype_list rename type_pairs subst env tl1 tl2 + | (Tpackage (p1, n1, tl1), Tpackage (p2, n2, tl2)) -> + begin try + unify_package env (eqtype_list rename type_pairs subst env) + t1'.level p1 n1 tl1 t2'.level p2 n2 tl2 + with Not_found -> raise (Unify []) + end | (Tvariant row1, Tvariant row2) -> eqtype_row rename type_pairs subst env row1 row2 | (Tobject (fi1, nm1), Tobject (fi2, nm2)) -> @@ -3838,11 +3926,36 @@ let rec subtype_rec env trace t1 t2 cstrs = with Unify _ -> (trace, t1, t2, !univar_pairs)::cstrs end - | (Tpackage (p1, nl1, tl1), Tpackage (p2, nl2, tl2)) - when Path.same p1 p2 && included nl2 nl1 -> +(* | (Tpackage (p1, nl1, tl1), Tpackage (p2, nl2, tl2)) + when eq_package_path env p1 p2 && included nl2 nl1 -> List.map2 (fun t1 t2 -> (trace, t1, t2, !univar_pairs)) (extract_assoc nl2 nl1 tl1) tl2 - @ cstrs + @ cstrs *) + | (Tpackage (p1, nl1, tl1), Tpackage (p2, nl2, tl2)) -> + begin try + let ntl1 = complete_type_list env nl2 t1.level (Mty_ident p1) nl1 tl1 + and ntl2 = complete_type_list env nl1 t2.level (Mty_ident p2) nl2 tl2 + ~allow_absent:true in + let cstrs' = + List.map + (fun (n2,t2) -> (trace, List.assoc n2 ntl1, t2, !univar_pairs)) + ntl2 + in + if eq_package_path env p1 p2 then cstrs' @ cstrs + else begin + (* need to check module subtyping *) + let snap = Btype.snapshot () in + try + List.iter (fun (_, t1, t2, _) -> unify env t1 t2) cstrs'; + if !package_subtype env p1 nl1 tl1 p2 nl2 tl2 + then (Btype.backtrack snap; cstrs' @ cstrs) + else raise (Unify []) + with Unify _ -> + Btype.backtrack snap; raise Not_found + end + with Not_found -> + (trace, t1, t2, !univar_pairs)::cstrs + end | (_, _) -> (trace, t1, t2, !univar_pairs)::cstrs end @@ -4097,8 +4210,10 @@ let rec nondep_type_rec env id ty = end else Tconstr(p, List.map (nondep_type_rec env id) tl, ref Mnil) - | Tpackage(p, _, _) when Path.isfree id p -> - raise Not_found + | Tpackage(p, nl, tl) when Path.isfree id p -> + let p' = normalize_package_path env p in + if Path.isfree id p' then raise Not_found; + Tpackage (p', nl, List.map (nondep_type_rec env id) tl) | Tobject (t1, name) -> Tobject (nondep_type_rec env id t1, ref (match !name with @@ -4141,6 +4256,8 @@ let nondep_type env id ty = clear_hash (); raise Not_found +let () = nondep_type' := nondep_type + let unroll_abbrev id tl ty = let ty = repr ty and path = Path.Pident id in if is_Tvar ty || (List.exists (deep_occur ty) tl) diff --git a/typing/ctype.mli b/typing/ctype.mli index 37c4bb97fd..2af24c3681 100644 --- a/typing/ctype.mli +++ b/typing/ctype.mli @@ -264,3 +264,8 @@ val collapse_conj_params: Env.t -> type_expr list -> unit val get_current_level: unit -> int val wrap_trace_gadt_instances: Env.t -> ('a -> 'b) -> 'a -> 'b + +(* Stubs *) +val package_subtype : + (Env.t -> Path.t -> Longident.t list -> type_expr list -> + Path.t -> Longident.t list -> type_expr list -> bool) ref diff --git a/typing/env.ml b/typing/env.ml index beee7a17d2..938d438ec8 100644 --- a/typing/env.ml +++ b/typing/env.ml @@ -57,6 +57,7 @@ type error = | Illegal_renaming of string * string * string | Inconsistent_import of string * string * string | Need_recursive_types of string * string + | Missing_module of Location.t * Path.t * Path.t exception Error of error @@ -111,6 +112,7 @@ type summary = | Env_class of summary * Ident.t * class_declaration | Env_cltype of summary * Ident.t * class_type_declaration | Env_open of summary * Path.t + | Env_functor_arg of summary * Ident.t module EnvTbl = struct @@ -172,6 +174,7 @@ type t = { components: (Path.t * module_components) EnvTbl.t; classes: (Path.t * class_declaration) EnvTbl.t; cltypes: (Path.t * class_type_declaration) EnvTbl.t; + functor_args: unit Ident.tbl; summary: summary; local_constraints: bool; gadt_instances: (int * TypeSet.t ref) list; @@ -201,11 +204,12 @@ and structure_components = { 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 *) - fcomp_cache: (Path.t, module_components) Hashtbl.t (* For memoization *) + fcomp_cache: (Path.t, module_components) Hashtbl.t; (* For memoization *) + fcomp_subst_cache: (Path.t, module_type) Hashtbl.t } let subst_modtype_maker (subst, mty) = Subst.modtype subst mty @@ -218,6 +222,7 @@ let empty = { cltypes = EnvTbl.empty; summary = Env_empty; local_constraints = false; gadt_instances = []; in_signature = false; + functor_args = Ident.empty; } let in_signature env = {env with in_signature = true} @@ -262,9 +267,13 @@ let check_modtype_inclusion = (* to be filled with Includemod.check_modtype_inclusion *) ref ((fun env mty1 path1 mty2 -> assert false) : t -> module_type -> Path.t -> module_type -> unit) +let strengthen = + (* to be filled with Mtype.strengthen *) + ref ((fun env mty path -> assert false) : + t -> module_type -> Path.t -> module_type) let md md_type = - {md_type; md_attributes=[]} + {md_type; md_attributes=[]; md_loc=Location.none} (* The name of the compilation unit currently compiled. "" if outside a compilation unit. *) @@ -279,7 +288,8 @@ type pers_struct = ps_comps: module_components; ps_crcs: (string * Digest.t) list; ps_filename: string; - ps_flags: pers_flags list } + ps_flags: pers_flags list; + mutable ps_crcs_checked: bool } let persistent_structures = (Hashtbl.create 17 : (string, pers_struct option) Hashtbl.t) @@ -288,17 +298,19 @@ let persistent_structures = let crc_units = Consistbl.create() -let check_consistency filename crcs = +let check_consistency ps = + if ps.ps_crcs_checked then () else try List.iter - (fun (name, crc) -> Consistbl.check crc_units name crc filename) - crcs + (fun (name, crc) -> Consistbl.check crc_units name crc ps.ps_filename) + ps.ps_crcs; + ps.ps_crcs_checked <- true with Consistbl.Inconsistency(name, source, auth) -> error (Inconsistent_import(name, auth, source)) (* Reading persistent structures from .cmi files *) -let read_pers_struct modname filename = ( +let read_pers_struct modname filename = let cmi = read_cmi filename in let name = cmi.cmi_name in let sign = cmi.cmi_sign in @@ -307,35 +319,37 @@ let read_pers_struct modname filename = ( let comps = !components_of_module' empty Subst.identity (Pident(Ident.create_persistent name)) - (Mty_signature sign) in - let ps = { ps_name = name; - ps_sig = sign; - ps_comps = comps; - ps_crcs = crcs; - ps_filename = filename; - ps_flags = flags } in - if ps.ps_name <> modname then - error (Illegal_renaming(modname, ps.ps_name, filename)); - check_consistency filename ps.ps_crcs; - List.iter - (function Rectypes -> - if not !Clflags.recursive_types then - error (Need_recursive_types(ps.ps_name, !current_unit))) - ps.ps_flags; - Hashtbl.add persistent_structures modname (Some ps); - ps -) - -let find_pers_struct name = + (Mty_signature sign) + in + let ps = { ps_name = name; + ps_sig = sign; + ps_comps = comps; + ps_crcs = crcs; + ps_crcs_checked = false; + ps_filename = filename; + ps_flags = flags } in + if ps.ps_name <> modname then + error (Illegal_renaming(modname, ps.ps_name, filename)); + if not !Clflags.transparent_modules then check_consistency ps; + List.iter + (function Rectypes -> + if not !Clflags.recursive_types then + error (Need_recursive_types(ps.ps_name, !current_unit))) + ps.ps_flags; + Hashtbl.add persistent_structures modname (Some ps); + ps + +let find_pers_struct ?(check=true) name = if name = "*predef*" then raise Not_found; let r = try Some (Hashtbl.find persistent_structures name) with Not_found -> None in - match r with - | Some None -> raise Not_found - | Some (Some sg) -> sg - | None -> + let ps = + match r with + | Some None -> raise Not_found + | Some (Some sg) -> sg + | None -> let filename = try find_in_path_uncap !load_path (name ^ ".cmi") with Not_found -> @@ -343,6 +357,9 @@ let find_pers_struct name = raise Not_found in read_pers_struct name filename + in + if check then check_consistency ps; + ps let reset_cache () = current_unit := ""; @@ -436,10 +453,94 @@ let find_type p env = let find_type_descrs p env = snd (find_type_full p env) +let find_module ~alias path env = + match path with + Pident id -> + begin try + let (p, data) = EnvTbl.find_same id env.modules + in data + with Not_found -> + if Ident.persistent id then + let ps = find_pers_struct (Ident.name id) in + md (Mty_signature(ps.ps_sig)) + else raise Not_found + end + | Pdot(p, s, pos) -> + begin match + EnvLazy.force !components_of_module_maker' (find_module_descr p env) + with + Structure_comps c -> + let (data, pos) = Tbl.find s c.comp_modules in + md (EnvLazy.force subst_modtype_maker data) + | Functor_comps f -> + raise Not_found + end + | Papply(p1, p2) -> + let desc1 = find_module_descr p1 env in + begin match EnvLazy.force !components_of_module_maker' desc1 with + Functor_comps f -> + md begin match f.fcomp_res with + | Mty_alias p -> + Mty_alias (Subst.module_path f.fcomp_subst p) + | mty -> + if alias then mty else + try + Hashtbl.find f.fcomp_subst_cache p2 + with Not_found -> + let mty = + Subst.modtype + (Subst.add_module f.fcomp_param p2 f.fcomp_subst) + f.fcomp_res in + Hashtbl.add f.fcomp_subst_cache p2 mty; + mty + end + | Structure_comps c -> + raise Not_found + end + +let required_globals = ref [] +let reset_required_globals () = required_globals := [] +let get_required_globals () = !required_globals +let add_required_global id = + if Ident.global id && not !Clflags.transparent_modules + && not (List.exists (Ident.same id) !required_globals) + then required_globals := id :: !required_globals + +let rec normalize_path lax env path = + let path = + match path with + Pdot(p, s, pos) -> + Pdot(normalize_path lax env p, s, pos) + | Papply(p1, p2) -> + Papply(normalize_path lax env p1, normalize_path true env p2) + | _ -> path + in + try match find_module ~alias:true path env with + {md_type=Mty_alias path1} -> + let path' = normalize_path lax env path1 in + if lax || !Clflags.transparent_modules then path' else + let id = Path.head path in + if Ident.global id && not (Ident.same id (Path.head path')) + then add_required_global id; + path' + | _ -> path + with Not_found when lax + || (match path with Pident id -> not (Ident.persistent id) | _ -> true) -> + path + +let normalize_path oloc env path = + try normalize_path (oloc = None) env path + with Not_found -> + match oloc with None -> assert false + | Some loc -> + raise (Error(Missing_module(loc, path, normalize_path true env path))) + +let find_module = find_module ~alias:false + (* Find the manifest type associated to a type when appropriate: - the type should be public or should have a private row, - the type should have an associated manifest type. *) -let find_type_expansion ?level path env = +let find_type_expansion path env = let decl = find_type path env in match decl.type_manifest with | Some body when decl.type_private = Public @@ -450,7 +551,13 @@ let find_type_expansion ?level path env = private row are still considered unknown to the type system. Hence, this case is caught by the following clause that also handles purely abstract data types without manifest type definition. *) - | _ -> raise Not_found + | _ -> + (* another way to expand is to normalize the path itself *) + let path' = normalize_path None env path in + if Path.same path path' then raise Not_found else + (decl.type_params, + newgenty (Tconstr (path', decl.type_params, ref Mnil)), + may_map snd decl.type_newtype_level) (* Find the manifest type information associated to a type, i.e. the necessary information for the compiler's type-based optimisations. @@ -462,37 +569,26 @@ let find_type_expansion_opt path env = (* The manifest type of Private abstract data types can still get an approximation using their manifest type. *) | Some body -> (decl.type_params, body, may_map snd decl.type_newtype_level) - | _ -> raise Not_found + | _ -> + let path' = normalize_path None env path in + if Path.same path path' then raise Not_found else + (decl.type_params, + newgenty (Tconstr (path', decl.type_params, ref Mnil)), + may_map snd decl.type_newtype_level) let find_modtype_expansion path env = match (find_modtype path env).mtd_type with | None -> raise Not_found | Some mty -> mty -let find_module path env = +let rec is_functor_arg path env = match path with Pident id -> - begin try - let (p, data) = EnvTbl.find_same id env.modules - in data - with Not_found -> - if Ident.persistent id then - let ps = find_pers_struct (Ident.name id) in - md (Mty_signature(ps.ps_sig)) - else raise Not_found - end - | Pdot(p, s, pos) -> - begin match - EnvLazy.force !components_of_module_maker' (find_module_descr p env) - with - Structure_comps c -> - let (data, pos) = Tbl.find s c.comp_modules in - md (EnvLazy.force subst_modtype_maker data) - | Functor_comps f -> - raise Not_found + begin try Ident.find_same id env.functor_args; true + with Not_found -> false end - | Papply(p1, p2) -> - raise Not_found (* not right *) + | Pdot (p, s, _) -> is_functor_arg p env + | Papply _ -> true (* Lookup by name *) @@ -519,54 +615,51 @@ let rec lookup_module_descr lid env = end | Lapply(l1, l2) -> let (p1, desc1) = lookup_module_descr l1 env in - let (p2, {md_type=mty2}) = lookup_module l2 env in + let p2 = lookup_module l2 env in + let {md_type=mty2} = find_module p2 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 end -and lookup_module lid env : Path.t * module_declaration = +and lookup_module lid env : Path.t = match lid with Lident s -> begin try - let (_, {md_type}) as r = EnvTbl.find_name s env.modules in + let (p, {md_type}) as r = EnvTbl.find_name s env.modules in begin match md_type with | Mty_ident (Path.Pident id) when Ident.name id = "#recmod#" -> (* see #5965 *) raise Recmodule | _ -> () end; - r + p with Not_found -> if s = !current_unit then raise Not_found; - let ps = find_pers_struct s in - (Pident(Ident.create_persistent s), - md (Mty_signature ps.ps_sig) - ) + ignore (find_pers_struct ~check:false s); + Pident(Ident.create_persistent s) end | Ldot(l, s) -> let (p, descr) = lookup_module_descr l env in begin match EnvLazy.force !components_of_module_maker' descr with Structure_comps c -> let (data, pos) = Tbl.find s c.comp_modules in - (Pdot(p, s, pos), md (EnvLazy.force subst_modtype_maker data)) + Pdot(p, s, pos) | Functor_comps f -> raise Not_found end | Lapply(l1, l2) -> let (p1, desc1) = lookup_module_descr l1 env in - let (p2, {md_type=mty2}) = lookup_module l2 env in + let p2 = lookup_module l2 env in + let {md_type=mty2} = find_module p2 env in 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; - let mty = - Subst.modtype (Subst.add_module f.fcomp_param p2 f.fcomp_subst) - f.fcomp_res in - (p, md mty) + Misc.may (!check_modtype_inclusion env mty2 p2) f.fcomp_arg; + p | Structure_comps c -> raise Not_found end @@ -915,16 +1008,29 @@ let add_gadt_instance_chain env lv t = (* Expand manifest module type names at the top of the given module type *) -let rec scrape_modtype mty env = - match mty with - Mty_ident path -> +let rec scrape_alias env ?path mty = + match mty, path with + Mty_ident p, _ -> begin try - scrape_modtype (find_modtype_expansion path env) env + scrape_alias env (find_modtype_expansion p env) ?path with Not_found -> mty end + | Mty_alias path, _ -> + begin try + scrape_alias env (find_module path env).md_type ~path + with Not_found -> + Location.prerr_warning Location.none + (Warnings.Deprecated + ("module " ^ Path.name path ^ " cannot be accessed")); + mty + end + | mty, Some path -> + !strengthen env mty path | _ -> mty +let scrape_alias env mty = scrape_alias env mty + (* Compute constructor descriptions *) let constructors_of_type ty_path decl = @@ -1042,7 +1148,7 @@ let rec components_of_module env sub path mty = EnvLazy.create (env, sub, path, mty) and components_of_module_maker (env, sub, path, mty) = - (match scrape_modtype mty env with + (match scrape_alias env mty with Mty_signature sg -> let c = { comp_values = Tbl.empty; @@ -1120,13 +1226,15 @@ and components_of_module_maker (env, sub, path, mty) = 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; fcomp_subst = sub; - fcomp_cache = Hashtbl.create 17 } - | Mty_ident p -> + fcomp_cache = Hashtbl.create 17; + fcomp_subst_cache = Hashtbl.create 17 } + | Mty_ident _ + | Mty_alias _ -> Structure_comps { comp_values = Tbl.empty; comp_constrs = Tbl.empty; @@ -1290,6 +1398,12 @@ let _ = (* Insertion of bindings by identifier *) +let add_functor_arg ?(arg=false) id env = + if not arg then env else + {env with + functor_args = Ident.add id () env.functor_args; + summary = Env_functor_arg (env.summary, id)} + let add_value ?check id desc env = store_value None ?check id (Pident id) desc env env @@ -1299,8 +1413,14 @@ let add_type ~check id info env = and add_exception ~check id decl env = store_exception ~check None id (Pident id) decl env env -and add_module_declaration id md env = - store_module None id (Pident id) md env env +and add_module_declaration ?arg id md env = + let path = + (*match md.md_type with + Mty_alias path -> normalize_path env path + | _ ->*) Pident id + in + let env = store_module None id path md env env in + add_functor_arg ?arg id env and add_modtype id info env = store_modtype None id (Pident id) info env env @@ -1311,8 +1431,8 @@ and add_class id ty env = and add_cltype id ty env = store_cltype None id (Pident id) ty env env -let add_module id mty env = - add_module_declaration id (md mty) env +let add_module ?arg id mty env = + add_module_declaration ?arg id (md mty) env let add_local_constraint id info elv env = match info with @@ -1332,13 +1452,17 @@ let enter store_fun name data env = let enter_value ?check = enter (store_value ?check) and enter_type = enter (store_type ~check:true) and enter_exception = enter (store_exception ~check:true) -and enter_module_declaration = enter store_module +and enter_module_declaration ?arg name md env = + let id = Ident.create name in + (id, add_module_declaration ?arg id md env) + (* let (id, env) = enter store_module name md env in + (id, add_functor_arg ?arg id env) *) and enter_modtype = enter store_modtype and enter_class = enter store_class and enter_cltype = enter store_cltype -let enter_module s mty env = - enter_module_declaration s (md mty) env +let enter_module ?arg s mty env = + enter_module_declaration ?arg s (md mty) env (* Insertion of all components of a signature *) @@ -1427,12 +1551,14 @@ let open_signature ?(loc = Location.none) ?(toplevel = false) ovf root sg env = (* Read a signature from a file *) let read_signature modname filename = - let ps = read_pers_struct modname filename in ps.ps_sig + let ps = read_pers_struct modname filename in + check_consistency ps; + ps.ps_sig (* Return the CRC of the interface of the given compilation unit *) let crc_of_unit name = - let ps = find_pers_struct name in + let ps = find_pers_struct ~check:false name in try List.assoc name ps.ps_crcs with Not_found -> @@ -1446,6 +1572,8 @@ let imported_units() = (* Save a signature to a file *) let save_signature_with_imports sg modname filename imports = + (*prerr_endline filename; + List.iter (fun (name, crc) -> prerr_endline name) imports;*) Btype.cleanup_abbrev (); Subst.reset_for_saving (); let sg = Subst.signature (Subst.for_saving Subst.identity) sg in @@ -1470,7 +1598,8 @@ let save_signature_with_imports sg modname filename imports = ps_comps = comps; ps_crcs = (cmi.cmi_name, crc) :: imports; ps_filename = filename; - ps_flags = cmi.cmi_flags } in + ps_flags = cmi.cmi_flags; + ps_crcs_checked = true } in Hashtbl.add persistent_structures modname (Some ps); Consistbl.set crc_units modname crc filename; sg @@ -1625,10 +1754,22 @@ let report_error ppf = function fprintf ppf "@[<hov>Unit %s imports from %s, which uses recursive types.@ %s@]" export import "The compilation flag -rectypes is required" + | Missing_module(_, path1, path2) -> + fprintf ppf "@[@[<hov>"; + if Path.same path1 path2 then + fprintf ppf "Internal path@ %s@ is dangling." (Path.name path1) + else + fprintf ppf "Internal path@ %s@ expands to@ %s@ which is dangling." + (Path.name path1) (Path.name path2); + fprintf ppf "@]@ @[%s@ %s@ %s.@]@]" + "The compiled interface for module" (Ident.name (Path.head path2)) + "was not found" let () = Location.register_error_of_exn (function + | Error (Missing_module (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 5aea533857..888869ebfc 100644 --- a/typing/env.mli +++ b/typing/env.mli @@ -24,6 +24,7 @@ type summary = | Env_class of summary * Ident.t * class_declaration | Env_cltype of summary * Ident.t * class_type_declaration | Env_open of summary * Path.t + | Env_functor_arg of summary * Ident.t type t @@ -53,12 +54,21 @@ val find_class: Path.t -> t -> class_declaration val find_cltype: Path.t -> t -> class_type_declaration val find_type_expansion: - ?level:int -> Path.t -> t -> type_expr list * type_expr * int option + 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 -> module_type +val is_functor_arg: Path.t -> t -> bool +val normalize_path: Location.t option -> t -> Path.t -> Path.t +(* Normalize the path to a concrete value or module. + If the option is None, allow returning dangling paths. + Otherwise raise a Missing_module error, and may add forgotten + head as required global. *) +val reset_required_globals: unit -> unit +val get_required_globals: unit -> Ident.t list +val add_required_global: Ident.t -> unit val has_local_constraints: t -> bool val add_gadt_instance_level: int -> t -> t @@ -76,7 +86,7 @@ val lookup_label: Longident.t -> t -> label_description val lookup_all_labels: Longident.t -> t -> (label_description * (unit -> unit)) list val lookup_type: Longident.t -> t -> Path.t * type_declaration -val lookup_module: Longident.t -> t -> Path.t * module_declaration +val lookup_module: Longident.t -> t -> Path.t val lookup_modtype: Longident.t -> t -> Path.t * modtype_declaration val lookup_class: Longident.t -> t -> Path.t * class_declaration val lookup_cltype: Longident.t -> t -> Path.t * class_type_declaration @@ -92,8 +102,8 @@ val add_value: ?check:(string -> Warnings.t) -> Ident.t -> value_description -> t -> t val add_type: check:bool -> Ident.t -> type_declaration -> t -> t val add_exception: check:bool -> Ident.t -> exception_declaration -> t -> t -val add_module: Ident.t -> module_type -> t -> t -val add_module_declaration: Ident.t -> module_declaration -> t -> t +val add_module: ?arg:bool -> Ident.t -> module_type -> t -> t +val add_module_declaration: ?arg:bool -> Ident.t -> module_declaration -> t -> t val add_modtype: Ident.t -> modtype_declaration -> t -> t val add_class: Ident.t -> class_declaration -> t -> t val add_cltype: Ident.t -> class_type_declaration -> t -> t @@ -119,8 +129,9 @@ val enter_value: string -> value_description -> t -> Ident.t * t val enter_type: string -> type_declaration -> t -> Ident.t * t val enter_exception: string -> exception_declaration -> t -> Ident.t * t -val enter_module: string -> module_type -> t -> Ident.t * t -val enter_module_declaration: string -> module_declaration -> t -> Ident.t * t +val enter_module: ?arg:bool -> string -> module_type -> t -> Ident.t * t +val enter_module_declaration: + ?arg:bool -> string -> module_declaration -> t -> Ident.t * t val enter_modtype: string -> modtype_declaration -> t -> Ident.t * t val enter_class: string -> class_declaration -> t -> Ident.t * t val enter_cltype: string -> class_type_declaration -> t -> Ident.t * t @@ -175,6 +186,7 @@ type error = | Illegal_renaming of string * string * string | Inconsistent_import of string * string * string | Need_recursive_types of string * string + | Missing_module of Location.t * Path.t * Path.t exception Error of error @@ -206,6 +218,8 @@ val check_modtype_inclusion: (t -> module_type -> Path.t -> module_type -> unit) ref (* Forward declaration to break mutual recursion with Typecore. *) val add_delayed_check_forward: ((unit -> unit) -> unit) ref +(* Forward declaration to break mutual recursion with Mtype. *) +val strengthen: (t -> module_type -> Path.t -> module_type) ref (** Folding over all identifiers (for analysis purpose) *) @@ -236,3 +250,6 @@ val fold_classs: val fold_cltypes: (string -> Path.t -> class_type_declaration -> 'a -> 'a) -> Longident.t option -> t -> 'a -> 'a + +(** Utilities *) +val scrape_alias: t -> module_type -> module_type diff --git a/typing/envaux.ml b/typing/envaux.ml index 6e13502d64..04d6d256f7 100644 --- a/typing/envaux.ml +++ b/typing/envaux.ml @@ -75,6 +75,10 @@ let rec env_from_summary sum subst = in Env.open_signature Asttypes.Override path' (extract_sig env md.md_type) env + | Env_functor_arg(Env_module(s, id, desc), id') when Ident.same id id' -> + Env.add_module_declaration id (Subst.module_declaration subst desc) + ~arg:true (env_from_summary s subst) + | Env_functor_arg _ -> assert false in Hashtbl.add env_cache (sum, subst) env; env diff --git a/typing/includemod.ml b/typing/includemod.ml index 11caabe2f6..7316a26af2 100644 --- a/typing/includemod.ml +++ b/typing/includemod.ml @@ -18,7 +18,7 @@ open Typedtree open Types type symptom = - Missing_field of Ident.t + Missing_field of Ident.t * Location.t * string (* kind *) | Value_descriptions of Ident.t * value_description * value_description | Type_declarations of Ident.t * type_declaration * type_declaration * Includecore.type_mismatch list @@ -35,6 +35,7 @@ type symptom = Ident.t * class_declaration * class_declaration * Ctype.class_match_failure list | Unbound_modtype_path of Path.t + | Unbound_module_path of Path.t type pos = Module of Ident.t | Modtype of Ident.t | Arg of Ident.t | Body of Ident.t @@ -49,6 +50,7 @@ exception Error of error list (* Inclusion between value descriptions *) let value_descriptions env cxt subst id vd1 vd2 = + Cmt_format.record_value_dependency vd1 vd2; Env.mark_value_used (Ident.name id) vd1; let vd2 = Subst.value_description subst vd2 in try @@ -104,6 +106,18 @@ let expand_module_path env cxt path = with Not_found -> raise(Error[cxt, env, Unbound_modtype_path path]) +let expand_module_alias env cxt path = + try (Env.find_module path env).md_type + with Not_found -> + raise(Error[cxt, env, Unbound_module_path path]) + +(* +let rec normalize_module_path env cxt path = + match expand_module_alias env cxt path with + Mty_alias path' -> normalize_module_path env cxt path' + | _ -> path +*) + (* Extract name, kind and ident from a signature item *) type field_desc = @@ -115,14 +129,23 @@ type field_desc = | Field_class of string | Field_classtype of string +let kind_of_field_desc = function + | Field_value _ -> "value" + | Field_type _ -> "type" + | Field_exception _ -> "exception" + | Field_module _ -> "module" + | Field_modtype _ -> "module type" + | Field_class _ -> "class" + | Field_classtype _ -> "class type" + let item_ident_name = function - Sig_value(id, _) -> (id, Field_value(Ident.name id)) - | Sig_type(id, _, _) -> (id, Field_type(Ident.name id)) - | Sig_exception(id, _) -> (id, Field_exception(Ident.name id)) - | Sig_module(id, _, _) -> (id, Field_module(Ident.name id)) - | Sig_modtype(id, _) -> (id, Field_modtype(Ident.name id)) - | Sig_class(id, _, _) -> (id, Field_class(Ident.name id)) - | Sig_class_type(id, _, _) -> (id, Field_classtype(Ident.name id)) + Sig_value(id, d) -> (id, d.val_loc, Field_value(Ident.name id)) + | Sig_type(id, d, _) -> (id, d.type_loc, Field_type(Ident.name id)) + | Sig_exception(id, d) -> (id, d.exn_loc, Field_exception(Ident.name id)) + | Sig_module(id, d, _) -> (id, d.md_loc, Field_module(Ident.name id)) + | Sig_modtype(id, d) -> (id, d.mtd_loc, Field_modtype(Ident.name id)) + | Sig_class(id, d, _) -> (id, d.cty_loc, Field_class(Ident.name id)) + | Sig_class_type(id, d, _) -> (id, d.clty_loc, Field_classtype(Ident.name id)) let is_runtime_component = function | Sig_value(_,{val_kind = Val_prim _}) @@ -136,7 +159,7 @@ let is_runtime_component = function (* Simplify a structure coercion *) -let simplify_structure_coercion cc = +let simplify_structure_coercion cc id_pos_list = let rec is_identity_coercion pos = function | [] -> true @@ -144,7 +167,7 @@ let simplify_structure_coercion cc = n = pos && c = Tcoerce_none && is_identity_coercion (pos + 1) rem in if is_identity_coercion 0 cc then Tcoerce_none - else Tcoerce_structure cc + else Tcoerce_structure (cc, id_pos_list) (* Inclusion between module types. Return the restriction that transforms a value of the smaller type @@ -156,19 +179,43 @@ let rec modtypes env cxt subst mty1 mty2 = with Dont_match -> raise(Error[cxt, env, Module_types(mty1, Subst.modtype subst mty2)]) - | Error reasons -> - raise(Error((cxt, env, Module_types(mty1, Subst.modtype subst mty2)) - :: reasons)) + | Error reasons as err -> + match mty1, mty2 with + Mty_alias _, _ + | _, Mty_alias _ -> raise err + | _ -> + raise(Error((cxt, env, Module_types(mty1, Subst.modtype subst mty2)) + :: reasons)) and try_modtypes env cxt subst mty1 mty2 = match (mty1, mty2) with - (Mty_ident p1, _) when may_expand_module_path env p1 -> + (Mty_alias p1, Mty_alias p2) -> + if Path.same p1 p2 then Tcoerce_none else + let p1 = Env.normalize_path None env p1 + and p2 = Env.normalize_path None env (Subst.module_path subst p2) in + (* Should actually be Tcoerce_ignore, if it existed *) + if Path.same p1 p2 then Tcoerce_none else raise Dont_match + | (Mty_alias p1, _) -> + let p1 = try + Env.normalize_path (Some Location.none) env p1 + with Env.Error (Env.Missing_module (_, _, path)) -> + raise (Error[cxt, env, Unbound_module_path path]) + in + let mty1 = Mtype.strengthen env (expand_module_alias env cxt p1) p1 in + Tcoerce_alias (p1, modtypes env cxt subst mty1 mty2) + | (Mty_ident p1, _) when may_expand_module_path env p1 -> try_modtypes env cxt subst (expand_module_path env cxt p1) mty2 | (_, Mty_ident p2) -> 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 = @@ -197,12 +244,20 @@ and signatures env cxt subst sig1 sig2 = (* Environment used to check inclusion of components *) let new_env = Env.add_signature sig1 (Env.in_signature env) in + (* Keep ids for module aliases *) + let (id_pos_list,_) = + List.fold_left + (fun (l,pos) -> function + Sig_module (id, _, _) -> + ((id,pos,Tcoerce_none)::l , pos+1) + | item -> (l, if is_runtime_component item then pos+1 else pos)) + ([], 0) sig1 in (* Build a table of the components of sig1, along with their positions. The table is indexed by kind and name of component *) let rec build_component_table pos tbl = function [] -> pos, tbl | item :: rem -> - let (id, name) = item_ident_name item in + let (id, _loc, name) = item_ident_name item in let nextpos = if is_runtime_component item then pos + 1 else pos in build_component_table nextpos (Tbl.add name (id, item, pos) tbl) rem in @@ -227,13 +282,13 @@ and signatures env cxt subst sig1 sig2 = signature_components new_env cxt subst (List.rev paired) in if len1 = len2 then (* see PR#5098 *) - simplify_structure_coercion cc + simplify_structure_coercion cc id_pos_list else - Tcoerce_structure cc + Tcoerce_structure (cc, id_pos_list) | _ -> raise(Error unpaired) end | item2 :: rem -> - let (id2, name2) = item_ident_name item2 in + let (id2, loc, name2) = item_ident_name item2 in let name2, report = match item2, name2 with Sig_type (_, {type_manifest=None}, _), Field_type s @@ -261,7 +316,9 @@ and signatures env cxt subst sig1 sig2 = ((item1, item2, pos1) :: paired) unpaired rem with Not_found -> let unpaired = - if report then (cxt, env, Missing_field id2) :: unpaired + if report then + (cxt, env, Missing_field (id2, loc, kind_of_field_desc name2)) :: + unpaired else unpaired in pair_components subst paired unpaired rem end in @@ -370,8 +427,9 @@ let show_locs ppf (loc1, loc2) = show_loc "Actual declaration" ppf loc1 let include_err ppf = function - | Missing_field id -> - fprintf ppf "The field `%a' is required but not provided" ident id + | Missing_field (id, loc, kind) -> + fprintf ppf "The %s `%a' is required but not provided" kind ident id; + show_loc "Expected declaration" ppf loc | Value_descriptions(id, d1, d2) -> fprintf ppf "@[<hv 2>Values do not match:@ %a@;<1 -2>is not included in@ %a@]" @@ -426,6 +484,8 @@ let include_err ppf = function Includeclass.report_error reason | Unbound_modtype_path path -> fprintf ppf "Unbound module type %a" Printtyp.path path + | Unbound_module_path path -> + fprintf ppf "Unbound module %a" Printtyp.path path let rec context ppf = function Module id :: rem -> diff --git a/typing/includemod.mli b/typing/includemod.mli index 75afef574c..7786ee4ab9 100644 --- a/typing/includemod.mli +++ b/typing/includemod.mli @@ -23,7 +23,7 @@ val type_declarations: Env.t -> Ident.t -> type_declaration -> type_declaration -> unit type symptom = - Missing_field of Ident.t + Missing_field of Ident.t * Location.t * string (* kind *) | Value_descriptions of Ident.t * value_description * value_description | Type_declarations of Ident.t * type_declaration * type_declaration * Includecore.type_mismatch list @@ -40,6 +40,7 @@ type symptom = Ident.t * class_declaration * class_declaration * Ctype.class_match_failure list | Unbound_modtype_path of Path.t + | Unbound_module_path of Path.t type pos = Module of Ident.t | Modtype of Ident.t | Arg of Ident.t | Body of Ident.t @@ -48,3 +49,4 @@ type error = pos list * Env.t * symptom exception Error of error list val report_error: formatter -> error list -> unit +val expand_module_alias: Env.t -> pos list -> Path.t -> Types.module_type diff --git a/typing/mtype.ml b/typing/mtype.ml index 53850d962a..a5e0d811dd 100644 --- a/typing/mtype.ml +++ b/typing/mtype.ml @@ -34,7 +34,8 @@ let rec strengthen env mty p = 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 @@ -85,6 +86,7 @@ and strengthen_sig env sg p = and strengthen_decl env md p = {md with md_type = strengthen env md.md_type p} +let () = Env.strengthen := strengthen (* In nondep_supertype, env is only used for the type it assigns to id. Hence there is no need to keep env up-to-date by adding the bindings @@ -100,13 +102,19 @@ let nondep_supertype env mid mty = if Path.isfree mid p then nondep_mty env va (Env.find_modtype_expansion p env) else mty + | Mty_alias p -> + if Path.isfree mid p then + nondep_mty env va (Env.find_module p env).md_type + else mty | Mty_signature sg -> Mty_signature(nondep_sig env va sg) | Mty_functor(param, arg, res) -> let var_inv = match va with Co -> Contra | Contra -> Co | Strict -> Strict in - 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 ~arg:true param + (Btype.default_mty arg) env) va res) and nondep_sig env va = function [] -> [] @@ -135,7 +143,8 @@ let nondep_supertype env mid mty = Sig_modtype(id, nondep_modtype_decl env d) :: rem' with Not_found -> match va with - Co -> Sig_modtype(id, {mtd_type=None; mtd_attributes=[]}) :: rem' + Co -> Sig_modtype(id, {mtd_type=None; mtd_loc=Location.none; + mtd_attributes=[]}) :: rem' | _ -> raise Not_found end | Sig_class(id, d, rs) -> @@ -186,6 +195,7 @@ and enrich_item env p = function let rec type_paths env p mty = match scrape env mty with Mty_ident p -> [] + | Mty_alias p -> [] | Mty_signature sg -> type_paths_sig env p 0 sg | Mty_functor(param, arg, res) -> [] @@ -212,6 +222,7 @@ let rec no_code_needed env mty = Mty_ident p -> false | Mty_signature sg -> no_code_needed_sig env sg | Mty_functor(_, _, _) -> false + | Mty_alias p -> true and no_code_needed_sig env sg = match sg with @@ -228,3 +239,142 @@ and no_code_needed_sig env sg = 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 + | Mty_alias _ -> + () + +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 + + +(* Remove module aliases from a signature *) + +module P = struct + type t = Path.t + let compare p1 p2 = + if Path.same p1 p2 then 0 else compare p1 p2 +end +module PathSet = Set.Make (P) +module PathMap = Map.Make (P) +module IdentSet = Set.Make (struct type t = Ident.t let compare = compare end) + +let rec get_prefixes = function + Pident _ -> PathSet.empty + | Pdot (p, _, _) + | Papply (p, _) -> PathSet.add p (get_prefixes p) + +let rec get_arg_paths = function + Pident _ -> PathSet.empty + | Pdot (p, _, _) -> get_arg_paths p + | Papply (p1, p2) -> + PathSet.add p2 + (PathSet.union (get_prefixes p2) + (PathSet.union (get_arg_paths p1) (get_arg_paths p2))) + +let rec rollback_path subst p = + try Pident (PathMap.find p subst) + with Not_found -> + match p with + Pident _ | Papply _ -> p + | Pdot (p1, s, n) -> + let p1' = rollback_path subst p1 in + if Path.same p1 p1' then p else rollback_path subst (Pdot (p1', s, n)) + +let rec collect_ids subst bindings p = + begin match rollback_path subst p with + Pident id -> + let ids = + try collect_ids subst bindings (Ident.find_same id bindings) + with Not_found -> IdentSet.empty + in + IdentSet.add id ids + | _ -> IdentSet.empty + end + +let collect_arg_paths mty = + let open Btype in + let paths = ref PathSet.empty + and subst = ref PathMap.empty + and bindings = ref Ident.empty in + (* let rt = Ident.create "Root" in + and prefix = ref (Path.Pident rt) in *) + let it_path p = paths := PathSet.union (get_arg_paths p) !paths + and it_signature_item it si = + type_iterators.it_signature_item it si; + match si with + Sig_module (id, {md_type=Mty_alias p}, _) -> + bindings := Ident.add id p !bindings + | Sig_module (id, {md_type=Mty_signature sg}, _) -> + List.iter + (function Sig_module (id', _, _) -> + subst := + PathMap.add (Pdot (Pident id, Ident.name id', -1)) id' !subst + | _ -> ()) + sg + | _ -> () + in + let it = {type_iterators with it_path; it_signature_item} in + it.it_module_type it mty; + PathSet.fold (fun p -> IdentSet.union (collect_ids !subst !bindings p)) + !paths IdentSet.empty + +let rec remove_aliases env excl mty = + match mty with + Mty_signature sg -> + Mty_signature (remove_aliases_sig env excl sg) + | Mty_alias _ -> + remove_aliases env excl (Env.scrape_alias env mty) + | mty -> + mty + +and remove_aliases_sig env excl sg = + match sg with + [] -> [] + | Sig_module(id, md, rs) :: rem -> + let mty = + match md.md_type with + Mty_alias _ when IdentSet.mem id excl -> + md.md_type + | mty -> + remove_aliases env excl mty + in + Sig_module(id, {md with md_type = mty} , rs) :: + remove_aliases_sig (Env.add_module id mty env) excl rem + | Sig_modtype(id, mtd) :: rem -> + Sig_modtype(id, mtd) :: + remove_aliases_sig (Env.add_modtype id mtd env) excl rem + | it :: rem -> + it :: remove_aliases_sig env excl rem + +let remove_aliases env sg = + let excl = collect_arg_paths sg in + (* PathSet.iter (fun p -> Format.eprintf "%a@ " Printtyp.path p) excl; + Format.eprintf "@."; *) + remove_aliases env excl sg diff --git a/typing/mtype.mli b/typing/mtype.mli index fe824731a6..6e815fad89 100644 --- a/typing/mtype.mli +++ b/typing/mtype.mli @@ -36,3 +36,5 @@ val no_code_needed_sig: Env.t -> signature -> bool 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 +val remove_aliases: Env.t -> module_type -> module_type diff --git a/typing/oprint.ml b/typing/oprint.ml index 7475c12438..47a0c04a52 100644 --- a/typing/oprint.ml +++ b/typing/oprint.ml @@ -341,15 +341,23 @@ let out_module_type = ref (fun _ -> failwith "Oprint.out_module_type") let out_sig_item = ref (fun _ -> failwith "Oprint.out_sig_item") let out_signature = ref (fun _ -> failwith "Oprint.out_signature") -let rec print_out_module_type ppf = +let rec print_out_functor ppf = + function + Omty_functor (_, None, mty_res) -> + fprintf ppf "() %a" print_out_functor mty_res + | Omty_functor (name , Some mty_arg, mty_res) -> + fprintf ppf "(%s : %a) %a" name + print_out_module_type mty_arg print_out_functor mty_res + | m -> fprintf ppf "->@ %a" print_out_module_type m +and print_out_module_type ppf = function Omty_abstract -> () - | 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 + | Omty_functor _ as t -> + fprintf ppf "@[<2>functor@ %a@]" print_out_functor t | Omty_ident id -> fprintf ppf "%a" print_ident id | Omty_signature sg -> fprintf ppf "@[<hv 2>sig@ %a@;<1 -2>end@]" !out_signature sg + | Omty_alias id -> fprintf ppf "(module %a)" print_ident id and print_out_signature ppf = function [] -> () @@ -374,6 +382,8 @@ and print_out_sig_item ppf = fprintf ppf "@[<2>module type %s@]" name | Osig_modtype (name, mty) -> fprintf ppf "@[<2>module type %s =@ %a@]" name !out_module_type mty + | Osig_module (name, Omty_alias id, _) -> + fprintf ppf "@[<2>module %s =@ %a@]" name print_ident id | Osig_module (name, mty, rs) -> fprintf ppf "@[<2>%s %s :@ %a@]" (match rs with Orec_not -> "module" diff --git a/typing/outcometree.mli b/typing/outcometree.mli index 19fc1c7446..eae7b2fbeb 100644 --- a/typing/outcometree.mli +++ b/typing/outcometree.mli @@ -75,9 +75,10 @@ and out_class_sig_item = 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 + | Omty_alias of out_ident and out_sig_item = | Osig_class of bool * string * (string * (bool * bool)) list * out_class_type * diff --git a/typing/parmatch.ml b/typing/parmatch.ml index 73fa785c1d..b425144a18 100644 --- a/typing/parmatch.ml +++ b/typing/parmatch.ml @@ -58,7 +58,7 @@ let const_compare x y = | Const_float f1, Const_float f2 -> Pervasives.compare (float_of_string f1) (float_of_string f2) | Const_string (s1, _), Const_string (s2, _) -> - Pervasives.compare s1 s2 + String.compare s1 s2 | _, _ -> Pervasives.compare x y let records_args l1 l2 = diff --git a/typing/predef.ml b/typing/predef.ml index d83c9cf675..9b95d62642 100644 --- a/typing/predef.ml +++ b/typing/predef.ml @@ -144,7 +144,7 @@ let build_initial_env add_type add_exception empty_env = Type_variant([cstr ident_nil []; cstr ident_cons [tvar; type_list tvar]]); type_variance = [Variance.covariant]} and decl_format6 = - let params = List.map newgenvar [();();();();();()] in + let params = List.map (newgenvar ?name:None) [();();();();();()] in {decl_abstr with type_params = params; type_arity = 6; diff --git a/typing/printtyp.ml b/typing/printtyp.ml index 1f7e501984..cd3a631b8a 100644 --- a/typing/printtyp.ml +++ b/typing/printtyp.ml @@ -247,28 +247,22 @@ let rec uniq = function let rec normalize_type_path ?(cache=false) env p = try - let desc = Env.find_type p env in - if desc.type_private = Private || desc.type_newtype_level <> None then - (p, Id) - else match desc.type_manifest with - Some ty -> - let params = List.map repr desc.type_params in - begin match repr ty with - {desc = Tconstr (p1, tyl, _)} -> - let tyl = List.map repr tyl in - if List.length params = List.length tyl - && List.for_all2 (==) params tyl - then normalize_type_path ~cache env p1 - else if cache || List.length params <= List.length tyl - || not (uniq tyl) then (p, Id) - else - let l1 = List.map (index params) tyl in - let (p2, s2) = normalize_type_path ~cache env p1 in - (p2, compose l1 s2) - | ty -> - (p, Nth (index params ty)) - end - | None -> (p, Id) + let (params, ty, _) = Env.find_type_expansion p env in + let params = List.map repr params in + match repr ty with + {desc = Tconstr (p1, tyl, _)} -> + let tyl = List.map repr tyl in + if List.length params = List.length tyl + && List.for_all2 (==) params tyl + then normalize_type_path ~cache env p1 + else if cache || List.length params <= List.length tyl + || not (uniq tyl) then (p, Id) + else + let l1 = List.map (index params) tyl in + let (p2, s2) = normalize_type_path ~cache env p1 in + (p2, compose l1 s2) + | ty -> + (p, Nth (index params ty)) with Not_found -> (p, Id) @@ -1116,9 +1110,14 @@ let rec tree_of_modtype = function | 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 ~arg:true param mty) tree_of_modtype ty_res + in + Omty_functor (Ident.name param, may_map tree_of_modtype ty_arg, res) + | Mty_alias p -> + Omty_alias (tree_of_path p) and tree_of_signature sg = wrap_env (fun env -> env) (tree_of_signature_rec !printing_env) sg diff --git a/typing/printtyped.ml b/typing/printtyped.ml index 7861361b8e..209121e834 100644 --- a/typing/printtyped.ml +++ b/typing/printtyped.ml @@ -1,4 +1,4 @@ -(***********************************************************************) +2(***********************************************************************) (* *) (* OCaml *) (* *) @@ -557,12 +557,13 @@ and module_type i ppf x = let i = i+1 in match x.mty_desc with | Tmty_ident (li,_) -> line i ppf "Pmty_ident %a\n" fmt_path li; + | Tmty_alias (li,_) -> line i ppf "Pmty_alias %a\n" fmt_path li; | Tmty_signature (s) -> line i ppf "Pmty_signature\n"; signature i ppf s; | Tmty_functor (s, _, mt1, mt2) -> line i ppf "Pmty_functor \"%a\"\n" fmt_ident s; - module_type i ppf mt1; + Misc.may (module_type i ppf) mt1; module_type i ppf mt2; | Tmty_with (mt, l) -> line i ppf "Pmty_with\n"; @@ -651,7 +652,7 @@ and module_expr i ppf x = 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"; diff --git a/typing/subst.ml b/typing/subst.ml index 6acf9323dd..df84e59eff 100644 --- a/typing/subst.ml +++ b/typing/subst.ml @@ -85,6 +85,14 @@ let newpersty desc = decr new_id; { desc = desc; level = generic_level; id = !new_id } +(* ensure that all occurrences of 'Tvar None' are physically shared *) +let tvar_none = Tvar None +let tunivar_none = Tunivar None +let norm = function + | Tvar None -> tvar_none + | Tunivar None -> tunivar_none + | d -> d + (* Similar to [Ctype.nondep_type_rec]. *) let rec typexp s ty = let ty = repr ty in @@ -92,7 +100,7 @@ let rec typexp s ty = Tvar _ | Tunivar _ as desc -> if s.for_saving || ty.id < 0 then let ty' = - if s.for_saving then newpersty desc + if s.for_saving then newpersty (norm desc) else newty2 ty.level desc in save_desc ty desc; ty.desc <- Tsubst ty'; ty' @@ -146,7 +154,7 @@ let rec typexp s ty = | Tconstr _ | Tnil -> typexp s more | Tunivar _ | Tvar _ -> save_desc more more.desc; - if s.for_saving then newpersty more.desc else + if s.for_saving then newpersty (norm more.desc) else if dup && is_Tvar more then newgenty more.desc else more | _ -> assert false in @@ -327,8 +335,10 @@ let rec modtype s = function 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) + | Mty_alias p -> + Mty_alias(module_path s p) and signature s sg = (* Components of signature may be mutually recursive (e.g. type declarations @@ -359,12 +369,14 @@ and module_declaration s decl = { md_type = modtype s decl.md_type; md_attributes = attrs s decl.md_attributes; + md_loc = loc s decl.md_loc; } and modtype_declaration s decl = { mtd_type = may_map (modtype s) decl.mtd_type; mtd_attributes = attrs s decl.mtd_attributes; + mtd_loc = loc s decl.mtd_loc; } (* For every binding k |-> d of m1, add k |-> f d to m2 diff --git a/typing/typecore.ml b/typing/typecore.ml index 644b2ae110..9351572e22 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -25,6 +25,7 @@ type error = | Constructor_arity_mismatch of Longident.t * int * int | Label_mismatch of Longident.t * (type_expr * type_expr) list | Pattern_type_clash of (type_expr * type_expr) list + | Or_pattern_type_clash of Ident.t * (type_expr * type_expr) list | Multiply_bound_variable of string | Orpat_vars of Ident.t | Expr_type_clash of (type_expr * type_expr) list @@ -64,6 +65,7 @@ type error = | Unexpected_existential | Unqualified_gadt_pattern of Path.t * string | Invalid_interval + | Invalid_for_loop_index | Extension of string exception Error of Location.t * Env.t * error @@ -437,7 +439,7 @@ let enter_orpat_variables loc env p1_vs p2_vs = unify env t1 t2 with | Unify trace -> - raise(Error(loc, env, Pattern_type_clash(trace))) + raise(Error(loc, env, Or_pattern_type_clash(x1, trace))) end; (x2,x1)::unify_vars rem1 rem2 end @@ -536,8 +538,10 @@ let build_or_pat env loc lid = let gloc = {loc with Location.loc_ghost=true} in let row' = ref {row with row_more=newvar()} in let pats = - List.map (fun (l,p) -> {pat_desc=Tpat_variant(l,p,row'); pat_loc=gloc; - pat_env=env; pat_type=ty; pat_extra=[]; pat_attributes=[]}) + List.map + (fun (l,p) -> + {pat_desc=Tpat_variant(l,p,row'); pat_loc=gloc; + pat_env=env; pat_type=ty; pat_extra=[]; pat_attributes=[]}) pats in match pats with @@ -545,8 +549,9 @@ let build_or_pat env loc lid = | pat :: pats -> let r = List.fold_left - (fun pat pat0 -> {pat_desc=Tpat_or(pat0,pat,Some row0); pat_extra=[]; - pat_loc=gloc; pat_env=env; pat_type=ty; pat_attributes=[]}) + (fun pat pat0 -> + {pat_desc=Tpat_or(pat0,pat,Some row0); pat_extra=[]; + pat_loc=gloc; pat_env=env; pat_type=ty; pat_attributes=[]}) pat pats in (path, rp { r with pat_loc = loc },ty) @@ -562,7 +567,9 @@ let rec expand_path env p = {desc=Tconstr(p,_,_)} -> expand_path env p | _ -> assert false end - | _ -> p + | _ -> + let p' = Env.normalize_path None env p in + if Path.same p p' then p else expand_path env p' let compare_type_path env tpath1 tpath2 = Path.same (expand_path env tpath1) (expand_path env tpath2) @@ -978,7 +985,8 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty = in let p = if c1 <= c2 then loop c1 c2 else loop c2 c1 in let p = {p with ppat_loc=loc} in - type_pat p expected_ty (* TODO: record 'extra' to remember about interval *) + type_pat p expected_ty + (* TODO: record 'extra' to remember about interval *) | Ppat_interval _ -> raise (Error (loc, !env, Invalid_interval)) | Ppat_tuple spl -> @@ -1177,7 +1185,8 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty = match p.pat_desc with Tpat_var (id,s) -> {p with pat_type = ty; - pat_desc = Tpat_alias ({p with pat_desc = Tpat_any; pat_attributes = []}, id,s); + pat_desc = Tpat_alias + ({p with pat_desc = Tpat_any; pat_attributes = []}, id,s); pat_extra = [extra]; } | _ -> {p with pat_type = ty; @@ -1186,7 +1195,8 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty = | Ppat_type lid -> let (path, p,ty) = build_or_pat !env loc lid.txt in unify_pat_types loc !env ty expected_ty; - { p with pat_extra = (Tpat_type (path, lid), loc, sp.ppat_attributes) :: p.pat_extra } + { p with pat_extra = + (Tpat_type (path, lid), loc, sp.ppat_attributes) :: p.pat_extra } | Ppat_extension (s, _arg) -> raise (Error (s.loc, !env, Extension s.txt)) @@ -1421,7 +1431,8 @@ and is_nonexpansive_mod mexp = | Tstr_open _ | Tstr_class_type _ | Tstr_exn_rebind _ -> true | Tstr_value (_, pat_exp_list) -> List.for_all (fun vb -> is_nonexpansive vb.vb_expr) pat_exp_list - | Tstr_module {mb_expr=m;_} | Tstr_include (m, _, _) -> is_nonexpansive_mod m + | Tstr_module {mb_expr=m;_} + | Tstr_include (m, _, _) -> is_nonexpansive_mod m | Tstr_recmodule id_mod_list -> List.for_all (fun {mb_expr=m;_} -> is_nonexpansive_mod m) id_mod_list @@ -1942,6 +1953,10 @@ and type_expect_ ?in_function env sexp ty_expected = Texp_ident(path, lid, desc) | Val_unbound -> raise(Error(loc, env, Masked_instance_variable lid.txt)) + (*| Val_prim _ -> + let p = Env.normalize_path (Some loc) env path in + Env.add_required_global (Path.head p); + Texp_ident(path, lid, desc)*) | _ -> Texp_ident(path, lid, desc) end; @@ -1970,10 +1985,13 @@ and type_expect_ ?in_function env sexp ty_expected = exp_type = type_constant cst; exp_attributes = sexp.pexp_attributes; exp_env = env } - | Pexp_let(Nonrecursive, [{pvb_pat=spat; pvb_expr=sval; pvb_attributes=[]}], sbody) when contains_gadt env spat -> + | Pexp_let(Nonrecursive, + [{pvb_pat=spat; pvb_expr=sval; pvb_attributes=[]}], sbody) + when contains_gadt env spat -> (* TODO: allow non-empty attributes? *) type_expect ?in_function env - {sexp with pexp_desc = Pexp_match (sval, [Ast_helper.Exp.case spat sbody])} + {sexp with + pexp_desc = Pexp_match (sval, [Ast_helper.Exp.case spat sbody])} ty_expected | Pexp_let(rec_flag, spat_sexp_list, sbody) -> let scp = @@ -2018,7 +2036,8 @@ and type_expect_ ?in_function env sexp ty_expected = Exp.fun_ ~loc l None (Pat.var ~loc (mknoloc "*opt*")) - (Exp.let_ ~loc Nonrecursive ~attrs:[mknoloc "#default",PStr []] [Vb.mk spat smatch] sexp) + (Exp.let_ ~loc Nonrecursive ~attrs:[mknoloc "#default",PStr []] + [Vb.mk spat smatch] sexp) in type_expect ?in_function env sfun ty_expected (* TODO: keep attributes, call type_function directly *) @@ -2167,7 +2186,7 @@ and type_expect_ ?in_function env sexp ty_expected = let ty = newconstr p' (instance_list env decl.type_params) in end_def (); - generalize ty; + generalize_structure ty; ty, op end | op -> ty_expected, op @@ -2317,11 +2336,16 @@ and type_expect_ ?in_function env sexp ty_expected = | Pexp_for(param, slow, shigh, dir, sbody) -> let low = type_expect env slow Predef.type_int in let high = type_expect env shigh Predef.type_int in - let (id, new_env) = - Env.enter_value param.txt {val_type = instance_def Predef.type_int; - val_attributes = []; - val_kind = Val_reg; Types.val_loc = loc; } env - ~check:(fun s -> Warnings.Unused_for_index s) + let id, new_env = + match param.ppat_desc with + | Ppat_any -> Ident.create "_for", env + | Ppat_var {txt} -> + Env.enter_value txt {val_type = instance_def Predef.type_int; + val_attributes = []; + val_kind = Val_reg; Types.val_loc = loc; } env + ~check:(fun s -> Warnings.Unused_for_index s) + | _ -> + raise (Error (param.ppat_loc, env, Invalid_for_loop_index)) in let body = type_statement new_env sbody in rue { @@ -2349,7 +2373,8 @@ and type_expect_ ?in_function env sexp ty_expected = exp_type = ty'; exp_attributes = arg.exp_attributes; exp_env = env; - exp_extra = (Texp_constraint cty, loc, sexp.pexp_attributes) :: arg.exp_extra; + exp_extra = + (Texp_constraint cty, loc, sexp.pexp_attributes) :: arg.exp_extra; } | Pexp_coerce(sarg, sty, sty') -> let separate = true (* always separate, 1% slowdown for lablgtk *) @@ -2716,7 +2741,8 @@ and type_expect_ ?in_function env sexp ty_expected = exp | _ -> assert false in - re { exp with exp_extra = (Texp_poly cty, loc, sexp.pexp_attributes) :: exp.exp_extra } + re { exp with exp_extra = + (Texp_poly cty, loc, sexp.pexp_attributes) :: exp.exp_extra } | Pexp_newtype(name, sbody) -> let ty = newvar () in (* remember original level *) @@ -2762,7 +2788,8 @@ and type_expect_ ?in_function env sexp ty_expected = (* non-expansive if the body is non-expansive, so we don't introduce any new extra node in the typed AST. *) rue { body with exp_loc = loc; exp_type = ety; - exp_extra = (Texp_newtype name, loc, sexp.pexp_attributes) :: body.exp_extra } + exp_extra = + (Texp_newtype name, loc, sexp.pexp_attributes) :: body.exp_extra } | Pexp_pack m -> let (p, nl, tl) = match Ctype.expand_head env (instance env ty_expected) with @@ -2946,8 +2973,8 @@ and type_argument env sarg ty_expected' ty_expected = let ty = option_none (instance env ty_arg) sarg.pexp_loc in make_args ((l, Some ty, Optional) :: args) ty_fun | Tarrow (l,_,ty_res',_) when l = "" || !Clflags.classic -> - args, ty_fun, no_labels ty_res' - | Tvar _ -> args, ty_fun, false + List.rev args, ty_fun, no_labels ty_res' + | Tvar _ -> List.rev args, ty_fun, false | _ -> [], texp.exp_type, false in let args, ty_fun', simple_res = make_args [] texp.exp_type in @@ -2981,18 +3008,22 @@ and type_argument env sarg ty_expected' ty_expected = {texp with exp_type = ty_res; exp_desc = Texp_apply (texp, - List.rev args @ ["", Some eta_var, Required])} + args @ ["", Some eta_var, Required])} in { texp with exp_type = ty_fun; exp_desc = Texp_function("", [case eta_pat e], Total) } in + Location.prerr_warning texp.exp_loc + (Warnings.Eliminated_optional_arguments (List.map (fun (l, _, _) -> l) args)); if warn then Location.prerr_warning texp.exp_loc (Warnings.Without_principality "eliminated optional argument"); if is_nonexpansive texp then func texp else (* let-expand to have side effects *) let let_pat, let_var = var_pair "arg" texp.exp_type in re { texp with exp_type = ty_fun; exp_desc = - Texp_let (Nonrecursive, [{vb_pat=let_pat; vb_expr=texp; vb_attributes=[]}], func let_var) } + Texp_let (Nonrecursive, + [{vb_pat=let_pat; vb_expr=texp; vb_attributes=[]}], + func let_var) } end | _ -> let texp = type_expect env sarg ty_expected' in @@ -3271,7 +3302,7 @@ and type_statement env sexp = (* Typing of match cases *) -and type_cases ?in_function env ty_arg ty_res partial_flag loc caselist : Typedtree.case list * _ = +and type_cases ?in_function env ty_arg ty_res partial_flag loc caselist = (* ty_arg is _fully_ generalized *) let patterns = List.map (fun {pc_lhs=p} -> p) caselist in let erase_either = @@ -3580,7 +3611,8 @@ and type_let ?(check = fun s -> Warnings.Unused_var s) let l = List.combine pat_list exp_list in let l = List.map2 - (fun (p, e) pvb -> {vb_pat=p; vb_expr=e; vb_attributes=pvb.pvb_attributes}) + (fun (p, e) pvb -> + {vb_pat=p; vb_expr=e; vb_attributes=pvb.pvb_attributes}) l spat_sexp_list in (l, new_env, unpacks) @@ -3645,6 +3677,12 @@ let report_error env ppf = function fprintf ppf "This pattern matches values of type") (function ppf -> fprintf ppf "but a pattern was expected which matches values of type") + | Or_pattern_type_clash (id, trace) -> + report_unification_error ppf env trace + (function ppf -> + fprintf ppf "The variable %s on the left-hand side of this or-pattern has type" (Ident.name id)) + (function ppf -> + fprintf ppf "but on the right-hand side it has type") | Multiply_bound_variable name -> fprintf ppf "Variable %s is bound several times in this matching" name | Orpat_vars id -> @@ -3820,6 +3858,9 @@ let report_error env ppf = function "must be qualified in this pattern" | Invalid_interval -> fprintf ppf "@[Only character intervals are supported in patterns.@]" + | Invalid_for_loop_index -> + fprintf ppf + "@[Invalid for-loop index: only variables and _ are allowed.@]" | Extension s -> fprintf ppf "Uninterpreted extension '%s'." s diff --git a/typing/typecore.mli b/typing/typecore.mli index 4b0f00817e..8dae2c9883 100644 --- a/typing/typecore.mli +++ b/typing/typecore.mli @@ -67,6 +67,7 @@ type error = | Constructor_arity_mismatch of Longident.t * int * int | Label_mismatch of Longident.t * (type_expr * type_expr) list | Pattern_type_clash of (type_expr * type_expr) list + | Or_pattern_type_clash of Ident.t * (type_expr * type_expr) list | Multiply_bound_variable of string | Orpat_vars of Ident.t | Expr_type_clash of (type_expr * type_expr) list @@ -106,6 +107,7 @@ type error = | Unexpected_existential | Unqualified_gadt_pattern of Path.t * string | Invalid_interval + | Invalid_for_loop_index | Extension of string exception Error of Location.t * Env.t * error diff --git a/typing/typedecl.ml b/typing/typedecl.ml index 214a0b1c2e..41625af08f 100644 --- a/typing/typedecl.ml +++ b/typing/typedecl.ml @@ -86,13 +86,21 @@ let is_float env ty = (* Determine if a type definition defines a fixed type. (PW) *) let is_fixed_type sd = - (match sd.ptype_manifest with - | Some { ptyp_desc = - (Ptyp_variant _|Ptyp_object _|Ptyp_class _|Ptyp_alias - ({ptyp_desc = Ptyp_variant _|Ptyp_object _|Ptyp_class _},_)) } -> true - | _ -> false) && - sd.ptype_kind = Ptype_abstract && - sd.ptype_private = Private + let rec has_row_var sty = + match sty.ptyp_desc with + Ptyp_alias (sty, _) -> has_row_var sty + | Ptyp_class _ + | Ptyp_object (_, Open) + | Ptyp_variant (_, Open, _) + | Ptyp_variant (_, Closed, Some _) -> true + | _ -> false + in + match sd.ptype_manifest with + None -> false + | Some sty -> + sd.ptype_kind = Ptype_abstract && + sd.ptype_private = Private && + has_row_var sty (* Set the row variable in a fixed type *) let set_fixed_row env loc p decl = @@ -573,7 +581,13 @@ let compute_variance env visited vari ty = Rpresent (Some ty) -> compute_same ty | Reither (_, tyl, _, _) -> - List.iter compute_same tyl + let open Variance in + let upper = + List.fold_left (fun s f -> set f true s) + null [May_pos; May_neg; May_weak] + in + let v = inter vari upper in + List.iter (compute_variance_rec v) tyl | _ -> ()) row.row_fields; compute_same row.row_more @@ -709,7 +723,7 @@ let compute_variance_gadt env check (required, loc as rloc) decl | {desc=Tconstr (path, tyl, _)} -> (* let tyl = List.map (Ctype.expand_head env) tyl in *) let tyl = List.map Ctype.repr tyl in - let fvl = List.map Ctype.free_variables tyl in + let fvl = List.map (Ctype.free_variables ?env:None) tyl in let _ = List.fold_left2 (fun (fv1,fv2) ty (c,n,i) -> @@ -1129,7 +1143,8 @@ let transl_with_constraint env id row_path orig_decl sdecl = let decl = { type_params = params; type_arity = List.length params; - type_kind = if arity_ok then orig_decl.type_kind else Type_abstract; + type_kind = + if arity_ok && man <> None then orig_decl.type_kind else Type_abstract; type_private = priv; type_manifest = man; type_variance = []; diff --git a/typing/typedtree.ml b/typing/typedtree.ml index 35c5f5c5e6..166086ae86 100644 --- a/typing/typedtree.ml +++ b/typing/typedtree.ml @@ -93,7 +93,7 @@ and expression_desc = | Texp_sequence of expression * expression | Texp_while of expression * expression | Texp_for of - Ident.t * string loc * expression * expression * direction_flag * + Ident.t * Parsetree.pattern * expression * expression * direction_flag * expression | Texp_send of expression * meth * expression option | Texp_new of Path.t * Longident.t loc * Types.class_declaration @@ -187,7 +187,7 @@ and module_type_constraint = 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 @@ -211,7 +211,8 @@ and structure_item_desc = | Tstr_primitive of value_description | Tstr_type of type_declaration list | Tstr_exception of constructor_declaration - | Tstr_exn_rebind of Ident.t * string loc * Path.t * Longident.t loc * attribute list + | Tstr_exn_rebind of + Ident.t * string loc * Path.t * Longident.t loc * attribute list | Tstr_module of module_binding | Tstr_recmodule of module_binding list | Tstr_modtype of module_type_declaration @@ -227,6 +228,7 @@ and module_binding = mb_name: string loc; mb_expr: module_expr; mb_attributes: attribute list; + mb_loc: Location.t; } and value_binding = @@ -238,9 +240,11 @@ and value_binding = and module_coercion = Tcoerce_none - | Tcoerce_structure of (int * module_coercion) list + | Tcoerce_structure of (int * module_coercion) list * + (Ident.t * int * module_coercion) list | Tcoerce_functor of module_coercion * module_coercion | Tcoerce_primitive of Primitive.description + | Tcoerce_alias of Path.t * module_coercion and module_type = { mty_desc: module_type_desc; @@ -253,9 +257,10 @@ and module_type = 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 + | Tmty_alias of Path.t * Longident.t loc and signature = { sig_items : signature_item list; @@ -287,6 +292,7 @@ and module_declaration = md_name: string loc; md_type: module_type; md_attributes: attribute list; + md_loc: Location.t; } and module_type_declaration = @@ -295,6 +301,7 @@ and module_type_declaration = mtd_name: string loc; mtd_type: module_type option; mtd_attributes: attribute list; + mtd_loc: Location.t; } and with_constraint = diff --git a/typing/typedtree.mli b/typing/typedtree.mli index b68d0cc8c0..a7161914c6 100644 --- a/typing/typedtree.mli +++ b/typing/typedtree.mli @@ -92,7 +92,7 @@ and expression_desc = | Texp_sequence of expression * expression | Texp_while of expression * expression | Texp_for of - Ident.t * string loc * expression * expression * direction_flag * + Ident.t * Parsetree.pattern * expression * expression * direction_flag * expression | Texp_send of expression * meth * expression option | Texp_new of Path.t * Longident.t loc * Types.class_declaration @@ -186,7 +186,7 @@ and module_type_constraint = 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 @@ -226,6 +226,7 @@ and module_binding = mb_name: string loc; mb_expr: module_expr; mb_attributes: attributes; + mb_loc: Location.t; } and value_binding = @@ -237,9 +238,11 @@ and value_binding = and module_coercion = Tcoerce_none - | Tcoerce_structure of (int * module_coercion) list + | Tcoerce_structure of (int * module_coercion) list * + (Ident.t * int * module_coercion) list | Tcoerce_functor of module_coercion * module_coercion | Tcoerce_primitive of Primitive.description + | Tcoerce_alias of Path.t * module_coercion and module_type = { mty_desc: module_type_desc; @@ -252,9 +255,10 @@ and module_type = 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 + | Tmty_alias of Path.t * Longident.t loc and signature = { sig_items : signature_item list; @@ -286,6 +290,7 @@ and module_declaration = md_name: string loc; md_type: module_type; md_attributes: attributes; + md_loc: Location.t; } and module_type_declaration = @@ -294,6 +299,7 @@ and module_type_declaration = mtd_name: string loc; mtd_type: module_type option; mtd_attributes: attributes; + mtd_loc: Location.t; } and with_constraint = diff --git a/typing/typedtreeIter.ml b/typing/typedtreeIter.ml index edb5587986..c0d61297d4 100644 --- a/typing/typedtreeIter.ml +++ b/typing/typedtreeIter.ml @@ -381,9 +381,10 @@ module MakeIterator(Iter : IteratorArgument) : sig begin match mty.mty_desc with Tmty_ident (path, _) -> () + | Tmty_alias (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 +413,7 @@ module MakeIterator(Iter : IteratorArgument) : sig 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; diff --git a/typing/typedtreeMap.ml b/typing/typedtreeMap.ml index 5c9229950f..93881a0f12 100644 --- a/typing/typedtreeMap.ml +++ b/typing/typedtreeMap.ml @@ -423,10 +423,11 @@ module MakeMap(Map : MapArgument) = struct let mty = Map.enter_module_type mty in let mty_desc = match mty.mty_desc with - Tmty_ident (path, lid) -> mty.mty_desc + Tmty_ident _ -> mty.mty_desc + | Tmty_alias _ -> 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 +457,7 @@ module MakeMap(Map : MapArgument) = struct 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) diff --git a/typing/typemod.ml b/typing/typemod.ml index ec63ae8cac..1e7a380191 100644 --- a/typing/typemod.ml +++ b/typing/typemod.ml @@ -39,6 +39,7 @@ type error = | 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 @@ -55,19 +56,20 @@ let rec path_concat head p = (* Extract a signature from a module type *) let extract_sig env loc mty = - match Mtype.scrape env mty with + match Env.scrape_alias env mty with Mty_signature sg -> sg | _ -> raise(Error(loc, env, Signature_expected)) let extract_sig_open env loc mty = - match Mtype.scrape env mty with + match Env.scrape_alias env mty with Mty_signature sg -> sg | _ -> raise(Error(loc, env, Structure_expected mty)) (* Compute the environment after opening a module *) let type_open ?toplevel ovf env loc lid = - let (path, md) = Typetexp.find_module env loc lid.txt in + let path = Typetexp.find_module env loc lid.txt in + let md = Env.find_module path env in let sg = extract_sig_open env loc md.md_type in path, Env.open_signature ~loc ?toplevel ovf path sg env @@ -194,14 +196,16 @@ let merge_constraint initial_env loc sg constr = make_next_first 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 + let path = Typetexp.find_module initial_env loc lid.txt in + let md' = Env.find_module path env in let newmd = Mtype.strengthen_decl env md' path in ignore(Includemod.modtypes env newmd.md_type md.md_type); (Pident id, lid, Twith_module (path, lid)), Sig_module(id, newmd, rs) :: rem | (Sig_module(id, md, rs) :: rem, [s], Pwith_modsubst (_, lid)) when Ident.name id = s -> - let (path, md') = Typetexp.find_module initial_env loc lid.txt in + let path = Typetexp.find_module initial_env loc lid.txt in + let md' = Env.find_module path env in let newmd = Mtype.strengthen_decl env md' path in ignore(Includemod.modtypes env newmd.md_type md.md_type); real_id := Some id; @@ -252,7 +256,7 @@ let merge_constraint initial_env loc sg constr = | [s], Pwith_modsubst (_, lid) -> let id = match !real_id with None -> assert false | Some id -> id in - let (path, _) = Typetexp.find_module initial_env loc lid.txt in + 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 | _ -> @@ -296,11 +300,15 @@ let rec approx_modtype env smty = Pmty_ident lid -> let (path, info) = Typetexp.find_modtype env smty.pmty_loc lid.txt in Mty_ident path + | Pmty_alias lid -> + let path = Typetexp.find_module env smty.pmty_loc lid.txt in + Mty_alias path | 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 ~arg:true param.txt (Btype.default_mty arg) env in let res = approx_modtype newenv sres in Mty_functor(id, arg, res) | Pmty_with(sbody, constraints) -> @@ -311,6 +319,13 @@ let rec approx_modtype env smty = | Pmty_extension (s, _arg) -> raise (Error (s.loc, env, Extension s.txt)) +and approx_module_declaration env pmd = + { + Types.md_type = approx_modtype env pmd.pmd_type; + md_attributes = pmd.pmd_attributes; + md_loc = pmd.pmd_loc; + } + and approx_sig env ssg = match ssg with [] -> [] @@ -321,12 +336,7 @@ and approx_sig env ssg = let rem = approx_sig env srem in map_rec' (fun rs (id, info) -> Sig_type(id, info, rs)) decls rem | Psig_module pmd -> - let md = - { - Types.md_type = approx_modtype env pmd.pmd_type; - md_attributes = pmd.pmd_attributes; - } - in + let md = approx_module_declaration env pmd in let (id, newenv) = Env.enter_module_declaration pmd.pmd_name.txt md env in @@ -335,18 +345,15 @@ and approx_sig env ssg = let decls = List.map (fun pmd -> - (Ident.create pmd.pmd_name.txt, - { - md_type = approx_modtype env pmd.pmd_type; - md_attributes = pmd.pmd_attributes; - } - ) + (Ident.create pmd.pmd_name.txt, + approx_module_declaration env pmd) ) sdecls in let newenv = - List.fold_left (fun env (id, md) -> Env.add_module_declaration id md env) - env decls in + List.fold_left + (fun env (id, md) -> Env.add_module_declaration id md env) + env decls in map_rec (fun rs (id, md) -> Sig_module(id, md, rs)) decls (approx_sig newenv srem) | Psig_modtype d -> @@ -379,6 +386,7 @@ and approx_modtype_info env sinfo = { mtd_type = may_map (approx_modtype env) sinfo.pmtd_type; mtd_attributes = sinfo.pmtd_attributes; + mtd_loc = sinfo.pmtd_loc; } (* Additional validity checks on type definitions arising from @@ -442,6 +450,9 @@ let transl_modtype_longident loc env lid = let (path, info) = Typetexp.find_modtype env loc lid in path +let transl_module_alias loc env lid = + Typetexp.find_module env loc lid + let mkmty desc typ env loc attrs = let mty = { mty_desc = desc; @@ -467,16 +478,22 @@ let rec transl_modtype env smty = let path = transl_modtype_longident loc env lid.txt in mkmty (Tmty_ident (path, lid)) (Mty_ident path) env loc smty.pmty_attributes + | Pmty_alias lid -> + let path = transl_module_alias loc env lid.txt in + mkmty (Tmty_alias (path, lid)) (Mty_alias path) env loc + smty.pmty_attributes | Pmty_signature ssg -> let sg = transl_signature env ssg in 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 ~arg:true 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 @@ -511,7 +528,8 @@ and transl_signature env sg = let loc = item.psig_loc in match item.psig_desc with | Psig_value sdesc -> - let (tdesc, newenv) = Typedecl.transl_value_decl env item.psig_loc sdesc in + let (tdesc, newenv) = + Typedecl.transl_value_decl env item.psig_loc sdesc in let (trem,rem, final_env) = transl_sig newenv srem in mksig (Tsig_value tdesc) env loc :: trem, (if List.exists (Ident.equal tdesc.val_id) (get_values rem) then rem @@ -541,14 +559,17 @@ and transl_signature env sg = let tmty = transl_modtype env pmd.pmd_type in let md = { md_type=tmty.mty_type; - md_attributes=pmd.pmd_attributes + md_attributes=pmd.pmd_attributes; + md_loc=pmd.pmd_loc; } in - let (id, newenv) = Env.enter_module_declaration pmd.pmd_name.txt md env in + let (id, newenv) = + Env.enter_module_declaration pmd.pmd_name.txt md env in let (trem, rem, final_env) = transl_sig newenv srem in mksig (Tsig_module {md_id=id; md_name=pmd.pmd_name; md_type=tmty; - md_attributes=pmd.pmd_attributes} - ) env loc :: trem, + md_loc=pmd.pmd_loc; + md_attributes=pmd.pmd_attributes}) + env loc :: trem, Sig_module(id, md, Trec_not) :: rem, final_env | Psig_recmodule sdecls -> @@ -562,7 +583,9 @@ and transl_signature env sg = mksig (Tsig_recmodule decls) env loc :: trem, map_rec (fun rs md -> let d = {Types.md_type = md.md_type.mty_type; - md_attributes = md.md_attributes} in + md_attributes = md.md_attributes; + md_loc = md.md_loc; + } in Sig_module(md.md_id, d, rs)) decls rem, final_env @@ -650,13 +673,14 @@ and transl_signature env sg = sg and transl_modtype_decl modtype_names env loc - {pmtd_name; pmtd_type; pmtd_attributes} = + {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} = check "module type" loc modtype_names pmtd_name.txt; let tmty = Misc.may_map (transl_modtype env) pmtd_type in let decl = { - mtd_type=may_map (fun t -> t.mty_type) tmty; + Types.mtd_type=may_map (fun t -> t.mty_type) tmty; mtd_attributes=pmtd_attributes; + mtd_loc=pmtd_loc; } in let (id, newenv) = Env.enter_modtype pmtd_name.txt decl env in @@ -666,6 +690,7 @@ and transl_modtype_decl modtype_names env loc mtd_name=pmtd_name; mtd_type=tmty; mtd_attributes=pmtd_attributes; + mtd_loc=pmtd_loc; } in newenv, mtd, Sig_modtype(id, decl) @@ -673,15 +698,16 @@ and transl_modtype_decl modtype_names env loc and transl_recmodule_modtypes loc env sdecls = let make_env curr = List.fold_left - (fun env (id, _, mty) -> Env.add_module id mty env) + (fun env (id, _, mty) -> Env.add_module ~arg:true id mty env) env curr in let make_env2 curr = List.fold_left - (fun env (id, _, mty) -> Env.add_module id mty.mty_type env) + (fun env (id, _, mty) -> Env.add_module ~arg:true id mty.mty_type env) env curr in let transition env_c curr = List.map2 - (fun pmd (id, id_loc, mty) -> (id, id_loc, transl_modtype env_c pmd.pmd_type)) + (fun pmd (id, id_loc, mty) -> + (id, id_loc, transl_modtype env_c pmd.pmd_type)) sdecls curr in let ids = List.map (fun x -> Ident.create x.pmd_name.txt) sdecls in let approx_env = @@ -694,7 +720,7 @@ and transl_recmodule_modtypes loc env sdecls = List.fold_left (fun env id -> let dummy = Mty_ident (Path.Pident (Ident.create "#recmod#")) in - Env.add_module id dummy env + Env.add_module ~arg:true id dummy env ) env ids in @@ -721,6 +747,7 @@ and transl_recmodule_modtypes loc env sdecls = List.map2 (fun pmd (id, id_loc, mty) -> {md_id=id; md_name=id_loc; md_type=mty; + md_loc=pmd.pmd_loc; md_attributes=pmd.pmd_attributes}) sdecls dcl2 in @@ -735,12 +762,15 @@ let rec path_of_module mexp = Tmod_ident (p,_) -> p | Tmod_apply(funct, arg, coercion) when !Clflags.applicative_functors -> Papply(path_of_module funct, path_of_module arg) + | Tmod_constraint (mexp, _, _, _) -> + path_of_module mexp | _ -> raise Not_a_path (* Check that all core type schemes in a structure are closed *) let rec closed_modtype = function Mty_ident p -> true + | Mty_alias p -> true | Mty_signature sg -> List.for_all closed_signature_item sg | Mty_functor(id, param, body) -> closed_modtype body @@ -821,7 +851,7 @@ let check_recmodule_inclusion env bindings = (* Generate fresh names Y_i for the rec. bound module idents X_i *) let bindings1 = List.map - (fun (id, _, mty_decl, modl, mty_actual, _attrs) -> + (fun (id, _, mty_decl, modl, mty_actual, _attrs, _loc) -> (id, Ident.rename id, mty_actual)) bindings in (* Enter the Y_i in the environment with their actual types substituted @@ -833,7 +863,7 @@ let check_recmodule_inclusion env bindings = if first_time then mty_actual else subst_and_strengthen env s id mty_actual in - Env.add_module id' mty_actual' env) + Env.add_module ~arg:false id' mty_actual' env) env bindings1 in (* Build the output substitution Y_i <- X_i *) let s' = @@ -846,7 +876,7 @@ let check_recmodule_inclusion env bindings = end else begin (* Base case: check inclusion of s(mty_actual) in s(mty_decl) and insert coercion if needed *) - let check_inclusion (id, id_loc, mty_decl, modl, mty_actual, attrs) = + let check_inclusion (id, id_loc, mty_decl, modl, mty_actual, attrs, loc) = let mty_decl' = Subst.modtype s mty_decl.mty_type and mty_actual' = subst_and_strengthen env s id mty_actual in let coercion = @@ -867,6 +897,7 @@ let check_recmodule_inclusion env bindings = mb_name = id_loc; mb_expr = modl'; mb_attributes = attrs; + mb_loc = loc; } in List.map check_inclusion bindings @@ -916,6 +947,21 @@ let modtype_of_package env loc p nl tl = let error = Typetexp.Unbound_modtype (Ctype.lid_of_path p) in raise(Typetexp.Error(loc, env, error)) +let package_subtype env p1 nl1 tl1 p2 nl2 tl2 = + let mkmty p nl tl = + let ntl = + List.filter (fun (n,t) -> Ctype.free_variables t = []) + (List.combine nl tl) in + let (nl, tl) = List.split ntl in + modtype_of_package env Location.none p nl tl + in + let mty1 = mkmty p1 nl1 tl1 and mty2 = mkmty p2 nl2 tl2 in + try Includemod.modtypes env mty1 mty2 = Tcoerce_none + with Includemod.Error msg -> false + (* raise(Error(Location.none, env, Not_included msg)) *) + +let () = Ctype.package_subtype := package_subtype + let wrap_constraint env arg mty explicit = let coercion = try @@ -930,16 +976,31 @@ let wrap_constraint env arg mty explicit = (* Type a module value expression *) -let rec type_module sttn funct_body anchor env smod = +let rec type_module ?(alias=false) sttn funct_body anchor env smod = match smod.pmod_desc with Pmod_ident lid -> - let (path, md) = Typetexp.find_module env smod.pmod_loc lid.txt in - let mty = md.md_type in - rm { mod_desc = Tmod_ident (path, lid); - mod_type = if sttn then Mtype.strengthen env mty path else mty; - mod_env = env; - mod_attributes = smod.pmod_attributes; - mod_loc = smod.pmod_loc } + let path = Typetexp.find_module env smod.pmod_loc lid.txt in + let md = { mod_desc = Tmod_ident (path, lid); + mod_type = Mty_alias path; + mod_env = env; + mod_attributes = smod.pmod_attributes; + mod_loc = smod.pmod_loc } in + let md = + if alias && not (Env.is_functor_arg path env) then + (Env.add_required_global (Path.head path); md) + else match (Env.find_module path env).md_type with + Mty_alias p1 when not alias -> + let p1 = Env.normalize_path (Some smod.pmod_loc) env p1 in + let mty = Includemod.expand_module_alias env [] p1 in + { md with + mod_desc = Tmod_constraint (md, mty, Tmodtype_implicit, + Tcoerce_alias (p1, Tcoerce_none)); + mod_type = if sttn then Mtype.strengthen env mty p1 else mty } + | mty -> + let mty = + if sttn then Mtype.strengthen env mty path else mty in + { md with mod_type = mty } + in rm md | Pmod_structure sstr -> let (str, sg, finalenv) = type_structure funct_body anchor env sstr smod.pmod_loc in @@ -949,11 +1010,14 @@ let rec type_module sttn funct_body anchor env smod = 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 ~arg:true 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 } @@ -962,8 +1026,16 @@ let rec type_module sttn funct_body anchor env smod = let path = try Some (path_of_module arg) with Not_a_path -> None in let funct = type_module (sttn && path <> None) funct_body None env sfunct in - begin match Mtype.scrape env funct.mod_type with + begin match Env.scrape_alias 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,9 +1047,11 @@ let rec type_module sttn funct_body anchor env smod = 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 + (Env.add_module ~arg:true param arg.mod_type env) + param mty_res with Not_found -> raise(Error(smod.pmod_loc, env, Cannot_eliminate_dependency mty_functor)) @@ -991,7 +1065,7 @@ let rec type_module sttn funct_body anchor env smod = raise(Error(sfunct.pmod_loc, env, Cannot_apply funct.mod_type)) end | Pmod_constraint(sarg, smty) -> - let arg = type_module true funct_body anchor env sarg in + let arg = type_module ~alias true funct_body anchor env sarg in let mty = transl_modtype env smty in rm {(wrap_constraint env arg mty.mty_type (Tmodtype_explicit mty)) with mod_loc = smod.pmod_loc; @@ -999,8 +1073,6 @@ let rec type_module sttn funct_body anchor env smod = } | 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 +1097,8 @@ let rec type_module sttn funct_body anchor env smod = | _ -> 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; @@ -1046,8 +1120,9 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope = | Pstr_value(rec_flag, sdefs) -> let scope = match rec_flag with - | Recursive -> Some (Annot.Idef {scope with - Location.loc_start = loc.Location.loc_start}) + | Recursive -> + Some (Annot.Idef {scope with + Location.loc_start = loc.Location.loc_start}) | Nonrecursive -> let start = match srem with @@ -1085,59 +1160,78 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope = Tstr_exn_rebind(id, name, path, longid, attrs), [Sig_exception(id, arg)], newenv - | Pstr_module {pmb_name = name; pmb_expr = smodl; pmb_attributes = attrs} -> + | Pstr_module {pmb_name = name; pmb_expr = smodl; pmb_attributes = attrs; + pmb_loc; + } -> check "module" loc module_names name.txt; let modl = - type_module true funct_body (anchor_submodule name.txt anchor) env - smodl in + type_module ~alias:true true funct_body + (anchor_submodule name.txt anchor) env smodl in let md = { md_type = enrich_module_type anchor name.txt modl.mod_type env; md_attributes = attrs; + md_loc = pmb_loc; } in let (id, newenv) = Env.enter_module_declaration name.txt md env in - Tstr_module {mb_id=id; mb_name=name; mb_expr=modl;mb_attributes=attrs}, + Tstr_module {mb_id=id; mb_name=name; mb_expr=modl; + mb_attributes=attrs; mb_loc=pmb_loc; + }, [Sig_module(id, {md_type = modl.mod_type; - md_attributes = attrs}, Trec_not)], + md_attributes = attrs; + md_loc = pmb_loc; + }, Trec_not)], newenv | Pstr_recmodule sbind -> let sbind = List.map (function - | {pmb_name = name; pmb_expr = {pmod_desc=Pmod_constraint(expr, typ)}; pmb_attributes = attrs} -> - name, typ, expr, attrs + | {pmb_name = name; + pmb_expr = {pmod_desc=Pmod_constraint(expr, typ)}; + pmb_attributes = attrs; + pmb_loc = loc; + } -> + name, typ, expr, attrs, loc | mb -> - raise (Error (mb.pmb_expr.pmod_loc, env, Recursive_module_require_explicit_type)) + raise (Error (mb.pmb_expr.pmod_loc, env, + Recursive_module_require_explicit_type)) ) sbind in List.iter - (fun (name, _, _, _) -> check "module" loc module_names name.txt) + (fun (name, _, _, _, _) -> check "module" loc module_names name.txt) sbind; let (decls, newenv) = transl_recmodule_modtypes loc env - (List.map (fun (name, smty, smodl, attrs) -> - {pmd_name=name; pmd_type=smty; pmd_attributes=attrs}) sbind + (List.map (fun (name, smty, smodl, attrs, loc) -> + {pmd_name=name; pmd_type=smty; + pmd_attributes=attrs; pmd_loc=loc}) sbind ) in let bindings1 = List.map2 - (fun {md_id=id; md_type=mty} (name, _, smodl, attrs) -> + (fun {md_id=id; md_type=mty} (name, _, smodl, attrs, loc) -> let modl = type_module true funct_body (anchor_recmodule id anchor) newenv smodl in let mty' = enrich_module_type anchor (Ident.name id) modl.mod_type newenv in - (id, name, mty, modl, mty', attrs)) + (id, name, mty, modl, mty', attrs, loc)) decls sbind in + let newenv = (* allow aliasing recursive modules from outside *) + List.fold_left + (fun env md -> Env.add_module md.md_id md.md_type.mty_type env) + env decls + in let bindings2 = check_recmodule_inclusion newenv bindings1 in Tstr_recmodule bindings2, map_rec (fun rs mb -> Sig_module(mb.mb_id, { md_type=mb.mb_expr.mod_type; - md_attributes=mb.mb_attributes + md_attributes=mb.mb_attributes; + md_loc=mb.mb_loc; }, rs)) bindings2 [], newenv @@ -1203,6 +1297,27 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope = (* Rename all identifiers bound by this signature to avoid clashes *) let sg = Subst.signature Subst.identity (extract_sig_open env smodl.pmod_loc modl.mod_type) in + let sg = + match modl.mod_desc with + Tmod_ident (p, _) when not (Env.is_functor_arg p env) -> + Env.add_required_global (Path.head p); + let pos = ref 0 in + List.map + (function + | Sig_module (id, md, rs) -> + let n = !pos in incr pos; + Sig_module (id, {md with md_type = + Mty_alias (Pdot(p,Ident.name id,n))}, + rs) + | Sig_value (_, {val_kind=Val_reg}) | Sig_exception _ + | Sig_class _ as it -> + incr pos; it + | Sig_value _ | Sig_type _ | Sig_modtype _ + | Sig_class_type _ as it -> + it) + sg + | _ -> sg + in List.iter (check_sig_item type_names module_names modtype_names loc) sg; let new_env = Env.add_signature sg env in @@ -1237,7 +1352,9 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope = str, sg, final_env let type_toplevel_phrase env s = + Env.reset_required_globals (); type_structure ~toplevel:true false None env s Location.none +(*let type_module_alias = type_module ~alias:true true false None*) let type_module = type_module true false None let type_structure = type_structure false None @@ -1245,6 +1362,7 @@ let type_structure = type_structure false None let rec normalize_modtype env = function Mty_ident p -> () + | Mty_alias p -> () | Mty_signature sg -> normalize_signature env sg | Mty_functor(id, param, body) -> normalize_modtype env body @@ -1263,6 +1381,7 @@ and normalize_signature_item env = function let rec simplify_modtype mty = match mty with Mty_ident path -> mty + | Mty_alias path -> mty | Mty_functor(id, arg, res) -> Mty_functor(id, arg, simplify_modtype res) | Mty_signature sg -> Mty_signature(simplify_signature sg) @@ -1294,7 +1413,8 @@ let type_module_type_of env smod = let tmty = match smod.pmod_desc with | Pmod_ident lid -> (* turn off strengthening in this case *) - let (path, md) = Typetexp.find_module env smod.pmod_loc lid.txt in + let path = Typetexp.find_module env smod.pmod_loc lid.txt in + let md = Env.find_module path env in rm { mod_desc = Tmod_ident (path, lid); mod_type = md.md_type; mod_env = env; @@ -1302,6 +1422,8 @@ let type_module_type_of env smod = mod_loc = smod.pmod_loc } | _ -> type_module env smod in let mty = tmty.mod_type in + (* PR#6307: expand aliases at root and submodules *) + let mty = Mtype.remove_aliases env mty in (* PR#5037: clean up inferred signature to remove duplicate specs *) let mty = simplify_modtype mty in (* PR#5036: must not contain non-generalized type variables *) @@ -1331,7 +1453,7 @@ let type_package env m p nl tl = match modl.mod_desc with Tmod_ident (mp,_) -> (mp, env) | _ -> - let (id, new_env) = Env.enter_module "%M" modl.mod_type env in + let (id, new_env) = Env.enter_module ~arg:true "%M" modl.mod_type env in (Pident id, new_env) in let rec mkpath mp = function @@ -1340,7 +1462,9 @@ let type_package env m p nl tl = | _ -> assert false in let tl' = - List.map (fun name -> Ctype.newconstr (mkpath mp name) []) nl in + List.map + (fun name -> Btype.newgenty (Tconstr (mkpath mp name,[],ref Mnil))) + nl in (* go back to original level *) Ctype.end_def (); if nl = [] then @@ -1359,16 +1483,17 @@ let () = Typecore.type_module := type_module; Typetexp.transl_modtype_longident := transl_modtype_longident; Typetexp.transl_modtype := transl_modtype; - Typecore.type_open := type_open; + Typecore.type_open := type_open ?toplevel:None; Typecore.type_package := type_package; type_module_type_of_fwd := type_module_type_of (* Typecheck an implementation file *) let type_implementation sourcefile outputprefix modulename initial_env ast = - Cmt_format.set_saved_types []; + Cmt_format.clear (); try Typecore.reset_delayed_checks (); + Env.reset_required_globals (); let (str, sg, finalenv) = type_structure initial_env ast (Location.in_file sourcefile) in let simple_sg = simplify_signature sg in @@ -1438,7 +1563,9 @@ let rec package_signatures subst = function let oldid = Ident.create_persistent name and newid = Ident.create name in Sig_module(newid, {md_type=Mty_signature sg'; - md_attributes=[]}, + md_attributes=[]; + md_loc=Location.none; + }, Trec_not) :: package_signatures (Subst.add_module oldid (Pident newid) subst) rem @@ -1549,7 +1676,8 @@ let report_error ppf = function 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 +1698,8 @@ let report_error ppf = function 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) diff --git a/typing/typemod.mli b/typing/typemod.mli index 20868d33f7..051a283609 100644 --- a/typing/typemod.mli +++ b/typing/typemod.mli @@ -60,6 +60,7 @@ type error = | 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 diff --git a/typing/types.ml b/typing/types.ml index 20fa3836ea..dc159cd09e 100644 --- a/typing/types.ml +++ b/typing/types.ml @@ -264,7 +264,8 @@ type class_type_declaration = 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 + | Mty_alias of Path.t and signature = signature_item list @@ -281,12 +282,14 @@ and module_declaration = { md_type: module_type; md_attributes: Parsetree.attributes; + md_loc: Location.t; } and modtype_declaration = { mtd_type: module_type option; (* Nonte: abstract *) mtd_attributes: Parsetree.attributes; + mtd_loc: Location.t; } and rec_status = diff --git a/typing/types.mli b/typing/types.mli index 62fad9653f..b53cf913e3 100644 --- a/typing/types.mli +++ b/typing/types.mli @@ -251,7 +251,8 @@ type class_type_declaration = 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 + | Mty_alias of Path.t and signature = signature_item list @@ -268,12 +269,14 @@ and module_declaration = { md_type: module_type; md_attributes: Parsetree.attributes; + md_loc: Location.t; } and modtype_declaration = { - mtd_type: module_type option; (* Nonte: abstract *) + mtd_type: module_type option; (* None: abstract *) mtd_attributes: Parsetree.attributes; + mtd_loc: Location.t; } and rec_status = diff --git a/typing/typetexp.ml b/typing/typetexp.ml index e6b6dfdebf..7af01dc3eb 100644 --- a/typing/typetexp.ml +++ b/typing/typetexp.ml @@ -69,7 +69,8 @@ let warning_attribute attrs = (function | ({txt = "warning"; loc}, payload) -> begin match payload with - | PStr [{pstr_desc=Pstr_eval({pexp_desc=Pexp_constant(Const_string(s, _))}, _)}] -> + | PStr [{pstr_desc=Pstr_eval + ({pexp_desc=Pexp_constant(Const_string(s, _))}, _)}] -> if !prev_warnings = None then prev_warnings := Some (Warnings.backup ()); begin try Warnings.parse_options false s @@ -166,10 +167,11 @@ let find_value env loc lid = let find_module env loc lid = let (path, decl) as r = - find_component Env.lookup_module (fun lid -> Unbound_module lid) env loc lid + find_component (fun lid env -> (Env.lookup_module lid env, ())) + (fun lid -> Unbound_module lid) env loc lid in - check_deprecated loc decl.md_attributes (Path.name path); - r + (* check_deprecated loc decl.md_attributes (Path.name path); *) + path let find_modtype env loc lid = let (path, decl) as r = @@ -206,7 +208,7 @@ let create_package_mty fake loc env (p, l) = (fun (s1, t1) (s2, t2) -> if s1.txt = s2.txt then raise (Error (loc, env, Multiple_constraints_on_type s1.txt)); - compare s1 s2) + compare s1.txt s2.txt) l in l, @@ -220,7 +222,8 @@ let create_package_mty fake loc env (p, l) = ptype_manifest = if fake then None else Some t; ptype_attributes = []; ptype_loc = loc} in - Ast_helper.Mty.mk ~loc (Pmty_with (mty, [ Pwith_type ({ txt = s.txt; loc }, d) ])) + Ast_helper.Mty.mk ~loc + (Pmty_with (mty, [ Pwith_type ({ txt = s.txt; loc }, d) ])) ) (Ast_helper.Mty.mk ~loc (Pmty_ident p)) l @@ -290,7 +293,8 @@ type policy = Fixed | Extensible | Univars let rec transl_type env policy styp = let loc = styp.ptyp_loc in let ctyp ctyp_desc ctyp_type = - { ctyp_desc; ctyp_type; ctyp_env = env; ctyp_loc = loc; ctyp_attributes = styp.ptyp_attributes } + { ctyp_desc; ctyp_type; ctyp_env = env; + ctyp_loc = loc; ctyp_attributes = styp.ptyp_attributes } in match styp.ptyp_desc with Ptyp_any -> diff --git a/typing/typetexp.mli b/typing/typetexp.mli index d475b03e2d..1d90eb7591 100644 --- a/typing/typetexp.mli +++ b/typing/typetexp.mli @@ -95,7 +95,7 @@ val find_value: val find_class: Env.t -> Location.t -> Longident.t -> Path.t * class_declaration val find_module: - Env.t -> Location.t -> Longident.t -> Path.t * module_declaration + Env.t -> Location.t -> Longident.t -> Path.t val find_modtype: Env.t -> Location.t -> Longident.t -> Path.t * modtype_declaration val find_class_type: diff --git a/utils/clflags.ml b/utils/clflags.ml index b44b7491f3..829393a00d 100644 --- a/utils/clflags.ml +++ b/utils/clflags.ml @@ -58,6 +58,7 @@ and dllpaths = ref ([] : string list) (* -dllpath *) and make_package = ref false (* -pack *) and for_package = ref (None: string option) (* -for-pack *) and error_size = ref 500 (* -error-size *) +and transparent_modules = ref false (* -trans-mod *) let dump_source = ref false (* -dsource *) let dump_parsetree = ref false (* -dparsetree *) and dump_typedtree = ref false (* -dtypedtree *) diff --git a/utils/clflags.mli b/utils/clflags.mli index 038c3aacba..876776acdb 100644 --- a/utils/clflags.mli +++ b/utils/clflags.mli @@ -55,6 +55,7 @@ val dllpaths : string list ref val make_package : bool ref val for_package : string option ref val error_size : int ref +val transparent_modules : bool ref val dump_source : bool ref val dump_parsetree : bool ref val dump_typedtree : bool ref diff --git a/utils/config.mlp b/utils/config.mlp index 874db44a4b..e16ef29988 100644 --- a/utils/config.mlp +++ b/utils/config.mlp @@ -52,12 +52,12 @@ let exec_magic_number = "Caml1999X010" and cmi_magic_number = "Caml1999I016" and cmo_magic_number = "Caml1999O008" and cma_magic_number = "Caml1999A009" -and cmx_magic_number = "Caml1999Y011" -and cmxa_magic_number = "Caml1999Z010" +and cmx_magic_number = "Caml1999Y012" +and cmxa_magic_number = "Caml1999Z011" and ast_impl_magic_number = "Caml1999M016" and ast_intf_magic_number = "Caml1999N015" and cmxs_magic_number = "Caml2007D001" -and cmt_magic_number = "Caml2012T002" +and cmt_magic_number = "Caml2012T003" let load_path = ref ([] : string list) diff --git a/utils/warnings.ml b/utils/warnings.ml index 3a4e0912f3..58d2753962 100644 --- a/utils/warnings.ml +++ b/utils/warnings.ml @@ -65,6 +65,7 @@ type t = | Open_shadow_label_constructor of string * string (* 45 *) | Bad_env_variable of string * string (* 46 *) | Attribute_payload of string * string (* 47 *) + | Eliminated_optional_arguments of string list (* 48 *) ;; (* If you remove a warning, leave a hole in the numbering. NEVER change @@ -121,9 +122,10 @@ let number = function | Open_shadow_label_constructor _ -> 45 | Bad_env_variable _ -> 46 | Attribute_payload _ -> 47 + | Eliminated_optional_arguments _ -> 48 ;; -let last_warning_number = 47 +let last_warning_number = 48 (* Must be the max number returned by the [number] function. *) let letter = function @@ -226,7 +228,7 @@ let parse_opt flags s = let parse_options errflag s = parse_opt (if errflag then error else active) s;; (* 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";; +let defaults_w = "+a-4-6-7-9-27-29-32..39-41..42-44-45-48";; let defaults_warn_error = "-a";; let () = parse_options false defaults_w;; @@ -360,6 +362,10 @@ let message = function Printf.sprintf "illegal environment variable %s : %s" var s | Attribute_payload (a, s) -> Printf.sprintf "illegal payload for attribute '%s'.\n%s" a s + | Eliminated_optional_arguments sl -> + Printf.sprintf "implicit elimination of optional argument%s %s" + (if List.length sl = 1 then "" else "s") + (String.concat ", " sl) ;; let nerrors = ref 0;; @@ -453,6 +459,7 @@ let descriptions = 45, "Open statement shadows an already defined label or constructor."; 46, "Illegal environment variable"; 47, "Illegal attribute payload"; + 48, "Implicit elimination of optional arguments"; ] ;; diff --git a/utils/warnings.mli b/utils/warnings.mli index a7c3abd40e..05bf66bdea 100644 --- a/utils/warnings.mli +++ b/utils/warnings.mli @@ -60,6 +60,7 @@ type t = | Open_shadow_label_constructor of string * string (* 45 *) | Bad_env_variable of string * string (* 46 *) | Attribute_payload of string * string (* 47 *) + | Eliminated_optional_arguments of string list (* 48 *) ;; val parse_options : bool -> string -> unit;; diff --git a/yacc/main.c b/yacc/main.c index f6cac60d45..d2f329310d 100644 --- a/yacc/main.c +++ b/yacc/main.c @@ -32,10 +32,12 @@ char big_endian; char *file_prefix = 0; char *myname = "yacc"; +char temp_form[] = "yacc.XXXXXXX"; + #ifdef NO_UNIX -char temp_form[] = "yacc.X"; +char dirsep = '\\'; #else -char temp_form[] = "yacc.XXXXXXX"; +char dirsep = '/'; #endif int lineno; @@ -102,7 +104,9 @@ char *nullable; #if !defined(HAVE_MKSTEMP) extern char *mktemp(char *); #endif +#ifndef NO_UNIX extern char *getenv(const char *); +#endif void done(int k) @@ -277,16 +281,16 @@ void create_file_names(void) char *tmpdir; #ifdef NO_UNIX - len = 0; - i = sizeof(temp_form); + tmpdir = getenv("TEMP"); + if (tmpdir == 0) tmpdir = "."; #else tmpdir = getenv("TMPDIR"); if (tmpdir == 0) tmpdir = "/tmp"; +#endif len = strlen(tmpdir); i = len + sizeof(temp_form); - if (len && tmpdir[len-1] != '/') + if (len && tmpdir[len-1] != dirsep) ++i; -#endif action_file_name = MALLOC(i); if (action_file_name == 0) no_space(); @@ -297,21 +301,19 @@ void create_file_names(void) union_file_name = MALLOC(i); if (union_file_name == 0) no_space(); -#ifndef NO_UNIX strcpy(action_file_name, tmpdir); strcpy(entry_file_name, tmpdir); strcpy(text_file_name, tmpdir); strcpy(union_file_name, tmpdir); - if (len && tmpdir[len - 1] != '/') + if (len && tmpdir[len - 1] != dirsep) { - action_file_name[len] = '/'; - entry_file_name[len] = '/'; - text_file_name[len] = '/'; - union_file_name[len] = '/'; + action_file_name[len] = dirsep; + entry_file_name[len] = dirsep; + text_file_name[len] = dirsep; + union_file_name[len] = dirsep; ++len; } -#endif strcpy(action_file_name + len, temp_form); strcpy(entry_file_name + len, temp_form); @@ -323,7 +325,6 @@ void create_file_names(void) text_file_name[len + 5] = 't'; union_file_name[len + 5] = 'u'; -#ifndef NO_UNIX #ifdef HAVE_MKSTEMP action_fd = mkstemp(action_file_name); if (action_fd == -1) @@ -343,7 +344,6 @@ void create_file_names(void) mktemp(text_file_name); mktemp(union_file_name); #endif -#endif len = strlen(file_prefix); |