pax_global_header00006660000000000000000000000064147313437720014525gustar00rootroot0000000000000052 comment=47e8a7c1082ce4e3004794931fd48259a364a5e4 camlp4-5.3-1/000077500000000000000000000000001473134377200127125ustar00rootroot00000000000000camlp4-5.3-1/.depend000066400000000000000000001672341473134377200141670ustar00rootroot00000000000000utils/ccomp.cmi : utils/clflags.cmi : utils/config.cmi : utils/consistbl.cmi : utils/misc.cmi : utils/tbl.cmi : utils/terminfo.cmi : utils/warnings.cmi : utils/ccomp.cmo : utils/misc.cmi utils/config.cmi utils/clflags.cmi \ utils/ccomp.cmi utils/ccomp.cmx : utils/misc.cmx utils/config.cmx utils/clflags.cmx \ utils/ccomp.cmi utils/clflags.cmo : utils/config.cmi utils/clflags.cmi utils/clflags.cmx : utils/config.cmx utils/clflags.cmi utils/config.cmo : utils/config.cmi utils/config.cmx : utils/config.cmi utils/consistbl.cmo : utils/consistbl.cmi utils/consistbl.cmx : utils/consistbl.cmi utils/misc.cmo : utils/misc.cmi utils/misc.cmx : utils/misc.cmi utils/tbl.cmo : utils/tbl.cmi utils/tbl.cmx : utils/tbl.cmi utils/terminfo.cmo : utils/terminfo.cmi utils/terminfo.cmx : utils/terminfo.cmi utils/warnings.cmo : utils/warnings.cmi utils/warnings.cmx : utils/warnings.cmi parsing/ast_helper.cmi : parsing/parsetree.cmi parsing/longident.cmi \ parsing/location.cmi parsing/asttypes.cmi parsing/ast_mapper.cmi : parsing/parsetree.cmi parsing/location.cmi parsing/asttypes.cmi : parsing/location.cmi parsing/lexer.cmi : parsing/parser.cmi parsing/location.cmi parsing/location.cmi : utils/warnings.cmi parsing/longident.cmi : parsing/parse.cmi : parsing/parsetree.cmi parsing/parser.cmi : parsing/parsetree.cmi parsing/location.cmi parsing/parsetree.cmi : parsing/longident.cmi parsing/location.cmi \ parsing/asttypes.cmi parsing/pprintast.cmi : parsing/parsetree.cmi parsing/longident.cmi \ parsing/asttypes.cmi parsing/printast.cmi : parsing/parsetree.cmi parsing/syntaxerr.cmi : parsing/location.cmi parsing/ast_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/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 \ parsing/location.cmi parsing/longident.cmo : utils/misc.cmi parsing/longident.cmi parsing/longident.cmx : utils/misc.cmx parsing/longident.cmi parsing/parse.cmo : parsing/syntaxerr.cmi parsing/parser.cmi \ parsing/location.cmi parsing/lexer.cmi parsing/parse.cmi parsing/parse.cmx : parsing/syntaxerr.cmx parsing/parser.cmx \ parsing/location.cmx parsing/lexer.cmx parsing/parse.cmi parsing/parser.cmo : parsing/syntaxerr.cmi parsing/parsetree.cmi \ parsing/longident.cmi parsing/location.cmi utils/clflags.cmi \ parsing/asttypes.cmi parsing/ast_helper.cmi parsing/parser.cmi parsing/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/syntaxerr.cmo : parsing/location.cmi parsing/syntaxerr.cmi parsing/syntaxerr.cmx : parsing/location.cmx parsing/syntaxerr.cmi typing/annot.cmi : parsing/location.cmi typing/btype.cmi : typing/types.cmi typing/path.cmi parsing/asttypes.cmi typing/cmi_format.cmi : typing/types.cmi typing/cmt_format.cmi : typing/types.cmi typing/typedtree.cmi \ parsing/location.cmi typing/env.cmi typing/cmi_format.cmi typing/ctype.cmi : typing/types.cmi typing/path.cmi parsing/longident.cmi \ typing/ident.cmi typing/env.cmi parsing/asttypes.cmi typing/datarepr.cmi : typing/types.cmi typing/path.cmi typing/ident.cmi \ parsing/asttypes.cmi typing/env.cmi : utils/warnings.cmi typing/types.cmi typing/subst.cmi \ typing/path.cmi parsing/longident.cmi parsing/location.cmi \ typing/ident.cmi utils/consistbl.cmi parsing/asttypes.cmi typing/envaux.cmi : typing/subst.cmi typing/path.cmi typing/env.cmi typing/ident.cmi : typing/includeclass.cmi : typing/types.cmi typing/env.cmi typing/ctype.cmi typing/includecore.cmi : typing/types.cmi typing/typedtree.cmi \ typing/ident.cmi typing/env.cmi typing/includemod.cmi : typing/types.cmi typing/typedtree.cmi \ typing/path.cmi typing/includecore.cmi typing/ident.cmi typing/env.cmi \ typing/ctype.cmi typing/mtype.cmi : typing/types.cmi typing/path.cmi typing/ident.cmi \ typing/env.cmi typing/oprint.cmi : typing/outcometree.cmi typing/outcometree.cmi : parsing/asttypes.cmi typing/parmatch.cmi : typing/types.cmi typing/typedtree.cmi \ parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \ typing/env.cmi parsing/asttypes.cmi typing/path.cmi : typing/ident.cmi typing/predef.cmi : typing/types.cmi typing/path.cmi typing/ident.cmi typing/primitive.cmi : typing/printtyp.cmi : typing/types.cmi typing/path.cmi \ typing/outcometree.cmi parsing/longident.cmi typing/ident.cmi \ typing/env.cmi typing/printtyped.cmi : typing/typedtree.cmi typing/stypes.cmi : typing/typedtree.cmi parsing/location.cmi \ typing/annot.cmi typing/subst.cmi : typing/types.cmi typing/path.cmi typing/ident.cmi typing/typeclass.cmi : typing/types.cmi typing/typedtree.cmi \ parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \ typing/ident.cmi typing/env.cmi typing/ctype.cmi parsing/asttypes.cmi typing/typecore.cmi : typing/types.cmi typing/typedtree.cmi typing/path.cmi \ parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \ typing/ident.cmi typing/env.cmi parsing/asttypes.cmi typing/annot.cmi typing/typedecl.cmi : typing/types.cmi typing/typedtree.cmi typing/path.cmi \ parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \ typing/includecore.cmi typing/ident.cmi typing/env.cmi typing/typedtree.cmi : typing/types.cmi typing/primitive.cmi typing/path.cmi \ parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \ typing/ident.cmi typing/env.cmi parsing/asttypes.cmi typing/typedtreeIter.cmi : typing/typedtree.cmi parsing/asttypes.cmi typing/typedtreeMap.cmi : typing/typedtree.cmi typing/typemod.cmi : typing/types.cmi typing/typedtree.cmi \ parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \ typing/includemod.cmi typing/ident.cmi typing/env.cmi typing/types.cmi : typing/primitive.cmi typing/path.cmi \ 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/btype.cmo : typing/types.cmi typing/path.cmi utils/misc.cmi \ typing/ident.cmi typing/btype.cmi typing/btype.cmx : typing/types.cmx typing/path.cmx utils/misc.cmx \ typing/ident.cmx typing/btype.cmi typing/cmi_format.cmo : typing/types.cmi utils/misc.cmi parsing/location.cmi \ utils/config.cmi typing/cmi_format.cmi typing/cmi_format.cmx : typing/types.cmx utils/misc.cmx parsing/location.cmx \ utils/config.cmx typing/cmi_format.cmi typing/cmt_format.cmo : typing/types.cmi typing/typedtreeMap.cmi \ typing/typedtree.cmi utils/misc.cmi parsing/location.cmi \ parsing/lexer.cmi typing/env.cmi utils/config.cmi typing/cmi_format.cmi \ utils/clflags.cmi typing/cmt_format.cmi typing/cmt_format.cmx : typing/types.cmx typing/typedtreeMap.cmx \ typing/typedtree.cmx utils/misc.cmx parsing/location.cmx \ parsing/lexer.cmx typing/env.cmx utils/config.cmx typing/cmi_format.cmx \ utils/clflags.cmx typing/cmt_format.cmi typing/ctype.cmo : typing/types.cmi typing/subst.cmi typing/path.cmi \ utils/misc.cmi parsing/longident.cmi parsing/location.cmi \ typing/ident.cmi typing/env.cmi utils/clflags.cmi typing/btype.cmi \ parsing/asttypes.cmi typing/ctype.cmi typing/ctype.cmx : typing/types.cmx typing/subst.cmx typing/path.cmx \ utils/misc.cmx parsing/longident.cmx parsing/location.cmx \ typing/ident.cmx typing/env.cmx utils/clflags.cmx typing/btype.cmx \ parsing/asttypes.cmi typing/ctype.cmi typing/datarepr.cmo : typing/types.cmi typing/predef.cmi typing/path.cmi \ parsing/location.cmi typing/ident.cmi typing/btype.cmi \ parsing/asttypes.cmi typing/datarepr.cmi typing/datarepr.cmx : typing/types.cmx typing/predef.cmx typing/path.cmx \ parsing/location.cmx typing/ident.cmx typing/btype.cmx \ parsing/asttypes.cmi typing/datarepr.cmi typing/env.cmo : utils/warnings.cmi typing/types.cmi utils/tbl.cmi \ typing/subst.cmi typing/predef.cmi typing/path.cmi utils/misc.cmi \ parsing/longident.cmi parsing/location.cmi typing/ident.cmi \ typing/datarepr.cmi utils/consistbl.cmi utils/config.cmi \ typing/cmi_format.cmi utils/clflags.cmi typing/btype.cmi \ parsing/asttypes.cmi typing/env.cmi typing/env.cmx : utils/warnings.cmx typing/types.cmx utils/tbl.cmx \ typing/subst.cmx typing/predef.cmx typing/path.cmx utils/misc.cmx \ parsing/longident.cmx parsing/location.cmx typing/ident.cmx \ typing/datarepr.cmx utils/consistbl.cmx utils/config.cmx \ typing/cmi_format.cmx utils/clflags.cmx typing/btype.cmx \ parsing/asttypes.cmi typing/env.cmi typing/envaux.cmo : typing/types.cmi typing/subst.cmi typing/printtyp.cmi \ typing/path.cmi typing/mtype.cmi utils/misc.cmi typing/env.cmi \ parsing/asttypes.cmi typing/envaux.cmi typing/envaux.cmx : typing/types.cmx typing/subst.cmx typing/printtyp.cmx \ typing/path.cmx typing/mtype.cmx utils/misc.cmx typing/env.cmx \ parsing/asttypes.cmi typing/envaux.cmi typing/ident.cmo : typing/ident.cmi typing/ident.cmx : typing/ident.cmi typing/includeclass.cmo : typing/types.cmi typing/printtyp.cmi \ typing/ctype.cmi typing/includeclass.cmi typing/includeclass.cmx : typing/types.cmx typing/printtyp.cmx \ typing/ctype.cmx typing/includeclass.cmi typing/includecore.cmo : typing/types.cmi typing/typedtree.cmi \ typing/predef.cmi typing/path.cmi utils/misc.cmi typing/ident.cmi \ typing/env.cmi typing/ctype.cmi typing/btype.cmi parsing/asttypes.cmi \ typing/includecore.cmi typing/includecore.cmx : typing/types.cmx typing/typedtree.cmx \ typing/predef.cmx typing/path.cmx utils/misc.cmx typing/ident.cmx \ typing/env.cmx typing/ctype.cmx typing/btype.cmx parsing/asttypes.cmi \ typing/includecore.cmi typing/includemod.cmo : typing/types.cmi typing/typedtree.cmi utils/tbl.cmi \ typing/subst.cmi typing/printtyp.cmi typing/path.cmi typing/mtype.cmi \ utils/misc.cmi parsing/location.cmi typing/includecore.cmi \ typing/includeclass.cmi typing/ident.cmi typing/env.cmi typing/ctype.cmi \ utils/clflags.cmi typing/includemod.cmi typing/includemod.cmx : typing/types.cmx typing/typedtree.cmx utils/tbl.cmx \ typing/subst.cmx typing/printtyp.cmx typing/path.cmx typing/mtype.cmx \ utils/misc.cmx parsing/location.cmx typing/includecore.cmx \ typing/includeclass.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \ utils/clflags.cmx typing/includemod.cmi typing/mtype.cmo : typing/types.cmi typing/subst.cmi typing/path.cmi \ typing/ident.cmi typing/env.cmi typing/ctype.cmi utils/clflags.cmi \ typing/btype.cmi parsing/asttypes.cmi typing/mtype.cmi typing/mtype.cmx : typing/types.cmx typing/subst.cmx typing/path.cmx \ typing/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 \ typing/oprint.cmi typing/parmatch.cmo : utils/warnings.cmi typing/types.cmi \ typing/typedtree.cmi typing/subst.cmi typing/predef.cmi typing/path.cmi \ parsing/parsetree.cmi utils/misc.cmi parsing/longident.cmi \ parsing/location.cmi typing/ident.cmi typing/env.cmi typing/datarepr.cmi \ typing/ctype.cmi typing/btype.cmi parsing/asttypes.cmi \ parsing/ast_helper.cmi typing/parmatch.cmi typing/parmatch.cmx : utils/warnings.cmx typing/types.cmx \ typing/typedtree.cmx typing/subst.cmx typing/predef.cmx typing/path.cmx \ parsing/parsetree.cmi utils/misc.cmx parsing/longident.cmx \ parsing/location.cmx typing/ident.cmx typing/env.cmx typing/datarepr.cmx \ typing/ctype.cmx typing/btype.cmx parsing/asttypes.cmi \ parsing/ast_helper.cmx typing/parmatch.cmi typing/path.cmo : typing/ident.cmi typing/path.cmi typing/path.cmx : typing/ident.cmx typing/path.cmi typing/predef.cmo : typing/types.cmi typing/path.cmi parsing/location.cmi \ typing/ident.cmi typing/btype.cmi parsing/asttypes.cmi typing/predef.cmi typing/predef.cmx : typing/types.cmx typing/path.cmx parsing/location.cmx \ typing/ident.cmx typing/btype.cmx parsing/asttypes.cmi typing/predef.cmi typing/primitive.cmo : utils/misc.cmi typing/primitive.cmi typing/primitive.cmx : utils/misc.cmx typing/primitive.cmi typing/printtyp.cmo : typing/types.cmi typing/primitive.cmi \ typing/predef.cmi typing/path.cmi typing/outcometree.cmi \ typing/oprint.cmi utils/misc.cmi parsing/longident.cmi \ parsing/location.cmi typing/ident.cmi typing/env.cmi typing/ctype.cmi \ utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \ typing/printtyp.cmi typing/printtyp.cmx : typing/types.cmx typing/primitive.cmx \ typing/predef.cmx typing/path.cmx typing/outcometree.cmi \ typing/oprint.cmx utils/misc.cmx parsing/longident.cmx \ parsing/location.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \ utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \ typing/printtyp.cmi typing/printtyped.cmo : typing/typedtree.cmi parsing/printast.cmi \ typing/path.cmi 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/ident.cmx parsing/asttypes.cmi typing/printtyped.cmi typing/stypes.cmo : typing/typedtree.cmi typing/printtyp.cmi \ parsing/location.cmi utils/clflags.cmi typing/annot.cmi typing/stypes.cmi typing/stypes.cmx : typing/typedtree.cmx typing/printtyp.cmx \ parsing/location.cmx utils/clflags.cmx typing/annot.cmi typing/stypes.cmi typing/subst.cmo : typing/types.cmi utils/tbl.cmi typing/path.cmi \ utils/misc.cmi parsing/location.cmi typing/ident.cmi utils/clflags.cmi \ typing/btype.cmi parsing/ast_mapper.cmi typing/subst.cmi typing/subst.cmx : typing/types.cmx utils/tbl.cmx typing/path.cmx \ utils/misc.cmx parsing/location.cmx typing/ident.cmx utils/clflags.cmx \ typing/btype.cmx parsing/ast_mapper.cmx typing/subst.cmi typing/typeclass.cmo : utils/warnings.cmi typing/typetexp.cmi \ typing/types.cmi typing/typedtree.cmi typing/typedecl.cmi \ typing/typecore.cmi typing/subst.cmi typing/stypes.cmi \ typing/printtyp.cmi typing/predef.cmi typing/path.cmi \ parsing/parsetree.cmi typing/parmatch.cmi utils/misc.cmi \ parsing/longident.cmi parsing/location.cmi typing/includeclass.cmi \ typing/ident.cmi typing/env.cmi typing/ctype.cmi typing/cmt_format.cmi \ utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \ parsing/ast_helper.cmi typing/typeclass.cmi typing/typeclass.cmx : utils/warnings.cmx typing/typetexp.cmx \ typing/types.cmx typing/typedtree.cmx typing/typedecl.cmx \ typing/typecore.cmx typing/subst.cmx typing/stypes.cmx \ typing/printtyp.cmx typing/predef.cmx typing/path.cmx \ parsing/parsetree.cmi typing/parmatch.cmx utils/misc.cmx \ parsing/longident.cmx parsing/location.cmx typing/includeclass.cmx \ typing/ident.cmx typing/env.cmx typing/ctype.cmx typing/cmt_format.cmx \ utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \ parsing/ast_helper.cmx typing/typeclass.cmi typing/typecore.cmo : utils/warnings.cmi typing/typetexp.cmi \ typing/types.cmi typing/typedtree.cmi typing/subst.cmi typing/stypes.cmi \ typing/printtyp.cmi typing/primitive.cmi typing/predef.cmi \ typing/path.cmi parsing/parsetree.cmi typing/parmatch.cmi \ typing/oprint.cmi utils/misc.cmi parsing/longident.cmi \ parsing/location.cmi typing/ident.cmi typing/env.cmi typing/ctype.cmi \ typing/cmt_format.cmi utils/clflags.cmi typing/btype.cmi \ parsing/asttypes.cmi parsing/ast_helper.cmi typing/annot.cmi \ typing/typecore.cmi typing/typecore.cmx : utils/warnings.cmx typing/typetexp.cmx \ typing/types.cmx typing/typedtree.cmx typing/subst.cmx typing/stypes.cmx \ typing/printtyp.cmx typing/primitive.cmx typing/predef.cmx \ typing/path.cmx parsing/parsetree.cmi typing/parmatch.cmx \ typing/oprint.cmx utils/misc.cmx parsing/longident.cmx \ parsing/location.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \ typing/cmt_format.cmx utils/clflags.cmx typing/btype.cmx \ parsing/asttypes.cmi parsing/ast_helper.cmx typing/annot.cmi \ typing/typecore.cmi typing/typedecl.cmo : utils/warnings.cmi typing/typetexp.cmi \ typing/types.cmi typing/typedtree.cmi typing/subst.cmi \ typing/printtyp.cmi typing/primitive.cmi typing/predef.cmi \ typing/path.cmi parsing/parsetree.cmi utils/misc.cmi \ parsing/longident.cmi parsing/location.cmi typing/includecore.cmi \ typing/ident.cmi typing/env.cmi typing/ctype.cmi utils/config.cmi \ utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \ parsing/ast_helper.cmi typing/typedecl.cmi typing/typedecl.cmx : utils/warnings.cmx typing/typetexp.cmx \ typing/types.cmx typing/typedtree.cmx typing/subst.cmx \ typing/printtyp.cmx typing/primitive.cmx typing/predef.cmx \ typing/path.cmx parsing/parsetree.cmi utils/misc.cmx \ parsing/longident.cmx parsing/location.cmx typing/includecore.cmx \ typing/ident.cmx typing/env.cmx typing/ctype.cmx utils/config.cmx \ utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \ parsing/ast_helper.cmx typing/typedecl.cmi typing/typedtree.cmo : typing/types.cmi typing/primitive.cmi typing/path.cmi \ parsing/parsetree.cmi utils/misc.cmi parsing/longident.cmi \ parsing/location.cmi typing/ident.cmi typing/env.cmi parsing/asttypes.cmi \ typing/typedtree.cmi typing/typedtree.cmx : typing/types.cmx typing/primitive.cmx typing/path.cmx \ parsing/parsetree.cmi utils/misc.cmx parsing/longident.cmx \ parsing/location.cmx typing/ident.cmx typing/env.cmx parsing/asttypes.cmi \ typing/typedtree.cmi typing/typedtreeIter.cmo : typing/typedtree.cmi parsing/asttypes.cmi \ typing/typedtreeIter.cmi typing/typedtreeIter.cmx : typing/typedtree.cmx parsing/asttypes.cmi \ typing/typedtreeIter.cmi typing/typedtreeMap.cmo : typing/typedtree.cmi utils/misc.cmi \ typing/typedtreeMap.cmi typing/typedtreeMap.cmx : typing/typedtree.cmx utils/misc.cmx \ typing/typedtreeMap.cmi typing/typemod.cmo : utils/warnings.cmi typing/typetexp.cmi typing/types.cmi \ typing/typedtree.cmi typing/typedecl.cmi typing/typecore.cmi \ typing/typeclass.cmi typing/subst.cmi typing/stypes.cmi \ typing/printtyp.cmi typing/path.cmi parsing/parsetree.cmi \ typing/mtype.cmi utils/misc.cmi parsing/longident.cmi \ parsing/location.cmi typing/includemod.cmi typing/ident.cmi \ typing/env.cmi typing/ctype.cmi utils/config.cmi typing/cmt_format.cmi \ utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi typing/annot.cmi \ typing/typemod.cmi typing/typemod.cmx : utils/warnings.cmx typing/typetexp.cmx typing/types.cmx \ typing/typedtree.cmx typing/typedecl.cmx typing/typecore.cmx \ typing/typeclass.cmx typing/subst.cmx typing/stypes.cmx \ typing/printtyp.cmx typing/path.cmx parsing/parsetree.cmi \ typing/mtype.cmx utils/misc.cmx parsing/longident.cmx \ parsing/location.cmx typing/includemod.cmx typing/ident.cmx \ typing/env.cmx typing/ctype.cmx utils/config.cmx typing/cmt_format.cmx \ utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi typing/annot.cmi \ typing/typemod.cmi typing/types.cmo : typing/primitive.cmi typing/path.cmi \ parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \ typing/ident.cmi parsing/asttypes.cmi typing/types.cmi typing/types.cmx : typing/primitive.cmx typing/path.cmx \ parsing/parsetree.cmi parsing/longident.cmx parsing/location.cmx \ typing/ident.cmx parsing/asttypes.cmi typing/types.cmi typing/typetexp.cmo : utils/warnings.cmi typing/types.cmi \ typing/typedtree.cmi utils/tbl.cmi typing/printtyp.cmi typing/path.cmi \ parsing/parsetree.cmi utils/misc.cmi parsing/longident.cmi \ parsing/location.cmi typing/env.cmi typing/ctype.cmi utils/clflags.cmi \ typing/btype.cmi parsing/asttypes.cmi parsing/ast_helper.cmi \ typing/typetexp.cmi typing/typetexp.cmx : utils/warnings.cmx typing/types.cmx \ typing/typedtree.cmx utils/tbl.cmx typing/printtyp.cmx typing/path.cmx \ parsing/parsetree.cmi utils/misc.cmx parsing/longident.cmx \ parsing/location.cmx typing/env.cmx typing/ctype.cmx utils/clflags.cmx \ typing/btype.cmx parsing/asttypes.cmi parsing/ast_helper.cmx \ typing/typetexp.cmi bytecomp/bytegen.cmi : bytecomp/lambda.cmi bytecomp/instruct.cmi bytecomp/bytelibrarian.cmi : bytecomp/bytelink.cmi : bytecomp/symtable.cmi bytecomp/cmo_format.cmi bytecomp/bytepackager.cmi : typing/ident.cmi bytecomp/bytesections.cmi : bytecomp/cmo_format.cmi : bytecomp/lambda.cmi typing/ident.cmi bytecomp/dll.cmi : bytecomp/emitcode.cmi : bytecomp/instruct.cmi bytecomp/cmo_format.cmi bytecomp/instruct.cmi : typing/types.cmi typing/subst.cmi \ parsing/location.cmi bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi bytecomp/lambda.cmi : typing/types.cmi typing/primitive.cmi typing/path.cmi \ parsing/location.cmi typing/ident.cmi typing/env.cmi parsing/asttypes.cmi bytecomp/matching.cmi : typing/typedtree.cmi parsing/location.cmi \ bytecomp/lambda.cmi typing/ident.cmi parsing/asttypes.cmi bytecomp/meta.cmi : bytecomp/printinstr.cmi : bytecomp/instruct.cmi bytecomp/printlambda.cmi : bytecomp/lambda.cmi bytecomp/runtimedef.cmi : bytecomp/simplif.cmi : bytecomp/lambda.cmi bytecomp/switch.cmi : bytecomp/symtable.cmi : utils/misc.cmi typing/ident.cmi \ bytecomp/cmo_format.cmi bytecomp/translclass.cmi : typing/typedtree.cmi parsing/location.cmi \ bytecomp/lambda.cmi typing/ident.cmi parsing/asttypes.cmi bytecomp/translcore.cmi : typing/typedtree.cmi typing/primitive.cmi \ typing/path.cmi parsing/location.cmi bytecomp/lambda.cmi typing/ident.cmi \ parsing/asttypes.cmi bytecomp/translmod.cmi : typing/typedtree.cmi typing/primitive.cmi \ parsing/location.cmi bytecomp/lambda.cmi typing/ident.cmi bytecomp/translobj.cmi : bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi bytecomp/typeopt.cmi : typing/typedtree.cmi typing/path.cmi \ bytecomp/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 bytecomp/bytegen.cmx : typing/types.cmx bytecomp/switch.cmx typing/subst.cmx \ typing/primitive.cmx utils/misc.cmx bytecomp/lambda.cmx \ bytecomp/instruct.cmx typing/ident.cmx utils/config.cmx \ parsing/asttypes.cmi bytecomp/bytegen.cmi bytecomp/bytelibrarian.cmo : utils/misc.cmi parsing/location.cmi \ utils/config.cmi bytecomp/cmo_format.cmi utils/clflags.cmi \ bytecomp/bytelink.cmi bytecomp/bytelibrarian.cmi bytecomp/bytelibrarian.cmx : utils/misc.cmx parsing/location.cmx \ utils/config.cmx bytecomp/cmo_format.cmi utils/clflags.cmx \ bytecomp/bytelink.cmx bytecomp/bytelibrarian.cmi bytecomp/bytelink.cmo : utils/warnings.cmi bytecomp/symtable.cmi \ bytecomp/opcodes.cmo utils/misc.cmi parsing/location.cmi typing/ident.cmi \ bytecomp/dll.cmi utils/consistbl.cmi utils/config.cmi \ bytecomp/cmo_format.cmi utils/clflags.cmi utils/ccomp.cmi \ bytecomp/bytesections.cmi bytecomp/bytelink.cmi bytecomp/bytelink.cmx : utils/warnings.cmx bytecomp/symtable.cmx \ bytecomp/opcodes.cmx utils/misc.cmx parsing/location.cmx typing/ident.cmx \ bytecomp/dll.cmx utils/consistbl.cmx utils/config.cmx \ bytecomp/cmo_format.cmi utils/clflags.cmx utils/ccomp.cmx \ bytecomp/bytesections.cmx bytecomp/bytelink.cmi bytecomp/bytepackager.cmo : typing/typemod.cmi bytecomp/translmod.cmi \ typing/subst.cmi typing/path.cmi utils/misc.cmi parsing/location.cmi \ bytecomp/instruct.cmi typing/ident.cmi typing/env.cmi \ bytecomp/emitcode.cmi utils/config.cmi bytecomp/cmo_format.cmi \ utils/clflags.cmi bytecomp/bytelink.cmi bytecomp/bytegen.cmi \ bytecomp/bytepackager.cmi bytecomp/bytepackager.cmx : typing/typemod.cmx bytecomp/translmod.cmx \ typing/subst.cmx typing/path.cmx utils/misc.cmx parsing/location.cmx \ bytecomp/instruct.cmx typing/ident.cmx typing/env.cmx \ bytecomp/emitcode.cmx utils/config.cmx bytecomp/cmo_format.cmi \ utils/clflags.cmx bytecomp/bytelink.cmx bytecomp/bytegen.cmx \ bytecomp/bytepackager.cmi bytecomp/bytesections.cmo : utils/misc.cmi utils/config.cmi \ bytecomp/bytesections.cmi bytecomp/bytesections.cmx : utils/misc.cmx utils/config.cmx \ bytecomp/bytesections.cmi bytecomp/dll.cmo : utils/misc.cmi utils/config.cmi bytecomp/dll.cmi bytecomp/dll.cmx : utils/misc.cmx utils/config.cmx bytecomp/dll.cmi bytecomp/emitcode.cmo : bytecomp/translmod.cmi typing/primitive.cmi \ bytecomp/opcodes.cmo utils/misc.cmi bytecomp/meta.cmi bytecomp/lambda.cmi \ bytecomp/instruct.cmi typing/env.cmi utils/config.cmi \ bytecomp/cmo_format.cmi utils/clflags.cmi typing/btype.cmi \ parsing/asttypes.cmi bytecomp/emitcode.cmi bytecomp/emitcode.cmx : bytecomp/translmod.cmx typing/primitive.cmx \ bytecomp/opcodes.cmx utils/misc.cmx bytecomp/meta.cmx bytecomp/lambda.cmx \ bytecomp/instruct.cmx typing/env.cmx utils/config.cmx \ bytecomp/cmo_format.cmi utils/clflags.cmx typing/btype.cmx \ parsing/asttypes.cmi bytecomp/emitcode.cmi bytecomp/instruct.cmo : typing/types.cmi typing/subst.cmi \ parsing/location.cmi bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi \ bytecomp/instruct.cmi bytecomp/instruct.cmx : typing/types.cmx typing/subst.cmx \ parsing/location.cmx bytecomp/lambda.cmx typing/ident.cmx typing/env.cmx \ bytecomp/instruct.cmi bytecomp/lambda.cmo : typing/types.cmi typing/primitive.cmi typing/path.cmi \ utils/misc.cmi parsing/location.cmi typing/ident.cmi typing/env.cmi \ parsing/asttypes.cmi bytecomp/lambda.cmi bytecomp/lambda.cmx : typing/types.cmx typing/primitive.cmx typing/path.cmx \ utils/misc.cmx parsing/location.cmx typing/ident.cmx typing/env.cmx \ parsing/asttypes.cmi bytecomp/lambda.cmi bytecomp/matching.cmo : typing/types.cmi bytecomp/typeopt.cmi \ typing/typedtree.cmi bytecomp/switch.cmi bytecomp/printlambda.cmi \ typing/primitive.cmi typing/predef.cmi typing/path.cmi \ typing/parmatch.cmi utils/misc.cmi parsing/longident.cmi \ parsing/location.cmi bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi \ utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \ bytecomp/matching.cmi bytecomp/matching.cmx : typing/types.cmx bytecomp/typeopt.cmx \ typing/typedtree.cmx bytecomp/switch.cmx bytecomp/printlambda.cmx \ typing/primitive.cmx typing/predef.cmx typing/path.cmx \ typing/parmatch.cmx utils/misc.cmx parsing/longident.cmx \ parsing/location.cmx bytecomp/lambda.cmx typing/ident.cmx typing/env.cmx \ utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \ bytecomp/matching.cmi bytecomp/meta.cmo : bytecomp/meta.cmi bytecomp/meta.cmx : bytecomp/meta.cmi bytecomp/opcodes.cmo : bytecomp/opcodes.cmx : bytecomp/printinstr.cmo : bytecomp/printlambda.cmi parsing/location.cmi \ bytecomp/lambda.cmi bytecomp/instruct.cmi typing/ident.cmi \ bytecomp/printinstr.cmi bytecomp/printinstr.cmx : bytecomp/printlambda.cmx parsing/location.cmx \ bytecomp/lambda.cmx bytecomp/instruct.cmx typing/ident.cmx \ bytecomp/printinstr.cmi bytecomp/printlambda.cmo : typing/types.cmi typing/primitive.cmi \ parsing/location.cmi bytecomp/lambda.cmi typing/ident.cmi \ parsing/asttypes.cmi bytecomp/printlambda.cmi bytecomp/printlambda.cmx : typing/types.cmx typing/primitive.cmx \ parsing/location.cmx bytecomp/lambda.cmx typing/ident.cmx \ parsing/asttypes.cmi bytecomp/printlambda.cmi bytecomp/runtimedef.cmo : bytecomp/runtimedef.cmi bytecomp/runtimedef.cmx : bytecomp/runtimedef.cmi bytecomp/simplif.cmo : utils/tbl.cmi typing/stypes.cmi bytecomp/lambda.cmi \ typing/ident.cmi utils/clflags.cmi parsing/asttypes.cmi typing/annot.cmi \ bytecomp/simplif.cmi bytecomp/simplif.cmx : utils/tbl.cmx typing/stypes.cmx bytecomp/lambda.cmx \ typing/ident.cmx utils/clflags.cmx parsing/asttypes.cmi typing/annot.cmi \ bytecomp/simplif.cmi bytecomp/switch.cmo : bytecomp/switch.cmi bytecomp/switch.cmx : bytecomp/switch.cmi bytecomp/symtable.cmo : utils/tbl.cmi bytecomp/runtimedef.cmi \ typing/predef.cmi utils/misc.cmi bytecomp/meta.cmi parsing/location.cmi \ bytecomp/lambda.cmi typing/ident.cmi bytecomp/dll.cmi \ bytecomp/cmo_format.cmi utils/clflags.cmi bytecomp/bytesections.cmi \ parsing/asttypes.cmi bytecomp/symtable.cmi bytecomp/symtable.cmx : utils/tbl.cmx bytecomp/runtimedef.cmx \ typing/predef.cmx utils/misc.cmx bytecomp/meta.cmx parsing/location.cmx \ bytecomp/lambda.cmx typing/ident.cmx bytecomp/dll.cmx \ bytecomp/cmo_format.cmi utils/clflags.cmx bytecomp/bytesections.cmx \ parsing/asttypes.cmi bytecomp/symtable.cmi bytecomp/translclass.cmo : typing/types.cmi bytecomp/typeopt.cmi \ typing/typedtree.cmi bytecomp/translobj.cmi bytecomp/translcore.cmi \ typing/path.cmi bytecomp/matching.cmi parsing/location.cmi \ bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi utils/clflags.cmi \ typing/btype.cmi parsing/asttypes.cmi bytecomp/translclass.cmi bytecomp/translclass.cmx : typing/types.cmx bytecomp/typeopt.cmx \ typing/typedtree.cmx bytecomp/translobj.cmx bytecomp/translcore.cmx \ typing/path.cmx bytecomp/matching.cmx parsing/location.cmx \ bytecomp/lambda.cmx typing/ident.cmx typing/env.cmx utils/clflags.cmx \ typing/btype.cmx parsing/asttypes.cmi bytecomp/translclass.cmi bytecomp/translcore.cmo : utils/warnings.cmi typing/types.cmi \ bytecomp/typeopt.cmi typing/typedtree.cmi bytecomp/translobj.cmi \ typing/primitive.cmi typing/predef.cmi typing/path.cmi \ typing/parmatch.cmi utils/misc.cmi bytecomp/matching.cmi \ parsing/longident.cmi parsing/location.cmi bytecomp/lambda.cmi \ typing/ident.cmi typing/env.cmi utils/config.cmi utils/clflags.cmi \ typing/btype.cmi parsing/asttypes.cmi bytecomp/translcore.cmi bytecomp/translcore.cmx : utils/warnings.cmx typing/types.cmx \ bytecomp/typeopt.cmx typing/typedtree.cmx bytecomp/translobj.cmx \ typing/primitive.cmx typing/predef.cmx typing/path.cmx \ typing/parmatch.cmx utils/misc.cmx bytecomp/matching.cmx \ parsing/longident.cmx parsing/location.cmx bytecomp/lambda.cmx \ typing/ident.cmx typing/env.cmx utils/config.cmx utils/clflags.cmx \ typing/btype.cmx parsing/asttypes.cmi bytecomp/translcore.cmi bytecomp/translmod.cmo : typing/types.cmi typing/typedtree.cmi \ bytecomp/translobj.cmi bytecomp/translcore.cmi bytecomp/translclass.cmi \ typing/printtyp.cmi typing/primitive.cmi typing/predef.cmi \ typing/path.cmi typing/mtype.cmi utils/misc.cmi parsing/longident.cmi \ parsing/location.cmi bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi \ typing/ctype.cmi parsing/asttypes.cmi bytecomp/translmod.cmi bytecomp/translmod.cmx : typing/types.cmx typing/typedtree.cmx \ bytecomp/translobj.cmx bytecomp/translcore.cmx bytecomp/translclass.cmx \ typing/printtyp.cmx typing/primitive.cmx typing/predef.cmx \ typing/path.cmx typing/mtype.cmx utils/misc.cmx parsing/longident.cmx \ parsing/location.cmx bytecomp/lambda.cmx typing/ident.cmx typing/env.cmx \ typing/ctype.cmx parsing/asttypes.cmi bytecomp/translmod.cmi bytecomp/translobj.cmo : typing/primitive.cmi utils/misc.cmi \ parsing/longident.cmi bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi \ utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \ bytecomp/translobj.cmi bytecomp/translobj.cmx : typing/primitive.cmx utils/misc.cmx \ parsing/longident.cmx bytecomp/lambda.cmx typing/ident.cmx typing/env.cmx \ utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \ bytecomp/translobj.cmi bytecomp/typeopt.cmo : typing/types.cmi typing/typedtree.cmi \ typing/predef.cmi typing/path.cmi bytecomp/lambda.cmi typing/ident.cmi \ typing/env.cmi typing/ctype.cmi bytecomp/typeopt.cmi bytecomp/typeopt.cmx : typing/types.cmx typing/typedtree.cmx \ typing/predef.cmx typing/path.cmx bytecomp/lambda.cmx typing/ident.cmx \ typing/env.cmx typing/ctype.cmx bytecomp/typeopt.cmi asmcomp/asmgen.cmi : bytecomp/lambda.cmi asmcomp/cmm.cmi asmcomp/asmlibrarian.cmi : asmcomp/asmlink.cmi : asmcomp/cmx_format.cmi asmcomp/asmpackager.cmi : asmcomp/clambda.cmi : bytecomp/lambda.cmi typing/ident.cmi \ asmcomp/debuginfo.cmi parsing/asttypes.cmi asmcomp/closure.cmi : bytecomp/lambda.cmi asmcomp/clambda.cmi asmcomp/cmm.cmi : typing/ident.cmi asmcomp/debuginfo.cmi asmcomp/cmmgen.cmi : asmcomp/cmx_format.cmi asmcomp/cmm.cmi \ asmcomp/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/debuginfo.cmi : parsing/location.cmi bytecomp/lambda.cmi asmcomp/emit.cmi : asmcomp/linearize.cmi asmcomp/cmm.cmi asmcomp/emitaux.cmi : asmcomp/debuginfo.cmi asmcomp/interf.cmi : asmcomp/mach.cmi asmcomp/linearize.cmi : asmcomp/reg.cmi asmcomp/mach.cmi \ asmcomp/debuginfo.cmi asmcomp/liveness.cmi : asmcomp/mach.cmi asmcomp/mach.cmi : asmcomp/reg.cmi asmcomp/debuginfo.cmi asmcomp/cmm.cmi \ asmcomp/arch.cmo asmcomp/printclambda.cmi : asmcomp/clambda.cmi asmcomp/printcmm.cmi : asmcomp/cmm.cmi asmcomp/printlinear.cmi : asmcomp/linearize.cmi asmcomp/printmach.cmi : asmcomp/reg.cmi asmcomp/mach.cmi asmcomp/proc.cmi : asmcomp/reg.cmi asmcomp/mach.cmi asmcomp/reg.cmi : asmcomp/cmm.cmi asmcomp/reload.cmi : asmcomp/mach.cmi asmcomp/reloadgen.cmi : asmcomp/reg.cmi asmcomp/mach.cmi asmcomp/schedgen.cmi : asmcomp/mach.cmi asmcomp/linearize.cmi asmcomp/scheduling.cmi : asmcomp/linearize.cmi asmcomp/selectgen.cmi : utils/tbl.cmi asmcomp/reg.cmi asmcomp/mach.cmi \ typing/ident.cmi asmcomp/debuginfo.cmi asmcomp/cmm.cmi asmcomp/arch.cmo asmcomp/selection.cmi : asmcomp/mach.cmi asmcomp/cmm.cmi asmcomp/spill.cmi : asmcomp/mach.cmi asmcomp/split.cmi : asmcomp/mach.cmi asmcomp/arch.cmo : asmcomp/arch.cmx : asmcomp/asmgen.cmo : bytecomp/translmod.cmi asmcomp/split.cmi \ asmcomp/spill.cmi asmcomp/selection.cmi asmcomp/scheduling.cmi \ asmcomp/reload.cmi asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/printmach.cmi \ asmcomp/printlinear.cmi asmcomp/printcmm.cmi asmcomp/printclambda.cmi \ typing/primitive.cmi utils/misc.cmi asmcomp/mach.cmi parsing/location.cmi \ asmcomp/liveness.cmi asmcomp/linearize.cmi asmcomp/interf.cmi \ asmcomp/emitaux.cmi asmcomp/emit.cmi utils/config.cmi \ asmcomp/compilenv.cmi asmcomp/comballoc.cmi asmcomp/coloring.cmi \ asmcomp/cmmgen.cmi asmcomp/cmm.cmi asmcomp/closure.cmi utils/clflags.cmi \ asmcomp/asmgen.cmi asmcomp/asmgen.cmx : bytecomp/translmod.cmx asmcomp/split.cmx \ asmcomp/spill.cmx asmcomp/selection.cmx asmcomp/scheduling.cmx \ asmcomp/reload.cmx asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/printmach.cmx \ asmcomp/printlinear.cmx asmcomp/printcmm.cmx asmcomp/printclambda.cmx \ typing/primitive.cmx utils/misc.cmx asmcomp/mach.cmx parsing/location.cmx \ asmcomp/liveness.cmx asmcomp/linearize.cmx asmcomp/interf.cmx \ asmcomp/emitaux.cmx asmcomp/emit.cmx utils/config.cmx \ asmcomp/compilenv.cmx asmcomp/comballoc.cmx asmcomp/coloring.cmx \ asmcomp/cmmgen.cmx asmcomp/cmm.cmx asmcomp/closure.cmx utils/clflags.cmx \ asmcomp/asmgen.cmi asmcomp/asmlibrarian.cmo : utils/misc.cmi parsing/location.cmi \ utils/config.cmi asmcomp/compilenv.cmi asmcomp/cmx_format.cmi \ utils/clflags.cmi asmcomp/clambda.cmi utils/ccomp.cmi asmcomp/asmlink.cmi \ asmcomp/asmlibrarian.cmi asmcomp/asmlibrarian.cmx : utils/misc.cmx parsing/location.cmx \ utils/config.cmx asmcomp/compilenv.cmx asmcomp/cmx_format.cmi \ utils/clflags.cmx asmcomp/clambda.cmx utils/ccomp.cmx asmcomp/asmlink.cmx \ asmcomp/asmlibrarian.cmi asmcomp/asmlink.cmo : bytecomp/runtimedef.cmi asmcomp/proc.cmi \ utils/misc.cmi parsing/location.cmi asmcomp/emitaux.cmi asmcomp/emit.cmi \ utils/consistbl.cmi utils/config.cmi asmcomp/compilenv.cmi \ asmcomp/cmx_format.cmi asmcomp/cmmgen.cmi utils/clflags.cmi \ utils/ccomp.cmi asmcomp/asmgen.cmi asmcomp/asmlink.cmi asmcomp/asmlink.cmx : bytecomp/runtimedef.cmx asmcomp/proc.cmx \ utils/misc.cmx parsing/location.cmx asmcomp/emitaux.cmx asmcomp/emit.cmx \ utils/consistbl.cmx utils/config.cmx asmcomp/compilenv.cmx \ asmcomp/cmx_format.cmi asmcomp/cmmgen.cmx utils/clflags.cmx \ utils/ccomp.cmx asmcomp/asmgen.cmx asmcomp/asmlink.cmi asmcomp/asmpackager.cmo : typing/typemod.cmi bytecomp/translmod.cmi \ utils/misc.cmi parsing/location.cmi typing/ident.cmi typing/env.cmi \ utils/config.cmi asmcomp/compilenv.cmi asmcomp/cmx_format.cmi \ utils/clflags.cmi utils/ccomp.cmi asmcomp/asmlink.cmi asmcomp/asmgen.cmi \ asmcomp/asmpackager.cmi asmcomp/asmpackager.cmx : typing/typemod.cmx bytecomp/translmod.cmx \ utils/misc.cmx parsing/location.cmx typing/ident.cmx typing/env.cmx \ utils/config.cmx asmcomp/compilenv.cmx asmcomp/cmx_format.cmi \ utils/clflags.cmx utils/ccomp.cmx asmcomp/asmlink.cmx asmcomp/asmgen.cmx \ asmcomp/asmpackager.cmi asmcomp/clambda.cmo : bytecomp/lambda.cmi typing/ident.cmi \ asmcomp/debuginfo.cmi parsing/asttypes.cmi asmcomp/clambda.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 \ 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/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 \ asmcomp/interf.cmi asmcomp/emit.cmi asmcomp/coloring.cmi asmcomp/cmm.cmi \ asmcomp/codegen.cmi asmcomp/codegen.cmx : asmcomp/split.cmx asmcomp/spill.cmx asmcomp/reload.cmx \ asmcomp/reg.cmx asmcomp/printmach.cmx asmcomp/printlinear.cmx \ asmcomp/printcmm.cmx asmcomp/liveness.cmx asmcomp/linearize.cmx \ asmcomp/interf.cmx asmcomp/emit.cmx asmcomp/coloring.cmx asmcomp/cmm.cmx \ asmcomp/codegen.cmi asmcomp/coloring.cmo : asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/coloring.cmi asmcomp/coloring.cmx : asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/coloring.cmi asmcomp/comballoc.cmo : asmcomp/reg.cmi asmcomp/mach.cmi utils/config.cmi \ asmcomp/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/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/emit.cmx : asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \ asmcomp/mach.cmx asmcomp/linearize.cmx asmcomp/emitaux.cmx \ asmcomp/debuginfo.cmx utils/config.cmx asmcomp/compilenv.cmx \ asmcomp/cmm.cmx utils/clflags.cmx asmcomp/arch.cmx asmcomp/emit.cmi asmcomp/emitaux.cmo : asmcomp/linearize.cmi asmcomp/debuginfo.cmi \ utils/config.cmi utils/clflags.cmi asmcomp/arch.cmo asmcomp/emitaux.cmi asmcomp/emitaux.cmx : asmcomp/linearize.cmx asmcomp/debuginfo.cmx \ utils/config.cmx utils/clflags.cmx asmcomp/arch.cmx asmcomp/emitaux.cmi asmcomp/interf.cmo : asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/mach.cmi \ asmcomp/interf.cmi asmcomp/interf.cmx : asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/mach.cmx \ asmcomp/interf.cmi asmcomp/linearize.cmo : asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \ asmcomp/mach.cmi asmcomp/debuginfo.cmi asmcomp/cmm.cmi \ asmcomp/linearize.cmi asmcomp/linearize.cmx : asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \ asmcomp/mach.cmx asmcomp/debuginfo.cmx asmcomp/cmm.cmx \ asmcomp/linearize.cmi asmcomp/liveness.cmo : asmcomp/reg.cmi asmcomp/proc.cmi \ asmcomp/printmach.cmi utils/misc.cmi asmcomp/mach.cmi \ asmcomp/liveness.cmi asmcomp/liveness.cmx : asmcomp/reg.cmx asmcomp/proc.cmx \ asmcomp/printmach.cmx utils/misc.cmx asmcomp/mach.cmx \ asmcomp/liveness.cmi asmcomp/mach.cmo : asmcomp/reg.cmi asmcomp/debuginfo.cmi asmcomp/cmm.cmi \ asmcomp/arch.cmo asmcomp/mach.cmi asmcomp/mach.cmx : asmcomp/reg.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/printlinear.cmo : asmcomp/printmach.cmi asmcomp/mach.cmi \ asmcomp/linearize.cmi asmcomp/debuginfo.cmi asmcomp/printlinear.cmi asmcomp/printlinear.cmx : asmcomp/printmach.cmx asmcomp/mach.cmx \ asmcomp/linearize.cmx asmcomp/debuginfo.cmx asmcomp/printlinear.cmi asmcomp/printmach.cmo : asmcomp/reg.cmi asmcomp/proc.cmi \ asmcomp/printcmm.cmi asmcomp/mach.cmi asmcomp/debuginfo.cmi \ asmcomp/cmm.cmi asmcomp/arch.cmo asmcomp/printmach.cmi asmcomp/printmach.cmx : asmcomp/reg.cmx asmcomp/proc.cmx \ asmcomp/printcmm.cmx asmcomp/mach.cmx asmcomp/debuginfo.cmx \ asmcomp/cmm.cmx asmcomp/arch.cmx asmcomp/printmach.cmi asmcomp/proc.cmo : asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \ utils/config.cmi asmcomp/cmm.cmi utils/clflags.cmi utils/ccomp.cmi \ asmcomp/arch.cmo asmcomp/proc.cmi asmcomp/proc.cmx : asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \ utils/config.cmx asmcomp/cmm.cmx utils/clflags.cmx utils/ccomp.cmx \ asmcomp/arch.cmx asmcomp/proc.cmi asmcomp/reg.cmo : asmcomp/cmm.cmi asmcomp/reg.cmi asmcomp/reg.cmx : asmcomp/cmm.cmx asmcomp/reg.cmi asmcomp/reload.cmo : asmcomp/reloadgen.cmi asmcomp/reg.cmi asmcomp/mach.cmi \ asmcomp/cmm.cmi utils/clflags.cmi asmcomp/arch.cmo asmcomp/reload.cmi asmcomp/reload.cmx : asmcomp/reloadgen.cmx asmcomp/reg.cmx asmcomp/mach.cmx \ asmcomp/cmm.cmx utils/clflags.cmx asmcomp/arch.cmx asmcomp/reload.cmi asmcomp/reloadgen.cmo : asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \ asmcomp/reloadgen.cmi asmcomp/reloadgen.cmx : asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \ asmcomp/reloadgen.cmi asmcomp/schedgen.cmo : asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/mach.cmi \ asmcomp/linearize.cmi asmcomp/cmm.cmi asmcomp/arch.cmo \ asmcomp/schedgen.cmi asmcomp/schedgen.cmx : asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/mach.cmx \ asmcomp/linearize.cmx asmcomp/cmm.cmx asmcomp/arch.cmx \ asmcomp/schedgen.cmi asmcomp/scheduling.cmo : asmcomp/schedgen.cmi asmcomp/scheduling.cmi asmcomp/scheduling.cmx : asmcomp/schedgen.cmx asmcomp/scheduling.cmi asmcomp/selectgen.cmo : utils/tbl.cmi bytecomp/simplif.cmi asmcomp/reg.cmi \ asmcomp/proc.cmi utils/misc.cmi asmcomp/mach.cmi typing/ident.cmi \ asmcomp/debuginfo.cmi asmcomp/cmm.cmi asmcomp/arch.cmo \ asmcomp/selectgen.cmi asmcomp/selectgen.cmx : utils/tbl.cmx bytecomp/simplif.cmx asmcomp/reg.cmx \ asmcomp/proc.cmx utils/misc.cmx asmcomp/mach.cmx typing/ident.cmx \ asmcomp/debuginfo.cmx asmcomp/cmm.cmx asmcomp/arch.cmx \ asmcomp/selectgen.cmi asmcomp/selection.cmo : asmcomp/selectgen.cmi asmcomp/proc.cmi \ utils/misc.cmi asmcomp/mach.cmi asmcomp/cmm.cmi utils/clflags.cmi \ asmcomp/arch.cmo asmcomp/selection.cmi asmcomp/selection.cmx : asmcomp/selectgen.cmx asmcomp/proc.cmx \ utils/misc.cmx asmcomp/mach.cmx asmcomp/cmm.cmx utils/clflags.cmx \ asmcomp/arch.cmx asmcomp/selection.cmi asmcomp/spill.cmo : asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \ asmcomp/mach.cmi asmcomp/spill.cmi asmcomp/spill.cmx : asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \ asmcomp/mach.cmx asmcomp/spill.cmi asmcomp/split.cmo : asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \ asmcomp/split.cmi asmcomp/split.cmx : asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \ asmcomp/split.cmi driver/compenv.cmi : driver/compile.cmi : driver/compmisc.cmi : typing/env.cmi driver/errors.cmi : driver/main.cmi : driver/main_args.cmi : driver/optcompile.cmi : driver/opterrors.cmi : driver/optmain.cmi : driver/pparse.cmi : parsing/parsetree.cmi driver/compenv.cmo : utils/warnings.cmi utils/misc.cmi parsing/location.cmi \ utils/config.cmi utils/clflags.cmi driver/compenv.cmi driver/compenv.cmx : utils/warnings.cmx utils/misc.cmx parsing/location.cmx \ utils/config.cmx utils/clflags.cmx driver/compenv.cmi driver/compile.cmo : utils/warnings.cmi typing/typemod.cmi \ typing/typedtree.cmi typing/typecore.cmi bytecomp/translmod.cmi \ typing/stypes.cmi bytecomp/simplif.cmi typing/printtyped.cmi \ typing/printtyp.cmi bytecomp/printlambda.cmi bytecomp/printinstr.cmi \ parsing/printast.cmi parsing/pprintast.cmi driver/pparse.cmi \ utils/misc.cmi parsing/location.cmi typing/includemod.cmi typing/env.cmi \ bytecomp/emitcode.cmi driver/compmisc.cmi driver/compenv.cmi \ utils/clflags.cmi utils/ccomp.cmi bytecomp/bytegen.cmi driver/compile.cmi driver/compile.cmx : utils/warnings.cmx typing/typemod.cmx \ typing/typedtree.cmx typing/typecore.cmx bytecomp/translmod.cmx \ typing/stypes.cmx bytecomp/simplif.cmx typing/printtyped.cmx \ typing/printtyp.cmx bytecomp/printlambda.cmx bytecomp/printinstr.cmx \ parsing/printast.cmx parsing/pprintast.cmx driver/pparse.cmx \ utils/misc.cmx parsing/location.cmx typing/includemod.cmx typing/env.cmx \ bytecomp/emitcode.cmx driver/compmisc.cmx driver/compenv.cmx \ utils/clflags.cmx utils/ccomp.cmx bytecomp/bytegen.cmx driver/compile.cmi driver/compmisc.cmo : utils/misc.cmi typing/ident.cmi typing/env.cmi \ utils/config.cmi driver/compenv.cmi utils/clflags.cmi driver/compmisc.cmi driver/compmisc.cmx : utils/misc.cmx typing/ident.cmx typing/env.cmx \ utils/config.cmx driver/compenv.cmx utils/clflags.cmx driver/compmisc.cmi driver/errors.cmo : parsing/location.cmi driver/errors.cmi driver/errors.cmx : parsing/location.cmx driver/errors.cmi driver/main.cmo : utils/warnings.cmi utils/misc.cmi driver/main_args.cmi \ parsing/location.cmi utils/config.cmi driver/compmisc.cmi \ driver/compile.cmi driver/compenv.cmi utils/clflags.cmi \ bytecomp/bytepackager.cmi bytecomp/bytelink.cmi \ bytecomp/bytelibrarian.cmi driver/main.cmi driver/main.cmx : utils/warnings.cmx utils/misc.cmx driver/main_args.cmx \ parsing/location.cmx utils/config.cmx driver/compmisc.cmx \ driver/compile.cmx driver/compenv.cmx utils/clflags.cmx \ bytecomp/bytepackager.cmx bytecomp/bytelink.cmx \ bytecomp/bytelibrarian.cmx driver/main.cmi driver/main_args.cmo : utils/warnings.cmi driver/main_args.cmi driver/main_args.cmx : utils/warnings.cmx driver/main_args.cmi driver/optcompile.cmo : utils/warnings.cmi typing/typemod.cmi \ typing/typedtree.cmi typing/typecore.cmi bytecomp/translmod.cmi \ typing/stypes.cmi bytecomp/simplif.cmi typing/printtyped.cmi \ typing/printtyp.cmi bytecomp/printlambda.cmi parsing/printast.cmi \ parsing/pprintast.cmi driver/pparse.cmi utils/misc.cmi \ typing/includemod.cmi typing/env.cmi utils/config.cmi driver/compmisc.cmi \ asmcomp/compilenv.cmi driver/compenv.cmi utils/clflags.cmi \ utils/ccomp.cmi asmcomp/asmgen.cmi driver/optcompile.cmi driver/optcompile.cmx : utils/warnings.cmx typing/typemod.cmx \ typing/typedtree.cmx typing/typecore.cmx bytecomp/translmod.cmx \ typing/stypes.cmx bytecomp/simplif.cmx typing/printtyped.cmx \ typing/printtyp.cmx bytecomp/printlambda.cmx parsing/printast.cmx \ parsing/pprintast.cmx driver/pparse.cmx utils/misc.cmx \ typing/includemod.cmx typing/env.cmx utils/config.cmx driver/compmisc.cmx \ asmcomp/compilenv.cmx driver/compenv.cmx utils/clflags.cmx \ utils/ccomp.cmx asmcomp/asmgen.cmx driver/optcompile.cmi driver/opterrors.cmo : parsing/location.cmi driver/opterrors.cmi driver/opterrors.cmx : parsing/location.cmx driver/opterrors.cmi driver/optmain.cmo : utils/warnings.cmi asmcomp/printmach.cmi \ driver/optcompile.cmi utils/misc.cmi driver/main_args.cmi \ parsing/location.cmi utils/config.cmi driver/compmisc.cmi \ driver/compenv.cmi utils/clflags.cmi asmcomp/asmpackager.cmi \ asmcomp/asmlink.cmi asmcomp/asmlibrarian.cmi asmcomp/arch.cmo \ driver/optmain.cmi driver/optmain.cmx : utils/warnings.cmx asmcomp/printmach.cmx \ driver/optcompile.cmx utils/misc.cmx driver/main_args.cmx \ parsing/location.cmx utils/config.cmx driver/compmisc.cmx \ driver/compenv.cmx utils/clflags.cmx asmcomp/asmpackager.cmx \ asmcomp/asmlink.cmx asmcomp/asmlibrarian.cmx asmcomp/arch.cmx \ driver/optmain.cmi driver/pparse.cmo : parsing/parse.cmi utils/misc.cmi parsing/location.cmi \ utils/config.cmi utils/clflags.cmi utils/ccomp.cmi driver/pparse.cmi driver/pparse.cmx : parsing/parse.cmx utils/misc.cmx parsing/location.cmx \ utils/config.cmx utils/clflags.cmx utils/ccomp.cmx driver/pparse.cmi toplevel/genprintval.cmi : typing/types.cmi typing/path.cmi \ typing/outcometree.cmi typing/env.cmi toplevel/opttopdirs.cmi : parsing/longident.cmi toplevel/opttoploop.cmi : utils/warnings.cmi typing/types.cmi \ typing/path.cmi parsing/parsetree.cmi typing/outcometree.cmi \ parsing/longident.cmi parsing/location.cmi typing/env.cmi toplevel/opttopmain.cmi : toplevel/topdirs.cmi : parsing/longident.cmi toplevel/toploop.cmi : utils/warnings.cmi typing/types.cmi typing/path.cmi \ parsing/parsetree.cmi typing/outcometree.cmi parsing/longident.cmi \ parsing/location.cmi typing/env.cmi toplevel/topmain.cmi : toplevel/trace.cmi : typing/types.cmi typing/path.cmi parsing/longident.cmi \ typing/env.cmi toplevel/expunge.cmo : bytecomp/symtable.cmi bytecomp/runtimedef.cmi \ utils/misc.cmi typing/ident.cmi bytecomp/bytesections.cmi toplevel/expunge.cmx : bytecomp/symtable.cmx bytecomp/runtimedef.cmx \ utils/misc.cmx typing/ident.cmx bytecomp/bytesections.cmx toplevel/genprintval.cmo : typing/types.cmi typing/printtyp.cmi \ typing/predef.cmi typing/path.cmi typing/outcometree.cmi utils/misc.cmi \ parsing/longident.cmi typing/ident.cmi typing/env.cmi typing/datarepr.cmi \ typing/ctype.cmi typing/btype.cmi toplevel/genprintval.cmi toplevel/genprintval.cmx : typing/types.cmx typing/printtyp.cmx \ typing/predef.cmx typing/path.cmx typing/outcometree.cmi utils/misc.cmx \ parsing/longident.cmx typing/ident.cmx typing/env.cmx typing/datarepr.cmx \ typing/ctype.cmx typing/btype.cmx toplevel/genprintval.cmi toplevel/opttopdirs.cmo : utils/warnings.cmi typing/types.cmi \ typing/printtyp.cmi toplevel/opttoploop.cmi utils/misc.cmi \ parsing/longident.cmi typing/ident.cmi typing/env.cmi typing/ctype.cmi \ utils/config.cmi utils/clflags.cmi asmcomp/asmlink.cmi \ toplevel/opttopdirs.cmi toplevel/opttopdirs.cmx : utils/warnings.cmx typing/types.cmx \ typing/printtyp.cmx toplevel/opttoploop.cmx utils/misc.cmx \ parsing/longident.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \ utils/config.cmx utils/clflags.cmx asmcomp/asmlink.cmx \ toplevel/opttopdirs.cmi toplevel/opttoploop.cmo : utils/warnings.cmi typing/types.cmi \ typing/typemod.cmi typing/typedtree.cmi typing/typecore.cmi \ bytecomp/translmod.cmi bytecomp/simplif.cmi typing/printtyped.cmi \ typing/printtyp.cmi bytecomp/printlambda.cmi parsing/printast.cmi \ typing/predef.cmi parsing/pprintast.cmi typing/path.cmi \ parsing/parsetree.cmi parsing/parse.cmi typing/outcometree.cmi \ typing/oprint.cmi utils/misc.cmi parsing/longident.cmi \ parsing/location.cmi parsing/lexer.cmi typing/ident.cmi \ toplevel/genprintval.cmi typing/env.cmi utils/config.cmi \ driver/compmisc.cmi asmcomp/compilenv.cmi utils/clflags.cmi \ typing/btype.cmi asmcomp/asmlink.cmi asmcomp/asmgen.cmi \ toplevel/opttoploop.cmi toplevel/opttoploop.cmx : utils/warnings.cmx typing/types.cmx \ typing/typemod.cmx typing/typedtree.cmx typing/typecore.cmx \ bytecomp/translmod.cmx bytecomp/simplif.cmx typing/printtyped.cmx \ typing/printtyp.cmx bytecomp/printlambda.cmx parsing/printast.cmx \ typing/predef.cmx parsing/pprintast.cmx typing/path.cmx \ parsing/parsetree.cmi parsing/parse.cmx typing/outcometree.cmi \ typing/oprint.cmx utils/misc.cmx parsing/longident.cmx \ parsing/location.cmx parsing/lexer.cmx typing/ident.cmx \ toplevel/genprintval.cmx typing/env.cmx utils/config.cmx \ driver/compmisc.cmx asmcomp/compilenv.cmx utils/clflags.cmx \ typing/btype.cmx asmcomp/asmlink.cmx asmcomp/asmgen.cmx \ toplevel/opttoploop.cmi toplevel/opttopmain.cmo : utils/warnings.cmi asmcomp/printmach.cmi \ toplevel/opttoploop.cmi toplevel/opttopdirs.cmi utils/misc.cmi \ driver/main_args.cmi parsing/location.cmi utils/config.cmi \ driver/compenv.cmi utils/clflags.cmi toplevel/opttopmain.cmi toplevel/opttopmain.cmx : utils/warnings.cmx asmcomp/printmach.cmx \ toplevel/opttoploop.cmx toplevel/opttopdirs.cmx utils/misc.cmx \ driver/main_args.cmx parsing/location.cmx utils/config.cmx \ driver/compenv.cmx utils/clflags.cmx toplevel/opttopmain.cmi toplevel/opttopstart.cmo : toplevel/opttopmain.cmi toplevel/opttopstart.cmx : toplevel/opttopmain.cmx toplevel/topdirs.cmo : utils/warnings.cmi typing/types.cmi \ toplevel/trace.cmi toplevel/toploop.cmi bytecomp/symtable.cmi \ typing/printtyp.cmi typing/path.cmi bytecomp/opcodes.cmo utils/misc.cmi \ bytecomp/meta.cmi parsing/longident.cmi typing/ident.cmi typing/env.cmi \ bytecomp/dll.cmi typing/ctype.cmi utils/consistbl.cmi utils/config.cmi \ bytecomp/cmo_format.cmi utils/clflags.cmi toplevel/topdirs.cmi toplevel/topdirs.cmx : utils/warnings.cmx typing/types.cmx \ toplevel/trace.cmx toplevel/toploop.cmx bytecomp/symtable.cmx \ typing/printtyp.cmx typing/path.cmx bytecomp/opcodes.cmx utils/misc.cmx \ bytecomp/meta.cmx parsing/longident.cmx typing/ident.cmx typing/env.cmx \ bytecomp/dll.cmx typing/ctype.cmx utils/consistbl.cmx utils/config.cmx \ bytecomp/cmo_format.cmi utils/clflags.cmx toplevel/topdirs.cmi toplevel/toploop.cmo : utils/warnings.cmi typing/types.cmi \ typing/typemod.cmi typing/typedtree.cmi typing/typecore.cmi \ bytecomp/translmod.cmi bytecomp/symtable.cmi bytecomp/simplif.cmi \ typing/printtyped.cmi typing/printtyp.cmi bytecomp/printlambda.cmi \ bytecomp/printinstr.cmi parsing/printast.cmi typing/predef.cmi \ parsing/pprintast.cmi driver/pparse.cmi typing/path.cmi \ parsing/parsetree.cmi parsing/parse.cmi typing/outcometree.cmi \ typing/oprint.cmi utils/misc.cmi bytecomp/meta.cmi parsing/longident.cmi \ parsing/location.cmi parsing/lexer.cmi typing/includemod.cmi \ typing/ident.cmi toplevel/genprintval.cmi typing/env.cmi \ bytecomp/emitcode.cmi bytecomp/dll.cmi utils/consistbl.cmi \ utils/config.cmi driver/compmisc.cmi utils/clflags.cmi \ bytecomp/bytegen.cmi typing/btype.cmi parsing/ast_helper.cmi \ toplevel/toploop.cmi toplevel/toploop.cmx : utils/warnings.cmx typing/types.cmx \ typing/typemod.cmx typing/typedtree.cmx typing/typecore.cmx \ bytecomp/translmod.cmx bytecomp/symtable.cmx bytecomp/simplif.cmx \ typing/printtyped.cmx typing/printtyp.cmx bytecomp/printlambda.cmx \ bytecomp/printinstr.cmx parsing/printast.cmx typing/predef.cmx \ parsing/pprintast.cmx driver/pparse.cmx typing/path.cmx \ parsing/parsetree.cmi parsing/parse.cmx typing/outcometree.cmi \ typing/oprint.cmx utils/misc.cmx bytecomp/meta.cmx parsing/longident.cmx \ parsing/location.cmx parsing/lexer.cmx typing/includemod.cmx \ typing/ident.cmx toplevel/genprintval.cmx typing/env.cmx \ bytecomp/emitcode.cmx bytecomp/dll.cmx utils/consistbl.cmx \ utils/config.cmx driver/compmisc.cmx utils/clflags.cmx \ bytecomp/bytegen.cmx typing/btype.cmx parsing/ast_helper.cmx \ toplevel/toploop.cmi toplevel/topmain.cmo : utils/warnings.cmi toplevel/toploop.cmi \ toplevel/topdirs.cmi utils/misc.cmi driver/main_args.cmi \ parsing/location.cmi utils/config.cmi driver/compenv.cmi \ utils/clflags.cmi toplevel/topmain.cmi toplevel/topmain.cmx : utils/warnings.cmx toplevel/toploop.cmx \ toplevel/topdirs.cmx utils/misc.cmx driver/main_args.cmx \ parsing/location.cmx utils/config.cmx driver/compenv.cmx \ utils/clflags.cmx toplevel/topmain.cmi toplevel/topstart.cmo : toplevel/topmain.cmi toplevel/topstart.cmx : toplevel/topmain.cmx toplevel/trace.cmo : typing/types.cmi toplevel/toploop.cmi \ typing/printtyp.cmi typing/predef.cmi typing/path.cmi utils/misc.cmi \ bytecomp/meta.cmi parsing/longident.cmi typing/ctype.cmi \ toplevel/trace.cmi toplevel/trace.cmx : typing/types.cmx toplevel/toploop.cmx \ typing/printtyp.cmx typing/predef.cmx typing/path.cmx utils/misc.cmx \ bytecomp/meta.cmx parsing/longident.cmx typing/ctype.cmx \ toplevel/trace.cmi camlp4-5.3-1/.gitignore000066400000000000000000000001161473134377200147000ustar00rootroot00000000000000_build/ _opam/ config.sh myocamlbuild_config.ml camlp4/boot/*.old camlp4/META camlp4-5.3-1/.ignore000066400000000000000000000002711473134377200141760ustar00rootroot00000000000000configure ocamlc ocamlc.opt expunge ocaml ocamlopt ocamlopt.opt package-macosx _boot_log1 _boot_log2 _build _start _buildtest _log myocamlbuild_config.ml ocamlbuild-mixed-boot ocamlnat camlp4-5.3-1/.ocp-indent000066400000000000000000000000401473134377200147450ustar00rootroot00000000000000match_clause=4 strict_with=auto camlp4-5.3-1/.travis-ci.sh000066400000000000000000000006331473134377200152270ustar00rootroot00000000000000case $XARCH in i386) uname -a git clone git://github.com/ocaml/ocaml -b $OCAML_BRANCH --depth 1 cd ocaml ./configure make world.opt sudo make install cd .. rm -rf ocaml git clone git://github.com/ocaml/ocamlbuild cd ocamlbuild make sudo make install cd .. rm -rf ocamlbuild ./configure $CONFIGURE_ARGS && make && sudo make install ;; *) echo unknown arch exit 1 ;; esac camlp4-5.3-1/.travis.yml000066400000000000000000000003531473134377200150240ustar00rootroot00000000000000language: c script: bash -ex .travis-ci.sh env: - OCAML_BRANCH=4.12 XARCH=i386 - OCAML_BRANCH=trunk XARCH=i386 CONFIGURE_ARGS=--skip-version-check jobs: allow_failures: - if: CONFIGURE_ARGS = --skip-version-check camlp4-5.3-1/CHANGES.md000066400000000000000000000006661473134377200143140ustar00rootroot000000000000004.02.1+1 -------- * map `functor () ->` to `functor * ->` like OCaml * fix hanging problem in the toplevel 4.02.0+2 -------- * raise an error when passing "with type M.t := ..." to OCaml * Make scripts insensitive to `CDPATH` * fix build when ocamlopt is not available * fix the default value of `PKGDIR` 4.02.0+1 -------- * support the `M()` syntax * support for extensible types * support the `match ... with exception ...` syntax camlp4-5.3-1/LICENSE000066400000000000000000000634241473134377200137300ustar00rootroot00000000000000Camlp4 is distributed under the terms of the GNU Library General Public License version 2 (included below). As a special exception to the GNU Library General Public License, you may link, statically or dynamically, a "work that uses the Library" with a publicly distributed version of the Library to produce an executable file containing portions of the Library, and distribute that executable file under terms of your choice, without any of the additional requirements listed in clause 6 of the GNU Library General Public License. By "a publicly distributed version of the Library", we mean either the unmodified Library as distributed by INRIA, or a modified version of the Library that is distributed under the conditions defined in clause 2 of the GNU Library General Public License. This exception does not however invalidate any other reasons why the executable file might be covered by the GNU Library General Public License. ---------------------------------------------------------------------- GNU LIBRARY GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1991 Free Software Foundation, Inc. 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the library GPL. It is numbered 2 because it goes with version 2 of the ordinary GPL.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Library General Public License, applies to some specially designated Free Software Foundation software, and to any other libraries whose authors decide to use it. You can use it for your libraries, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library, or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link a program with the library, you must provide complete object files to the recipients so that they can relink them with the library, after making changes to the library and recompiling it. And you must show them these terms so they know their rights. Our method of protecting your rights has two steps: (1) copyright the library, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the library. Also, for each distributor's protection, we want to make certain that everyone understands that there is no warranty for this free library. If the library is modified by someone else and passed on, we want its recipients to know that what they have is not the original version, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that companies distributing free software will individually obtain patent licenses, thus in effect transforming the program into proprietary software. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License, which was designed for utility programs. This license, the GNU Library General Public License, applies to certain designated libraries. This license is quite different from the ordinary one; be sure to read it in full, and don't assume that anything in it is the same as in the ordinary license. The reason we have a separate public license for some libraries is that they blur the distinction we usually make between modifying or adding to a program and simply using it. Linking a program with a library, without changing the library, is in some sense simply using the library, and is analogous to running a utility program or application program. However, in a textual and legal sense, the linked executable is a combined work, a derivative of the original library, and the ordinary General Public License treats it as such. Because of this blurred distinction, using the ordinary General Public License for libraries did not effectively promote software sharing, because most developers did not use the libraries. We concluded that weaker conditions might promote sharing better. However, unrestricted linking of non-free programs would deprive the users of those programs of all benefit from the free status of the libraries themselves. This Library General Public License is intended to permit developers of non-free programs to use free libraries, while preserving your freedom as a user of such programs to change the free libraries that are incorporated in them. (We have not seen how to achieve this as regards changes in header files, but we have achieved it as regards changes in the actual functions of the Library.) The hope is that this will lead to faster development of free libraries. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, while the latter only works together with the library. Note that it is possible for a library to be covered by the ordinary General Public License rather than by this special one. GNU LIBRARY GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Library General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also compile or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. c) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. d) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Library General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. , 1 April 1990 Ty Coon, President of Vice That's all there is to it! camlp4-5.3-1/Makefile000066400000000000000000000015151473134377200143540ustar00rootroot00000000000000OB := ocamlbuild -classic-display -use-ocamlfind -plugin-tag "package(camlp-streams)" DESTDIR= -include config.sh OB += $(OB_FLAGS) .PHONY: default default: byte .PHONY: byte byte: $(OB) `sh ./build/camlp4-byte-only.sh` .PHONY: native native: $(OB) `sh ./build/camlp4-native-only.sh` .PHONY: all all: byte native .PHONY: install install: env DESTDIR=$(DESTDIR) sh ./build/install.sh .PHONY: install-META install-META: camlp4/META mkdir -p $(DESTDIR)${PKGDIR}/camlp4/ cp -f camlp4/META $(DESTDIR)${PKGDIR}/camlp4/ camlp4/META: camlp4/META.in sed -e s/@@VERSION@@/${version}/g $? > $@ .PHONY: bootstrap bootstrap: sh ./build/camlp4-bootstrap.sh .PHONY: Camlp4Ast Camlp4Ast: sh ./build/camlp4-mkCamlp4Ast.sh .PHONY: clean clean: rm -rf _build .PHONY: distclean distclean: rm -rf _build myocamlbuild_config.ml Makefile.config camlp4-5.3-1/README.md000066400000000000000000000030201473134377200141640ustar00rootroot00000000000000camlp4 ====== Camlp4 was a software system for writing extensible parsers for programming languages. Since August 2019, Camlp4 is no longer actively maintained and the last release to support all OCaml language features was 4.08. Later releases will try to keep camlp4 buildable, by supporting new OCaml AST but not new syntax constructions, which means camlp4 will be able to parse only OCaml language up to 4.08. Rationale: existing code using camlp4 will still be buildable, but no new code should be written with camlp4. Maintainers of Camlp4-using projects are encouraged to switch to other systems: - For new projects or actively-moving projects, we recommend adopting ppx attributes and extensions, which is now the preferred way to perform AST transformations on OCaml programs. - For slow-moving projects or users of other Camlp4 features (extensible grammars), switching to the (maintained) [Camlp5](https://github.com/camlp5/camlp5) variant of the preprocessor should be easy. Building from git ----------------- Camlp4 branches try to follow OCaml ones. To build with the trunk of OCaml, you need to use the trunk branch of Camlp4. To build for a specific version, for instance 4.02.1, use the 4.02 branch of Camlp4. Updating to new OCaml version checklist --------------------------------------- 1. Update code :) 2. Update camlp4_version in configure 3. Update version field in opam file 4. Update CI to use new version (TBD currently there is travis but it is not working) 5. Branch and tag to match previous versions camlp4-5.3-1/_tags000066400000000000000000000035511473134377200137360ustar00rootroot00000000000000############################################################################ # # # OCaml # # # # Nicolas Pouillard, projet Gallium, INRIA Rocquencourt # # # # Copyright 2007 Institut National de Recherche en Informatique et # # en Automatique. All rights reserved. This file is distributed under # # the terms of the GNU Library General Public License, with the special # # exception on linking described in LICENSE at the top of the Camlp4 # # source tree. # # # ############################################################################ # Ocamlbuild tags file # We want -g everywhere it's possible true: debug # Enforce safe-string true: safe_string true: warn(@8) : use_import : package(dynlink), package(camlp-streams) : use_ocamlcommon : package(unix) : -package(unix) : package(dynlink) : package(dynlink) : package(unix) #<**/*.ml*>: warn_error(A-3), warn(-3) <**/*.ml*>: package(camlp-streams) # The tag "camlp4boot" is for preprocessing using camlp4/boot/camlp4boot.byte : camlp4boot, warn_Z : -camlp4boot or or "camlp4/Camlp4/Struct/Lexer.ml": -camlp4boot, -warn_Z, warn_a : -debug camlp4-5.3-1/build/000077500000000000000000000000001473134377200140115ustar00rootroot00000000000000camlp4-5.3-1/build/camlp4-bootstrap-recipe.txt000066400000000000000000000132571473134377200212220ustar00rootroot00000000000000############################################################################ # # # 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 GNU Library General Public License, with the special # # exception on linking described in LICENSE at the top of the Camlp4 # # source tree. # # # ############################################################################ === Short version === # Run the following command until you see three fixpoint: make clean byte install bootstrap === Install the bootstrapping camlp4 processor === make install === Build camlp4 === make === Bootstrap camlp4 === # First "Build camlp4" # Then "Install the bootstrapping camlp4 processor" # Indeed the following bootstrapping script # does use the installed version! make bootstrap # 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! make Camlp4Ast === 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 camlp4-5.3-1/build/camlp4-bootstrap.sh000077500000000000000000000041641473134377200175500ustar00rootroot00000000000000#!/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 GNU Library General Public License, with the special # # exception on linking described in LICENSE at the top of the Camlp4 # # source tree. # # # ############################################################################ # README: to bootstrap camlp4 have a look at build/camlp4-bootstrap-recipe.txt set -e if [ ! -e camlp4/META.in ] ; then echo "script $0 invoked from the wrong location" exit 1 fi . ./config.sh export PATH=$BINDIR:$PATH TMPTARGETS="\ camlp4/boot/Lexer.ml" TARGETS="\ camlp4/boot/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 cmd() { echo $@ $@ } cmd camlp4o _build/camlp4/Camlp4/Struct/Lexer.ml -printer r -o camlp4/boot/Lexer.ml cmd camlp4boot \ -printer r \ -filter map \ -filter fold \ -filter meta \ -filter trash \ -impl camlp4/Camlp4/Struct/Camlp4Ast.mlast \ -o camlp4/boot/Camlp4Ast.ml for t in Camlp4 camlp4boot; do cmd camlp4boot -impl camlp4/boot/$t.ml4 -printer o -D OPT -o camlp4/boot/$t.ml done rm -f camlp4/boot/Lexer.ml for t in $TARGETS; do echo promote $t if cmp $t $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 camlp4-5.3-1/build/camlp4-byte-only.sh000077500000000000000000000022401473134377200174460ustar00rootroot00000000000000#!/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 GNU Library General Public License, with the special # # exception on linking described in LICENSE at the top of the Camlp4 # # source tree. # # # ############################################################################ set -e if [ ! -e camlp4/META.in ] ; then echo "script $0 invoked from the wrong location" exit 1 fi . ./config.sh . build/camlp4-targets.sh set -x echo $CAMLP4_BYTE camlp4-5.3-1/build/camlp4-mkCamlp4Ast.sh000077500000000000000000000030411473134377200176440ustar00rootroot00000000000000#!/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 GNU Library General Public License, with the special # # exception on linking described in LICENSE at the top of the Camlp4 # # source tree. # # # ############################################################################ set -e if [ ! -e camlp4/META.in ] ; then echo "script $0 invoked from the wrong location" exit 1 fi . ./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" cmd() { echo $@ $@ } cmd camlp4boot \ -printer r \ -filter map \ -filter fold \ -filter meta \ -filter trash \ -impl camlp4/Camlp4/Struct/Camlp4Ast.mlast \ -o camlp4/boot/Camlp4Ast.ml camlp4-5.3-1/build/camlp4-native-only.sh000077500000000000000000000022421473134377200177730ustar00rootroot00000000000000#!/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 GNU Library General Public License, with the special # # exception on linking described in LICENSE at the top of the Camlp4 # # source tree. # # # ############################################################################ set -e if [ ! -e camlp4/META.in ] ; then echo "script $0 invoked from the wrong location" exit 1 fi . ./config.sh . build/camlp4-targets.sh set -x echo $CAMLP4_NATIVE camlp4-5.3-1/build/camlp4-targets.sh000077500000000000000000000037071473134377200172060ustar00rootroot00000000000000#!/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 GNU Library General Public License, with the special # # exception on linking described in LICENSE at the top of the Camlp4 # # source tree. # # # ############################################################################ CAMLP4_BYTE="\ camlp4/Camlp4.cmo \ camlp4/Camlp4Top.cmo \ camlp4/camlp4prof.byte$EXE \ camlp4/mkcamlp4.byte$EXE \ camlp4/camlp4.byte$EXE \ camlp4/camlp4fulllib.cma" CAMLP4_NATIVE="\ camlp4/Camlp4.cmx \ camlp4/camlp4prof.native$EXE \ camlp4/mkcamlp4.native$EXE \ camlp4/camlp4.native$EXE \ camlp4/camlp4fulllib.cmxa" if [ "$OCAMLNAT" = "true" ]; then CAMLP4_NATIVE="$CAMLP4_NATIVE camlp4/Camlp4Top.cmx" fi 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" if [ "$OCAMLNAT" = "true" ]; then CAMLP4_NATIVE="$CAMLP4_NATIVE camlp4/$i.cmxa" fi 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 .. camlp4-5.3-1/build/install.sh000077500000000000000000000111731473134377200160210ustar00rootroot00000000000000#!/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 GNU Library General Public License, with the special # # exception on linking described in LICENSE at the top of the Camlp4 # # source tree. # # # ############################################################################ set -e if [ ! -e camlp4/META.in ] ; then echo "script $0 invoked from the wrong location" exit 1 fi # 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}" . ./config.sh BINDIR="$DESTDIR${SAVED_BINDIR:-${BINDIR}}" LIBDIR="$DESTDIR${SAVED_LIBDIR:-${LIBDIR}}" 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/camlp4 cd ./_build echo "Installing camlp4..." installbin camlp4/camlp4prof.byte$EXE $BINDIR/camlp4prof$EXE installbin camlp4/mkcamlp4.byte$EXE $BINDIR/mkcamlp4$EXE installbin camlp4/camlp4.byte$EXE $BINDIR/camlp4$EXE installbin camlp4/camlp4boot.byte$EXE $BINDIR/camlp4boot$EXE installbin camlp4/camlp4o.byte$EXE $BINDIR/camlp4o$EXE installbin camlp4/camlp4of.byte$EXE $BINDIR/camlp4of$EXE installbin camlp4/camlp4oof.byte$EXE $BINDIR/camlp4oof$EXE installbin camlp4/camlp4orf.byte$EXE $BINDIR/camlp4orf$EXE installbin camlp4/camlp4r.byte$EXE $BINDIR/camlp4r$EXE installbin camlp4/camlp4rf.byte$EXE $BINDIR/camlp4rf$EXE installbin camlp4/camlp4o.native$EXE $BINDIR/camlp4o.opt$EXE installbin camlp4/camlp4of.native$EXE $BINDIR/camlp4of.opt$EXE installbin camlp4/camlp4oof.native$EXE $BINDIR/camlp4oof.opt$EXE installbin camlp4/camlp4orf.native$EXE $BINDIR/camlp4orf.opt$EXE installbin camlp4/camlp4r.native$EXE $BINDIR/camlp4r.opt$EXE installbin camlp4/camlp4rf.native$EXE $BINDIR/camlp4rf.opt$EXE cd ./camlp4 CAMLP4DIR=$LIBDIR/camlp4 for dir in Camlp4Parsers Camlp4Printers Camlp4Filters Camlp4Top; do echo "Installing $dir..." mkdir -p $CAMLP4DIR/$dir installdir \ $dir/*.cm* \ $dir/*$O \ $CAMLP4DIR/$dir done installdir \ camlp4lib.cma camlp4lib.cmxa Camlp4.cmi \ camlp4fulllib.cma camlp4fulllib.cmxa \ camlp4o.cma camlp4of.cma camlp4oof.cma \ camlp4orf.cma camlp4r.cma camlp4rf.cma \ Camlp4Bin.cm[iox] Camlp4Bin$O Camlp4Top.cm[io] \ config/Camlp4_config.cmi camlp4prof.cm[iox] camlp4prof$O \ $CAMLP4DIR if [ "$OCAMLNAT" = "true" ]; then installdir \ camlp4o.cmxa camlp4of.cmxa camlp4oof.cmxa \ camlp4orf.cmxa camlp4r.cmxa camlp4rf.cmxa \ $CAMLP4DIR fi installlibdir camlp4lib$A camlp4fulllib$A $CAMLP4DIR if [ "$OCAMLNAT" = "true" ]; then installlibdir \ camlp4o$A camlp4of$A camlp4oof$A \ camlp4orf$A camlp4r$A camlp4rf$A \ $CAMLP4DIR fi cd .. camlp4-5.3-1/camlp4/000077500000000000000000000000001473134377200140725ustar00rootroot00000000000000camlp4-5.3-1/camlp4/.ignore000066400000000000000000000000271473134377200153550ustar00rootroot00000000000000.cache-status *.tmp.ml camlp4-5.3-1/camlp4/CHANGES000066400000000000000000001220331473134377200150660ustar00rootroot00000000000000- [...] In the revised syntax of parsers the "?" is now a "??" like in the orignal syntax to not conflict with optional labels. - [29 Jun 05] Add private row types. Make "private" a type constructor "TyPrv" rather than a flag. (Jacques) - [09 Jun 04] Moved "-no_quot" option from pa_o to camlp4, enabling to use it indepently fom pa_o.cmo. - [17 Nov 04] Renamed "loc" into "_loc", introducing an incompatibility with existing code (3.08.x and before). Such code can generally run unmodified using the -loc option (camlp4 -loc "loc"). Camlp4 Version 3.08.2 ------------------------ - [07 Oct 04] Changes in the interfaces plexer.mli and pcaml.mli: - plexer.mli: introduced a new lexer building function `make_lexer', similar to `gmake', but returning a triple of references in addition (holding respectively the character number of the beginning of the current line, the current line number and the name of the file being parsed). - pcaml.mli: a new value `position'. A global reference to a triple like the one mentioned above. - [07 Sep 04] Camlp4 grammars `error recovery mode' now issues a warning when used (but this warning is disabled by default). Camlp4 Version 3.08.[01] ------------------------ - [05 Jul 04] creation of the `unmaintained' directory: pa_format, pa_lefteval, pa_ocamllex, pa_olabl, pa_scheme and pa_sml go there, each in its own subdir. Currently, they compile fine. - [05 Jul 04] pa_ifdef, subsumed by pa_macro since 3.07, prints a warning when loaded, encouraging use of pa_macro. - [01 July 04] profiled versions of Camlp4 libs are *NOT* installed by default (not even built). To build and install them, uncomment the line PROFILING=prof in camlp4/config/Makefile.tpl, and then make opt.opt && make install - [22-23 June 04] `make install' now installs also pa_[or].cmx, pa_[or]p.cmx, pa_[or]_fast.cmx, and odyl.cmx - [12 may 04] Added to the camlp4 tools the -version option that prints the version number, in the same way as the other ocaml tools. - [12 may 04] Locations are now handled as in OCaml. The main benefit is that line numbers are now correct in error messages. However, this slightly changes the interface of a few Camlp4 modules (see ICHANGES). ** Warning: Some contribs of the camlp4 distribution are broken because of this change. In particular the scheme/lisp syntaxes. - [20 nov 03] Illegal escape sequences in strings now issue a warning. Camlp4 Version 3.07 ___________________ - [29 Sep 03] Camlp4 code now licensed under the LGPL minus clause 6. - [09 Sep 03] Added tokens LABEL and OPTLABEL in plexer, and use them in both parsers (ocaml and revised). There was, afaik, no other way to fix ambiguities (bugs) in parsing labels and type constraints. Camlp4 Version 3.07 beta1 ________________________ - [July 03] Updated the ocaml/camlp4 CVS tree with the camlp4 "parallel" CVS tree, which becomes obsolete from now on. Added support for recursive modules, private data constructors, and new syntaxes for integers (int32, nativeint, ...). Camlp4 Version 3.06++ ----------------------- - [02 Dec 02] In AST predefined quotation, changed antiquotations for "rec", "mutable": now all are with coercion "opt": $opt:...$ (instead of "rec" and "mut"). Added antiquotation for "private". Cleaned up the entries for "methods" and for labelled and optional parameters. - [29 Nov 02] Removed all "extract_crc" stuff no more necessary with the new interface of Dynlink. - [26 Nov 02] Added ability to use "#use" directives in compiled files. - [21 Nov 02] Changed Scheme syntax for directives: now, e.g. #load "file" is written: # (load "file"). Added directives in "implem", "interf" and "use" directive. - [20 Nov 02] Added Grammar.glexer returning the lexer used by a grammar. Also added a field in Token.glexer type to ask lexers to record the locations of the comments. - [04 Nov 02] Added option -no_quot with normal syntax (pa_o.cmo): don't parse quotations (it allows to use e.g. <:> as a valid token). - [31 Oct 02] Added pa_macro.cmo (to replace pa_ifdef.cmo which is kept for compatibility, but deprecated). The extended statements allow de definitions of macros and conditional compilation like in C. - [29 Oct 02] Changed pretty printers of the three main syntaxes: if the locations of input are not correct, do no more raise End_of_file when displaying the inter-phrases (return: the input found up to eof if not empty, otherwise the value of the -sep parameter if not empty, otherwise the string "\n"). - [25 Oct 02] Added option -records in pa_sml.cmo: generates normal OCaml records instead of objects (the user must be sure that there are no names conflicts). - [22 Oct 02] Added Plexer.specific_space_dot: when set to "true", the next call to Plexer.gmake returns a lexer where the dot preceded by spaces (space, tab, newline, etc.) return a different token than when not preceded by spaces. - [19 Oct 02] Added printer in Scheme syntax: pr_scheme.cmo and the extension pr_schemep.cmo which rebuilts parsers. - [15 Oct 02] Now, in case of syntax error, the real input file name is displayed (can be different from the input file, because of the possibility of line directives, typically generated by /lib/cpp). Changed interface of Stdpp.line_of_loc: now return also a string: the name of the real input file name. - [14 Oct 02] Fixed bug in normal syntax (pa_o.cmo): the constructors with currification of parameters (C x y) were accepted. - [14 Oct 02] Fixed many problems of make under Windows (in particular if installations directories contain spaces). - [11 Oct 02] In ocaml syntax (pa_o.cmo), fixed 3 bugs (or incompatibilities with the ocaml yacc version of the compiler): 1/ "ref new foo" was interpreted as "ref;; new foo" instead of "ref (new foo)" 2/ unary minuses did not work correctly (nor in quotation of syntax trees), in particular "-0.0" 3/ "begin end" was a syntax error, instead of being "()". - [Sep-Oct 02] Many changes and improvements in Scheme syntax. - [07 Oct 02] Added definition of Pcaml.type_declaration which is now visible in the interface, allowing to change the type declarations. - [07 Oct 02] Added Pcaml.syntax_name to allow syntax extensions to test it and take different decision. In revised syntax, its value is "Revised", in normal syntax "OCaml" and in Scheme syntax "Scheme". - [03 Oct 02] Added lexing of '\xHH' where HH is hexadecimal number. - [01 Oct 02] In normal syntax (camlp4o), fixed problem of lexing comment: (* bleble'''*) - [23 Sep 02] Fixed bug: input "0x" raised Failure "int_of_string" without location (syntaxes pa_o and pa_r). - [14 Sep 02] Added functions Grammar.iter_entry and Grammar.fold_entry to iterate a grammar entry and transitively all the entries it calls. - [12 Sep 02] Added "Pcaml.rename_id", a hook to allow parsers to give ability to rename their identifiers. Called in Scheme syntax (pa_scheme.ml) when generating its identifiers. - [09 Sep 02] Fixed bug under toplevel, the command: !Toploop.parse_toplevel_phrase (Lexing.from_buff "1;;");; failed "End_of_file". - [06 Sep 02] Added "Pcaml.string_of". Combined with Pcaml.pr_expr, Pcaml.pr_patt, and so on, allow to pretty print syntax trees in string. E.g. in the toplevel: # #load "pr_o.cmo"; # Pcaml.string_of Pcaml.pr_expr <:expr< let x = 3 in x + 2 >>;; - : string = "let x = 3 in x + 2" Camlp4 Version 3.06 -------------------- - [24 Jul 02] Added Scheme syntax: pa_scheme.ml, camlp4sch.cma (toplevel), camlp4sch (command). Camlp4 Version 3.05 ----------------------- - [12 Jul 02] Better treatment of comments in option -cip (add comments in phrases) for both printers pr_o.cmo (normal syntax) and pr_r.cmo (revised syntax); added comments before let binding and class structure items; treat comments inside sum and record type definitions; the option -tc is now deprecated and equivalent to -cip. - [13 Jun 02] Added pa_lefteval.cmo: add let..in expressions to guarantee left evaluation of functions parameters, t-uples, and so on (instead of the default non-specified-but-in-fact-right-to-left evaluation). - [06 Jun 02] Changed revised syntax (pa_r) of variants types definition; (Jacques Garrigue's idea): old syntax new syntax [| ... |] [ = ... ] [| < ... |] [ < ... ] [| > ... |] [ > ... ] This applies also in predefined quotations of syntax tree for types <:ctyp< ... >> - [05 Jun 02] Added option -ss in pr_o.cmo: print with double semicolons; and the option -no_ss is now by default. - [30 May 02] Improved SML syntax (pa_sml). - [30 May 02] Changed the AST for the "with module" construct (was with type "module_type"; changed into type "module_expr"). - [26 May 02] Added missing abstract module types. - [21 Apr 02] Added polymorphic types for polymorphic methods: revised syntax (example): ! 'a 'b . type ctyp quotation: <:ctyp< ! $list:pl$ . $t$ >> - [17 Apr 02] Fixed bug: in normal syntax (pa_o.cmo) made a parse error on the "dot" on (in interface file file): class c : a * B.c -> object val x : int end - [03 Apr 02] Fixed bug: (* "(*" *) resulted in "comment not terminated". - [03 Apr 02] Fixed incompatibility with ocaml: ''' and '"' must be displayed as '\'' and '\"' in normal syntax printer (pr_o.cmo). - [03 Apr 02] When there are several tokens parsed together (locally LL(n)), the location error now highlights all tokens, resulting in a more clear error message (e.g. "for i let" would display "illegal begin of expr" and highlight the 3 tokens, not just "for"). - [30 Mar 02] Added pa_extfold.cmo extending pa_extend.cmo by grammar symbols FOLD0 and FOLD1. Work like LIST0 and LIST1 but have two initial parameters: a function of type 'a -> 'b -> 'b doing the fold and an initial value of type 'b. Actually, LIST0 now is like FOLD0 (fun x y -> x :: y) [] with an reverse of the resulting list. - [20 Mar 02] Fixed problem: when running a toplevel linked with camlp4 as a script, the camlp4 welcome message was displayed. - [14 Mar 02] The configure shell and the program now test the consistency of OCaml and Camlp4. Therefore 1/ if trying to compile this version with an incompatible OCaml version or 2/ trying to run an installed Camlp4 with a incompatible OCaml version: in both cases, camlp4 fails. - [14 Mar 02] When make opt.opt is done, the very fast version is made for the normal syntax ("compiled" version). The installed camlp4o.opt is that version. - [05 Mar 02] Changed the conversion to OCaml syntax tree for <:expr< x.val >> and <:expr< x.val := e >> which generates now the tree of !x and x := e, no more x.contents and x.contents <- e. This change was necessary because of a problem if a record has been defined with a field named "contents". - [16 Feb 02] Changed interface of grammars: the token type is now customizable, using a new lexer type Token.glexer, parametrized by the token type, and a new functor GMake. This was accompanied by some cleanup. Become deprecated: the type Token.lexer (use Token.glexer), Grammar.create (use Grammar.gcreate), Unsafe.reinit_gram (use Unsafe.gram_reinit), the functor Grammar.Make (use Grammar.GMake). Deprecated means that they are kept during some versions and removed afterwards. - [06 Feb 02] Added missing infix "%" in pa_o (normal syntax). - [06 Feb 02] Added Grammar.print_entry printing any kind of (obj) entry and having the Format.formatter as first parameter (Grammar.Entry.print and its equivalent in functorial interface call it). - [05 Feb 02] Added a flag Plexer.no_quotations. When set to True, the quotations are no more lexed in all lexers built by Plexer.make () - [05 Feb 02] Changed the printing of options so that the option -help aligns correctly their documentation. One can use now Pcaml.add_option without having to calculate that. - [05 Feb 02] pr_r.cmo: now the option -ncip (no comments in phrases) is by default, because its behaviour is not 100% sure. An option -cip has been added to set it. - [03 Feb 02] Added function Stdpp.line_of_loc returning the line and columns positions from a character location and a file. - [01 Feb 02] Fixed bug in token.ml: the location function provided by lexer_func_of_parser, lexer_func_of_ocamllex and make_stream_and_location could raise Invalid_argument "Array.make" for big files if the number of read tokens overflows the maximum arrays size (Sys.max_array_length). The bug is not really fixed: in case of this overflow, the returned location is (0, 0) (but the program does not fail). - [28 Jan 02] Fixed bug in pa_o when parsing class_types. A horrible hack had to be programmed to be able to treat them correctly. - [28 Jan 02] Fixed bug in OCaml toplevel when loading camlp4: the directives were not applied in the good order. - [26 Jan 02] The printer pr_extend.cmo try now also to rebuild GEXTEND statements (before it tried only the EXTEND). - [23 Jan 02] The empty functional stream "fstream [: :]" is now of type 'a Fstream.t thanks to the new implementation of lazies allowing to create polymorphic lazy values. - [11 Jan 02] Added a test in grammars using Plexer that a keyword is not used also as parameter of a LIDENT or a UIDENT. - [04 Jan 02] Fixed bug in pa_sml (SML syntax): the function definitions with several currified parameters did not work. It works now, but the previous code was supposed to treat let ("fun" in SML syntax) definitions of infix operators, what does not work any more now. - [04 Jan 02] Alain Frisch's contribution: Added pa_ocamllex.cma, syntax for ocamllex files. The command: camlp4 pa_ocamllex.cmo pr_o.cmo -ocamllex -impl foo.mll > foo.ml does the same thing as: ocamllex foo.mll Allow to compile directly mll files. Without option -ocamllex, allow to insert lex rules in a ml file. - [29 Dec 01] Added variable "inter_phrases" in Pcaml, of type ref (option string) to specify the string to print between phrases in pretty printers. The default is None, meaning to copy the inter phrases from the source file. Camlp4 Version 3.04 ------------------- - [07 Dec 01] Added Pcaml.parse_interf and Pcaml.parse_implem, hooks to specify the parsers tof use, i.e. now can use other parsing technics than the Camlp4 grammar system. - [27 Nov 01] Fixed functions Token.eval_char and Token.eval_string which returned bad values, resulting lexing of backslash sequences incompatible with OCaml (e.g. "\1" returned "\001" (one character) but OCaml returns the string of the two characters \ and 1). - [15 Nov 01] In revised syntax, in let binding in sequences, the "in" can be replaced by a semicolon; the revised syntax printer pr_r.cmo now rather prints a semicolon there. - [07 Nov 01] Added the ability to use $ as token: was impossible so far, because of AST quotation uses it for its antiquotation. The fix is just a little (invisible) change in Plexer. - [05 Nov 01] Added option -tc (types comment) when using pr_o or pr_r try to print comments inside sum and record types like they are in the source (not by default, because may work incorrectly). - [05 Nov 01] Added option -ca (comment after) when using pr_o or pr_r: print ocamldoc comments after the declarations, when they are before. - [04 Nov 01] Added locations for variants and labels declarations in AST (file MLast.mli). - [03 Nov 01] In pretty printers pr_o and pr_r, skip to next begin of line when displaying the sources between phrase, to prevent e.g. the displaying of the possible last comment of a sum type declaration (the other comment being not displayed anyway). - [24 Oct 01] Fixed incorrect locations in sequences. - [24 Oct 01] Was erroneously compiled by the OCaml boot compiler instead of the generated ocamlc. Fixed. - [15 Oct 01] Fixed some parsing differences between pa_o and ocamlyacc: in parsers, in labels. - [12 Oct 01] Added missing bigarray syntax a.{b} (and Cie) in standard syntax (pa_o). Camlp4 Version 3.03 ------------------- - [09 Oct 01] Fixed bug: the token !$ did not work. Fixed and completed some syntaxes of labels patterns. Added missing case in exception declaration (exception rebinding). - [05 Oct 01] Fixed bug in normal syntax: when defining a constructor named "True" of "False" (capitalized, i.e. not like the booleans), it did not work. - [04 Oct 01] Fixed some revised and quotation syntaxes in objects classes and types (cleaner). Cleaned up also several parts of the parsers. - [02 Oct 01] In revised syntax, the warning for using old syntax for sequences is now by default. To remove it, the option -no-warn-seq of camlp4r has been added. Option -warn-seq has been removed. - [07 Sep 01] Included Camlp4 in OCaml distribution. - [06 Sep 01] Added missing pattern construction #t - [05 Sep 01] Fixed bug in pa_o: {A.B.c = d} was refused. - [26 Aug 01] Fixed bug: in normal and revised syntaxes, refused -1.0 (minus float) as pattern. - [24 Aug 01] Fixed bug: (a : b :> c) and ((a : b) :> c) were parsed identically. - [20 Aug 01] Fixed configure script for Windows configuration. - [10 Aug 01] Fixed bug: <:expr< 'a' >> did not work because of a typing problem. - [10 Aug 01] Fixed bug in compilation process under Windows: the use of the extension .exe was missing in several parts in Makefiles and shell scripts. - [09 Aug 01] Changed message error in grammar: in the case when the rule is: ....; tok1; tok2; .. tokn; ... (n terminal tokens following each other), where the grammar is locally LL(n), it displays now: tok1 tok2 .. tokn expected instead of just tok1 expected because "tok1" can be correct in the input, and in this case, the message underscored the tok1 and said "tok1 expected". - [07 Aug 01] When camlp4r.cma is loaded in the toplevel, the results are now displayed in revised syntax. - [04 Aug 01] Added syntax "declare..end" in quotations class_str_item and class_sig_item to be able to generate several items from one only item (like in str_item and sig_item). Camlp4 Version 3.02 ------------------- - [21 Jul 01] Fixed bug: <:expr< { l = x } >> was badly built and resulted in a typing error. - [13 Jul 01] Fixed bug: did not accept floats in patterns. - [11 Jul 01] Added function Pcaml.top_printer to be able to use the printers Pcaml.pr_expr, Pcaml.pr_patt, and so on for the #install_printer of OCaml toplevel. Ex: let f = Pcaml.top_printer Pcaml.pr_expr;; #install_printer f;; #load "pr_o.cmo";; - [24 Jun 01] In grammars, added symbol ANY, returning the current token, whichever it is. - [24 Jun 01] In grammars, a rule list of the form [ s1 | s2 | .. | sn ] is interpreted as [ x = s1 -> x | x = s2 -> x | .. x = sn -> x ] instead of [ _ = s1 -> () | _ = s2 -> () .. ] - [24 Jun 01] Moved the functions [Plexer.char_of_char_token] and [Plexer.string_of_string_token] into module [Token] with names [Token.eval_char] and [Token.eval_string]. - [22 Jun 01] Added warning when using old syntax for sequences, while and do (do..return, do..done) in predefined quotation expr. - [22 Jun 01] Changed message for unbound quotations (more clear). Camlp4 Version 3.01.6: ---------------------- - [22 Jun 01] Changed the module Pretty into Spretty. - [21 Jun 01] Camlp4 can now be compiled even if OCaml is not installed: in the directory "config", the file "configure_batch" is a possibility to configure the compilation (alternative of "configure" of the top directory) and has a parameter "-ocaml-top" to specify the OCaml top directory (relative to the camlp4/config directory). - [21 Jun 01] The interactive "configure" now tests if the native-code compilers ocamlc.opt and ocamlopt.opt are accessible and tell the Makefile to preferably use them if they are. - [16 Jun 01] The syntax tree for strings and characters now represent their exact input representation (the node for characters is now of type string, no more char). For example, the string "a\098c" remains "a\098c" and is *not* converted into (the equivalent) "abc" in the syntax tree. The convertion takes place when converting into OCaml tree representation. This has the advantage that the pretty print now display them as they are in the input file. To convert from input to real representation (if needed), two functions have been added: Plexer.string_of_string_token and Plexer.char_of_char_token. - [10 Jun 01] In revised syntax, added ability to write {foo x = y} as short form for {foo = fun x -> y}. - [08 Jun 01] Completed missing cases in pa_extfun.cmo for variants. - [06 Jun 01] Completed missing cases in abstract syntax tree and in normal syntax parser pa_o.ml (about classes). - [06 Jun 01] Fixed bug in pa_o.cmo (parser of normal syntax): (~~) did not work, and actually all prefix operators between parentheses. Camlp4 Version 3.01.5: ---------------------- - [04 Jun 01] Fixed bug: when using "include" in a structure item the rest of the structure was lost. - [31 May 01] Added ability to user #load and #directory inside ml or mli files to specify a cmo file to be loaded (for syntax extension) or the directory path (like option -I). Same semantics than in toplevel. - [29 May 01] The name of the location variable used in grammars (action parts of the rules) and in the predefined quotations for OCaml syntax trees is now configurable in Stdpp.loc_name (string reference). Added also option -loc to set this variable. Default: loc. - [26 May 01] Added functional streams: a library module Fstream and a syntax kit: pa_fstream.cmo. Syntax: streams: fstream [: ... :] parsers: fparser [ [: ... :] -> ... | ... ] - [25 May 01] Added function Token.lexer_func_of a little bit more general than Token.lexer_func_of_parser. Camlp4 Version 3.01.4: ---------------------- - [20 May 01] Fixed bug: pr_rp and pr_op could generate bound variables resulting incorrect program: (e.g. fun s -> parser [: `_; x :] -> s x was printed: fun s -> parser [: `_; s :] -> s s) - [19 May 01] Small improvement in pretty.ml resulting a faster print (no more stacked HOVboxes which printers pr_r and pr_o usually generate in expr, patt, ctyp, etc.) - [18 May 01] Added [lexer_func_of_parser] and [lexer_func_of_ocamllex] in module [Token] to create lexers functions from char stream parsers or from [ocamllex] lexers. - [16 May 01] Pretty printing with pr_r.cmo (revised syntax) now keep comments inside phrases. - [15 May 01] Changed pretty printing system, using now new extensible functions of Camlp4. - [15 May 01] Added library module Extfun for extensible functions, syntax pa_extfun, and a printer pr_extfun. - [12 May 01] Fixed bug: missing cases in pr_o and pr_r for in cases of "for", "while", and some other expressions, when between parentheses. Camlp4 Version 3.01.3: ---------------------- - [04 May 01] Put back the syntax "do ... return ..." in predefined quotation "expr", to be able to compile previous programs. Work only if the quotation is in position of expression, not in pattern. - [04 May 01] Added lisp syntax pa_lisp.cmo (not terminated). - [01 May 01] Fixed bug: in toplevel, in case of syntax error in #use, the display was incorrect: it displayed the input, instead of the file location. Camlp4 Version 3.01.2: ---------------------- - [27 Apr 01] Added variable Grammar.error_verbose and option -verbose of command camlp4 to display more information in case of parsing error. - [27 Apr 01] Fixed bug: the locations in sequences was not what expected by OCaml, resulting on bad locations displaying in case of typing error. - [27 Apr 01] Fixed bug: in normal syntax, the sequence was parsed of left associative instead of right associative, resulting bad pretty printing. Camlp4 Version 3.01.1: ---------------------- - [19 Apr 01] Added missing new feature "include" (structure item). - [17 Apr 01] Changed revised syntax of sequences. Now: do { expr1; expr2 ..... ; exprn } for patt = expr to/downto expr do { expr1; expr2 ..... ; exprn } while expr do { expr1; expr2 ..... ; exprn } * If holding a "let ... in", the scope applies up to the end of the sequence. * The old syntax "do .... return ..." is still accepted. * In expr quotation, it is *not* accepted. To ensure backward compatibility, use ifdef NEWSEQ, which answers True from this version. * The printer pr_r.cmo by default prints with this new syntax. * To print with old syntax, use option -old_seq. * To get a warning when using old syntax, use option -warn_seq. Camlp4 Version 3.01: -------------------- - [5 Mar 01] In pa_o.ml fixed problem, did not parse: class ['a, 'b] cl a b : ['a, 'b] classtype - [9 Oct 00] Raise now Stream.Error when parsing with an empty entry (meaning that the user probably forgot to initialize it). - [21 Jul 00] Fixed (pr_o.cmo) pb of bad printing of let (f : unit -> int) = fun () -> 1 - [10 Jun, 21 Jul 00] Added Pcaml.sync to synchronize after syntax error in toplevel. - [24 May 00] Changed the "make opt", returning to what was done in the previous releases, i.e. just the compilation of the library (6 files). The native code compilation of "camlp4o" and "camlp4r" are not absolutely necessary and can create problems in some systems because of too long code. The drawbacks are more important than the advantages. - [19 May 00] Changed option -split_gext (when pa_extend.cmo is loaded) into -split_ext: it applies now also for non functorial grammars (extended by EXTEND instead of GEXTEND). - [12 May 00] Fixed problem in pr_rp.cmo and pr_op.cmo: the pretty printing of the construction "match x with parser" did not work (because of the type constraint "Stream.t _" added some versions ago). Camlp4 Version 3.00: -------------------- - [Apr 19, 00] Added "pa_olabl" for labels with old Olabl syntax. - [Apr 18, 00] Make opt now builds camlp4o.opt and camlp4r.opt - [Apr 17, 00] Added support for labels and variants. - [Mar 28, 00] Improved the grammars: now the rules starting with n terminals are locally LL(n), i.e. if any of the terminal fails, it is not Error but just Failure. Allows to write the OCaml syntax case: ( operator ) ( expr ) with the problem of "( - )" as: "("; "-"; ")" "("; operator; ")" "("; expr; ")" after factorization of the "(", the rule "-"; ")" is locally LL(2): it works for this reason. In the previous implementation, a hack had to be added for this case. To allow this, the interface of "Token" changed. The field "tparse" is now of type "pattern -> option (Stream.t t -> string)" instead of "pattern -> Stream.t t -> string". Set it to "None" for standard pattern parsing (or if you don't know). Camlp4 Version 2.04: -------------------- - [Nov 23, 99] Changed the module name Config into Oconfig, because of conflict problem when applications want to link with the module Config of OCaml. Camlp4 Version 2.03: -------------------- * pr_depend: - [Jun 25, 99] Added missing case in "pr_depend.cmo": pattern A.B.C. - [Jun 5, 99] Fixed in "pr_depend.ml" case expression "Foo.Bar" displaying a bad dependency with file "bar.ml" if existed. And changed "pa_r.ml" (revised syntax parsing) to generate a more logical ast for case "var.Mod.lab". - [Apr 29, 99] Added missing cases in "pr_o.cmo" and in "pr_depend.cmo". - [Mar 11, 99] Added missing cases in "pr_depend.cmo". - [Mar 9, 99] Added missing case in pr_depend.ml. * Other: - [Sep 10, 99] Updated from current OCaml new interfaces. - [Jul 9, 99] Added stream type constraint in pa_oop.ml to reflect the same change in OCaml. - [Jun 24, 99] Added missing "constraint" construction in types - [Jun 15, 99] Added option -I for command "mkcamlp4". - [May 14, 99] Added man pages (links) for camlp4o, camlp4r, mkcamlp4, ocpp - [May 10, 99] Added shell script "configure_batch" in directory "config". - [May 10, 99] Changed LICENSE to BSD. - [Apr 29, 99] Added "ifdef" for mli files. - [Apr 11, 99] Changed option "-no_cp" into "-sep" in pr_r.cmo and pr_o.cmo. - [Apr 11, 99] Fixed (old) bug: too long strings where bad pretty printed. - [Mar 24, 99] Added missing stream type constraint for parsers. - [Mar 17, 99] Changed template Makefile to use ocamlc.opt and ocamlopt.opt by default, instead of ocamlc and ocamlopt. - [Mar 9, 99] Added ifndef in pa_ifdef.ml. - [Mar 7, 99] Completed and fixed some cases in pr_extend.ml. Camlp4 Version 2.02: -------------------- * Parsing: - [Feb 27, 99] Fixed 2 bugs, resulting of incorrect OCaml parsing of the program example: "type t = F(B).t" - [Jan 30, 99] Fixed bug "pa_op.ml", could not parse "parser | [<>] -> ()". - [Jan 16, 99] Added "define" and "undef" in "pa_ifdef.cmo". - [Dec 22, 98] Fixed precedence of "!=" in OCaml syntax * Printing: - [Mar 4, 99] Added pr_depend.cmo for printing file dependencies. - [Dec 28, 98] Fixed pretty printing of long strings starting with spaces; used to display "\\n..." instead of "\\n...". * Camlp4: - [Feb 19, 99] Sort command line argument list in reverse order to avoid argument names conflicts when adding arguments. * Olabl: - [Feb 26, 99] Started extensions for Olabl: directory "lablp4" and some changes in MLast. Olabl programs can be preprocessed by: camlp4 pa_labl.cma pr_ldump.cmo * Internal: - Use of pr_depend.cmo instead of ocamldep for dependencies. Camlp4 Version 2.01: -------------------- Token interface * Big change: the type for tokens and tokens patterns is now (string * string) the first string being the constructor name and the second its possible parameters. No change in EXTEND statements using Plexer. But lexers have: - a supplementary parameter "tparse" to specify how to parse token from token patterns. - fields "using" and "removing" replacing "add_keyword" and "remove_keyword". See the file README-2.01 for how to update your programs and the interface of Token. Grammar interface * The function "keywords" have been replaced by "tokens". The equivalent of the old statement: Grammar.keywords g is now: Grammar.tokens g "" Missing features added * Added "lazy" statement (pa_r.cmo, pa_o.cmo, pr_r.cmo, pr_o.cmo) * Added print "assert" statement (pr_o.cmo, pr_r.cmo) * Added parsing of infix operators like in OCaml (e.g. |||) in pa_o.cmo Compilation * Added "make scratch" * Changed Makefile. No more "make T=../", working bad in some systems. * Some changes to make compilation in Windows 95/98 working better (thanks to Patricia Peratto). Classes and objects * Added quotations for classes and objects (q_MLast.ml) * Added accessible entries in module Pcaml (class_type, class_expr, etc.) * Changed classes and objects types in definition (module MLast) Miscelleneous * Some adds in pa_sml.cmo. Thanks to Franklin Chen. * Added option "-no_cp" when "pr_o.cmo" or "pr_r.cmo" is loaded: do not print comments between phrases. * Added option "-split_gext" when "pa_extend.cmo" is loaded: split GEXTEND by functions to turn around a PowerPC problem. Bug fixes * Fixed pa_r.cmo, pa_o.cmo to parse, and pr_r.cmo, pr_o.cmo to print "(x:#M.c)" * Fixed printing pr_o.cmo of "(a.b <- 1)::1" * Extended options with parameters worked only when the parameter was sticked. Ex: camlp4o pr_o.cmo -l120 foo.ml worked, but not: camlp4o pr_o.cmo -l 120 foo.ml Camlp4 Version 2.00: -------------------- * Designation "righteous" has been renamed "revised". * Added class and objects in OCaml printing (pr_o.cmo), revised parsing (pa_r.cmo) and printing (pr_r.cmo). * Fixed bug in OCaml syntax: let _, x = 1, 2;; was refused. Camlp4 Version 2.00--1: ----------------------- * Added classes and objects in OCaml syntax (pa_o.cmo) * Fixed pr_r.cmo et pr_r.cmo which wrote on stdout, even when option -o Camlp4 Version 2.00--: ---------------------- * Adapted for OCaml 2.00. * No objects and classes in this version. * Added "let module" parsing and printing. * Added arrays patterns parsing and printing. * Added records with "with" "{... with ...}" parsing and printing * Added # num "string" in plexer (was missing). * Fixed bug in pr_o.cmo: module A = B (C);; was printed module A = B C;; * Added "pa_sml.cmo", SML syntax + "lib.sml" * Fixed bug in pa_r.ml and pa_o.ml: forgot to clear let_binding * Changed Plexer: unknown keywords do not raise error but return Tterm * q_MLast.cmo: suppressed <:expr< [$list:el$] >> (cannot work) * Added option "-no_ss" (no ;;) when "pr_o.cmo" loaded * Many changes and bug fixing in pretty printing pr_o.cmo and pr_r.cmo * Command ocpp works now without having to explicitely load "/usr/local/lib/ocaml/stdlib.cma" and "/usr/local/lib/camlp4/gramlib.cma" * Fixed problem of pretty print "&" and "or" in normal and righteous syntaxes * Added missing statement "include" in signature item in normal and righteous syntaxes * Changed precedence of ":=" and "<-" in normal syntax (pa_o et pr_o): now before "or", like in OCaml compiler. * Same change in righteous syntax, by symmetry. Camlp4 Version 1.07.2: ---------------------- Errors and missings in normal and righteous syntaxes. * Added forgotten syntax (righteous): type constraints in class type fields. * Added missing syntax (normal): type foo = bar = {......} * Added missing syntax (normal): did not accept separators before ending constructions (many of them). * Fixed bug: "assert false" is now of type 'a, like in OCaml. * Fixed to match OCaml feature: "\^" is "\^" in OCaml, but just "^" in Camlp4. * Fixed bug in Windows NT/95: problem in backslash before newlines in strings Grammars, EXTEND, DELETE_RULE * Added functorial version for grammars (started in version 1.07.1, completed in this version). * Added statements GEXTEND and GDELETE_RULE in pa_extend.cmo for functorial version. * EXTEND statement is added AFTER "top" instead of LEVEL "top" (because of problems parsing "a; EXTEND...") * Added ability to have expressions (in antiquotation form) of type string in EXTEND after keywords "LIDENT", "UIDENT", "IDENT", "ANTIQUOT", "INT" as in others constructions inside EXTEND. * A grammar rule hidden by another is not deleted but just masked. DELETE_RULE will restore the old version. * DELETE_RULE now raises Not_found if no rule matched. * Fixed bug: DELETE_RULE did not work when deleting a rule which is a prefix of another rule. * Some functions for "system use" in [Grammar] become "official": [Entry.obj], [extend], [delete_rule]. Command line, man page * Added option -o: output on file instead of standard output, necessary to allow compilation in Windows NT/95 (in fact, this option exists since 1.07.1 but forgotten in its "changes" list). * Command line option -help more complete. * Updated man page: camlp4 options are better explained. * Fixed bug: "camlp4 [other-options] foo.ml" worked but not "camlp4 foo.ml [other-options]". * Fixed bug: "camlp4 foo" did not display a understandable error message. Camlp4's compilation * Changes in compilation process in order to try to make it work better for Windows NT under Cygnus. Miscellaneous * Added [Pcaml.add_option] for adding command line options. Camlp4 Version 1.07.1: ---------------------- * Added forgotten syntax in pr_o: type x = y = A | B * Fixed bug negative floats parsing in pa_o => error while pretty printing * Added assert statement and option -noassert. * Environment variable CAMLP4LIB to change camlp4 library directory * Grammar: empty rules have a correct location instead of (-1, -1) * Compilation possible in Windows NT/95 * String constants no more shared while parsing OCaml * Fixed bug in antiquotations in q_MLast.cmo (bad errors locations) * Fixed bug in antiquotations in q_MLast.cmo (EOI not checked) * Fixed bug in Plexer: could not create keywords with iso 8859 characters Camlp4 Version 1.07: -------------------- * Changed version number + configuration script * Added iso 8859 uppercase characters for uidents in plexer.ml * Fixed bug factorization IDENT in grammars * Fixed bug pr_o.cmo was printing "declare" * Fixed bug constructor arity in OCaml syntax (pa_o.cmo). * Changed "lazy" into "slazy". * Completed pa_ifdef.cmo. Camlp4 Version 1.06: -------------------- * Adapted to OCaml 1.06. * Changed version number to match OCaml's => 1.06 too. * Deleted module Gstream, using OCaml's Stream. * Generate different AST for C(x,y) and C x y (change done in OCaml's compiler) * No more message "Interrupted" in toplevel in case of syntax error. * Added flag to suppress warnings while extending grammars. * Completed some missing statements and declarations (objects) * Modified odyl implementation; works better * Added ability to extend command line specification * Added "let_binding" as predefined (accessible) entry in Pcaml. * Added construction FUNCTION in EXTEND statement to call another function. * Added some ISO-8859-1 characters in lexer identifiers. * Fixed bug "value x = {val = 1};" (righteous syntax) * Fixed bug "open A.B.C" was interpreted as "open B.A.C" * Modified behavior of "DELETE_RULE": the complete rule must be provided * Completed quotations MLast ("expr", "patt", etc) to accept whole language * Renamed "LIKE" into "LEVEL" in grammar EXTEND * Added "NEXT" as grammar symbol in grammar EXTEND * Added command "mkcamlp4" to make camlp4 executables linked with C code * Added "pr_extend.cmo" to reconstitute EXTEND instructions Camlp4 Version 0.6: ------------------- --- Installing * To compile camlp4, it is no more necessary to have the sources of the Objective Caml compiler available. It can be compiled like any other Objective Caml program. --- Options of "camlp4" * Added option -where: "camlp4 -where" prints the name of the standard library directory of Camlp4 and exit. So, the ocaml toplevel and the compiler can use the option: -I `camlp4 -where` * Added option -nolib to not search for objects files in the installed library directory of Camlp4. --- Interface of grammar library modules * The function Grammar.keywords returns now a list of pairs. The pair is composed of a keyword and the number of times it is used in entries. * Changed interface of Token and Grammar for lexers, so user lexers have to be changed. --- New features in grammars * New instruction "DELETE_RULE" provided by pa_extend.cmo to delete rules. Ex: DELETE_RULE Pcaml.expr: "if" END; deletes the "if" instruction of the language. * Added the ability to parse some specific integer in grammars: a possible parameter to INT, like the ones for LIDENT and UIDENT. * In instruction EXTEND, ability to omit "-> action", default is "-> ()" * Ability to add antiquotation (between $'s) as symbol rule, of type string, interpreted as a keyword, in instruction EXTEND. * Ability to put entries with qualified names (Foo.bar) in instruction EXTEND. --- Quotations * The module Ast has been renamed MLast. The quotation expander "q_ast.cmo" has been renamed "q_MLast.cmo". * Quotation expanders are now of two kinds: - The "classical" type for expanders returning a string. These expanders have now a supplementary parameter: a boolean value set to "True" when the quotation is in a context of an expression an to "False" when the quotation is in a context of a pattern. These expanders, returning strings which are parsed afterwards, may work for some language syntax and/or language extensions used (e.g. may work for Righteous syntax and not for OCaml syntax). - A new type of expander returning directly syntax trees. A pair of functions, for expressions and for patterns must be provided. These expanders are independant from the language syntax and/or extensions used. * The predefined quotation expanders "ctyp_", "patt_" and "expr_" has been deleted; one can use "ctyp", "patt", and "expr" in position of pattern or expression. --- OCaml and Righteous syntaxes * Fixed bug: "open Foo.Bar" was converted (pr_dump.cmo) into "open Bar.Foo" * Corrected behavior different from OCaml's: "^" and "@" were at the same level than "=": now, like OCaml, they have a separated right associative level. --- Grammars behavior * While extending entries: default position is now "extension of the first level", instead of "adding a new level at the end". * Another Change: in each precedence level, terminals are inserted before other symbols (non terminals, lists, options, etc), LIDENT "foo" before LIDENT (alone) and UIDENT "foo" before UIDENT (alone). New rules not factorizable are now inserted before the other rules. * Changed algorithm of entries parsing: each precedence level is tested against the stream *before* its next precedences levels (instead of *after*): EXTEND e: [[ LIDENT "a" -> "xxx" ] | [ i = LIDENT -> i ]]; END; Now, parsing the entry e with the string "a" returns "xxx" instead of "a" * Less keywords in instruction EXTEND (LEFTA, LIDENT, etc), which can be used now as normal identifiers. * When inserting a new rule, a warning appears if a rule with the same production already existed (it is deleted). * Parse error messages (Gstream.Error) are formatted => spaces trigger Format.print_space and newlines trigger Format.force_newline. Camlp4 Version 0.5: ------------------- * Possible creation of native code library (make opt) * OCaml and Righteous Syntax more complete * Added pa_ru.cmo for compiling sequences of type unit (Righteous) * Quotations AST - No more quotation long_id - Antiquotations for identifiers more simple * Lot of small changes Camlp4 Version 0.4: ------------------- * First distributed version camlp4-5.3-1/camlp4/Camlp4.mlpack000066400000000000000000000001261473134377200164020ustar00rootroot00000000000000Debug ErrorHandler OCamlInitSyntax Options PreCast Printers Register Sig Struct Utils camlp4-5.3-1/camlp4/Camlp4/000077500000000000000000000000001473134377200152125ustar00rootroot00000000000000camlp4-5.3-1/camlp4/Camlp4/Camlp4Ast.partial.ml000066400000000000000000000373351473134377200210020ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2007 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Note: when you modify these types you must increment ast magic numbers defined in Camlp4_config.ml. *) type loc = Loc.t and meta_bool = [ BTrue | BFalse | BAnt of string ] and rec_flag = [ ReRecursive | ReNonrecursive | ReNil | ReAnt of string ] and direction_flag = [ DiTo | DiDownto | DiAnt of string ] and mutable_flag = [ MuMutable | MuNil | MuAnt of string ] and private_flag = [ PrPrivate | PrNil | PrAnt of string ] and virtual_flag = [ ViVirtual | ViNil | ViAnt of string ] and override_flag = [ OvOverride | OvNil | OvAnt of string ] and row_var_flag = [ RvRowVar | RvNil | RvAnt of string ] and meta_option 'a = [ ONone | OSome of 'a | OAnt of string ] and meta_list 'a = [ LNil | LCons of 'a and meta_list 'a | LAnt of string ] and ident = [ IdAcc of loc and ident and ident (* i . i *) | IdApp of loc and ident and ident (* i i *) | IdLid of loc and string (* foo *) | IdUid of loc and string (* Bar *) | IdAnt of loc and string (* $s$ *) ] and ctyp = [ TyNil of loc | TyAli of loc and ctyp and ctyp (* t as t *) (* list 'a as 'a *) | TyAny of loc (* _ *) | TyApp of loc and ctyp and ctyp (* t t *) (* list 'a *) | TyArr of loc and ctyp and ctyp (* t -> t *) (* int -> string *) | TyCls of loc and ident (* #i *) (* #point *) | TyLab of loc and string and ctyp (* ~s:t *) | TyId of loc and ident (* i *) (* Lazy.t *) | TyMan of loc and ctyp and ctyp (* t == t *) (* type t = [ A | B ] == Foo.t *) (* type t 'a 'b 'c = t constraint t = t constraint t = t *) | TyDcl of loc and string and list ctyp and ctyp and list (ctyp * ctyp) (* type t 'a 'b 'c += A *) | TyExt of loc and ident and list ctyp and ctyp (* < (t)? (..)? > *) (* < move : int -> 'a .. > as 'a *) | TyObj of loc and ctyp and row_var_flag | TyOlb of loc and string and ctyp (* ?s:t *) | TyPol of loc and ctyp and ctyp (* ! t . t *) (* ! 'a . list 'a -> 'a *) | TyTypePol of loc and ctyp and ctyp (* type t . t *) (* type a . list a -> a *) | TyQuo of loc and string (* 's *) | TyQuP of loc and string (* +'s *) | TyQuM of loc and string (* -'s *) | TyAnP of loc (* +_ *) | TyAnM of loc (* -_ *) | TyVrn of loc and string (* `s *) | TyRec of loc and ctyp (* { t } *) (* { foo : int ; bar : mutable string } *) | TyCol of loc and ctyp and ctyp (* t : t *) | TySem of loc and ctyp and ctyp (* t; t *) | TyCom of loc and ctyp and ctyp (* t, t *) | TySum of loc and ctyp (* [ t ] *) (* [ A of int and string | B ] *) | TyOf of loc and ctyp and ctyp (* t of t *) (* A of int *) | TyAnd of loc and ctyp and ctyp (* t and t *) | TyOr of loc and ctyp and ctyp (* t | t *) | TyPrv of loc and ctyp (* private t *) | TyMut of loc and ctyp (* mutable t *) | TyTup of loc and ctyp (* ( t ) *) (* (int * string) *) | TySta of loc and ctyp and ctyp (* t * t *) | TyVrnEq of loc and ctyp (* [ = t ] *) | TyVrnSup of loc and ctyp (* [ > t ] *) | TyVrnInf of loc and ctyp (* [ < t ] *) | TyVrnInfSup of loc and ctyp and ctyp (* [ < t > t ] *) | TyAmp of loc and ctyp and ctyp (* t & t *) | TyOfAmp of loc and ctyp and ctyp (* t of & t *) | TyPkg of loc and module_type (* (module S) *) | TyOpn of loc (* .. *) | TyAtt of loc and string and str_item and ctyp (* .. [@attr] *) | TyAnt of loc and string (* $s$ *) ] and patt = [ PaNil of loc | PaId of loc and ident (* i *) | PaAli of loc and patt and patt (* p as p *) (* (Node x y as n) *) | PaAnt of loc and string (* $s$ *) | PaAny of loc (* _ *) | PaApp of loc and patt and patt (* p p *) (* fun x y -> *) | PaArr of loc and patt (* [| p |] *) | PaCom of loc and patt and patt (* p, p *) | PaSem of loc and patt and patt (* p; p *) | PaChr of loc and string (* c *) (* 'x' *) | PaInt of loc and string | PaInt32 of loc and string | PaInt64 of loc and string | PaNativeInt of loc and string | PaFlo of loc and string | PaLab of loc and string and patt (* ~s or ~s:(p) *) (* ?s or ?s:(p) *) | PaOlb of loc and string and patt (* ?s:(p = e) or ?(p = e) *) | PaOlbi of loc and string and patt and expr | PaOrp of loc and patt and patt (* p | p *) | PaRng of loc and patt and patt (* p .. p *) | PaRec of loc and patt (* { p } *) | PaEq of loc and ident and patt (* i = p *) | PaStr of loc and string (* s *) | PaTup of loc and patt (* ( p ) *) | PaTyc of loc and patt and ctyp (* (p : t) *) | PaTyp of loc and ident (* #i *) | PaVrn of loc and string (* `s *) | PaLaz of loc and patt (* lazy p *) | PaAtt of loc and string and str_item and patt (* .. [@attr] *) | PaMod of loc and string (* (module M) *) | PaExc of loc and patt (* exception p *) ] and expr = [ ExNil of loc | ExId of loc and ident (* i *) | ExAcc of loc and expr and expr (* e.e *) | ExAnt of loc and string (* $s$ *) | ExApp of loc and expr and expr (* e e *) | ExAre of loc and expr and expr (* e.(e) *) | ExArr of loc and expr (* [| e |] *) | ExSem of loc and expr and expr (* e; e *) | ExAsf of loc (* assert False *) | ExAsr of loc and expr (* assert e *) | ExAss of loc and expr and expr (* e := e *) | ExChr of loc and string (* 'c' *) | ExCoe of loc and expr and ctyp and ctyp (* (e : t) or (e : t :> t) *) | ExFlo of loc and string (* 3.14 *) (* for s = e to/downto e do { e } *) | ExFor of loc and patt and expr and expr and direction_flag and expr | ExFun of loc and match_case (* fun [ mc ] *) | ExIfe of loc and expr and expr and expr (* if e then e else e *) | ExInt of loc and string (* 42 *) | ExInt32 of loc and string | ExInt64 of loc and string | ExNativeInt of loc and string | ExLab of loc and string and expr (* ~s or ~s:e *) | ExLaz of loc and expr (* lazy e *) (* let b in e or let rec b in e *) | ExLet of loc and rec_flag and binding and expr (* let module s = me in e *) | ExLmd of loc and string and module_expr and expr (* match e with [ mc ] *) | ExMat of loc and expr and match_case (* new i *) | ExNew of loc and ident (* object ((p))? (cst)? end *) | ExObj of loc and patt and class_str_item (* ?s or ?s:e *) | ExOlb of loc and string and expr (* {< rb >} *) | ExOvr of loc and rec_binding (* { rb } or { (e) with rb } *) | ExRec of loc and rec_binding and expr (* do { e } *) | ExSeq of loc and expr (* e#s *) | ExSnd of loc and expr and string (* e.[e] *) | ExSte of loc and expr and expr (* s *) (* "foo" *) | ExStr of loc and string (* try e with [ mc ] *) | ExTry of loc and expr and match_case (* (e) *) | ExTup of loc and expr (* e, e *) | ExCom of loc and expr and expr (* (e : t) *) | ExTyc of loc and expr and ctyp (* `s *) | ExVrn of loc and string (* while e do { e } *) | ExWhi of loc and expr and expr (* let open i in e *) | ExOpI of loc and ident and override_flag and expr (* fun (type t) -> e *) (* let f x (type t) y z = e *) | ExFUN of loc and string and expr (* (module ME : S) which is represented as (module (ME : S)) *) | ExPkg of loc and module_expr (* e [@attr] *) | ExAtt of loc and string and str_item and expr ] and module_type = [ MtNil of loc (* i *) (* A.B.C *) | MtId of loc and ident (* (module ident) *) | MtAlias of loc and ident (* functor (s : mt) -> mt *) | MtFun of loc and string and module_type and module_type (* 's *) | MtQuo of loc and string (* sig sg end *) | MtSig of loc and sig_item (* mt with wc *) | MtWit of loc and module_type and with_constr (* module type of m *) | MtOf of loc and module_expr | MtAtt of loc and string and str_item and module_type (* .. [@attr] *) | MtAnt of loc and string (* $s$ *) ] and sig_item = [ SgNil of loc (* class cict *) | SgCls of loc and class_type (* class type cict *) | SgClt of loc and class_type (* sg ; sg *) | SgSem of loc and sig_item and sig_item (* # s or # s e *) | SgDir of loc and string and expr (* exception t *) | SgExc of loc and ctyp (* external s : t = s ... s *) | SgExt of loc and string and ctyp and meta_list string (* include mt *) | SgInc of loc and module_type (* module s : mt *) | SgMod of loc and string and module_type (* module rec mb *) | SgRecMod of loc and module_binding (* module type s = mt *) | SgMty of loc and string and module_type (* open i *) | SgOpn of loc and override_flag and ident (* type t *) | SgTyp of loc and rec_flag and ctyp (* value s : t *) | SgVal of loc and string and ctyp | SgAnt of loc and string (* $s$ *) ] and with_constr = [ WcNil of loc (* type t = t *) | WcTyp of loc and ctyp and ctyp (* module i = i *) | WcMod of loc and ident and ident (* type t := t *) | WcTyS of loc and ctyp and ctyp (* module i := i *) | WcMoS of loc and ident and ident (* wc and wc *) | WcAnd of loc and with_constr and with_constr | WcAnt of loc and string (* $s$ *) ] and binding = [ BiNil of loc (* bi and bi *) (* let a = 42 and c = 43 *) | BiAnd of loc and binding and binding (* p = e *) (* let patt = expr *) | BiEq of loc and patt and expr | BiAnt of loc and string (* $s$ *) ] and rec_binding = [ RbNil of loc (* rb ; rb *) | RbSem of loc and rec_binding and rec_binding (* i = e *) | RbEq of loc and ident and expr | RbAnt of loc and string (* $s$ *) ] and module_binding = [ MbNil of loc (* mb and mb *) (* module rec (s : mt) = me and (s : mt) = me *) | MbAnd of loc and module_binding and module_binding (* s : mt = me *) | MbColEq of loc and string and module_type and module_expr (* s : mt *) | MbCol of loc and string and module_type | MbAnt of loc and string (* $s$ *) ] and match_case = [ McNil of loc (* a | a *) | McOr of loc and match_case and match_case (* p (when e)? -> e *) | McArr of loc and patt and expr and expr | McAnt of loc and string (* $s$ *) ] and module_expr = [ MeNil of loc (* i *) | MeId of loc and ident (* me me *) | MeApp of loc and module_expr and module_expr (* functor (s : mt) -> me *) | MeFun of loc and string and module_type and module_expr (* struct st end *) | MeStr of loc and str_item (* (me : mt) *) | MeTyc of loc and module_expr and module_type (* (value e) *) (* (value e : S) which is represented as (value (e : S)) *) | MePkg of loc and expr | MeAtt of loc and string and str_item and module_expr (* .. [@attr] *) | MeAnt of loc and string (* $s$ *) ] and str_item = [ StNil of loc (* class cice *) | StCls of loc and class_expr (* class type cict *) | StClt of loc and class_type (* st ; st *) | StSem of loc and str_item and str_item (* # s or # s e *) | StDir of loc and string and expr (* exception t or exception t = i *) | StExc of loc and ctyp and meta_option(*FIXME*) ident (* e *) | StExp of loc and expr (* external s : t = s ... s *) | StExt of loc and string and ctyp and meta_list string (* include me *) | StInc of loc and module_expr (* module s = me *) | StMod of loc and string and module_expr (* module rec mb *) | StRecMod of loc and module_binding (* module type s = mt *) | StMty of loc and string and module_type (* open i *) | StOpn of loc and override_flag and ident (* type t *) | StTyp of loc and rec_flag and ctyp (* value (rec)? bi *) | StVal of loc and rec_flag and binding | StAnt of loc and string (* $s$ *) ] and class_type = [ CtNil of loc (* (virtual)? i ([ t ])? *) | CtCon of loc and virtual_flag and ident and ctyp (* [t] -> ct *) | CtFun of loc and ctyp and class_type (* object ((t))? (csg)? end *) | CtSig of loc and ctyp and class_sig_item (* ct and ct *) | CtAnd of loc and class_type and class_type (* ct : ct *) | CtCol of loc and class_type and class_type (* ct = ct *) | CtEq of loc and class_type and class_type (* $s$ *) | CtAtt of loc and string and str_item and class_type (* .. [@attr] *) | CtAnt of loc and string ] and class_sig_item = [ CgNil of loc (* type t = t *) | CgCtr of loc and ctyp and ctyp (* csg ; csg *) | CgSem of loc and class_sig_item and class_sig_item (* inherit ct *) | CgInh of loc and class_type (* method s : t or method private s : t *) | CgMth of loc and string and private_flag and ctyp (* value (virtual)? (mutable)? s : t *) | CgVal of loc and string and mutable_flag and virtual_flag and ctyp (* method virtual (private)? s : t *) | CgVir of loc and string and private_flag and ctyp | CgAnt of loc and string (* $s$ *) ] and class_expr = [ CeNil of loc (* ce e *) | CeApp of loc and class_expr and expr (* (virtual)? i ([ t ])? *) | CeCon of loc and virtual_flag and ident and ctyp (* fun p -> ce *) | CeFun of loc and patt and class_expr (* let (rec)? bi in ce *) | CeLet of loc and rec_flag and binding and class_expr (* object ((p))? (cst)? end *) | CeStr of loc and patt and class_str_item (* ce : ct *) | CeTyc of loc and class_expr and class_type (* ce and ce *) | CeAnd of loc and class_expr and class_expr (* ce = ce *) | CeEq of loc and class_expr and class_expr (* $s$ *) | CeAtt of loc and string and str_item and class_expr (* .. [@attr] *) | CeAnt of loc and string ] and class_str_item = [ CrNil of loc (* cst ; cst *) | CrSem of loc and class_str_item and class_str_item (* type t = t *) | CrCtr of loc and ctyp and ctyp (* inherit(!)? ce (as s)? *) | CrInh of loc and override_flag and class_expr and string (* initializer e *) | CrIni of loc and expr (* method(!)? (private)? s : t = e or method(!)? (private)? s = e *) | CrMth of loc and string and override_flag and private_flag and expr and ctyp (* value(!)? (mutable)? s = e *) | CrVal of loc and string and override_flag and mutable_flag and expr (* method virtual (private)? s : t *) | CrVir of loc and string and private_flag and ctyp (* value virtual (mutable)? s : t *) | CrVvr of loc and string and mutable_flag and ctyp | CrAnt of loc and string (* $s$ *) ]; camlp4-5.3-1/camlp4/Camlp4/Debug.ml000066400000000000000000000045711473134377200166010ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) (* camlp4r *) open Format; module Debug = struct value mode _ = False; end; type section = string; value out_channel = try let f = Sys.getenv "CAMLP4_DEBUG_FILE" in open_out_gen [Open_wronly; Open_creat; Open_append; Open_text] 0o666 f with [ Not_found -> Stdlib.stderr ]; module StringSet = Set.Make String; value mode = try let str = Sys.getenv "CAMLP4_DEBUG" in let rec loop acc i = try let pos = String.index_from str i ':' in loop (StringSet.add (String.sub str i (pos - i)) acc) (pos + 1) with [ Not_found -> StringSet.add (String.sub str i (String.length str - i)) acc ] in let sections = loop StringSet.empty 0 in if StringSet.mem "*" sections then fun _ -> True else fun x -> StringSet.mem x sections with [ Not_found -> fun _ -> False ]; value formatter = let header = "camlp4-debug: " in let at_bol = ref True in (make_formatter (fun buf pos len -> for i = pos to pos + len - 1 do if at_bol.val then output_string out_channel header else (); let ch = buf.[i]; output_char out_channel ch; at_bol.val := ch = '\n'; done) (fun () -> flush out_channel)); value printf section fmt = fprintf formatter ("%s: " ^^ fmt) section; camlp4-5.3-1/camlp4/Camlp4/Debug.mli000066400000000000000000000023471473134377200167510ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) (* camlp4r *) type section = string; value mode : section -> bool; value printf : section -> format 'a Format.formatter unit -> 'a; camlp4-5.3-1/camlp4/Camlp4/ErrorHandler.ml000066400000000000000000000142531473134377200201400ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) (* camlp4r *) open Format; module ObjTools = struct value desc obj = if Obj.is_block obj then "tag = " ^ string_of_int (Obj.tag obj) else "int_val = " ^ string_of_int (Obj.obj obj); (*Imported from the extlib*) value rec to_string r = if Obj.is_int r then let i = (Obj.magic r : int) in string_of_int i ^ " | CstTag" ^ string_of_int (i + 1) else (* Block. *) let rec get_fields acc = fun [ 0 -> acc | n -> let n = n-1 in get_fields [Obj.field r n :: acc] n ] in let rec is_list r = if Obj.is_int r then r = Obj.repr 0 (* [] *) else let s = Obj.size r and t = Obj.tag r in t = 0 && s = 2 && is_list (Obj.field r 1) (* h :: t *) in let rec get_list r = if Obj.is_int r then [] else let h = Obj.field r 0 and t = get_list (Obj.field r 1) in [h :: t] in let opaque name = (* XXX In future, print the address of value 'r'. Not possible in * pure OCaml at the moment. *) "<" ^ name ^ ">" in let s = Obj.size r and t = Obj.tag r in (* From the tag, determine the type of block. *) match t with [ _ when is_list r -> let fields = get_list r in "[" ^ String.concat "; " (List.map to_string fields) ^ "]" | 0 -> let fields = get_fields [] s in "(" ^ String.concat ", " (List.map to_string fields) ^ ")" | x when x = Obj.lazy_tag -> (* Note that [lazy_tag .. forward_tag] are < no_scan_tag. Not * clear if very large constructed values could have the same * tag. XXX *) opaque "lazy" | x when x = Obj.closure_tag -> opaque "closure" | x when x = Obj.object_tag -> let fields = get_fields [] s in let (_class, id, slots) = match fields with [ [h; h'::t] -> (h, h', t) | _ -> assert False ] in (* No information on decoding the class (first field). So just print * out the ID and the slots. *) "Object #" ^ to_string id ^ " (" ^ String.concat ", " (List.map to_string slots) ^ ")" | x when x = Obj.infix_tag -> opaque "infix" | x when x = Obj.forward_tag -> opaque "forward" | x when x < Obj.no_scan_tag -> let fields = get_fields [] s in "Tag" ^ string_of_int t ^ " (" ^ String.concat ", " (List.map to_string fields) ^ ")" | x when x = Obj.string_tag -> "\"" ^ String.escaped (Obj.magic r : string) ^ "\"" | x when x = Obj.double_tag -> Utils.float_repres (Obj.magic r : float) | x when x = Obj.abstract_tag -> opaque "abstract" | x when x = Obj.custom_tag -> opaque "custom" | _ -> failwith ("ObjTools.to_string: unknown tag (" ^ string_of_int t ^ ")") ]; value print ppf x = fprintf ppf "%s" (to_string x); value print_desc ppf x = fprintf ppf "%s" (desc x); end; value default_handler ppf x = do { let x = Obj.repr x; if Obj.tag x <> 0 then fprintf ppf "Camlp4: Uncaught exception: %s" (Obj.obj (Obj.field x 0) : string) else do { fprintf ppf "Camlp4: Uncaught exception: %s" (Obj.obj (Obj.field (Obj.field x 0) 0) : string); if Obj.size x > 1 then do { pp_print_string ppf " ("; for i = 1 to Obj.size x - 1 do if i > 1 then pp_print_string ppf ", " else (); ObjTools.print ppf (Obj.field x i); done; pp_print_char ppf ')' } else (); }; fprintf ppf "@." }; value handler = ref (fun ppf default_handler exn -> default_handler ppf exn); value register f = let current_handler = handler.val in handler.val := fun ppf default_handler exn -> try f ppf exn with exn -> current_handler ppf default_handler exn; module Register (Error : Sig.Error) = struct let current_handler = handler.val in handler.val := fun ppf default_handler -> fun [ Error.E x -> Error.print ppf x | x -> current_handler ppf default_handler x ]; end; value gen_print ppf default_handler = fun [ Out_of_memory -> fprintf ppf "Out of memory" | Assert_failure (file, line, char) -> fprintf ppf "Assertion failed, file %S, line %d, char %d" file line char | Match_failure (file, line, char) -> fprintf ppf "Pattern matching failed, file %S, line %d, char %d" file line char | Failure str -> fprintf ppf "Failure: %S" str | Invalid_argument str -> fprintf ppf "Invalid argument: %S" str | Sys_error str -> fprintf ppf "I/O error: %S" str | Stream.Failure -> fprintf ppf "Parse failure" | Stream.Error str -> fprintf ppf "Parse error: %s" str | x -> handler.val ppf default_handler x ]; value print ppf = gen_print ppf default_handler; value try_print ppf = gen_print ppf (fun _ -> raise); value to_string exn = Format.asprintf "%a" print exn; value try_to_string exn = Format.asprintf "%a" try_print exn; camlp4-5.3-1/camlp4/Camlp4/ErrorHandler.mli000066400000000000000000000030771473134377200203130ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Nicolas Pouillard: initial version *) value print : Format.formatter -> exn -> unit; value try_print : Format.formatter -> exn -> unit; value to_string : exn -> string; value try_to_string : exn -> string; value register : (Format.formatter -> exn -> unit) -> unit; module Register (Error : Sig.Error) : sig end; module ObjTools : sig value print : Format.formatter -> Obj.t -> unit; value print_desc : Format.formatter -> Obj.t -> unit; (*Imported from the extlib*) value to_string : Obj.t -> string; value desc : Obj.t -> string; end; camlp4-5.3-1/camlp4/Camlp4/OCamlInitSyntax.ml000066400000000000000000000320361473134377200205760ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Nicolas Pouillard: initial version *) module Make (Ast : Sig.Camlp4Ast) (Gram : Sig.Grammar.Static with module Loc = Ast.Loc with type Token.t = Sig.camlp4_token) (Quotation : Sig.Quotation with module Ast = Sig.Camlp4AstToAst Ast) : Sig.Camlp4Syntax with module Loc = Ast.Loc and module Ast = Ast and module Token = Gram.Token and module Gram = Gram and module Quotation = Quotation = struct module Loc = Ast.Loc; module Ast = Ast; module Gram = Gram; module Token = Gram.Token; open Sig; (* Warnings *) type warning = Loc.t -> string -> unit; value default_warning loc txt = Format.eprintf " %a: %s@." Loc.print loc txt; value current_warning = ref default_warning; value print_warning loc txt = current_warning.val loc txt; value a_CHAR = Gram.Entry.mk "a_CHAR"; value a_FLOAT = Gram.Entry.mk "a_FLOAT"; value a_INT = Gram.Entry.mk "a_INT"; value a_INT32 = Gram.Entry.mk "a_INT32"; value a_INT64 = Gram.Entry.mk "a_INT64"; value a_LABEL = Gram.Entry.mk "a_LABEL"; value a_LIDENT = Gram.Entry.mk "a_LIDENT"; value a_NATIVEINT = Gram.Entry.mk "a_NATIVEINT"; value a_OPTLABEL = Gram.Entry.mk "a_OPTLABEL"; value a_STRING = Gram.Entry.mk "a_STRING"; value a_UIDENT = Gram.Entry.mk "a_UIDENT"; value a_ident = Gram.Entry.mk "a_ident"; value amp_ctyp = Gram.Entry.mk "amp_ctyp"; value and_ctyp = Gram.Entry.mk "and_ctyp"; value match_case = Gram.Entry.mk "match_case"; value match_case0 = Gram.Entry.mk "match_case0"; value binding = Gram.Entry.mk "binding"; value class_declaration = Gram.Entry.mk "class_declaration"; value class_description = Gram.Entry.mk "class_description"; value class_expr = Gram.Entry.mk "class_expr"; value class_fun_binding = Gram.Entry.mk "class_fun_binding"; value class_fun_def = Gram.Entry.mk "class_fun_def"; value class_info_for_class_expr = Gram.Entry.mk "class_info_for_class_expr"; value class_info_for_class_type = Gram.Entry.mk "class_info_for_class_type"; value class_longident = Gram.Entry.mk "class_longident"; value class_longident_and_param = Gram.Entry.mk "class_longident_and_param"; value class_name_and_param = Gram.Entry.mk "class_name_and_param"; value class_sig_item = Gram.Entry.mk "class_sig_item"; value class_signature = Gram.Entry.mk "class_signature"; value class_str_item = Gram.Entry.mk "class_str_item"; value class_structure = Gram.Entry.mk "class_structure"; value class_type = Gram.Entry.mk "class_type"; value class_type_declaration = Gram.Entry.mk "class_type_declaration"; value class_type_longident = Gram.Entry.mk "class_type_longident"; value class_type_longident_and_param = Gram.Entry.mk "class_type_longident_and_param"; value class_type_plus = Gram.Entry.mk "class_type_plus"; value comma_ctyp = Gram.Entry.mk "comma_ctyp"; value comma_expr = Gram.Entry.mk "comma_expr"; value comma_ipatt = Gram.Entry.mk "comma_ipatt"; value comma_patt = Gram.Entry.mk "comma_patt"; value comma_type_parameter = Gram.Entry.mk "comma_type_parameter"; value constrain = Gram.Entry.mk "constrain"; value constructor_arg_list = Gram.Entry.mk "constructor_arg_list"; value constructor_declaration = Gram.Entry.mk "constructor_declaration"; value constructor_declarations = Gram.Entry.mk "constructor_declarations"; value ctyp = Gram.Entry.mk "ctyp"; value cvalue_binding = Gram.Entry.mk "cvalue_binding"; value direction_flag = Gram.Entry.mk "direction_flag"; value direction_flag_quot = Gram.Entry.mk "direction_flag_quot"; value dummy = Gram.Entry.mk "dummy"; value entry_eoi = Gram.Entry.mk "entry_eoi"; value eq_expr = Gram.Entry.mk "eq_expr"; value expr = Gram.Entry.mk "expr"; value expr_eoi = Gram.Entry.mk "expr_eoi"; value field_expr = Gram.Entry.mk "field_expr"; value field_expr_list = Gram.Entry.mk "field_expr_list"; value fun_binding = Gram.Entry.mk "fun_binding"; value fun_def = Gram.Entry.mk "fun_def"; value ident = Gram.Entry.mk "ident"; value implem = Gram.Entry.mk "implem"; value interf = Gram.Entry.mk "interf"; value ipatt = Gram.Entry.mk "ipatt"; value ipatt_tcon = Gram.Entry.mk "ipatt_tcon"; value label = Gram.Entry.mk "label"; value label_declaration = Gram.Entry.mk "label_declaration"; value label_declaration_list = Gram.Entry.mk "label_declaration_list"; value label_expr = Gram.Entry.mk "label_expr"; value label_expr_list = Gram.Entry.mk "label_expr_list"; value label_ipatt = Gram.Entry.mk "label_ipatt"; value label_ipatt_list = Gram.Entry.mk "label_ipatt_list"; value label_longident = Gram.Entry.mk "label_longident"; value label_patt = Gram.Entry.mk "label_patt"; value label_patt_list = Gram.Entry.mk "label_patt_list"; value labeled_ipatt = Gram.Entry.mk "labeled_ipatt"; value let_binding = Gram.Entry.mk "let_binding"; value meth_list = Gram.Entry.mk "meth_list"; value meth_decl = Gram.Entry.mk "meth_decl"; value module_binding = Gram.Entry.mk "module_binding"; value module_binding0 = Gram.Entry.mk "module_binding0"; value module_declaration = Gram.Entry.mk "module_declaration"; value module_expr = Gram.Entry.mk "module_expr"; value module_longident = Gram.Entry.mk "module_longident"; value module_longident_with_app = Gram.Entry.mk "module_longident_with_app"; value module_rec_declaration = Gram.Entry.mk "module_rec_declaration"; value module_type = Gram.Entry.mk "module_type"; value package_type = Gram.Entry.mk "package_type"; value more_ctyp = Gram.Entry.mk "more_ctyp"; value name_tags = Gram.Entry.mk "name_tags"; value opt_as_lident = Gram.Entry.mk "opt_as_lident"; value opt_class_self_patt = Gram.Entry.mk "opt_class_self_patt"; value opt_class_self_type = Gram.Entry.mk "opt_class_self_type"; value opt_class_signature = Gram.Entry.mk "opt_class_signature"; value opt_class_structure = Gram.Entry.mk "opt_class_structure"; value opt_comma_ctyp = Gram.Entry.mk "opt_comma_ctyp"; value opt_dot_dot = Gram.Entry.mk "opt_dot_dot"; value row_var_flag_quot = Gram.Entry.mk "row_var_flag_quot"; value opt_eq_ctyp = Gram.Entry.mk "opt_eq_ctyp"; value opt_expr = Gram.Entry.mk "opt_expr"; value opt_meth_list = Gram.Entry.mk "opt_meth_list"; value opt_mutable = Gram.Entry.mk "opt_mutable"; value mutable_flag_quot = Gram.Entry.mk "mutable_flag_quot"; value opt_polyt = Gram.Entry.mk "opt_polyt"; value opt_private = Gram.Entry.mk "opt_private"; value private_flag_quot = Gram.Entry.mk "private_flag_quot"; value opt_rec = Gram.Entry.mk "opt_rec"; value opt_nonrec = Gram.Entry.mk "opt_nonrec"; value rec_flag_quot = Gram.Entry.mk "rec_flag_quot"; value opt_sig_items = Gram.Entry.mk "opt_sig_items"; value opt_str_items = Gram.Entry.mk "opt_str_items"; value opt_virtual = Gram.Entry.mk "opt_virtual"; value virtual_flag_quot = Gram.Entry.mk "virtual_flag_quot"; value opt_override = Gram.Entry.mk "opt_override"; value override_flag_quot = Gram.Entry.mk "override_flag_quot"; value opt_when_expr = Gram.Entry.mk "opt_when_expr"; value patt = Gram.Entry.mk "patt"; value patt_as_patt_opt = Gram.Entry.mk "patt_as_patt_opt"; value patt_eoi = Gram.Entry.mk "patt_eoi"; value patt_tcon = Gram.Entry.mk "patt_tcon"; value phrase = Gram.Entry.mk "phrase"; value poly_type = Gram.Entry.mk "poly_type"; value row_field = Gram.Entry.mk "row_field"; value sem_expr = Gram.Entry.mk "sem_expr"; value sem_expr_for_list = Gram.Entry.mk "sem_expr_for_list"; value sem_patt = Gram.Entry.mk "sem_patt"; value sem_patt_for_list = Gram.Entry.mk "sem_patt_for_list"; value semi = Gram.Entry.mk "semi"; value sequence = Gram.Entry.mk "sequence"; value do_sequence = Gram.Entry.mk "do_sequence"; value sig_item = Gram.Entry.mk "sig_item"; value sig_items = Gram.Entry.mk "sig_items"; value star_ctyp = Gram.Entry.mk "star_ctyp"; value str_item = Gram.Entry.mk "str_item"; value str_items = Gram.Entry.mk "str_items"; value top_phrase = Gram.Entry.mk "top_phrase"; value type_constraint = Gram.Entry.mk "type_constraint"; value type_declaration = Gram.Entry.mk "type_declaration"; value type_ident_and_parameters = Gram.Entry.mk "type_ident_and_parameters"; value type_kind = Gram.Entry.mk "type_kind"; value type_longident = Gram.Entry.mk "type_longident"; value type_longident_and_parameters = Gram.Entry.mk "type_longident_and_parameters"; value type_parameter = Gram.Entry.mk "type_parameter"; value type_parameters = Gram.Entry.mk "type_parameters"; value typevars = Gram.Entry.mk "typevars"; value use_file = Gram.Entry.mk "use_file"; value val_longident = Gram.Entry.mk "val_longident"; value value_let = Gram.Entry.mk "value_let"; value value_val = Gram.Entry.mk "value_val"; value with_constr = Gram.Entry.mk "with_constr"; value expr_quot = Gram.Entry.mk "quotation of expression"; value patt_quot = Gram.Entry.mk "quotation of pattern"; value ctyp_quot = Gram.Entry.mk "quotation of type"; value str_item_quot = Gram.Entry.mk "quotation of structure item"; value sig_item_quot = Gram.Entry.mk "quotation of signature item"; value class_str_item_quot = Gram.Entry.mk "quotation of class structure item"; value class_sig_item_quot = Gram.Entry.mk "quotation of class signature item"; value module_expr_quot = Gram.Entry.mk "quotation of module expression"; value module_type_quot = Gram.Entry.mk "quotation of module type"; value class_type_quot = Gram.Entry.mk "quotation of class type"; value class_expr_quot = Gram.Entry.mk "quotation of class expression"; value with_constr_quot = Gram.Entry.mk "quotation of with constraint"; value binding_quot = Gram.Entry.mk "quotation of binding"; value rec_binding_quot = Gram.Entry.mk "quotation of record binding"; value match_case_quot = Gram.Entry.mk "quotation of match_case (try/match/function case)"; value module_binding_quot = Gram.Entry.mk "quotation of module rec binding"; value ident_quot = Gram.Entry.mk "quotation of identifier"; value prefixop = Gram.Entry.mk "prefix operator (start with '!', '?', '~')"; value infixop0 = Gram.Entry.mk "infix operator (level 0) (comparison operators, and some others)"; value infixop1 = Gram.Entry.mk "infix operator (level 1) (start with '^', '@')"; value infixop2 = Gram.Entry.mk "infix operator (level 2) (start with '+', '-')"; value infixop3 = Gram.Entry.mk "infix operator (level 3) (start with '*', '/', '%')"; value infixop4 = Gram.Entry.mk "infix operator (level 4) (start with \"**\") (right assoc)"; EXTEND Gram top_phrase: [ [ `EOI -> None ] ] ; END; module AntiquotSyntax = struct module Loc = Ast.Loc; module Ast = Sig.Camlp4AstToAst Ast; module Gram = Gram; value antiquot_expr = Gram.Entry.mk "antiquot_expr"; value antiquot_patt = Gram.Entry.mk "antiquot_patt"; EXTEND Gram antiquot_expr: [ [ x = expr; `EOI -> x ] ] ; antiquot_patt: [ [ x = patt; `EOI -> x ] ] ; END; value parse_expr loc str = Gram.parse_string antiquot_expr loc str; value parse_patt loc str = Gram.parse_string antiquot_patt loc str; end; module Quotation = Quotation; value wrap directive_handler pa init_loc cs = let rec loop loc = let (pl, stopped_at_directive) = pa loc cs in match stopped_at_directive with [ Some new_loc -> let pl = match List.rev pl with [ [] -> assert False | [x :: xs] -> match directive_handler x with [ None -> xs | Some x -> [x :: xs] ] ] in (List.rev pl) @ (loop new_loc) | None -> pl ] in loop init_loc; value parse_implem ?(directive_handler = fun _ -> None) _loc cs = let l = wrap directive_handler (Gram.parse implem) _loc cs in <:str_item< $list:l$ >>; value parse_interf ?(directive_handler = fun _ -> None) _loc cs = let l = wrap directive_handler (Gram.parse interf) _loc cs in <:sig_item< $list:l$ >>; value print_interf ?input_file:(_) ?output_file:(_) _ = failwith "No interface printer"; value print_implem ?input_file:(_) ?output_file:(_) _ = failwith "No implementation printer"; end; camlp4-5.3-1/camlp4/Camlp4/Options.ml000066400000000000000000000147551473134377200172130ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) type spec_list = list (string * Arg.spec * string); open Format; value rec action_arg s sl = fun [ Arg.Unit f -> if s = "" then do { f (); Some sl } else None | Arg.Bool f -> if s = "" then match sl with [ [s :: sl] -> try do { f (bool_of_string s); Some sl } with [ Invalid_argument _ -> None ] | [] -> None ] else try do { f (bool_of_string s); Some sl } with [ Invalid_argument _ -> None ] | Arg.Set r -> if s = "" then do { r.val := True; Some sl } else None | Arg.Clear r -> if s = "" then do { r.val := False; Some sl } else None | Arg.Rest f -> do { List.iter f [s :: sl]; Some [] } | Arg.Rest_all f -> do { f [s :: sl]; Some [] } | Arg.String f -> if s = "" then match sl with [ [s :: sl] -> do { f s; Some sl } | [] -> None ] else do { f s; Some sl } | Arg.Set_string r -> if s = "" then match sl with [ [s :: sl] -> do { r.val := s; Some sl } | [] -> None ] else do { r.val := s; Some sl } | Arg.Int f -> if s = "" then match sl with [ [s :: sl] -> try do { f (int_of_string s); Some sl } with [ Failure _ -> None ] | [] -> None ] else try do { f (int_of_string s); Some sl } with [ Failure _ -> None ] | Arg.Set_int r -> if s = "" then match sl with [ [s :: sl] -> try do { r.val := (int_of_string s); Some sl } with [ Failure _ -> None ] | [] -> None ] else try do { r.val := (int_of_string s); Some sl } with [ Failure _ -> None ] | Arg.Float f -> if s = "" then match sl with [ [s :: sl] -> do { f (float_of_string s); Some sl } | [] -> None ] else do { f (float_of_string s); Some sl } | Arg.Set_float r -> if s = "" then match sl with [ [s :: sl] -> do { r.val := (float_of_string s); Some sl } | [] -> None ] else do { r.val := (float_of_string s); Some sl } | Arg.Tuple specs -> let rec action_args s sl = fun [ [] -> Some sl | [spec :: spec_list] -> match action_arg s sl spec with [ None -> action_args "" [] spec_list | Some [s :: sl] -> action_args s sl spec_list | Some sl -> action_args "" sl spec_list ] ] in action_args s sl specs | Arg.Symbol syms f -> match (if s = "" then sl else [s :: sl]) with [ [s :: sl] when List.mem s syms -> do { f s; Some sl } | _ -> None ] | Arg.Expand _f -> invalid_arg "Arg.Expand is unimplemented" (* TODO *) ]; value common_start s1 s2 = loop 0 where rec loop i = if i == String.length s1 || i == String.length s2 then i else if s1.[i] == s2.[i] then loop (i + 1) else i; value parse_arg fold s sl = fold (fun (name, action, _) acu -> let i = common_start s name in if i == String.length name then try action_arg (String.sub s i (String.length s - i)) sl action with [ Arg.Bad _ -> acu ] else acu) None; value rec parse_aux fold anon_fun = fun [ [] -> [] | [s :: sl] -> if String.length s > 1 && s.[0] = '-' then match parse_arg fold s sl with [ Some sl -> parse_aux fold anon_fun sl | None -> [s :: parse_aux fold anon_fun sl] ] else do { (anon_fun s : unit); parse_aux fold anon_fun sl } ]; value align_doc key s = let s = loop 0 where rec loop i = if i = String.length s then "" else if s.[i] = ' ' then loop (i + 1) else String.sub s i (String.length s - i) in let (p, s) = if String.length s > 0 then if s.[0] = '<' then loop 0 where rec loop i = if i = String.length s then ("", s) else if s.[i] <> '>' then loop (i + 1) else let p = String.sub s 0 (i + 1) in loop (i + 1) where rec loop i = if i >= String.length s then (p, "") else if s.[i] = ' ' then loop (i + 1) else (p, String.sub s i (String.length s - i)) else ("", s) else ("", "") in let tab = String.make (max 1 (16 - String.length key - String.length p)) ' ' in p ^ tab ^ s; value make_symlist l = match l with [ [] -> "" | [h::t] -> (List.fold_left (fun x y -> x ^ "|" ^ y) ("{" ^ h) t) ^ "}" ]; value print_usage_list l = List.iter (fun (key, spec, doc) -> match spec with [ Arg.Symbol symbs _ -> let s = make_symlist symbs in let synt = key ^ " " ^ s in eprintf " %s %s\n" synt (align_doc synt doc) | _ -> eprintf " %s %s\n" key (align_doc key doc) ] ) l; value remaining_args argv = let rec loop l i = if i == Array.length argv then l else loop [argv.(i) :: l] (i + 1) in List.rev (loop [] (Arg.current.val + 1)); value init_spec_list = ref []; value ext_spec_list = ref []; value init spec_list = init_spec_list.val := spec_list; value add name spec descr = ext_spec_list.val := [(name, spec, descr) :: ext_spec_list.val]; value fold f init = let spec_list = init_spec_list.val @ ext_spec_list.val in let specs = List.sort (fun (k1, _, _) (k2, _, _) -> String.compare k2 k1) spec_list in List.fold_right f specs init; value parse anon_fun argv = let remaining_args = remaining_args argv in parse_aux fold anon_fun remaining_args; value ext_spec_list () = ext_spec_list.val; camlp4-5.3-1/camlp4/Camlp4/Options.mli000066400000000000000000000026621473134377200173560ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) type spec_list = list (string * Arg.spec * string); value init : spec_list -> unit; value add : string -> Arg.spec -> string -> unit; (** Add an option to the command line options. *) value print_usage_list : spec_list -> unit; value ext_spec_list : unit -> spec_list; value parse : (string -> unit) -> array string -> list string; camlp4-5.3-1/camlp4/Camlp4/PreCast.ml000066400000000000000000000052721473134377200171130ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) module Id = struct value name = "Camlp4.PreCast"; value version = Sys.ocaml_version; end; type camlp4_token = Sig.camlp4_token == [ KEYWORD of string | SYMBOL of string | LIDENT of string | UIDENT of string | ESCAPED_IDENT of string | INT of int and string | INT32 of int32 and string | INT64 of int64 and string | NATIVEINT of nativeint and string | FLOAT of float and string | CHAR of char and string | STRING of string and string | LABEL of string | OPTLABEL of string | QUOTATION of Sig.quotation | ANTIQUOT of string and string | COMMENT of string | BLANKS of string | NEWLINE | LINE_DIRECTIVE of int and option string | EOI ]; module Loc = Struct.Loc; module Ast = Struct.Camlp4Ast.Make Loc; module Token = Struct.Token.Make Loc; module Lexer = Struct.Lexer.Make Token; module Gram = Struct.Grammar.Static.Make Lexer; module DynLoader = Struct.DynLoader; module Quotation = Struct.Quotation.Make Ast; module MakeSyntax (U : sig end) = OCamlInitSyntax.Make Ast Gram Quotation; module Syntax = MakeSyntax (struct end); module AstFilters = Struct.AstFilters.Make Ast; module MakeGram = Struct.Grammar.Static.Make; module Printers = struct module OCaml = Printers.OCaml.Make Syntax; module OCamlr = Printers.OCamlr.Make Syntax; (* module OCamlrr = Printers.OCamlrr.Make Syntax; *) module DumpOCamlAst = Printers.DumpOCamlAst.Make Syntax; module DumpCamlp4Ast = Printers.DumpCamlp4Ast.Make Syntax; module Null = Printers.Null.Make Syntax; end; camlp4-5.3-1/camlp4/Camlp4/PreCast.mli000066400000000000000000000062221473134377200172600ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) type camlp4_token = Sig.camlp4_token == [ KEYWORD of string | SYMBOL of string | LIDENT of string | UIDENT of string | ESCAPED_IDENT of string | INT of int and string | INT32 of int32 and string | INT64 of int64 and string | NATIVEINT of nativeint and string | FLOAT of float and string | CHAR of char and string | STRING of string and string | LABEL of string | OPTLABEL of string | QUOTATION of Sig.quotation | ANTIQUOT of string and string | COMMENT of string | BLANKS of string | NEWLINE | LINE_DIRECTIVE of int and option string | EOI ]; module Id : Sig.Id; module Loc : Sig.Loc; module Ast : Sig.Camlp4Ast with module Loc = Loc; module Token : Sig.Token with module Loc = Loc and type t = camlp4_token; module Lexer : Sig.Lexer with module Loc = Loc and module Token = Token; module Gram : Sig.Grammar.Static with module Loc = Loc and module Token = Token; module Quotation : Sig.Quotation with module Ast = Sig.Camlp4AstToAst Ast; module DynLoader : Sig.DynLoader; module AstFilters : Sig.AstFilters with module Ast = Ast; module Syntax : Sig.Camlp4Syntax with module Loc = Loc and module Token = Token and module Ast = Ast and module Gram = Gram and module Quotation = Quotation; module Printers : sig module OCaml : (Sig.Printer Ast).S; module OCamlr : (Sig.Printer Ast).S; module DumpOCamlAst : (Sig.Printer Ast).S; module DumpCamlp4Ast : (Sig.Printer Ast).S; module Null : (Sig.Printer Ast).S; end; module MakeGram (Lexer : Sig.Lexer with module Loc = Loc) : Sig.Grammar.Static with module Loc = Loc and module Token = Lexer.Token; module MakeSyntax (U : sig end) : Sig.Syntax; camlp4-5.3-1/camlp4/Camlp4/Printers.mlpack000066400000000000000000000000551473134377200202110ustar00rootroot00000000000000DumpCamlp4Ast DumpOCamlAst Null OCaml OCamlr camlp4-5.3-1/camlp4/Camlp4/Printers/000077500000000000000000000000001473134377200170205ustar00rootroot00000000000000camlp4-5.3-1/camlp4/Camlp4/Printers/DumpCamlp4Ast.ml000066400000000000000000000037511473134377200217760ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) module Id = struct value name = "Camlp4Printers.DumpCamlp4Ast"; value version = Sys.ocaml_version; end; module Make (Syntax : Sig.Syntax) : (Sig.Printer Syntax.Ast).S = struct include Syntax; value with_open_out_file x f = match x with [ Some file -> do { let oc = open_out_bin file; f oc; flush oc; close_out oc } | None -> do { set_binary_mode_out stdout True; f stdout; flush stdout } ]; value dump_ast magic ast oc = do { output_string oc magic; output_value oc ast; }; value print_interf ?input_file:(_) ?output_file ast = with_open_out_file output_file (dump_ast Camlp4_config.camlp4_ast_intf_magic_number ast); value print_implem ?input_file:(_) ?output_file ast = with_open_out_file output_file (dump_ast Camlp4_config.camlp4_ast_impl_magic_number ast); end; camlp4-5.3-1/camlp4/Camlp4/Printers/DumpCamlp4Ast.mli000066400000000000000000000022221473134377200221370ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Nicolas Pouillard: initial version *) module Id : Sig.Id; module Make (Syntax : Sig.Syntax) : (Sig.Printer Syntax.Ast).S; camlp4-5.3-1/camlp4/Camlp4/Printers/DumpOCamlAst.ml000066400000000000000000000042751473134377200216530ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) module Id : Sig.Id = struct value name = "Camlp4Printers.DumpOCamlAst"; value version = Sys.ocaml_version; end; module Make (Syntax : Sig.Camlp4Syntax) : (Sig.Printer Syntax.Ast).S = struct include Syntax; module Ast2pt = Struct.Camlp4Ast2OCamlAst.Make Ast; value with_open_out_file x f = match x with [ Some file -> do { let oc = open_out_bin file; f oc; flush oc; close_out oc } | None -> do { set_binary_mode_out stdout True; f stdout; flush stdout } ]; value dump_pt magic fname pt oc = do { output_string oc magic; output_value oc (if fname = "-" then "" else fname); output_value oc pt; }; value print_interf ?(input_file = "-") ?output_file ast = let pt = Ast2pt.sig_item ast in with_open_out_file output_file (dump_pt Camlp4_config.ocaml_ast_intf_magic_number input_file pt); value print_implem ?(input_file = "-") ?output_file ast = let pt = Ast2pt.str_item ast in with_open_out_file output_file (dump_pt Camlp4_config.ocaml_ast_impl_magic_number input_file pt); end; camlp4-5.3-1/camlp4/Camlp4/Printers/DumpOCamlAst.mli000066400000000000000000000022301473134377200220110ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Nicolas Pouillard: initial version *) module Id : Sig.Id; module Make (Syntax : Sig.Camlp4Syntax) : (Sig.Printer Syntax.Ast).S; camlp4-5.3-1/camlp4/Camlp4/Printers/Null.ml000066400000000000000000000026101473134377200202630ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) module Id = struct value name = "Camlp4.Printers.Null"; value version = Sys.ocaml_version; end; module Make (Syntax : Sig.Syntax) = struct include Syntax; value print_interf ?input_file:(_) ?output_file:(_) _ = (); value print_implem ?input_file:(_) ?output_file:(_) _ = (); end; camlp4-5.3-1/camlp4/Camlp4/Printers/Null.mli000066400000000000000000000022711473134377200204370ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) module Id : Sig.Id; module Make (Syntax : Sig.Syntax) : (Sig.Printer Syntax.Ast).S; camlp4-5.3-1/camlp4/Camlp4/Printers/OCaml.ml000066400000000000000000001406331473134377200203540ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Nicolas Pouillard: initial version *) open Format; module Id = struct value name = "Camlp4.Printers.OCaml"; value version = Sys.ocaml_version; end; module Make (Syntax : Sig.Camlp4Syntax) = struct include Syntax; type sep = format unit formatter unit; type fun_binding = [= `patt of Ast.patt | `newtype of string ]; value pp = fprintf; value cut f = fprintf f "@ "; value list' elt sep sep' f = let rec loop = fun [ [] -> () | [x::xs] -> do { pp f sep ; elt f x; pp f sep'; loop xs } ] in fun [ [] -> () | [x] -> do { elt f x; pp f sep' } | [x::xs] -> do { elt f x; pp f sep'; loop xs } ]; value list elt sep f = let rec loop = fun [ [] -> () | [x::xs] -> do { pp f sep ; elt f x; loop xs } ] in fun [ [] -> () | [x] -> elt f x | [x::xs] -> do { elt f x; loop xs } ]; value rec list_of_meta_list = fun [ Ast.LNil -> [] | Ast.LCons x xs -> [x :: list_of_meta_list xs] | Ast.LAnt _ -> assert False ]; value meta_list elt sep f mxs = let xs = list_of_meta_list mxs in list elt sep f xs; module CommentFilter = Struct.CommentFilter.Make Token; value comment_filter = CommentFilter.mk (); CommentFilter.define (Gram.get_filter ()) comment_filter; module StringSet = Set.Make String; value infix_lidents = ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"]; value is_infix = let first_chars = ['='; '<'; '>'; '|'; '&'; '$'; '@'; '^'; '+'; '-'; '*'; '/'; '%'; '\\'] and infixes = List.fold_right StringSet.add infix_lidents StringSet.empty in fun s -> (StringSet.mem s infixes || (s <> "" && List.mem s.[0] first_chars)); value is_keyword = let keywords = (* without infix_lidents *) List.fold_right StringSet.add ["and"; "as"; "assert"; "begin"; "class"; "constraint"; "do"; "done"; "downto"; "else"; "end"; "exception"; "external"; "false"; "for"; "fun"; "function"; "functor"; "if"; "in"; "include"; "inherit"; "initializer"; "lazy"; "let"; "match"; "method"; "module"; "mutable"; "new"; "object"; "of"; "open"; "parser"; "private"; "rec"; "sig"; "struct"; "then"; "to"; "true"; "try"; "type"; "val"; "virtual"; "when"; "while"; "with"] StringSet.empty in fun s -> StringSet.mem s keywords; module Lexer = Struct.Lexer.Make Token; let module M = ErrorHandler.Register Lexer.Error in (); open Sig; value lexer s = Lexer.from_string ~quotations:Camlp4_config.quotations.val Loc.ghost s; value lex_string str = try match lexer str with parser [: `(tok, _); `(EOI, _) :] -> tok with [ Stream.Failure | Stream.Error _ -> failwith (sprintf "Cannot print %S this string contains more than one token" str) | Lexer.Error.E exn -> failwith (sprintf "Cannot print %S this identifier does not respect OCaml lexing rules (%s)" str (Lexer.Error.to_string exn)) ]; (* This is to be sure character literals are always escaped. *) value ocaml_char x = Char.escaped (Struct.Token.Eval.char x); value rec get_expr_args a al = match a with [ <:expr< $a1$ $a2$ >> -> get_expr_args a1 [a2 :: al] | _ -> (a, al) ]; value rec get_patt_args a al = match a with [ <:patt< $a1$ $a2$ >> -> get_patt_args a1 [a2 :: al] | _ -> (a, al) ]; value rec get_ctyp_args a al = match a with [ <:ctyp< $a1$ $a2$ >> -> get_ctyp_args a1 [a2 :: al] | _ -> (a, al) ]; value is_irrefut_patt = Ast.is_irrefut_patt; value rec expr_fun_args = fun [ <:expr< fun $p$ -> $e$ >> as ge -> if is_irrefut_patt p then let (pl, e) = expr_fun_args e in ([`patt p :: pl], e) else ([], ge) | <:expr< fun (type $i$) -> $e$ >> -> let (pl, e) = expr_fun_args e in ([`newtype i :: pl], e) | ge -> ([], ge) ]; value rec class_expr_fun_args = fun [ <:class_expr< fun $p$ -> $ce$ >> as ge -> if is_irrefut_patt p then let (pl, ce) = class_expr_fun_args ce in ([p :: pl], ce) else ([], ge) | ge -> ([], ge) ]; value rec do_print_comments_before loc f = parser [ [: ` (comm, comm_loc) when Loc.strictly_before comm_loc loc; s :] -> let () = f comm comm_loc in do_print_comments_before loc f s | [: :] -> () ]; class printer ?curry_constr:(init_curry_constr = False) ?(comments = True) () = object (o) (** pipe means we are under a match case (try, function) *) value pipe = False; value semi = False; method under_pipe = {< pipe = True >}; method under_semi = {< semi = True >}; method reset_semi = {< semi = False >}; method reset = {< pipe = False; semi = False >}; value semisep : sep = ";;"; value no_semisep : sep = ""; (* used to mark where ";;" should not occur *) value mode = if comments then `comments else `no_comments; value curry_constr = init_curry_constr; value var_conversion = False; method andsep : sep = "@]@ @[<2>and@ "; method value_val = "val"; method value_let = "let"; method semisep = semisep; method set_semisep s = {< semisep = s >}; method set_comments b = {< mode = if b then `comments else `no_comments >}; method set_loc_and_comments = {< mode = `loc_and_comments >}; method set_curry_constr b = {< curry_constr = b >}; method print_comments_before loc f = match mode with [ `comments -> do_print_comments_before loc (fun c _ -> pp f "%s@ " c) (CommentFilter.take_stream comment_filter) | `loc_and_comments -> let () = pp f "(*loc: %a*)@ " Loc.dump loc in do_print_comments_before loc (fun s -> pp f "%s(*comm_loc: %a*)@ " s Loc.dump) (CommentFilter.take_stream comment_filter) | _ -> () ]; method var f = fun [ "" -> pp f "$lid:\"\"$" | "[]" -> pp f "[]" | "()" -> pp f "()" | " True" -> pp f "True" | " False" -> pp f "False" | v -> match (var_conversion, v) with [ (True, "val") -> pp f "contents" | (True, "True") -> pp f "true" | (True, "False") -> pp f "false" | _ -> match lex_string v with [ (LIDENT s | UIDENT s | ESCAPED_IDENT s) when is_keyword s -> pp f "%s__" s | (LIDENT s | ESCAPED_IDENT s) when List.mem s infix_lidents -> pp f "( %s )" s | SYMBOL s -> pp f "( %s )" s | LIDENT s | UIDENT s | ESCAPED_IDENT s -> pp_print_string f s | tok -> failwith (sprintf "Bad token used as an identifier: %s" (Token.to_string tok)) ] ] ]; method type_params f = fun [ [] -> () | [x] -> pp f "%a@ " o#ctyp x | l -> pp f "@[<1>(%a)@]@ " (list o#ctyp ",@ ") l ]; method class_params f = fun [ <:ctyp< $t1$, $t2$ >> -> pp f "@[<1>%a,@ %a@]" o#class_params t1 o#class_params t2 | x -> o#ctyp f x ]; method override_flag f = fun [ Ast.OvOverride -> pp f "!" | Ast.OvNil -> () | Ast.OvAnt s -> o#anti f s ]; method mutable_flag f = fun [ Ast.MuMutable -> pp f "mutable@ " | Ast.MuNil -> () | Ast.MuAnt s -> o#anti f s ]; method rec_flag f = fun [ Ast.ReRecursive -> pp f "rec@ " | Ast.ReNonrecursive | Ast.ReNil -> () | Ast.ReAnt s -> o#anti f s ]; method nonrec_flag f = fun [ Ast.ReNonrecursive -> pp f "nonrec@ " | Ast.ReRecursive | Ast.ReNil -> () | Ast.ReAnt s -> o#anti f s ]; method virtual_flag f = fun [ Ast.ViVirtual -> pp f "virtual@ " | Ast.ViNil -> () | Ast.ViAnt s -> o#anti f s ]; method private_flag f = fun [ Ast.PrPrivate -> pp f "private@ " | Ast.PrNil -> () | Ast.PrAnt s -> o#anti f s ]; method anti f s = pp f "$%s$" s; method seq f = fun [ <:expr< $e1$; $e2$ >> -> pp f "%a;@ %a" o#under_semi#seq e1 o#seq e2 | <:expr< do { $e$ } >> -> o#seq f e | e -> o#expr f e ]; (* FIXME when the Format module will fixed. pp_print_if_newline f (); pp_print_string f "| "; *) method match_case f = fun [ <:match_case@_loc<>> -> pp f "@[<2>@ _ ->@ %a@]" o#raise_match_failure _loc | a -> o#match_case_aux f a ]; method match_case_aux f = fun [ <:match_case<>> -> () | <:match_case< $anti:s$ >> -> o#anti f s | <:match_case< $a1$ | $a2$ >> -> pp f "%a%a" o#match_case_aux a1 o#match_case_aux a2 | <:match_case< $p$ -> $e$ >> -> pp f "@ | @[<2>%a@ ->@ %a@]" o#patt p o#under_pipe#expr e | <:match_case< $p$ when $w$ -> $e$ >> -> pp f "@ | @[<2>%a@ when@ %a@ ->@ %a@]" o#patt p o#under_pipe#expr w o#under_pipe#expr e ]; method fun_binding f = fun [ `patt p -> o#simple_patt f p | `newtype i -> pp f "(type %s)" i ]; method binding f bi = let () = o#node f bi Ast.loc_of_binding in match bi with [ <:binding<>> -> () | <:binding< $b1$ and $b2$ >> -> do { o#binding f b1; pp f o#andsep; o#binding f b2 } | <:binding< $p$ = $e$ >> -> let (pl, e') = match p with [ <:patt< ($_$ : $_$) >> -> ([], e) | _ -> expr_fun_args e ] in match (p, e') with [ (<:patt< $lid:_$ >>, <:expr< ($e'$ : $t$) >>) -> pp f "%a :@ %a =@ %a" (list o#fun_binding "@ ") [`patt p::pl] o#ctyp t o#expr e' | (<:patt< $lid:_$ >>, _) -> pp f "%a @[<0>%a=@]@ %a" o#simple_patt p (list' o#fun_binding "" "@ ") pl o#expr e' | _ -> pp f "%a =@ %a" o#simple_patt p o#expr e ] | <:binding< $anti:s$ >> -> o#anti f s ]; method record_binding f bi = let () = o#node f bi Ast.loc_of_rec_binding in match bi with [ <:rec_binding<>> -> () | <:rec_binding< $i$ = $e$ >> -> pp f "@ @[<2>%a =@ %a@];" o#var_ident i o#expr e | <:rec_binding< $b1$ ; $b2$ >> -> do { o#under_semi#record_binding f b1; o#under_semi#record_binding f b2 } | <:rec_binding< $anti:s$ >> -> o#anti f s ]; method mk_patt_list = fun [ <:patt< [$p1$ :: $p2$] >> -> let (pl, c) = o#mk_patt_list p2 in ([p1 :: pl], c) | <:patt< [] >> -> ([], None) | p -> ([], Some p) ]; method mk_expr_list = fun [ <:expr< [$e1$ :: $e2$] >> -> let (el, c) = o#mk_expr_list e2 in ([e1 :: el], c) | <:expr< [] >> -> ([], None) | e -> ([], Some e) ]; method expr_list f = fun [ [] -> pp f "[]" | [e] -> pp f "[ %a ]" o#under_semi#expr e | el -> pp f "@[<2>[ %a@] ]" (list o#under_semi#expr ";@ ") el ]; method expr_list_cons simple f e = let (el, c) = o#mk_expr_list e in match c with [ None -> o#expr_list f el | Some x -> (if simple then pp f "@[<2>(%a)@]" else pp f "@[<2>%a@]") (list o#under_semi#dot_expr " ::@ ") (el @ [x]) ]; method patt_expr_fun_args f (p, e) = let (pl, e) = expr_fun_args e in pp f "%a@ ->@ %a" (list o#fun_binding "@ ") [p::pl] o#expr e; method patt_class_expr_fun_args f (p, ce) = let (pl, ce) = class_expr_fun_args ce in pp f "%a =@]@ %a" (list o#simple_patt "@ ") [p::pl] o#class_expr ce; method constrain f (t1, t2) = pp f "@[<2>constraint@ %a =@ %a@]" o#ctyp t1 o#ctyp t2; method sum_type f t = match Ast.list_of_ctyp t [] with [ [] -> () | ts -> pp f "@[| %a@]" (list o#constructor_declaration "@ | ") ts ]; method private constructor_declaration f t = match t with [ <:ctyp< $t1$ : $t2$ -> $t3$ >> -> pp f "@[<2>%a :@ @[<2>%a@ ->@ %a@]@]" o#ctyp t1 o#constructor_type t2 o#ctyp t3 | t -> o#ctyp f t ]; method string f = pp f "%s"; method quoted_string f = pp f "%S"; method numeric f num suff = if num.[0] = '-' then pp f "(%s%s)" num suff else pp f "%s%s" num suff; method module_expr_get_functor_args accu = fun [ <:module_expr< functor ($s$ : $mt$) -> $me$ >> -> o#module_expr_get_functor_args [(s, mt)::accu] me | <:module_expr< ($me$ : $mt$) >> -> (List.rev accu, me, Some mt) | me -> (List.rev accu, me, None) ]; method functor_args f = list o#functor_arg "@ " f; method functor_arg f (s, mt) = match mt with [ Ast.MtNil _ -> o#functor_arg_var f s | _ -> pp f "@[<2>(%a :@ %a)@]" o#functor_arg_var s o#module_type mt ]; method functor_arg_var f v = match v with [ "*" -> pp f "()" | v -> o#var f v ]; method module_rec_binding f = fun [ <:module_binding<>> -> () | <:module_binding< $s$ : $mt$ = $me$ >> -> pp f "@[<2>%a :@ %a =@ %a@]" o#var s o#module_type mt o#module_expr me | <:module_binding< $s$ : $mt$ >> -> pp f "@[<2>%a :@ %a@]" o#var s o#module_type mt | <:module_binding< $mb1$ and $mb2$ >> -> do { o#module_rec_binding f mb1; pp f o#andsep; o#module_rec_binding f mb2 } | <:module_binding< $anti:s$ >> -> o#anti f s ]; method class_declaration f = fun [ <:class_expr< ( $ce$ : $ct$ ) >> -> pp f "%a :@ %a" o#class_expr ce o#class_type ct | ce -> o#class_expr f ce ]; method raise_match_failure f _loc = let n = Loc.file_name _loc in let l = Loc.start_line _loc in let c = Loc.start_off _loc - Loc.start_bol _loc in o#expr f <:expr< raise (Match_failure $`str:n$ $`int:l$ $`int:c$) >>; method node : ! 'a . formatter -> 'a -> ('a -> Loc.t) -> unit = fun f node loc_of_node -> o#print_comments_before (loc_of_node node) f; method ident f i = let () = o#node f i Ast.loc_of_ident in match i with [ <:ident< $i1$.$i2$ >> -> pp f "%a.@,%a" o#ident i1 o#ident i2 | <:ident< $i1$ $i2$ >> -> pp f "%a@,(%a)" o#ident i1 o#ident i2 | <:ident< $anti:s$ >> -> o#anti f s | <:ident< $lid:s$ >> | <:ident< $uid:s$ >> -> o#var f s ]; method private var_ident = {< var_conversion = True >}#ident; method expr f e = let () = o#node f e Ast.loc_of_expr in match e with [ ((<:expr< let $rec:_$ $_$ in $_$ >> | <:expr< let module $_$ = $_$ in $_$ >>) as e) when semi -> pp f "(%a)" o#reset#expr e | ((<:expr< match $_$ with [ $_$ ] >> | <:expr< try $_$ with [ $_$ ] >> | <:expr< fun [ $_$ ] >>) as e) when pipe || semi -> pp f "(%a)" o#reset#expr e | <:expr< - $x$ >> -> (* If you want to remove the space take care of - !r *) pp f "@[<2>-@ %a@]" o#dot_expr x | <:expr< -. $x$ >> -> pp f "@[<2>-.@ %a@]" o#dot_expr x (* same note as above *) | <:expr< [$_$ :: $_$] >> -> o#expr_list_cons False f e | <:expr@_loc< $lid:n$ $x$ $y$ >> when is_infix n -> pp f "@[<2>%a@ %s@ %a@]" o#apply_expr x n o#apply_expr y | <:expr< $x$ $y$ >> -> let (a, al) = get_expr_args x [y] in if (not curry_constr) && Ast.is_expr_constructor a then match al with [ [ <:expr< ($tup:_$) >> ] -> pp f "@[<2>%a@ (%a)@]" o#apply_expr x o#expr y | [_] -> pp f "@[<2>%a@ %a@]" o#apply_expr x o#apply_expr y | al -> pp f "@[<2>%a@ (%a)@]" o#apply_expr a (* The #apply_expr below may put too much parens. However using #expr would be wrong: PR#5056. *) (list o#under_pipe#apply_expr ",@ ") al ] else pp f "@[<2>%a@]" (list o#apply_expr "@ ") [a::al] | <:expr< $e1$.val := $e2$ >> -> pp f "@[<2>%a :=@ %a@]" o#dot_expr e1 o#expr e2 | <:expr< $e1$ := $e2$ >> -> pp f "@[<2>%a@ <-@ %a@]" o#dot_expr e1 o#expr e2 | <:expr@loc< fun [] >> -> pp f "@[<2>fun@ _@ ->@ %a@]" o#raise_match_failure loc | <:expr< fun $p$ -> $e$ >> when is_irrefut_patt p -> pp f "@[<2>fun@ %a@]" o#patt_expr_fun_args (`patt p, e) | <:expr< fun (type $i$) -> $e$ >> -> pp f "@[<2>fun@ %a@]" o#patt_expr_fun_args (`newtype i, e) | <:expr< fun [ $a$ ] >> -> pp f "@[function%a@]" o#match_case a | <:expr< if $e1$ then $e2$ else $e3$ >> -> pp f "@[@[<2>if@ %a@]@ @[<2>then@ %a@]@ @[<2>else@ %a@]@]" o#expr e1 o#under_semi#expr e2 o#under_semi#expr e3 | <:expr< lazy $e$ >> -> pp f "@[<2>lazy@ %a@]" o#simple_expr e | <:expr< let $rec:r$ $bi$ in $e$ >> -> match e with [ <:expr< let $rec:_$ $_$ in $_$ >> -> pp f "@[<0>@[<2>let %a%a in@]@ %a@]" o#rec_flag r o#binding bi o#reset_semi#expr e | _ -> pp f "@[@[<2>let %a%a@]@ @[in@ %a@]@]" o#rec_flag r o#binding bi o#reset_semi#expr e ] | Ast.ExOpI _loc i ov e -> (* | <:expr< let open $i$ in $e$ >> -> *) pp f "@[<2>let open%a %a@]@ @[<2>in@ %a@]" o#override_flag ov o#ident i o#reset_semi#expr e | <:expr< match $e$ with [ $a$ ] >> -> pp f "@[@[@[<2>match %a@]@ with@]%a@]" o#expr e o#match_case a | <:expr< try $e$ with [ $a$ ] >> -> pp f "@[<0>@[try@ %a@]@ @[<0>with%a@]@]" o#expr e o#match_case a | <:expr< assert False >> -> pp f "@[<2>assert@ false@]" | <:expr< assert $e$ >> -> pp f "@[<2>assert@ %a@]" o#dot_expr e | <:expr< let module $s$ = $me$ in $e$ >> -> pp f "@[<2>let module %a =@ %a@]@ @[<2>in@ %a@]" o#var s o#module_expr me o#reset_semi#expr e | <:expr< object $cst$ end >> -> pp f "@[@[object@ %a@]@ end@]" o#class_str_item cst | <:expr< object ($p$ : $t$) $cst$ end >> -> pp f "@[@[object @[<1>(%a :@ %a)@]@ %a@]@ end@]" o#patt p o#ctyp t o#class_str_item cst | <:expr< object ($p$) $cst$ end >> -> pp f "@[@[object @[<2>(%a)@]@ %a@]@ end@]" o#patt p o#class_str_item cst | e -> o#apply_expr f e ]; method apply_expr f e = let () = o#node f e Ast.loc_of_expr in match e with [ <:expr< new $i$ >> -> pp f "@[<2>new@ %a@]" o#ident i | e -> o#dot_expr f e ]; method dot_expr f e = let () = o#node f e Ast.loc_of_expr in match e with [ <:expr< $e$.val >> -> pp f "@[<2>!@,%a@]" o#simple_expr e | <:expr< $e1$ . $e2$ >> -> pp f "@[<2>%a.@,%a@]" o#dot_expr e1 o#dot_expr e2 | <:expr< $e1$ .( $e2$ ) >> -> pp f "@[<2>%a.@,(%a)@]" o#dot_expr e1 o#expr e2 | <:expr< $e1$ .[ $e2$ ] >> -> pp f "%a.@[<1>[@,%a@]@,]" o#dot_expr e1 o#expr e2 | <:expr< $e$ # $s$ >> -> pp f "@[<2>%a#@,%s@]" o#dot_expr e s | e -> o#simple_expr f e ]; method simple_expr f e = let () = o#node f e Ast.loc_of_expr in match e with [ <:expr<>> -> () | <:expr< do { $e$ } >> -> pp f "@[(%a)@]" o#seq e | <:expr< [$_$ :: $_$] >> -> o#expr_list_cons True f e | <:expr< ( $tup:e$ ) >> -> pp f "@[<1>(%a)@]" o#expr e | <:expr< [| $e$ |] >> -> pp f "@[<0>@[<2>[|@ %a@]@ |]@]" o#under_semi#expr e | <:expr< ($e$ :> $t$) >> -> pp f "@[<2>(%a :>@ %a)@]" o#expr e o#ctyp t | <:expr< ($e$ : $t1$ :> $t2$) >> -> pp f "@[<2>(%a :@ %a :>@ %a)@]" o#expr e o#ctyp t1 o#ctyp t2 | <:expr< ($e$ : $t$) >> -> pp f "@[<2>(%a :@ %a)@]" o#expr e o#ctyp t | <:expr< $anti:s$ >> -> o#anti f s | <:expr< for $p$ = $e1$ $to:df$ $e2$ do { $e3$ } >> -> pp f "@[@[@[<2>for %a =@ %a@ %a@ %a@ do@]@ %a@]@ done@]" o#patt p o#expr e1 o#direction_flag df o#expr e2 o#seq e3 | <:expr< $int:s$ >> -> o#numeric f s "" | <:expr< $nativeint:s$ >> -> o#numeric f s "n" | <:expr< $int64:s$ >> -> o#numeric f s "L" | <:expr< $int32:s$ >> -> o#numeric f s "l" | <:expr< $flo:s$ >> -> o#numeric f s "" | <:expr< $chr:s$ >> -> pp f "'%s'" (ocaml_char s) | <:expr< $id:i$ >> -> o#var_ident f i | <:expr< { $b$ } >> -> pp f "@[@[{%a@]@ }@]" o#record_binding b | <:expr< { ($e$) with $b$ } >> -> pp f "@[@[{@ (%a)@ with%a@]@ }@]" o#expr e o#record_binding b | <:expr< $str:s$ >> -> pp f "\"%s\"" s | <:expr< while $e1$ do { $e2$ } >> -> pp f "@[<2>while@ %a@ do@ %a@ done@]" o#expr e1 o#seq e2 | <:expr< ~ $s$ >> -> pp f "~%s" s | <:expr< ~ $s$ : $e$ >> -> pp f "@[<2>~%s:@ %a@]" s o#dot_expr e | <:expr< ? $s$ >> -> pp f "?%s" s | <:expr< ? $s$ : $e$ >> -> pp f "@[<2>?%s:@ %a@]" s o#dot_expr e | <:expr< ` $lid:s$ >> -> pp f "`%a" o#var s | <:expr< {< $b$ >} >> -> pp f "@[@[{<%a@]@ >}@]" o#record_binding b | <:expr< $e1$, $e2$ >> -> pp f "%a,@ %a" o#simple_expr e1 o#simple_expr e2 | <:expr< $e1$; $e2$ >> -> pp f "%a;@ %a" o#under_semi#expr e1 o#expr e2 | <:expr< (module $me$ : $mt$) >> -> pp f "@[@[(module %a : %a@])@]" o#module_expr me o#module_type mt | <:expr< (module $me$) >> -> pp f "@[@[(module %a@])@]" o#module_expr me | Ast.ExAtt _loc s str e -> pp f "((%a)[@@%s %a])" o#expr e s o#str_item str | <:expr< $_$ $_$ >> | <:expr< $_$ . $_$ >> | <:expr< $_$ . ( $_$ ) >> | <:expr< $_$ . [ $_$ ] >> | <:expr< $_$ := $_$ >> | <:expr< $_$ # $_$ >> | <:expr< fun [ $_$ ] >> | <:expr< fun (type $_$) -> $_$ >> | <:expr< match $_$ with [ $_$ ] >> | <:expr< try $_$ with [ $_$ ] >> | <:expr< if $_$ then $_$ else $_$ >> | <:expr< let $rec:_$ $_$ in $_$ >> | <:expr< let module $_$ = $_$ in $_$ >> | (* <:expr< let open $_$ in $_$ >> *)Ast.ExOpI _ _ _ _ | <:expr< assert $_$ >> | <:expr< assert False >> | <:expr< lazy $_$ >> | <:expr< new $_$ >> | <:expr< object ($_$) $_$ end >> -> pp f "(%a)" o#reset#expr e ]; method direction_flag f b = match b with [ Ast.DiTo -> pp_print_string f "to" | Ast.DiDownto -> pp_print_string f "downto" | Ast.DiAnt s -> o#anti f s ]; method patt f p = let () = o#node f p Ast.loc_of_patt in match p with [ <:patt< ( $p1$ as $p2$ ) >> -> pp f "@[<1>(%a@ as@ %a)@]" o#patt p1 o#patt p2 | <:patt< $i$ = $p$ >> -> pp f "@[<2>%a =@ %a@]" o#var_ident i o#patt p | <:patt< $p1$; $p2$ >> -> pp f "%a;@ %a" o#patt p1 o#patt p2 | p -> o#patt1 f p ]; method patt1 f = fun [ <:patt< $p1$ | $p2$ >> -> pp f "@[<2>%a@ |@ %a@]" o#patt1 p1 o#patt2 p2 | p -> o#patt2 f p ]; method patt2 f = fun [ (* <:patt< ( $tup:p$ ) >> -> pp f "@[<1>(%a)@]" o#patt3 p | *) p -> o#patt3 f p ]; method patt3 f = fun [ <:patt< $p1$ .. $p2$ >> -> pp f "@[<2>%a@ ..@ %a@]" o#patt3 p1 o#patt4 p2 | <:patt< $p1$, $p2$ >> -> pp f "%a,@ %a" o#patt3 p1 o#patt3 p2 | p -> o#patt4 f p ]; method patt4 f = fun [ <:patt< [$_$ :: $_$] >> as p -> let (pl, c) = o#mk_patt_list p in match c with [ None -> pp f "@[<2>[@ %a@]@ ]" (list o#patt ";@ ") pl | Some x -> pp f "@[<2>%a@]" (list o#patt5 " ::@ ") (pl @ [x]) ] | p -> o#patt5 f p ]; method patt5 f = fun [ <:patt< [$_$ :: $_$] >> as p -> o#simple_patt f p | <:patt< lazy $p$ >> -> pp f "@[<2>lazy %a@]" o#simple_patt p | Ast.PaExc _ p -> pp f "@[<2>exception %a@]" o#simple_patt p | <:patt< $x$ $y$ >> -> let (a, al) = get_patt_args x [y] in if not (Ast.is_patt_constructor a) then Format.eprintf "WARNING: strange pattern application of a non constructor@." else if curry_constr then pp f "@[<2>%a@]" (list o#simple_patt "@ ") [a::al] else match al with [ [ <:patt< ($tup:_$) >> ] -> pp f "@[<2>%a@ (%a)@]" o#simple_patt x o#patt y | [_] -> pp f "@[<2>%a@ %a@]" o#patt5 x o#simple_patt y | al -> pp f "@[<2>%a@ (%a)@]" o#patt5 a (list o#simple_patt ",@ ") al ] | p -> o#simple_patt f p ]; method simple_patt f p = let () = o#node f p Ast.loc_of_patt in match p with [ <:patt<>> -> () | <:patt< $id:i$ >> -> o#var_ident f i | <:patt< $anti:s$ >> -> o#anti f s | <:patt< _ >> -> pp f "_" | <:patt< ( module $m$ ) >> -> pp f "(module %s)" m | <:patt< ( $tup:p$ ) >> -> pp f "@[<1>(%a)@]" o#patt3 p | <:patt< { $p$ } >> -> pp f "@[{@ %a@]@ }" o#patt p | <:patt< $str:s$ >> -> pp f "\"%s\"" s | <:patt< ( $p$ : $t$ ) >> -> pp f "@[<1>(%a :@ %a)@]" o#patt p o#ctyp t | <:patt< $nativeint:s$ >> -> o#numeric f s "n" | <:patt< $int64:s$ >> -> o#numeric f s "L" | <:patt< $int32:s$ >> -> o#numeric f s "l" | <:patt< $int:s$ >> -> o#numeric f s "" | <:patt< $flo:s$ >> -> o#numeric f s "" | <:patt< $chr:s$ >> -> pp f "'%s'" (ocaml_char s) | <:patt< ~ $s$ >> -> pp f "~%s" s | <:patt< ` $uid:s$ >> -> pp f "`%a" o#var s | <:patt< # $i$ >> -> pp f "@[<2>#%a@]" o#ident i | <:patt< [| $p$ |] >> -> pp f "@[<2>[|@ %a@]@ |]" o#patt p | <:patt< ~ $s$ : ($p$) >> -> pp f "@[<2>~%s:@ (%a)@]" s o#patt p | <:patt< ? $s$ >> -> pp f "?%s" s | <:patt< ?($p$) >> -> pp f "@[<2>?(%a)@]" o#patt_tycon p | <:patt< ? $s$ : ($p$) >> -> pp f "@[<2>?%s:@,@[<1>(%a)@]@]" s o#patt_tycon p | <:patt< ?($p$ = $e$) >> -> pp f "@[<2>?(%a =@ %a)@]" o#patt_tycon p o#expr e | <:patt< ? $s$ : ($p$ = $e$) >> -> pp f "@[<2>?%s:@,@[<1>(%a =@ %a)@]@]" s o#patt_tycon p o#expr e | <:patt< $_$ $_$ >> | <:patt< ($_$ as $_$) >> | <:patt< $_$ | $_$ >> | <:patt< $_$ .. $_$ >> | <:patt< $_$, $_$ >> | <:patt< $_$; $_$ >> | <:patt< $_$ = $_$ >> | <:patt< lazy $_$ >> | Ast.PaExc _ _ as p -> pp f "@[<1>(%a)@]" o#patt p | Ast.PaAtt _loc s str e -> pp f "((%a)[@@%s %a])" o#patt e s o#str_item str ]; method patt_tycon f = fun [ <:patt< ( $p$ : $t$ ) >> -> pp f "%a :@ %a" o#patt p o#ctyp t | p -> o#patt f p ]; method simple_ctyp f t = let () = o#node f t Ast.loc_of_ctyp in match t with [ <:ctyp< $id:i$ >> -> o#ident f i | <:ctyp< $anti:s$ >> -> o#anti f s | <:ctyp< _ >> -> pp f "_" | Ast.TyOpn _ -> pp f ".." | Ast.TyAnP _ -> pp f "+_" | Ast.TyAnM _ -> pp f "-_" | <:ctyp< ~ $s$ : $t$ >> -> pp f "@[<2>%s:@ %a@]" s o#simple_ctyp t | <:ctyp< ? $s$ : $t$ >> -> pp f "@[<2>?%s:@ %a@]" s o#simple_ctyp t | <:ctyp< < > >> -> pp f "< >" | <:ctyp< < .. > >> -> pp f "< .. >" | <:ctyp< < $t$ .. > >> -> pp f "@[<0>@[<2><@ %a;@ ..@]@ >@]" o#ctyp t | <:ctyp< < $t$ > >> -> pp f "@[<0>@[<2><@ %a@]@ >@]" o#ctyp t | <:ctyp< '$s$ >> -> pp f "'%a" o#var s | <:ctyp< { $t$ } >> -> pp f "@[<2>{@ %a@]@ }" o#ctyp t | <:ctyp< [ $t$ ] >> -> pp f "@[<0>%a@]" o#sum_type t | <:ctyp< ( $tup:t$ ) >> -> pp f "@[<1>(%a)@]" o#ctyp t | <:ctyp< (module $mt$) >> -> pp f "@[<2>(module@ %a@])" o#module_type mt | <:ctyp< [ = $t$ ] >> -> pp f "@[<2>[@ %a@]@ ]" o#sum_type t | <:ctyp< [ < $t$ ] >> -> pp f "@[<2>[<@ %a@]@,]" o#sum_type t | <:ctyp< [ < $t1$ > $t2$ ] >> -> let (a, al) = get_ctyp_args t2 [] in pp f "@[<2>[<@ %a@ >@ %a@]@ ]" o#sum_type t1 (list o#simple_ctyp "@ ") [a::al] | <:ctyp< [ > $t$ ] >> -> pp f "@[<2>[>@ %a@]@,]" o#sum_type t | <:ctyp< # $i$ >> -> pp f "@[<2>#%a@]" o#ident i | <:ctyp< `$s$ >> -> pp f "`%a" o#var s | <:ctyp< $t1$ * $t2$ >> -> pp f "%a *@ %a" o#simple_ctyp t1 o#simple_ctyp t2 | Ast.TyAtt _loc s str e -> pp f "((%a)[@@%s %a])" o#ctyp e s o#str_item str | <:ctyp<>> -> assert False | t -> pp f "@[<1>(%a)@]" o#ctyp t ]; method ctyp f t = let () = o#node f t Ast.loc_of_ctyp in match t with [ <:ctyp< $t1$ as $t2$ >> -> pp f "@[<2>%a@ as@ %a@]" o#simple_ctyp t1 o#simple_ctyp t2 | <:ctyp< $t1$ -> $t2$ >> -> pp f "@[<2>%a@ ->@ %a@]" o#ctyp1 t1 o#ctyp t2 | <:ctyp< +'$s$ >> -> pp f "+'%a" o#var s | <:ctyp< -'$s$ >> -> pp f "-'%a" o#var s | <:ctyp< $t1$ | $t2$ >> -> pp f "%a@ | %a" o#ctyp t1 o#ctyp t2 | <:ctyp< $t1$ : mutable $t2$ >> -> pp f "@[mutable@ %a :@ %a@]" o#ctyp t1 o#ctyp t2 | <:ctyp< $t1$ : $t2$ >> -> pp f "@[<2>%a :@ %a@]" o#ctyp t1 o#ctyp t2 | <:ctyp< $t1$; $t2$ >> -> pp f "%a;@ %a" o#ctyp t1 o#ctyp t2 | <:ctyp< $t$ of $<:ctyp<>>$ >> -> o#ctyp f t | <:ctyp< $t1$ of $t2$ >> -> pp f "@[%a@ @[<3>of@ %a@]@]" o#ctyp t1 o#constructor_type t2 | <:ctyp< $t1$ of & $t2$ >> -> pp f "@[%a@ @[<3>of &@ %a@]@]" o#ctyp t1 o#constructor_type t2 | <:ctyp< $t1$ and $t2$ >> -> pp f "%a@ and %a" o#ctyp t1 o#ctyp t2 | <:ctyp< mutable $t$ >> -> pp f "@[<2>mutable@ %a@]" o#ctyp t | <:ctyp< $t1$ & $t2$ >> -> pp f "%a@ &@ %a" o#ctyp t1 o#ctyp t2 | <:ctyp< $t1$ == $t2$ >> -> pp f "@[<2>%a =@ %a@]" o#simple_ctyp t1 o#ctyp t2 | Ast.TyDcl _ tn tp te cl -> do { pp f "@[<2>%a%a@]" o#type_params tp o#var tn; match te with [ <:ctyp<>> -> () | _ -> pp f " =@ %a" o#ctyp te ]; if cl <> [] then pp f "@ %a" (list o#constrain "@ ") cl else (); } | Ast.TyExt _ tn tp te -> pp f "@[<2>%a%a@] =@ %a" o#type_params tp o#ident tn o#ctyp te | Ast.TyCom (loc, _, _) -> Loc.raise loc (Failure "this construction is not allowed here") | t -> o#ctyp1 f t ]; method ctyp1 f = fun [ <:ctyp< $t1$ $t2$ >> -> match get_ctyp_args t1 [t2] with [ (_, [_]) -> pp f "@[<2>%a@ %a@]" o#simple_ctyp t2 o#simple_ctyp t1 | (a, al) -> pp f "@[<2>(%a)@ %a@]" (list o#ctyp ",@ ") al o#simple_ctyp a ] | <:ctyp< ! $t1$ . $t2$ >> -> let (a, al) = get_ctyp_args t1 [] in pp f "@[<2>%a.@ %a@]" (list o#ctyp "@ ") [a::al] o#ctyp t2 | Ast.TyTypePol (_,t1,t2) -> let (a, al) = get_ctyp_args t1 [] in pp f "@[<2>type %a.@ %a@]" (list o#ctyp "@ ") [a::al] o#ctyp t2 | <:ctyp< private $t$ >> -> pp f "@[private@ %a@]" o#simple_ctyp t | t -> o#simple_ctyp f t ]; method constructor_type f t = match t with [ <:ctyp@loc< $t1$ and $t2$ >> -> let () = o#node f t (fun _ -> loc) in pp f "%a@ * %a" o#constructor_type t1 o#constructor_type t2 | <:ctyp< $_$ -> $_$ >> -> pp f "(%a)" o#ctyp t | t -> o#ctyp f t ]; method sig_item f sg = let () = o#node f sg Ast.loc_of_sig_item in match sg with [ <:sig_item<>> -> () | <:sig_item< $sg$; $<:sig_item<>>$ >> | <:sig_item< $<:sig_item<>>$; $sg$ >> -> o#sig_item f sg | <:sig_item< $sg1$; $sg2$ >> -> do { o#sig_item f sg1; cut f; o#sig_item f sg2 } | <:sig_item< exception $t$ >> -> pp f "@[<2>exception@ %a%(%)@]" o#ctyp t semisep | <:sig_item< external $s$ : $t$ = $sl$ >> -> pp f "@[<2>external@ %a :@ %a =@ %a%(%)@]" o#var s o#ctyp t (meta_list o#quoted_string "@ ") sl semisep | Ast.SgMod(_, name, Ast.MtAlias(_, id)) -> pp f "@[<2>module %a@ =@ %a@]" o#var name o#ident id | <:sig_item< module $s1$ ($s2$ : $mt1$) : $mt2$ >> -> let rec loop accu = fun [ <:module_type< functor ($s$ : $mt1$) -> $mt2$ >> -> loop [(s, mt1)::accu] mt2 | mt -> (List.rev accu, mt) ] in let (al, mt) = loop [(s2, mt1)] mt2 in pp f "@[<2>module %a@ @[<0>%a@] :@ %a%(%)@]" o#var s1 o#functor_args al o#module_type mt semisep | <:sig_item< module $s$ : $mt$ >> -> pp f "@[<2>module %a :@ %a%(%)@]" o#var s o#module_type mt semisep | <:sig_item< module type $s$ = $ <:module_type<>> $ >> -> pp f "@[<2>module type %a%(%)@]" o#var s semisep | <:sig_item< module type $s$ = $mt$ >> -> pp f "@[<2>module type %a =@ %a%(%)@]" o#var s o#module_type mt semisep | Ast.SgOpn _loc ov sl -> pp f "@[<2>open%a@ %a%(%)@]" o#override_flag ov o#ident sl semisep | Ast.SgTyp(_, rf, t) -> pp f "@[@[type%a %a@]%(%)@]" o#nonrec_flag rf o#ctyp t semisep | <:sig_item< value $s$ : $t$ >> -> pp f "@[<2>%s %a :@ %a%(%)@]" o#value_val o#var s o#ctyp t semisep | <:sig_item< include $mt$ >> -> pp f "@[<2>include@ %a%(%)@]" o#module_type mt semisep | <:sig_item< class type $ct$ >> -> pp f "@[<2>class type %a%(%)@]" o#class_type ct semisep | <:sig_item< class $ce$ >> -> pp f "@[<2>class %a%(%)@]" o#class_type ce semisep | <:sig_item< module rec $mb$ >> -> pp f "@[<2>module rec %a%(%)@]" o#module_rec_binding mb semisep | Ast.SgDir _ _ _ -> () | <:sig_item< $anti:s$ >> -> pp f "%a%(%)" o#anti s semisep ]; method str_item f st = let () = o#node f st Ast.loc_of_str_item in match st with [ <:str_item<>> -> () | <:str_item< $st$; $<:str_item<>>$ >> | <:str_item< $<:str_item<>>$; $st$ >> -> o#str_item f st | <:str_item< $st1$; $st2$ >> -> do { o#str_item f st1; cut f; o#str_item f st2 } | <:str_item< exception $t$ >> -> pp f "@[<2>exception@ %a%(%)@]" o#ctyp t semisep | <:str_item< exception $t$ = $sl$ >> -> pp f "@[<2>exception@ %a =@ %a%(%)@]" o#ctyp t o#ident sl semisep | <:str_item< external $s$ : $t$ = $sl$ >> -> pp f "@[<2>external@ %a :@ %a =@ %a%(%)@]" o#var s o#ctyp t (meta_list o#quoted_string "@ ") sl semisep | <:str_item< module $s1$ ($s2$ : $mt1$) = $me$ >> -> match o#module_expr_get_functor_args [(s2, mt1)] me with [ (al, me, Some mt2) -> pp f "@[<2>module %a@ @[<0>%a@] :@ %a =@ %a%(%)@]" o#var s1 o#functor_args al o#module_type mt2 o#module_expr me semisep | (al, me, _) -> pp f "@[<2>module %a@ @[<0>%a@] =@ %a%(%)@]" o#var s1 o#functor_args al o#module_expr me semisep ] | <:str_item< module $s$ : $mt$ = $me$ >> -> pp f "@[<2>module %a :@ %a =@ %a%(%)@]" o#var s o#module_type mt o#module_expr me semisep | <:str_item< module $s$ = $me$ >> -> pp f "@[<2>module %a =@ %a%(%)@]" o#var s o#module_expr me semisep | <:str_item< module type $s$ = $mt$ >> -> pp f "@[<2>module type %a =@ %a%(%)@]" o#var s o#module_type mt semisep | Ast.StOpn _loc ov sl -> (* | <:str_item< open $sl$ >> -> *) pp f "@[<2>open%a@ %a%(%)@]" o#override_flag ov o#ident sl semisep | Ast.StTyp(_, rf, t) -> pp f "@[@[type%a %a@]%(%)@]" o#nonrec_flag rf o#ctyp t semisep | <:str_item< value $rec:r$ $bi$ >> -> pp f "@[<2>%s %a%a%(%)@]" o#value_let o#rec_flag r o#binding bi semisep | <:str_item< $exp:e$ >> -> pp f "@[<2>let _ =@ %a%(%)@]" o#expr e semisep | <:str_item< include $me$ >> -> pp f "@[<2>include@ %a%(%)@]" o#simple_module_expr me semisep | <:str_item< class type $ct$ >> -> pp f "@[<2>class type %a%(%)@]" o#class_type ct semisep | <:str_item< class $ce$ >> -> pp f "@[class %a%(%)@]" o#class_declaration ce semisep | <:str_item< module rec $mb$ >> -> pp f "@[<2>module rec %a%(%)@]" o#module_rec_binding mb semisep | Ast.StDir _ _ _ -> () | <:str_item< $anti:s$ >> -> pp f "%a%(%)" o#anti s semisep | Ast.StExc _ _ (Ast.OAnt _) -> assert False ]; method module_type f mt = let () = o#node f mt Ast.loc_of_module_type in match mt with [ <:module_type<>> -> assert False | <:module_type< module type of $me$ >> -> pp f "@[<2>module type of@ %a@]" o#module_expr me | <:module_type< $id:i$ >> -> o#ident f i | <:module_type< $anti:s$ >> -> o#anti f s | Ast.MtFun(_, "*", Ast.MtNil _, mt) -> pp f "@[<2>functor@ ()@ ->@ %a@]" o#module_type mt | <:module_type< functor ( $s$ : $mt1$ ) -> $mt2$ >> -> pp f "@[<2>functor@ @[<1>(%a :@ %a)@]@ ->@ %a@]" o#var s o#module_type mt1 o#module_type mt2 | <:module_type< '$s$ >> -> pp f "'%a" o#var s | <:module_type< sig $sg$ end >> -> pp f "@[@[sig@ %a@]@ end@]" o#sig_item sg | Ast.MtAtt _loc s str e -> pp f "((%a)[@@%s %a])" o#module_type e s o#str_item str | <:module_type< $mt$ with $wc$ >> -> pp f "@[<2>%a@ with@ %a@]" o#module_type mt o#with_constraint wc | Ast.MtAlias(_, id) -> pp f "@[<2>(module@ %a@])" o#ident id ]; method with_constraint f wc = let () = o#node f wc Ast.loc_of_with_constr in match wc with [ <:with_constr<>> -> () | <:with_constr< type $t1$ = $t2$ >> -> pp f "@[<2>type@ %a =@ %a@]" o#ctyp t1 o#ctyp t2 | <:with_constr< module $i1$ = $i2$ >> -> pp f "@[<2>module@ %a =@ %a@]" o#ident i1 o#ident i2 | <:with_constr< type $t1$ := $t2$ >> -> pp f "@[<2>type@ %a :=@ %a@]" o#ctyp t1 o#ctyp t2 | <:with_constr< module $i1$ := $i2$ >> -> pp f "@[<2>module@ %a :=@ %a@]" o#ident i1 o#ident i2 | <:with_constr< $wc1$ and $wc2$ >> -> do { o#with_constraint f wc1; pp f o#andsep; o#with_constraint f wc2 } | <:with_constr< $anti:s$ >> -> o#anti f s ]; method module_expr f me = let () = o#node f me Ast.loc_of_module_expr in match me with [ <:module_expr<>> -> assert False | <:module_expr< ( struct $st$ end : sig $sg$ end ) >> -> pp f "@[<2>@[struct@ %a@]@ end :@ @[sig@ %a@]@ end@]" o#str_item st o#sig_item sg | _ -> o#simple_module_expr f me ]; method simple_module_expr f me = let () = o#node f me Ast.loc_of_module_expr in match me with [ <:module_expr<>> -> assert False | <:module_expr< $id:i$ >> -> o#ident f i | <:module_expr< $anti:s$ >> -> o#anti f s | <:module_expr< $me1$ $me2$ >> -> pp f "@[<2>%a@,(%a)@]" o#module_expr me1 o#module_expr me2 | Ast.MeFun(_, "*", Ast.MtNil _, me) -> pp f "@[<2>functor@ ()@ ->@ %a@]" o#module_expr me | <:module_expr< functor ( $s$ : $mt$ ) -> $me$ >> -> pp f "@[<2>functor@ @[<1>(%a :@ %a)@]@ ->@ %a@]" o#var s o#module_type mt o#module_expr me | <:module_expr< struct $st$ end >> -> pp f "@[@[struct@ %a@]@ end@]" o#str_item st | <:module_expr< ( $me$ : $mt$ ) >> -> pp f "@[<1>(%a :@ %a)@]" o#module_expr me o#module_type mt | <:module_expr< (value $e$ : $mt$ ) >> -> pp f "@[<1>(%s %a :@ %a)@]" o#value_val o#expr e o#module_type mt | <:module_expr< (value $e$ ) >> -> pp f "@[<1>(%s %a)@]" o#value_val o#expr e | Ast.MeAtt _loc s str e -> pp f "((%a)[@@%s %a])" o#module_expr e s o#str_item str ]; method class_expr f ce = let () = o#node f ce Ast.loc_of_class_expr in match ce with [ <:class_expr< $ce$ $e$ >> -> pp f "@[<2>%a@ %a@]" o#class_expr ce o#apply_expr e | <:class_expr< $id:i$ >> -> pp f "@[<2>%a@]" o#ident i | <:class_expr< $id:i$ [ $t$ ] >> -> pp f "@[<2>@[<1>[%a]@]@ %a@]" o#class_params t o#ident i | <:class_expr< virtual $lid:i$ >> -> pp f "@[<2>virtual@ %a@]" o#var i | <:class_expr< virtual $lid:i$ [ $t$ ] >> -> pp f "@[<2>virtual@ @[<1>[%a]@]@ %a@]" o#class_params t o#var i | <:class_expr< fun $p$ -> $ce$ >> -> pp f "@[<2>fun@ %a@ ->@ %a@]" o#simple_patt p o#class_expr ce | <:class_expr< let $rec:r$ $bi$ in $ce$ >> -> pp f "@[<2>let %a%a@]@ @[<2>in@ %a@]" o#rec_flag r o#binding bi o#class_expr ce | <:class_expr< object $cst$ end >> -> pp f "@[@[object %a@]@ end@]" o#class_str_item cst | <:class_expr< object ($p$) $cst$ end >> -> pp f "@[@[object @[<1>(%a)@]@ %a@]@ end@]" o#patt p o#class_str_item cst | <:class_expr< ( $ce$ : $ct$ ) >> -> pp f "@[<1>(%a :@ %a)@]" o#class_expr ce o#class_type ct | <:class_expr< $anti:s$ >> -> o#anti f s | <:class_expr< $ce1$ and $ce2$ >> -> do { o#class_expr f ce1; pp f o#andsep; o#class_expr f ce2 } | <:class_expr< $ce1$ = fun $p$ -> $ce2$ >> when is_irrefut_patt p -> pp f "@[<2>%a@ %a" o#class_expr ce1 o#patt_class_expr_fun_args (p, ce2) | <:class_expr< $ce1$ = $ce2$ >> -> pp f "@[<2>%a =@]@ %a" o#class_expr ce1 o#class_expr ce2 | Ast.CeAtt _loc s str e -> pp f "((%a)[@@%s %a])" o#class_expr e s o#str_item str | _ -> assert False ]; method class_type f ct = let () = o#node f ct Ast.loc_of_class_type in match ct with [ <:class_type< $id:i$ >> -> pp f "@[<2>%a@]" o#ident i | <:class_type< $id:i$ [ $t$ ] >> -> pp f "@[<2>[@,%a@]@,]@ %a" o#class_params t o#ident i | <:class_type< virtual $lid:i$ >> -> pp f "@[<2>virtual@ %a@]" o#var i | <:class_type< virtual $lid:i$ [ $t$ ] >> -> pp f "@[<2>virtual@ [@,%a@]@,]@ %a" o#class_params t o#var i | <:class_type< [ $t$ ] -> $ct$ >> -> pp f "@[<2>%a@ ->@ %a@]" o#simple_ctyp t o#class_type ct | <:class_type< object $csg$ end >> -> pp f "@[@[object@ %a@]@ end@]" o#class_sig_item csg | <:class_type< object ($t$) $csg$ end >> -> pp f "@[@[object @[<1>(%a)@]@ %a@]@ end@]" o#ctyp t o#class_sig_item csg | <:class_type< $anti:s$ >> -> o#anti f s | <:class_type< $ct1$ and $ct2$ >> -> do { o#class_type f ct1; pp f o#andsep; o#class_type f ct2 } | <:class_type< $ct1$ : $ct2$ >> -> pp f "%a :@ %a" o#class_type ct1 o#class_type ct2 | <:class_type< $ct1$ = $ct2$ >> -> pp f "%a =@ %a" o#class_type ct1 o#class_type ct2 | Ast.CtAtt _loc s str e -> pp f "((%a)[@@%s %a])" o#class_type e s o#str_item str | _ -> assert False ]; method class_sig_item f csg = let () = o#node f csg Ast.loc_of_class_sig_item in match csg with [ <:class_sig_item<>> -> () | <:class_sig_item< $csg$; $<:class_sig_item<>>$ >> | <:class_sig_item< $<:class_sig_item<>>$; $csg$ >> -> o#class_sig_item f csg | <:class_sig_item< $csg1$; $csg2$ >> -> do { o#class_sig_item f csg1; cut f; o#class_sig_item f csg2 } | <:class_sig_item< constraint $t1$ = $t2$ >> -> pp f "@[<2>constraint@ %a =@ %a%(%)@]" o#ctyp t1 o#ctyp t2 no_semisep | <:class_sig_item< inherit $ct$ >> -> pp f "@[<2>inherit@ %a%(%)@]" o#class_type ct no_semisep | <:class_sig_item< method $private:pr$ $s$ : $t$ >> -> pp f "@[<2>method %a%a :@ %a%(%)@]" o#private_flag pr o#var s o#ctyp t no_semisep | <:class_sig_item< method virtual $private:pr$ $s$ : $t$ >> -> pp f "@[<2>method virtual %a%a :@ %a%(%)@]" o#private_flag pr o#var s o#ctyp t no_semisep | <:class_sig_item< value $mutable:mu$ $virtual:vi$ $s$ : $t$ >> -> pp f "@[<2>%s %a%a%a :@ %a%(%)@]" o#value_val o#mutable_flag mu o#virtual_flag vi o#var s o#ctyp t no_semisep | <:class_sig_item< $anti:s$ >> -> pp f "%a%(%)" o#anti s no_semisep ]; method class_str_item f cst = let () = o#node f cst Ast.loc_of_class_str_item in match cst with [ <:class_str_item<>> -> () | <:class_str_item< $cst$; $<:class_str_item<>>$ >> | <:class_str_item< $<:class_str_item<>>$; $cst$ >> -> o#class_str_item f cst | <:class_str_item< $cst1$; $cst2$ >> -> do { o#class_str_item f cst1; cut f; o#class_str_item f cst2 } | <:class_str_item< constraint $t1$ = $t2$ >> -> pp f "@[<2>constraint %a =@ %a%(%)@]" o#ctyp t1 o#ctyp t2 no_semisep | <:class_str_item< inherit $override:ov$ $ce$ >> -> pp f "@[<2>inherit%a@ %a%(%)@]" o#override_flag ov o#class_expr ce no_semisep | <:class_str_item< inherit $override:ov$ $ce$ as $lid:s$ >> -> pp f "@[<2>inherit%a@ %a as@ %a%(%)@]" o#override_flag ov o#class_expr ce o#var s no_semisep | <:class_str_item< initializer $e$ >> -> pp f "@[<2>initializer@ %a%(%)@]" o#expr e no_semisep | <:class_str_item< method $override:ov$ $private:pr$ $s$ = $e$ >> -> pp f "@[<2>method%a %a%a =@ %a%(%)@]" o#override_flag ov o#private_flag pr o#var s o#expr e no_semisep | <:class_str_item< method $override:ov$ $private:pr$ $s$ : $t$ = $e$ >> -> pp f "@[<2>method%a %a%a :@ %a =@ %a%(%)@]" o#override_flag ov o#private_flag pr o#var s o#ctyp t o#expr e no_semisep | <:class_str_item< method virtual $private:pr$ $s$ : $t$ >> -> pp f "@[<2>method virtual@ %a%a :@ %a%(%)@]" o#private_flag pr o#var s o#ctyp t no_semisep | <:class_str_item< value virtual $mutable:mu$ $s$ : $t$ >> -> pp f "@[<2>%s virtual %a%a :@ %a%(%)@]" o#value_val o#mutable_flag mu o#var s o#ctyp t no_semisep | <:class_str_item< value $override:ov$ $mutable:mu$ $s$ = $e$ >> -> pp f "@[<2>%s%a %a%a =@ %a%(%)@]" o#value_val o#override_flag ov o#mutable_flag mu o#var s o#expr e no_semisep | <:class_str_item< $anti:s$ >> -> pp f "%a%(%)" o#anti s no_semisep ]; method implem f st = match st with [ <:str_item< $exp:e$ >> -> pp f "@[<0>%a%(%)@]@." o#expr e semisep | st -> pp f "@[%a@]@." o#str_item st ]; method interf f sg = pp f "@[%a@]@." o#sig_item sg; end; value with_outfile output_file fct arg = let call close f = do { try fct f arg with [ exn -> do { close (); raise exn } ]; close () } in match output_file with [ None -> call (fun () -> ()) std_formatter | Some s -> let oc = open_out s in let f = formatter_of_out_channel oc in call (fun () -> close_out oc) f ]; value print output_file fct = let o = new printer () in with_outfile output_file (fct o); value print_interf ?input_file:(_) ?output_file sg = print output_file (fun o -> o#interf) sg; value print_implem ?input_file:(_) ?output_file st = print output_file (fun o -> o#implem) st; end; module MakeMore (Syntax : Sig.Camlp4Syntax) : (Sig.Printer Syntax.Ast).S = struct include Make Syntax; value semisep : ref sep = ref ("@\n" : sep); value margin = ref 78; value comments = ref True; value locations = ref False; value curry_constr = ref False; value print output_file fct = let o = new printer ~comments:comments.val ~curry_constr:curry_constr.val () in let o = o#set_semisep semisep.val in let o = if locations.val then o#set_loc_and_comments else o in with_outfile output_file (fun f -> let () = Format.pp_set_margin f margin.val in Format.fprintf f "@[%a@]@." (fct o)); value print_interf ?input_file:(_) ?output_file sg = print output_file (fun o -> o#interf) sg; value print_implem ?input_file:(_) ?output_file st = print output_file (fun o -> o#implem) st; value check_sep s = if String.contains s '%' then failwith "-sep Format error, % found in string" else (Obj.magic (Struct.Token.Eval.string s : string) : sep); Options.add "-l" (Arg.Int (fun i -> margin.val := i)) " line length for pretty printing."; Options.add "-ss" (Arg.Unit (fun () -> semisep.val := ";;")) " Print double semicolons."; Options.add "-no_ss" (Arg.Unit (fun () -> semisep.val := "")) " Do not print double semicolons (default)."; Options.add "-sep" (Arg.String (fun s -> semisep.val := check_sep s)) " Use this string between phrases."; Options.add "-curry-constr" (Arg.Set curry_constr) "Use currified constructors."; Options.add "-no_comments" (Arg.Clear comments) "Do not add comments."; Options.add "-add_locations" (Arg.Set locations) "Add locations as comment."; end; camlp4-5.3-1/camlp4/Camlp4/Printers/OCaml.mli000066400000000000000000000163501473134377200205230ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Nicolas Pouillard: initial version *) module Id : Sig.Id; module Make (Syntax : Sig.Camlp4Syntax) : sig open Format; include Sig.Camlp4Syntax with module Loc = Syntax.Loc and module Token = Syntax.Token and module Ast = Syntax.Ast and module Gram = Syntax.Gram; type sep = format unit formatter unit; type fun_binding = [= `patt of Ast.patt | `newtype of string ]; value list' : (formatter -> 'a -> unit) -> format 'b formatter unit -> format unit formatter unit -> formatter -> list 'a -> unit; value list : (formatter -> 'a -> unit) -> format 'b formatter unit -> formatter -> list 'a -> unit; value lex_string : string -> Token.t; value is_infix : string -> bool; value is_keyword : string -> bool; value ocaml_char : string -> string; value get_expr_args : Ast.expr -> list Ast.expr -> (Ast.expr * list Ast.expr); value get_patt_args : Ast.patt -> list Ast.patt -> (Ast.patt * list Ast.patt); value get_ctyp_args : Ast.ctyp -> list Ast.ctyp -> (Ast.ctyp * list Ast.ctyp); value expr_fun_args : Ast.expr -> (list fun_binding * Ast.expr); (** [new printer ~curry_constr:True ~comments:False] Default values: curry_constr = False comments = True *) class printer : [?curry_constr: bool] -> [?comments: bool] -> [unit] -> object ('a) method interf : formatter -> Ast.sig_item -> unit; method implem : formatter -> Ast.str_item -> unit; method sig_item : formatter -> Ast.sig_item -> unit; method str_item : formatter -> Ast.str_item -> unit; value pipe : bool; value semi : bool; value semisep : sep; value no_semisep : sep; method value_val : string; method value_let : string; method andsep : sep; method anti : formatter -> string -> unit; method class_declaration : formatter -> Ast.class_expr -> unit; method class_expr : formatter -> Ast.class_expr -> unit; method class_sig_item : formatter -> Ast.class_sig_item -> unit; method class_str_item : formatter -> Ast.class_str_item -> unit; method class_type : formatter -> Ast.class_type -> unit; method constrain : formatter -> (Ast.ctyp * Ast.ctyp) -> unit; method ctyp : formatter -> Ast.ctyp -> unit; method ctyp1 : formatter -> Ast.ctyp -> unit; method constructor_type : formatter -> Ast.ctyp -> unit; method dot_expr : formatter -> Ast.expr -> unit; method apply_expr : formatter -> Ast.expr -> unit; method expr : formatter -> Ast.expr -> unit; method expr_list : formatter -> list Ast.expr -> unit; method expr_list_cons : bool -> formatter -> Ast.expr -> unit; method fun_binding : formatter -> fun_binding -> unit; method functor_arg_var : formatter -> string -> unit; method functor_arg : formatter -> (string * Ast.module_type) -> unit; method functor_args : formatter -> list (string * Ast.module_type) -> unit; method ident : formatter -> Ast.ident -> unit; method numeric : formatter -> string -> string -> unit; method binding : formatter -> Ast.binding -> unit; method record_binding : formatter -> Ast.rec_binding -> unit; method match_case : formatter -> Ast.match_case -> unit; method match_case_aux : formatter -> Ast.match_case -> unit; method mk_expr_list : Ast.expr -> (list Ast.expr * option Ast.expr); method mk_patt_list : Ast.patt -> (list Ast.patt * option Ast.patt); method simple_module_expr : formatter -> Ast.module_expr -> unit; method module_expr : formatter -> Ast.module_expr -> unit; method module_expr_get_functor_args : list (string * Ast.module_type) -> Ast.module_expr -> (list (string * Ast.module_type) * Ast.module_expr * option Ast.module_type); method module_rec_binding : formatter -> Ast.module_binding -> unit; method module_type : formatter -> Ast.module_type -> unit; method override_flag : formatter -> Ast.override_flag -> unit; method mutable_flag : formatter -> Ast.mutable_flag -> unit; method direction_flag : formatter -> Ast.direction_flag -> unit; method rec_flag : formatter -> Ast.rec_flag -> unit; method nonrec_flag : formatter -> Ast.rec_flag -> unit; method node : formatter -> 'b -> ('b -> Loc.t) -> unit; method patt : formatter -> Ast.patt -> unit; method patt1 : formatter -> Ast.patt -> unit; method patt2 : formatter -> Ast.patt -> unit; method patt3 : formatter -> Ast.patt -> unit; method patt4 : formatter -> Ast.patt -> unit; method patt5 : formatter -> Ast.patt -> unit; method patt_tycon : formatter -> Ast.patt -> unit; method patt_expr_fun_args : formatter -> (fun_binding * Ast.expr) -> unit; method patt_class_expr_fun_args : formatter -> (Ast.patt * Ast.class_expr) -> unit; method print_comments_before : Loc.t -> formatter -> unit; method private_flag : formatter -> Ast.private_flag -> unit; method virtual_flag : formatter -> Ast.virtual_flag -> unit; method quoted_string : formatter -> string -> unit; method raise_match_failure : formatter -> Loc.t -> unit; method reset : 'a; method reset_semi : 'a; method semisep : sep; method set_comments : bool -> 'a; method set_curry_constr : bool -> 'a; method set_loc_and_comments : 'a; method set_semisep : sep -> 'a; method simple_ctyp : formatter -> Ast.ctyp -> unit; method simple_expr : formatter -> Ast.expr -> unit; method simple_patt : formatter -> Ast.patt -> unit; method seq : formatter -> Ast.expr -> unit; method string : formatter -> string -> unit; method sum_type : formatter -> Ast.ctyp -> unit; method type_params : formatter -> list Ast.ctyp -> unit; method class_params : formatter -> Ast.ctyp -> unit; method under_pipe : 'a; method under_semi : 'a; method var : formatter -> string -> unit; method with_constraint : formatter -> Ast.with_constr -> unit; end; value with_outfile : option string -> (formatter -> 'a -> unit) -> 'a -> unit; value print : option string -> (printer -> formatter -> 'a -> unit) -> 'a -> unit; end; module MakeMore (Syntax : Sig.Camlp4Syntax) : (Sig.Printer Syntax.Ast).S; camlp4-5.3-1/camlp4/Camlp4/Printers/OCamlr.ml000066400000000000000000000264721473134377200205420ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Nicolas Pouillard: initial version *) open Format; module Id = struct value name = "Camlp4.Printers.OCamlr"; value version = Sys.ocaml_version; end; module Make (Syntax : Sig.Camlp4Syntax) = struct include Syntax; open Sig; module PP_o = OCaml.Make Syntax; open PP_o; value pp = fprintf; value is_keyword = let keywords = ["where"] and not_keywords = ["false"; "function"; "true"; "val"] in fun s -> not (List.mem s not_keywords) && (is_keyword s || List.mem s keywords); class printer ?curry_constr:(init_curry_constr = True) ?(comments = True) () = object (o) inherit PP_o.printer ~curry_constr:init_curry_constr ~comments () as super; value! semisep : sep = ";"; value! no_semisep : sep = ";"; value mode = if comments then `comments else `no_comments; value curry_constr = init_curry_constr; value first_match_case = True; method andsep : sep = "@]@ @[<2>and@ "; method value_val = "value"; method value_let = "value"; method under_pipe = o; method under_semi = o; method reset_semi = o; method reset = o; method private unset_first_match_case = {< first_match_case = False >}; method private set_first_match_case = {< first_match_case = True >}; method seq f e = let rec self right f e = let go_right = self right and go_left = self False in match e with [ <:expr< let $rec:r$ $bi$ in $e1$ >> -> if right then pp f "@[<2>let %a%a@];@ %a" o#rec_flag r o#binding bi go_right e1 else pp f "(%a)" o#expr e | <:expr< do { $e$ } >> -> go_right f e | <:expr< $e1$; $e2$ >> -> do { pp f "%a;@ " go_left e1; match (right, e2) with [ (True, <:expr< let $rec:r$ $bi$ in $e3$ >>) -> pp f "@[<2>let %a%a@];@ %a" o#rec_flag r o#binding bi go_right e3 | _ -> go_right f e2 ] } | e -> o#expr f e ] in self True f e; method var f = fun [ "" -> pp f "$lid:\"\"$" | "[]" -> pp f "[]" | "()" -> pp f "()" | " True" -> pp f "True" | " False" -> pp f "False" | v -> match lex_string v with [ (LIDENT s | UIDENT s | ESCAPED_IDENT s) when is_keyword s -> pp f "%s__" s | SYMBOL s -> pp f "( %s )" s | LIDENT s | UIDENT s | ESCAPED_IDENT s -> pp_print_string f s | tok -> failwith (sprintf "Bad token used as an identifier: %s" (Token.to_string tok)) ] ]; method type_params f = fun [ [] -> () | [x] -> pp f "@ %a" o#ctyp x | l -> pp f "@ @[<1>%a@]" (list o#ctyp "@ ") l ]; method match_case f = fun [ <:match_case<>> -> pp f "@ []" | m -> pp f "@ [ %a ]" o#set_first_match_case#match_case_aux m ]; method match_case_aux f = fun [ <:match_case<>> -> () | <:match_case< $anti:s$ >> -> o#anti f s | <:match_case< $a1$ | $a2$ >> -> pp f "%a%a" o#match_case_aux a1 o#unset_first_match_case#match_case_aux a2 | <:match_case< $p$ -> $e$ >> -> let () = if first_match_case then () else pp f "@ | " in pp f "@[<2>%a@ ->@ %a@]" o#patt p o#under_pipe#expr e | <:match_case< $p$ when $w$ -> $e$ >> -> let () = if first_match_case then () else pp f "@ | " in pp f "@[<2>%a@ when@ %a@ ->@ %a@]" o#patt p o#under_pipe#expr w o#under_pipe#expr e ]; method sum_type f = fun [ <:ctyp<>> -> pp f "[]" | t -> pp f "@[[ %a ]@]" o#ctyp t ]; method ident f i = let () = o#node f i Ast.loc_of_ident in match i with [ <:ident< $i1$ $i2$ >> -> pp f "%a@ %a" o#dot_ident i1 o#dot_ident i2 | i -> o#dot_ident f i ]; method private dot_ident f i = let () = o#node f i Ast.loc_of_ident in match i with [ <:ident< $i1$.$i2$ >> -> pp f "%a.@,%a" o#dot_ident i1 o#dot_ident i2 | <:ident< $anti:s$ >> -> o#anti f s | <:ident< $lid:s$ >> | <:ident< $uid:s$ >> -> o#var f s | i -> pp f "(%a)" o#ident i ]; method patt4 f = fun [ <:patt< [$_$ :: $_$] >> as p -> let (pl, c) = o#mk_patt_list p in match c with [ None -> pp f "@[<2>[@ %a@]@ ]" (list o#patt ";@ ") pl | Some x -> pp f "@[<2>[ %a ::@ %a ]@]" (list o#patt ";@ ") pl o#patt x ] | p -> super#patt4 f p ]; method expr_list_cons _ f e = let (el, c) = o#mk_expr_list e in match c with [ None -> o#expr_list f el | Some x -> pp f "@[<2>[ %a ::@ %a ]@]" (list o#expr ";@ ") el o#expr x ]; method expr f e = let () = o#node f e Ast.loc_of_expr in match e with [ <:expr< $e1$ := $e2$ >> -> pp f "@[<2>%a@ :=@ %a@]" o#dot_expr e1 o#expr e2 | <:expr< fun $p$ -> $e$ >> when Ast.is_irrefut_patt p -> pp f "@[<2>fun@ %a@]" o#patt_expr_fun_args (`patt p, e) | <:expr< fun (type $i$) -> $e$ >> -> pp f "@[<2>fun@ %a@]" o#patt_expr_fun_args (`newtype i, e) | <:expr< fun [ $a$ ] >> -> pp f "@[fun%a@]" o#match_case a | <:expr< assert False >> -> pp f "@[<2>assert@ False@]" | e -> super#expr f e ]; method dot_expr f e = let () = o#node f e Ast.loc_of_expr in match e with [ <:expr< $e$.val >> -> pp f "@[<2>%a.@,val@]" o#simple_expr e | e -> super#dot_expr f e ]; method ctyp f t = let () = o#node f t Ast.loc_of_ctyp in match t with [ Ast.TyDcl _ tn tp te cl -> do { pp f "@[<2>%a%a@]" o#var tn o#type_params tp; match te with [ <:ctyp<>> -> () | _ -> pp f " =@ %a" o#ctyp te ]; if cl <> [] then pp f "@ %a" (list o#constrain "@ ") cl else (); } | <:ctyp< $t1$ : mutable $t2$ >> -> pp f "@[%a :@ mutable %a@]" o#ctyp t1 o#ctyp t2 | <:ctyp< $t1$ == $t2$ >> -> pp f "@[<2>%a ==@ %a@]" o#simple_ctyp t1 o#ctyp t2 | t -> super#ctyp f t ]; method simple_ctyp f t = let () = o#node f t Ast.loc_of_ctyp in match t with [ <:ctyp< [ = $t$ ] >> -> pp f "@[<2>[ =@ %a@]@ ]" o#ctyp t | <:ctyp< [ < $t$ ] >> -> pp f "@[<2>[ <@ %a@]@,]" o#ctyp t | <:ctyp< [ < $t1$ > $t2$ ] >> -> pp f "@[<2>[ <@ %a@ >@ %a@]@ ]" o#ctyp t1 o#ctyp t2 | <:ctyp< [ > $t$ ] >> -> pp f "@[<2>[ >@ %a@]@,]" o#ctyp t | <:ctyp< $t1$ == $t2$ >> -> pp f "@[<2>%a@ ==@ %a@]" o#simple_ctyp t1 o#simple_ctyp t2 | <:ctyp< ~ $s$ : $t$ >> -> pp f "@[<2>~%s:@ %a@]" s o#simple_ctyp t | t -> super#simple_ctyp f t ]; method ctyp1 f = fun [ <:ctyp< $t1$ $t2$ >> -> match get_ctyp_args t1 [t2] with [ (_, [_]) -> pp f "@[<2>%a@ %a@]" o#simple_ctyp t1 o#simple_ctyp t2 | (a, al) -> pp f "@[<2>%a@]" (list o#simple_ctyp "@ ") [a::al] ] | <:ctyp< ! $t1$ . $t2$ >> -> let (a, al) = get_ctyp_args t1 [] in pp f "@[<2>! %a.@ %a@]" (list o#ctyp "@ ") [a::al] o#ctyp t2 | t -> super#ctyp1 f t ]; method constructor_type f t = match t with [ <:ctyp@loc< $t1$ and $t2$ >> -> let () = o#node f t (fun _ -> loc) in pp f "%a@ and %a" o#constructor_type t1 o#constructor_type t2 | t -> o#ctyp f t ]; method str_item f st = match st with [ <:str_item< $exp:e$ >> -> pp f "@[<2>%a%(%)@]" o#expr e semisep | st -> super#str_item f st ]; method module_expr f me = let () = o#node f me Ast.loc_of_module_expr in match me with [ <:module_expr< $me1$ $me2$ >> -> pp f "@[<2>%a@ %a@]" o#module_expr me1 o#simple_module_expr me2 | me -> super#module_expr f me ]; method simple_module_expr f me = let () = o#node f me Ast.loc_of_module_expr in match me with [ <:module_expr< $_$ $_$ >> -> pp f "(%a)" o#module_expr me | _ -> super#simple_module_expr f me ]; method implem f st = pp f "@[%a@]@." o#str_item st; method class_type f ct = let () = o#node f ct Ast.loc_of_class_type in match ct with [ <:class_type< [ $t$ ] -> $ct$ >> -> pp f "@[<2>[ %a ] ->@ %a@]" o#simple_ctyp t o#class_type ct | <:class_type< $id:i$ >> -> pp f "@[<2>%a@]" o#ident i | <:class_type< $id:i$ [ $t$ ] >> -> pp f "@[<2>%a [@,%a@]@,]" o#ident i o#class_params t | <:class_type< virtual $lid:i$ >> -> pp f "@[<2>virtual@ %a@]" o#var i | <:class_type< virtual $lid:i$ [ $t$ ] >> -> pp f "@[<2>virtual@ %a@ [@,%a@]@,]" o#var i o#class_params t | ct -> super#class_type f ct ]; method class_expr f ce = let () = o#node f ce Ast.loc_of_class_expr in match ce with [ <:class_expr< $id:i$ >> -> pp f "@[<2>%a@]" o#ident i | <:class_expr< $id:i$ [ $t$ ] >> -> pp f "@[<2>%a@ @[<1>[%a]@]@]" o#ident i o#class_params t | <:class_expr< virtual $lid:i$ >> -> pp f "@[<2>virtual@ %a@]" o#var i | <:class_expr< virtual $lid:i$ [ $t$ ] >> -> pp f "@[<2>virtual@ %a@ @[<1>[%a]@]@]" o#var i o#class_params t | ce -> super#class_expr f ce ]; end; value with_outfile = with_outfile; value print output_file fct = let o = new printer () in with_outfile output_file (fct o); value print_interf ?input_file:(_) ?output_file sg = print output_file (fun o -> o#interf) sg; value print_implem ?input_file:(_) ?output_file st = print output_file (fun o -> o#implem) st; end; module MakeMore (Syntax : Sig.Camlp4Syntax) : (Sig.Printer Syntax.Ast).S = struct include Make Syntax; value margin = ref 78; value comments = ref True; value locations = ref False; value curry_constr = ref True; value print output_file fct = let o = new printer ~comments:comments.val ~curry_constr:curry_constr.val () in let o = if locations.val then o#set_loc_and_comments else o in with_outfile output_file (fun f -> let () = Format.pp_set_margin f margin.val in Format.fprintf f "@[%a@]@." (fct o)); value print_interf ?input_file:(_) ?output_file sg = print output_file (fun o -> o#interf) sg; value print_implem ?input_file:(_) ?output_file st = print output_file (fun o -> o#implem) st; Options.add "-l" (Arg.Int (fun i -> margin.val := i)) " line length for pretty printing."; Options.add "-no_comments" (Arg.Clear comments) "Do not add comments."; Options.add "-add_locations" (Arg.Set locations) "Add locations as comment."; end; camlp4-5.3-1/camlp4/Camlp4/Printers/OCamlr.mli000066400000000000000000000035651473134377200207110ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Nicolas Pouillard: initial version *) module Id : Sig.Id; module Make (Syntax : Sig.Camlp4Syntax) : sig open Format; include Sig.Camlp4Syntax with module Loc = Syntax.Loc and module Token = Syntax.Token and module Ast = Syntax.Ast and module Gram = Syntax.Gram; (** [new printer ~curry_constr:c ~comments:False] Default values: curry_constr = True comments = True *) class printer : [?curry_constr: bool] -> [?comments: bool] -> [unit] -> object ('a) inherit (OCaml.Make Syntax).printer; end; value with_outfile : option string -> (formatter -> 'a -> unit) -> 'a -> unit; value print : option string -> (printer -> formatter -> 'a -> unit) -> 'a -> unit; end; module MakeMore (Syntax : Sig.Camlp4Syntax) : (Sig.Printer Syntax.Ast).S; camlp4-5.3-1/camlp4/Camlp4/Register.ml000066400000000000000000000142661473134377200173410ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) module PP = Printers; open PreCast; type parser_fun 'a = ?directive_handler:('a -> option 'a) -> PreCast.Loc.t -> Stream.t char -> 'a; type printer_fun 'a = ?input_file:string -> ?output_file:string -> 'a -> unit; value sig_item_parser = ref (fun ?directive_handler:(_) _ _ -> failwith "No interface parser"); value str_item_parser = ref (fun ?directive_handler:(_) _ _ -> failwith "No implementation parser"); value sig_item_printer = ref (fun ?input_file:(_) ?output_file:(_) _ -> failwith "No interface printer"); value str_item_printer = ref (fun ?input_file:(_) ?output_file:(_) _ -> failwith "No implementation printer"); value callbacks = Queue.create (); value loaded_modules = ref []; value iter_and_take_callbacks f = let rec loop () = loop (f (Queue.take callbacks)) in try loop () with [ Queue.Empty -> () ]; value declare_dyn_module m f = begin (* let () = Format.eprintf "declare_dyn_module: %s@." m in *) loaded_modules.val := [ m :: loaded_modules.val ]; Queue.add (m, f) callbacks; end; value register_str_item_parser f = str_item_parser.val := f; value register_sig_item_parser f = sig_item_parser.val := f; value register_parser f g = do { str_item_parser.val := f; sig_item_parser.val := g }; value current_parser () = (str_item_parser.val, sig_item_parser.val); value register_str_item_printer f = str_item_printer.val := f; value register_sig_item_printer f = sig_item_printer.val := f; value register_printer f g = do { str_item_printer.val := f; sig_item_printer.val := g }; value current_printer () = (str_item_printer.val, sig_item_printer.val); module Plugin (Id : Sig.Id) (Maker : functor (Unit : sig end) -> sig end) = struct declare_dyn_module Id.name (fun _ -> let module M = Maker (struct end) in ()); end; module SyntaxExtension (Id : Sig.Id) (Maker : Sig.SyntaxExtension) = struct declare_dyn_module Id.name (fun _ -> let module M = Maker Syntax in ()); end; module OCamlSyntaxExtension (Id : Sig.Id) (Maker : functor (Syn : Sig.Camlp4Syntax) -> Sig.Camlp4Syntax) = struct declare_dyn_module Id.name (fun _ -> let module M = Maker Syntax in ()); end; module SyntaxPlugin (Id : Sig.Id) (Maker : functor (Syn : Sig.Syntax) -> sig end) = struct declare_dyn_module Id.name (fun _ -> let module M = Maker Syntax in ()); end; module Printer (Id : Sig.Id) (Maker : functor (Syn : Sig.Syntax) -> (Sig.Printer Syn.Ast).S) = struct declare_dyn_module Id.name (fun _ -> let module M = Maker Syntax in register_printer M.print_implem M.print_interf); end; module OCamlPrinter (Id : Sig.Id) (Maker : functor (Syn : Sig.Camlp4Syntax) -> (Sig.Printer Syn.Ast).S) = struct declare_dyn_module Id.name (fun _ -> let module M = Maker Syntax in register_printer M.print_implem M.print_interf); end; module OCamlPreCastPrinter (Id : Sig.Id) (P : (Sig.Printer PreCast.Ast).S) = struct declare_dyn_module Id.name (fun _ -> register_printer P.print_implem P.print_interf); end; module Parser (Id : Sig.Id) (Maker : functor (Ast : Sig.Ast) -> (Sig.Parser Ast).S) = struct declare_dyn_module Id.name (fun _ -> let module M = Maker PreCast.Ast in register_parser M.parse_implem M.parse_interf); end; module OCamlParser (Id : Sig.Id) (Maker : functor (Ast : Sig.Camlp4Ast) -> (Sig.Parser Ast).S) = struct declare_dyn_module Id.name (fun _ -> let module M = Maker PreCast.Ast in register_parser M.parse_implem M.parse_interf); end; module OCamlPreCastParser (Id : Sig.Id) (P : (Sig.Parser PreCast.Ast).S) = struct declare_dyn_module Id.name (fun _ -> register_parser P.parse_implem P.parse_interf); end; module AstFilter (Id : Sig.Id) (Maker : functor (F : Sig.AstFilters) -> sig end) = struct declare_dyn_module Id.name (fun _ -> let module M = Maker AstFilters in ()); end; sig_item_parser.val := Syntax.parse_interf; str_item_parser.val := Syntax.parse_implem; module CurrentParser = struct module Ast = Ast; value parse_interf ?directive_handler loc strm = sig_item_parser.val ?directive_handler loc strm; value parse_implem ?directive_handler loc strm = str_item_parser.val ?directive_handler loc strm; end; module CurrentPrinter = struct module Ast = Ast; value print_interf ?input_file ?output_file ast = sig_item_printer.val ?input_file ?output_file ast; value print_implem ?input_file ?output_file ast = str_item_printer.val ?input_file ?output_file ast; end; value enable_ocaml_printer () = let module M = OCamlPrinter PP.OCaml.Id PP.OCaml.MakeMore in (); value enable_ocamlr_printer () = let module M = OCamlPrinter PP.OCamlr.Id PP.OCamlr.MakeMore in (); (* value enable_ocamlrr_printer () = let module M = OCamlPrinter PP.OCamlrr.Id PP.OCamlrr.MakeMore in (); *) value enable_dump_ocaml_ast_printer () = let module M = OCamlPrinter PP.DumpOCamlAst.Id PP.DumpOCamlAst.Make in (); value enable_dump_camlp4_ast_printer () = let module M = Printer PP.DumpCamlp4Ast.Id PP.DumpCamlp4Ast.Make in (); value enable_null_printer () = let module M = Printer PP.Null.Id PP.Null.Make in (); camlp4-5.3-1/camlp4/Camlp4/Register.mli000066400000000000000000000073751473134377200175150ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) module Plugin (Id : Sig.Id) (Plugin : functor (Unit : sig end) -> sig end) : sig end; module SyntaxPlugin (Id : Sig.Id) (SyntaxPlugin : functor (Syn : Sig.Syntax) -> sig end) : sig end; module SyntaxExtension (Id : Sig.Id) (SyntaxExtension : Sig.SyntaxExtension) : sig end; module OCamlSyntaxExtension (Id : Sig.Id) (SyntaxExtension : functor (Syntax : Sig.Camlp4Syntax) -> Sig.Camlp4Syntax) : sig end; (** {6 Registering Parsers} *) type parser_fun 'a = ?directive_handler:('a -> option 'a) -> PreCast.Loc.t -> Stream.t char -> 'a; value register_str_item_parser : parser_fun PreCast.Ast.str_item -> unit; value register_sig_item_parser : parser_fun PreCast.Ast.sig_item -> unit; value register_parser : parser_fun PreCast.Ast.str_item -> parser_fun PreCast.Ast.sig_item -> unit; value current_parser : unit -> (parser_fun PreCast.Ast.str_item * parser_fun PreCast.Ast.sig_item); module Parser (Id : Sig.Id) (Maker : functor (Ast : Sig.Ast) -> (Sig.Parser Ast).S) : sig end; module OCamlParser (Id : Sig.Id) (Maker : functor (Ast : Sig.Camlp4Ast) -> (Sig.Parser Ast).S) : sig end; module OCamlPreCastParser (Id : Sig.Id) (Parser : (Sig.Parser PreCast.Ast).S) : sig end; (** {6 Registering Printers} *) type printer_fun 'a = ?input_file:string -> ?output_file:string -> 'a -> unit; value register_str_item_printer : printer_fun PreCast.Ast.str_item -> unit; value register_sig_item_printer : printer_fun PreCast.Ast.sig_item -> unit; value register_printer : printer_fun PreCast.Ast.str_item -> printer_fun PreCast.Ast.sig_item -> unit; value current_printer : unit -> (printer_fun PreCast.Ast.str_item * printer_fun PreCast.Ast.sig_item); module Printer (Id : Sig.Id) (Maker : functor (Syn : Sig.Syntax) -> (Sig.Printer Syn.Ast).S) : sig end; module OCamlPrinter (Id : Sig.Id) (Maker : functor (Syn : Sig.Camlp4Syntax) -> (Sig.Printer Syn.Ast).S) : sig end; module OCamlPreCastPrinter (Id : Sig.Id) (Printer : (Sig.Printer PreCast.Ast).S) : sig end; (** {6 Registering Filters} *) module AstFilter (Id : Sig.Id) (Maker : functor (F : Sig.AstFilters) -> sig end) : sig end; value declare_dyn_module : string -> (unit -> unit) -> unit; value iter_and_take_callbacks : ((string * (unit -> unit)) -> unit) -> unit; value loaded_modules : ref (list string); module CurrentParser : (Sig.Parser PreCast.Ast).S; module CurrentPrinter : (Sig.Printer PreCast.Ast).S; value enable_ocaml_printer : unit -> unit; value enable_ocamlr_printer : unit -> unit; (* value enable_ocamlrr_printer : unit -> unit; *) value enable_null_printer : unit -> unit; value enable_dump_ocaml_ast_printer : unit -> unit; value enable_dump_camlp4_ast_printer : unit -> unit; camlp4-5.3-1/camlp4/Camlp4/Sig.ml000066400000000000000000001611301473134377200162700ustar00rootroot00000000000000(* camlp4r *) (****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) (** Camlp4 signature repository *) (** {6 Basic signatures} *) (** Signature with just a type. *) module type Type = sig type t; end; (** Signature for errors modules, an Error modules can be registred with the {!ErrorHandler.Register} functor in order to be well printed. *) module type Error = sig type t; exception E of t; value to_string : t -> string; value print : Format.formatter -> t -> unit; end; (** A signature for extensions identifiers. *) module type Id = sig (** The name of the extension, typically the module name. *) value name : string; (** The version of the extension, typically $ Id$ with a versionning system. *) value version : string; end; (** A signature for warnings abstract from locations. *) module Warning (Loc : Type) = struct module type S = sig type warning = Loc.t -> string -> unit; value default_warning : warning; value current_warning : ref warning; value print_warning : warning; end; end; (** {6 Advanced signatures} *) (** A signature for locations. *) module type Loc = sig (** The type of locations. Note that, as for OCaml locations, character numbers in locations refer to character numbers in the parsed character stream, while line numbers refer to line numbers in the source file. The source file and the parsed character stream differ, for instance, when the parsed character stream contains a line number directive. The line number directive will only update the file-name field and the line-number field of the position. It makes therefore no sense to use character numbers with the source file if the sources contain line number directives. *) type t; (** Return a start location for the given file name. This location starts at the begining of the file. *) value mk : string -> t; (** The [ghost] location can be used when no location information is available. *) value ghost : t; (** {6 Conversion functions} *) (** Return a location where both positions are set the given position. *) value of_lexing_position : Lexing.position -> t; (** Return an OCaml location. *) value to_ocaml_location : t -> Location.t; (** Return a location from an OCaml location. *) value of_ocaml_location : Location.t -> t; (** Return a location from ocamllex buffer. *) value of_lexbuf : Lexing.lexbuf -> t; (** Return a location from [(file_name, start_line, start_bol, start_off, stop_line, stop_bol, stop_off, ghost)]. *) value of_tuple : (string * int * int * int * int * int * int * bool) -> t; (** Return [(file_name, start_line, start_bol, start_off, stop_line, stop_bol, stop_off, ghost)]. *) value to_tuple : t -> (string * int * int * int * int * int * int * bool); (** [merge loc1 loc2] Return a location that starts at [loc1] and end at [loc2]. *) value merge : t -> t -> t; (** The stop pos becomes equal to the start pos. *) value join : t -> t; (** [move selector n loc] Return the location where positions are moved. Affected positions are chosen with [selector]. Returned positions have their character offset plus [n]. *) value move : [= `start | `stop | `both ] -> int -> t -> t; (** [shift n loc] Return the location where the new start position is the old stop position, and where the new stop position character offset is the old one plus [n]. *) value shift : int -> t -> t; (** [move_line n loc] Return the location with the old line count plus [n]. The "begin of line" of both positions become the current offset. *) value move_line : int -> t -> t; (** {6 Accessors} *) (** Return the file name *) value file_name : t -> string; (** Return the line number of the begining of this location. *) value start_line : t -> int; (** Return the line number of the ending of this location. *) value stop_line : t -> int; (** Returns the number of characters from the begining of the stream to the begining of the line of location's begining. *) value start_bol : t -> int; (** Returns the number of characters from the begining of the stream to the begining of the line of location's ending. *) value stop_bol : t -> int; (** Returns the number of characters from the begining of the stream of the begining of this location. *) value start_off : t -> int; (** Return the number of characters from the begining of the stream of the ending of this location. *) value stop_off : t -> int; (** Return the start position as a Lexing.position. *) value start_pos : t -> Lexing.position; (** Return the stop position as a Lexing.position. *) value stop_pos : t -> Lexing.position; (** Generally, return true if this location does not come from an input stream. *) value is_ghost : t -> bool; (** Return the associated ghost location. *) value ghostify : t -> t; (** Return the location with the give file name *) value set_file_name : string -> t -> t; (** [strictly_before loc1 loc2] True if the stop position of [loc1] is strictly_before the start position of [loc2]. *) value strictly_before : t -> t -> bool; (** Return the location with an absolute file name. *) value make_absolute : t -> t; (** Print the location into the formatter in a format suitable for error reporting. *) value print : Format.formatter -> t -> unit; (** Print the location in a short format useful for debugging. *) value dump : Format.formatter -> t -> unit; (** Same as {!print} but return a string instead of printting it. *) value to_string : t -> string; (** [Exc_located loc e] is an encapsulation of the exception [e] with the input location [loc]. To be used in quotation expanders and in grammars to specify some input location for an error. Do not raise this exception directly: rather use the following function [Loc.raise]. *) exception Exc_located of t and exn; (** [raise loc e], if [e] is already an [Exc_located] exception, re-raise it, else raise the exception [Exc_located loc e]. *) value raise : t -> exn -> 'a; (** The name of the location variable used in grammars and in the predefined quotations for OCaml syntax trees. Default: [_loc]. *) value name : ref string; end; (** Abstract syntax tree minimal signature. Types of this signature are abstract. See the {!Camlp4Ast} signature for a concrete definition. *) module type Ast = sig (** {6 Syntactic categories as abstract types} *) type loc; type meta_bool; type meta_option 'a; type meta_list 'a; type ctyp; type patt; type expr; type module_type; type sig_item; type with_constr; type module_expr; type str_item; type class_type; type class_sig_item; type class_expr; type class_str_item; type match_case; type ident; type binding; type rec_binding; type module_binding; type rec_flag; type direction_flag; type mutable_flag; type private_flag; type virtual_flag; type row_var_flag; type override_flag; (** {6 Location accessors} *) value loc_of_ctyp : ctyp -> loc; value loc_of_patt : patt -> loc; value loc_of_expr : expr -> loc; value loc_of_module_type : module_type -> loc; value loc_of_module_expr : module_expr -> loc; value loc_of_sig_item : sig_item -> loc; value loc_of_str_item : str_item -> loc; value loc_of_class_type : class_type -> loc; value loc_of_class_sig_item : class_sig_item -> loc; value loc_of_class_expr : class_expr -> loc; value loc_of_class_str_item : class_str_item -> loc; value loc_of_with_constr : with_constr -> loc; value loc_of_binding : binding -> loc; value loc_of_rec_binding : rec_binding -> loc; value loc_of_module_binding : module_binding -> loc; value loc_of_match_case : match_case -> loc; value loc_of_ident : ident -> loc; (** {6 Traversals} *) (** This class is the base class for map traversal on the Ast. To make a custom traversal class one just extend it like that: This example swap pairs expression contents: open Camlp4.PreCast; [class swap = object inherit Ast.map as super; method expr e = match super#expr e with \[ <:expr\@_loc< ($e1$, $e2$) >> -> <:expr< ($e2$, $e1$) >> | e -> e \]; end; value _loc = Loc.ghost; value map = (new swap)#expr; assert (map <:expr< fun x -> (x, 42) >> = <:expr< fun x -> (42, x) >>);] *) class map : object ('self_type) method string : string -> string; method list : ! 'a 'b . ('self_type -> 'a -> 'b) -> list 'a -> list 'b; method meta_bool : meta_bool -> meta_bool; method meta_option : ! 'a 'b . ('self_type -> 'a -> 'b) -> meta_option 'a -> meta_option 'b; method meta_list : ! 'a 'b . ('self_type -> 'a -> 'b) -> meta_list 'a -> meta_list 'b; method loc : loc -> loc; method expr : expr -> expr; method patt : patt -> patt; method ctyp : ctyp -> ctyp; method str_item : str_item -> str_item; method sig_item : sig_item -> sig_item; method module_expr : module_expr -> module_expr; method module_type : module_type -> module_type; method class_expr : class_expr -> class_expr; method class_type : class_type -> class_type; method class_sig_item : class_sig_item -> class_sig_item; method class_str_item : class_str_item -> class_str_item; method with_constr : with_constr -> with_constr; method binding : binding -> binding; method rec_binding : rec_binding -> rec_binding; method module_binding : module_binding -> module_binding; method match_case : match_case -> match_case; method ident : ident -> ident; method override_flag : override_flag -> override_flag; method mutable_flag : mutable_flag -> mutable_flag; method private_flag : private_flag -> private_flag; method virtual_flag : virtual_flag -> virtual_flag; method direction_flag : direction_flag -> direction_flag; method rec_flag : rec_flag -> rec_flag; method row_var_flag : row_var_flag -> row_var_flag; method unknown : ! 'a. 'a -> 'a; end; (** Fold style traversal *) class fold : object ('self_type) method string : string -> 'self_type; method list : ! 'a . ('self_type -> 'a -> 'self_type) -> list 'a -> 'self_type; method meta_bool : meta_bool -> 'self_type; method meta_option : ! 'a . ('self_type -> 'a -> 'self_type) -> meta_option 'a -> 'self_type; method meta_list : ! 'a . ('self_type -> 'a -> 'self_type) -> meta_list 'a -> 'self_type; method loc : loc -> 'self_type; method expr : expr -> 'self_type; method patt : patt -> 'self_type; method ctyp : ctyp -> 'self_type; method str_item : str_item -> 'self_type; method sig_item : sig_item -> 'self_type; method module_expr : module_expr -> 'self_type; method module_type : module_type -> 'self_type; method class_expr : class_expr -> 'self_type; method class_type : class_type -> 'self_type; method class_sig_item : class_sig_item -> 'self_type; method class_str_item : class_str_item -> 'self_type; method with_constr : with_constr -> 'self_type; method binding : binding -> 'self_type; method rec_binding : rec_binding -> 'self_type; method module_binding : module_binding -> 'self_type; method match_case : match_case -> 'self_type; method ident : ident -> 'self_type; method rec_flag : rec_flag -> 'self_type; method direction_flag : direction_flag -> 'self_type; method mutable_flag : mutable_flag -> 'self_type; method private_flag : private_flag -> 'self_type; method virtual_flag : virtual_flag -> 'self_type; method row_var_flag : row_var_flag -> 'self_type; method override_flag : override_flag -> 'self_type; method unknown : ! 'a. 'a -> 'self_type; end; end; (** Signature for OCaml syntax trees. *) (* This signature is an extension of {!Ast} It provides: - Types for all kinds of structure. - Map: A base class for map traversals. - Map classes and functions for common kinds. == Core language == ctyp :: Representaion of types patt :: The type of patterns expr :: The type of expressions match_case :: The type of cases for match/function/try constructions ident :: The type of identifiers (including path like Foo(X).Bar.y) binding :: The type of let bindings rec_binding :: The type of record definitions == Modules == module_type :: The type of module types sig_item :: The type of signature items str_item :: The type of structure items module_expr :: The type of module expressions module_binding :: The type of recursive module definitions with_constr :: The type of `with' constraints == Classes == class_type :: The type of class types class_sig_item :: The type of class signature items class_expr :: The type of class expressions class_str_item :: The type of class structure items *) module type Camlp4Ast = sig (** The inner module for locations *) module Loc : Loc; INCLUDE "camlp4/Camlp4/Camlp4Ast.partial.ml"; value loc_of_ctyp : ctyp -> loc; value loc_of_patt : patt -> loc; value loc_of_expr : expr -> loc; value loc_of_module_type : module_type -> loc; value loc_of_module_expr : module_expr -> loc; value loc_of_sig_item : sig_item -> loc; value loc_of_str_item : str_item -> loc; value loc_of_class_type : class_type -> loc; value loc_of_class_sig_item : class_sig_item -> loc; value loc_of_class_expr : class_expr -> loc; value loc_of_class_str_item : class_str_item -> loc; value loc_of_with_constr : with_constr -> loc; value loc_of_binding : binding -> loc; value loc_of_rec_binding : rec_binding -> loc; value loc_of_module_binding : module_binding -> loc; value loc_of_match_case : match_case -> loc; value loc_of_ident : ident -> loc; module Meta : sig module type META_LOC = sig (* The first location is where to put the returned pattern. Generally it's _loc to match with <:patt< ... >> quotations. The second location is the one to treat. *) value meta_loc_patt : loc -> loc -> patt; (* The first location is where to put the returned expression. Generally it's _loc to match with <:expr< ... >> quotations. The second location is the one to treat. *) value meta_loc_expr : loc -> loc -> expr; end; module MetaLoc : sig value meta_loc_patt : loc -> loc -> patt; value meta_loc_expr : loc -> loc -> expr; end; module MetaGhostLoc : sig value meta_loc_patt : loc -> 'a -> patt; value meta_loc_expr : loc -> 'a -> expr; end; module MetaLocVar : sig value meta_loc_patt : loc -> 'a -> patt; value meta_loc_expr : loc -> 'a -> expr; end; module Make (MetaLoc : META_LOC) : sig module Expr : sig value meta_string : loc -> string -> expr; value meta_int : loc -> string -> expr; value meta_float : loc -> string -> expr; value meta_char : loc -> string -> expr; value meta_bool : loc -> bool -> expr; value meta_list : (loc -> 'a -> expr) -> loc -> list 'a -> expr; value meta_binding : loc -> binding -> expr; value meta_rec_binding : loc -> rec_binding -> expr; value meta_class_expr : loc -> class_expr -> expr; value meta_class_sig_item : loc -> class_sig_item -> expr; value meta_class_str_item : loc -> class_str_item -> expr; value meta_class_type : loc -> class_type -> expr; value meta_ctyp : loc -> ctyp -> expr; value meta_expr : loc -> expr -> expr; value meta_ident : loc -> ident -> expr; value meta_match_case : loc -> match_case -> expr; value meta_module_binding : loc -> module_binding -> expr; value meta_module_expr : loc -> module_expr -> expr; value meta_module_type : loc -> module_type -> expr; value meta_patt : loc -> patt -> expr; value meta_sig_item : loc -> sig_item -> expr; value meta_str_item : loc -> str_item -> expr; value meta_with_constr : loc -> with_constr -> expr; value meta_rec_flag : loc -> rec_flag -> expr; value meta_mutable_flag : loc -> mutable_flag -> expr; value meta_virtual_flag : loc -> virtual_flag -> expr; value meta_private_flag : loc -> private_flag -> expr; value meta_row_var_flag : loc -> row_var_flag -> expr; value meta_override_flag : loc -> override_flag -> expr; value meta_direction_flag : loc -> direction_flag -> expr; end; module Patt : sig value meta_string : loc -> string -> patt; value meta_int : loc -> string -> patt; value meta_float : loc -> string -> patt; value meta_char : loc -> string -> patt; value meta_bool : loc -> bool -> patt; value meta_list : (loc -> 'a -> patt) -> loc -> list 'a -> patt; value meta_binding : loc -> binding -> patt; value meta_rec_binding : loc -> rec_binding -> patt; value meta_class_expr : loc -> class_expr -> patt; value meta_class_sig_item : loc -> class_sig_item -> patt; value meta_class_str_item : loc -> class_str_item -> patt; value meta_class_type : loc -> class_type -> patt; value meta_ctyp : loc -> ctyp -> patt; value meta_expr : loc -> expr -> patt; value meta_ident : loc -> ident -> patt; value meta_match_case : loc -> match_case -> patt; value meta_module_binding : loc -> module_binding -> patt; value meta_module_expr : loc -> module_expr -> patt; value meta_module_type : loc -> module_type -> patt; value meta_patt : loc -> patt -> patt; value meta_sig_item : loc -> sig_item -> patt; value meta_str_item : loc -> str_item -> patt; value meta_with_constr : loc -> with_constr -> patt; value meta_rec_flag : loc -> rec_flag -> patt; value meta_mutable_flag : loc -> mutable_flag -> patt; value meta_virtual_flag : loc -> virtual_flag -> patt; value meta_private_flag : loc -> private_flag -> patt; value meta_row_var_flag : loc -> row_var_flag -> patt; value meta_override_flag : loc -> override_flag -> patt; value meta_direction_flag : loc -> direction_flag -> patt; end; end; end; (** See {!Ast.map}. *) class map : object ('self_type) method string : string -> string; method list : ! 'a 'b . ('self_type -> 'a -> 'b) -> list 'a -> list 'b; method meta_bool : meta_bool -> meta_bool; method meta_option : ! 'a 'b . ('self_type -> 'a -> 'b) -> meta_option 'a -> meta_option 'b; method meta_list : ! 'a 'b . ('self_type -> 'a -> 'b) -> meta_list 'a -> meta_list 'b; method loc : loc -> loc; method expr : expr -> expr; method patt : patt -> patt; method ctyp : ctyp -> ctyp; method str_item : str_item -> str_item; method sig_item : sig_item -> sig_item; method module_expr : module_expr -> module_expr; method module_type : module_type -> module_type; method class_expr : class_expr -> class_expr; method class_type : class_type -> class_type; method class_sig_item : class_sig_item -> class_sig_item; method class_str_item : class_str_item -> class_str_item; method with_constr : with_constr -> with_constr; method binding : binding -> binding; method rec_binding : rec_binding -> rec_binding; method module_binding : module_binding -> module_binding; method match_case : match_case -> match_case; method ident : ident -> ident; method mutable_flag : mutable_flag -> mutable_flag; method private_flag : private_flag -> private_flag; method virtual_flag : virtual_flag -> virtual_flag; method direction_flag : direction_flag -> direction_flag; method rec_flag : rec_flag -> rec_flag; method row_var_flag : row_var_flag -> row_var_flag; method override_flag : override_flag -> override_flag; method unknown : ! 'a. 'a -> 'a; end; (** See {!Ast.fold}. *) class fold : object ('self_type) method string : string -> 'self_type; method list : ! 'a . ('self_type -> 'a -> 'self_type) -> list 'a -> 'self_type; method meta_bool : meta_bool -> 'self_type; method meta_option : ! 'a . ('self_type -> 'a -> 'self_type) -> meta_option 'a -> 'self_type; method meta_list : ! 'a . ('self_type -> 'a -> 'self_type) -> meta_list 'a -> 'self_type; method loc : loc -> 'self_type; method expr : expr -> 'self_type; method patt : patt -> 'self_type; method ctyp : ctyp -> 'self_type; method str_item : str_item -> 'self_type; method sig_item : sig_item -> 'self_type; method module_expr : module_expr -> 'self_type; method module_type : module_type -> 'self_type; method class_expr : class_expr -> 'self_type; method class_type : class_type -> 'self_type; method class_sig_item : class_sig_item -> 'self_type; method class_str_item : class_str_item -> 'self_type; method with_constr : with_constr -> 'self_type; method binding : binding -> 'self_type; method rec_binding : rec_binding -> 'self_type; method module_binding : module_binding -> 'self_type; method match_case : match_case -> 'self_type; method ident : ident -> 'self_type; method rec_flag : rec_flag -> 'self_type; method direction_flag : direction_flag -> 'self_type; method mutable_flag : mutable_flag -> 'self_type; method private_flag : private_flag -> 'self_type; method virtual_flag : virtual_flag -> 'self_type; method row_var_flag : row_var_flag -> 'self_type; method override_flag : override_flag -> 'self_type; method unknown : ! 'a. 'a -> 'self_type; end; value map_expr : (expr -> expr) -> map; value map_patt : (patt -> patt) -> map; value map_ctyp : (ctyp -> ctyp) -> map; value map_str_item : (str_item -> str_item) -> map; value map_sig_item : (sig_item -> sig_item) -> map; value map_loc : (loc -> loc) -> map; value ident_of_expr : expr -> ident; value ident_of_patt : patt -> ident; value ident_of_ctyp : ctyp -> ident; value biAnd_of_list : list binding -> binding; value rbSem_of_list : list rec_binding -> rec_binding; value paSem_of_list : list patt -> patt; value paCom_of_list : list patt -> patt; value tyOr_of_list : list ctyp -> ctyp; value tyAnd_of_list : list ctyp -> ctyp; value tyAmp_of_list : list ctyp -> ctyp; value tySem_of_list : list ctyp -> ctyp; value tyCom_of_list : list ctyp -> ctyp; value tySta_of_list : list ctyp -> ctyp; value stSem_of_list : list str_item -> str_item; value sgSem_of_list : list sig_item -> sig_item; value crSem_of_list : list class_str_item -> class_str_item; value cgSem_of_list : list class_sig_item -> class_sig_item; value ctAnd_of_list : list class_type -> class_type; value ceAnd_of_list : list class_expr -> class_expr; value wcAnd_of_list : list with_constr -> with_constr; value meApp_of_list : list module_expr -> module_expr; value mbAnd_of_list : list module_binding -> module_binding; value mcOr_of_list : list match_case -> match_case; value idAcc_of_list : list ident -> ident; value idApp_of_list : list ident -> ident; value exSem_of_list : list expr -> expr; value exCom_of_list : list expr -> expr; value list_of_ctyp : ctyp -> list ctyp -> list ctyp; value list_of_binding : binding -> list binding -> list binding; value list_of_rec_binding : rec_binding -> list rec_binding -> list rec_binding; value list_of_with_constr : with_constr -> list with_constr -> list with_constr; value list_of_patt : patt -> list patt -> list patt; value list_of_expr : expr -> list expr -> list expr; value list_of_str_item : str_item -> list str_item -> list str_item; value list_of_sig_item : sig_item -> list sig_item -> list sig_item; value list_of_class_sig_item : class_sig_item -> list class_sig_item -> list class_sig_item; value list_of_class_str_item : class_str_item -> list class_str_item -> list class_str_item; value list_of_class_type : class_type -> list class_type -> list class_type; value list_of_class_expr : class_expr -> list class_expr -> list class_expr; value list_of_module_expr : module_expr -> list module_expr -> list module_expr; value list_of_module_binding : module_binding -> list module_binding -> list module_binding; value list_of_match_case : match_case -> list match_case -> list match_case; value list_of_ident : ident -> list ident -> list ident; (** Like [String.escape] but takes care to not escape antiquotations strings. *) value safe_string_escaped : string -> string; (** Returns True if the given pattern is irrefutable. *) value is_irrefut_patt : patt -> bool; value is_constructor : ident -> bool; value is_patt_constructor : patt -> bool; value is_expr_constructor : expr -> bool; value ty_of_stl : (Loc.t * string * list ctyp) -> ctyp; value ty_of_sbt : (Loc.t * string * bool * ctyp) -> ctyp; value bi_of_pe : (patt * expr) -> binding; value pel_of_binding : binding -> list (patt * expr); value binding_of_pel : list (patt * expr) -> binding; value sum_type_of_list : list (Loc.t * string * list ctyp) -> ctyp; value record_type_of_list : list (Loc.t * string * bool * ctyp) -> ctyp; end; (** This functor is a restriction functor. It takes a Camlp4Ast module and gives the Ast one. Typical use is for [with] constraints. Example: ... with module Ast = Camlp4.Sig.Camlp4AstToAst Camlp4Ast *) module Camlp4AstToAst (M : Camlp4Ast) : Ast with type loc = M.loc and type meta_bool = M.meta_bool and type meta_option 'a = M.meta_option 'a and type meta_list 'a = M.meta_list 'a and type ctyp = M.ctyp and type patt = M.patt and type expr = M.expr and type module_type = M.module_type and type sig_item = M.sig_item and type with_constr = M.with_constr and type module_expr = M.module_expr and type str_item = M.str_item and type class_type = M.class_type and type class_sig_item = M.class_sig_item and type class_expr = M.class_expr and type class_str_item = M.class_str_item and type binding = M.binding and type rec_binding = M.rec_binding and type module_binding = M.module_binding and type match_case = M.match_case and type ident = M.ident and type rec_flag = M.rec_flag and type direction_flag = M.direction_flag and type mutable_flag = M.mutable_flag and type private_flag = M.private_flag and type virtual_flag = M.virtual_flag and type row_var_flag = M.row_var_flag and type override_flag = M.override_flag = M; (** Concrete definition of Camlp4 ASTs abstracted from locations. Since the Ast contains locations, this functor produces Ast types for a given location type. *) module MakeCamlp4Ast (Loc : Type) = struct INCLUDE "camlp4/Camlp4/Camlp4Ast.partial.ml"; end; (** {6 Filters} *) (** A type for stream filters. *) type stream_filter 'a 'loc = Stream.t ('a * 'loc) -> Stream.t ('a * 'loc); (** Registerinng and folding of Ast filters. Two kinds of filters must be handled: - Implementation filters: str_item -> str_item. - Interface filters: sig_item -> sig_item. *) module type AstFilters = sig module Ast : Camlp4Ast; type filter 'a = 'a -> 'a; value register_sig_item_filter : (filter Ast.sig_item) -> unit; value register_str_item_filter : (filter Ast.str_item) -> unit; value register_topphrase_filter : (filter Ast.str_item) -> unit; value fold_interf_filters : ('a -> filter Ast.sig_item -> 'a) -> 'a -> 'a; value fold_implem_filters : ('a -> filter Ast.str_item -> 'a) -> 'a -> 'a; value fold_topphrase_filters : ('a -> filter Ast.str_item -> 'a) -> 'a -> 'a; end; (** ASTs as one single dynamic type *) module type DynAst = sig module Ast : Ast; type tag 'a; value ctyp_tag : tag Ast.ctyp; value patt_tag : tag Ast.patt; value expr_tag : tag Ast.expr; value module_type_tag : tag Ast.module_type; value sig_item_tag : tag Ast.sig_item; value with_constr_tag : tag Ast.with_constr; value module_expr_tag : tag Ast.module_expr; value str_item_tag : tag Ast.str_item; value class_type_tag : tag Ast.class_type; value class_sig_item_tag : tag Ast.class_sig_item; value class_expr_tag : tag Ast.class_expr; value class_str_item_tag : tag Ast.class_str_item; value match_case_tag : tag Ast.match_case; value ident_tag : tag Ast.ident; value binding_tag : tag Ast.binding; value rec_binding_tag : tag Ast.rec_binding; value module_binding_tag : tag Ast.module_binding; value string_of_tag : tag 'a -> string; module Pack (X : sig type t 'a; end) : sig type pack; value pack : tag 'a -> X.t 'a -> pack; value unpack : tag 'a -> pack -> X.t 'a; value print_tag : Format.formatter -> pack -> unit; end; end; (** {6 Quotation operations} *) (** The generic quotation type. To see how fields are used here is an example: <:q_name@q_loc> The last one, q_shift is equal to the length of "<:q_name@q_loc<". *) type quotation = { q_name : string ; q_loc : string ; q_shift : int ; q_contents : string }; (** The signature for a quotation expander registery. *) module type Quotation = sig module Ast : Ast; module DynAst : DynAst with module Ast = Ast; open Ast; (** The [loc] is the initial location. The option string is the optional name for the location variable. The string is the quotation contents. *) type expand_fun 'a = loc -> option string -> string -> 'a; (** [add name exp] adds the quotation [name] associated with the expander [exp]. *) value add : string -> DynAst.tag 'a -> expand_fun 'a -> unit; (** [find name] returns the expander of the given quotation name. *) value find : string -> DynAst.tag 'a -> expand_fun 'a; (** [default] holds the default quotation name. *) value default : ref string; (** [parse_quotation_result parse_function loc position_tag quotation quotation_result] It's a parser wrapper, this function handles the error reporting for you. *) value parse_quotation_result : (loc -> string -> 'a) -> loc -> quotation -> string -> string -> 'a; (** function translating quotation names; default = identity *) value translate : ref (string -> string); value expand : loc -> quotation -> DynAst.tag 'a -> 'a; (** [dump_file] optionally tells Camlp4 to dump the result of an expander if this result is syntactically incorrect. If [None] (default), this result is not dumped. If [Some fname], the result is dumped in the file [fname]. *) value dump_file : ref (option string); module Error : Error; end; (** {6 Tokens} *) (** A signature for tokens. *) module type Token = sig module Loc : Loc; type t; value to_string : t -> string; value print : Format.formatter -> t -> unit; value match_keyword : string -> t -> bool; value extract_string : t -> string; module Filter : sig type token_filter = stream_filter t Loc.t; (** The type for this filter chain. A basic implementation just store the [is_keyword] function given by [mk] and use it in the [filter] function. *) type t; (** The given predicate function returns true if the given string is a keyword. This function can be used in filters to translate identifier tokens to keyword tokens. *) value mk : (string -> bool) -> t; (** This function allows to register a new filter to the token filter chain. You can choose to not support these and raise an exception. *) value define_filter : t -> (token_filter -> token_filter) -> unit; (** This function filter the given stream and return a filtered stream. A basic implementation just match identifiers against the [is_keyword] function to produce token keywords instead. *) value filter : t -> token_filter; (** Called by the grammar system when a keyword is used. The boolean argument is True when it's the first time that keyword is used. If you do not care about this information just return [()]. *) value keyword_added : t -> string -> bool -> unit; (** Called by the grammar system when a keyword is no longer used. If you do not care about this information just return [()]. *) value keyword_removed : t -> string -> unit; end; module Error : Error; end; (** This signature describes tokens for the OCaml and the Revised syntax lexing rules. For some tokens the data constructor holds two representations with the evaluated one and the source one. For example the INT data constructor holds an integer and a string, this string can contains more information that's needed for a good pretty-printing ("42", "4_2", "0000042", "0b0101010"...). The meaning of the tokens are: - [KEYWORD s] is the keyword [s]. - [LIDENT s] is the ident [s] starting with a lowercase letter. - [UIDENT s] is the ident [s] starting with an uppercase letter. - [INT i s] (resp. [INT32 i s], [INT64 i s] and [NATIVEINT i s]) the integer constant [i] whose string source is [s]. - [FLOAT f s] is the float constant [f] whose string source is [s]. - [STRING s s'] is the string constant [s] whose string source is [s']. - [CHAR c s] is the character constant [c] whose string source is [s]. - [QUOTATION q] is a quotation [q], see {!Quotation.t} for more information. - [ANTIQUOT n s] is an antiquotation [n] holding the string [s]. - [EOI] is the end of input. Warning: the second string associated with the constructor [STRING] is the string found in the source without any interpretation. In particular, the backslashes are not interpreted. For example, if the input is ["\n"] the string is *not* a string with one element containing the character "return", but a string of two elements: the backslash and the character ["n"]. To interpret a string use the first string of the [STRING] constructor (or if you need to compute it use the module {!Camlp4.Struct.Token.Eval}. Same thing for the constructor [CHAR]. *) type camlp4_token = [ KEYWORD of string | SYMBOL of string | LIDENT of string | UIDENT of string | ESCAPED_IDENT of string | INT of int and string | INT32 of int32 and string | INT64 of int64 and string | NATIVEINT of nativeint and string | FLOAT of float and string | CHAR of char and string | STRING of string and string | LABEL of string | OPTLABEL of string | QUOTATION of quotation | ANTIQUOT of string and string | COMMENT of string | BLANKS of string | NEWLINE | LINE_DIRECTIVE of int and option string | EOI ]; (** A signature for specialized tokens. *) module type Camlp4Token = Token with type t = camlp4_token; (** {6 Dynamic loaders} *) (** A signature for dynamic loaders. *) module type DynLoader = sig type t; exception Error of string and string; (** [mk ?ocaml_stdlib ?camlp4_stdlib] The stdlib flag is true by default. To disable it use: [mk ~ocaml_stdlib:False] *) value mk : ?ocaml_stdlib: bool -> ?camlp4_stdlib: bool -> unit -> t; (** Fold over the current load path list. *) value fold_load_path : t -> (string -> 'a -> 'a) -> 'a -> 'a; (** [load f] Load the file [f]. If [f] is not an absolute path name, the load path list used to find the directory of [f]. *) value load : t -> string -> unit; (** [include_dir d] Add the directory [d] in the current load path list (like the common -I option). *) value include_dir : t -> string -> unit; (** [find_in_path f] Returns the full path of the file [f] if [f] is in the current load path, raises [Not_found] otherwise. *) value find_in_path : t -> string -> string; (** [is_native] [True] if we are in native code, [False] for bytecode. *) value is_native : bool; end; (** A signature for grammars. *) module Grammar = struct (** Internal signature for sematantic actions of grammars, not for the casual user. These functions are unsafe. *) module type Action = sig type t ; value mk : 'a -> t; value get : t -> 'a; value getf : t -> ('a -> 'b); value getf2 : t -> ('a -> 'b -> 'c); end; type assoc = [ NonA | RightA | LeftA ]; type position = [ First | Last | Before of string | After of string | Level of string ]; (** Common signature for {!Sig.Grammar.Static} and {!Sig.Grammar.Dynamic}. *) module type Structure = sig module Loc : Loc; module Action : Action; module Token : Token with module Loc = Loc; type gram; type internal_entry; type tree; type token_pattern = ((Token.t -> bool) * string); type token_info; type token_stream = Stream.t (Token.t * token_info); value token_location : token_info -> Loc.t; type symbol = [ Smeta of string and list symbol and Action.t | Snterm of internal_entry | Snterml of internal_entry and string | Slist0 of symbol | Slist0sep of symbol and symbol | Slist1 of symbol | Slist1sep of symbol and symbol | Sopt of symbol | Stry of symbol | Sself | Snext | Stoken of token_pattern | Skeyword of string | Stree of tree ]; type production_rule = (list symbol * Action.t); type single_extend_statment = (option string * option assoc * list production_rule); type extend_statment = (option position * list single_extend_statment); type delete_statment = list symbol; type fold 'a 'b 'c = internal_entry -> list symbol -> (Stream.t 'a -> 'b) -> Stream.t 'a -> 'c; type foldsep 'a 'b 'c = internal_entry -> list symbol -> (Stream.t 'a -> 'b) -> (Stream.t 'a -> unit) -> Stream.t 'a -> 'c; end; (** Signature for Camlp4 grammars. Here the dynamic means that you can produce as many grammar values as needed with a single grammar module. If you do not need many grammar values it's preferable to use a static one. *) module type Dynamic = sig include Structure; (** Make a new grammar. *) value mk : unit -> gram; module Entry : sig (** The abstract type of grammar entries. The type parameter is the type of the semantic actions that are associated with this entry. *) type t 'a; (** Make a new entry from the given name. *) value mk : gram -> string -> t 'a; (** Make a new entry from a name and an hand made token parser. *) value of_parser : gram -> string -> (token_stream -> 'a) -> t 'a; (** Clear the entry and setup this parser instead. *) value setup_parser : t 'a -> (token_stream -> 'a) -> unit; (** Get the entry name. *) value name : t 'a -> string; (** Print the given entry into the given formatter. *) value print : Format.formatter -> t 'a -> unit; (** Same as {!print} but show the left-factorization. *) value dump : Format.formatter -> t 'a -> unit; (**/**) value obj : t 'a -> internal_entry; value clear : t 'a -> unit; (**/**) end; (** [get_filter g] Get the {!Token.Filter} associated to the [g]. *) value get_filter : gram -> Token.Filter.t; type not_filtered 'a; (** This function is called by the EXTEND ... END syntax. *) value extend : Entry.t 'a -> extend_statment -> unit; (** The delete rule. *) value delete_rule : Entry.t 'a -> delete_statment -> unit; value srules : Entry.t 'a -> list (list symbol * Action.t) -> symbol; value sfold0 : ('a -> 'b -> 'b) -> 'b -> fold _ 'a 'b; value sfold1 : ('a -> 'b -> 'b) -> 'b -> fold _ 'a 'b; value sfold0sep : ('a -> 'b -> 'b) -> 'b -> foldsep _ 'a 'b; (* value sfold1sep : ('a -> 'b -> 'b) -> 'b -> foldsep _ 'a 'b; *) (** Use the lexer to produce a non filtered token stream from a char stream. *) value lex : gram -> Loc.t -> Stream.t char -> not_filtered (Stream.t (Token.t * Loc.t)); (** Token stream from string. *) value lex_string : gram -> Loc.t -> string -> not_filtered (Stream.t (Token.t * Loc.t)); (** Filter a token stream using the {!Token.Filter} module *) value filter : gram -> not_filtered (Stream.t (Token.t * Loc.t)) -> token_stream; (** Lex, filter and parse a stream of character. *) value parse : Entry.t 'a -> Loc.t -> Stream.t char -> 'a; (** Same as {!parse} but from a string. *) value parse_string : Entry.t 'a -> Loc.t -> string -> 'a; (** Parse a token stream that is not filtered yet. *) value parse_tokens_before_filter : Entry.t 'a -> not_filtered (Stream.t (Token.t * Loc.t)) -> 'a; (** Parse a token stream that is already filtered. *) value parse_tokens_after_filter : Entry.t 'a -> token_stream -> 'a; end; (** Signature for Camlp4 grammars. Here the static means that there is only one grammar value by grammar module. If you do not need to store the grammar value it's preferable to use a static one. *) module type Static = sig include Structure; module Entry : sig (** The abstract type of grammar entries. The type parameter is the type of the semantic actions that are associated with this entry. *) type t 'a; (** Make a new entry from the given name. *) value mk : string -> t 'a; (** Make a new entry from a name and an hand made token parser. *) value of_parser : string -> (token_stream -> 'a) -> t 'a; (** Clear the entry and setup this parser instead. *) value setup_parser : t 'a -> (token_stream -> 'a) -> unit; (** Get the entry name. *) value name : t 'a -> string; (** Print the given entry into the given formatter. *) value print : Format.formatter -> t 'a -> unit; (** Same as {!print} but show the left-factorization. *) value dump : Format.formatter -> t 'a -> unit; (**/**) value obj : t 'a -> internal_entry; value clear : t 'a -> unit; (**/**) end; (** Get the {!Token.Filter} associated to the grammar module. *) value get_filter : unit -> Token.Filter.t; type not_filtered 'a; (** This function is called by the EXTEND ... END syntax. *) value extend : Entry.t 'a -> extend_statment -> unit; (** The delete rule. *) value delete_rule : Entry.t 'a -> delete_statment -> unit; value srules : Entry.t 'a -> list (list symbol * Action.t) -> symbol; value sfold0 : ('a -> 'b -> 'b) -> 'b -> fold _ 'a 'b; value sfold1 : ('a -> 'b -> 'b) -> 'b -> fold _ 'a 'b; value sfold0sep : ('a -> 'b -> 'b) -> 'b -> foldsep _ 'a 'b; (* value sfold1sep : ('a -> 'b -> 'b) -> 'b -> foldsep _ 'a 'b; *) (** Use the lexer to produce a non filtered token stream from a char stream. *) value lex : Loc.t -> Stream.t char -> not_filtered (Stream.t (Token.t * Loc.t)); (** Token stream from string. *) value lex_string : Loc.t -> string -> not_filtered (Stream.t (Token.t * Loc.t)); (** Filter a token stream using the {!Token.Filter} module *) value filter : not_filtered (Stream.t (Token.t * Loc.t)) -> token_stream; (** Lex, filter and parse a stream of character. *) value parse : Entry.t 'a -> Loc.t -> Stream.t char -> 'a; (** Same as {!parse} but from a string. *) value parse_string : Entry.t 'a -> Loc.t -> string -> 'a; (** Parse a token stream that is not filtered yet. *) value parse_tokens_before_filter : Entry.t 'a -> not_filtered (Stream.t (Token.t * Loc.t)) -> 'a; (** Parse a token stream that is already filtered. *) value parse_tokens_after_filter : Entry.t 'a -> token_stream -> 'a; end; end; (** A signature for lexers. *) module type Lexer = sig module Loc : Loc; module Token : Token with module Loc = Loc; module Error : Error; (** The constructor for a lexing function. The character stream is the input stream to be lexed. The result is a stream of pairs of a token and a location. The lexer do not use global (mutable) variables: instantiations of [Lexer.mk ()] do not perturb each other. *) value mk : unit -> (Loc.t -> Stream.t char -> Stream.t (Token.t * Loc.t)); end; (** A signature for parsers abstract from ASTs. *) module Parser (Ast : Ast) = struct module type SIMPLE = sig (** The parse function for expressions. The underlying expression grammar entry is generally "expr; EOI". *) value parse_expr : Ast.loc -> string -> Ast.expr; (** The parse function for patterns. The underlying pattern grammar entry is generally "patt; EOI". *) value parse_patt : Ast.loc -> string -> Ast.patt; end; module type S = sig (** Called when parsing an implementation (ml file) to build the syntax tree; the returned list contains the phrases (structure items) as a single "declare" node (a list of structure items); if the parser encounter a directive it stops (since the directive may change the syntax), the given [directive_handler] function evaluates it and the parsing starts again. *) value parse_implem : ?directive_handler:(Ast.str_item -> option Ast.str_item) -> Ast.loc -> Stream.t char -> Ast.str_item; (** Same as {!parse_implem} but for interface (mli file). *) value parse_interf : ?directive_handler:(Ast.sig_item -> option Ast.sig_item) -> Ast.loc -> Stream.t char -> Ast.sig_item; end; end; (** A signature for printers abstract from ASTs. *) module Printer (Ast : Ast) = struct module type S = sig value print_interf : ?input_file:string -> ?output_file:string -> Ast.sig_item -> unit; value print_implem : ?input_file:string -> ?output_file:string -> Ast.str_item -> unit; end; end; (** A syntax module is a sort of constistent bunch of modules and values. In such a module you have a parser, a printer, and also modules for locations, syntax trees, tokens, grammars, quotations, anti-quotations. There is also the main grammar entries. *) module type Syntax = sig module Loc : Loc; module Ast : Ast with type loc = Loc.t; module Token : Token with module Loc = Loc; module Gram : Grammar.Static with module Loc = Loc and module Token = Token; module Quotation : Quotation with module Ast = Ast; module AntiquotSyntax : (Parser Ast).SIMPLE; include (Warning Loc).S; include (Parser Ast).S; include (Printer Ast).S; end; (** A syntax module is a sort of constistent bunch of modules and values. In such a module you have a parser, a printer, and also modules for locations, syntax trees, tokens, grammars, quotations, anti-quotations. There is also the main grammar entries. *) module type Camlp4Syntax = sig module Loc : Loc; module Ast : Camlp4Ast with module Loc = Loc; module Token : Camlp4Token with module Loc = Loc; module Gram : Grammar.Static with module Loc = Loc and module Token = Token; module Quotation : Quotation with module Ast = Camlp4AstToAst Ast; module AntiquotSyntax : (Parser Ast).SIMPLE; include (Warning Loc).S; include (Parser Ast).S; include (Printer Ast).S; value interf : Gram.Entry.t (list Ast.sig_item * option Loc.t); value implem : Gram.Entry.t (list Ast.str_item * option Loc.t); value top_phrase : Gram.Entry.t (option Ast.str_item); value use_file : Gram.Entry.t (list Ast.str_item * option Loc.t); value a_CHAR : Gram.Entry.t string; value a_FLOAT : Gram.Entry.t string; value a_INT : Gram.Entry.t string; value a_INT32 : Gram.Entry.t string; value a_INT64 : Gram.Entry.t string; value a_LABEL : Gram.Entry.t string; value a_LIDENT : Gram.Entry.t string; value a_NATIVEINT : Gram.Entry.t string; value a_OPTLABEL : Gram.Entry.t string; value a_STRING : Gram.Entry.t string; value a_UIDENT : Gram.Entry.t string; value a_ident : Gram.Entry.t string; value amp_ctyp : Gram.Entry.t Ast.ctyp; value and_ctyp : Gram.Entry.t Ast.ctyp; value match_case : Gram.Entry.t Ast.match_case; value match_case0 : Gram.Entry.t Ast.match_case; value match_case_quot : Gram.Entry.t Ast.match_case; value binding : Gram.Entry.t Ast.binding; value binding_quot : Gram.Entry.t Ast.binding; value rec_binding_quot : Gram.Entry.t Ast.rec_binding; value class_declaration : Gram.Entry.t Ast.class_expr; value class_description : Gram.Entry.t Ast.class_type; value class_expr : Gram.Entry.t Ast.class_expr; value class_expr_quot : Gram.Entry.t Ast.class_expr; value class_fun_binding : Gram.Entry.t Ast.class_expr; value class_fun_def : Gram.Entry.t Ast.class_expr; value class_info_for_class_expr : Gram.Entry.t Ast.class_expr; value class_info_for_class_type : Gram.Entry.t Ast.class_type; value class_longident : Gram.Entry.t Ast.ident; value class_longident_and_param : Gram.Entry.t Ast.class_expr; value class_name_and_param : Gram.Entry.t (string * Ast.ctyp); value class_sig_item : Gram.Entry.t Ast.class_sig_item; value class_sig_item_quot : Gram.Entry.t Ast.class_sig_item; value class_signature : Gram.Entry.t Ast.class_sig_item; value class_str_item : Gram.Entry.t Ast.class_str_item; value class_str_item_quot : Gram.Entry.t Ast.class_str_item; value class_structure : Gram.Entry.t Ast.class_str_item; value class_type : Gram.Entry.t Ast.class_type; value class_type_declaration : Gram.Entry.t Ast.class_type; value class_type_longident : Gram.Entry.t Ast.ident; value class_type_longident_and_param : Gram.Entry.t Ast.class_type; value class_type_plus : Gram.Entry.t Ast.class_type; value class_type_quot : Gram.Entry.t Ast.class_type; value comma_ctyp : Gram.Entry.t Ast.ctyp; value comma_expr : Gram.Entry.t Ast.expr; value comma_ipatt : Gram.Entry.t Ast.patt; value comma_patt : Gram.Entry.t Ast.patt; value comma_type_parameter : Gram.Entry.t Ast.ctyp; value constrain : Gram.Entry.t (Ast.ctyp * Ast.ctyp); value constructor_arg_list : Gram.Entry.t Ast.ctyp; value constructor_declaration : Gram.Entry.t Ast.ctyp; value constructor_declarations : Gram.Entry.t Ast.ctyp; value ctyp : Gram.Entry.t Ast.ctyp; value ctyp_quot : Gram.Entry.t Ast.ctyp; value cvalue_binding : Gram.Entry.t Ast.expr; value direction_flag : Gram.Entry.t Ast.direction_flag; value direction_flag_quot : Gram.Entry.t Ast.direction_flag; value dummy : Gram.Entry.t unit; value eq_expr : Gram.Entry.t (string -> Ast.patt -> Ast.patt); value expr : Gram.Entry.t Ast.expr; value expr_eoi : Gram.Entry.t Ast.expr; value expr_quot : Gram.Entry.t Ast.expr; value field_expr : Gram.Entry.t Ast.rec_binding; value field_expr_list : Gram.Entry.t Ast.rec_binding; value fun_binding : Gram.Entry.t Ast.expr; value fun_def : Gram.Entry.t Ast.expr; value ident : Gram.Entry.t Ast.ident; value ident_quot : Gram.Entry.t Ast.ident; value ipatt : Gram.Entry.t Ast.patt; value ipatt_tcon : Gram.Entry.t Ast.patt; value label : Gram.Entry.t string; value label_declaration : Gram.Entry.t Ast.ctyp; value label_declaration_list : Gram.Entry.t Ast.ctyp; value label_expr : Gram.Entry.t Ast.rec_binding; value label_expr_list : Gram.Entry.t Ast.rec_binding; value label_ipatt : Gram.Entry.t Ast.patt; value label_ipatt_list : Gram.Entry.t Ast.patt; value label_longident : Gram.Entry.t Ast.ident; value label_patt : Gram.Entry.t Ast.patt; value label_patt_list : Gram.Entry.t Ast.patt; value labeled_ipatt : Gram.Entry.t Ast.patt; value let_binding : Gram.Entry.t Ast.binding; value meth_list : Gram.Entry.t (Ast.ctyp * Ast.row_var_flag); value meth_decl : Gram.Entry.t Ast.ctyp; value module_binding : Gram.Entry.t Ast.module_binding; value module_binding0 : Gram.Entry.t Ast.module_expr; value module_binding_quot : Gram.Entry.t Ast.module_binding; value module_declaration : Gram.Entry.t Ast.module_type; value module_expr : Gram.Entry.t Ast.module_expr; value module_expr_quot : Gram.Entry.t Ast.module_expr; value module_longident : Gram.Entry.t Ast.ident; value module_longident_with_app : Gram.Entry.t Ast.ident; value module_rec_declaration : Gram.Entry.t Ast.module_binding; value module_type : Gram.Entry.t Ast.module_type; value package_type : Gram.Entry.t Ast.module_type; value module_type_quot : Gram.Entry.t Ast.module_type; value more_ctyp : Gram.Entry.t Ast.ctyp; value name_tags : Gram.Entry.t Ast.ctyp; value opt_as_lident : Gram.Entry.t string; value opt_class_self_patt : Gram.Entry.t Ast.patt; value opt_class_self_type : Gram.Entry.t Ast.ctyp; value opt_comma_ctyp : Gram.Entry.t Ast.ctyp; value opt_dot_dot : Gram.Entry.t Ast.row_var_flag; value row_var_flag_quot : Gram.Entry.t Ast.row_var_flag; value opt_eq_ctyp : Gram.Entry.t Ast.ctyp; value opt_expr : Gram.Entry.t Ast.expr; value opt_meth_list : Gram.Entry.t Ast.ctyp; value opt_mutable : Gram.Entry.t Ast.mutable_flag; value mutable_flag_quot : Gram.Entry.t Ast.mutable_flag; value opt_override : Gram.Entry.t Ast.override_flag; value override_flag_quot : Gram.Entry.t Ast.override_flag; value opt_polyt : Gram.Entry.t Ast.ctyp; value opt_private : Gram.Entry.t Ast.private_flag; value private_flag_quot : Gram.Entry.t Ast.private_flag; value opt_rec : Gram.Entry.t Ast.rec_flag; value opt_nonrec : Gram.Entry.t Ast.rec_flag; value rec_flag_quot : Gram.Entry.t Ast.rec_flag; value opt_virtual : Gram.Entry.t Ast.virtual_flag; value virtual_flag_quot : Gram.Entry.t Ast.virtual_flag; value opt_when_expr : Gram.Entry.t Ast.expr; value patt : Gram.Entry.t Ast.patt; value patt_as_patt_opt : Gram.Entry.t Ast.patt; value patt_eoi : Gram.Entry.t Ast.patt; value patt_quot : Gram.Entry.t Ast.patt; value patt_tcon : Gram.Entry.t Ast.patt; value phrase : Gram.Entry.t Ast.str_item; value poly_type : Gram.Entry.t Ast.ctyp; value row_field : Gram.Entry.t Ast.ctyp; value sem_expr : Gram.Entry.t Ast.expr; value sem_expr_for_list : Gram.Entry.t (Ast.expr -> Ast.expr); value sem_patt : Gram.Entry.t Ast.patt; value sem_patt_for_list : Gram.Entry.t (Ast.patt -> Ast.patt); value semi : Gram.Entry.t unit; value sequence : Gram.Entry.t Ast.expr; value do_sequence : Gram.Entry.t Ast.expr; value sig_item : Gram.Entry.t Ast.sig_item; value sig_item_quot : Gram.Entry.t Ast.sig_item; value sig_items : Gram.Entry.t Ast.sig_item; value star_ctyp : Gram.Entry.t Ast.ctyp; value str_item : Gram.Entry.t Ast.str_item; value str_item_quot : Gram.Entry.t Ast.str_item; value str_items : Gram.Entry.t Ast.str_item; value type_constraint : Gram.Entry.t unit; value type_declaration : Gram.Entry.t Ast.ctyp; value type_ident_and_parameters : Gram.Entry.t (Ast.ident * list Ast.ctyp); value type_kind : Gram.Entry.t Ast.ctyp; value type_longident : Gram.Entry.t Ast.ident; value type_longident_and_parameters : Gram.Entry.t Ast.ctyp; value type_parameter : Gram.Entry.t Ast.ctyp; value type_parameters : Gram.Entry.t (Ast.ctyp -> Ast.ctyp); value typevars : Gram.Entry.t Ast.ctyp; value val_longident : Gram.Entry.t Ast.ident; value value_let : Gram.Entry.t unit; value value_val : Gram.Entry.t unit; value with_constr : Gram.Entry.t Ast.with_constr; value with_constr_quot : Gram.Entry.t Ast.with_constr; value prefixop : Gram.Entry.t Ast.expr; value infixop0 : Gram.Entry.t Ast.expr; value infixop1 : Gram.Entry.t Ast.expr; value infixop2 : Gram.Entry.t Ast.expr; value infixop3 : Gram.Entry.t Ast.expr; value infixop4 : Gram.Entry.t Ast.expr; end; (** A signature for syntax extension (syntax -> syntax functors). *) module type SyntaxExtension = functor (Syn : Syntax) -> (Syntax with module Loc = Syn.Loc and module Ast = Syn.Ast and module Token = Syn.Token and module Gram = Syn.Gram and module Quotation = Syn.Quotation); camlp4-5.3-1/camlp4/Camlp4/Struct.mlpack000066400000000000000000000002231473134377200176640ustar00rootroot00000000000000AstFilters Camlp4Ast Camlp4Ast2OCamlAst CleanAst CommentFilter DynLoader EmptyError EmptyPrinter FreeVars Lexer Loc Quotation Token Grammar DynAst camlp4-5.3-1/camlp4/Camlp4/Struct/000077500000000000000000000000001473134377200164765ustar00rootroot00000000000000camlp4-5.3-1/camlp4/Camlp4/Struct/.ignore000066400000000000000000000000321473134377200177550ustar00rootroot00000000000000Lexer.ml Camlp4Ast.tmp.ml camlp4-5.3-1/camlp4/Camlp4/Struct/AstFilters.ml000066400000000000000000000034001473134377200211050ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) module Make (Ast : Sig.Camlp4Ast) : Sig.AstFilters with module Ast = Ast = struct module Ast = Ast; type filter 'a = 'a -> 'a; value interf_filters = Queue.create (); value fold_interf_filters f i = Queue.fold f i interf_filters; value implem_filters = Queue.create (); value fold_implem_filters f i = Queue.fold f i implem_filters; value topphrase_filters = Queue.create (); value fold_topphrase_filters f i = Queue.fold f i topphrase_filters; value register_sig_item_filter f = Queue.add f interf_filters; value register_str_item_filter f = Queue.add f implem_filters; value register_topphrase_filter f = Queue.add f topphrase_filters; end; camlp4-5.3-1/camlp4/Camlp4/Struct/Camlp4Ast.mlast000066400000000000000000000415071473134377200213370ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc = struct module Loc = Loc; module Ast = struct include Sig.MakeCamlp4Ast Loc; value safe_string_escaped s = if String.length s > 2 && s.[0] = '\\' && s.[1] = '$' then s else String.escaped s; end; include Ast; external loc_of_ctyp : ctyp -> Loc.t = "%field0"; external loc_of_patt : patt -> Loc.t = "%field0"; external loc_of_expr : expr -> Loc.t = "%field0"; external loc_of_module_type : module_type -> Loc.t = "%field0"; external loc_of_module_expr : module_expr -> Loc.t = "%field0"; external loc_of_sig_item : sig_item -> Loc.t = "%field0"; external loc_of_str_item : str_item -> Loc.t = "%field0"; external loc_of_class_type : class_type -> Loc.t = "%field0"; external loc_of_class_sig_item : class_sig_item -> Loc.t = "%field0"; external loc_of_class_expr : class_expr -> Loc.t = "%field0"; external loc_of_class_str_item : class_str_item -> Loc.t = "%field0"; external loc_of_with_constr : with_constr -> Loc.t = "%field0"; external loc_of_binding : binding -> Loc.t = "%field0"; external loc_of_rec_binding : rec_binding -> Loc.t = "%field0"; external loc_of_module_binding : module_binding -> Loc.t = "%field0"; external loc_of_match_case : match_case -> Loc.t = "%field0"; external loc_of_ident : ident -> Loc.t = "%field0"; value ghost = Loc.ghost; value rec is_module_longident = fun [ <:ident< $_$.$i$ >> -> is_module_longident i | <:ident< $i1$ $i2$ >> -> is_module_longident i1 && is_module_longident i2 | <:ident< $uid:_$ >> -> True | _ -> False ]; value ident_of_expr = let error () = invalid_arg "ident_of_expr: this expression is not an identifier" in let rec self = fun [ <:expr@_loc< $e1$ $e2$ >> -> <:ident< $self e1$ $self e2$ >> | <:expr@_loc< $e1$.$e2$ >> -> <:ident< $self e1$.$self e2$ >> | <:expr< $lid:_$ >> -> error () | <:expr< $id:i$ >> -> if is_module_longident i then i else error () | _ -> error () ] in fun [ <:expr< $id:i$ >> -> i | <:expr< $_$ $_$ >> -> error () | t -> self t ]; value ident_of_ctyp = let error () = invalid_arg "ident_of_ctyp: this type is not an identifier" in let rec self = fun [ <:ctyp@_loc< $t1$ $t2$ >> -> <:ident< $self t1$ $self t2$ >> | <:ctyp< $lid:_$ >> -> error () | <:ctyp< $id:i$ >> -> if is_module_longident i then i else error () | _ -> error () ] in fun [ <:ctyp< $id:i$ >> -> i | t -> self t ]; value ident_of_patt = let error () = invalid_arg "ident_of_patt: this pattern is not an identifier" in let rec self = fun [ <:patt@_loc< $p1$ $p2$ >> -> <:ident< $self p1$ $self p2$ >> | <:patt< $lid:_$ >> -> error () | <:patt< $id:i$ >> -> if is_module_longident i then i else error () | _ -> error () ] in fun [ <:patt< $id:i$ >> -> i | p -> self p ]; value rec is_irrefut_patt = fun [ <:patt< $lid:_$ >> -> True | <:patt< () >> -> True | <:patt< _ >> -> True | <:patt<>> -> True (* why not *) | <:patt< ($x$ as $y$) >> -> is_irrefut_patt x && is_irrefut_patt y | <:patt< { $p$ } >> -> is_irrefut_patt p | <:patt< $_$ = $p$ >> -> is_irrefut_patt p | <:patt< $p1$; $p2$ >> -> is_irrefut_patt p1 && is_irrefut_patt p2 | <:patt< $p1$, $p2$ >> -> is_irrefut_patt p1 && is_irrefut_patt p2 | <:patt< $p1$ | $p2$ >> -> is_irrefut_patt p1 && is_irrefut_patt p2 (* could be more fine grained *) | <:patt< $p1$ $p2$ >> -> is_irrefut_patt p1 && is_irrefut_patt p2 | <:patt< ($p$ : $_$) >> -> is_irrefut_patt p | <:patt< ($tup:pl$) >> -> is_irrefut_patt pl | <:patt< ? $_$ >> -> True | <:patt< ? $_$ : ($p$) >> -> is_irrefut_patt p | <:patt< ? $_$ : ($p$ = $_$) >> -> is_irrefut_patt p | <:patt< ~ $_$ >> -> True | <:patt< ~ $_$ : $p$ >> -> is_irrefut_patt p | <:patt< lazy $p$ >> -> is_irrefut_patt p | Ast.PaAtt _loc _s _str p -> is_irrefut_patt p | <:patt< $id:_$ >> -> False (* here one need to know the arity of constructors *) | <:patt< (module $_$) >> -> True | Ast.PaExc _loc p -> is_irrefut_patt p | <:patt< `$_$ >> | <:patt< $str:_$ >> | <:patt< $_$ .. $_$ >> | <:patt< $flo:_$ >> | <:patt< $nativeint:_$ >> | <:patt< $int64:_$ >> | <:patt< $int32:_$ >> | <:patt< $int:_$ >> | <:patt< $chr:_$ >> | <:patt< #$_$ >> | <:patt< [| $_$ |] >> | <:patt< $anti:_$ >> -> False ]; value rec is_constructor = fun [ <:ident< $_$.$i$ >> -> is_constructor i | <:ident< $uid:_$ >> -> True | <:ident< $lid:_$ >> | <:ident< $_$ $_$ >> -> False | <:ident< $anti:_$ >> -> assert False ]; value is_patt_constructor = fun [ <:patt< $id:i$ >> -> is_constructor i | <:patt< `$_$ >> -> True | _ -> False ]; value rec is_expr_constructor = fun [ <:expr< $id:i$ >> -> is_constructor i | <:expr< $e1$.$e2$ >> -> is_expr_constructor e1 && is_expr_constructor e2 | <:expr< `$_$ >> -> True | _ -> False ]; value rec tyOr_of_list = fun [ [] -> <:ctyp@ghost<>> | [t] -> t | [t::ts] -> let _loc = loc_of_ctyp t in <:ctyp< $t$ | $tyOr_of_list ts$ >> ]; value rec tyAnd_of_list = fun [ [] -> <:ctyp@ghost<>> | [t] -> t | [t::ts] -> let _loc = loc_of_ctyp t in <:ctyp< $t$ and $tyAnd_of_list ts$ >> ]; value rec tySem_of_list = fun [ [] -> <:ctyp@ghost<>> | [t] -> t | [t::ts] -> let _loc = loc_of_ctyp t in <:ctyp< $t$ ; $tySem_of_list ts$ >> ]; value rec tyCom_of_list = fun [ [] -> <:ctyp@ghost<>> | [t] -> t | [t::ts] -> let _loc = loc_of_ctyp t in <:ctyp< $t$, $tyCom_of_list ts$ >> ]; value rec tyAmp_of_list = fun [ [] -> <:ctyp@ghost<>> | [t] -> t | [t::ts] -> let _loc = loc_of_ctyp t in <:ctyp< $t$ & $tyAmp_of_list ts$ >> ]; value rec tySta_of_list = fun [ [] -> <:ctyp@ghost<>> | [t] -> t | [t::ts] -> let _loc = loc_of_ctyp t in <:ctyp< $t$ * $tySta_of_list ts$ >> ]; value rec stSem_of_list = fun [ [] -> <:str_item@ghost<>> | [t] -> t | [t::ts] -> let _loc = loc_of_str_item t in <:str_item< $t$ ; $stSem_of_list ts$ >> ]; value rec sgSem_of_list = fun [ [] -> <:sig_item@ghost<>> | [t] -> t | [t::ts] -> let _loc = loc_of_sig_item t in <:sig_item< $t$ ; $sgSem_of_list ts$ >> ]; value rec biAnd_of_list = fun [ [] -> <:binding@ghost<>> | [b] -> b | [b::bs] -> let _loc = loc_of_binding b in <:binding< $b$ and $biAnd_of_list bs$ >> ]; value rec rbSem_of_list = fun [ [] -> <:rec_binding@ghost<>> | [b] -> b | [b::bs] -> let _loc = loc_of_rec_binding b in <:rec_binding< $b$; $rbSem_of_list bs$ >> ]; value rec wcAnd_of_list = fun [ [] -> <:with_constr@ghost<>> | [w] -> w | [w::ws] -> let _loc = loc_of_with_constr w in <:with_constr< $w$ and $wcAnd_of_list ws$ >> ]; value rec idAcc_of_list = fun [ [] -> assert False | [i] -> i | [i::is] -> let _loc = loc_of_ident i in <:ident< $i$ . $idAcc_of_list is$ >> ]; value rec idApp_of_list = fun [ [] -> assert False | [i] -> i | [i::is] -> let _loc = loc_of_ident i in <:ident< $i$ $idApp_of_list is$ >> ]; value rec mcOr_of_list = fun [ [] -> <:match_case@ghost<>> | [x] -> x | [x::xs] -> let _loc = loc_of_match_case x in <:match_case< $x$ | $mcOr_of_list xs$ >> ]; value rec mbAnd_of_list = fun [ [] -> <:module_binding@ghost<>> | [x] -> x | [x::xs] -> let _loc = loc_of_module_binding x in <:module_binding< $x$ and $mbAnd_of_list xs$ >> ]; value rec meApp_of_list = fun [ [] -> assert False | [x] -> x | [x::xs] -> let _loc = loc_of_module_expr x in <:module_expr< $x$ $meApp_of_list xs$ >> ]; value rec ceAnd_of_list = fun [ [] -> <:class_expr@ghost<>> | [x] -> x | [x::xs] -> let _loc = loc_of_class_expr x in <:class_expr< $x$ and $ceAnd_of_list xs$ >> ]; value rec ctAnd_of_list = fun [ [] -> <:class_type@ghost<>> | [x] -> x | [x::xs] -> let _loc = loc_of_class_type x in <:class_type< $x$ and $ctAnd_of_list xs$ >> ]; value rec cgSem_of_list = fun [ [] -> <:class_sig_item@ghost<>> | [x] -> x | [x::xs] -> let _loc = loc_of_class_sig_item x in <:class_sig_item< $x$; $cgSem_of_list xs$ >> ]; value rec crSem_of_list = fun [ [] -> <:class_str_item@ghost<>> | [x] -> x | [x::xs] -> let _loc = loc_of_class_str_item x in <:class_str_item< $x$; $crSem_of_list xs$ >> ]; value rec paSem_of_list = fun [ [] -> <:patt@ghost<>> | [x] -> x | [x::xs] -> let _loc = loc_of_patt x in <:patt< $x$; $paSem_of_list xs$ >> ]; value rec paCom_of_list = fun [ [] -> <:patt@ghost<>> | [x] -> x | [x::xs] -> let _loc = loc_of_patt x in <:patt< $x$, $paCom_of_list xs$ >> ]; value rec exSem_of_list = fun [ [] -> <:expr@ghost<>> | [x] -> x | [x::xs] -> let _loc = loc_of_expr x in <:expr< $x$; $exSem_of_list xs$ >> ]; value rec exCom_of_list = fun [ [] -> <:expr@ghost<>> | [x] -> x | [x::xs] -> let _loc = loc_of_expr x in <:expr< $x$, $exCom_of_list xs$ >> ]; value ty_of_stl = fun [ (_loc, s, []) -> <:ctyp< $uid:s$ >> | (_loc, s, tl) -> <:ctyp< $uid:s$ of $tyAnd_of_list tl$ >> ]; value ty_of_sbt = fun [ (_loc, s, True, t) -> <:ctyp< $lid:s$ : mutable $t$ >> | (_loc, s, False, t) -> <:ctyp< $lid:s$ : $t$ >> ]; value bi_of_pe (p, e) = let _loc = loc_of_patt p in <:binding< $p$ = $e$ >>; value sum_type_of_list l = tyOr_of_list (List.map ty_of_stl l); value record_type_of_list l = tySem_of_list (List.map ty_of_sbt l); value binding_of_pel l = biAnd_of_list (List.map bi_of_pe l); value rec pel_of_binding = fun [ <:binding< $b1$ and $b2$ >> -> pel_of_binding b1 @ pel_of_binding b2 | <:binding< $p$ = $e$ >> -> [(p, e)] | _ -> assert False ]; value rec list_of_binding x acc = match x with [ <:binding< $b1$ and $b2$ >> -> list_of_binding b1 (list_of_binding b2 acc) | t -> [t :: acc] ]; value rec list_of_rec_binding x acc = match x with [ <:rec_binding< $b1$; $b2$ >> -> list_of_rec_binding b1 (list_of_rec_binding b2 acc) | t -> [t :: acc] ]; value rec list_of_with_constr x acc = match x with [ <:with_constr< $w1$ and $w2$ >> -> list_of_with_constr w1 (list_of_with_constr w2 acc) | t -> [t :: acc] ]; value rec list_of_ctyp x acc = match x with [ <:ctyp<>> -> acc | <:ctyp< $x$ & $y$ >> | <:ctyp< $x$, $y$ >> | <:ctyp< $x$ * $y$ >> | <:ctyp< $x$; $y$ >> | <:ctyp< $x$ and $y$ >> | <:ctyp< $x$ | $y$ >> -> list_of_ctyp x (list_of_ctyp y acc) | x -> [x :: acc] ]; value rec list_of_patt x acc = match x with [ <:patt<>> -> acc | <:patt< $x$, $y$ >> | <:patt< $x$; $y$ >> -> list_of_patt x (list_of_patt y acc) | x -> [x :: acc] ]; value rec list_of_expr x acc = match x with [ <:expr<>> -> acc | <:expr< $x$, $y$ >> | <:expr< $x$; $y$ >> -> list_of_expr x (list_of_expr y acc) | x -> [x :: acc] ]; value rec list_of_str_item x acc = match x with [ <:str_item<>> -> acc | <:str_item< $x$; $y$ >> -> list_of_str_item x (list_of_str_item y acc) | x -> [x :: acc] ]; value rec list_of_sig_item x acc = match x with [ <:sig_item<>> -> acc | <:sig_item< $x$; $y$ >> -> list_of_sig_item x (list_of_sig_item y acc) | x -> [x :: acc] ]; value rec list_of_class_sig_item x acc = match x with [ <:class_sig_item<>> -> acc | <:class_sig_item< $x$; $y$ >> -> list_of_class_sig_item x (list_of_class_sig_item y acc) | x -> [x :: acc] ]; value rec list_of_class_str_item x acc = match x with [ <:class_str_item<>> -> acc | <:class_str_item< $x$; $y$ >> -> list_of_class_str_item x (list_of_class_str_item y acc) | x -> [x :: acc] ]; value rec list_of_class_type x acc = match x with [ <:class_type< $x$ and $y$ >> -> list_of_class_type x (list_of_class_type y acc) | x -> [x :: acc] ]; value rec list_of_class_expr x acc = match x with [ <:class_expr< $x$ and $y$ >> -> list_of_class_expr x (list_of_class_expr y acc) | x -> [x :: acc] ]; value rec list_of_module_expr x acc = match x with [ <:module_expr< $x$ $y$ >> -> list_of_module_expr x (list_of_module_expr y acc) | x -> [x :: acc] ]; value rec list_of_match_case x acc = match x with [ <:match_case<>> -> acc | <:match_case< $x$ | $y$ >> -> list_of_match_case x (list_of_match_case y acc) | x -> [x :: acc] ]; value rec list_of_ident x acc = match x with [ <:ident< $x$ . $y$ >> | <:ident< $x$ $y$ >> -> list_of_ident x (list_of_ident y acc) | x -> [x :: acc] ]; value rec list_of_module_binding x acc = match x with [ <:module_binding< $x$ and $y$ >> -> list_of_module_binding x (list_of_module_binding y acc) | x -> [x :: acc] ]; module Camlp4Trash = struct INCLUDE "camlp4/Camlp4/Camlp4Ast.partial.ml"; end; module Meta = struct module type META_LOC = sig (** The first location is where to put the returned pattern. Generally it's _loc to match with <:patt< ... >> quotations. The second location is the one to treat. *) value meta_loc_patt : Loc.t -> Loc.t -> Ast.patt; (** The first location is where to put the returned expression. Generally it's _loc to match with <:expr< ... >> quotations. The second location is the one to treat. *) value meta_loc_expr : Loc.t -> Loc.t -> Ast.expr; end; module MetaLoc = struct value meta_loc_patt _loc location = let (a, b, c, d, e, f, g, h) = Loc.to_tuple location in <:patt< Loc.of_tuple ($`str:a$, $`int:b$, $`int:c$, $`int:d$, $`int:e$, $`int:f$, $`int:g$, $if h then <:patt< True >> else <:patt< False >> $) >>; value meta_loc_expr _loc location = let (a, b, c, d, e, f, g, h) = Loc.to_tuple location in <:expr< Loc.of_tuple ($`str:a$, $`int:b$, $`int:c$, $`int:d$, $`int:e$, $`int:f$, $`int:g$, $if h then <:expr< True >> else <:expr< False >> $) >>; end; module MetaGhostLoc = struct value meta_loc_patt _loc _ = <:patt< Loc.ghost >>; value meta_loc_expr _loc _ = <:expr< Loc.ghost >>; end; module MetaLocVar = struct value meta_loc_patt _loc _ = <:patt< $lid:Loc.name.val$ >>; value meta_loc_expr _loc _ = <:expr< $lid:Loc.name.val$ >>; end; module Make (MetaLoc : META_LOC) = struct open MetaLoc; value meta_loc = meta_loc_expr; module Expr = Camlp4Filters.MetaGeneratorExpr Ast; value meta_loc = meta_loc_patt; module Patt = Camlp4Filters.MetaGeneratorPatt Ast; end; end; class map = Camlp4MapGenerator.generated; class fold = Camlp4FoldGenerator.generated; value map_expr f = object inherit map as super; method expr x = f (super#expr x); end; value map_patt f = object inherit map as super; method patt x = f (super#patt x); end; value map_ctyp f = object inherit map as super; method ctyp x = f (super#ctyp x); end; value map_str_item f = object inherit map as super; method str_item x = f (super#str_item x); end; value map_sig_item f = object inherit map as super; method sig_item x = f (super#sig_item x); end; value map_loc f = object inherit map as super; method loc x = f (super#loc x); end; end; camlp4-5.3-1/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml000066400000000000000000001677261473134377200223110ustar00rootroot00000000000000(* camlp4r *) (****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2002-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) (* We copy the implementation of a few functions from OCaml to avoid depending on its implementation. *) module Location = struct type t = Location.t == { loc_start: Lexing.position; loc_end: Lexing.position; loc_ghost: bool; }; type loc 'a = Location.loc 'a == { txt : 'a; loc : t; }; value none = let loc = { Lexing. pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; pos_cnum = -1; } in { loc_start = loc; loc_end = loc; loc_ghost = True }; value mkloc txt loc = { txt; loc }; end; module Longident = struct type t = Longident.t == [ Lident of string | Ldot of t and string | Lapply of t and t ]; value last = fun [ Lident s -> s | Ldot _ s -> s | Lapply _ _ -> failwith "Longident.last" ]; end; module Make (Ast : Sig.Camlp4Ast) = struct open Format; open Parsetree; open Longident; open Asttypes; open Ast; value error loc str = Loc.raise loc (Failure str); value char_of_char_token loc s = try Token.Eval.char s with [ Failure _ as exn -> Loc.raise loc exn ] ; value string_of_string_token loc s = try Token.Eval.string s with [ Failure _ as exn -> Loc.raise loc exn ] ; value remove_underscores s = let s = Bytes.of_string s in let l = Bytes.length s in let rec remove src dst = if src >= l then if dst >= l then s else Bytes.sub s 0 dst else match Bytes.get s src with [ '_' -> remove (src + 1) dst | c -> do { Bytes.set s dst c; remove (src + 1) (dst + 1) } ] in Bytes.to_string (remove 0 0) ; value mkloc = Loc.to_ocaml_location; value mkghloc loc = Loc.to_ocaml_location (Loc.ghostify loc); value with_loc txt loc = Location.mkloc txt (mkloc loc); value mktyp loc d = {ptyp_desc = d; ptyp_loc = mkloc loc; ptyp_attributes = [];ptyp_loc_stack=[]}; value mkpat loc d = {ppat_desc = d; ppat_loc = mkloc loc; ppat_attributes = [];ppat_loc_stack=[]}; value mkghpat loc d = {ppat_desc = d; ppat_loc = mkghloc loc; ppat_attributes = [];ppat_loc_stack=[]}; value mkexp loc d = {pexp_desc = d; pexp_loc = mkloc loc; pexp_attributes = [];pexp_loc_stack=[]}; value mkmty loc d = {pmty_desc = d; pmty_loc = mkloc loc; pmty_attributes = []}; value mksig loc d = {psig_desc = d; psig_loc = mkloc loc}; value mkmod loc d = {pmod_desc = d; pmod_loc = mkloc loc; pmod_attributes = []}; value mkstr loc d = {pstr_desc = d; pstr_loc = mkloc loc}; value mkcty loc d = {pcty_desc = d; pcty_loc = mkloc loc; pcty_attributes = []}; value mkcl loc d = {pcl_desc = d; pcl_loc = mkloc loc; pcl_attributes = []}; value mkcf loc d = { pcf_desc = d; pcf_loc = mkloc loc; pcf_attributes = []}; value mkctf loc d = { pctf_desc = d; pctf_loc = mkloc loc; pctf_attributes = []}; value mkvirtual = fun [ <:virtual_flag< virtual >> -> Virtual | <:virtual_flag<>> -> Concrete | _ -> assert False ]; value mkdirection = fun [ <:direction_flag< to >> -> Upto | <:direction_flag< downto >> -> Downto | _ -> assert False ]; value lident s = Lident s; value lident_with_loc s loc = with_loc (Lident s) loc; value ldot l s = Ldot l s; value lapply l s = Lapply l s; value conv_con = let t = Hashtbl.create 73 in do { List.iter (fun (s, s') -> Hashtbl.add t s s') [("True", "true"); ("False", "false"); (" True", "True"); (" False", "False")]; fun s -> try Hashtbl.find t s with [ Not_found -> s ] } ; value conv_lab = let t = Hashtbl.create 73 in do { List.iter (fun (s, s') -> Hashtbl.add t s s') [("val", "contents")]; fun s -> try Hashtbl.find t s with [ Not_found -> s ] } ; value array_function_no_loc str name = ldot (lident str) (if Camlp4_config.unsafe.val then "unsafe_" ^ name else name) ; value array_function loc str name = with_loc (array_function_no_loc str name) loc; value mkrf = fun [ Ast.ReRecursive -> Recursive | Ast.ReNonrecursive | Ast.ReNil -> Nonrecursive | _ -> assert False ]; value mknrf = fun [ Ast.ReNonrecursive -> Nonrecursive | Ast.ReRecursive | Ast.ReNil -> Recursive | _ -> assert False ]; value mkli sloc s list = with_loc (loop lident list) sloc where rec loop f = fun [ [i :: il] -> loop (ldot (f i)) il | [] -> f s ] ; value rec ctyp_fa al = fun [ TyApp _ f a -> ctyp_fa [a :: al] f | f -> (f, al) ] ; value ident_tag ?(conv_lid = fun x -> x) i = let rec self i acc = match i with [ <:ident< $i1$.$i2$ >> -> self i2 (Some (self i1 acc)) | <:ident< $i1$ $i2$ >> -> let i' = Lapply (fst (self i1 None)) (fst (self i2 None)) in let x = match acc with [ None -> i' | _ -> error (loc_of_ident i) "invalid long identifier" ] in (x, `app) | <:ident< $uid:s$ >> -> let x = match acc with [ None -> lident s | Some (acc, `uident | `app) -> ldot acc s | _ -> error (loc_of_ident i) "invalid long identifier" ] in (x, `uident) | <:ident< $lid:s$ >> -> let x = match acc with [ None -> lident (conv_lid s) | Some (acc, `uident | `app) -> ldot acc (conv_lid s) | _ -> error (loc_of_ident i) "invalid long identifier" ] in (x, `lident) | _ -> error (loc_of_ident i) "invalid long identifier" ] in self i None; value ident_noloc ?conv_lid i = fst (ident_tag ?conv_lid i); value ident ?conv_lid i = with_loc (ident_noloc ?conv_lid i) (loc_of_ident i); value long_lident msg id = match ident_tag id with [ (i, `lident) -> with_loc i (loc_of_ident id) | _ -> error (loc_of_ident id) msg ] ; value long_type_ident = long_lident "invalid long identifier type"; value long_class_ident = long_lident "invalid class name"; value long_uident_noloc ?(conv_con = fun x -> x) i = match ident_tag i with [ (Ldot i s, `uident) -> ldot i (conv_con s) | (Lident s, `uident) -> lident (conv_con s) | (i, `app) -> i | _ -> error (loc_of_ident i) "uppercase identifier expected" ] ; value long_uident ?conv_con i = with_loc (long_uident_noloc ?conv_con i) (loc_of_ident i); value rec ctyp_long_id_prefix t = match t with [ <:ctyp< $id:i$ >> -> ident_noloc i | <:ctyp< $m1$ $m2$ >> -> let li1 = ctyp_long_id_prefix m1 in let li2 = ctyp_long_id_prefix m2 in Lapply li1 li2 | t -> error (loc_of_ctyp t) "invalid module expression" ] ; value ctyp_long_id t = match t with [ <:ctyp< $id:i$ >> -> (False, long_type_ident i) | TyApp loc _ _ -> error loc "invalid type name" | TyCls _ i -> (True, ident i) | t -> error (loc_of_ctyp t) "invalid type" ] ; value rec ty_var_list_of_ctyp = fun [ <:ctyp< $t1$ $t2$ >> -> ty_var_list_of_ctyp t1 @ ty_var_list_of_ctyp t2 | <:ctyp@loc< '$s$ >> -> [with_loc s loc] | _ -> assert False ]; value attribute_fwd = ref (fun _ _ _ -> assert False); value attribute loc s str = !attribute_fwd loc s str; value rec ctyp = fun [ TyId loc i -> let li = long_type_ident i in mktyp loc (Ptyp_constr li []) | TyAli loc t1 t2 -> let (t, i) = match (t1, t2) with [ (t, TyQuo _ s) -> (t, s) | (TyQuo _ s, t) -> (t, s) | _ -> error loc "invalid alias type" ] in mktyp loc (Ptyp_alias (ctyp t, with_loc i loc)) | TyAny loc -> mktyp loc Ptyp_any | TyApp loc _ _ as f -> let (f, al) = ctyp_fa [] f in let (is_cls, li) = ctyp_long_id f in if is_cls then mktyp loc (Ptyp_class li (List.map ctyp al)) else mktyp loc (Ptyp_constr li (List.map ctyp al)) | TyArr loc (TyLab _ lab t1) t2 -> mktyp loc (Ptyp_arrow (Labelled lab) (ctyp t1) (ctyp t2)) | TyArr loc (TyOlb _ lab t1) t2 -> mktyp loc (Ptyp_arrow (Optional lab) (ctyp t1) (ctyp t2)) | TyArr loc t1 t2 -> mktyp loc (Ptyp_arrow Nolabel (ctyp t1) (ctyp t2)) | <:ctyp@loc< < $fl$ > >> -> mktyp loc (Ptyp_object (meth_list fl []) Closed) | <:ctyp@loc< < $fl$ .. > >> -> mktyp loc (Ptyp_object (meth_list fl []) Open) | TyCls loc id -> mktyp loc (Ptyp_class (ident id) []) | <:ctyp@loc< (module $pt$) >> -> let (i, cs) = package_type pt in mktyp loc (Ptyp_package i cs) | TyAtt loc s str e -> let e = ctyp e in {(e) with ptyp_attributes = e.ptyp_attributes @ [attribute loc s str]} | TyLab loc _ _ -> error loc "labelled type not allowed here" | TyMan loc _ _ -> error loc "manifest type not allowed here" | TyOlb loc _ _ -> error loc "labelled type not allowed here" | TyPol loc t1 t2 -> mktyp loc (Ptyp_poly (ty_var_list_of_ctyp t1) (ctyp t2)) | TyQuo loc s -> mktyp loc (Ptyp_var s) | TyRec loc _ -> error loc "record type not allowed here" | TySum loc _ -> error loc "sum type not allowed here" | TyPrv loc _ -> error loc "private type not allowed here" | TyMut loc _ -> error loc "mutable type not allowed here" | TyOr loc _ _ -> error loc "type1 | type2 not allowed here" | TyAnd loc _ _ -> error loc "type1 and type2 not allowed here" | TyOf loc _ _ -> error loc "type1 of type2 not allowed here" | TyCol loc _ _ -> error loc "type1 : type2 not allowed here" | TySem loc _ _ -> error loc "type1 ; type2 not allowed here" | TyTypePol loc _ _ -> error loc "locally abstract type not allowed here" | <:ctyp@loc< ($t1$ * $t2$) >> -> mktyp loc (Ptyp_tuple (List.map ctyp (list_of_ctyp t1 (list_of_ctyp t2 [])))) | <:ctyp@loc< [ = $t$ ] >> -> mktyp loc (Ptyp_variant (row_field t) Closed None) | <:ctyp@loc< [ > $t$ ] >> -> mktyp loc (Ptyp_variant (row_field t) Open None) | <:ctyp@loc< [ < $t$ ] >> -> mktyp loc (Ptyp_variant (row_field t) Closed (Some [])) | <:ctyp@loc< [ < $t$ > $t'$ ] >> -> mktyp loc (Ptyp_variant (row_field t) Closed (Some (name_tags t'))) | TyAnt loc _ -> error loc "antiquotation not allowed here" | TyOfAmp loc _ _ | TyAmp loc _ _ | TySta loc _ _ | TyCom loc _ _ | TyVrn loc _ | TyQuM loc _ | TyQuP loc _ | TyDcl loc _ _ _ _ | TyExt loc _ _ _ | TyAnP loc | TyAnM loc | TyObj loc _ (RvAnt _) | TyNil loc | TyOpn loc | TyTup loc _ -> error loc "this construction is not allowed here" ] and row_field = let mk loc x = { prf_loc = mkloc loc; prf_desc = x; prf_attributes = [] } in fun [ <:ctyp<>> -> [] | <:ctyp@loc< `$i$ >> -> [mk loc (Rtag (with_loc (conv_con i) loc) True [])] | <:ctyp@loc< `$i$ of & $t$ >> -> [mk loc (Rtag (with_loc (conv_con i) loc) True (List.map ctyp (list_of_ctyp t [])))] | <:ctyp@loc< `$i$ of $t$ >> -> [mk loc (Rtag (with_loc (conv_con i) loc) False (List.map ctyp (list_of_ctyp t [])))] | <:ctyp< $t1$ | $t2$ >> -> row_field t1 @ row_field t2 | t -> [mk (Ast.loc_of_ctyp t) (Rinherit (ctyp t))] ] and name_tags = fun [ <:ctyp< $t1$ $t2$ >> -> name_tags t1 @ name_tags t2 | <:ctyp< `$s$ >> -> [s] | _ -> assert False ] and meth_list fl acc = match fl with [ <:ctyp<>> -> acc | <:ctyp< $t1$; $t2$ >> -> meth_list t1 (meth_list t2 acc) | <:ctyp@loc< $lid:lab$ : $t$ >> -> [{ pof_loc = mkloc loc ; pof_desc = Otag (with_loc lab loc) (ctyp t) ; pof_attributes = []} :: acc] | _ -> assert False ] and package_type_constraints wc acc = match wc with [ <:with_constr<>> -> acc | <:with_constr< type $id:id$ = $ct$ >> -> [(ident id, ctyp ct) :: acc] | <:with_constr< $wc1$ and $wc2$ >> -> package_type_constraints wc1 (package_type_constraints wc2 acc) | _ -> error (loc_of_with_constr wc) "unexpected `with constraint' for a package type" ] and package_type : module_type -> package_type = fun [ <:module_type< $id:i$ with $wc$ >> -> (long_uident i, package_type_constraints wc []) | <:module_type< $id:i$ >> -> (long_uident i, []) | mt -> error (loc_of_module_type mt) "unexpected package type" ] ; value mktype loc name tl cl tk tp tm = {ptype_name = name; ptype_params = tl; ptype_cstrs = cl; ptype_kind = tk; ptype_private = tp; ptype_manifest = tm; ptype_loc = mkloc loc; ptype_attributes = []} ; value mktypext loc path tl tc tp = {ptyext_loc=loc; ptyext_path = path; ptyext_params = tl; ptyext_constructors = tc; ptyext_private = tp; ptyext_attributes = []} ; value mkprivate' m = if m then Private else Public; value mkprivate = fun [ <:private_flag< private >> -> Private | <:private_flag<>> -> Public | _ -> assert False ]; value mktrecord = fun [ <:ctyp@loc< $id:(<:ident@sloc< $lid:s$ >>)$ : mutable $t$ >> -> {pld_name=with_loc s sloc; pld_mutable=Mutable; pld_type=ctyp t; pld_loc=mkloc loc; pld_attributes=[]; } | <:ctyp@loc< $id:(<:ident@sloc< $lid:s$ >>)$ : $t$ >> -> {pld_name=with_loc s sloc; pld_mutable=Immutable; pld_type=ctyp t; pld_loc=mkloc loc; pld_attributes=[]; } | _ -> assert False (*FIXME*) ]; value mkvariant = fun [ <:ctyp@loc< $id:(<:ident@sloc< $uid:s$ >>)$ >> -> { pcd_name = with_loc (conv_con s) sloc ; pcd_args = Pcstr_tuple [] ; pcd_res = None ; pcd_loc = mkloc loc ; pcd_attributes = [] ; pcd_vars = [] } | <:ctyp@loc< $id:(<:ident@sloc< $uid:s$ >>)$ of $t$ >> -> { pcd_name = with_loc (conv_con s) sloc ; pcd_args = Pcstr_tuple (List.map ctyp (list_of_ctyp t [])) ; pcd_res = None ; pcd_loc = mkloc loc ; pcd_attributes = [] ; pcd_vars = [] } | <:ctyp@loc< $id:(<:ident@sloc< $uid:s$ >>)$ : ($t$ -> $u$) >> -> { pcd_name = with_loc (conv_con s) sloc ; pcd_args = Pcstr_tuple (List.map ctyp (list_of_ctyp t [])) ; pcd_res = Some (ctyp u) ; pcd_loc = mkloc loc ; pcd_attributes = [] ; pcd_vars = [] } | <:ctyp@loc< $id:(<:ident@sloc< $uid:s$ >>)$ : $t$ >> -> { pcd_name = with_loc (conv_con s) sloc ; pcd_args = Pcstr_tuple [] ; pcd_res = Some (ctyp t) ; pcd_loc = mkloc loc ; pcd_attributes = [] ; pcd_vars = [] } | _ -> assert False (*FIXME*) ]; value mkextension_constructor = fun [ <:ctyp@loc< $id:(<:ident@sloc< $uid:s$ >>)$ >> -> {pext_name = with_loc (conv_con s) sloc; pext_kind = Pext_decl [] (Pcstr_tuple []) None; pext_loc = mkloc loc; pext_attributes = []} | <:ctyp@loc< $id:(<:ident@sloc< $uid:s$ >>)$ of $t$ >> -> {pext_name = with_loc (conv_con s) sloc; pext_kind = Pext_decl [] (Pcstr_tuple (List.map ctyp (list_of_ctyp t []))) None; pext_loc = mkloc loc; pext_attributes = []} | <:ctyp@loc< $id:(<:ident@sloc< $uid:s$ >>)$ : ($t$ -> $u$) >> -> {pext_name = with_loc (conv_con s) sloc; pext_kind = Pext_decl [] (Pcstr_tuple (List.map ctyp (list_of_ctyp t []))) (Some (ctyp u)); pext_loc = mkloc loc; pext_attributes = []} | <:ctyp@loc< $id:(<:ident@sloc< $uid:s$ >>)$ : $t$ >> -> {pext_name = with_loc (conv_con s) sloc; pext_kind = Pext_decl [] (Pcstr_tuple []) (Some (ctyp t)); pext_loc = mkloc loc; pext_attributes = []} | <:ctyp@loc< $id:(<:ident@sloc< $uid:s$ >>)$ == $id:r$ >> -> {pext_name = with_loc (conv_con s) sloc; pext_kind = Pext_rebind (long_uident r); pext_loc = mkloc loc; pext_attributes = []} | _ -> assert False (*FIXME*) ]; value rec type_decl name tl cl loc m pflag = fun [ <:ctyp< $t1$ == $t2$ >> -> type_decl name tl cl loc (Some (ctyp t1)) pflag t2 | <:ctyp@_loc< private $t$ >> -> if pflag then error _loc "multiple private keyword used, use only one instead" else type_decl name tl cl loc m True t | <:ctyp< { $t$ } >> -> mktype loc name tl cl (Ptype_record (List.map mktrecord (list_of_ctyp t []))) (mkprivate' pflag) m | <:ctyp< [ $t$ ] >> -> mktype loc name tl cl (Ptype_variant (List.map mkvariant (list_of_ctyp t []))) (mkprivate' pflag) m | TyOpn loc -> mktype loc name tl cl Ptype_open (mkprivate' pflag) m | t -> if m <> None then error loc "only one manifest type allowed by definition" else let m = match t with [ <:ctyp<>> -> None | _ -> Some (ctyp t) ] in mktype loc name tl cl Ptype_abstract (mkprivate' pflag) m ] ; value rec type_ext path tl loc pflag = fun [ <:ctyp@_loc< $_$ == $_$ >> -> error _loc "manifest type not allowed for extensions" | <:ctyp@_loc< private $t$ >> -> if pflag then error _loc "multiple private keyword used, use only one instead" else type_ext path tl loc True t | <:ctyp< [ $t$ ] >> -> mktypext (mkloc loc) path tl (List.map mkextension_constructor (list_of_ctyp t [])) (mkprivate' pflag) | _ -> error loc "invalid type extension" ] ; value type_decl name tl cl t loc = type_decl name tl cl loc None False t; value type_ext path tl t loc = type_ext path tl loc False t; value mkvalue_desc loc name t p = {pval_name = name; pval_type = ctyp t; pval_prim = p; pval_loc = mkloc loc; pval_attributes = []}; value rec list_of_meta_list = fun [ Ast.LNil -> [] | Ast.LCons x xs -> [x :: list_of_meta_list xs] | Ast.LAnt _ -> assert False ]; value mkmutable = fun [ <:mutable_flag< mutable >> -> Mutable | <:mutable_flag<>> -> Immutable | _ -> assert False ]; value paolab lab p = match (lab, p) with [ ("", <:patt< $lid:i$ >> | <:patt< ($lid:i$ : $_$) >>) -> i | ("", p) -> error (loc_of_patt p) "bad ast in label" | _ -> lab ] ; value opt_private_ctyp = fun [ <:ctyp< private $t$ >> -> (Ptype_abstract, Private, ctyp t) | t -> (Ptype_abstract, Public, ctyp t) ]; value rec type_parameters t acc = match t with [ <:ctyp< $t1$ $t2$ >> -> type_parameters t1 (type_parameters t2 acc) | <:ctyp< +'$s$ >> -> [(s, (Covariant, NoInjectivity)) :: acc] | <:ctyp< -'$s$ >> -> [(s, (Contravariant, NoInjectivity)) :: acc] | <:ctyp< '$s$ >> -> [(s, (NoVariance, NoInjectivity)) :: acc] | _ -> assert False ]; value core_type loc ty = { ptyp_desc = ty ; ptyp_loc = mkloc loc ; ptyp_attributes = [] ; ptyp_loc_stack = [] }; value ptyp_var loc s = core_type loc (Ptyp_var s); value ptyp_any loc = core_type loc Ptyp_any; value rec optional_type_parameters t acc = match t with [ <:ctyp< $t1$ $t2$ >> -> optional_type_parameters t1 (optional_type_parameters t2 acc) | <:ctyp@loc< +'$s$ >> -> [(ptyp_var loc s, (Covariant, NoInjectivity)) :: acc] | Ast.TyAnP loc -> [(ptyp_any loc, (Covariant, NoInjectivity)) :: acc] | <:ctyp@loc< -'$s$ >> -> [(ptyp_var loc s, (Contravariant, NoInjectivity)) :: acc] | Ast.TyAnM loc -> [(ptyp_any loc, (Contravariant, NoInjectivity)) :: acc] | <:ctyp@loc< '$s$ >> -> [(ptyp_var loc s, (NoVariance, NoInjectivity)) :: acc] | Ast.TyAny loc -> [(ptyp_any loc, (NoVariance, NoInjectivity)) :: acc] | _ -> assert False ]; value rec class_parameters t acc = match t with [ <:ctyp< $t1$, $t2$ >> -> class_parameters t1 (class_parameters t2 acc) | <:ctyp@loc< +'$s$ >> -> [(ptyp_var loc s, (Covariant, NoInjectivity)) :: acc] | <:ctyp@loc< -'$s$ >> -> [(ptyp_var loc s, (Contravariant, NoInjectivity)) :: acc] | <:ctyp@loc< '$s$ >> -> [(ptyp_var loc s, (NoVariance, NoInjectivity)) :: acc] | _ -> assert False ]; value rec type_parameters_and_type_name t acc = match t with [ <:ctyp< $t1$ $t2$ >> -> type_parameters_and_type_name t1 (optional_type_parameters t2 acc) | <:ctyp< $id:i$ >> -> (ident i, acc) | _ -> assert False ]; value mkwithtyp pwith_type loc id_tpl ct = let (id, tpl) = type_parameters_and_type_name id_tpl [] in let (kind, priv, ct) = opt_private_ctyp ct in pwith_type id { ptype_name = Location.mkloc (Longident.last id.txt) id.loc; ptype_params = tpl; ptype_cstrs = []; ptype_kind = kind; ptype_private = priv; ptype_manifest = Some ct; ptype_loc = mkloc loc; ptype_attributes = []; }; value rec mkwithc wc acc = match wc with [ <:with_constr<>> -> acc | <:with_constr@loc< type $id_tpl$ = $ct$ >> -> [mkwithtyp (fun lid x -> Pwith_type lid x) loc id_tpl ct :: acc] | <:with_constr< module $i1$ = $i2$ >> -> [(Pwith_module (long_uident i1) (long_uident i2)) :: acc] | <:with_constr@loc< type $id_tpl$ := $ct$ >> -> [mkwithtyp (fun lid x -> Pwith_typesubst lid x) loc id_tpl ct :: acc] | <:with_constr< module $i1$ := $i2$ >> (*WcMoS _ i1 i2*) -> [(Pwith_modsubst (long_uident i1) (long_uident i2)) :: acc] | <:with_constr< $wc1$ and $wc2$ >> -> mkwithc wc1 (mkwithc wc2 acc) | <:with_constr@loc< $anti:_$ >> -> error loc "bad with constraint (antiquotation)" ]; value rec patt_fa al = fun [ PaApp _ f a -> patt_fa [a :: al] f | f -> (f, al) ] ; value mkconst loc pconst_desc = {pconst_desc; pconst_loc = mkloc loc} ; value rec deep_mkrangepat loc c1 c2 = if c1 = c2 then mkghpat loc (Ppat_constant (mkconst loc (Pconst_char c1))) else mkghpat loc (Ppat_or (mkghpat loc (Ppat_constant (mkconst loc (Pconst_char c1)))) (deep_mkrangepat loc (Char.chr (Char.code c1 + 1)) c2)) ; value rec mkrangepat loc c1 c2 = if c1 > c2 then mkrangepat loc c2 c1 else if c1 = c2 then mkpat loc (Ppat_constant (mkconst loc (Pconst_char c1))) else mkpat loc (Ppat_or (mkghpat loc (Ppat_constant (mkconst loc (Pconst_char c1)))) (deep_mkrangepat loc (Char.chr (Char.code c1 + 1)) c2)) ; value rec patt = fun [ <:patt@loc< $id:(<:ident@sloc< $lid:s$ >>)$ >> -> mkpat loc (Ppat_var (with_loc s sloc)) | <:patt@loc< $id:i$ >> -> let p = Ppat_construct (long_uident ~conv_con i) None in mkpat loc p | PaAli loc p1 p2 -> let (p, i) = match (p1, p2) with [ (p, <:patt< $id:(<:ident@sloc< $lid:s$ >>)$ >>) -> (p, with_loc s sloc) | (<:patt< $id:(<:ident@sloc< $lid:s$ >>)$ >>, p) -> (p, with_loc s sloc) | _ -> error loc "invalid alias pattern" ] in mkpat loc (Ppat_alias (patt p) i) | PaAnt loc _ -> error loc "antiquotation not allowed here" | PaAny loc -> mkpat loc Ppat_any | <:patt@loc< $id:(<:ident@sloc< $uid:s$ >>)$ ($tup:<:patt@loc_any< _ >>$) >> -> mkpat loc (Ppat_construct (lident_with_loc (conv_con s) sloc) (Some ([], mkpat loc_any Ppat_any))) | PaApp loc _ _ as f -> let (f, al) = patt_fa [] f in let al = List.map patt al in match (patt f).ppat_desc with [ Ppat_construct li None -> let a = match al with [ [a] -> a | _ -> mkpat loc (Ppat_tuple al) ] in mkpat loc (Ppat_construct li (Some ([], a))) | Ppat_variant s None -> let a = match al with [ [a] -> a | _ -> mkpat loc (Ppat_tuple al) ] in mkpat loc (Ppat_variant s (Some a)) | _ -> error (loc_of_patt f) "this is not a constructor, it cannot be applied in a pattern" ] | PaArr loc p -> mkpat loc (Ppat_array (List.map patt (list_of_patt p []))) | PaChr loc s -> mkpat loc (Ppat_constant (mkconst loc (Pconst_char (char_of_char_token loc s)))) | PaInt loc s -> mkpat loc (Ppat_constant (mkconst loc (Pconst_integer (s, None)))) | PaInt32 loc s -> mkpat loc (Ppat_constant (mkconst loc (Pconst_integer (s, Some 'l')))) | PaInt64 loc s -> mkpat loc (Ppat_constant (mkconst loc (Pconst_integer (s, Some 'L')))) | PaNativeInt loc s -> mkpat loc (Ppat_constant (mkconst loc (Pconst_integer (s, Some 'n')))) | PaFlo loc s -> mkpat loc (Ppat_constant (mkconst loc (Pconst_float (remove_underscores s, None)))) | PaLab loc _ _ -> error loc "labeled pattern not allowed here" | PaOlb loc _ _ | PaOlbi loc _ _ _ -> error loc "labeled pattern not allowed here" | PaOrp loc p1 p2 -> mkpat loc (Ppat_or (patt p1) (patt p2)) | PaRng loc p1 p2 -> match (p1, p2) with [ (PaChr loc1 c1, PaChr loc2 c2) -> let c1 = char_of_char_token loc1 c1 in let c2 = char_of_char_token loc2 c2 in mkrangepat loc c1 c2 | _ -> error loc "range pattern allowed only for characters" ] | PaRec loc p -> let ps = list_of_patt p [] in let is_wildcard = fun [ <:patt< _ >> -> True | _ -> False ] in let (wildcards,ps) = List.partition is_wildcard ps in let is_closed = if wildcards = [] then Closed else Open in mkpat loc (Ppat_record (List.map mklabpat ps, is_closed)) | PaStr loc s -> mkpat loc (Ppat_constant (mkconst loc (Pconst_string (string_of_string_token loc s) (Loc.to_ocaml_location loc) None))) | <:patt@loc< ($p1$, $p2$) >> -> mkpat loc (Ppat_tuple (List.map patt (list_of_patt p1 (list_of_patt p2 [])))) | <:patt@loc< ($tup:_$) >> -> error loc "singleton tuple pattern" | PaTyc loc p t -> mkpat loc (Ppat_constraint (patt p) (ctyp t)) | PaTyp loc i -> mkpat loc (Ppat_type (long_type_ident i)) | PaVrn loc s -> mkpat loc (Ppat_variant (conv_con s) None) | PaLaz loc p -> mkpat loc (Ppat_lazy (patt p)) | PaMod loc m -> mkpat loc (Ppat_unpack (with_loc (Some m) loc)) | PaExc loc p -> mkpat loc (Ppat_exception (patt p)) | PaAtt loc s str e -> let e = patt e in {(e) with ppat_attributes = e.ppat_attributes @ [attribute loc s str]} | PaEq _ _ _ | PaSem _ _ _ | PaCom _ _ _ | PaNil _ as p -> error (loc_of_patt p) "invalid pattern" ] and mklabpat = fun [ <:patt< $i$ = $p$ >> -> (ident ~conv_lid:conv_lab i, patt p) | p -> error (loc_of_patt p) "invalid pattern" ]; value rec expr_fa al = fun [ ExApp _ f a -> expr_fa [a :: al] f | f -> (f, al) ] ; value rec class_expr_fa al = fun [ CeApp _ ce a -> class_expr_fa [a :: al] ce | ce -> (ce, al) ] ; value rec sep_expr_acc l = fun [ ExAcc _ e1 e2 -> sep_expr_acc (sep_expr_acc l e2) e1 | <:expr@loc< $uid:s$ >> as e -> match l with [ [] -> [(loc, [], e)] | [(loc', sl, e) :: l] -> [(Loc.merge loc loc', [s :: sl], e) :: l] ] | <:expr< $id:(<:ident< $_$.$_$ >> as i)$ >> -> let rec normalize_acc = fun [ <:ident@_loc< $i1$.$i2$ >> -> <:expr< $normalize_acc i1$.$normalize_acc i2$ >> | <:ident@_loc< $i1$ $i2$ >> -> <:expr< $normalize_acc i1$ $normalize_acc i2$ >> | <:ident@_loc< $anti:_$ >> | <:ident@_loc< $uid:_$ >> | <:ident@_loc< $lid:_$ >> as i -> <:expr< $id:i$ >> ] in sep_expr_acc l (normalize_acc i) | e -> [(loc_of_expr e, [], e) :: l] ] ; value override_flag loc = fun [ <:override_flag< ! >> -> Override | <:override_flag<>> -> Fresh | _ -> error loc "antiquotation not allowed here" ]; value list_of_opt_ctyp ot acc = match ot with [ <:ctyp<>> -> acc | t -> list_of_ctyp t acc ]; value varify_constructors var_names = let rec loop t = let desc = match t.ptyp_desc with [ Ptyp_any -> Ptyp_any | Ptyp_var x -> Ptyp_var x | Ptyp_arrow label core_type core_type' -> Ptyp_arrow label (loop core_type) (loop core_type') | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst) | Ptyp_constr ({ txt = Lident s }) [] when List.exists (fun x -> s = x.txt) var_names -> Ptyp_var ("&" ^ s) | Ptyp_constr longident lst -> Ptyp_constr longident (List.map loop lst) | Ptyp_object (lst, o) -> Ptyp_object (List.map loop_object_field lst, o) | Ptyp_class longident lst -> Ptyp_class (longident, List.map loop lst) | Ptyp_alias core_type string -> Ptyp_alias(loop core_type, string) | Ptyp_variant row_field_list flag lbl_lst_option -> Ptyp_variant(List.map loop_row_field row_field_list, flag, lbl_lst_option) | Ptyp_poly string_lst core_type -> Ptyp_poly(string_lst, loop core_type) | Ptyp_package longident lst -> Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst) | Ptyp_extension x -> Ptyp_extension x | Ptyp_open (mod_ident, t) -> Ptyp_open (mod_ident, loop t) ] in {(t) with ptyp_desc = desc} and loop_object_field x = let pof_desc = match x.pof_desc with [ Otag s t -> Otag s (loop t) | Oinherit t -> Oinherit (loop t) ] in { (x) with pof_desc } and loop_row_field x = let prf_desc = match x.prf_desc with [ Rtag(label,flag,lst) -> Rtag(label,flag,List.map loop lst) | Rinherit t -> Rinherit (loop t) ] in {(x) with prf_desc} in loop; value rec expr = fun [ <:expr@loc< $x$.val >> -> mkexp loc (Pexp_apply (mkexp loc (Pexp_ident (lident_with_loc "!" loc))) [(Nolabel, expr x)]) | ExAcc loc _ _ | <:expr@loc< $id:<:ident< $_$ . $_$ >>$ >> as e -> let (e, l) = match sep_expr_acc [] e with [ [(loc, ml, <:expr< $uid:s$ >>) :: l] -> (mkexp loc (Pexp_construct (mkli loc (conv_con s) ml) None), l) | [(loc, ml, <:expr< $lid:s$ >>) :: l] -> (mkexp loc (Pexp_ident (mkli loc s ml)), l) | [(_, [], e) :: l] -> (expr e, l) | _ -> error loc "bad ast in expression" ] in let (_, e) = List.fold_left (fun (loc_bp, e1) (loc_ep, ml, e2) -> match e2 with [ <:expr@sloc< $lid:s$ >> -> let loc = Loc.merge loc_bp loc_ep in (loc, mkexp loc (Pexp_field e1 (mkli sloc (conv_lab s) ml))) | _ -> error (loc_of_expr e2) "lowercase identifier expected" ]) (loc, e) l in e | ExAnt loc _ -> error loc "antiquotation not allowed here" | ExApp loc _ _ as f -> let (f, al) = expr_fa [] f in let al = List.map label_expr al in match (expr f).pexp_desc with [ Pexp_construct li None -> let al = List.map snd al in let a = match al with [ [a] -> a | _ -> mkexp loc (Pexp_tuple al) ] in mkexp loc (Pexp_construct li (Some a)) | Pexp_variant s None -> let al = List.map snd al in let a = match al with [ [a] -> a | _ -> mkexp loc (Pexp_tuple al) ] in mkexp loc (Pexp_variant s (Some a)) | _ -> mkexp loc (Pexp_apply (expr f) al) ] | ExAre loc e1 e2 -> mkexp loc (Pexp_apply (mkexp loc (Pexp_ident (array_function loc "Array" "get"))) [(Nolabel, expr e1); (Nolabel, expr e2)]) | ExArr loc e -> mkexp loc (Pexp_array (List.map expr (list_of_expr e []))) | ExAsf loc -> mkexp loc (Pexp_assert (mkexp loc (Pexp_construct {txt=Lident "false"; loc=mkloc loc} None))) | ExAss loc e v -> let e = match e with [ <:expr@loc< $x$.val >> -> Pexp_apply (mkexp loc (Pexp_ident (lident_with_loc ":=" loc))) [(Nolabel, expr x); (Nolabel, expr v)] | ExAcc loc _ _ -> match (expr e).pexp_desc with [ Pexp_field e lab -> Pexp_setfield e lab (expr v) | _ -> error loc "bad record access" ] | ExAre loc e1 e2 -> Pexp_apply (mkexp loc (Pexp_ident (array_function loc "Array" "set"))) [(Nolabel, expr e1); (Nolabel, expr e2); (Nolabel, expr v)] | <:expr< $id:(<:ident@lloc< $lid:lab$ >>)$ >> -> Pexp_setinstvar (with_loc lab lloc) (expr v) | ExSte loc e1 e2 -> Pexp_apply (mkexp loc (Pexp_ident (array_function loc "String" "set"))) [(Nolabel, expr e1); (Nolabel, expr e2); (Nolabel, expr v)] | _ -> error loc "bad left part of assignment" ] in mkexp loc e | ExAsr loc e -> mkexp loc (Pexp_assert (expr e)) | ExChr loc s -> mkexp loc (Pexp_constant (mkconst loc (Pconst_char (char_of_char_token loc s)))) | ExCoe loc e t1 t2 -> let t1 = match t1 with [ <:ctyp<>> -> None | t -> Some (ctyp t) ] in mkexp loc (Pexp_coerce (expr e) t1 (ctyp t2)) | ExFlo loc s -> mkexp loc (Pexp_constant (mkconst loc (Pconst_float (remove_underscores s, None)))) | ExFor loc p e1 e2 df el -> let e3 = ExSeq loc el in mkexp loc (Pexp_for (patt p) (expr e1) (expr e2) (mkdirection df) (expr e3)) | <:expr@loc< fun [ $PaLab _ lab po$ when $w$ -> $e$ ] >> -> mkfun loc (Labelled lab) None (patt_of_lab loc lab po) e w | <:expr@loc< fun [ $PaOlbi _ lab p e1$ when $w$ -> $e2$ ] >> -> let lab = paolab lab p in mkfun loc (Optional lab) (Some (expr e1)) (patt p) e2 w | <:expr@loc< fun [ $PaOlb _ lab p$ when $w$ -> $e$ ] >> -> let lab = paolab lab p in mkfun loc (Optional lab) None (patt_of_lab loc lab p) e w | ExFun loc a -> mkexp loc (Pexp_function ([], None, Pfunction_cases (match_case a [], mkloc loc, []))) | ExIfe loc e1 e2 e3 -> mkexp loc (Pexp_ifthenelse (expr e1) (expr e2) (Some (expr e3))) | ExInt loc s -> mkexp loc (Pexp_constant (mkconst loc (Pconst_integer (s, None)))) | ExInt32 loc s -> mkexp loc (Pexp_constant (mkconst loc (Pconst_integer (s, Some 'l')))) | ExInt64 loc s -> mkexp loc (Pexp_constant (mkconst loc (Pconst_integer (s, Some 'L')))) | ExNativeInt loc s -> mkexp loc (Pexp_constant (mkconst loc (Pconst_integer (s, Some 'n')))) | ExLab loc _ _ -> error loc "labeled expression not allowed here" | ExLaz loc e -> mkexp loc (Pexp_lazy (expr e)) | ExLet loc rf bi e -> let e = expr e in match binding bi [] with [ [] -> e | bi -> mkexp loc (Pexp_let (mkrf rf) bi e) ] | ExLmd loc i me e -> mkexp loc (Pexp_letmodule (with_loc (Some i) loc) (module_expr me) (expr e)) | ExMat loc e a -> mkexp loc (Pexp_match (expr e) (match_case a [])) | ExNew loc id -> mkexp loc (Pexp_new (long_type_ident id)) | ExObj loc po cfl -> let p = match po with [ <:patt<>> -> <:patt@loc< _ >> | p -> p ] in let cil = class_str_item cfl [] in mkexp loc (Pexp_object { pcstr_self = patt p; pcstr_fields = cil }) | ExOlb loc _ _ -> error loc "labeled expression not allowed here" | ExOvr loc iel -> mkexp loc (Pexp_override (mkideexp iel [])) | ExRec loc lel eo -> match lel with [ <:rec_binding<>> -> error loc "empty record" | _ -> let eo = match eo with [ <:expr<>> -> None | e -> Some (expr e) ] in mkexp loc (Pexp_record (mklabexp lel []) eo) ] | ExSeq _loc e -> let rec loop = fun [ [] -> expr <:expr< () >> | [e] -> expr e | [e :: el] -> let _loc = Loc.merge (loc_of_expr e) _loc in mkexp _loc (Pexp_sequence (expr e) (loop el)) ] in loop (list_of_expr e []) | ExSnd loc e s -> mkexp loc (Pexp_send (expr e) (with_loc s loc)) | ExSte loc e1 e2 -> mkexp loc (Pexp_apply (mkexp loc (Pexp_ident (array_function loc "String" "get"))) [(Nolabel, expr e1); (Nolabel, expr e2)]) | ExStr loc s -> mkexp loc (Pexp_constant (mkconst loc (Pconst_string (string_of_string_token loc s) (Loc.to_ocaml_location loc) None))) | ExTry loc e a -> mkexp loc (Pexp_try (expr e) (match_case a [])) | <:expr@loc< ($e1$, $e2$) >> -> mkexp loc (Pexp_tuple (List.map expr (list_of_expr e1 (list_of_expr e2 [])))) | <:expr@loc< ($tup:_$) >> -> error loc "singleton tuple" | ExTyc loc e t -> mkexp loc (Pexp_constraint (expr e) (ctyp t)) | <:expr@loc< () >> -> mkexp loc (Pexp_construct (lident_with_loc "()" loc) None) | <:expr@loc< $lid:s$ >> -> mkexp loc (Pexp_ident (lident_with_loc s loc)) | <:expr@loc< $uid:s$ >> -> mkexp loc (Pexp_construct (lident_with_loc (conv_con s) loc) None) | ExVrn loc s -> mkexp loc (Pexp_variant (conv_con s) None) | ExWhi loc e1 el -> let e2 = ExSeq loc el in mkexp loc (Pexp_while (expr e1) (expr e2)) | ExOpI loc i ov e -> let fresh = override_flag loc ov in mkexp loc (Pexp_open ({popen_loc = mkloc loc ;popen_override=fresh ;popen_attributes=[] ;popen_expr= {pmod_desc = Pmod_ident (long_uident i) ;pmod_loc = mkloc loc ;pmod_attributes = [] } }, (expr e))) | <:expr@loc< (module $me$ : $pt$) >> -> mkexp loc (Pexp_constraint (mkexp loc (Pexp_pack (module_expr me)), mktyp loc (Ptyp_package (package_type pt)))) | <:expr@loc< (module $me$) >> -> mkexp loc (Pexp_pack (module_expr me)) | ExFUN loc i e -> mkexp loc (Pexp_newtype (with_loc i loc) (expr e)) | <:expr@loc< $_$,$_$ >> -> error loc "expr, expr: not allowed here" | <:expr@loc< $_$;$_$ >> -> error loc "expr; expr: not allowed here, use do {...} or [|...|] to surround them" | ExAtt loc s str e -> let e = expr e in {(e) with pexp_attributes = e.pexp_attributes @ [attribute loc s str]} | ExId _ _ | ExNil _ as e -> error (loc_of_expr e) "invalid expr" ] and patt_of_lab _loc lab = fun [ <:patt<>> -> patt <:patt< $lid:lab$ >> | p -> patt p ] and expr_of_lab _loc lab = fun [ <:expr<>> -> expr <:expr< $lid:lab$ >> | e -> expr e ] and label_expr = fun [ ExLab loc lab eo -> (Labelled lab, expr_of_lab loc lab eo) | ExOlb loc lab eo -> (Optional lab, expr_of_lab loc lab eo) | e -> (Nolabel, expr e) ] and binding x acc = match x with [ <:binding< $x$ and $y$ >> -> binding x (binding y acc) | <:binding@_loc< $pat:( <:patt@sloc< $lid:bind_name$ >> )$ = ($e$ : $TyTypePol _ vs ty$) >> -> (* this code is not pretty because it is temporary *) let rec id_to_string x = match x with [ <:ctyp@loc< $lid:x$ >> -> [with_loc x loc] | <:ctyp< $x$ $y$ >> -> (id_to_string x) @ (id_to_string y) | _ -> assert False] in let vars = id_to_string vs in let ampersand_vars = List.map (fun x -> { loc = x.loc; txt = "&" ^ x.txt}) vars in let ty' = varify_constructors vars (ctyp ty) in let mkexp = mkexp _loc in let mkpat = mkpat _loc in let e = mkexp (Pexp_constraint (expr e) (ctyp ty)) in let rec mk_newtypes x = match x with [ [newtype :: []] -> mkexp (Pexp_newtype(newtype, e)) | [newtype :: newtypes] -> mkexp(Pexp_newtype (newtype,mk_newtypes newtypes)) | [] -> assert False] in let pat = mkpat (Ppat_constraint (mkpat (Ppat_var (with_loc bind_name sloc)), mktyp _loc (Ptyp_poly ampersand_vars ty'))) in let e = mk_newtypes vars in [{pvb_pat=pat; pvb_expr=e; pvb_attributes=[]; pvb_loc = mkloc _loc; pvb_constraint = None} :: acc] | <:binding@_loc< $p$ = ($e$ : ! $vs$ . $ty$) >> -> [{pvb_pat=patt <:patt< ($p$ : ! $vs$ . $ty$ ) >>; pvb_expr=expr e; pvb_attributes=[]; pvb_loc=mkloc _loc; pvb_constraint = None} :: acc] | <:binding@_loc< $p$ = $e$ >> -> [{pvb_pat=patt p; pvb_expr=expr e; pvb_attributes=[]; pvb_loc=mkloc _loc; pvb_constraint = None} :: acc] | <:binding<>> -> acc | _ -> assert False ] and match_case x acc = match x with [ <:match_case< $x$ | $y$ >> -> match_case x (match_case y acc) | <:match_case< $pat:p$ when $w$ -> $e$ >> -> [when_expr (patt p) e w :: acc] | <:match_case<>> -> acc | _ -> assert False ] and when_expr p e w = let g = match w with [ <:expr<>> -> None | g -> Some (expr g) ] in {pc_lhs = p; pc_guard = g; pc_rhs = expr e} and mkfun loc lab def p e w = let () = match w with [ <:expr<>> -> () | _ -> assert False ] in mkexp loc (Pexp_function ([ { pparam_loc = mkloc loc; pparam_desc = Pparam_val (lab, def, p)} ], None, Pfunction_body (expr e))) and mklabexp x acc = match x with [ <:rec_binding< $x$; $y$ >> -> mklabexp x (mklabexp y acc) | <:rec_binding< $i$ = $e$ >> -> [(ident ~conv_lid:conv_lab i, expr e) :: acc] | _ -> assert False ] and mkideexp x acc = match x with [ <:rec_binding<>> -> acc | <:rec_binding< $x$; $y$ >> -> mkideexp x (mkideexp y acc) | <:rec_binding< $id:( <:ident@sloc< $lid:s$ >>)$ = $e$ >> -> [(with_loc s sloc, expr e) :: acc] | _ -> assert False ] and mktype_decl_or_ext x acc = match x with [ <:ctyp< $x$ and $y$ >> -> mktype_decl_or_ext x (mktype_decl_or_ext y acc) | Ast.TyDcl cloc c tl td cl -> let cl = List.map (fun (t1, t2) -> let loc = Loc.merge (loc_of_ctyp t1) (loc_of_ctyp t2) in (ctyp t1, ctyp t2, mkloc loc)) cl in let td = type_decl (with_loc c cloc) (List.fold_right optional_type_parameters tl []) cl td cloc in match acc with [ `Unknown -> `Dcl [td] | `Dcl acc -> `Dcl [td :: acc] | `Ext _ -> error cloc "cannot mix type declaration and extension" ] | Ast.TyExt cloc c tl td -> match acc with [ `Unknown -> `Ext(type_ext (long_type_ident c) (List.fold_right optional_type_parameters tl []) td cloc) | `Dcl _ -> error cloc "cannot mix type declaration and extension" | `Ext _ -> error cloc "only one type extension allowed" ] | _ -> assert False ] and module_type = fun [ <:module_type@loc<>> -> error loc "abstract/nil module type not allowed here" | <:module_type@loc< $id:i$ >> -> mkmty loc (Pmty_ident (long_uident i)) | Ast.MtFun(loc, "*", Ast.MtNil _, mt) -> mkmty loc (Pmty_functor Unit (module_type mt)) | <:module_type@loc< functor ($n$ : $nt$) -> $mt$ >> -> mkmty loc (Pmty_functor (Named (with_loc (Some n) loc) (module_type nt)) (module_type mt)) | <:module_type@loc< '$_$ >> -> error loc "module type variable not allowed here" | <:module_type@loc< sig $sl$ end >> -> mkmty loc (Pmty_signature (sig_item sl [])) | <:module_type@loc< $mt$ with $wc$ >> -> mkmty loc (Pmty_with (module_type mt) (mkwithc wc [])) | <:module_type@loc< module type of $me$ >> -> mkmty loc (Pmty_typeof (module_expr me)) | MtAtt loc s str e -> let e = module_type e in {(e) with pmty_attributes = e.pmty_attributes @ [attribute loc s str]} | Ast.MtAlias(loc, id) -> mkmty loc (Pmty_alias (long_uident id)) | <:module_type< $anti:_$ >> -> assert False ] and sig_item s l = match s with [ <:sig_item<>> -> l | SgCls loc cd -> [mksig loc (Psig_class (List.map class_info_class_type (list_of_class_type cd []))) :: l] | SgClt loc ctd -> [mksig loc (Psig_class_type (List.map class_info_class_type (list_of_class_type ctd []))) :: l] | <:sig_item< $sg1$; $sg2$ >> -> sig_item sg1 (sig_item sg2 l) | SgDir _ _ _ -> l | <:sig_item@loc< exception $uid:s$ >> -> [mksig loc (Psig_exception { ptyexn_constructor = { pext_name = with_loc (conv_con s) loc; pext_kind = Pext_decl (([], (Pcstr_tuple []), None)); pext_attributes = []; pext_loc = mkloc loc; }; ptyexn_loc = mkloc loc; ptyexn_attributes = [] }) :: l] | <:sig_item@loc< exception $uid:s$ of $t$ >> -> [mksig loc (Psig_exception { ptyexn_loc = mkloc loc ; ptyexn_attributes = [] ; ptyexn_constructor = { pext_name = with_loc (conv_con s) loc ; pext_kind = Pext_decl ([], Pcstr_tuple (List.map ctyp (list_of_ctyp t [])), None) ; pext_attributes = [] ; pext_loc = mkloc loc } }) :: l] | SgExc _ _ -> assert False (*FIXME*) | SgExt loc n t sl -> [mksig loc (Psig_value (mkvalue_desc loc (with_loc n loc) t (list_of_meta_list sl))) :: l] | SgInc loc mt -> [mksig loc (Psig_include {pincl_mod=module_type mt; pincl_attributes=[]; pincl_loc = mkloc loc}) :: l] | SgMod loc n mt -> [mksig loc (Psig_module {pmd_loc=mkloc loc; pmd_name=with_loc (Some n) loc; pmd_type=module_type mt; pmd_attributes=[]}) :: l] | SgRecMod loc mb -> [mksig loc (Psig_recmodule (module_sig_binding mb [])) :: l] | SgMty loc n mt -> let si = match mt with [ MtQuo _ _ -> None | _ -> Some (module_type mt) ] in [mksig loc (Psig_modtype {pmtd_loc=mkloc loc; pmtd_name=with_loc n loc; pmtd_type=si; pmtd_attributes=[]}) :: l] | SgOpn loc ov id -> let fresh = override_flag loc ov in [mksig loc (Psig_open {popen_override=fresh; popen_expr=long_uident id; popen_attributes=[]; popen_loc = mkloc loc}) :: l] | SgTyp loc rf tdl -> let rf = mknrf rf in let ty = match mktype_decl_or_ext tdl `Unknown with [ `Unknown -> Psig_type (rf, []) | `Dcl l -> Psig_type (rf, l) | `Ext e -> Psig_typext e ] in [mksig loc ty :: l] | SgVal loc n t -> [mksig loc (Psig_value (mkvalue_desc loc (with_loc n loc) t [])) :: l] | <:sig_item@loc< $anti:_$ >> -> error loc "antiquotation in sig_item" ] and module_sig_binding x acc = match x with [ <:module_binding< $x$ and $y$ >> -> module_sig_binding x (module_sig_binding y acc) | <:module_binding@loc< $s$ : $mt$ >> -> [{pmd_loc=mkloc loc; pmd_name=with_loc (Some s) loc; pmd_type=module_type mt; pmd_attributes=[]} :: acc] | _ -> assert False ] and module_str_binding x acc = match x with [ <:module_binding< $x$ and $y$ >> -> module_str_binding x (module_str_binding y acc) | <:module_binding@loc< $s$ : $mt$ = $me$ >> -> [{pmb_loc=mkloc loc; pmb_name=with_loc (Some s) loc; pmb_expr= {pmod_loc=Location.none; pmod_desc=Pmod_constraint(module_expr me,module_type mt); pmod_attributes=[]; }; pmb_attributes=[]} :: acc] | _ -> assert False ] and module_expr = fun [ <:module_expr@loc<>> -> error loc "nil module expression" | <:module_expr@loc< $id:i$ >> -> mkmod loc (Pmod_ident (long_uident i)) | <:module_expr@loc< $me1$ $me2$ >> -> mkmod loc (Pmod_apply (module_expr me1) (module_expr me2)) | Ast.MeFun(loc, "*", Ast.MtNil _, me) -> mkmod loc (Pmod_functor Unit (module_expr me)) | <:module_expr@loc< functor ($n$ : $mt$) -> $me$ >> -> mkmod loc (Pmod_functor (Named (with_loc (Some n) loc) (module_type mt)) (module_expr me)) | <:module_expr@loc< struct $sl$ end >> -> mkmod loc (Pmod_structure (str_item sl [])) | <:module_expr@loc< ($me$ : $mt$) >> -> mkmod loc (Pmod_constraint (module_expr me) (module_type mt)) | <:module_expr@loc< (value $e$ : $pt$) >> -> mkmod loc (Pmod_unpack ( mkexp loc (Pexp_constraint (expr e, mktyp loc (Ptyp_package (package_type pt)))))) | <:module_expr@loc< (value $e$) >> -> mkmod loc (Pmod_unpack (expr e)) | MeAtt loc s str e -> let e = module_expr e in {(e) with pmod_attributes = e.pmod_attributes @ [attribute loc s str]} | <:module_expr@loc< $anti:_$ >> -> error loc "antiquotation in module_expr" ] and str_item s l = match s with [ <:str_item<>> -> l | StCls loc cd -> [mkstr loc (Pstr_class (List.map class_info_class_expr (list_of_class_expr cd []))) :: l] | StClt loc ctd -> [mkstr loc (Pstr_class_type (List.map class_info_class_type (list_of_class_type ctd []))) :: l] | <:str_item< $st1$; $st2$ >> -> str_item st1 (str_item st2 l) | StDir _ _ _ -> l | <:str_item@loc< exception $uid:s$ >> -> [mkstr loc (Pstr_exception {ptyexn_loc=mkloc loc ;ptyexn_attributes=[] ; ptyexn_constructor = { pext_name = with_loc (conv_con s) loc ; pext_kind = Pext_decl ([], Pcstr_tuple [], None) ; pext_attributes = [] ; pext_loc = mkloc loc } }) :: l ] | <:str_item@loc< exception $uid:s$ of $t$ >> -> [mkstr loc (Pstr_exception {ptyexn_loc=mkloc loc ;ptyexn_attributes=[] ; ptyexn_constructor ={ pext_name = with_loc (conv_con s) loc ; pext_kind = Pext_decl ([], Pcstr_tuple (List.map ctyp (list_of_ctyp t [])), None) ; pext_attributes = [] ; pext_loc = mkloc loc } }) :: l ] | <:str_item@loc< exception $uid:s$ = $i$ >> -> [mkstr loc (Pstr_exception {ptyexn_loc=mkloc loc ;ptyexn_attributes=[] ; ptyexn_constructor ={ pext_name = with_loc (conv_con s) loc ; pext_kind = Pext_rebind (long_uident ~conv_con i) ; pext_attributes = [] ; pext_loc = mkloc loc } }) :: l ] | <:str_item@loc< exception $uid:_$ of $_$ = $_$ >> -> error loc "type in exception alias" | StExc _ _ _ -> assert False (*FIXME*) | StExp loc e -> [mkstr loc (Pstr_eval (expr e) []) :: l] | StExt loc n t sl -> [mkstr loc (Pstr_primitive (mkvalue_desc loc (with_loc n loc) t (list_of_meta_list sl))) :: l] | StInc loc me -> [mkstr loc (Pstr_include {pincl_mod=module_expr me; pincl_attributes=[]; pincl_loc=mkloc loc}) :: l] | StMod loc n me -> [mkstr loc (Pstr_module {pmb_loc=mkloc loc; pmb_name=with_loc (Some n) loc;pmb_expr=module_expr me;pmb_attributes=[]}) :: l] | StRecMod loc mb -> [mkstr loc (Pstr_recmodule (module_str_binding mb [])) :: l] | StMty loc n mt -> let si = match mt with [ MtQuo _ _ -> None | _ -> Some (module_type mt) ] in [mkstr loc (Pstr_modtype {pmtd_loc=mkloc loc; pmtd_name=with_loc n loc; pmtd_type=si; pmtd_attributes=[]}) :: l] | StOpn loc ov id -> let fresh = override_flag loc ov in [mkstr loc (Pstr_open {popen_override=fresh; popen_expr={pmod_desc = Pmod_ident(long_uident id); pmod_loc = mkloc loc; pmod_attributes=[]}; popen_attributes=[]; popen_loc=mkloc loc}) :: l] | StTyp loc rf tdl -> let rf = mknrf rf in let ty = match mktype_decl_or_ext tdl `Unknown with [ `Unknown -> Pstr_type (rf, []) | `Dcl l -> Pstr_type (rf, l) | `Ext e -> Pstr_typext e ] in [mkstr loc ty :: l] | StVal loc rf bi -> [mkstr loc (Pstr_value (mkrf rf) (binding bi [])) :: l] | <:str_item@loc< $anti:_$ >> -> error loc "antiquotation in str_item" ] and class_type = fun [ CtCon loc ViNil id tl -> mkcty loc (Pcty_constr (long_class_ident id) (List.map ctyp (list_of_opt_ctyp tl []))) | CtFun loc (TyLab _ lab t) ct -> mkcty loc (Pcty_arrow (Labelled lab) (ctyp t) (class_type ct)) | CtFun loc (TyOlb _ lab t) ct -> mkcty loc (Pcty_arrow (Optional lab) (ctyp t) (class_type ct)) | CtFun loc t ct -> mkcty loc (Pcty_arrow Nolabel (ctyp t) (class_type ct)) | CtSig loc t_o ctfl -> let t = match t_o with [ <:ctyp<>> -> <:ctyp@loc< _ >> | t -> t ] in let cil = class_sig_item ctfl [] in mkcty loc (Pcty_signature { pcsig_self = ctyp t; pcsig_fields = cil; }) | CtAtt loc s str e -> let e = class_type e in {(e) with pcty_attributes = e.pcty_attributes @ [attribute loc s str]} | CtCon loc _ _ _ -> error loc "invalid virtual class inside a class type" | CtAnt _ _ | CtEq _ _ _ | CtCol _ _ _ | CtAnd _ _ _ | CtNil _ -> assert False ] and class_info_class_expr ci = match ci with [ CeEq _ (CeCon loc vir (IdLid nloc name) params) ce -> let params = match params with [ <:ctyp<>> -> [] | t -> class_parameters t [] ] in {pci_virt = mkvirtual vir; pci_params = params; pci_name = with_loc name nloc; pci_expr = class_expr ce; pci_loc = mkloc loc; pci_attributes = [] } | ce -> error (loc_of_class_expr ce) "bad class definition" ] and class_info_class_type ci = match ci with [ CtEq _ (CtCon loc vir (IdLid nloc name) params) ct | CtCol _ (CtCon loc vir (IdLid nloc name) params) ct -> let params = match params with [ <:ctyp<>> -> [] | t -> class_parameters t [] ] in {pci_virt = mkvirtual vir; pci_params = params; pci_name = with_loc name nloc; pci_expr = class_type ct; pci_attributes = []; pci_loc = mkloc loc } | ct -> error (loc_of_class_type ct) "bad class/class type declaration/definition" ] and class_sig_item c l = match c with [ <:class_sig_item<>> -> l | CgCtr loc t1 t2 -> [mkctf loc (Pctf_constraint (ctyp t1, ctyp t2)) :: l] | <:class_sig_item< $csg1$; $csg2$ >> -> class_sig_item csg1 (class_sig_item csg2 l) | CgInh loc ct -> [mkctf loc (Pctf_inherit (class_type ct)) :: l] | CgMth loc s pf t -> [mkctf loc (Pctf_method (with_loc s loc, mkprivate pf, Concrete, ctyp t)) :: l] | CgVal loc s b v t -> [mkctf loc (Pctf_val (with_loc s loc, mkmutable b, mkvirtual v, ctyp t)) :: l] | CgVir loc s b t -> [mkctf loc (Pctf_method (with_loc s loc, mkprivate b, Virtual, ctyp t)) :: l] | CgAnt _ _ -> assert False ] and class_expr = fun [ CeApp loc _ _ as c -> let (ce, el) = class_expr_fa [] c in let el = List.map label_expr el in mkcl loc (Pcl_apply (class_expr ce) el) | CeCon loc ViNil id tl -> mkcl loc (Pcl_constr (long_class_ident id) (List.map ctyp (list_of_opt_ctyp tl []))) | CeFun loc (PaLab _ lab po) ce -> mkcl loc (Pcl_fun (Labelled lab) None (patt_of_lab loc lab po) (class_expr ce)) | CeFun loc (PaOlbi _ lab p e) ce -> let lab = paolab lab p in mkcl loc (Pcl_fun (Optional lab) (Some (expr e)) (patt p) (class_expr ce)) | CeFun loc (PaOlb _ lab p) ce -> let lab = paolab lab p in mkcl loc (Pcl_fun (Optional lab) None (patt_of_lab loc lab p) (class_expr ce)) | CeFun loc p ce -> mkcl loc (Pcl_fun Nolabel None (patt p) (class_expr ce)) | CeLet loc rf bi ce -> mkcl loc (Pcl_let (mkrf rf) (binding bi []) (class_expr ce)) | CeStr loc po cfl -> let p = match po with [ <:patt<>> -> <:patt@loc< _ >> | p -> p ] in let cil = class_str_item cfl [] in mkcl loc (Pcl_structure { pcstr_self = patt p; pcstr_fields = cil; }) | CeTyc loc ce ct -> mkcl loc (Pcl_constraint (class_expr ce) (class_type ct)) | CeAtt loc s str e -> let e = class_expr e in {(e) with pcl_attributes = e.pcl_attributes @ [attribute loc s str]} | CeCon loc _ _ _ -> error loc "invalid virtual class inside a class expression" | CeAnt _ _ | CeEq _ _ _ | CeAnd _ _ _ | CeNil _ -> assert False ] and class_str_item c l = match c with [ CrNil _ -> l | CrCtr loc t1 t2 -> [mkcf loc (Pcf_constraint (ctyp t1, ctyp t2)) :: l] | <:class_str_item< $cst1$; $cst2$ >> -> class_str_item cst1 (class_str_item cst2 l) | CrInh loc ov ce pb -> let opb = if pb = "" then None else Some (with_loc pb loc) in [mkcf loc (Pcf_inherit (override_flag loc ov) (class_expr ce) opb) :: l] | CrIni loc e -> [mkcf loc (Pcf_initializer (expr e)) :: l] | CrMth loc s ov pf e t -> let t = match t with [ <:ctyp<>> -> None | t -> Some (ctyp t) ] in let e = mkexp loc (Pexp_poly (expr e) t) in [mkcf loc (Pcf_method (with_loc s loc, mkprivate pf, Cfk_concrete (override_flag loc ov, e))) :: l] | CrVal loc s ov mf e -> [mkcf loc (Pcf_val (with_loc s loc, mkmutable mf, Cfk_concrete (override_flag loc ov, expr e))) :: l] | CrVir loc s pf t -> [mkcf loc (Pcf_method (with_loc s loc, mkprivate pf, Cfk_virtual (ctyp t))) :: l] | CrVvr loc s mf t -> [mkcf loc (Pcf_val (with_loc s loc, mkmutable mf, Cfk_virtual (ctyp t))) :: l] | CrAnt _ _ -> assert False ]; value sig_item ast = sig_item ast []; value str_item ast = str_item ast []; value directive_arg x = let x = match x with [ ExStr loc s -> Some (loc, Pdir_string s) | ExInt loc i -> Some (loc, Pdir_int (i, None)) | <:expr@loc< True >> -> Some (loc, Pdir_bool True) | <:expr@loc< False >> -> Some (loc, Pdir_bool False) | <:expr< >> -> None | e -> Some (Ast.loc_of_expr e, Pdir_ident (ident_noloc (ident_of_expr e))) ] in match x with [ None -> None | Some (loc, x) -> Some { pdira_desc = x; pdira_loc = mkloc loc } ] ; value phrase = fun [ StDir loc d arg -> Ptop_dir {pdir_name = with_loc d loc ;pdir_arg = (directive_arg arg) ;pdir_loc = mkloc loc} | si -> Ptop_def (str_item si) ] ; value attribute loc s str = { attr_name = with_loc s loc ; attr_payload = PStr (str_item str) ; attr_loc = mkloc loc }; value () = attribute_fwd.val := attribute; end; camlp4-5.3-1/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.mli000066400000000000000000000025721473134377200224450ustar00rootroot00000000000000(* camlp4r *) (****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2002-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) module Make (Camlp4Ast : Sig.Camlp4Ast) : sig open Camlp4Ast; (** {6 Useful functions} *) value sig_item : sig_item -> Parsetree.signature; value str_item : str_item -> Parsetree.structure; value phrase : str_item -> Parsetree.toplevel_phrase; end; camlp4-5.3-1/camlp4/Camlp4/Struct/CleanAst.ml000066400000000000000000000123711473134377200205260ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Nicolas Pouillard: initial version *) (** This module is suppose to contain nils elimination. *) module Make (Ast : Sig.Camlp4Ast) = struct class clean_ast = object inherit Ast.map as super; method with_constr wc = match super#with_constr wc with [ <:with_constr< $ <:with_constr<>> $ and $wc$ >> | <:with_constr< $wc$ and $ <:with_constr<>> $ >> -> wc | wc -> wc ]; method expr e = match super#expr e with [ <:expr< let $rec:_$ $ <:binding<>> $ in $e$ >> | <:expr< { ($e$) with $ <:rec_binding<>> $ } >> | <:expr< $ <:expr<>> $, $e$ >> | <:expr< $e$, $ <:expr<>> $ >> | <:expr< $ <:expr<>> $; $e$ >> | <:expr< $e$; $ <:expr<>> $ >> -> e | e -> e ]; method patt p = match super#patt p with [ <:patt< ( $p$ as $ <:patt<>> $ ) >> | <:patt< $ <:patt<>> $ | $p$ >> | <:patt< $p$ | $ <:patt<>> $ >> | <:patt< $ <:patt<>> $, $p$ >> | <:patt< $p$, $ <:patt<>> $ >> | <:patt< $ <:patt<>> $; $p$ >> | <:patt< $p$; $ <:patt<>> $ >> -> p | p -> p ]; method match_case mc = match super#match_case mc with [ <:match_case< $ <:match_case<>> $ | $mc$ >> | <:match_case< $mc$ | $ <:match_case<>> $ >> -> mc | mc -> mc ]; method binding bi = match super#binding bi with [ <:binding< $ <:binding<>> $ and $bi$ >> | <:binding< $bi$ and $ <:binding<>> $ >> -> bi | bi -> bi ]; method rec_binding rb = match super#rec_binding rb with [ <:rec_binding< $ <:rec_binding<>> $ ; $bi$ >> | <:rec_binding< $bi$ ; $ <:rec_binding<>> $ >> -> bi | bi -> bi ]; method module_binding mb = match super#module_binding mb with [ <:module_binding< $ <:module_binding<>> $ and $mb$ >> | <:module_binding< $mb$ and $ <:module_binding<>> $ >> -> mb | mb -> mb ]; method ctyp t = match super#ctyp t with [ <:ctyp< ! $ <:ctyp<>> $ . $t$ >> | <:ctyp< $ <:ctyp<>> $ as $t$ >> | <:ctyp< $t$ as $ <:ctyp<>> $ >> | <:ctyp< $t$ -> $ <:ctyp<>> $ >> | <:ctyp< $ <:ctyp<>> $ -> $t$ >> | <:ctyp< $ <:ctyp<>> $ | $t$ >> | <:ctyp< $t$ | $ <:ctyp<>> $ >> | <:ctyp< $t$ of $ <:ctyp<>> $ >> | <:ctyp< $ <:ctyp<>> $ and $t$ >> | <:ctyp< $t$ and $ <:ctyp<>> $ >> | <:ctyp< $t$; $ <:ctyp<>> $ >> | <:ctyp< $ <:ctyp<>> $; $t$ >> | <:ctyp< $ <:ctyp<>> $, $t$ >> | <:ctyp< $t$, $ <:ctyp<>> $ >> | <:ctyp< $t$ & $ <:ctyp<>> $ >> | <:ctyp< $ <:ctyp<>> $ & $t$ >> | <:ctyp< $ <:ctyp<>> $ * $t$ >> | <:ctyp< $t$ * $ <:ctyp<>> $ >> -> t | t -> t ]; method sig_item sg = match super#sig_item sg with [ <:sig_item< $ <:sig_item<>> $; $sg$ >> | <:sig_item< $sg$; $ <:sig_item<>> $ >> -> sg | Ast.SgTyp (loc, _, Ast.TyNil _) -> <:sig_item@loc<>> | sg -> sg ]; method str_item st = match super#str_item st with [ <:str_item< $ <:str_item<>> $; $st$ >> | <:str_item< $st$; $ <:str_item<>> $ >> -> st | Ast.StTyp (loc, _, Ast.TyNil _) -> <:str_item@loc<>> | <:str_item@loc< value $rec:_$ $ <:binding<>> $ >> -> <:str_item@loc<>> | st -> st ]; method module_type mt = match super#module_type mt with [ <:module_type< $mt$ with $ <:with_constr<>> $ >> -> mt | mt -> mt ]; method class_expr ce = match super#class_expr ce with [ <:class_expr< $ <:class_expr<>> $ and $ce$ >> | <:class_expr< $ce$ and $ <:class_expr<>> $ >> -> ce | ce -> ce ]; method class_type ct = match super#class_type ct with [ <:class_type< $ <:class_type<>> $ and $ct$ >> | <:class_type< $ct$ and $ <:class_type<>> $ >> -> ct | ct -> ct ]; method class_sig_item csg = match super#class_sig_item csg with [ <:class_sig_item< $ <:class_sig_item<>> $; $csg$ >> | <:class_sig_item< $csg$; $ <:class_sig_item<>> $ >> -> csg | csg -> csg ]; method class_str_item cst = match super#class_str_item cst with [ <:class_str_item< $ <:class_str_item<>> $; $cst$ >> | <:class_str_item< $cst$; $ <:class_str_item<>> $ >> -> cst | cst -> cst ]; end; end; camlp4-5.3-1/camlp4/Camlp4/Struct/CommentFilter.ml000066400000000000000000000042551473134377200216060ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) module Make (Token : Sig.Camlp4Token) = struct open Token; type t = (Stream.t (string * Loc.t) * Queue.t (string * Loc.t)); value mk () = let q = Queue.create () in let f _ = debug comments "take...@\n" in try Some (Queue.take q) with [ Queue.Empty -> None ] in (Stream.from f, q); value filter (_, q) = let rec self = parser [ [: ` (Sig.COMMENT x, loc); xs :] -> do { Queue.add (x, loc) q; debug comments "add: %S at %a@\n" x Loc.dump loc in self xs } | [: ` x; xs :] -> (* debug comments "Found %a at %a@." Token.print x Loc.dump loc in *) [: ` x; self xs :] | [: :] -> [: :] ] in self; value take_list (_, q) = let rec self accu = if Queue.is_empty q then accu else self [Queue.take q :: accu] in self []; value take_stream = fst; value define token_fiter comments_strm = debug comments "Define a comment filter@\n" in Token.Filter.define_filter token_fiter (fun previous strm -> previous (filter comments_strm strm)); end; camlp4-5.3-1/camlp4/Camlp4/Struct/CommentFilter.mli000066400000000000000000000026561473134377200217620ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) module Make (Token : Sig.Camlp4Token) : sig open Token; type t; value mk : unit -> t; value define : Token.Filter.t -> t -> unit; value filter : t -> Stream.t (Token.t * Loc.t) -> Stream.t (Token.t * Loc.t); value take_list : t -> list (string * Loc.t); value take_stream : t -> Stream.t (string * Loc.t); end; camlp4-5.3-1/camlp4/Camlp4/Struct/DynAst.ml000066400000000000000000000064371473134377200202440ustar00rootroot00000000000000(* camlp4r *) (****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2007 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Nicolas Pouillard: initial version *) module Make (Ast : Sig.Ast) : Sig.DynAst with module Ast = Ast = struct module Ast = Ast; type tag 'a = [ Tag_ctyp | Tag_patt | Tag_expr | Tag_module_type | Tag_sig_item | Tag_with_constr | Tag_module_expr | Tag_str_item | Tag_class_type | Tag_class_sig_item | Tag_class_expr | Tag_class_str_item | Tag_match_case | Tag_ident | Tag_binding | Tag_rec_binding | Tag_module_binding ]; value string_of_tag = fun [ Tag_ctyp -> "ctyp" | Tag_patt -> "patt" | Tag_expr -> "expr" | Tag_module_type -> "module_type" | Tag_sig_item -> "sig_item" | Tag_with_constr -> "with_constr" | Tag_module_expr -> "module_expr" | Tag_str_item -> "str_item" | Tag_class_type -> "class_type" | Tag_class_sig_item -> "class_sig_item" | Tag_class_expr -> "class_expr" | Tag_class_str_item -> "class_str_item" | Tag_match_case -> "match_case" | Tag_ident -> "ident" | Tag_binding -> "binding" | Tag_rec_binding -> "rec_binding" | Tag_module_binding -> "module_binding" ]; value ctyp_tag = Tag_ctyp; value patt_tag = Tag_patt; value expr_tag = Tag_expr; value module_type_tag = Tag_module_type; value sig_item_tag = Tag_sig_item; value with_constr_tag = Tag_with_constr; value module_expr_tag = Tag_module_expr; value str_item_tag = Tag_str_item; value class_type_tag = Tag_class_type; value class_sig_item_tag = Tag_class_sig_item; value class_expr_tag = Tag_class_expr; value class_str_item_tag = Tag_class_str_item; value match_case_tag = Tag_match_case; value ident_tag = Tag_ident; value binding_tag = Tag_binding; value rec_binding_tag = Tag_rec_binding; value module_binding_tag = Tag_module_binding; type dyn; external dyn_tag : tag 'a -> tag dyn = "%identity"; module Pack(X : sig type t 'a; end) = struct (* These Obj.* hacks should be avoided with GADTs *) type pack = (tag dyn * Obj.t); exception Pack_error; value pack tag v = (dyn_tag tag, Obj.repr v); value unpack (tag : tag 'a) (tag', obj) = if dyn_tag tag = tag' then (Obj.obj obj : X.t 'a) else raise Pack_error; value print_tag f (tag, _) = Format.pp_print_string f (string_of_tag tag); end; end; camlp4-5.3-1/camlp4/Camlp4/Struct/DynLoader.ml000066400000000000000000000057661473134377200207270ustar00rootroot00000000000000(* camlp4r pa_macro.cmo *) (****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2001-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) type t = Queue.t string; exception Error of string and string; value include_dir x y = Queue.add y x; value fold_load_path x f acc = Queue.fold (fun x y -> f y x) acc x; value mk ?(ocaml_stdlib = True) ?(camlp4_stdlib = True) () = let q = Queue.create () in do { if ocaml_stdlib then include_dir q Camlp4_config.ocaml_standard_library else (); if camlp4_stdlib then do { include_dir q Camlp4_config.camlp4_standard_library; include_dir q (Filename.concat Camlp4_config.camlp4_standard_library "Camlp4Parsers"); include_dir q (Filename.concat Camlp4_config.camlp4_standard_library "Camlp4Printers"); include_dir q (Filename.concat Camlp4_config.camlp4_standard_library "Camlp4Filters"); } else (); include_dir q "."; q }; (* Load files in core *) value find_in_path x name = if not (Filename.is_implicit name) then if Sys.file_exists name then name else raise Not_found else let res = fold_load_path x (fun dir -> fun [ None -> let fullname = Filename.concat dir name in if Sys.file_exists fullname then Some fullname else None | x -> x ]) None in match res with [ None -> raise Not_found | Some x -> x ]; value load = let _initialized = ref False in fun _path file -> do { if not _initialized.val then try do { Dynlink.allow_unsafe_modules True; _initialized.val := True } with [ Dynlink.Error e -> raise (Error "Camlp4's dynamic loader initialization" (Dynlink.error_message e)) ] else (); let fname = try find_in_path _path file with [ Not_found -> raise (Error file "file not found in path") ] in try Dynlink.loadfile fname with [ Dynlink.Error e -> raise (Error fname (Dynlink.error_message e)) ] }; value is_native = Dynlink.is_native; camlp4-5.3-1/camlp4/Camlp4/Struct/DynLoader.mli000066400000000000000000000021731473134377200210650ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) include Sig.DynLoader; camlp4-5.3-1/camlp4/Camlp4/Struct/EmptyError.ml000066400000000000000000000023041473134377200211370ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) type t = unit; exception E of t; value print _ = assert False; value to_string _ = assert False; camlp4-5.3-1/camlp4/Camlp4/Struct/EmptyError.mli000066400000000000000000000021661473134377200213160ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) include Sig.Error; camlp4-5.3-1/camlp4/Camlp4/Struct/EmptyPrinter.ml000066400000000000000000000024421473134377200214740ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Nicolas Pouillard: initial version *) module Make (Ast : Sig.Ast) = struct value print_interf ?input_file:(_) ?output_file:(_) _ = failwith "No interface printer"; value print_implem ?input_file:(_) ?output_file:(_) _ = failwith "No implementation printer"; end; camlp4-5.3-1/camlp4/Camlp4/Struct/EmptyPrinter.mli000066400000000000000000000021601473134377200216420ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Nicolas Pouillard: initial version *) module Make (Ast : Sig.Ast) : (Sig.Printer Ast).S; camlp4-5.3-1/camlp4/Camlp4/Struct/FreeVars.ml000066400000000000000000000114311473134377200205450ustar00rootroot00000000000000(* camlp4r *) (****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Nicolas Pouillard: initial version *) module Make (Ast : Sig.Camlp4Ast) = struct module S = Set.Make String; class c_fold_pattern_vars ['accu] f init = object inherit Ast.fold as super; value acc = init; method acc : 'accu = acc; method patt = fun [ <:patt< $lid:s$ >> | <:patt< ~ $s$ >> | <:patt< ? $s$ >> -> {< acc = f s acc >} | p -> super#patt p ]; end; value fold_pattern_vars f p init = ((new c_fold_pattern_vars f init)#patt p)#acc; value rec fold_binding_vars f bi acc = match bi with [ <:binding< $bi1$ and $bi2$ >> -> fold_binding_vars f bi1 (fold_binding_vars f bi2 acc) | <:binding< $p$ = $_$ >> -> fold_pattern_vars f p acc | <:binding<>> -> acc | <:binding< $anti:_$ >> -> assert False ]; class fold_free_vars ['accu] (f : string -> 'accu -> 'accu) ?(env_init = S.empty) free_init = object (o) inherit Ast.fold as super; value free : 'accu = free_init; value env : S.t = env_init; method free = free; method set_env env = {< env = env >}; method add_atom s = {< env = S.add s env >}; method add_patt p = {< env = fold_pattern_vars S.add p env >}; method add_binding bi = {< env = fold_binding_vars S.add bi env >}; method expr = fun [ <:expr< $lid:s$ >> | <:expr< ~ $s$ >> | <:expr< ? $s$ >> -> if S.mem s env then o else {< free = f s free >} | <:expr< let $bi$ in $e$ >> -> (((o#add_binding bi)#expr e)#set_env env)#binding bi | <:expr< let rec $bi$ in $e$ >> -> (((o#add_binding bi)#expr e)#binding bi)#set_env env | <:expr< for $p$ = $e1$ $to:_$ $e2$ do { $e3$ } >> -> ((((o#expr e1)#expr e2)#patt p)#expr e3)#set_env env | <:expr< $id:_$ >> | <:expr< new $_$ >> -> o | <:expr< object ($p$) $cst$ end >> -> ((o#add_patt p)#class_str_item cst)#set_env env | e -> super#expr e ]; method match_case = fun [ <:match_case< $p$ when $e1$ -> $e2$ >> -> (((o#add_patt p)#expr e1)#expr e2)#set_env env | m -> super#match_case m ]; method str_item = fun [ <:str_item< external $s$ : $t$ = $_$ >> -> (o#ctyp t)#add_atom s | <:str_item< value $bi$ >> -> (o#binding bi)#add_binding bi | <:str_item< value rec $bi$ >> -> (o#add_binding bi)#binding bi | st -> super#str_item st ]; method class_expr = fun [ <:class_expr< fun $p$ -> $ce$ >> -> ((o#add_patt p)#class_expr ce)#set_env env | <:class_expr< let $bi$ in $ce$ >> -> (((o#binding bi)#add_binding bi)#class_expr ce)#set_env env | <:class_expr< let rec $bi$ in $ce$ >> -> (((o#add_binding bi)#binding bi)#class_expr ce)#set_env env | <:class_expr< object ($p$) $cst$ end >> -> ((o#add_patt p)#class_str_item cst)#set_env env | ce -> super#class_expr ce ]; method class_str_item = fun [ <:class_str_item< inherit $override:_$ $_$ >> as cst -> super#class_str_item cst | <:class_str_item< inherit $override:_$ $ce$ as $s$ >> -> (o#class_expr ce)#add_atom s | <:class_str_item< value $override:_$ $mutable:_$ $s$ = $e$ >> -> (o#expr e)#add_atom s | <:class_str_item< value virtual $mutable:_$ $s$ : $t$ >> -> (o#ctyp t)#add_atom s | cst -> super#class_str_item cst ]; method module_expr = fun [ <:module_expr< struct $st$ end >> -> (o#str_item st)#set_env env | me -> super#module_expr me ]; end; value free_vars env_init e = let fold = new fold_free_vars S.add ~env_init S.empty in (fold#expr e)#free; end; camlp4-5.3-1/camlp4/Camlp4/Struct/FreeVars.mli000066400000000000000000000037221473134377200207220ustar00rootroot00000000000000(* camlp4r *) (****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Nicolas Pouillard: initial version *) module Make (Ast : Sig.Camlp4Ast) : sig module S : Set.S with type elt = string; value fold_binding_vars : (string -> 'accu -> 'accu) -> Ast.binding -> 'accu -> 'accu; class c_fold_pattern_vars ['accu] : [string -> 'accu -> 'accu] -> ['accu] -> object inherit Ast.fold; value acc : 'accu; method acc : 'accu; end; value fold_pattern_vars : (string -> 'accu -> 'accu) -> Ast.patt -> 'accu -> 'accu; class fold_free_vars ['accu] : [string -> 'accu -> 'accu] -> [?env_init:S.t] -> ['accu] -> object ('self_type) inherit Ast.fold; value free : 'accu; value env : S.t; method free : 'accu; method set_env : S.t -> 'self_type; method add_atom : string -> 'self_type; method add_patt : Ast.patt -> 'self_type; method add_binding : Ast.binding -> 'self_type; end; value free_vars : S.t -> Ast.expr -> S.t; end; camlp4-5.3-1/camlp4/Camlp4/Struct/Grammar.mlpack000066400000000000000000000001301473134377200212470ustar00rootroot00000000000000Delete Dynamic Entry Failed Find Fold Insert Parser Print Search Static Structure Tools camlp4-5.3-1/camlp4/Camlp4/Struct/Grammar/000077500000000000000000000000001473134377200200645ustar00rootroot00000000000000camlp4-5.3-1/camlp4/Camlp4/Struct/Grammar/Delete.ml000066400000000000000000000145621473134377200216300ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) exception Rule_not_found of (string * string); let () = Printexc.register_printer (fun [ Rule_not_found (symbols, entry) -> let msg = Printf.sprintf "rule %S cannot be found in entry\n%s" symbols entry in Some msg | _ -> None ]) in () ; module Make (Structure : Structure.S) = struct module Tools = Tools.Make Structure; module Parser = Parser.Make Structure; module Print = Print.Make Structure; open Structure; value raise_rule_not_found entry symbols = let to_string f x = let buff = Buffer.create 128 in let ppf = Format.formatter_of_buffer buff in do { f ppf x; Format.pp_print_flush ppf (); Buffer.contents buff } in let entry = to_string Print.entry entry in let symbols = to_string Print.print_rule symbols in raise (Rule_not_found (symbols, entry)) ; (* Deleting a rule *) (* [delete_rule_in_tree] returns [Some (dsl, t)] if success [dsl] = Some (list of deleted nodes) if branch deleted None if action replaced by previous version of action [t] = remaining tree [None] if failure *) value delete_rule_in_tree entry = let rec delete_in_tree symbols tree = match (symbols, tree) with [ ([s :: sl], Node n) -> if Tools.logically_eq_symbols entry s n.node then delete_son sl n else match delete_in_tree symbols n.brother with [ Some (dsl, t) -> Some (dsl, Node {node = n.node; son = n.son; brother = t}) | None -> None ] | ([_ :: _], _) -> None | ([], Node n) -> match delete_in_tree [] n.brother with [ Some (dsl, t) -> Some (dsl, Node {node = n.node; son = n.son; brother = t}) | None -> None ] | ([], DeadEnd) -> None | ([], LocAct _ []) -> Some (Some [], DeadEnd) | ([], LocAct _ [action :: list]) -> Some (None, LocAct action list) ] and delete_son sl n = match delete_in_tree sl n.son with [ Some (Some dsl, DeadEnd) -> Some (Some [n.node :: dsl], n.brother) | Some (Some dsl, t) -> let t = Node {node = n.node; son = t; brother = n.brother} in Some (Some [n.node :: dsl], t) | Some (None, t) -> let t = Node {node = n.node; son = t; brother = n.brother} in Some (None, t) | None -> None ] in delete_in_tree ; value rec decr_keyw_use gram = fun [ Skeyword kwd -> removing gram kwd | Smeta _ sl _ -> List.iter (decr_keyw_use gram) sl | Slist0 s | Slist1 s | Sopt s | Stry s -> decr_keyw_use gram s | Slist0sep s1 s2 -> do { decr_keyw_use gram s1; decr_keyw_use gram s2 } | Slist1sep s1 s2 -> do { decr_keyw_use gram s1; decr_keyw_use gram s2 } | Stree t -> decr_keyw_use_in_tree gram t | Sself | Snext | Snterm _ | Snterml _ _ | Stoken _ -> () ] and decr_keyw_use_in_tree gram = fun [ DeadEnd | LocAct _ _ -> () | Node n -> do { decr_keyw_use gram n.node; decr_keyw_use_in_tree gram n.son; decr_keyw_use_in_tree gram n.brother } ] ; value rec delete_rule_in_suffix entry symbols = fun [ [lev :: levs] -> match delete_rule_in_tree entry symbols lev.lsuffix with [ Some (dsl, t) -> do { match dsl with [ Some dsl -> List.iter (decr_keyw_use entry.egram) dsl | None -> () ]; match t with [ DeadEnd when lev.lprefix == DeadEnd -> levs | _ -> let lev = {assoc = lev.assoc; lname = lev.lname; lsuffix = t; lprefix = lev.lprefix} in [lev :: levs] ] } | None -> let levs = delete_rule_in_suffix entry symbols levs in [lev :: levs] ] | [] -> raise_rule_not_found entry symbols ] ; value rec delete_rule_in_prefix entry symbols = fun [ [lev :: levs] -> match delete_rule_in_tree entry symbols lev.lprefix with [ Some (dsl, t) -> do { match dsl with [ Some dsl -> List.iter (decr_keyw_use entry.egram) dsl | None -> () ]; match t with [ DeadEnd when lev.lsuffix == DeadEnd -> levs | _ -> let lev = {assoc = lev.assoc; lname = lev.lname; lsuffix = lev.lsuffix; lprefix = t} in [lev :: levs] ] } | None -> let levs = delete_rule_in_prefix entry symbols levs in [lev :: levs] ] | [] -> raise_rule_not_found entry symbols ] ; value rec delete_rule_in_level_list entry symbols levs = match symbols with [ [Sself :: symbols] -> delete_rule_in_suffix entry symbols levs | [Snterm e :: symbols] when e == entry -> delete_rule_in_suffix entry symbols levs | _ -> delete_rule_in_prefix entry symbols levs ] ; value delete_rule entry sl = match entry.edesc with [ Dlevels levs -> let levs = delete_rule_in_level_list entry sl levs in do { entry.edesc := Dlevels levs; entry.estart := fun lev strm -> let f = Parser.start_parser_of_entry entry in do { entry.estart := f; f lev strm }; entry.econtinue := fun lev bp a strm -> let f = Parser.continue_parser_of_entry entry in do { entry.econtinue := f; f lev bp a strm } } | Dparser _ -> () ] ; end; camlp4-5.3-1/camlp4/Camlp4/Struct/Grammar/Dynamic.ml000066400000000000000000000054371473134377200220130ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) module Make (Lexer : Sig.Lexer) : Sig.Grammar.Dynamic with module Loc = Lexer.Loc and module Token = Lexer.Token = struct module Structure = Structure.Make Lexer; module Delete = Delete.Make Structure; module Insert = Insert.Make Structure; module Entry = Entry.Make Structure; module Fold = Fold.Make Structure; module Tools = Tools.Make Structure; include Structure; value mk () = let gkeywords = Hashtbl.create 301 in { gkeywords = gkeywords; gfilter = Token.Filter.mk (Hashtbl.mem gkeywords); glexer = Lexer.mk (); warning_verbose = ref True; (* FIXME *) error_verbose = Camlp4_config.verbose }; value get_filter g = g.gfilter; value lex g loc cs = g.glexer loc cs; value lex_string g loc str = lex g loc (Stream.of_string str); value filter g ts = Tools.keep_prev_loc (Token.Filter.filter g.gfilter ts); value parse_tokens_after_filter entry ts = Entry.parse_tokens_after_filter entry ts; value parse_tokens_before_filter entry ts = parse_tokens_after_filter entry (filter entry.egram ts); value parse entry loc cs = parse_tokens_before_filter entry (lex entry.egram loc cs); value parse_string entry loc str = parse_tokens_before_filter entry (lex_string entry.egram loc str); value delete_rule = Delete.delete_rule; value srules e rl = let t = List.fold_left (fun tree (symbols, action) -> Insert.insert_tree e symbols action tree) DeadEnd rl in Stree t; value sfold0 = Fold.sfold0; value sfold1 = Fold.sfold1; value sfold0sep = Fold.sfold0sep; (* value sfold1sep = Fold.sfold1sep; *) value extend = Insert.extend; end; camlp4-5.3-1/camlp4/Camlp4/Struct/Grammar/Entry.ml000066400000000000000000000061741473134377200215270ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) module Make (Structure : Structure.S) = struct module Dump = Print.MakeDump Structure; module Print = Print.Make Structure; module Tools = Tools.Make Structure; open Format; open Structure; open Tools; type t 'a = internal_entry; value name e = e.ename; value print ppf e = fprintf ppf "%a@\n" Print.entry e; value dump ppf e = fprintf ppf "%a@\n" Dump.entry e; (* value find e s = Find.entry e s; *) value mk g n = { egram = g; ename = n; estart = empty_entry n; econtinue _ _ _ = parser []; edesc = Dlevels [] }; value action_parse entry ts : Action.t = try entry.estart 0 ts with [ Stream.Failure -> Loc.raise (get_prev_loc ts) (Stream.Error ("illegal begin of " ^ entry.ename)) | Loc.Exc_located _ _ as exc -> raise exc | exc -> Loc.raise (get_prev_loc ts) exc ]; value lex entry loc cs = entry.egram.glexer loc cs; value lex_string entry loc str = lex entry loc (Stream.of_string str); value filter entry ts = keep_prev_loc (Token.Filter.filter (get_filter entry.egram) ts); value parse_tokens_after_filter entry ts = Action.get (action_parse entry ts); value parse_tokens_before_filter entry ts = parse_tokens_after_filter entry (filter entry ts); value parse entry loc cs = parse_tokens_before_filter entry (lex entry loc cs); value parse_string entry loc str = parse_tokens_before_filter entry (lex_string entry loc str); value of_parser g n (p : Stream.t (Token.t * token_info) -> 'a) : t 'a = let f ts = Action.mk (p ts) in { egram = g; ename = n; estart _ = f; econtinue _ _ _ = parser []; edesc = Dparser f }; value setup_parser e (p : Stream.t (Token.t * token_info) -> 'a) = let f ts = Action.mk (p ts) in do { e.estart := fun _ -> f; e.econtinue := fun _ _ _ -> parser []; e.edesc := Dparser f }; value clear e = do { e.estart := fun _ -> parser []; e.econtinue := fun _ _ _ -> parser []; e.edesc := Dlevels [] }; value obj x = x; end; camlp4-5.3-1/camlp4/Camlp4/Struct/Grammar/Failed.ml000066400000000000000000000115041473134377200216030ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) module Make (Structure : Structure.S) = struct module Tools = Tools.Make Structure; module Search = Search.Make Structure; module Print = Print.Make Structure; open Structure; open Format; value rec name_of_symbol entry = fun [ Snterm e -> "[" ^ e.ename ^ "]" | Snterml e l -> "[" ^ e.ename ^ " level " ^ l ^ "]" | Sself | Snext -> "[" ^ entry.ename ^ "]" | Stoken (_, descr) -> descr | Skeyword kwd -> "\"" ^ kwd ^ "\"" | _ -> "???" ] ; value rec name_of_symbol_failed entry = fun [ Slist0 s | Slist0sep s _ | Slist1 s | Slist1sep s _ | Sopt s | Stry s -> name_of_symbol_failed entry s | Stree t -> name_of_tree_failed entry t | s -> name_of_symbol entry s ] and name_of_tree_failed entry = fun [ Node {node = s; brother = bro; son = son} -> let tokl = match s with [ Stoken _ | Skeyword _ -> Tools.get_token_list entry [] s son | _ -> None ] in match tokl with [ None -> let txt = name_of_symbol_failed entry s in let txt = match (s, son) with [ (Sopt _, Node _) -> txt ^ " or " ^ name_of_tree_failed entry son | _ -> txt ] in let txt = match bro with [ DeadEnd | LocAct _ _ -> txt | Node _ -> txt ^ " or " ^ name_of_tree_failed entry bro ] in txt | Some (tokl, _, _) -> List.fold_left (fun s tok -> (if s = "" then "" else s ^ " then ") ^ match tok with [ Stoken (_, descr) -> descr | Skeyword kwd -> kwd | _ -> assert False ]) "" tokl ] | DeadEnd | LocAct _ _ -> "???" ] ; value magic _s x = debug magic "Obj.magic: %s@." _s in Obj.magic x; value tree_failed entry prev_symb_result prev_symb tree = let txt = name_of_tree_failed entry tree in let txt = match prev_symb with [ Slist0 s -> let txt1 = name_of_symbol_failed entry s in txt1 ^ " or " ^ txt ^ " expected" | Slist1 s -> let txt1 = name_of_symbol_failed entry s in txt1 ^ " or " ^ txt ^ " expected" | Slist0sep s sep -> match magic "tree_failed: 'a -> list 'b" prev_symb_result with [ [] -> let txt1 = name_of_symbol_failed entry s in txt1 ^ " or " ^ txt ^ " expected" | _ -> let txt1 = name_of_symbol_failed entry sep in txt1 ^ " or " ^ txt ^ " expected" ] | Slist1sep s sep -> match magic "tree_failed: 'a -> list 'b" prev_symb_result with [ [] -> let txt1 = name_of_symbol_failed entry s in txt1 ^ " or " ^ txt ^ " expected" | _ -> let txt1 = name_of_symbol_failed entry sep in txt1 ^ " or " ^ txt ^ " expected" ] | Stry _(*NP: not sure about this*) | Sopt _ | Stree _ -> txt ^ " expected" | _ -> txt ^ " expected after " ^ name_of_symbol entry prev_symb ] in do { if entry.egram.error_verbose.val then do { let tree = Search.tree_in_entry prev_symb tree entry.edesc; let ppf = err_formatter; fprintf ppf "@[@,"; fprintf ppf "----------------------------------@,"; fprintf ppf "Parse error in entry [%s], rule:@;<0 2>" entry.ename; fprintf ppf "@["; Print.print_level ppf pp_force_newline (Print.flatten_tree tree); fprintf ppf "@]@,"; fprintf ppf "----------------------------------@,"; fprintf ppf "@]@." } else (); txt ^ " (in [" ^ entry.ename ^ "])" } ; value symb_failed entry prev_symb_result prev_symb symb = let tree = Node {node = symb; brother = DeadEnd; son = DeadEnd} in tree_failed entry prev_symb_result prev_symb tree ; value symb_failed_txt e s1 s2 = symb_failed e 0 s1 s2; end; camlp4-5.3-1/camlp4/Camlp4/Struct/Grammar/Find.ml000066400000000000000000000052471473134377200213060ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) (* value entry e s = let rec find_levels = fun [ [] -> None | [lev :: levs] -> match find_tree lev.lsuffix with [ None -> match find_tree lev.lprefix with [ None -> find_levels levs | x -> x ] | x -> x ] ] and symbol = fun [ Snterm e -> if e.ename = s then Some e else None | Snterml e _ -> if e.ename = s then Some e else None | Smeta _ sl _ -> find_symbol_list sl | Slist0 s -> find_symbol s | Slist0sep s _ -> find_symbol s | Slist1 s -> find_symbol s | Slist1sep s _ -> find_symbol s | Sopt s -> find_symbol s | Stree t -> find_tree t | Sself | Snext | Stoken _ | Stoken_fun _ -> None ] and symbol_list = fun [ [s :: sl] -> match find_symbol s with [ None -> find_symbol_list sl | x -> x ] | [] -> None ] and tree = fun [ Node {node = s; brother = bro; son = son} -> match find_symbol s with [ None -> match find_tree bro with [ None -> find_tree son | x -> x ] | x -> x ] | LocAct _ _ | DeadEnd -> None ] in match e.edesc with [ Dlevels levs -> match find_levels levs with [ Some e -> e | None -> raise Not_found ] | Dparser _ -> raise Not_found ] ; *) camlp4-5.3-1/camlp4/Camlp4/Struct/Grammar/Fold.ml000066400000000000000000000056371473134377200213150ustar00rootroot00000000000000(* camlp4r *) (****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) module Make (Structure : Structure.S) = struct open Structure; open Format; module Parse = Parser.Make Structure; module Fail = Failed.Make Structure; open Sig.Grammar; (* Prevent from implict usage. *) module Stream = struct type t 'a = Stream.t 'a; exception Failure = Stream.Failure; exception Error = Stream.Error; end; value sfold0 f e _entry _symbl psymb = let rec fold accu = parser [ [: a = psymb; s :] -> fold (f a accu) s | [: :] -> accu ] in parser [: a = fold e :] -> a ; value sfold1 f e _entry _symbl psymb = let rec fold accu = parser [ [: a = psymb; s :] -> fold (f a accu) s | [: :] -> accu ] in parser [: a = psymb; a = fold (f a e) :] -> a ; value sfold0sep f e entry symbl psymb psep = let failed = fun [ [symb; sep] -> Fail.symb_failed_txt entry sep symb | _ -> "failed" ] in let rec kont accu = parser [ [: () = psep; a = psymb ?? failed symbl; s :] -> kont (f a accu) s | [: :] -> accu ] in parser [ [: a = psymb; s :] -> kont (f a e) s | [: :] -> e ] ; value sfold1sep f e entry symbl psymb psep = let failed = fun [ [symb; sep] -> Fail.symb_failed_txt entry sep symb | _ -> "failed" ] in let parse_top = fun [ [symb; _] -> Parse.parse_top_symb entry symb (* FIXME context *) | _ -> raise Stream.Failure ] in let rec kont accu = parser [ [: () = psep; a = parser [ [: a = psymb :] -> a | [: a = parse_top symbl :] -> Obj.magic a | [: :] -> raise (Stream.Error (failed symbl)) ]; s :] -> kont (f a accu) s | [: :] -> accu ] in parser [: a = psymb; s :] -> kont (f a e) s ; end; camlp4-5.3-1/camlp4/Camlp4/Struct/Grammar/Fold.mli000066400000000000000000000026561473134377200214640ustar00rootroot00000000000000(* camlp4r *) (****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) module Make (Structure : Structure.S) : sig open Structure; value sfold0 : ('a -> 'b -> 'b) -> 'b -> fold _ 'a 'b; value sfold1 : ('a -> 'b -> 'b) -> 'b -> fold _ 'a 'b; value sfold0sep : ('a -> 'b -> 'b) -> 'b -> foldsep _ 'a 'b; (* value sfold1sep : ('a -> 'b -> 'b) -> 'b -> foldsep _ 'a 'b; *) end; camlp4-5.3-1/camlp4/Camlp4/Struct/Grammar/Insert.ml000066400000000000000000000252351473134377200216710ustar00rootroot00000000000000(* -*- camlp4r -*- *) (****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) module Make (Structure : Structure.S) = struct module Tools = Tools.Make Structure; module Parser = Parser.Make Structure; open Structure; open Format; open Sig.Grammar; value is_before s1 s2 = match (s1, s2) with [ (Skeyword _ | Stoken _, Skeyword _ | Stoken _) -> False | (Skeyword _ | Stoken _, _) -> True | _ -> False ] ; value rec derive_eps = fun [ Slist0 _ | Slist0sep _ _ | Sopt _ -> True | Stry s -> derive_eps s | Stree t -> tree_derive_eps t | Slist1 _ | Slist1sep _ _ | Stoken _ | Skeyword _ -> (* For sure we cannot derive epsilon from these *) False | Smeta _ _ _ | Snterm _ | Snterml _ _ | Snext | Sself -> (* Approximation *) False ] and tree_derive_eps = fun [ LocAct _ _ -> True | Node {node = s; brother = bro; son = son} -> derive_eps s && tree_derive_eps son || tree_derive_eps bro | DeadEnd -> False ] ; value empty_lev lname assoc = let assoc = match assoc with [ Some a -> a | None -> LeftA ] in {assoc = assoc; lname = lname; lsuffix = DeadEnd; lprefix = DeadEnd} ; value change_lev entry lev n lname assoc = let a = match assoc with [ None -> lev.assoc | Some a -> do { if a <> lev.assoc && entry.egram.warning_verbose.val then do { eprintf " Changing associativity of level \"%s\"\n" n; flush Stdlib.stderr } else (); a } ] in do { match lname with [ Some n -> if lname <> lev.lname && entry.egram.warning_verbose.val then do { eprintf " Level label \"%s\" ignored\n" n; flush Stdlib.stderr } else () | None -> () ]; {assoc = a; lname = lev.lname; lsuffix = lev.lsuffix; lprefix = lev.lprefix} } ; value change_to_self entry = fun [ Snterm e when e == entry -> Sself | x -> x ] ; value get_level entry position levs = match position with [ Some First -> ([], empty_lev, levs) | Some Last -> (levs, empty_lev, []) | Some (Level n) -> let rec get = fun [ [] -> do { eprintf "No level labelled \"%s\" in entry \"%s\"\n" n entry.ename; flush Stdlib.stderr; failwith "Grammar.extend" } | [lev :: levs] -> if Tools.is_level_labelled n lev then ([], change_lev entry lev n, levs) else let (levs1, rlev, levs2) = get levs in ([lev :: levs1], rlev, levs2) ] in get levs | Some (Before n) -> let rec get = fun [ [] -> do { eprintf "No level labelled \"%s\" in entry \"%s\"\n" n entry.ename; flush Stdlib.stderr; failwith "Grammar.extend" } | [lev :: levs] -> if Tools.is_level_labelled n lev then ([], empty_lev, [lev :: levs]) else let (levs1, rlev, levs2) = get levs in ([lev :: levs1], rlev, levs2) ] in get levs | Some (After n) -> let rec get = fun [ [] -> do { eprintf "No level labelled \"%s\" in entry \"%s\"\n" n entry.ename; flush Stdlib.stderr; failwith "Grammar.extend" } | [lev :: levs] -> if Tools.is_level_labelled n lev then ([lev], empty_lev, levs) else let (levs1, rlev, levs2) = get levs in ([lev :: levs1], rlev, levs2) ] in get levs | None -> match levs with [ [lev :: levs] -> ([], change_lev entry lev "", levs) | [] -> ([], empty_lev, []) ] ] ; value rec check_gram entry = fun [ Snterm e -> if e.egram != entry.egram then do { eprintf "\ Error: entries \"%s\" and \"%s\" do not belong to the same grammar.\n" entry.ename e.ename; flush Stdlib.stderr; failwith "Grammar.extend error" } else () | Snterml e _ -> if e.egram != entry.egram then do { eprintf "\ Error: entries \"%s\" and \"%s\" do not belong to the same grammar.\n" entry.ename e.ename; flush Stdlib.stderr; failwith "Grammar.extend error" } else () | Smeta _ sl _ -> List.iter (check_gram entry) sl | Slist0sep s t -> do { check_gram entry t; check_gram entry s } | Slist1sep s t -> do { check_gram entry t; check_gram entry s } | Slist0 s | Slist1 s | Sopt s | Stry s -> check_gram entry s | Stree t -> tree_check_gram entry t | Snext | Sself | Stoken _ | Skeyword _ -> () ] and tree_check_gram entry = fun [ Node {node = n; brother = bro; son = son} -> do { check_gram entry n; tree_check_gram entry bro; tree_check_gram entry son } | LocAct _ _ | DeadEnd -> () ] ; value get_initial = fun [ [Sself :: symbols] -> (True, symbols) | symbols -> (False, symbols) ] ; value insert_tokens gram symbols = let rec insert = fun [ Smeta _ sl _ -> List.iter insert sl | Slist0 s | Slist1 s | Sopt s | Stry s -> insert s | Slist0sep s t -> do { insert s; insert t } | Slist1sep s t -> do { insert s; insert t } | Stree t -> tinsert t | Skeyword kwd -> using gram kwd | Snterm _ | Snterml _ _ | Snext | Sself | Stoken _ -> () ] and tinsert = fun [ Node {node = s; brother = bro; son = son} -> do { insert s; tinsert bro; tinsert son } | LocAct _ _ | DeadEnd -> () ] in List.iter insert symbols ; value insert_tree entry gsymbols action tree = let rec insert symbols tree = match symbols with [ [s :: sl] -> insert_in_tree s sl tree | [] -> match tree with [ Node {node = s; son = son; brother = bro} -> Node {node = s; son = son; brother = insert [] bro} | LocAct old_action action_list -> let () = if entry.egram.warning_verbose.val then eprintf " Grammar extension: in [%s] some rule has been masked@." entry.ename else () in LocAct action [old_action :: action_list] | DeadEnd -> LocAct action [] ] ] and insert_in_tree s sl tree = match try_insert s sl tree with [ Some t -> t | None -> Node {node = s; son = insert sl DeadEnd; brother = tree} ] and try_insert s sl tree = match tree with [ Node {node = s1; son = son; brother = bro} -> if Tools.eq_symbol s s1 then let t = Node {node = s1; son = insert sl son; brother = bro} in Some t else if is_before s1 s || derive_eps s && not (derive_eps s1) then let bro = match try_insert s sl bro with [ Some bro -> bro | None -> Node {node = s; son = insert sl DeadEnd; brother = bro} ] in let t = Node {node = s1; son = son; brother = bro} in Some t else match try_insert s sl bro with [ Some bro -> let t = Node {node = s1; son = son; brother = bro} in Some t | None -> None ] | LocAct _ _ | DeadEnd -> None ] in insert gsymbols tree ; value insert_level entry e1 symbols action slev = match e1 with [ True -> {assoc = slev.assoc; lname = slev.lname; lsuffix = insert_tree entry symbols action slev.lsuffix; lprefix = slev.lprefix} | False -> {assoc = slev.assoc; lname = slev.lname; lsuffix = slev.lsuffix; lprefix = insert_tree entry symbols action slev.lprefix} ] ; value levels_of_rules entry position rules = let elev = match entry.edesc with [ Dlevels elev -> elev | Dparser _ -> do { eprintf "Error: entry not extensible: \"%s\"\n" entry.ename; flush Stdlib.stderr; failwith "Grammar.extend" } ] in if rules = [] then elev else let (levs1, make_lev, levs2) = get_level entry position elev in let (levs, _) = List.fold_left (fun (levs, make_lev) (lname, assoc, level) -> let lev = make_lev lname assoc in let lev = List.fold_left (fun lev (symbols, action) -> let symbols = List.map (change_to_self entry) symbols in do { List.iter (check_gram entry) symbols; let (e1, symbols) = get_initial symbols; insert_tokens entry.egram symbols; insert_level entry e1 symbols action lev }) lev level in ([lev :: levs], empty_lev)) ([], make_lev) rules in levs1 @ List.rev levs @ levs2 ; value extend entry (position, rules) = let elev = levels_of_rules entry position rules in do { entry.edesc := Dlevels elev; entry.estart := fun lev strm -> let f = Parser.start_parser_of_entry entry in do { entry.estart := f; f lev strm }; entry.econtinue := fun lev bp a strm -> let f = Parser.continue_parser_of_entry entry in do { entry.econtinue := f; f lev bp a strm } }; end; camlp4-5.3-1/camlp4/Camlp4/Struct/Grammar/Parser.ml000066400000000000000000000360511473134377200216570ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) module Make (Structure : Structure.S) = struct module Tools = Tools.Make Structure; module Failed = Failed.Make Structure; module Print = Print.Make Structure; open Structure; open Sig.Grammar; module StreamOrig = Stream; value njunk strm n = for i = 1 to n do Stream.junk strm done; value loc_bp = Tools.get_cur_loc; value loc_ep = Tools.get_prev_loc; value drop_prev_loc = Tools.drop_prev_loc; value add_loc bp parse_fun strm = let x = parse_fun strm in let ep = loc_ep strm in let loc = if Loc.start_off bp > Loc.stop_off ep then (* If nothing has been consumed, create a 0-length location. *) Loc.join bp else Loc.merge bp ep in (x, loc); value stream_peek_nth strm n = let rec loop i = fun [ [x :: xs] -> if i = 1 then Some x else loop (i - 1) xs | [] -> None ] in loop n (Stream.npeek n strm); (* We don't want Stream's functions to be used implictly. *) module Stream = struct type t 'a = StreamOrig.t 'a; exception Failure = StreamOrig.Failure; exception Error = StreamOrig.Error; value peek = StreamOrig.peek; value junk = StreamOrig.junk; value dup strm = (* This version of peek_nth is off-by-one from Stream.peek_nth *) let peek_nth n = loop n (Stream.npeek (n + 1) strm) where rec loop n = fun [ [] -> None | [x] -> if n = 0 then Some x else None | [_ :: l] -> loop (n - 1) l ] in Stream.from peek_nth; end; value try_parser ps strm = let strm' = Stream.dup strm in let r = try ps strm' with [ Stream.Error _ | Loc.Exc_located _ (Stream.Error _) -> raise Stream.Failure | exc -> raise exc ] in do { njunk strm (StreamOrig.count strm'); r; }; value level_number entry lab = let rec lookup levn = fun [ [] -> failwith ("unknown level " ^ lab) | [lev :: levs] -> if Tools.is_level_labelled lab lev then levn else lookup (succ levn) levs ] in match entry.edesc with [ Dlevels elev -> lookup 0 elev | Dparser _ -> raise Not_found ] ; value strict_parsing = ref False; value strict_parsing_warning = ref False; value rec top_symb entry = fun [ Sself | Snext -> Snterm entry | Snterml e _ -> Snterm e | Slist1sep s sep -> Slist1sep (top_symb entry s) sep | _ -> raise Stream.Failure ] ; value top_tree entry = fun [ Node {node = s; brother = bro; son = son} -> Node {node = top_symb entry s; brother = bro; son = son} | LocAct _ _ | DeadEnd -> raise Stream.Failure ] ; value entry_of_symb entry = fun [ Sself | Snext -> entry | Snterm e -> e | Snterml e _ -> e | _ -> raise Stream.Failure ] ; value continue entry loc a s son p1 = parser [: a = (entry_of_symb entry s).econtinue 0 loc a; act = p1 ?? Failed.tree_failed entry a s son :] -> Action.mk (fun _ -> Action.getf act a) ; (* PR#4603, PR#4330, PR#4551: Here loc_bp replaced get_loc_ep to fix all these bugs. If you do change it again look at these bugs. *) value skip_if_empty bp strm = if loc_bp strm = bp then Action.mk (fun _ -> raise Stream.Failure) else raise Stream.Failure ; value do_recover parser_of_tree entry nlevn alevn loc a s son = parser [ [: a = parser_of_tree entry nlevn alevn (top_tree entry son) :] -> a | [: a = skip_if_empty loc :] -> a | [: a = continue entry loc a s son (parser_of_tree entry nlevn alevn son) :] -> a ] ; value recover parser_of_tree entry nlevn alevn loc a s son strm = if strict_parsing.val then raise (Stream.Error (Failed.tree_failed entry a s son)) else let _ = if strict_parsing_warning.val then begin let msg = Failed.tree_failed entry a s son; Format.eprintf "Warning: trying to recover from syntax error"; if entry.ename <> "" then Format.eprintf " in [%s]" entry.ename else (); Format.eprintf "\n%s%a@." msg Loc.print loc; end else () in do_recover parser_of_tree entry nlevn alevn loc a s son strm ; value rec parser_of_tree entry nlevn alevn = fun [ DeadEnd -> parser [] | LocAct act _ -> parser [: :] -> act | Node {node = Sself; son = LocAct act _; brother = DeadEnd} -> parser [: a = entry.estart alevn :] -> Action.getf act a | Node {node = Sself; son = LocAct act _; brother = bro} -> let p2 = parser_of_tree entry nlevn alevn bro in parser [ [: a = entry.estart alevn :] -> Action.getf act a | [: a = p2 :] -> a ] | Node {node = s; son = son; brother = DeadEnd} -> let tokl = match s with [ Stoken _ | Skeyword _ -> Tools.get_token_list entry [] s son | _ -> None ] in match tokl with [ None -> let ps = parser_of_symbol entry nlevn s in let p1 = parser_of_tree entry nlevn alevn son in let p1 = parser_cont p1 entry nlevn alevn s son in fun strm -> let bp = loc_bp strm in match strm with parser [: a = ps; act = p1 bp a :] -> Action.getf act a | Some (tokl, last_tok, son) -> let p1 = parser_of_tree entry nlevn alevn son in let p1 = parser_cont p1 entry nlevn alevn last_tok son in parser_of_token_list p1 tokl ] | Node {node = s; son = son; brother = bro} -> let tokl = match s with [ Stoken _ | Skeyword _ -> Tools.get_token_list entry [] s son | _ -> None ] in match tokl with [ None -> let ps = parser_of_symbol entry nlevn s in let p1 = parser_of_tree entry nlevn alevn son in let p1 = parser_cont p1 entry nlevn alevn s son in let p2 = parser_of_tree entry nlevn alevn bro in fun strm -> let bp = loc_bp strm in match strm with parser [ [: a = ps; act = p1 bp a :] -> Action.getf act a | [: a = p2 :] -> a ] | Some (tokl, last_tok, son) -> let p1 = parser_of_tree entry nlevn alevn son in let p1 = parser_cont p1 entry nlevn alevn last_tok son in let p1 = parser_of_token_list p1 tokl in let p2 = parser_of_tree entry nlevn alevn bro in parser [ [: a = p1 :] -> a | [: a = p2 :] -> a ] ] ] and parser_cont p1 entry nlevn alevn s son loc a = parser [ [: a = p1 :] -> a | [: a = recover parser_of_tree entry nlevn alevn loc a s son :] -> a | [: :] -> raise (Stream.Error (Failed.tree_failed entry a s son)) ] and parser_of_token_list p1 tokl = loop 1 tokl where rec loop n = fun [ [Stoken (tematch, _) :: tokl] -> match tokl with [ [] -> let ps strm = match stream_peek_nth strm n with [ Some (tok, _) when tematch tok -> (njunk strm n; Action.mk tok) | _ -> raise Stream.Failure ] in fun strm -> let bp = loc_bp strm in match strm with parser [: a = ps; act = p1 bp a :] -> Action.getf act a | _ -> let ps strm = match stream_peek_nth strm n with [ Some (tok, _) when tematch tok -> tok | _ -> raise Stream.Failure ] in let p1 = loop (n + 1) tokl in parser [: tok = ps; s :] -> let act = p1 s in Action.getf act tok ] | [Skeyword kwd :: tokl] -> match tokl with [ [] -> let ps strm = match stream_peek_nth strm n with [ Some (tok, _) when Token.match_keyword kwd tok -> (njunk strm n; Action.mk tok) | _ -> raise Stream.Failure ] in fun strm -> let bp = loc_bp strm in match strm with parser [: a = ps; act = p1 bp a :] -> Action.getf act a | _ -> let ps strm = match stream_peek_nth strm n with [ Some (tok, _) when Token.match_keyword kwd tok -> tok | _ -> raise Stream.Failure ] in let p1 = loop (n + 1) tokl in parser [: tok = ps; s :] -> let act = p1 s in Action.getf act tok ] | _ -> invalid_arg "parser_of_token_list" ] and parser_of_symbol entry nlevn = fun [ Smeta _ symbl act -> let act = Obj.magic act entry symbl in let pl = List.map (parser_of_symbol entry nlevn) symbl in Obj.magic (List.fold_left (fun act p -> Obj.magic act p) act pl) | Slist0 s -> let ps = parser_of_symbol entry nlevn s in let rec loop al = parser [ [: a = ps; s :] -> loop [a :: al] s | [: :] -> al ] in parser [: a = loop [] :] -> Action.mk (List.rev a) | Slist0sep symb sep -> let ps = parser_of_symbol entry nlevn symb in let pt = parser_of_symbol entry nlevn sep in let rec kont al = parser [ [: v = pt; a = ps ?? Failed.symb_failed entry v sep symb; s :] -> kont [a :: al] s | [: :] -> al ] in parser [ [: a = ps; s :] -> Action.mk (List.rev (kont [a] s)) | [: :] -> Action.mk [] ] | Slist1 s -> let ps = parser_of_symbol entry nlevn s in let rec loop al = parser [ [: a = ps; s :] -> loop [a :: al] s | [: :] -> al ] in parser [: a = ps; s :] -> Action.mk (List.rev (loop [a] s)) | Slist1sep symb sep -> let ps = parser_of_symbol entry nlevn symb in let pt = parser_of_symbol entry nlevn sep in let rec kont al = parser [ [: v = pt; a = parser [ [: a = ps :] -> a | [: a = parse_top_symb entry symb :] -> a | [: :] -> raise (Stream.Error (Failed.symb_failed entry v sep symb)) ]; s :] -> kont [a :: al] s | [: :] -> al ] in parser [: a = ps; s :] -> Action.mk (List.rev (kont [a] s)) | Sopt s -> let ps = parser_of_symbol entry nlevn s in parser [ [: a = ps :] -> Action.mk (Some a) | [: :] -> Action.mk None ] | Stry s -> let ps = parser_of_symbol entry nlevn s in try_parser ps | Stree t -> let pt = parser_of_tree entry 1 0 t in fun strm -> let bp = loc_bp strm in match strm with parser [: (act, loc) = add_loc bp pt :] -> Action.getf act loc | Snterm e -> parser [: a = e.estart 0 :] -> a | Snterml e l -> parser [: a = e.estart (level_number e l) :] -> a | Sself -> parser [: a = entry.estart 0 :] -> a | Snext -> parser [: a = entry.estart nlevn :] -> a | Skeyword kwd -> parser [: `(tok, _) when Token.match_keyword kwd tok :] -> Action.mk tok | Stoken (f, _) -> parser [: `(tok,_) when f tok :] -> Action.mk tok ] and parse_top_symb entry symb strm = parser_of_symbol entry 0 (top_symb entry symb) strm; value rec start_parser_of_levels entry clevn = fun [ [] -> fun _ -> parser [] | [lev :: levs] -> let p1 = start_parser_of_levels entry (succ clevn) levs in match lev.lprefix with [ DeadEnd -> p1 | tree -> let alevn = match lev.assoc with [ LeftA | NonA -> succ clevn | RightA -> clevn ] in let p2 = parser_of_tree entry (succ clevn) alevn tree in match levs with [ [] -> fun levn strm -> let bp = loc_bp strm in match strm with parser [: (act, loc) = add_loc bp p2; strm :] -> let a = Action.getf act loc in entry.econtinue levn loc a strm | _ -> fun levn strm -> if levn > clevn then p1 levn strm else let bp = loc_bp strm in match strm with parser [ [: (act, loc) = add_loc bp p2 :] -> let a = Action.getf act loc in entry.econtinue levn loc a strm | [: act = p1 levn :] -> act ] ] ] ] ; value start_parser_of_entry entry = debug gram "start_parser_of_entry: @[<2>%a@]@." Print.entry entry in match entry.edesc with [ Dlevels [] -> Tools.empty_entry entry.ename | Dlevels elev -> start_parser_of_levels entry 0 elev | Dparser p -> fun _ -> p ] ; value rec continue_parser_of_levels entry clevn = fun [ [] -> fun _ _ _ -> parser [] | [lev :: levs] -> let p1 = continue_parser_of_levels entry (succ clevn) levs in match lev.lsuffix with [ DeadEnd -> p1 | tree -> let alevn = match lev.assoc with [ LeftA | NonA -> succ clevn | RightA -> clevn ] in let p2 = parser_of_tree entry (succ clevn) alevn tree in fun levn bp a strm -> if levn > clevn then p1 levn bp a strm else match strm with parser [ [: act = p1 levn bp a :] -> act | [: (act, loc) = add_loc bp p2 :] -> let a = Action.getf2 act a loc in entry.econtinue levn loc a strm ] ] ] ; value continue_parser_of_entry entry = debug gram "continue_parser_of_entry: @[<2>%a@]@." Print.entry entry in match entry.edesc with [ Dlevels elev -> let p = continue_parser_of_levels entry 0 elev in fun levn bp a -> parser [ [: a = p levn bp a :] -> a | [: :] -> a ] | Dparser _ -> fun _ _ _ -> parser [] ] ; end; camlp4-5.3-1/camlp4/Camlp4/Struct/Grammar/Parser.mli000066400000000000000000000053211473134377200220240ustar00rootroot00000000000000(* camlp4r *) (****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2007 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) module Make (Structure : Structure.S) : sig open Structure; value add_loc : Loc.t -> (token_stream -> 'b) -> token_stream -> ('b * Loc.t); value level_number : internal_entry -> string -> int; value strict_parsing : ref bool; value strict_parsing_warning : ref bool; value top_symb : internal_entry -> symbol -> symbol; value top_tree : internal_entry -> tree -> tree; value entry_of_symb : internal_entry -> symbol -> internal_entry; value continue : internal_entry -> Loc.t -> Action.t -> symbol -> tree -> efun -> efun; value do_recover : (internal_entry -> 'a -> 'b -> tree -> efun) -> internal_entry -> 'a -> 'b -> Loc.t -> Action.t -> symbol -> tree -> efun; value recover : (internal_entry -> 'a -> 'b -> tree -> efun) -> internal_entry -> 'a -> 'b -> Loc.t -> Action.t -> symbol -> tree -> efun; value parser_of_tree : internal_entry -> int -> int -> tree -> efun; value parser_cont : efun -> internal_entry -> int -> int -> symbol -> tree -> Loc.t -> Action.t -> efun; value parser_of_token_list : (Loc.t -> Action.t -> efun) -> list symbol -> efun; value parser_of_symbol : internal_entry -> int -> symbol -> efun; value parse_top_symb : internal_entry -> symbol -> efun; value start_parser_of_levels : internal_entry -> int -> list level -> int -> efun; value start_parser_of_entry : internal_entry -> int -> efun; value continue_parser_of_levels : internal_entry -> int -> list level -> int -> Loc.t -> 'a -> efun; value continue_parser_of_entry : internal_entry -> int -> Loc.t -> Action.t -> efun; end; camlp4-5.3-1/camlp4/Camlp4/Struct/Grammar/Print.ml000066400000000000000000000214731473134377200215210ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) module Make (Structure : Structure.S) = struct open Structure; open Format; open Sig.Grammar; value rec flatten_tree = fun [ DeadEnd -> [] | LocAct _ _ -> [[]] | Node {node = n; brother = b; son = s} -> [ [n :: l] | l <- flatten_tree s ] @ flatten_tree b ]; value rec print_symbol ppf = fun [ Smeta n sl _ -> print_meta ppf n sl | Slist0 s -> fprintf ppf "LIST0 %a" print_symbol1 s | Slist0sep s t -> fprintf ppf "LIST0 %a SEP %a" print_symbol1 s print_symbol1 t | Slist1 s -> fprintf ppf "LIST1 %a" print_symbol1 s | Slist1sep s t -> fprintf ppf "LIST1 %a SEP %a" print_symbol1 s print_symbol1 t | Sopt s -> fprintf ppf "OPT %a" print_symbol1 s | Stry s -> fprintf ppf "TRY %a" print_symbol1 s | Snterml e l -> fprintf ppf "%s@ LEVEL@ %S" e.ename l | Snterm _ | Snext | Sself | Stree _ | Stoken _ | Skeyword _ as s -> print_symbol1 ppf s ] and print_meta ppf n sl = loop 0 sl where rec loop i = fun [ [] -> () | [s :: sl] -> let j = try String.index_from n i ' ' with [ Not_found -> String.length n ] in do { fprintf ppf "%s %a" (String.sub n i (j - i)) print_symbol1 s; if sl = [] then () else do { fprintf ppf " "; loop (min (j + 1) (String.length n)) sl } } ] and print_symbol1 ppf = fun [ Snterm e -> pp_print_string ppf e.ename | Sself -> pp_print_string ppf "SELF" | Snext -> pp_print_string ppf "NEXT" | Stoken (_, descr) -> pp_print_string ppf descr | Skeyword s -> fprintf ppf "%S" s | Stree t -> print_level ppf pp_print_space (flatten_tree t) | Smeta _ _ _ | Snterml _ _ | Slist0 _ | Slist0sep _ _ | Slist1 _ | Slist1sep _ _ | Sopt _ | Stry _ as s -> fprintf ppf "(%a)" print_symbol s ] and print_rule ppf symbols = do { fprintf ppf "@["; let _ = List.fold_left (fun sep symbol -> do { fprintf ppf "%t%a" sep print_symbol symbol; fun ppf -> fprintf ppf ";@ " }) (fun _ -> ()) symbols in fprintf ppf "@]" } and print_level ppf pp_print_space rules = do { fprintf ppf "@[[ "; let _ = List.fold_left (fun sep rule -> do { fprintf ppf "%t%a" sep print_rule rule; fun ppf -> fprintf ppf "%a| " pp_print_space () }) (fun _ -> ()) rules in fprintf ppf " ]@]" } ; value levels ppf elev = let _ = List.fold_left (fun sep lev -> let rules = [ [Sself :: t] | t <- flatten_tree lev.lsuffix ] @ flatten_tree lev.lprefix in do { fprintf ppf "%t@[" sep; match lev.lname with [ Some n -> fprintf ppf "%S@;<1 2>" n | None -> () ]; match lev.assoc with [ LeftA -> fprintf ppf "LEFTA" | RightA -> fprintf ppf "RIGHTA" | NonA -> fprintf ppf "NONA" ]; fprintf ppf "@]@;<1 2>"; print_level ppf pp_force_newline rules; fun ppf -> fprintf ppf "@,| " }) (fun _ -> ()) elev in (); value entry ppf e = do { fprintf ppf "@[%s: [ " e.ename; match e.edesc with [ Dlevels elev -> levels ppf elev | Dparser _ -> fprintf ppf "" ]; fprintf ppf " ]@]" }; end; module MakeDump (Structure : Structure.S) = struct open Structure; open Format; open Sig.Grammar; type brothers = [ Bro of symbol and list brothers ]; value rec print_tree ppf tree = let rec get_brothers acc = fun [ DeadEnd -> List.rev acc | LocAct _ _ -> List.rev acc | Node {node = n; brother = b; son = s} -> get_brothers [Bro n (get_brothers [] s) :: acc] b ] and print_brothers ppf brothers = if brothers = [] then fprintf ppf "@ []" else List.iter (fun [ Bro n xs -> do { fprintf ppf "@ @[- %a" print_symbol n; match xs with [ [] -> () | [_] -> try print_children ppf (get_children [] xs) with [ Exit -> fprintf ppf ":%a" print_brothers xs ] | _ -> fprintf ppf ":%a" print_brothers xs ]; fprintf ppf "@]"; }]) brothers and print_children ppf = List.iter (fprintf ppf ";@ %a" print_symbol) and get_children acc = fun [ [] -> List.rev acc | [Bro n x] -> get_children [n::acc] x | _ -> raise Exit ] in print_brothers ppf (get_brothers [] tree) and print_symbol ppf = fun [ Smeta n sl _ -> print_meta ppf n sl | Slist0 s -> fprintf ppf "LIST0 %a" print_symbol1 s | Slist0sep s t -> fprintf ppf "LIST0 %a SEP %a" print_symbol1 s print_symbol1 t | Slist1 s -> fprintf ppf "LIST1 %a" print_symbol1 s | Slist1sep s t -> fprintf ppf "LIST1 %a SEP %a" print_symbol1 s print_symbol1 t | Sopt s -> fprintf ppf "OPT %a" print_symbol1 s | Stry s -> fprintf ppf "TRY %a" print_symbol1 s | Snterml e l -> fprintf ppf "%s@ LEVEL@ %S" e.ename l | Snterm _ | Snext | Sself | Stree _ | Stoken _ | Skeyword _ as s -> print_symbol1 ppf s ] and print_meta ppf n sl = loop 0 sl where rec loop i = fun [ [] -> () | [s :: sl] -> let j = try String.index_from n i ' ' with [ Not_found -> String.length n ] in do { fprintf ppf "%s %a" (String.sub n i (j - i)) print_symbol1 s; if sl = [] then () else do { fprintf ppf " "; loop (min (j + 1) (String.length n)) sl } } ] and print_symbol1 ppf = fun [ Snterm e -> pp_print_string ppf e.ename | Sself -> pp_print_string ppf "SELF" | Snext -> pp_print_string ppf "NEXT" | Stoken (_, descr) -> pp_print_string ppf descr | Skeyword s -> fprintf ppf "%S" s | Stree t -> print_tree ppf t | Smeta _ _ _ | Snterml _ _ | Slist0 _ | Slist0sep _ _ | Slist1 _ | Slist1sep _ _ | Sopt _ | Stry _ as s -> fprintf ppf "(%a)" print_symbol s ] and print_rule ppf symbols = do { fprintf ppf "@["; let _ = List.fold_left (fun sep symbol -> do { fprintf ppf "%t%a" sep print_symbol symbol; fun ppf -> fprintf ppf ";@ " }) (fun _ -> ()) symbols in fprintf ppf "@]" } and print_level ppf pp_print_space rules = do { fprintf ppf "@[[ "; let _ = List.fold_left (fun sep rule -> do { fprintf ppf "%t%a" sep print_rule rule; fun ppf -> fprintf ppf "%a| " pp_print_space () }) (fun _ -> ()) rules in fprintf ppf " ]@]" } ; value levels ppf elev = let _ = List.fold_left (fun sep lev -> do { fprintf ppf "%t@[" sep; match lev.lname with [ Some n -> fprintf ppf "%S@;<1 2>" n | None -> () ]; match lev.assoc with [ LeftA -> fprintf ppf "LEFTA" | RightA -> fprintf ppf "RIGHTA" | NonA -> fprintf ppf "NONA" ]; fprintf ppf "@]@;<1 2>"; fprintf ppf "@[suffix:@ "; print_tree ppf lev.lsuffix; fprintf ppf "@]@ @[prefix:@ "; print_tree ppf lev.lprefix; fprintf ppf "@]"; fun ppf -> fprintf ppf "@,| " }) (fun _ -> ()) elev in (); value entry ppf e = do { fprintf ppf "@[%s: [ " e.ename; match e.edesc with [ Dlevels elev -> levels ppf elev | Dparser _ -> fprintf ppf "" ]; fprintf ppf " ]@]" }; end; camlp4-5.3-1/camlp4/Camlp4/Struct/Grammar/Print.mli000066400000000000000000000045721473134377200216730ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) module Make (Structure : Structure.S) : sig value flatten_tree : Structure.tree -> list (list Structure.symbol); value print_symbol : Format.formatter -> Structure.symbol -> unit; value print_meta : Format.formatter -> string -> list Structure.symbol -> unit; value print_symbol1 : Format.formatter -> Structure.symbol -> unit; value print_rule : Format.formatter -> list Structure.symbol -> unit; value print_level : Format.formatter -> (Format.formatter -> unit -> unit) -> list (list Structure.symbol) -> unit; value levels : Format.formatter -> list Structure.level -> unit; value entry : Format.formatter -> Structure.internal_entry -> unit; end; module MakeDump (Structure : Structure.S) : sig value print_symbol : Format.formatter -> Structure.symbol -> unit; value print_meta : Format.formatter -> string -> list Structure.symbol -> unit; value print_symbol1 : Format.formatter -> Structure.symbol -> unit; value print_rule : Format.formatter -> list Structure.symbol -> unit; value print_level : Format.formatter -> (Format.formatter -> unit -> unit) -> list (list Structure.symbol) -> unit; value levels : Format.formatter -> list Structure.level -> unit; value entry : Format.formatter -> Structure.internal_entry -> unit; end; camlp4-5.3-1/camlp4/Camlp4/Struct/Grammar/Search.ml000066400000000000000000000073741473134377200216360ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) module Make (Structure : Structure.S) = struct open Structure; value tree_in_entry prev_symb tree = fun [ Dlevels levels -> let rec search_levels = fun [ [] -> tree | [level :: levels] -> match search_level level with [ Some tree -> tree | None -> search_levels levels ] ] and search_level level = match search_tree level.lsuffix with [ Some t -> Some (Node {node = Sself; son = t; brother = DeadEnd}) | None -> search_tree level.lprefix ] and search_tree t = if tree <> DeadEnd && t == tree then Some t else match t with [ Node n -> match search_symbol n.node with [ Some symb -> Some (Node {node = symb; son = n.son; brother = DeadEnd}) | None -> match search_tree n.son with [ Some t -> Some (Node {node = n.node; son = t; brother = DeadEnd}) | None -> search_tree n.brother ] ] | LocAct _ _ | DeadEnd -> None ] and search_symbol symb = match symb with [ Snterm _ | Snterml _ _ | Slist0 _ | Slist0sep _ _ | Slist1 _ | Slist1sep _ _ | Sopt _ | Stry _ | Stoken _ | Stree _ | Skeyword _ when symb == prev_symb -> Some symb | Slist0 symb -> match search_symbol symb with [ Some symb -> Some (Slist0 symb) | None -> None ] | Slist0sep symb sep -> match search_symbol symb with [ Some symb -> Some (Slist0sep symb sep) | None -> match search_symbol sep with [ Some sep -> Some (Slist0sep symb sep) | None -> None ] ] | Slist1 symb -> match search_symbol symb with [ Some symb -> Some (Slist1 symb) | None -> None ] | Slist1sep symb sep -> match search_symbol symb with [ Some symb -> Some (Slist1sep symb sep) | None -> match search_symbol sep with [ Some sep -> Some (Slist1sep symb sep) | None -> None ] ] | Sopt symb -> match search_symbol symb with [ Some symb -> Some (Sopt symb) | None -> None ] | Stry symb -> match search_symbol symb with [ Some symb -> Some (Stry symb) | None -> None ] | Stree t -> match search_tree t with [ Some t -> Some (Stree t) | None -> None ] | _ -> None ] in search_levels levels | Dparser _ -> tree ] ; end; camlp4-5.3-1/camlp4/Camlp4/Struct/Grammar/Static.ml000066400000000000000000000057711473134377200216570ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) value uncurry f (x,y) = f x y; value flip f x y = f y x; module Make (Lexer : Sig.Lexer) : Sig.Grammar.Static with module Loc = Lexer.Loc and module Token = Lexer.Token = struct module Structure = Structure.Make Lexer; module Delete = Delete.Make Structure; module Insert = Insert.Make Structure; module Fold = Fold.Make Structure; module Tools = Tools.Make Structure; include Structure; value gram = let gkeywords = Hashtbl.create 301 in { gkeywords = gkeywords; gfilter = Token.Filter.mk (Hashtbl.mem gkeywords); glexer = Lexer.mk (); warning_verbose = ref True; (* FIXME *) error_verbose = Camlp4_config.verbose }; module Entry = struct module E = Entry.Make Structure; type t 'a = E.t 'a; value mk = E.mk gram; value of_parser name strm = E.of_parser gram name strm; value setup_parser = E.setup_parser; value name = E.name; value print = E.print; value clear = E.clear; value dump = E.dump; value obj x = x; end; value get_filter () = gram.gfilter; value lex loc cs = gram.glexer loc cs; value lex_string loc str = lex loc (Stream.of_string str); value filter ts = Tools.keep_prev_loc (Token.Filter.filter gram.gfilter ts); value parse_tokens_after_filter entry ts = Entry.E.parse_tokens_after_filter entry ts; value parse_tokens_before_filter entry ts = parse_tokens_after_filter entry (filter ts); value parse entry loc cs = parse_tokens_before_filter entry (lex loc cs); value parse_string entry loc str = parse_tokens_before_filter entry (lex_string loc str); value delete_rule = Delete.delete_rule; value srules e rl = Stree (List.fold_left (flip (uncurry (Insert.insert_tree e))) DeadEnd rl); value sfold0 = Fold.sfold0; value sfold1 = Fold.sfold1; value sfold0sep = Fold.sfold0sep; (* value sfold1sep = Fold.sfold1sep; *) value extend = Insert.extend; end; camlp4-5.3-1/camlp4/Camlp4/Struct/Grammar/Structure.ml000066400000000000000000000213661473134377200224260ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) open Sig.Grammar; module type S = sig module Loc : Sig.Loc; module Token : Sig.Token with module Loc = Loc; module Lexer : Sig.Lexer with module Loc = Loc and module Token = Token; module Action : Sig.Grammar.Action; type gram = { gfilter : Token.Filter.t; gkeywords : Hashtbl.t string (ref int); glexer : Loc.t -> Stream.t char -> Stream.t (Token.t * Loc.t); warning_verbose : ref bool; error_verbose : ref bool }; type token_info = { prev_loc : Loc.t ; cur_loc : Loc.t ; prev_loc_only : bool }; type token_stream = Stream.t (Token.t * token_info); type efun = token_stream -> Action.t; type token_pattern = ((Token.t -> bool) * string); type internal_entry = { egram : gram; ename : string; estart : mutable int -> efun; econtinue : mutable int -> Loc.t -> Action.t -> efun; edesc : mutable desc } and desc = [ Dlevels of list level | Dparser of token_stream -> Action.t ] and level = { assoc : assoc ; lname : option string ; lsuffix : tree ; lprefix : tree } and symbol = [ Smeta of string and list symbol and Action.t | Snterm of internal_entry | Snterml of internal_entry and string | Slist0 of symbol | Slist0sep of symbol and symbol | Slist1 of symbol | Slist1sep of symbol and symbol | Sopt of symbol | Stry of symbol | Sself | Snext | Stoken of token_pattern | Skeyword of string | Stree of tree ] and tree = [ Node of node | LocAct of Action.t and list Action.t | DeadEnd ] and node = { node : symbol ; son : tree ; brother : tree }; type production_rule = (list symbol * Action.t); type single_extend_statment = (option string * option assoc * list production_rule); type extend_statment = (option position * list single_extend_statment); type delete_statment = list symbol; type fold 'a 'b 'c = internal_entry -> list symbol -> (Stream.t 'a -> 'b) -> Stream.t 'a -> 'c; type foldsep 'a 'b 'c = internal_entry -> list symbol -> (Stream.t 'a -> 'b) -> (Stream.t 'a -> unit) -> Stream.t 'a -> 'c; (* Accessors *) value get_filter : gram -> Token.Filter.t; (* Useful functions *) value using : gram -> string -> unit; value removing : gram -> string -> unit; end; module Make (Lexer : Sig.Lexer) = struct module Loc = Lexer.Loc; module Token = Lexer.Token; module Action : Sig.Grammar.Action = struct type t = Obj.t ; value mk = Obj.repr; value get = Obj.obj ; value getf = Obj.obj ; value getf2 = Obj.obj ; end; module Lexer = Lexer; type gram = { gfilter : Token.Filter.t; gkeywords : Hashtbl.t string (ref int); glexer : Loc.t -> Stream.t char -> Stream.t (Token.t * Loc.t); warning_verbose : ref bool; error_verbose : ref bool }; type token_info = { prev_loc : Loc.t ; cur_loc : Loc.t ; prev_loc_only : bool }; type token_stream = Stream.t (Token.t * token_info); type efun = token_stream -> Action.t; type token_pattern = ((Token.t -> bool) * string); type internal_entry = { egram : gram; ename : string; estart : mutable int -> efun; econtinue : mutable int -> Loc.t -> Action.t -> efun; edesc : mutable desc } and desc = [ Dlevels of list level | Dparser of token_stream -> Action.t ] and level = { assoc : assoc ; lname : option string ; lsuffix : tree ; lprefix : tree } and symbol = [ Smeta of string and list symbol and Action.t | Snterm of internal_entry | Snterml of internal_entry and string | Slist0 of symbol | Slist0sep of symbol and symbol | Slist1 of symbol | Slist1sep of symbol and symbol | Sopt of symbol | Stry of symbol | Sself | Snext | Stoken of token_pattern | Skeyword of string | Stree of tree ] and tree = [ Node of node | LocAct of Action.t and list Action.t | DeadEnd ] and node = { node : symbol ; son : tree ; brother : tree }; type production_rule = (list symbol * Action.t); type single_extend_statment = (option string * option assoc * list production_rule); type extend_statment = (option position * list single_extend_statment); type delete_statment = list symbol; type fold 'a 'b 'c = internal_entry -> list symbol -> (Stream.t 'a -> 'b) -> Stream.t 'a -> 'c; type foldsep 'a 'b 'c = internal_entry -> list symbol -> (Stream.t 'a -> 'b) -> (Stream.t 'a -> unit) -> Stream.t 'a -> 'c; value get_filter g = g.gfilter; value token_location r = r.cur_loc; type not_filtered 'a = 'a; value using { gkeywords = table; gfilter = filter } kwd = let r = try Hashtbl.find table kwd with [ Not_found -> let r = ref 0 in do { Hashtbl.add table kwd r; r } ] in do { Token.Filter.keyword_added filter kwd (r.val = 0); incr r }; value removing { gkeywords = table; gfilter = filter } kwd = let r = Hashtbl.find table kwd in let () = decr r in if r.val = 0 then do { Token.Filter.keyword_removed filter kwd; Hashtbl.remove table kwd } else (); end; (* value iter_entry f e = let treated = ref [] in let rec do_entry e = if List.memq e treated.val then () else do { treated.val := [e :: treated.val]; f e; match e.edesc with [ Dlevels ll -> List.iter do_level ll | Dparser _ -> () ] } and do_level lev = do { do_tree lev.lsuffix; do_tree lev.lprefix } and do_tree = fun [ Node n -> do_node n | LocAct _ _ | DeadEnd -> () ] and do_node n = do { do_symbol n.node; do_tree n.son; do_tree n.brother } and do_symbol = fun [ Smeta _ sl _ -> List.iter do_symbol sl | Snterm e | Snterml e _ -> do_entry e | Slist0 s | Slist1 s | Sopt s | Stry s -> do_symbol s | Slist0sep s1 s2 | Slist1sep s1 s2 -> do { do_symbol s1; do_symbol s2 } | Stree t -> do_tree t | Sself | Snext | Stoken _ | Stoken_fun _ -> () ] in do_entry e ; value fold_entry f e init = let treated = ref [] in let rec do_entry accu e = if List.memq e treated.val then accu else do { treated.val := [e :: treated.val]; let accu = f e accu in match e.edesc with [ Dlevels ll -> List.fold_left do_level accu ll | Dparser _ -> accu ] } and do_level accu lev = let accu = do_tree accu lev.lsuffix in do_tree accu lev.lprefix and do_tree accu = fun [ Node n -> do_node accu n | LocAct _ _ | DeadEnd -> accu ] and do_node accu n = let accu = do_symbol accu n.node in let accu = do_tree accu n.son in do_tree accu n.brother and do_symbol accu = fun [ Smeta _ sl _ -> List.fold_left do_symbol accu sl | Snterm e | Snterml e _ -> do_entry accu e | Slist0 s | Slist1 s | Sopt s | Stry s -> do_symbol accu s | Slist0sep s1 s2 | Slist1sep s1 s2 -> let accu = do_symbol accu s1 in do_symbol accu s2 | Stree t -> do_tree accu t | Sself | Snext | Stoken _ | Stoken_fun _ -> accu ] in do_entry init e ; value is_level_labelled n lev = match lev.lname with [ Some n1 -> n = n1 | None -> False ] ; value tokens g con = let list = ref [] in do { Hashtbl.iter (fun (p_con, p_prm) c -> if p_con = con then list.val := [(p_prm, c.val) :: list.val] else ()) g.gtokens; list.val } ; *) camlp4-5.3-1/camlp4/Camlp4/Struct/Grammar/Tools.ml000066400000000000000000000114011473134377200215130ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) (* PR#5090: don't do lookahead on get_prev_loc. *) value get_prev_loc_only = ref False; module Make (Structure : Structure.S) = struct open Structure; value empty_entry ename _ = raise (Stream.Error ("entry [" ^ ename ^ "] is empty")); value rec stream_map f = parser [ [: ` x; strm :] -> [: ` (f x); stream_map f strm :] | [: :] -> [: :] ]; value keep_prev_loc strm = match Stream.peek strm with [ None -> [: :] | Some (tok0,init_loc) -> let rec go prev_loc strm1 = if get_prev_loc_only.val then [: `(tok0, {prev_loc; cur_loc = prev_loc; prev_loc_only = True}); go prev_loc strm1 :] else match strm1 with parser [ [: `(tok,cur_loc); strm :] -> [: `(tok, {prev_loc; cur_loc; prev_loc_only = False}); go cur_loc strm :] | [: :] -> [: :] ] in go init_loc strm ]; value drop_prev_loc strm = stream_map (fun (tok,r) -> (tok,r.cur_loc)) strm; value get_cur_loc strm = match Stream.peek strm with [ Some (_,r) -> r.cur_loc | None -> Loc.ghost ]; value get_prev_loc strm = begin get_prev_loc_only.val := True; let result = match Stream.peek strm with [ Some (_, {prev_loc; prev_loc_only = True}) -> begin Stream.junk strm; prev_loc end | Some (_, {prev_loc; prev_loc_only = False}) -> prev_loc | None -> Loc.ghost ]; get_prev_loc_only.val := False; result end; value is_level_labelled n lev = match lev.lname with [ Some n1 -> n = n1 | None -> False ]; value warning_verbose = ref True; value rec get_token_list entry tokl last_tok tree = match tree with [ Node {node = (Stoken _ | Skeyword _ as tok); son = son; brother = DeadEnd} -> get_token_list entry [last_tok :: tokl] tok son | _ -> if tokl = [] then None else Some (List.rev [last_tok :: tokl], last_tok, tree) ]; value is_antiquot s = let len = String.length s in len > 1 && s.[0] = '$'; value eq_Stoken_ids s1 s2 = not (is_antiquot s1) && not (is_antiquot s2) && s1 = s2; value logically_eq_symbols entry = let rec eq_symbols s1 s2 = match (s1, s2) with [ (Snterm e1, Snterm e2) -> e1.ename = e2.ename | (Snterm e1, Sself) -> e1.ename = entry.ename | (Sself, Snterm e2) -> entry.ename = e2.ename | (Snterml e1 l1, Snterml e2 l2) -> e1.ename = e2.ename && l1 = l2 | (Slist0 s1, Slist0 s2) | (Slist1 s1, Slist1 s2) | (Sopt s1, Sopt s2) | (Stry s1, Stry s2) -> eq_symbols s1 s2 | (Slist0sep s1 sep1, Slist0sep s2 sep2) | (Slist1sep s1 sep1, Slist1sep s2 sep2) -> eq_symbols s1 s2 && eq_symbols sep1 sep2 | (Stree t1, Stree t2) -> eq_trees t1 t2 | (Stoken (_, s1), Stoken (_, s2)) -> eq_Stoken_ids s1 s2 | _ -> s1 = s2 ] and eq_trees t1 t2 = match (t1, t2) with [ (Node n1, Node n2) -> eq_symbols n1.node n2.node && eq_trees n1.son n2.son && eq_trees n1.brother n2.brother | (LocAct _ _ | DeadEnd, LocAct _ _ | DeadEnd) -> True | _ -> False ] in eq_symbols; value rec eq_symbol s1 s2 = match (s1, s2) with [ (Snterm e1, Snterm e2) -> e1 == e2 | (Snterml e1 l1, Snterml e2 l2) -> e1 == e2 && l1 = l2 | (Slist0 s1, Slist0 s2) | (Slist1 s1, Slist1 s2) | (Sopt s1, Sopt s2) | (Stry s1, Stry s2) -> eq_symbol s1 s2 | (Slist0sep s1 sep1, Slist0sep s2 sep2) | (Slist1sep s1 sep1, Slist1sep s2 sep2) -> eq_symbol s1 s2 && eq_symbol sep1 sep2 | (Stree _, Stree _) -> False | (Stoken (_, s1), Stoken (_, s2)) -> eq_Stoken_ids s1 s2 | _ -> s1 = s2 ] ; end; camlp4-5.3-1/camlp4/Camlp4/Struct/Lexer.mll000066400000000000000000000500171473134377200202660ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) (* The lexer definition *) { (** A lexical analyzer. *) (* FIXME interface module Make (Token : Token) |+ Note that this Token sig is not in Sig +| *) (* : Sig.Lexer. S with module Loc = Token.Loc and module Token = Token; *) (* type context = { loc : Loc.t ; in_comment : bool ; |+* FIXME When True, all lexers built by [Plexer.make ()] do not lex the quotation syntax any more. Default is False (quotations are lexed). +| quotations : bool }; value default_context : context; value mk : Loc.t -> Stream.t char -> Stream.t (Token.t * Loc.t); value mk' : context -> Stream.t char -> Stream.t (Token.t * Loc.t); *) (* FIXME Beware the context argument must be given like that: * mk' { (default_context) with ... = ... } strm *) module TokenEval = Token.Eval module Make (Token : Sig.Camlp4Token) = struct module Loc = Token.Loc module Token = Token open Lexing open Sig (* Error report *) module Error = struct type t = | Illegal_character of char | Illegal_escape of string | Unterminated_comment | Unterminated_string | Unterminated_quotation | Unterminated_antiquot | Unterminated_string_in_comment | Comment_start | Comment_not_end | Literal_overflow of string | Invalid_literal of string exception E of t open Format let print ppf = function | Illegal_character c -> fprintf ppf "Illegal character (%s)" (Char.escaped c) | Illegal_escape s -> fprintf ppf "Illegal backslash escape in string or character (%s)" s | Unterminated_comment -> 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_quotation -> fprintf ppf "Quotation not terminated" | Unterminated_antiquot -> fprintf ppf "Antiquotation not terminated" | Literal_overflow ty -> fprintf ppf "Integer literal exceeds the range of representable integers of type %s" ty | Comment_start -> fprintf ppf "this is the start of a comment" | Comment_not_end -> fprintf ppf "this is not the end of a comment" | Invalid_literal s -> fprintf ppf "Invalid literal %s" s let to_string x = let b = Buffer.create 50 in let fmt = formatter_of_buffer b in let () = fprintf fmt "%a" print x in Buffer.contents b end;; let module M = ErrorHandler.Register(Error) in () open Error (* To store some context information: * loc : position of the beginning of a string, quotation and comment * in_comment: are we in a comment? * quotations: shall we lex quotation? * If quotations is false it's a SYMBOL token. * antiquots : shall we lex antiquotations. *) type context = { loc : Loc.t ; in_comment : bool ; quotations : bool ; antiquots : bool ; lexbuf : lexbuf ; buffer : Buffer.t } let default_context lb = { loc = Loc.ghost ; in_comment = false ; quotations = true ; antiquots = false ; lexbuf = lb ; buffer = Buffer.create 256 } (* To buffer string literals, quotations and antiquotations *) let store c = Buffer.add_string c.buffer (Lexing.lexeme c.lexbuf) let istore_char c i = Buffer.add_char c.buffer (Lexing.lexeme_char c.lexbuf i) let buff_contents c = let contents = Buffer.contents c.buffer in Buffer.reset c.buffer; contents let loc c = Loc.merge c.loc (Loc.of_lexbuf c.lexbuf) let quotations c = c.quotations let antiquots c = c.antiquots let is_in_comment c = c.in_comment let in_comment c = { (c) with in_comment = true } let set_start_p c = c.lexbuf.lex_start_p <- Loc.start_pos c.loc let move_start_p shift c = (* FIXME Please see PR#5820*) let p = c.lexbuf.lex_start_p in c.lexbuf.lex_start_p <- { (p) with pos_cnum = p.pos_cnum + shift } let update_loc c = { (c) with loc = Loc.of_lexbuf c.lexbuf } let with_curr_loc f c = f (update_loc c) c.lexbuf let parse_nested f c = with_curr_loc f c; set_start_p c; buff_contents c let shift n c = { (c) with loc = Loc.move `both n c.loc } let store_parse f c = store c ; f c c.lexbuf let parse f c = f c c.lexbuf let mk_quotation quotation c name loc shift = let s = parse_nested quotation (update_loc c) in let contents = String.sub s 0 (String.length s - 2) in QUOTATION { q_name = name ; q_loc = loc ; q_shift = shift ; q_contents = contents } (* Update the current location with file name and line number. *) let update_loc c file line absolute chars = let lexbuf = c.lexbuf in let pos = lexbuf.lex_curr_p in let new_file = match file with | None -> pos.pos_fname | Some s -> s in lexbuf.lex_curr_p <- { pos with pos_fname = new_file; pos_lnum = if absolute then line else pos.pos_lnum + line; pos_bol = pos.pos_cnum - chars; } (* To convert integer literals, copied from "../parsing/lexer.mll" *) let cvt_int_literal s = - int_of_string ("-" ^ s) let cvt_int32_literal s = Int32.neg (Int32.of_string ("-" ^ s)) let cvt_int64_literal s = Int64.neg (Int64.of_string ("-" ^ s)) let cvt_nativeint_literal s = Nativeint.neg (Nativeint.of_string ("-" ^ s)) let err error loc = raise(Loc.Exc_located(loc, Error.E error)) let warn error loc = Format.eprintf "Warning: %a: %a@." Loc.print loc Error.print error } let newline = ('\010' | '\013' | "\013\010") let blank = [' ' '\009' '\012'] let lowercase = ['a'-'z' '\223'-'\246' '\248'-'\255' '_'] let uppercase = ['A'-'Z' '\192'-'\214' '\216'-'\222'] let identchar = ['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9'] let ident = (lowercase|uppercase) identchar* let quote_tag = (lowercase|uppercase) (identchar|'.')* let locname = ident let not_star_symbolchar = ['$' '!' '%' '&' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~' '\\'] let symbolchar = '*' | not_star_symbolchar let quotchar = ['!' '%' '&' '+' '-' '.' '/' ':' '=' '?' '@' '^' '|' '~' '\\' '*'] let hexa_char = ['0'-'9' 'A'-'F' 'a'-'f'] let decimal_literal = ['0'-'9'] ['0'-'9' '_']* let hex_literal = '0' ['x' 'X'] hexa_char ['0'-'9' 'A'-'F' 'a'-'f' '_']* let oct_literal = '0' ['o' 'O'] ['0'-'7'] ['0'-'7' '_']* let bin_literal = '0' ['b' 'B'] ['0'-'1'] ['0'-'1' '_']* let int_literal = decimal_literal | hex_literal | oct_literal | bin_literal let float_literal = ['0'-'9'] ['0'-'9' '_']* ('.' ['0'-'9' '_']* )? (['e' 'E'] ['+' '-']? ['0'-'9'] ['0'-'9' '_']*)? (* Delimitors are extended (from 3.09) in a conservative way *) (* These chars that can't start an expression or a pattern: *) let safe_delimchars = ['%' '&' '/' '@' '^'] (* These symbols are unsafe since "[<", "[|", etc. exsist. *) let delimchars = safe_delimchars | ['|' '<' '>' ':' '=' '.'] let left_delims = ['(' '[' '{'] let right_delims = [')' ']' '}'] let left_delimitor = (* At least a safe_delimchars *) left_delims delimchars* safe_delimchars (delimchars|left_delims)* (* A '(' or a new super '(' without "(<" *) | '(' (['|' ':'] delimchars*)? (* Old brackets, no new brackets starting with "[|" or "[:" *) | '[' ['|' ':']? (* Old "[<","{<" and new ones *) | ['[' '{'] delimchars* '<' (* Old brace and new ones *) | '{' (['|' ':'] delimchars*)? let right_delimitor = (* At least a safe_delimchars *) (delimchars|right_delims)* safe_delimchars (delimchars|right_delims)* right_delims (* A ')' or a new super ')' without ">)" *) | (delimchars* ['|' ':'])? ')' (* Old brackets, no new brackets ending with "|]" or ":]" *) | ['|' ':']? ']' (* Old ">]",">}" and new ones *) | '>' delimchars* [']' '}'] (* Old brace and new ones *) | (delimchars* ['|' ':'])? '}' rule token c = parse | newline { update_loc c None 1 false 0; NEWLINE } | blank + as x { BLANKS x } | "~" (lowercase identchar * as x) ':' { LABEL x } | "?" (lowercase identchar * as x) ':' { OPTLABEL x } | lowercase identchar * as x { LIDENT x } | uppercase identchar * as x { UIDENT x } | int_literal as i { try INT(cvt_int_literal i, i) with Failure _ -> err (Literal_overflow "int") (Loc.of_lexbuf lexbuf) } | float_literal as f { try FLOAT(float_of_string f, f) with Failure _ -> err (Literal_overflow "float") (Loc.of_lexbuf lexbuf) } | (int_literal as i) "l" { try INT32(cvt_int32_literal i, i) with Failure _ -> err (Literal_overflow "int32") (Loc.of_lexbuf lexbuf) } | (int_literal as i) "L" { try INT64(cvt_int64_literal i, i) with Failure _ -> err (Literal_overflow "int64") (Loc.of_lexbuf lexbuf) } | (int_literal as i) "n" { try NATIVEINT(cvt_nativeint_literal i, i) with Failure _ -> err (Literal_overflow "nativeint") (Loc.of_lexbuf lexbuf) } | (float_literal | int_literal) identchar+ { err (Invalid_literal (Lexing.lexeme lexbuf)) (Loc.of_lexbuf lexbuf) } | '"' { with_curr_loc string c; let s = buff_contents c in STRING (TokenEval.string s, s) } | "'" (newline as x) "'" { update_loc c None 1 false 1; CHAR (TokenEval.char x, x) } | "'" ( [^ '\\' '\010' '\013'] | '\\' (['\\' '"' 'n' 't' 'b' 'r' ' ' '\''] |['0'-'9'] ['0'-'9'] ['0'-'9'] |'x' hexa_char hexa_char) as x) "'" { CHAR (TokenEval.char x, x) } | "'\\" (_ as c) { err (Illegal_escape (String.make 1 c)) (Loc.of_lexbuf lexbuf) } | "(*" { store c; COMMENT(parse_nested comment (in_comment c)) } | "(*)" { warn Comment_start (Loc.of_lexbuf lexbuf) ; parse comment (in_comment c); COMMENT (buff_contents c) } | "*)" { warn Comment_not_end (Loc.of_lexbuf lexbuf) ; c.lexbuf.lex_curr_pos <- c.lexbuf.lex_curr_pos - 1; SYMBOL "*" } | "<<" (quotchar* as beginning) { if quotations c then (move_start_p (-String.length beginning); mk_quotation quotation c "" "" 2) else parse (symbolchar_star ("<<" ^ beginning)) c } | "<<>>" { if quotations c then QUOTATION { q_name = ""; q_loc = ""; q_shift = 2; q_contents = "" } else parse (symbolchar_star "<<>>") c } | "<@" { if quotations c then with_curr_loc maybe_quotation_at c else parse (symbolchar_star "<@") c } | "<:" { if quotations c then with_curr_loc maybe_quotation_colon c else parse (symbolchar_star "<:") c } | "#" [' ' '\t']* (['0'-'9']+ as num) [' ' '\t']* ("\"" ([^ '\010' '\013' '"' ] * as name) "\"")? [^ '\010' '\013'] * newline { let inum = int_of_string num in update_loc c name inum true 0; LINE_DIRECTIVE(inum, name) } | '(' (not_star_symbolchar as op) ')' { ESCAPED_IDENT (String.make 1 op) } | '(' (not_star_symbolchar symbolchar* not_star_symbolchar as op) ')' { ESCAPED_IDENT op } | '(' (not_star_symbolchar symbolchar* as op) blank+ ')' { ESCAPED_IDENT op } | '(' blank+ (symbolchar* not_star_symbolchar as op) ')' { ESCAPED_IDENT op } | '(' blank+ (symbolchar+ as op) blank+ ')' { ESCAPED_IDENT op } | ( "#" | "`" | "'" | "," | "." | ".." | ":" | "::" | ":=" | ":>" | ";" | ";;" | "_" | left_delimitor | right_delimitor ) as x { SYMBOL x } | '$' { if antiquots c then with_curr_loc dollar (shift 1 c) else parse (symbolchar_star "$") c } | ['~' '?' '!' '=' '<' '>' '|' '&' '@' '^' '+' '-' '*' '/' '%' '\\'] symbolchar * as x { SYMBOL x } | eof { let pos = lexbuf.lex_curr_p in lexbuf.lex_curr_p <- { pos with pos_bol = pos.pos_bol + 1 ; pos_cnum = pos.pos_cnum + 1 }; EOI } | _ as c { err (Illegal_character c) (Loc.of_lexbuf lexbuf) } and comment c = parse "(*" { store c; with_curr_loc comment c; parse comment c } | "*)" { store c } | '<' (':' quote_tag)? ('@' locname)? '<' { store c; if quotations c then with_curr_loc quotation c; parse comment c } | ident { store_parse comment c } | "\"" { store c; begin try with_curr_loc string c with Loc.Exc_located(_, Error.E Unterminated_string) -> err Unterminated_string_in_comment (loc c) end; Buffer.add_char c.buffer '"'; parse comment c } | "''" { store_parse comment c } | "'''" { store_parse comment c } | "'" newline "'" { update_loc c None 1 false 1; store_parse comment c } | "'" [^ '\\' '\'' '\010' '\013' ] "'" { store_parse comment c } | "'\\" ['\\' '"' '\'' 'n' 't' 'b' 'r' ' '] "'" { store_parse comment c } | "'\\" ['0'-'9'] ['0'-'9'] ['0'-'9'] "'" { store_parse comment c } | "'\\" 'x' hexa_char hexa_char "'" { store_parse comment c } | eof { err Unterminated_comment (loc c) } | newline { update_loc c None 1 false 0; store_parse comment c } | _ { store_parse comment c } and string c = parse '"' { set_start_p c } | '\\' newline ([' ' '\t'] * as space) { update_loc c None 1 false (String.length space); store_parse string c } | '\\' ['\\' '"' 'n' 't' 'b' 'r' ' ' '\''] { store_parse string c } | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] { store_parse string c } | '\\' 'x' hexa_char hexa_char { store_parse string c } | '\\' (_ as x) { if is_in_comment c then store_parse string c else begin warn (Illegal_escape (String.make 1 x)) (Loc.of_lexbuf lexbuf); store_parse string c end } | newline { update_loc c None 1 false 0; store_parse string c } | eof { err Unterminated_string (loc c) } | _ { store_parse string c } and symbolchar_star beginning c = parse | symbolchar* as tok { move_start_p (-String.length beginning) c ; SYMBOL(beginning ^ tok) } and maybe_quotation_at c = parse | (ident as loc) '<' { mk_quotation quotation c "" loc (1 + String.length loc) } | symbolchar* as tok { SYMBOL("<@" ^ tok) } and maybe_quotation_colon c = parse | (quote_tag as name) '<' { mk_quotation quotation c name "" (1 + String.length name) } | (quote_tag as name) '@' (locname as loc) '<' { mk_quotation quotation c name loc (2 + String.length loc + String.length name) } | symbolchar* as tok { SYMBOL("<:" ^ tok) } and quotation c = parse | '<' (':' quote_tag)? ('@' locname)? '<' { store c ; with_curr_loc quotation c ; parse quotation c } | ">>" { store c } | eof { err Unterminated_quotation (loc c) } | newline { update_loc c None 1 false 0 ; store_parse quotation c } | _ { store_parse quotation c } and dollar c = parse | '$' { set_start_p c; ANTIQUOT("", "") } | ('`'? (identchar*|['.' '!']+) as name) ':' { with_curr_loc (antiquot name) (shift (1 + String.length name) c) } | _ { store_parse (antiquot "") c } and antiquot name c = parse | '$' { set_start_p c; ANTIQUOT(name, buff_contents c) } | eof { err Unterminated_antiquot (loc c) } | newline { update_loc c None 1 false 0; store_parse (antiquot name) c } | '<' (':' quote_tag)? ('@' locname)? '<' { store c; with_curr_loc quotation c; parse (antiquot name) c } | _ { store_parse (antiquot name) c } { let lexing_store s buff max = let rec self n s = if n >= max then n else match Stream.peek s with | Some x -> Stream.junk s; Bytes.set buff n x; succ n | _ -> n in self 0 s let from_context c = let next _ = let tok = with_curr_loc token c in let loc = Loc.of_lexbuf c.lexbuf in Some ((tok, loc)) in Stream.from next let from_lexbuf ?(quotations = true) lb = let c = { (default_context lb) with loc = Loc.of_lexbuf lb; antiquots = !Camlp4_config.antiquotations; quotations = quotations } in from_context c let setup_loc lb loc = let start_pos = Loc.start_pos loc in lb.lex_abs_pos <- start_pos.pos_cnum; lb.lex_curr_p <- start_pos let from_string ?quotations loc str = let lb = Lexing.from_string str in setup_loc lb loc; from_lexbuf ?quotations lb let from_stream ?quotations loc strm = let lb = Lexing.from_function (lexing_store strm) in setup_loc lb loc; from_lexbuf ?quotations lb let mk () loc strm = from_stream ~quotations:!Camlp4_config.quotations loc strm end } camlp4-5.3-1/camlp4/Camlp4/Struct/Loc.ml000066400000000000000000000217431473134377200175540ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) (* camlp4r *) open Format; (* FIXME Study these 2 others implementations which change the ghost handling: type pos = ... the same ... 1/ type loc = { file_name : string; start : pos; stop : pos }; type t = [ Nowhere | Ghost of loc (* the closest non ghost loc *) | Concrete of loc ]; 2/ type loc = { file_name : string; start : pos; stop : pos }; type t = option loc; 3/ type t = { file_name : option string; start : pos; stop : pos }; *) type pos = { line : int; bol : int; off : int }; type t = { file_name : string; start : pos; stop : pos; ghost : bool }; (* Debug section *) value dump_sel f x = let s = match x with [ `start -> "`start" | `stop -> "`stop" | `both -> "`both" | _ -> "" ] in pp_print_string f s; value dump_pos f x = fprintf f "@[{ line = %d ;@ bol = %d ;@ off = %d } : pos@]" x.line x.bol x.off; value dump_long f x = fprintf f "@[{ file_name = %s ;@ start = %a (%d-%d);@ stop = %a (%d);@ ghost = %b@ } : Loc.t@]" x.file_name dump_pos x.start (x.start.off - x.start.bol) (x.stop.off - x.start.bol) dump_pos x.stop (x.stop.off - x.stop.bol) x.ghost; value dump f x = fprintf f "[%S: %d:%d-%d %d:%d%t]" x.file_name x.start.line (x.start.off - x.start.bol) (x.stop.off - x.start.bol) x.stop.line (x.stop.off - x.stop.bol) (fun o -> if x.ghost then fprintf o " (ghost)" else ()); value start_pos = { line = 1 ; bol = 0 ; off = 0 }; value ghost = { file_name = "ghost-location"; start = start_pos; stop = start_pos; ghost = True }; value mk file_name = debug loc "mk %s@\n" file_name in { file_name = file_name; start = start_pos; stop = start_pos; ghost = False }; value of_tuple (file_name, start_line, start_bol, start_off, stop_line, stop_bol, stop_off, ghost) = { file_name = file_name; start = { line = start_line ; bol = start_bol ; off = start_off }; stop = { line = stop_line ; bol = stop_bol ; off = stop_off }; ghost = ghost }; value to_tuple { file_name = file_name; start = { line = start_line ; bol = start_bol ; off = start_off }; stop = { line = stop_line ; bol = stop_bol ; off = stop_off }; ghost = ghost } = (file_name, start_line, start_bol, start_off, stop_line, stop_bol, stop_off, ghost); value pos_of_lexing_position p = let pos = { line = p.Lexing.pos_lnum ; bol = p.Lexing.pos_bol ; off = p.Lexing.pos_cnum } in debug loc "pos_of_lexing_position: %a@\n" dump_pos pos in pos; value pos_to_lexing_position p file_name = (* debug loc "pos_to_lexing_position: %a@\n" dump_pos p in *) { Lexing. pos_fname = file_name; pos_lnum = p.line ; pos_bol = p.bol ; pos_cnum = p.off }; value better_file_name a b = match (a, b) with [ ("", "") -> a | ("", x) -> x | (x, "") -> x | ("-", x) -> x | (x, "-") -> x | (x, _) -> x ]; value of_lexbuf lb = let start = Lexing.lexeme_start_p lb and stop = Lexing.lexeme_end_p lb in let loc = { file_name = better_file_name start.Lexing.pos_fname stop.Lexing.pos_fname; start = pos_of_lexing_position start; stop = pos_of_lexing_position stop; ghost = False } in debug loc "of_lexbuf: %a@\n" dump loc in loc; value of_lexing_position pos = let loc = { file_name = pos.Lexing.pos_fname; start = pos_of_lexing_position pos; stop = pos_of_lexing_position pos; ghost = False } in debug loc "of_lexing_position: %a@\n" dump loc in loc; value to_ocaml_location x = debug loc "to_ocaml_location: %a@\n" dump x in { Location. loc_start = pos_to_lexing_position x.start x.file_name; loc_end = pos_to_lexing_position x.stop x.file_name; loc_ghost = x.ghost }; value of_ocaml_location { Location.loc_start = a; loc_end = b; loc_ghost = g } = let res = { file_name = better_file_name a.Lexing.pos_fname b.Lexing.pos_fname; start = pos_of_lexing_position a; stop = pos_of_lexing_position b; ghost = g } in debug loc "of_ocaml_location: %a@\n" dump res in res; value start_pos x = pos_to_lexing_position x.start x.file_name; value stop_pos x = pos_to_lexing_position x.stop x.file_name; value merge a b = if a == b then debug loc "trivial merge@\n" in a else let r = match (a.ghost, b.ghost) with [ (False, False) -> (* FIXME if a.file_name <> b.file_name then raise (Invalid_argument (sprintf "Loc.merge: Filenames must be equal: %s <> %s" a.file_name b.file_name)) *) (* else *) { (a) with stop = b.stop } | (True, True) -> { (a) with stop = b.stop } | (True, _) -> { (a) with stop = b.stop } | (_, True) -> { (b) with start = a.start } ] in debug loc "@[merge %a@ %a@ %a@]@\n" dump a dump b dump r in r; value join x = { (x) with stop = x.start }; value map f start_stop_both x = match start_stop_both with [ `start -> { (x) with start = f x.start } | `stop -> { (x) with stop = f x.stop } | `both -> { (x) with start = f x.start; stop = f x.stop } ]; value move_pos chars x = { (x) with off = x.off + chars }; value move s chars x = debug loc "move %a %d %a@\n" dump_sel s chars dump x in map (move_pos chars) s x; value move_line lines x = debug loc "move_line %d %a@\n" lines dump x in let move_line_pos x = { (x) with line = x.line + lines ; bol = x.off } in map move_line_pos `both x; value shift width x = { (x) with start = x.stop ; stop = move_pos width x.stop }; value file_name x = x.file_name; value start_line x = x.start.line; value stop_line x = x.stop.line; value start_bol x = x.start.bol; value stop_bol x = x.stop.bol; value start_off x = x.start.off; value stop_off x = x.stop.off; value is_ghost x = x.ghost; value set_file_name s x = debug loc "set_file_name: %a@\n" dump x in { (x) with file_name = s }; value ghostify x = debug loc "ghostify: %a@\n" dump x in { (x) with ghost = True }; value make_absolute x = debug loc "make_absolute: %a@\n" dump x in let pwd = Sys.getcwd () in if Filename.is_relative x.file_name then { (x) with file_name = Filename.concat pwd x.file_name } else x; value strictly_before x y = let b = x.stop.off < y.start.off && x.file_name = y.file_name in debug loc "%a [strictly_before] %a => %b@\n" dump x dump y b in b; value to_string x = do { let (a, b) = (x.start, x.stop) in let res = sprintf "File \"%s\", line %d, characters %d-%d" x.file_name a.line (a.off - a.bol) (b.off - a.bol) in if x.start.line <> x.stop.line then sprintf "%s (end at line %d, character %d)" res x.stop.line (b.off - b.bol) else res }; value print out x = pp_print_string out (to_string x); value check x msg = if ((start_line x) > (stop_line x) || (start_bol x) > (stop_bol x) || (start_off x) > (stop_off x) || (start_line x) < 0 || (stop_line x) < 0 || (start_bol x) < 0 || (stop_bol x) < 0 || (start_off x) < 0 || (stop_off x) < 0) (* Here, we don't check (start_off x) < (start_bol x) || (stop_off x) < (start_bol x) since the lexer is called on antiquotations, with off=0, but line and bolpos have "correct" values *) then do { eprintf "*** Warning: (%s) strange positions ***\n%a@\n" msg print x; False } else True; exception Exc_located of t and exn; ErrorHandler.register (fun ppf -> fun [ Exc_located loc exn -> fprintf ppf "%a:@\n%a" print loc ErrorHandler.print exn | exn -> raise exn ]); value name = ref "_loc"; value raise loc exc = match exc with [ Exc_located _ _ -> raise exc | _ -> raise (Exc_located loc exc) ] ; camlp4-5.3-1/camlp4/Camlp4/Struct/Loc.mli000066400000000000000000000021641473134377200177210ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) include Sig.Loc; camlp4-5.3-1/camlp4/Camlp4/Struct/Quotation.ml000066400000000000000000000137651473134377200210270ustar00rootroot00000000000000(* camlp4r *) (****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2002-2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) module Make (Ast : Sig.Camlp4Ast) : Sig.Quotation with module Ast = Ast = struct module Ast = Ast; module DynAst = DynAst.Make Ast; module Loc = Ast.Loc; open Format; open Sig; type expand_fun 'a = Loc.t -> option string -> string -> 'a; module Exp_key = DynAst.Pack(struct type t 'a = unit; end); module Exp_fun = DynAst.Pack(struct type t 'a = expand_fun 'a; end); value expanders_table = (ref [] : ref (list ((string * Exp_key.pack) * Exp_fun.pack))); value default = ref ""; value translate = ref (fun x -> x); value expander_name name = match translate.val name with [ "" -> default.val | name -> name ]; value find name tag = let key = (expander_name name, Exp_key.pack tag ()) in Exp_fun.unpack tag (List.assoc key expanders_table.val); value add name tag f = let elt = ((name, Exp_key.pack tag ()), Exp_fun.pack tag f) in expanders_table.val := [elt :: expanders_table.val]; value dump_file = ref None; module Error = struct type error = [ Finding | Expanding | ParsingResult of Loc.t and string | Locating ]; type t = (string * string * error * exn); exception E of t; value print ppf (name, position, ctx, exn) = let name = if name = "" then default.val else name in let pp x = fprintf ppf "@?@[<2>While %s %S in a position of %S:" x name position in let () = match ctx with [ Finding -> begin pp "finding quotation"; if expanders_table.val = [] then fprintf ppf "@ There is no quotation expander available." else begin fprintf ppf "@ @[Available quotation expanders are:@\n"; List.iter begin fun ((s,t),_) -> fprintf ppf "@[<2>%s@ (in@ a@ position@ of %a)@]@ " s Exp_key.print_tag t end expanders_table.val; fprintf ppf "@]" end end | Expanding -> pp "expanding quotation" | Locating -> pp "parsing" | ParsingResult loc str -> let () = pp "parsing result of quotation" in match dump_file.val with [ Some dump_file -> let () = fprintf ppf " dumping result...\n" in try let oc = open_out_bin dump_file in begin output_string oc str; output_string oc "\n"; flush oc; close_out oc; fprintf ppf "%a:" Loc.print (Loc.set_file_name dump_file loc); end with _ -> fprintf ppf "Error while dumping result in file %S; dump aborted" dump_file | None -> fprintf ppf "\n(consider setting variable Quotation.dump_file, or using the -QD option)" ] ] in fprintf ppf "@\n%a@]@." ErrorHandler.print exn; value to_string x = Format.asprintf "%a" print x; end; let module M = ErrorHandler.Register Error in (); open Error; value expand_quotation loc expander pos_tag quot = debug quot "expand_quotation: name: %s, str: %S@." quot.q_name quot.q_contents in let loc_name_opt = if quot.q_loc = "" then None else Some quot.q_loc in try expander loc loc_name_opt quot.q_contents with [ Loc.Exc_located _ (Error.E _) as exc -> raise exc | Loc.Exc_located iloc exc -> let exc1 = Error.E (quot.q_name, pos_tag, Expanding, exc) in raise (Loc.Exc_located iloc exc1) | exc -> let exc1 = Error.E (quot.q_name, pos_tag, Expanding, exc) in raise (Loc.Exc_located loc exc1) ]; value parse_quotation_result parse loc quot pos_tag str = try parse loc str with [ Loc.Exc_located iloc (Error.E (n, pos_tag, Expanding, exc)) -> let ctx = ParsingResult iloc quot.q_contents in let exc1 = Error.E (n, pos_tag, ctx, exc) in raise (Loc.Exc_located iloc exc1) | Loc.Exc_located iloc (Error.E _ as exc) -> raise (Loc.Exc_located iloc exc) | Loc.Exc_located iloc exc -> let ctx = ParsingResult iloc quot.q_contents in let exc1 = Error.E (quot.q_name, pos_tag, ctx, exc) in raise (Loc.Exc_located iloc exc1) ]; value expand loc quotation tag = let pos_tag = DynAst.string_of_tag tag in let name = quotation.q_name in debug quot "handle_quotation: name: %s, str: %S@." name quotation.q_contents in let expander = try find name tag with [ Loc.Exc_located _ (Error.E _) as exc -> raise exc | Loc.Exc_located qloc exc -> raise (Loc.Exc_located qloc (Error.E (name, pos_tag, Finding, exc))) | exc -> raise (Loc.Exc_located loc (Error.E (name, pos_tag, Finding, exc))) ] in let loc = Loc.join (Loc.move `start quotation.q_shift loc) in expand_quotation loc expander pos_tag quotation; end; camlp4-5.3-1/camlp4/Camlp4/Struct/Token.ml000066400000000000000000000204171473134377200201140ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Nicolas Pouillard: initial version *) open Format; module Make (Loc : Sig.Loc) : Sig.Camlp4Token with module Loc = Loc = struct module Loc = Loc; open Sig; type t = camlp4_token; type token = t; value to_string = fun [ KEYWORD s -> sprintf "KEYWORD %S" s | SYMBOL s -> sprintf "SYMBOL %S" s | LIDENT s -> sprintf "LIDENT %S" s | UIDENT s -> sprintf "UIDENT %S" s | INT _ s -> sprintf "INT %s" s | INT32 _ s -> sprintf "INT32 %sd" s | INT64 _ s -> sprintf "INT64 %sd" s | NATIVEINT _ s-> sprintf "NATIVEINT %sd" s | FLOAT _ s -> sprintf "FLOAT %s" s | CHAR _ s -> sprintf "CHAR '%s'" s | STRING _ s -> sprintf "STRING \"%s\"" s (* here it's not %S since the string is already escaped *) | LABEL s -> sprintf "LABEL %S" s | OPTLABEL s -> sprintf "OPTLABEL %S" s | ANTIQUOT n s -> sprintf "ANTIQUOT %s: %S" n s | QUOTATION x -> sprintf "QUOTATION { q_name=%S; q_loc=%S; q_shift=%d; q_contents=%S }" x.q_name x.q_loc x.q_shift x.q_contents | COMMENT s -> sprintf "COMMENT %S" s | BLANKS s -> sprintf "BLANKS %S" s | NEWLINE -> sprintf "NEWLINE" | EOI -> sprintf "EOI" | ESCAPED_IDENT s -> sprintf "ESCAPED_IDENT %S" s | LINE_DIRECTIVE i None -> sprintf "LINE_DIRECTIVE %d" i | LINE_DIRECTIVE i (Some s) -> sprintf "LINE_DIRECTIVE %d %S" i s ]; value print ppf x = pp_print_string ppf (to_string x); value match_keyword kwd = fun [ KEYWORD kwd' when kwd = kwd' -> True | _ -> False ]; value extract_string = fun [ KEYWORD s | SYMBOL s | LIDENT s | UIDENT s | INT _ s | INT32 _ s | INT64 _ s | NATIVEINT _ s | FLOAT _ s | CHAR _ s | STRING _ s | LABEL s | OPTLABEL s | COMMENT s | BLANKS s | ESCAPED_IDENT s -> s | tok -> invalid_arg ("Cannot extract a string from this token: "^ to_string tok) ]; module Error = struct type t = [ Illegal_token of string | Keyword_as_label of string | Illegal_token_pattern of string and string | Illegal_constructor of string ]; exception E of t; value print ppf = fun [ Illegal_token s -> fprintf ppf "Illegal token (%s)" s | Keyword_as_label kwd -> fprintf ppf "`%s' is a keyword, it cannot be used as label name" kwd | Illegal_token_pattern p_con p_prm -> fprintf ppf "Illegal token pattern: %s %S" p_con p_prm | Illegal_constructor con -> fprintf ppf "Illegal constructor %S" con ]; value to_string x = Format.asprintf "%a" print x; end; let module M = ErrorHandler.Register Error in (); module Filter = struct type token_filter = stream_filter t Loc.t; type t = { is_kwd : string -> bool; filter : mutable token_filter }; value err error loc = raise (Loc.Exc_located loc (Error.E error)); value keyword_conversion tok is_kwd = match tok with [ SYMBOL s | LIDENT s | UIDENT s when is_kwd s -> KEYWORD s | ESCAPED_IDENT s -> LIDENT s | _ -> tok ]; value check_keyword_as_label tok loc is_kwd = let s = match tok with [ LABEL s -> s | OPTLABEL s -> s | _ -> "" ] in if s <> "" && is_kwd s then err (Error.Keyword_as_label s) loc else (); value check_unknown_keywords tok loc = match tok with [ SYMBOL s -> err (Error.Illegal_token s) loc | _ -> () ]; value error_no_respect_rules p_con p_prm = raise (Error.E (Error.Illegal_token_pattern p_con p_prm)); value check_keyword _ = True; (* FIXME let lb = Lexing.from_string s in let next () = token default_context lb in try match next () with [ SYMBOL _ | UIDENT _ | LIDENT _ -> (next () = EOI) | _ -> False ] with [ Stream.Error _ -> False ]; *) value error_on_unknown_keywords = ref False; value rec ignore_layout = parser [ [: `(COMMENT _ | BLANKS _ | NEWLINE | LINE_DIRECTIVE _ _, _); s :] -> ignore_layout s | [: ` x; s :] -> [: ` x; ignore_layout s :] | [: :] -> [: :] ]; value mk is_kwd = { is_kwd = is_kwd; filter = ignore_layout }; value filter x = let f tok loc = do { let tok = keyword_conversion tok x.is_kwd; check_keyword_as_label tok loc x.is_kwd; if error_on_unknown_keywords.val then check_unknown_keywords tok loc else (); debug token "@[Lexer before filter:@ %a@ at@ %a@]@." print tok Loc.dump loc in (tok, loc) } in let rec filter = parser [ [: `(tok, loc); s :] -> [: ` f tok loc; filter s :] | [: :] -> [: :] ] in let rec tracer = (* FIXME add a debug block construct *) parser [ [: `((_tok, _loc) as x); xs :] -> debug token "@[Lexer after filter:@ %a@ at@ %a@]@." print _tok Loc.dump _loc in [: ` x; tracer xs :] | [: :] -> [: :] ] in fun strm -> tracer (x.filter (filter strm)); value define_filter x f = x.filter := f x.filter; value keyword_added _ _ _ = (); value keyword_removed _ _ = (); end; end; (* Char and string tokens to real chars and string *) module Eval = struct value valch x = Char.code x - Char.code '0'; value valch_hex x = let d = Char.code x in if d >= 97 then d - 87 else if d >= 65 then d - 55 else d - 48; value rec skip_indent = parser [ [: `' ' | '\t'; s :] -> skip_indent s | [: :] -> () ]; value skip_opt_linefeed = parser [ [: `'\010' :] -> () | [: :] -> () ]; value chr c = if c < 0 || c > 255 then failwith "invalid char token" else Char.chr c; value rec backslash = parser [ [: `'\010' :] -> '\010' | [: `'\013' :] -> '\013' | [: `'n' :] -> '\n' | [: `'r' :] -> '\r' | [: `'t' :] -> '\t' | [: `'b' :] -> '\b' | [: `'\\' :] -> '\\' | [: `'"' :] -> '"' | [: `'\'' :] -> '\'' | [: `' ' :] -> ' ' | [: `('0'..'9' as c1); `('0'..'9' as c2); `('0'..'9' as c3) :] -> chr (100 * (valch c1) + 10 * (valch c2) + (valch c3)) | [: `'x'; `('0'..'9' | 'a'..'f' | 'A'..'F' as c1) ; `('0'..'9' | 'a'..'f' | 'A'..'F' as c2) :] -> chr (16 * (valch_hex c1) + (valch_hex c2)) ]; value rec backslash_in_string strict store = parser [ [: `'\010'; s :] -> skip_indent s | [: `'\013'; s :] -> do { skip_opt_linefeed s; skip_indent s } | [: x = backslash :] -> store x | [: `c when not strict :] -> do { store '\\'; store c } | [: :] -> failwith "invalid string token" ]; value char s = if String.length s = 1 then s.[0] else if String.length s = 0 then failwith "invalid char token" else match Stream.of_string s with parser [ [: `'\\'; x = backslash :] -> x | [: :] -> failwith "invalid char token" ]; value string ?strict s = let buf = Buffer.create 23 in let store = Buffer.add_char buf in let rec parse = parser [ [: `'\\'; _ = backslash_in_string (strict <> None) store; s :] -> parse s | [: `c; s :] -> do { store c; parse s } | [: :] -> Buffer.contents buf ] in parse (Stream.of_string s); end; camlp4-5.3-1/camlp4/Camlp4/Struct/Token.mli000066400000000000000000000034651473134377200202710ustar00rootroot00000000000000(****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) module Make (Loc : Sig.Loc) : Sig.Camlp4Token with module Loc = Loc; module Eval : sig value char : string -> char; (** Convert a char token, where the escape sequences (backslashes) remain to be interpreted; raise [Failure] if an incorrect backslash sequence is found; [Token.Eval.char (Char.escaped c)] returns [c] *) value string : ?strict:unit -> string -> string; (** [Taken.Eval.string strict s] Convert a string token, where the escape sequences (backslashes) remain to be interpreted; raise [Failure] if [strict] and an incorrect backslash sequence is found; [Token.Eval.string strict (String.escaped s)] returns [s] *) end; camlp4-5.3-1/camlp4/Camlp4/Utils.ml000066400000000000000000000012661473134377200166510ustar00rootroot00000000000000(* Imported from typing/oprint.ml *) value valid_float_lexeme s = let l = String.length s in let rec loop i = if i >= l then s ^ "." else match s.[i] with [ '0' .. '9' | '-' -> loop (i+1) | _ -> s ] in loop 0 ; value float_repres f = match classify_float f with [ FP_nan -> "nan" | FP_infinite -> if f < 0.0 then "neg_infinity" else "infinity" | _ -> let float_val = let s1 = Printf.sprintf "%.12g" f in if f = float_of_string s1 then s1 else let s2 = Printf.sprintf "%.15g" f in if f = float_of_string s2 then s2 else Printf.sprintf "%.18g" f in valid_float_lexeme float_val ] ; camlp4-5.3-1/camlp4/Camlp4/Utils.mli000066400000000000000000000000461473134377200170150ustar00rootroot00000000000000value float_repres : float -> string; camlp4-5.3-1/camlp4/Camlp4Bin.ml000066400000000000000000000327701473134377200162060ustar00rootroot00000000000000(* camlp4r *) (****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) open Camlp4; open PreCast.Syntax; open PreCast; open Format; module CleanAst = Camlp4.Struct.CleanAst.Make Ast; module SSet = Set.Make String; value pa_r = "Camlp4OCamlRevisedParser"; value pa_rr = "Camlp4OCamlReloadedParser"; value pa_o = "Camlp4OCamlParser"; value pa_rp = "Camlp4OCamlRevisedParserParser"; value pa_op = "Camlp4OCamlParserParser"; value pa_g = "Camlp4GrammarParser"; value pa_m = "Camlp4MacroParser"; value pa_qb = "Camlp4QuotationCommon"; value pa_q = "Camlp4QuotationExpander"; value pa_rq = "Camlp4OCamlRevisedQuotationExpander"; value pa_oq = "Camlp4OCamlOriginalQuotationExpander"; value pa_l = "Camlp4ListComprehension"; open Register; value dyn_loader = ref (fun []); value rcall_callback = ref (fun () -> ()); value loaded_modules = ref SSet.empty; value add_to_loaded_modules name = loaded_modules.val := SSet.add name loaded_modules.val; value (objext,libext) = if DynLoader.is_native then (".cmxs",".cmxs") else (".cmo",".cma"); value rewrite_and_load n x = let dyn_loader = dyn_loader.val () in let find_in_path = DynLoader.find_in_path dyn_loader in let real_load name = do { add_to_loaded_modules name; DynLoader.load dyn_loader name } in let load = List.iter begin fun n -> if SSet.mem n loaded_modules.val || List.mem n Register.loaded_modules.val then () else begin add_to_loaded_modules n; DynLoader.load dyn_loader (n ^ objext); end end in do { match (n, String.lowercase_ascii x) with [ ("Parsers"|"", "pa_r.cmo" | "r" | "ocamlr" | "ocamlrevised" | "camlp4ocamlrevisedparser.cmo") -> load [pa_r] | ("Parsers"|"", "rr" | "reloaded" | "ocamlreloaded" | "camlp4ocamlreloadedparser.cmo") -> load [pa_rr] | ("Parsers"|"", "pa_o.cmo" | "o" | "ocaml" | "camlp4ocamlparser.cmo") -> load [pa_r; pa_o] | ("Parsers"|"", "pa_rp.cmo" | "rp" | "rparser" | "camlp4ocamlrevisedparserparser.cmo") -> load [pa_r; pa_rp] | ("Parsers"|"", "pa_op.cmo" | "op" | "parser" | "camlp4ocamlparserparser.cmo") -> load [pa_r; pa_o; pa_rp; pa_op] | ("Parsers"|"", "pa_extend.cmo" | "pa_extend_m.cmo" | "g" | "grammar" | "camlp4grammarparser.cmo") -> load [pa_g] | ("Parsers"|"", "pa_macro.cmo" | "m" | "macro" | "camlp4macroparser.cmo") -> load [pa_m] | ("Parsers"|"", "q" | "camlp4quotationexpander.cmo") -> load [pa_qb; pa_q] | ("Parsers"|"", "q_mlast.cmo" | "rq" | "camlp4ocamlrevisedquotationexpander.cmo") -> load [pa_qb; pa_rq] | ("Parsers"|"", "oq" | "camlp4ocamloriginalquotationexpander.cmo") -> load [pa_r; pa_o; pa_qb; pa_oq] | ("Parsers"|"", "rf") -> load [pa_r; pa_rp; pa_qb; pa_q; pa_g; pa_l; pa_m] | ("Parsers"|"", "of") -> load [pa_r; pa_o; pa_rp; pa_op; pa_qb; pa_q; pa_g; pa_l; pa_m] | ("Parsers"|"", "comp" | "camlp4listcomprehension.cmo") -> load [pa_l] | ("Filters"|"", "lift" | "camlp4astlifter.cmo") -> load ["Camlp4AstLifter"] | ("Filters"|"", "exn" | "camlp4exceptiontracer.cmo") -> load ["Camlp4ExceptionTracer"] | ("Filters"|"", "prof" | "camlp4profiler.cmo") -> load ["Camlp4Profiler"] (* map is now an alias of fold since fold handles map too *) | ("Filters"|"", "map" | "camlp4mapgenerator.cmo") -> load ["Camlp4FoldGenerator"] | ("Filters"|"", "fold" | "camlp4foldgenerator.cmo") -> load ["Camlp4FoldGenerator"] | ("Filters"|"", "meta" | "camlp4metagenerator.cmo") -> load ["Camlp4MetaGenerator"] | ("Filters"|"", "trash" | "camlp4trashremover.cmo") -> load ["Camlp4TrashRemover"] | ("Filters"|"", "striploc" | "camlp4locationstripper.cmo") -> load ["Camlp4LocationStripper"] | ("Printers"|"", "pr_r.cmo" | "r" | "ocamlr" | "camlp4ocamlrevisedprinter.cmo") -> Register.enable_ocamlr_printer () | ("Printers"|"", "pr_o.cmo" | "o" | "ocaml" | "camlp4ocamlprinter.cmo") -> Register.enable_ocaml_printer () | ("Printers"|"", "pr_dump.cmo" | "p" | "dumpocaml" | "camlp4ocamlastdumper.cmo") -> Register.enable_dump_ocaml_ast_printer () | ("Printers"|"", "d" | "dumpcamlp4" | "camlp4astdumper.cmo") -> Register.enable_dump_camlp4_ast_printer () | ("Printers"|"", "a" | "auto" | "camlp4autoprinter.cmo") -> load ["Camlp4AutoPrinter"] | _ -> let y = "Camlp4"^n^"/"^x^objext in real_load (try find_in_path y with [ Not_found -> x ]) ]; rcall_callback.val (); }; value print_warning = eprintf "%a:\n%s@." Loc.print; value rec parse_file dyn_loader name pa getdir = let directive_handler = Some (fun ast -> match getdir ast with [ Some x -> match x with [ (_, "load", s) -> do { rewrite_and_load "" s; None } | (_, "directory", s) -> do { DynLoader.include_dir dyn_loader s; None } | (_, "use", s) -> Some (parse_file dyn_loader s pa getdir) | (_, "default_quotation", s) -> do { Quotation.default.val := s; None } | (loc, _, _) -> Loc.raise loc (Stream.Error "bad directive") ] | None -> None ]) in let loc = Loc.mk name in do { current_warning.val := print_warning; let ic = if name = "-" then stdin else open_in_bin name; let cs = Stream.of_channel ic; let clear () = if name = "-" then () else close_in ic; let phr = try pa ?directive_handler loc cs with x -> do { clear (); raise x }; clear (); phr }; value output_file = ref None; value process dyn_loader name pa pr clean fold_filters getdir = let ast = parse_file dyn_loader name pa getdir in let ast = fold_filters (fun t filter -> filter t) ast in let ast = clean ast in pr ?input_file:(Some name) ?output_file:output_file.val ast; value gind = fun [ Ast.SgDir loc n (Ast.ExStr _ s) -> Some (loc, n, s) | _ -> None ]; value gimd = fun [ Ast.StDir loc n (Ast.ExStr _ s) -> Some (loc, n, s) | _ -> None ]; value process_intf dyn_loader name = process dyn_loader name CurrentParser.parse_interf CurrentPrinter.print_interf (new CleanAst.clean_ast)#sig_item AstFilters.fold_interf_filters gind; value process_impl dyn_loader name = process dyn_loader name CurrentParser.parse_implem CurrentPrinter.print_implem (new CleanAst.clean_ast)#str_item AstFilters.fold_implem_filters gimd; value just_print_the_version () = do { printf "%s@." Camlp4_config.version; exit 0 }; value print_version () = do { eprintf "Camlp4 version %s@." Camlp4_config.version; exit 0 }; value print_stdlib () = do { printf "%s@." Camlp4_config.camlp4_standard_library; exit 0 }; value usage ini_sl ext_sl = do { eprintf "\ Usage: camlp4 [load-options] [--] [other-options]\n\ Options:\n\ .ml Parse this implementation file\n\ .mli Parse this interface file\n\ .%s Load this module inside the Camlp4 core@." (if DynLoader.is_native then "cmxs " else "(cmo|cma)") ; Options.print_usage_list ini_sl; (* loop (ini_sl @ ext_sl) where rec loop = fun [ [(y, _, _) :: _] when y = "-help" -> () | [_ :: sl] -> loop sl | [] -> eprintf " -help Display this list of options.@." ]; *) if ext_sl <> [] then do { eprintf "Options added by loaded object files:@."; Options.print_usage_list ext_sl; } else (); }; value warn_noassert () = do { eprintf "\ camlp4 warning: option -noassert is obsolete\n\ You should give the -noassert option to the ocaml compiler instead.@."; }; type file_kind = [ Intf of string | Impl of string | Str of string | ModuleImpl of string | IncludeDir of string ]; value search_stdlib = ref True; value print_loaded_modules = ref False; value (task, do_task) = let t = ref None in let task f x = let () = Camlp4_config.current_input_file.val := x in t.val := Some (if t.val = None then (fun _ -> f x) else (fun usage -> usage ())) in let do_task usage = match t.val with [ Some f -> f usage | None -> () ] in (task, do_task); value input_file x = let dyn_loader = dyn_loader.val () in do { rcall_callback.val (); match x with [ Intf file_name -> task (process_intf dyn_loader) file_name | Impl file_name -> task (process_impl dyn_loader) file_name | Str s -> begin let (f, o) = Filename.open_temp_file "from_string" ".ml"; output_string o s; close_out o; task (process_impl dyn_loader) f; at_exit (fun () -> Sys.remove f); end | ModuleImpl file_name -> rewrite_and_load "" file_name | IncludeDir dir -> DynLoader.include_dir dyn_loader dir ]; rcall_callback.val (); }; value expand_directory alt s = if String.length s > 0 && s.[0] = '+' then Filename.concat alt (String.sub s 1 (String.length s - 1)) else s ; value initial_spec_list = [("-I", Arg.String (fun x -> input_file (IncludeDir (expand_directory Camlp4_config.camlp4_standard_library x))), " Add directory in search patch for object files."); ("-where", Arg.Unit print_stdlib, "Print camlp4 library directory and exit."); ("-nolib", Arg.Clear search_stdlib, "No automatic search for object files in library directory."); ("-intf", Arg.String (fun x -> input_file (Intf x)), " Parse as an interface, whatever its extension."); ("-impl", Arg.String (fun x -> input_file (Impl x)), " Parse as an implementation, whatever its extension."); ("-str", Arg.String (fun x -> input_file (Str x)), " Parse as an implementation."); ("-unsafe", Arg.Set Camlp4_config.unsafe, "Generate unsafe accesses to array and strings."); ("-noassert", Arg.Unit warn_noassert, "Obsolete, do not use this option."); ("-verbose", Arg.Set Camlp4_config.verbose, "More verbose in parsing errors."); ("-loc", Arg.Set_string Loc.name, " Name of the location variable (default: " ^ Loc.name.val ^ ")."); ("-QD", Arg.String (fun x -> Quotation.dump_file.val := Some x), " Dump quotation expander result in case of syntax error."); ("-o", Arg.String (fun x -> output_file.val := Some x), " Output on instead of standard output."); ("-v", Arg.Unit print_version, "Print Camlp4 version and exit."); ("-version", Arg.Unit just_print_the_version, "Print Camlp4 version number and exit."); ("-vnum", Arg.Unit just_print_the_version, "Print Camlp4 version number and exit."); ("-no_quot", Arg.Clear Camlp4_config.quotations, "Don't parse quotations, allowing to use, e.g. \"<:>\" as token."); ("-loaded-modules", Arg.Set print_loaded_modules, "Print the list of loaded modules."); ("-parser", Arg.String (rewrite_and_load "Parsers"), " Load the parser Camlp4Parsers/.cm(o|a|xs)"); ("-printer", Arg.String (rewrite_and_load "Printers"), " Load the printer Camlp4Printers/.cm(o|a|xs)"); ("-filter", Arg.String (rewrite_and_load "Filters"), " Load the filter Camlp4Filters/.cm(o|a|xs)"); ("-ignore", Arg.String ignore, "ignore the next argument"); ("--", Arg.Unit ignore, "Deprecated, does nothing") ]; Options.init initial_spec_list; value anon_fun name = input_file (if Filename.check_suffix name ".mli" then Intf name else if Filename.check_suffix name ".ml" then Impl name else if Filename.check_suffix name objext then ModuleImpl name else if Filename.check_suffix name libext then ModuleImpl name else raise (Arg.Bad ("don't know what to do with " ^ name))); value main argv = let usage () = do { usage initial_spec_list (Options.ext_spec_list ()); exit 0 } in try do { let dynloader = DynLoader.mk ~ocaml_stdlib:search_stdlib.val ~camlp4_stdlib:search_stdlib.val (); dyn_loader.val := fun () -> dynloader; let call_callback () = Register.iter_and_take_callbacks (fun (name, module_callback) -> let () = add_to_loaded_modules name in module_callback ()); call_callback (); rcall_callback.val := call_callback; match Options.parse anon_fun argv with [ [] -> () | ["-help"|"--help"|"-h"|"-?" :: _] -> usage () | [s :: _] -> do { eprintf "%s: unknown or misused option\n" s; eprintf "Use option -help for usage@."; exit 2 } ]; do_task usage; call_callback (); if print_loaded_modules.val then do { SSet.iter (eprintf "%s@.") loaded_modules.val; } else () } with [ Arg.Bad s -> do { eprintf "Error: %s\n" s; eprintf "Use option -help for usage@."; exit 2 } | Arg.Help _ -> usage () | exc -> do { eprintf "@[%a@]@." ErrorHandler.print exc; exit 2 } ]; main Sys.argv; camlp4-5.3-1/camlp4/Camlp4Filters/000077500000000000000000000000001473134377200165435ustar00rootroot00000000000000camlp4-5.3-1/camlp4/Camlp4Filters/Camlp4AstLifter.ml000066400000000000000000000032651473134377200220410ustar00rootroot00000000000000(* camlp4r *) (****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Nicolas Pouillard: initial version *) open Camlp4; module Id = struct value name = "Camlp4AstLifter"; value version = Sys.ocaml_version; end; module Make (AstFilters : Camlp4.Sig.AstFilters) = struct open AstFilters; module MetaLoc = struct module Ast = Ast; value meta_loc_patt _loc _ = <:patt< loc >>; value meta_loc_expr _loc _ = <:expr< loc >>; end; module MetaAst = Ast.Meta.Make MetaLoc; register_str_item_filter (fun ast -> let _loc = Ast.loc_of_str_item ast in <:str_item< let loc = Loc.ghost in $exp:MetaAst.Expr.meta_str_item _loc ast$ >>); end; let module M = Camlp4.Register.AstFilter Id Make in (); camlp4-5.3-1/camlp4/Camlp4Filters/Camlp4ExceptionTracer.ml000066400000000000000000000046341473134377200232440ustar00rootroot00000000000000(* camlp4r *) (****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Nicolas Pouillard: initial version *) open Camlp4; module Id = struct value name = "Camlp4ExceptionTracer"; value version = Sys.ocaml_version; end; module Make (AstFilters : Camlp4.Sig.AstFilters) = struct open AstFilters; open Ast; value add_debug_expr e = (* let _loc = Loc.make_absolute (MLast.loc_of_expr e) in *) let _loc = Ast.loc_of_expr e in let msg = "camlp4-debug: exc: %s at " ^ Loc.to_string _loc ^ "@." in <:expr< try $e$ with [ Stream.Failure | Exit as exc -> raise exc | exc -> do { if Debug.mode "exc" then Format.eprintf $`str:msg$ (Printexc.to_string exc) else (); raise exc } ] >>; value rec map_match_case = fun [ <:match_case@_loc< $m1$ | $m2$ >> -> <:match_case< $map_match_case m1$ | $map_match_case m2$ >> | <:match_case@_loc< $p$ when $w$ -> $e$ >> -> <:match_case@_loc< $p$ when $w$ -> $add_debug_expr e$ >> | m -> m ]; value filter = object inherit Ast.map as super; method expr = fun [ <:expr@_loc< fun [ $m$ ] >> -> <:expr< fun [ $map_match_case m$ ] >> | x -> super#expr x ]; method str_item = fun [ <:str_item< module Debug = $_$ >> as st -> st | st -> super#str_item st ]; end; register_str_item_filter filter#str_item; end; let module M = Camlp4.Register.AstFilter Id Make in (); camlp4-5.3-1/camlp4/Camlp4Filters/Camlp4FoldGenerator.ml000066400000000000000000000566341473134377200227070ustar00rootroot00000000000000(* camlp4r *) (****************************************************************************) (* *) (* OCaml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2006-2007 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Camlp4 *) (* source tree. *) (* *) (****************************************************************************) (* Authors: * - Nicolas Pouillard: initial version *) open Camlp4; module Id = struct value name = "Camlp4FoldGenerator"; value version = Sys.ocaml_version; end; module Make (AstFilters : Camlp4.Sig.AstFilters) = struct open AstFilters; module StringMap = Map.Make String; open Ast; value _loc = Loc.ghost; value sf = Printf.sprintf; value xik i k = let i = if i < 0 then assert False else if i = 0 then "" else sf "_i%d" i in let k = if k < 1 then assert False else if k = 1 then "" else sf "_k%d" k in sf "_x%s%s" i k; value exik i k = <:expr< $lid:xik i k$ >>; value pxik i k = <:patt< $lid:xik i k$ >>; value elidk y k = <:expr< $lid:sf "%s_%d" y k$ >>; value plidk y k = <:patt< $lid:sf "%s_%d" y k$ >>; value xs s = "_x_" ^ s; value xsk = sf "_x_%s_%d"; value exsk s k = <:expr< $lid:xsk s k$>>; value rec apply_expr accu = fun [ [] -> accu | [x :: xs] -> let _loc = Ast.loc_of_expr x in apply_expr <:expr< $accu$ $x$ >> xs ]; value rec apply_patt accu = fun [ [] -> accu | [x :: xs] -> let _loc = Ast.loc_of_patt x in apply_patt <:patt< $accu$ $x$ >> xs ]; value rec apply_ctyp accu = fun [ [] -> accu | [x :: xs] -> let _loc = Ast.loc_of_ctyp x in apply_ctyp <:ctyp< $accu$ $x$ >> xs ]; value opt_map f = fun [ Some x -> Some (f x) | None -> None ]; value list_init f n = let rec self m = if m = n then [] else [f m :: self (succ m)] in self 0; value rec lid_of_ident sep = fun [ <:ident< $lid:s$ >> | <:ident< $uid:s$ >> -> s | <:ident< $i1$.$i2$ >> -> lid_of_ident sep i1 ^ sep ^ lid_of_ident sep i2 | _ -> assert False ]; type type_decl = (string * Ast.ident * list Ast.ctyp * Ast.ctyp * bool); value builtin_types = let tyMap = StringMap.empty in let tyMap = let abstr = ["string"; "int"; "float"; "int32"; "int64"; "nativeint"; "char"] in List.fold_right (fun name -> StringMap.add name (name, <:ident< $lid:name$ >>, [], <:ctyp<>>, False)) abstr tyMap in let tyMap = let concr = [("bool", <:ident>, [], <:ctyp< [ False | True ] >>, False); ("list", <:ident>, [ <:ctyp< 'a >> ], <:ctyp< [ $uid:"[]"$ | $uid:"::"$ of 'a and list 'a ] >>, False); ("option", <:ident