summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPierre Weis <Pierre.Weis@inria.fr>2009-12-23 18:40:34 +0000
committerPierre Weis <Pierre.Weis@inria.fr>2009-12-23 18:40:34 +0000
commit57cc3000e652f833de7c3dd44bbe88900a8b3989 (patch)
tree7218e6a2637ed5c57ca9489c2c75a3cd3947a151
parent2e641fae302a10700314b11c24691f552575d7ef (diff)
downloadocaml-57cc3000e652f833de7c3dd44bbe88900a8b3989.tar.gz
Parsing + typing are now correct.
git-svn-id: http://caml.inria.fr/svn/ocaml/branches/dothat@9487 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat
-rw-r--r--.depend289
-rw-r--r--Makefile5
-rwxr-xr-xboot/ocamlcbin1065092 -> 1072883 bytes
-rwxr-xr-xboot/ocamldepbin298527 -> 303812 bytes
-rwxr-xr-xboot/ocamllexbin165431 -> 165419 bytes
-rw-r--r--parsing/lexer.mll1
-rw-r--r--parsing/parser.mly240
-rw-r--r--parsing/parsetree.mli15
-rw-r--r--parsing/printast.ml35
-rw-r--r--typing/ctype.ml28
-rw-r--r--typing/datarepr.ml44
-rw-r--r--typing/datarepr.mli20
-rw-r--r--typing/env.ml206
-rw-r--r--typing/env.mli14
-rw-r--r--typing/mtype.ml2
-rw-r--r--typing/parmatch.ml2
-rw-r--r--typing/predef.ml136
-rw-r--r--typing/predef.mli31
-rw-r--r--typing/printtyp.ml32
-rw-r--r--typing/printtyp.mli2
-rw-r--r--typing/typeclass.ml5
-rw-r--r--typing/typecore.ml643
-rw-r--r--typing/typecore.mli21
-rw-r--r--typing/typedecl.ml10
-rw-r--r--typing/typemod.ml5
-rw-r--r--typing/types.ml13
-rw-r--r--typing/types.mli10
-rw-r--r--typing/typetexp.ml61
-rw-r--r--typing/typetexp.mli4
29 files changed, 1069 insertions, 805 deletions
diff --git a/.depend b/.depend
index b4a70c0a60..0d45cfcf77 100644
--- a/.depend
+++ b/.depend
@@ -31,14 +31,15 @@ parsing/location.cmi: utils/warnings.cmi
parsing/longident.cmi:
parsing/parse.cmi: parsing/parsetree.cmi
parsing/parser.cmi: parsing/parsetree.cmi
-parsing/parsetree.cmi: parsing/longident.cmi parsing/location.cmi \
- parsing/asttypes.cmi
+parsing/parsetree.cmi: parsing/reftypes.cmi parsing/longident.cmi \
+ parsing/location.cmi parsing/asttypes.cmi
parsing/printast.cmi: parsing/parsetree.cmi
+parsing/reftypes.cmi: parsing/longident.cmi
parsing/syntaxerr.cmi: parsing/location.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/lexer.cmo: parsing/parser.cmi utils/misc.cmi parsing/location.cmi \
+ parsing/lexer.cmi
+parsing/lexer.cmx: parsing/parser.cmx utils/misc.cmx parsing/location.cmx \
+ parsing/lexer.cmi
parsing/linenum.cmo: utils/misc.cmi parsing/linenum.cmi
parsing/linenum.cmx: utils/misc.cmx parsing/linenum.cmi
parsing/location.cmo: utils/warnings.cmi utils/terminfo.cmi \
@@ -47,29 +48,31 @@ parsing/location.cmx: utils/warnings.cmx utils/terminfo.cmx \
parsing/linenum.cmx parsing/location.cmi
parsing/longident.cmo: utils/misc.cmi parsing/longident.cmi
parsing/longident.cmx: utils/misc.cmx parsing/longident.cmi
-parsing/parse.cmo: parsing/syntaxerr.cmi parsing/parser.cmi \
- parsing/location.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/parse.cmo: parsing/parser.cmi parsing/location.cmi parsing/lexer.cmi \
+ parsing/parse.cmi
+parsing/parse.cmx: parsing/parser.cmx parsing/location.cmx parsing/lexer.cmx \
+ parsing/parse.cmi
+parsing/parser.cmo: parsing/reftypes.cmi parsing/parsetree.cmi \
parsing/longident.cmi parsing/location.cmi utils/clflags.cmi \
parsing/asttypes.cmi parsing/parser.cmi
-parsing/parser.cmx: parsing/syntaxerr.cmx parsing/parsetree.cmi \
+parsing/parser.cmx: parsing/reftypes.cmi parsing/parsetree.cmi \
parsing/longident.cmx parsing/location.cmx utils/clflags.cmx \
parsing/asttypes.cmi parsing/parser.cmi
-parsing/printast.cmo: parsing/parsetree.cmi parsing/longident.cmi \
+parsing/printast.cmo: parsing/reftypes.cmi parsing/parsetree.cmi \
parsing/location.cmi parsing/asttypes.cmi parsing/printast.cmi
-parsing/printast.cmx: parsing/parsetree.cmi parsing/longident.cmx \
+parsing/printast.cmx: parsing/reftypes.cmi parsing/parsetree.cmi \
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/builtin.cmi: typing/types.cmi typing/path.cmi typing/ident.cmi
typing/ctype.cmi: typing/types.cmi typing/path.cmi typing/ident.cmi \
typing/env.cmi parsing/asttypes.cmi
typing/datarepr.cmi: typing/types.cmi typing/path.cmi parsing/asttypes.cmi
-typing/env.cmi: typing/types.cmi typing/path.cmi parsing/longident.cmi \
- typing/ident.cmi utils/consistbl.cmi typing/annot.cmi
+typing/env.cmi: typing/types.cmi parsing/reftypes.cmi typing/path.cmi \
+ parsing/longident.cmi typing/ident.cmi utils/consistbl.cmi \
+ typing/annot.cmi
typing/ident.cmi:
typing/includeclass.cmi: typing/types.cmi typing/typedtree.cmi typing/env.cmi \
typing/ctype.cmi
@@ -93,9 +96,10 @@ 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/typecore.cmi: typing/types.cmi typing/typedtree.cmi \
+ parsing/reftypes.cmi typing/path.cmi parsing/parsetree.cmi \
+ parsing/longident.cmi parsing/location.cmi typing/ident.cmi \
+ typing/env.cmi parsing/asttypes.cmi typing/annot.cmi
typing/typedecl.cmi: typing/types.cmi typing/path.cmi parsing/parsetree.cmi \
parsing/longident.cmi parsing/location.cmi typing/ident.cmi \
typing/env.cmi
@@ -113,26 +117,30 @@ typing/btype.cmo: typing/types.cmi typing/path.cmi utils/misc.cmi \
typing/btype.cmi
typing/btype.cmx: typing/types.cmx typing/path.cmx utils/misc.cmx \
typing/btype.cmi
+typing/builtin.cmo: typing/types.cmi typing/predef.cmi typing/path.cmi \
+ typing/ident.cmi typing/btype.cmi parsing/asttypes.cmi typing/builtin.cmi
+typing/builtin.cmx: typing/types.cmx typing/predef.cmx typing/path.cmx \
+ typing/ident.cmx typing/btype.cmx parsing/asttypes.cmi typing/builtin.cmi
typing/ctype.cmo: typing/types.cmi typing/subst.cmi typing/path.cmi \
- utils/misc.cmi parsing/longident.cmi typing/ident.cmi typing/env.cmi \
- utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi typing/ctype.cmi
+ utils/misc.cmi typing/ident.cmi typing/env.cmi utils/clflags.cmi \
+ typing/btype.cmi parsing/asttypes.cmi typing/ctype.cmi
typing/ctype.cmx: typing/types.cmx typing/subst.cmx typing/path.cmx \
- utils/misc.cmx parsing/longident.cmx typing/ident.cmx typing/env.cmx \
- utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi typing/ctype.cmi
+ utils/misc.cmx typing/ident.cmx typing/env.cmx utils/clflags.cmx \
+ typing/btype.cmx parsing/asttypes.cmi typing/ctype.cmi
typing/datarepr.cmo: typing/types.cmi typing/predef.cmi utils/misc.cmi \
parsing/asttypes.cmi typing/datarepr.cmi
typing/datarepr.cmx: typing/types.cmx typing/predef.cmx utils/misc.cmx \
parsing/asttypes.cmi typing/datarepr.cmi
typing/env.cmo: typing/types.cmi utils/tbl.cmi typing/subst.cmi \
- typing/predef.cmi typing/path.cmi utils/misc.cmi parsing/longident.cmi \
+ parsing/reftypes.cmi typing/path.cmi utils/misc.cmi parsing/longident.cmi \
typing/ident.cmi typing/datarepr.cmi utils/consistbl.cmi utils/config.cmi \
- utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi typing/annot.cmi \
- typing/env.cmi
+ utils/clflags.cmi typing/builtin.cmi typing/btype.cmi \
+ parsing/asttypes.cmi typing/annot.cmi typing/env.cmi
typing/env.cmx: typing/types.cmx utils/tbl.cmx typing/subst.cmx \
- typing/predef.cmx typing/path.cmx utils/misc.cmx parsing/longident.cmx \
+ parsing/reftypes.cmi typing/path.cmx utils/misc.cmx parsing/longident.cmx \
typing/ident.cmx typing/datarepr.cmx utils/consistbl.cmx utils/config.cmx \
- utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi typing/annot.cmi \
- typing/env.cmi
+ utils/clflags.cmx typing/builtin.cmx typing/btype.cmx \
+ parsing/asttypes.cmi typing/annot.cmi typing/env.cmi
typing/ident.cmo: typing/ident.cmi
typing/ident.cmx: typing/ident.cmi
typing/includeclass.cmo: typing/types.cmi typing/printtyp.cmi \
@@ -154,15 +162,13 @@ typing/includemod.cmx: typing/types.cmx typing/typedtree.cmx utils/tbl.cmx \
utils/misc.cmx typing/includecore.cmx typing/includeclass.cmx \
typing/ident.cmx typing/env.cmx typing/ctype.cmx typing/includemod.cmi
typing/mtype.cmo: typing/types.cmi typing/subst.cmi typing/path.cmi \
- typing/ident.cmi typing/env.cmi typing/ctype.cmi typing/btype.cmi \
- parsing/asttypes.cmi typing/mtype.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 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/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 typing/oprint.cmi
+typing/oprint.cmx: typing/outcometree.cmi typing/oprint.cmi
typing/parmatch.cmo: utils/warnings.cmi typing/types.cmi typing/typedtree.cmi \
typing/subst.cmi typing/predef.cmi typing/path.cmi utils/misc.cmi \
parsing/location.cmi typing/ident.cmi typing/env.cmi typing/datarepr.cmi \
@@ -199,14 +205,14 @@ typing/subst.cmo: typing/types.cmi utils/tbl.cmi typing/path.cmi \
utils/misc.cmi typing/ident.cmi typing/btype.cmi typing/subst.cmi
typing/subst.cmx: typing/types.cmx utils/tbl.cmx typing/path.cmx \
utils/misc.cmx typing/ident.cmx typing/btype.cmx typing/subst.cmi
-typing/typeclass.cmo: utils/warnings.cmi typing/typetexp.cmi typing/types.cmi \
+typing/typeclass.cmo: typing/typetexp.cmi typing/types.cmi \
typing/typedtree.cmi typing/typedecl.cmi typing/typecore.cmi \
typing/subst.cmi typing/stypes.cmi typing/printtyp.cmi typing/predef.cmi \
typing/path.cmi parsing/parsetree.cmi typing/parmatch.cmi utils/misc.cmi \
parsing/longident.cmi parsing/location.cmi typing/includeclass.cmi \
typing/ident.cmi typing/env.cmi typing/ctype.cmi utils/clflags.cmi \
typing/btype.cmi parsing/asttypes.cmi typing/typeclass.cmi
-typing/typeclass.cmx: utils/warnings.cmx typing/typetexp.cmx typing/types.cmx \
+typing/typeclass.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 \
@@ -214,16 +220,16 @@ typing/typeclass.cmx: utils/warnings.cmx typing/typetexp.cmx typing/types.cmx \
typing/ident.cmx typing/env.cmx typing/ctype.cmx utils/clflags.cmx \
typing/btype.cmx parsing/asttypes.cmi typing/typeclass.cmi
typing/typecore.cmo: utils/warnings.cmi typing/typetexp.cmi typing/types.cmi \
- typing/typedtree.cmi typing/stypes.cmi typing/printtyp.cmi \
- typing/primitive.cmi typing/predef.cmi typing/path.cmi \
- parsing/parsetree.cmi typing/parmatch.cmi utils/misc.cmi \
+ typing/typedtree.cmi typing/subst.cmi typing/stypes.cmi \
+ parsing/reftypes.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/ident.cmi \
typing/env.cmi typing/ctype.cmi utils/clflags.cmi typing/btype.cmi \
parsing/asttypes.cmi typing/annot.cmi typing/typecore.cmi
typing/typecore.cmx: utils/warnings.cmx typing/typetexp.cmx typing/types.cmx \
- typing/typedtree.cmx typing/stypes.cmx typing/printtyp.cmx \
- typing/primitive.cmx typing/predef.cmx typing/path.cmx \
- parsing/parsetree.cmi typing/parmatch.cmx utils/misc.cmx \
+ typing/typedtree.cmx typing/subst.cmx typing/stypes.cmx \
+ parsing/reftypes.cmi 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/ident.cmx \
typing/env.cmx typing/ctype.cmx utils/clflags.cmx typing/btype.cmx \
parsing/asttypes.cmi typing/annot.cmi typing/typecore.cmi
@@ -247,40 +253,38 @@ typing/typedtree.cmo: typing/types.cmi typing/primitive.cmi typing/path.cmi \
typing/typedtree.cmx: typing/types.cmx typing/primitive.cmx typing/path.cmx \
utils/misc.cmx parsing/location.cmx typing/ident.cmx typing/env.cmx \
parsing/asttypes.cmi typing/typedtree.cmi
-typing/typemod.cmo: typing/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 \
+typing/typemod.cmo: typing/typetexp.cmi typing/types.cmi typing/typedtree.cmi \
+ typing/typedecl.cmi typing/typecore.cmi typing/typeclass.cmi \
+ typing/subst.cmi typing/stypes.cmi typing/printtyp.cmi typing/path.cmi \
parsing/parsetree.cmi typing/mtype.cmi utils/misc.cmi \
parsing/longident.cmi parsing/location.cmi typing/includemod.cmi \
typing/ident.cmi typing/env.cmi typing/ctype.cmi utils/config.cmi \
- utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi typing/annot.cmi \
+ utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \
typing/typemod.cmi
-typing/typemod.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 \
+typing/typemod.cmx: typing/typetexp.cmx typing/types.cmx typing/typedtree.cmx \
+ typing/typedecl.cmx typing/typecore.cmx typing/typeclass.cmx \
+ typing/subst.cmx typing/stypes.cmx typing/printtyp.cmx typing/path.cmx \
parsing/parsetree.cmi typing/mtype.cmx utils/misc.cmx \
parsing/longident.cmx parsing/location.cmx typing/includemod.cmx \
typing/ident.cmx typing/env.cmx typing/ctype.cmx utils/config.cmx \
- utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi typing/annot.cmi \
+ utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \
typing/typemod.cmi
typing/types.cmo: typing/primitive.cmi typing/path.cmi utils/misc.cmi \
typing/ident.cmi parsing/asttypes.cmi typing/types.cmi
typing/types.cmx: typing/primitive.cmx typing/path.cmx utils/misc.cmx \
typing/ident.cmx parsing/asttypes.cmi typing/types.cmi
-typing/typetexp.cmo: utils/warnings.cmi typing/types.cmi utils/tbl.cmi \
- typing/printtyp.cmi typing/path.cmi parsing/parsetree.cmi utils/misc.cmi \
+typing/typetexp.cmo: typing/types.cmi utils/tbl.cmi typing/printtyp.cmi \
+ typing/path.cmi parsing/parsetree.cmi utils/misc.cmi \
parsing/longident.cmi parsing/location.cmi typing/env.cmi \
typing/ctype.cmi utils/clflags.cmi typing/btype.cmi typing/typetexp.cmi
-typing/typetexp.cmx: utils/warnings.cmx typing/types.cmx utils/tbl.cmx \
- typing/printtyp.cmx typing/path.cmx parsing/parsetree.cmi utils/misc.cmx \
+typing/typetexp.cmx: typing/types.cmx utils/tbl.cmx typing/printtyp.cmx \
+ typing/path.cmx parsing/parsetree.cmi utils/misc.cmx \
parsing/longident.cmx parsing/location.cmx typing/env.cmx \
typing/ctype.cmx utils/clflags.cmx typing/btype.cmx typing/typetexp.cmi
typing/unused_var.cmo: utils/warnings.cmi parsing/parsetree.cmi \
- parsing/longident.cmi parsing/location.cmi parsing/asttypes.cmi \
- typing/unused_var.cmi
+ parsing/location.cmi typing/unused_var.cmi
typing/unused_var.cmx: utils/warnings.cmx parsing/parsetree.cmi \
- parsing/longident.cmx parsing/location.cmx parsing/asttypes.cmi \
- typing/unused_var.cmi
+ parsing/location.cmx typing/unused_var.cmi
bytecomp/bytegen.cmi: bytecomp/lambda.cmi bytecomp/instruct.cmi
bytecomp/bytelibrarian.cmi:
bytecomp/bytelink.cmi: bytecomp/symtable.cmi bytecomp/cmo_format.cmi
@@ -315,11 +319,11 @@ bytecomp/typeopt.cmi: typing/typedtree.cmi typing/path.cmi \
bytecomp/bytegen.cmo: typing/types.cmi bytecomp/switch.cmi typing/subst.cmi \
typing/stypes.cmi typing/primitive.cmi utils/misc.cmi bytecomp/lambda.cmi \
bytecomp/instruct.cmi typing/ident.cmi utils/config.cmi \
- parsing/asttypes.cmi typing/annot.cmi bytecomp/bytegen.cmi
+ parsing/asttypes.cmi bytecomp/bytegen.cmi
bytecomp/bytegen.cmx: typing/types.cmx bytecomp/switch.cmx typing/subst.cmx \
typing/stypes.cmx typing/primitive.cmx utils/misc.cmx bytecomp/lambda.cmx \
bytecomp/instruct.cmx typing/ident.cmx utils/config.cmx \
- parsing/asttypes.cmi typing/annot.cmi bytecomp/bytegen.cmi
+ parsing/asttypes.cmi bytecomp/bytegen.cmi
bytecomp/bytelibrarian.cmo: utils/misc.cmi utils/config.cmi \
bytecomp/cmo_format.cmi utils/clflags.cmi bytecomp/bytelink.cmi \
bytecomp/bytelibrarian.cmi
@@ -372,15 +376,13 @@ bytecomp/lambda.cmx: typing/types.cmx typing/primitive.cmx typing/path.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 \
+ typing/primitive.cmi typing/predef.cmi typing/parmatch.cmi utils/misc.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 \
+ typing/primitive.cmx typing/predef.cmx typing/parmatch.cmx utils/misc.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
@@ -388,18 +390,16 @@ 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/printinstr.cmo: bytecomp/printlambda.cmi bytecomp/lambda.cmi \
+ bytecomp/instruct.cmi typing/ident.cmi bytecomp/printinstr.cmi
+bytecomp/printinstr.cmx: bytecomp/printlambda.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/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/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: bytecomp/lambda.cmi typing/ident.cmi utils/clflags.cmi \
@@ -475,7 +475,6 @@ 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/cmmgen.cmi: asmcomp/compilenv.cmi asmcomp/cmm.cmi asmcomp/clambda.cmi
asmcomp/cmm.cmi: typing/ident.cmi asmcomp/debuginfo.cmi
asmcomp/cmmgen.cmi: asmcomp/compilenv.cmi asmcomp/cmm.cmi asmcomp/clambda.cmi
asmcomp/codegen.cmi: asmcomp/cmm.cmi
@@ -483,8 +482,8 @@ asmcomp/coloring.cmi:
asmcomp/comballoc.cmi: asmcomp/mach.cmi
asmcomp/compilenv.cmi: typing/ident.cmi asmcomp/clambda.cmi
asmcomp/debuginfo.cmi: parsing/location.cmi bytecomp/lambda.cmi
-asmcomp/emitaux.cmi: asmcomp/debuginfo.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
@@ -495,8 +494,8 @@ asmcomp/printlinear.cmi: asmcomp/linearize.cmi
asmcomp/printmach.cmi: asmcomp/reg.cmi asmcomp/mach.cmi
asmcomp/proc.cmi: asmcomp/reg.cmi asmcomp/mach.cmi
asmcomp/reg.cmi: asmcomp/cmm.cmi
-asmcomp/reloadgen.cmi: asmcomp/reg.cmi asmcomp/mach.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 \
@@ -504,32 +503,32 @@ asmcomp/selectgen.cmi: utils/tbl.cmi asmcomp/reg.cmi asmcomp/mach.cmi \
asmcomp/selection.cmi: asmcomp/mach.cmi asmcomp/cmm.cmi
asmcomp/spill.cmi: asmcomp/mach.cmi
asmcomp/split.cmi: asmcomp/mach.cmi
-asmcomp/arch.cmo: utils/misc.cmi utils/config.cmi
-asmcomp/arch.cmx: utils/misc.cmx utils/config.cmx
+asmcomp/arch.cmo:
+asmcomp/arch.cmx:
asmcomp/asmgen.cmo: bytecomp/translmod.cmi asmcomp/split.cmi \
asmcomp/spill.cmi asmcomp/selection.cmi asmcomp/scheduling.cmi \
asmcomp/reload.cmi asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/printmach.cmi \
asmcomp/printlinear.cmi asmcomp/printcmm.cmi typing/primitive.cmi \
- utils/misc.cmi asmcomp/mach.cmi asmcomp/liveness.cmi \
- asmcomp/linearize.cmi asmcomp/interf.cmi asmcomp/emitaux.cmi \
- asmcomp/emit.cmi utils/config.cmi asmcomp/compilenv.cmi \
- asmcomp/comballoc.cmi asmcomp/coloring.cmi asmcomp/cmmgen.cmi \
- asmcomp/cmm.cmi asmcomp/closure.cmi utils/clflags.cmi asmcomp/asmgen.cmi
+ utils/misc.cmi asmcomp/liveness.cmi asmcomp/linearize.cmi \
+ asmcomp/interf.cmi asmcomp/emitaux.cmi asmcomp/emit.cmi utils/config.cmi \
+ asmcomp/compilenv.cmi asmcomp/comballoc.cmi asmcomp/coloring.cmi \
+ asmcomp/cmmgen.cmi asmcomp/cmm.cmi asmcomp/closure.cmi utils/clflags.cmi \
+ asmcomp/asmgen.cmi
asmcomp/asmgen.cmx: bytecomp/translmod.cmx asmcomp/split.cmx \
asmcomp/spill.cmx asmcomp/selection.cmx asmcomp/scheduling.cmx \
asmcomp/reload.cmx asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/printmach.cmx \
asmcomp/printlinear.cmx asmcomp/printcmm.cmx typing/primitive.cmx \
- utils/misc.cmx asmcomp/mach.cmx asmcomp/liveness.cmx \
- asmcomp/linearize.cmx asmcomp/interf.cmx asmcomp/emitaux.cmx \
- asmcomp/emit.cmx utils/config.cmx asmcomp/compilenv.cmx \
- asmcomp/comballoc.cmx asmcomp/coloring.cmx asmcomp/cmmgen.cmx \
- asmcomp/cmm.cmx asmcomp/closure.cmx utils/clflags.cmx asmcomp/asmgen.cmi
+ utils/misc.cmx asmcomp/liveness.cmx asmcomp/linearize.cmx \
+ asmcomp/interf.cmx asmcomp/emitaux.cmx asmcomp/emit.cmx utils/config.cmx \
+ asmcomp/compilenv.cmx asmcomp/comballoc.cmx asmcomp/coloring.cmx \
+ asmcomp/cmmgen.cmx asmcomp/cmm.cmx asmcomp/closure.cmx utils/clflags.cmx \
+ asmcomp/asmgen.cmi
asmcomp/asmlibrarian.cmo: utils/misc.cmi utils/config.cmi \
- asmcomp/compilenv.cmi utils/clflags.cmi asmcomp/clambda.cmi \
- utils/ccomp.cmi asmcomp/asmlink.cmi asmcomp/asmlibrarian.cmi
+ asmcomp/compilenv.cmi utils/clflags.cmi utils/ccomp.cmi \
+ asmcomp/asmlink.cmi asmcomp/asmlibrarian.cmi
asmcomp/asmlibrarian.cmx: utils/misc.cmx utils/config.cmx \
- asmcomp/compilenv.cmx utils/clflags.cmx asmcomp/clambda.cmx \
- utils/ccomp.cmx asmcomp/asmlink.cmx asmcomp/asmlibrarian.cmi
+ asmcomp/compilenv.cmx utils/clflags.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 \
@@ -562,6 +561,10 @@ asmcomp/closure.cmx: utils/tbl.cmx bytecomp/switch.cmx typing/primitive.cmx \
utils/misc.cmx bytecomp/lambda.cmx typing/ident.cmx asmcomp/debuginfo.cmx \
asmcomp/compilenv.cmx utils/clflags.cmx asmcomp/clambda.cmx \
parsing/asttypes.cmi asmcomp/closure.cmi
+asmcomp/cmm.cmo: typing/ident.cmi asmcomp/debuginfo.cmi asmcomp/arch.cmo \
+ 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 \
@@ -572,10 +575,6 @@ asmcomp/cmmgen.cmx: typing/types.cmx bytecomp/switch.cmx asmcomp/proc.cmx \
asmcomp/debuginfo.cmx utils/config.cmx asmcomp/compilenv.cmx \
asmcomp/cmm.cmx utils/clflags.cmx asmcomp/clambda.cmx \
parsing/asttypes.cmi asmcomp/arch.cmx asmcomp/cmmgen.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/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 \
@@ -596,26 +595,22 @@ asmcomp/compilenv.cmo: utils/misc.cmi typing/ident.cmi typing/env.cmi \
utils/config.cmi asmcomp/clambda.cmi asmcomp/compilenv.cmi
asmcomp/compilenv.cmx: utils/misc.cmx typing/ident.cmx typing/env.cmx \
utils/config.cmx 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/debuginfo.cmo: parsing/location.cmi asmcomp/debuginfo.cmi
+asmcomp/debuginfo.cmx: parsing/location.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/reg.cmi asmcomp/linearize.cmi \
asmcomp/debuginfo.cmi asmcomp/cmm.cmi asmcomp/arch.cmo \
asmcomp/emitaux.cmi
asmcomp/emitaux.cmx: asmcomp/reg.cmx asmcomp/linearize.cmx \
asmcomp/debuginfo.cmx asmcomp/cmm.cmx asmcomp/arch.cmx \
asmcomp/emitaux.cmi
-asmcomp/emit.cmo: asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \
- asmcomp/mach.cmi parsing/location.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 parsing/location.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/interf.cmo: asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \
asmcomp/mach.cmi asmcomp/interf.cmi
asmcomp/interf.cmx: asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \
@@ -656,20 +651,18 @@ asmcomp/proc.cmx: asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.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/reload.cmo: asmcomp/reloadgen.cmi asmcomp/reg.cmi asmcomp/mach.cmi \
- asmcomp/cmm.cmi asmcomp/arch.cmo asmcomp/reload.cmi
-asmcomp/reload.cmx: asmcomp/reloadgen.cmx asmcomp/reg.cmx asmcomp/mach.cmx \
- asmcomp/cmm.cmx asmcomp/arch.cmx asmcomp/reload.cmi
asmcomp/schedgen.cmo: asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \
- asmcomp/linearize.cmi asmcomp/cmm.cmi asmcomp/arch.cmo \
- asmcomp/schedgen.cmi
+ asmcomp/linearize.cmi asmcomp/arch.cmo asmcomp/schedgen.cmi
asmcomp/schedgen.cmx: asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \
- asmcomp/linearize.cmx asmcomp/cmm.cmx asmcomp/arch.cmx \
- asmcomp/schedgen.cmi
+ asmcomp/linearize.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 asmcomp/reg.cmi asmcomp/proc.cmi \
@@ -680,10 +673,10 @@ asmcomp/selectgen.cmx: utils/tbl.cmx asmcomp/reg.cmx asmcomp/proc.cmx \
asmcomp/cmm.cmx asmcomp/arch.cmx asmcomp/selectgen.cmi
asmcomp/selection.cmo: asmcomp/selectgen.cmi asmcomp/reg.cmi asmcomp/proc.cmi \
utils/misc.cmi asmcomp/mach.cmi asmcomp/debuginfo.cmi asmcomp/cmm.cmi \
- asmcomp/arch.cmo asmcomp/selection.cmi
+ utils/clflags.cmi asmcomp/arch.cmo asmcomp/selection.cmi
asmcomp/selection.cmx: asmcomp/selectgen.cmx asmcomp/reg.cmx asmcomp/proc.cmx \
utils/misc.cmx asmcomp/mach.cmx asmcomp/debuginfo.cmx asmcomp/cmm.cmx \
- asmcomp/arch.cmx asmcomp/selection.cmi
+ 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 \
@@ -714,22 +707,18 @@ driver/compile.cmx: utils/warnings.cmx typing/unused_var.cmx \
driver/pparse.cmx parsing/parse.cmx utils/misc.cmx parsing/location.cmx \
typing/ident.cmx typing/env.cmx bytecomp/emitcode.cmx utils/config.cmx \
utils/clflags.cmx utils/ccomp.cmx bytecomp/bytegen.cmx driver/compile.cmi
-driver/errors.cmo: utils/warnings.cmi typing/typetexp.cmi typing/typemod.cmi \
- typing/typedecl.cmi typing/typecore.cmi typing/typeclass.cmi \
- bytecomp/translmod.cmi bytecomp/translcore.cmi bytecomp/translclass.cmi \
- parsing/syntaxerr.cmi bytecomp/symtable.cmi driver/pparse.cmi \
- parsing/location.cmi parsing/lexer.cmi typing/includemod.cmi \
- typing/env.cmi typing/ctype.cmi bytecomp/bytepackager.cmi \
+driver/errors.cmo: typing/typetexp.cmi typing/typemod.cmi typing/typedecl.cmi \
+ typing/typecore.cmi typing/typeclass.cmi bytecomp/translmod.cmi \
+ bytecomp/translcore.cmi bytecomp/translclass.cmi parsing/syntaxerr.cmi \
+ bytecomp/symtable.cmi parsing/location.cmi parsing/lexer.cmi \
+ typing/includemod.cmi typing/env.cmi bytecomp/bytepackager.cmi \
bytecomp/bytelink.cmi bytecomp/bytelibrarian.cmi driver/errors.cmi
-driver/errors.cmx: utils/warnings.cmx typing/typetexp.cmx typing/typemod.cmx \
- typing/typedecl.cmx typing/typecore.cmx typing/typeclass.cmx \
- bytecomp/translmod.cmx bytecomp/translcore.cmx bytecomp/translclass.cmx \
- parsing/syntaxerr.cmx bytecomp/symtable.cmx driver/pparse.cmx \
- parsing/location.cmx parsing/lexer.cmx typing/includemod.cmx \
- typing/env.cmx typing/ctype.cmx bytecomp/bytepackager.cmx \
+driver/errors.cmx: typing/typetexp.cmx typing/typemod.cmx typing/typedecl.cmx \
+ typing/typecore.cmx typing/typeclass.cmx bytecomp/translmod.cmx \
+ bytecomp/translcore.cmx bytecomp/translclass.cmx parsing/syntaxerr.cmx \
+ bytecomp/symtable.cmx parsing/location.cmx parsing/lexer.cmx \
+ typing/includemod.cmx typing/env.cmx bytecomp/bytepackager.cmx \
bytecomp/bytelink.cmx bytecomp/bytelibrarian.cmx driver/errors.cmi
-driver/main_args.cmo: driver/main_args.cmi
-driver/main_args.cmx: driver/main_args.cmi
driver/main.cmo: utils/warnings.cmi utils/misc.cmi driver/main_args.cmi \
driver/errors.cmi utils/config.cmi driver/compile.cmi utils/clflags.cmi \
bytecomp/bytepackager.cmi bytecomp/bytelink.cmi \
@@ -738,6 +727,8 @@ driver/main.cmx: utils/warnings.cmx utils/misc.cmx driver/main_args.cmx \
driver/errors.cmx utils/config.cmx driver/compile.cmx utils/clflags.cmx \
bytecomp/bytepackager.cmx bytecomp/bytelink.cmx \
bytecomp/bytelibrarian.cmx driver/main.cmi
+driver/main_args.cmo: driver/main_args.cmi
+driver/main_args.cmx: driver/main_args.cmi
driver/optcompile.cmo: utils/warnings.cmi typing/unused_var.cmi \
typing/typemod.cmi typing/typedtree.cmi bytecomp/translmod.cmi \
typing/stypes.cmi bytecomp/simplif.cmi typing/printtyp.cmi \
@@ -752,20 +743,18 @@ driver/optcompile.cmx: utils/warnings.cmx typing/unused_var.cmx \
parsing/parse.cmx utils/misc.cmx parsing/location.cmx typing/ident.cmx \
typing/env.cmx utils/config.cmx asmcomp/compilenv.cmx utils/clflags.cmx \
utils/ccomp.cmx asmcomp/asmgen.cmx driver/optcompile.cmi
-driver/opterrors.cmo: utils/warnings.cmi typing/typetexp.cmi \
- typing/typemod.cmi typing/typedecl.cmi typing/typecore.cmi \
- typing/typeclass.cmi bytecomp/translmod.cmi bytecomp/translcore.cmi \
- bytecomp/translclass.cmi parsing/syntaxerr.cmi driver/pparse.cmi \
- parsing/location.cmi parsing/lexer.cmi typing/includemod.cmi \
- typing/env.cmi typing/ctype.cmi asmcomp/compilenv.cmi \
+driver/opterrors.cmo: typing/typetexp.cmi typing/typemod.cmi \
+ typing/typedecl.cmi typing/typecore.cmi typing/typeclass.cmi \
+ bytecomp/translmod.cmi bytecomp/translcore.cmi bytecomp/translclass.cmi \
+ parsing/syntaxerr.cmi parsing/location.cmi parsing/lexer.cmi \
+ typing/includemod.cmi typing/env.cmi asmcomp/compilenv.cmi \
asmcomp/asmpackager.cmi asmcomp/asmlink.cmi asmcomp/asmlibrarian.cmi \
asmcomp/asmgen.cmi driver/opterrors.cmi
-driver/opterrors.cmx: utils/warnings.cmx typing/typetexp.cmx \
- typing/typemod.cmx typing/typedecl.cmx typing/typecore.cmx \
- typing/typeclass.cmx bytecomp/translmod.cmx bytecomp/translcore.cmx \
- bytecomp/translclass.cmx parsing/syntaxerr.cmx driver/pparse.cmx \
- parsing/location.cmx parsing/lexer.cmx typing/includemod.cmx \
- typing/env.cmx typing/ctype.cmx asmcomp/compilenv.cmx \
+driver/opterrors.cmx: typing/typetexp.cmx typing/typemod.cmx \
+ typing/typedecl.cmx typing/typecore.cmx typing/typeclass.cmx \
+ bytecomp/translmod.cmx bytecomp/translcore.cmx bytecomp/translclass.cmx \
+ parsing/syntaxerr.cmx parsing/location.cmx parsing/lexer.cmx \
+ typing/includemod.cmx typing/env.cmx asmcomp/compilenv.cmx \
asmcomp/asmpackager.cmx asmcomp/asmlink.cmx asmcomp/asmlibrarian.cmx \
asmcomp/asmgen.cmx driver/opterrors.cmi
driver/optmain.cmo: utils/warnings.cmi asmcomp/printmach.cmi \
diff --git a/Makefile b/Makefile
index 53dd3012ad..c3557bf041 100644
--- a/Makefile
+++ b/Makefile
@@ -48,7 +48,7 @@ TYPING=typing/unused_var.cmo typing/ident.cmo typing/path.cmo \
typing/primitive.cmo typing/types.cmo \
typing/btype.cmo typing/oprint.cmo \
typing/subst.cmo typing/predef.cmo \
- typing/datarepr.cmo typing/env.cmo \
+ typing/datarepr.cmo typing/builtin.cmo typing/env.cmo \
typing/typedtree.cmo typing/ctype.cmo \
typing/printtyp.cmo typing/includeclass.cmo \
typing/mtype.cmo typing/includecore.cmo \
@@ -112,7 +112,8 @@ OPTOBJS=$(OPTUTILS) $(PARSING) $(TYPING) $(COMP) $(ASMCOMP) $(OPTDRIVER)
EXPUNGEOBJS=utils/misc.cmo utils/tbl.cmo \
utils/config.cmo utils/clflags.cmo \
typing/ident.cmo typing/path.cmo typing/types.cmo typing/btype.cmo \
- typing/predef.cmo bytecomp/runtimedef.cmo bytecomp/bytesections.cmo \
+ typing/predef.cmo typing/datarepr.cmo typing/builtin.cmo \
+ bytecomp/runtimedef.cmo bytecomp/bytesections.cmo \
bytecomp/dll.cmo bytecomp/meta.cmo bytecomp/symtable.cmo toplevel/expunge.cmo
PERVASIVES=$(STDLIB_MODULES) outcometree topdirs toploop
diff --git a/boot/ocamlc b/boot/ocamlc
index 03c288cf2c..56a70e7465 100755
--- a/boot/ocamlc
+++ b/boot/ocamlc
Binary files differ
diff --git a/boot/ocamldep b/boot/ocamldep
index ff3afb5999..de4bc7449a 100755
--- a/boot/ocamldep
+++ b/boot/ocamldep
Binary files differ
diff --git a/boot/ocamllex b/boot/ocamllex
index 123f7f15c5..4821eb9120 100755
--- a/boot/ocamllex
+++ b/boot/ocamllex
Binary files differ
diff --git a/parsing/lexer.mll b/parsing/lexer.mll
index 019b23c3d3..226b94b4b3 100644
--- a/parsing/lexer.mll
+++ b/parsing/lexer.mll
@@ -357,6 +357,7 @@ rule token = parse
| "->" { MINUSGREATER }
| "." { DOT }
| ".." { DOTDOT }
+ | ".^" { DOTHAT }
| ":" { COLON }
| "::" { COLONCOLON }
| ":=" { COLONEQUAL }
diff --git a/parsing/parser.mly b/parsing/parser.mly
index d0d12eaade..e52773318f 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -17,6 +17,7 @@
%{
open Location
open Asttypes
+open Reftypes
open Longident
open Parsetree
@@ -47,6 +48,18 @@ let reloc_exp x = { x with pexp_loc = symbol_rloc () };;
let mkoperator name pos =
{ pexp_desc = Pexp_ident(Lident name); pexp_loc = rhs_loc pos }
+let mk_question_typ ident option_type target_type =
+ mktyp
+ (Ptyp_arrow
+ ("?" ^ ident,
+ {
+ ptyp_desc =
+ Ptyp_constr (Ldot (Lident "*predef*", "option"), [ option_type ]);
+ ptyp_loc = option_type.ptyp_loc;
+ },
+ target_type))
+;;
+
(*
Ghost expressions and patterns:
expressions and patterns that do not appear explicitely in the
@@ -70,13 +83,16 @@ let ghtyp d = { ptyp_desc = d; ptyp_loc = symbol_gloc () };;
let mkassert e =
match e with
- | {pexp_desc = Pexp_construct (Lident "false", None, false) } ->
- mkexp (Pexp_assertfalse)
- | _ -> mkexp (Pexp_assert (e))
+ | { pexp_desc =
+ Pexp_construct
+ (Reftypes.Pconstr (Lident "false"), None, false);
+ _ } ->
+ mkexp Pexp_assertfalse
+ | _ -> mkexp (Pexp_assert e)
;;
let mkinfix arg1 name arg2 =
- mkexp(Pexp_apply(mkoperator name 2, ["", arg1; "", arg2]))
+ mkexp(Pexp_apply(mkoperator name 2, [ "", arg1; "", arg2 ]))
let neg_float_string f =
if String.length f > 0 && f.[0] = '-'
@@ -104,9 +120,11 @@ let mkuplus name arg =
| _ ->
mkexp(Pexp_apply(mkoperator ("~" ^ name) 1, ["", arg]))
+let constr_ref name = Reftypes.Pconstr (Lident name);;
+
let rec mktailexp = function
[] ->
- ghexp(Pexp_construct(Lident "[]", None, false))
+ ghexp(Pexp_construct(constr_ref "[]", None, false))
| e1 :: el ->
let exp_el = mktailexp el in
let l = {loc_start = e1.pexp_loc.loc_start;
@@ -114,11 +132,12 @@ let rec mktailexp = function
loc_ghost = true}
in
let arg = {pexp_desc = Pexp_tuple [e1; exp_el]; pexp_loc = l} in
- {pexp_desc = Pexp_construct(Lident "::", Some arg, false); pexp_loc = l}
+ { pexp_desc = Pexp_construct(constr_ref "::", Some arg, false);
+ pexp_loc = l; }
let rec mktailpat = function
[] ->
- ghpat(Ppat_construct(Lident "[]", None, false))
+ ghpat(Ppat_construct(constr_ref "[]", None, false))
| p1 :: pl ->
let pat_pl = mktailpat pl in
let l = {loc_start = p1.ppat_loc.loc_start;
@@ -126,7 +145,8 @@ let rec mktailpat = function
loc_ghost = true}
in
let arg = {ppat_desc = Ppat_tuple [p1; pat_pl]; ppat_loc = l} in
- {ppat_desc = Ppat_construct(Lident "::", Some arg, false); ppat_loc = l}
+ { ppat_desc = Ppat_construct(constr_ref "::", Some arg, false);
+ ppat_loc = l; }
let ghstrexp e =
{ pstr_desc = Pstr_eval e; pstr_loc = {e.pexp_loc with loc_ghost = true} }
@@ -197,11 +217,21 @@ let lapply p1 p2 =
then Lapply(p1, p2)
else raise (Syntaxerr.Error(Syntaxerr.Applicative_path (symbol_rloc())))
-let exp_of_label lbl =
- mkexp (Pexp_ident(Lident(Longident.last lbl)))
+let exp_of_record_label_ref lref =
+ match lref with
+ | Plabel label ->
+ mkexp (Pexp_ident(Lident(Longident.last label)))
+ | Plabel_ty (_, label) ->
+ mkexp (Pexp_ident(Lident label))
+;;
-let pat_of_label lbl =
- mkpat (Ppat_var(Longident.last lbl))
+let pat_of_record_label_ref lref =
+ match lref with
+ | Plabel label ->
+ mkpat (Ppat_var(Longident.last label))
+ | Plabel_ty (_, label) ->
+ mkpat (Ppat_var label)
+;;
%}
@@ -229,6 +259,7 @@ let pat_of_label lbl =
%token DONE
%token DOT
%token DOTDOT
+%token DOTHAT
%token DOWNTO
%token ELSE
%token END
@@ -366,13 +397,14 @@ The precedences must be listed from low to high.
%left INFIXOP2 PLUS PLUSDOT MINUS MINUSDOT /* expr (e OP e OP e) */
%left INFIXOP3 STAR /* expr (e OP e OP e) */
%right INFIXOP4 /* expr (e OP e OP e) */
-%nonassoc prec_unary_minus prec_unary_plus /* unary - */
+%nonassoc prec_unary_minus prec_unary_plus /* unary - unary + */
%nonassoc prec_constant_constructor /* cf. simple_expr (C versus C x) */
%nonassoc prec_constr_appl /* above AS BAR COLONCOLON COMMA */
%nonassoc below_SHARP
%nonassoc SHARP /* simple_expr/toplevel_directive */
%nonassoc below_DOT
%nonassoc DOT
+%nonassoc DOTHAT
/* Finally, the first tokens of simple_expr are above everything else. */
%nonassoc BACKQUOTE BEGIN CHAR FALSE FLOAT INT INT32 INT64
LBRACE LBRACELESS LBRACKET LBRACKETBAR LIDENT LPAREN
@@ -852,7 +884,7 @@ expr:
{ syntax_error() }
| expr_comma_list %prec below_COMMA
{ mkexp(Pexp_tuple(List.rev $1)) }
- | constr_longident simple_expr %prec below_SHARP
+ | constr_longident_ref simple_expr %prec below_SHARP
{ mkexp(Pexp_construct($1, Some $2, false)) }
| name_tag simple_expr %prec below_SHARP
{ mkexp(Pexp_variant($1, Some $2)) }
@@ -865,13 +897,13 @@ expr:
| FOR val_ident EQUAL seq_expr direction_flag seq_expr DO seq_expr DONE
{ mkexp(Pexp_for($2, $4, $6, $5, $8)) }
| expr COLONCOLON expr
- { mkexp(Pexp_construct(Lident "::",
- Some(ghexp(Pexp_tuple[$1;$3])),
- false)) }
+ { mkexp(Pexp_construct(
+ constr_ref "::",
+ Some (ghexp (Pexp_tuple [ $1; $3; ])), false)) }
| LPAREN COLONCOLON RPAREN LPAREN expr COMMA expr RPAREN
- { mkexp(Pexp_construct(Lident "::",
- Some(ghexp(Pexp_tuple[$5;$7])),
- false)) }
+ { mkexp(Pexp_construct(
+ constr_ref "::",
+ Some (ghexp (Pexp_tuple [ $5; $7; ])), false)) }
| expr INFIXOP0 expr
{ mkinfix $1 $2 $3 }
| expr INFIXOP1 expr
@@ -912,7 +944,7 @@ expr:
{ mkuminus $1 $2 }
| additive expr %prec prec_unary_plus
{ mkuplus $1 $2 }
- | simple_expr DOT label_longident LESSMINUS expr
+ | simple_expr DOT record_label_longident_ref LESSMINUS expr
{ mkexp(Pexp_setfield($1, $3, $5)) }
| simple_expr DOT LPAREN seq_expr RPAREN LESSMINUS expr
{ mkexp(Pexp_apply(ghexp(Pexp_ident(array_function "Array" "set")),
@@ -936,11 +968,11 @@ expr:
{ mkexp (Pexp_pack ($3, $5)) }
;
simple_expr:
- val_longident
+ | val_longident_ref
{ mkexp(Pexp_ident $1) }
| constant
{ mkexp(Pexp_constant $1) }
- | constr_longident %prec prec_constant_constructor
+ | constr_longident_ref %prec prec_constant_constructor
{ mkexp(Pexp_construct($1, None, false)) }
| name_tag %prec prec_constant_constructor
{ mkexp(Pexp_variant($1, None)) }
@@ -951,12 +983,12 @@ simple_expr:
| BEGIN seq_expr END
{ reloc_exp $2 }
| BEGIN END
- { mkexp (Pexp_construct (Lident "()", None, false)) }
+ { mkexp (Pexp_construct (constr_ref "()", None, false)) }
| BEGIN seq_expr error
{ unclosed "begin" 1 "end" 3 }
| LPAREN seq_expr type_constraint RPAREN
{ let (t, t') = $3 in mkexp(Pexp_constraint($2, t, t')) }
- | simple_expr DOT label_longident
+ | simple_expr DOT record_label_longident_ref
{ mkexp(Pexp_field($1, $3)) }
| simple_expr DOT LPAREN seq_expr RPAREN
{ mkexp(Pexp_apply(ghexp(Pexp_ident(array_function "Array" "get")),
@@ -965,7 +997,7 @@ simple_expr:
{ unclosed "(" 3 ")" 5 }
| simple_expr DOT LBRACKET seq_expr RBRACKET
{ mkexp(Pexp_apply(ghexp(Pexp_ident(array_function "String" "get")),
- ["",$1; "",$4])) }
+ ["", $1; "", $4])) }
| simple_expr DOT LBRACKET seq_expr error
{ unclosed "[" 3 "]" 5 }
| simple_expr DOT LBRACE expr RBRACE
@@ -1022,8 +1054,10 @@ label_expr:
{ ("?" ^ $1, $2) }
;
label_ident:
- LIDENT { ($1, mkexp(Pexp_ident(Lident $1))) }
+ LIDENT
+ { ($1, mkexp(Pexp_ident(Lident $1))) }
;
+
let_bindings:
let_binding { [$1] }
| let_bindings AND let_binding { $3 :: $1 }
@@ -1072,19 +1106,22 @@ expr_comma_list:
| expr COMMA expr { [$3; $1] }
;
record_expr:
- simple_expr WITH lbl_expr_list opt_semi { (Some $1, List.rev $3) }
- | lbl_expr_list opt_semi { (None, List.rev $1) }
+ simple_expr WITH record_lbl_expr_list opt_semi
+ { Some $1, List.rev $3 }
+ | record_lbl_expr_list opt_semi { None, List.rev $1 }
;
-lbl_expr_list:
- label_longident EQUAL expr
- { [$1,$3] }
- | label_longident
- { [$1, exp_of_label $1] }
- | lbl_expr_list SEMI label_longident EQUAL expr
+
+record_lbl_expr_list:
+ | record_label_longident_ref EQUAL expr
+ { [ $1, $3 ] }
+ | record_label_longident_ref
+ { [ $1, exp_of_record_label_ref $1 ] }
+ | record_lbl_expr_list SEMI record_label_longident_ref EQUAL expr
{ ($3, $5) :: $1 }
- | lbl_expr_list SEMI label_longident
- { ($3, exp_of_label $3) :: $1 }
+ | record_lbl_expr_list SEMI record_label_longident_ref
+ { ($3, exp_of_record_label_ref $3) :: $1 }
;
+
field_expr_list:
label EQUAL expr
{ [$1,$3] }
@@ -1112,16 +1149,18 @@ pattern:
{ mkpat(Ppat_alias($1, $3)) }
| pattern_comma_list %prec below_COMMA
{ mkpat(Ppat_tuple(List.rev $1)) }
- | constr_longident pattern %prec prec_constr_appl
+ | constr_longident_ref pattern %prec prec_constr_appl
{ mkpat(Ppat_construct($1, Some $2, false)) }
| name_tag pattern %prec prec_constr_appl
{ mkpat(Ppat_variant($1, Some $2)) }
| pattern COLONCOLON pattern
- { mkpat(Ppat_construct(Lident "::", Some(ghpat(Ppat_tuple[$1;$3])),
- false)) }
+ { mkpat(Ppat_construct(
+ constr_ref "::",
+ Some (ghpat (Ppat_tuple [ $1; $3; ])), false)) }
| LPAREN COLONCOLON RPAREN LPAREN pattern COMMA pattern RPAREN
- { mkpat(Ppat_construct(Lident "::", Some(ghpat(Ppat_tuple[$5;$7])),
- false)) }
+ { mkpat(Ppat_construct(
+ constr_ref "::",
+ Some (ghpat (Ppat_tuple [ $5; $7; ])), false)) }
| pattern BAR pattern
{ mkpat(Ppat_or($1, $3)) }
| LAZY simple_pattern
@@ -1136,15 +1175,15 @@ simple_pattern:
{ mkpat(Ppat_constant $1) }
| CHAR DOTDOT CHAR
{ mkrangepat $1 $3 }
- | constr_longident
+ | constr_longident_ref
{ mkpat(Ppat_construct($1, None, false)) }
| name_tag
{ mkpat(Ppat_variant($1, None)) }
| SHARP type_longident
{ mkpat(Ppat_type $2) }
- | LBRACE lbl_pattern_list record_pattern_end RBRACE
+ | LBRACE record_lbl_pattern_list record_pattern_end RBRACE
{ mkpat(Ppat_record(List.rev $2, $3)) }
- | LBRACE lbl_pattern_list opt_semi error
+ | LBRACE record_lbl_pattern_list opt_semi error
{ unclosed "{" 1 "}" 4 }
| LBRACKET pattern_semi_list opt_semi RBRACKET
{ reloc_pat (mktailpat (List.rev $2)) }
@@ -1174,11 +1213,15 @@ pattern_semi_list:
pattern { [$1] }
| pattern_semi_list SEMI pattern { $3 :: $1 }
;
-lbl_pattern_list:
- label_longident EQUAL pattern { [($1, $3)] }
- | label_longident { [($1, pat_of_label $1)] }
- | lbl_pattern_list SEMI label_longident EQUAL pattern { ($3, $5) :: $1 }
- | lbl_pattern_list SEMI label_longident { ($3, pat_of_label $3) :: $1 }
+record_lbl_pattern_list:
+ | record_label_longident_ref EQUAL pattern
+ { [($1, $3)] }
+ | record_label_longident_ref
+ { [($1, pat_of_record_label_ref $1)] }
+ | record_lbl_pattern_list SEMI record_label_longident_ref EQUAL pattern
+ { ($3, $5) :: $1 }
+ | record_lbl_pattern_list SEMI record_label_longident_ref
+ { ($3, pat_of_record_label_ref $3) :: $1 }
;
record_pattern_end:
opt_semi { Closed }
@@ -1228,11 +1271,11 @@ type_kind:
{ (Ptype_variant(List.rev $3), Private, None) }
| EQUAL private_flag BAR constructor_declarations
{ (Ptype_variant(List.rev $4), $2, None) }
- | EQUAL private_flag LBRACE label_declarations opt_semi RBRACE
+ | EQUAL private_flag LBRACE record_label_declarations opt_semi RBRACE
{ (Ptype_record(List.rev $4), $2, None) }
| EQUAL core_type EQUAL private_flag opt_bar constructor_declarations
{ (Ptype_variant(List.rev $6), $4, Some $2) }
- | EQUAL core_type EQUAL private_flag LBRACE label_declarations opt_semi RBRACE
+ | EQUAL core_type EQUAL private_flag LBRACE record_label_declarations opt_semi RBRACE
{ (Ptype_record(List.rev $6), $4, Some $2) }
;
type_parameters:
@@ -1252,6 +1295,7 @@ type_parameter_list:
type_parameter { [$1] }
| type_parameter_list COMMA type_parameter { $3 :: $1 }
;
+
constructor_declarations:
constructor_declaration { [$1] }
| constructor_declarations BAR constructor_declaration { $3 :: $1 }
@@ -1263,12 +1307,16 @@ constructor_arguments:
/*empty*/ { [] }
| OF core_type_list { List.rev $2 }
;
-label_declarations:
- label_declaration { [$1] }
- | label_declarations SEMI label_declaration { $3 :: $1 }
+
+record_label_declarations:
+ | record_label_declaration
+ { [$1] }
+ | record_label_declarations SEMI record_label_declaration
+ { $3 :: $1 }
;
-label_declaration:
- mutable_flag label COLON poly_type { ($2, $1, $4, symbol_rloc()) }
+record_label_declaration:
+ mutable_flag record_label_ident COLON poly_type
+ { ($2, $1, $4, symbol_rloc()) }
;
/* "with" constraints (additional type equations over signature components) */
@@ -1278,7 +1326,7 @@ with_constraints:
| with_constraints AND with_constraint { $3 :: $1 }
;
with_constraint:
- TYPE type_parameters label_longident with_type_binder core_type constraints
+ TYPE type_parameters type_path with_type_binder core_type constraints
{ let params, variance = List.split $2 in
($3, Pwith_type {ptype_params = params;
ptype_cstrs = List.rev $6;
@@ -1287,7 +1335,7 @@ with_constraint:
ptype_private = $4;
ptype_variance = variance;
ptype_loc = symbol_rloc()}) }
- /* used label_longident instead of type_longident to disallow
+ /* used type_path instead of type_longident to disallow
functor applications in type path */
| MODULE mod_longident EQUAL mod_ext_longident
{ ($2, Pwith_module $4) }
@@ -1322,13 +1370,9 @@ core_type2:
simple_core_type_or_tuple
{ $1 }
| QUESTION LIDENT COLON core_type2 MINUSGREATER core_type2
- { mktyp(Ptyp_arrow("?" ^ $2 ,
- {ptyp_desc = Ptyp_constr(Ldot (Lident "*predef*", "option"), [$4]);
- ptyp_loc = $4.ptyp_loc}, $6)) }
+ { mk_question_typ $2 $4 $6 }
| OPTLABEL core_type2 MINUSGREATER core_type2
- { mktyp(Ptyp_arrow("?" ^ $1 ,
- {ptyp_desc = Ptyp_constr(Ldot (Lident "*predef*", "option"), [$2]);
- ptyp_loc = $2.ptyp_loc}, $4)) }
+ { mk_question_typ $1 $2 $4 }
| LIDENT COLON core_type2 MINUSGREATER core_type2
{ mktyp(Ptyp_arrow($1, $3, $5)) }
| core_type2 MINUSGREATER core_type2
@@ -1469,6 +1513,7 @@ signed_constant:
| MINUS NATIVEINT { Const_nativeint(Nativeint.neg $2) }
| PLUS INT { Const_int $2 }
| PLUS FLOAT { Const_float $2 }
+ | PLUSDOT FLOAT { Const_float $2 }
| PLUS INT32 { Const_int32 $2 }
| PLUS INT64 { Const_int64 $2 }
| PLUS NATIVEINT { Const_nativeint $2 }
@@ -1480,10 +1525,7 @@ ident:
UIDENT { $1 }
| LIDENT { $1 }
;
-val_ident:
- LIDENT { $1 }
- | LPAREN operator RPAREN { $2 }
-;
+
operator:
PREFIXOP { $1 }
| INFIXOP0 { $1 }
@@ -1505,6 +1547,23 @@ operator:
| AMPERAMPER { "&&" }
| COLONEQUAL { ":=" }
;
+
+val_ident:
+ LIDENT { $1 }
+ | LPAREN operator RPAREN { $2 }
+;
+
+val_longident:
+ val_ident { Lident $1 }
+ | mod_longident DOT val_ident { Ldot ($1, $3) }
+;
+
+val_longident_ref:
+ | val_longident { $1 }
+;
+
+/* Value constructors identifiers and long identifiers */
+
constr_ident:
UIDENT { $1 }
/* | LBRACKET RBRACKET { "[]" } */
@@ -1515,25 +1574,51 @@ constr_ident:
| TRUE { "true" }
;
-val_longident:
- val_ident { Lident $1 }
- | mod_longident DOT val_ident { Ldot($1, $3) }
-;
constr_longident:
- mod_longident %prec below_DOT { $1 }
+ | mod_longident %prec below_DOT { $1 }
| LBRACKET RBRACKET { Lident "[]" }
| LPAREN RPAREN { Lident "()" }
| FALSE { Lident "false" }
| TRUE { Lident "true" }
;
-label_longident:
- LIDENT { Lident $1 }
- | mod_longident DOT LIDENT { Ldot($1, $3) }
+
+constr_longident_ref:
+ | constr_longident
+ { Pconstr $1 }
+ | LIDENT DOTHAT constr_ident
+ { Pconstr_ty (Lident $1, $3) }
+ | mod_longident DOT LIDENT DOTHAT constr_ident
+ { Pconstr_ty (Ldot ($1, $3), $5) }
;
+
+/* Record label identifiers and long identifiers */
+
+record_label_ident:
+ | LIDENT { $1 }
+;
+
+record_label_longident:
+ | record_label_ident { Lident $1 }
+ | mod_longident DOT record_label_ident { Ldot($1, $3) }
+;
+
+record_label_longident_ref:
+ | record_label_longident
+ { Plabel $1 }
+ | record_label_longident DOTHAT record_label_ident
+ { Plabel_ty ($1, $3) }
+;
+
+type_path:
+ | LIDENT { Lident $1 }
+ | mod_longident DOT LIDENT { Ldot ($1, $3) }
+;
+
type_longident:
LIDENT { Lident $1 }
| mod_ext_longident DOT LIDENT { Ldot($1, $3) }
;
+
mod_longident:
UIDENT { Lident $1 }
| mod_longident DOT UIDENT { Ldot($1, $3) }
@@ -1547,6 +1632,7 @@ mty_longident:
ident { Lident $1 }
| mod_ext_longident DOT ident { Ldot($1, $3) }
;
+
clty_longident:
LIDENT { Lident $1 }
| mod_ext_longident DOT LIDENT { Ldot($1, $3) }
diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli
index ca835be10e..26a21588de 100644
--- a/parsing/parsetree.mli
+++ b/parsing/parsetree.mli
@@ -15,6 +15,7 @@
(* Abstract syntax tree produced by parsing *)
open Asttypes
+open Reftypes
(* Type expressions for the core language *)
@@ -22,7 +23,7 @@ type core_type =
{ ptyp_desc: core_type_desc;
ptyp_loc: Location.t }
-and core_type_desc =
+and core_type_desc =
Ptyp_any
| Ptyp_var of string
| Ptyp_arrow of label * core_type * core_type
@@ -71,9 +72,9 @@ and pattern_desc =
| Ppat_alias of pattern * string
| Ppat_constant of constant
| Ppat_tuple of pattern list
- | Ppat_construct of Longident.t * pattern option * bool
+ | Ppat_construct of Reftypes.constructor_ref * pattern option * bool
| Ppat_variant of label * pattern option
- | Ppat_record of (Longident.t * pattern) list * closed_flag
+ | Ppat_record of (Reftypes.label_ref * pattern) list * closed_flag
| Ppat_array of pattern list
| Ppat_or of pattern * pattern
| Ppat_constraint of pattern * core_type
@@ -93,11 +94,11 @@ and expression_desc =
| Pexp_match of expression * (pattern * expression) list
| Pexp_try of expression * (pattern * expression) list
| Pexp_tuple of expression list
- | Pexp_construct of Longident.t * expression option * bool
+ | Pexp_construct of constructor_ref * expression option * bool
| Pexp_variant of label * expression option
- | Pexp_record of (Longident.t * expression) list * expression option
- | Pexp_field of expression * Longident.t
- | Pexp_setfield of expression * Longident.t * expression
+ | Pexp_record of (label_ref * expression) list * expression option
+ | Pexp_field of expression * label_ref
+ | Pexp_setfield of expression * label_ref * expression
| Pexp_array of expression list
| Pexp_ifthenelse of expression * expression * expression option
| Pexp_sequence of expression * expression
diff --git a/parsing/printast.ml b/parsing/printast.ml
index d35f74949c..6aeb349ded 100644
--- a/parsing/printast.ml
+++ b/parsing/printast.ml
@@ -13,6 +13,7 @@
(* $Id$ *)
open Asttypes;;
+open Reftypes;;
open Format;;
open Lexing;;
open Location;;
@@ -42,6 +43,20 @@ let rec fmt_longident_aux f x =
let fmt_longident f x = fprintf f "\"%a\"" fmt_longident_aux x;;
+let fmt_constructor_ref f cstr_ref =
+ match cstr_ref with
+ | Reftypes.Pconstr lid -> fprintf f "Pconstr %a" fmt_longident lid
+ | Reftypes.Pconstr_ty (lid_ty, constr_name) ->
+ fprintf f "Pconstr_ty (%a, %S)" fmt_longident lid_ty constr_name
+;;
+
+let fmt_record_label_ref f lbl_ref =
+ match lbl_ref with
+ | Reftypes.Plabel lid -> fprintf f "Plabel %a" fmt_longident lid
+ | Reftypes.Plabel_ty (lid_ty, lbl_name) ->
+ fprintf f "Plabel_ty (%a, %S)" fmt_longident lid_ty lbl_name
+;;
+
let fmt_constant f x =
match x with
| Const_int (i) -> fprintf f "Const_int %d" i;
@@ -177,7 +192,7 @@ and pattern i ppf x =
line i ppf "Ppat_tuple\n";
list i pattern ppf l;
| Ppat_construct (li, po, b) ->
- line i ppf "Ppat_construct %a\n" fmt_longident li;
+ line i ppf "Ppat_construct %a\n" fmt_constructor_ref li;
option i pattern ppf po;
bool i ppf b;
| Ppat_variant (l, po) ->
@@ -185,7 +200,7 @@ and pattern i ppf x =
option i pattern ppf po;
| Ppat_record (l, c) ->
line i ppf "Ppat_record\n";
- list i longident_x_pattern ppf l;
+ list i record_label_ref_x_pattern ppf l;
| Ppat_array (l) ->
line i ppf "Ppat_array\n";
list i pattern ppf l;
@@ -234,7 +249,7 @@ and expression i ppf x =
line i ppf "Pexp_tuple\n";
list i expression ppf l;
| Pexp_construct (li, eo, b) ->
- line i ppf "Pexp_construct %a\n" fmt_longident li;
+ line i ppf "Pexp_construct %a\n" fmt_constructor_ref li;
option i expression ppf eo;
bool i ppf b;
| Pexp_variant (l, eo) ->
@@ -242,16 +257,16 @@ and expression i ppf x =
option i expression ppf eo;
| Pexp_record (l, eo) ->
line i ppf "Pexp_record\n";
- list i longident_x_expression ppf l;
+ list i record_label_ref_x_expression ppf l;
option i expression ppf eo;
| Pexp_field (e, li) ->
line i ppf "Pexp_field\n";
expression i ppf e;
- longident i ppf li;
+ fmt_record_label_ref ppf li;
| Pexp_setfield (e1, li, e2) ->
line i ppf "Pexp_setfield\n";
expression i ppf e1;
- longident i ppf li;
+ fmt_record_label_ref ppf li;
expression i ppf e2;
| Pexp_array (l) ->
line i ppf "Pexp_array\n";
@@ -662,8 +677,8 @@ and string_list_x_location i ppf (l, loc) =
line i ppf "<params> %a\n" fmt_location loc;
list (i+1) string ppf l;
-and longident_x_pattern i ppf (li, p) =
- line i ppf "%a\n" fmt_longident li;
+and record_label_ref_x_pattern i ppf (li, p) =
+ line i ppf "%a\n" fmt_record_label_ref li;
pattern (i+1) ppf p;
and pattern_x_expression_case i ppf (p, e) =
@@ -680,8 +695,8 @@ and string_x_expression i ppf (s, e) =
line i ppf "<override> \"%s\"\n" s;
expression (i+1) ppf e;
-and longident_x_expression i ppf (li, e) =
- line i ppf "%a\n" fmt_longident li;
+and record_label_ref_x_expression i ppf (li, e) =
+ line i ppf "%a\n" fmt_record_label_ref li;
expression (i+1) ppf e;
and label_x_expression i ppf (l,e) =
diff --git a/typing/ctype.ml b/typing/ctype.ml
index 441b777af1..38bba6db99 100644
--- a/typing/ctype.ml
+++ b/typing/ctype.ml
@@ -651,7 +651,7 @@ let rec generalize_expansive env var_level ty =
match ty.desc with
Tconstr (path, tyl, abbrev) ->
let variance =
- try (Env.find_type path env).type_variance
+ try (Env.find_type_declaration path env).type_variance
with Not_found -> List.map (fun _ -> (true,true,true)) tyl in
abbrev := Mnil;
List.iter2
@@ -1202,7 +1202,7 @@ let expand_head_opt env ty =
let enforce_constraints env ty =
match ty with
{desc = Tconstr (path, args, abbrev); level = level} ->
- let decl = Env.find_type path env in
+ let decl = Env.find_type_declaration path env in
ignore
(subst env level Public (ref Mnil) None decl.type_params args
(newvar2 level))
@@ -1377,7 +1377,7 @@ let occur_univar env ty =
| Tconstr (_, [], _) -> ()
| Tconstr (p, tl, _) ->
begin try
- let td = Env.find_type p env in
+ let td = Env.find_type_declaration p env in
List.iter2
(fun t (pos,neg,_) -> if pos || neg then occur_rec bound t)
tl td.type_variance
@@ -1424,7 +1424,7 @@ let univars_escape env univar_pairs vl ty =
| Tconstr (_, [], _) -> ()
| Tconstr (p, tl, _) ->
begin try
- let td = Env.find_type p env in
+ let td = Env.find_type_declaration p env in
List.iter2 (fun t (pos,neg,_) -> if pos || neg then occur t)
tl td.type_variance
with Not_found ->
@@ -2759,7 +2759,7 @@ let rec lid_of_path sharp = function
Longident.Lapply (lid_of_path sharp p1, lid_of_path "" p2)
let find_cltype_for_path env p =
- let path, cl_abbr = Env.lookup_type (lid_of_path "#" p) env in
+ let path, cl_abbr = Env.lookup_type_declaration (lid_of_path "#" p) env in
match cl_abbr.type_manifest with
Some ty ->
begin match (repr ty).desc with
@@ -2841,14 +2841,14 @@ let rec build_subtype env visited loops posi level t =
if c > Unchanged then (t'',c)
else (t, Unchanged)
end
- | Tconstr(p, tl, abbrev) ->
+ | Tconstr(path, tl, abbrev) ->
(* Must check recursion on constructors, since we do not always
expand them *)
if memq_warn t visited then (t, Unchanged) else
let visited = t :: visited in
begin try
- let decl = Env.find_type p env in
- if level = 0 && generic_abbrev env p && safe_abbrev env t
+ let td = Env.find_type_declaration path env in
+ if level = 0 && generic_abbrev env path && safe_abbrev env t
&& not (has_constr_row' env t)
then warn := true;
let tl' =
@@ -2860,10 +2860,10 @@ let rec build_subtype env visited loops posi level t =
else
if co then build_subtype env visited loops posi level t
else (newvar(), Changed))
- decl.type_variance tl
+ td.type_variance tl
in
let c = collect tl' in
- if c > Unchanged then (newconstr p (List.map fst tl'), c)
+ if c > Unchanged then (newconstr path (List.map fst tl'), c)
else (t, Unchanged)
with Not_found ->
(t, Unchanged)
@@ -2960,8 +2960,8 @@ let subtype_error env trace =
let private_abbrev env path =
try
- let decl = Env.find_type path env in
- decl.type_private = Private && decl.type_manifest <> None
+ let td = Env.find_type_declaration path env in
+ td.type_private = Private && td.type_manifest <> None
with Not_found -> false
let rec subtype_rec env trace t1 t2 cstrs =
@@ -2993,7 +2993,7 @@ let rec subtype_rec env trace t1 t2 cstrs =
subtype_rec env trace t1 (expand_abbrev env t2) cstrs
| (Tconstr(p1, tl1, _), Tconstr(p2, tl2, _)) when Path.same p1 p2 ->
begin try
- let decl = Env.find_type p1 env in
+ let td = Env.find_type_declaration p1 env in
List.fold_left2
(fun cstrs (co, cn, _) (t1, t2) ->
if co then
@@ -3004,7 +3004,7 @@ let rec subtype_rec env trace t1 t2 cstrs =
else
if cn then subtype_rec env ((t2, t1)::trace) t2 t1 cstrs
else cstrs)
- cstrs decl.type_variance (List.combine tl1 tl2)
+ cstrs td.type_variance (List.combine tl1 tl2)
with Not_found ->
(trace, t1, t2, !univar_pairs)::cstrs
end
diff --git a/typing/datarepr.ml b/typing/datarepr.ml
index 80b94132d9..0cd710edc7 100644
--- a/typing/datarepr.ml
+++ b/typing/datarepr.ml
@@ -19,36 +19,40 @@ open Misc
open Asttypes
open Types
-let constructor_descrs ty_res cstrs priv =
+let constructor_descriptions ty_res cstrs priv =
let num_consts = ref 0 and num_nonconsts = ref 0 in
List.iter
(function (name, []) -> incr num_consts
| (name, _) -> incr num_nonconsts)
cstrs;
let rec describe_constructors idx_const idx_nonconst = function
- [] -> []
+ | [] -> []
| (name, ty_args) :: rem ->
let (tag, descr_rem) =
match ty_args with
- [] -> (Cstr_constant idx_const,
- describe_constructors (idx_const+1) idx_nonconst rem)
- | _ -> (Cstr_block idx_nonconst,
- describe_constructors idx_const (idx_nonconst+1) rem) in
- let cstr =
- { cstr_res = ty_res;
+ | [] ->
+ (Cstr_constant idx_const,
+ describe_constructors (idx_const + 1) idx_nonconst rem)
+ | _ ->
+ (Cstr_block idx_nonconst,
+ describe_constructors idx_const (idx_nonconst + 1) rem) in
+ let cdesc =
+ { cstr_name = name;
+ cstr_res = ty_res;
cstr_args = ty_args;
cstr_arity = List.length ty_args;
cstr_tag = tag;
cstr_consts = !num_consts;
cstr_nonconsts = !num_nonconsts;
cstr_private = priv } in
- (name, cstr) :: descr_rem in
+ cdesc :: descr_rem in
describe_constructors 0 0 cstrs
-let exception_descr path_exc decl =
- { cstr_res = Predef.type_exn;
- cstr_args = decl;
- cstr_arity = List.length decl;
+let exception_descr path_exc (ename, ty_list) =
+ { cstr_name = ename;
+ cstr_res = Predef.type_exn;
+ cstr_args = ty_list;
+ cstr_arity = List.length ty_list;
cstr_tag = Cstr_exception path_exc;
cstr_consts = -1;
cstr_nonconsts = -1;
@@ -61,12 +65,12 @@ let dummy_label =
lbl_pos = (-1); lbl_all = [||]; lbl_repres = Record_regular;
lbl_private = Public }
-let label_descrs ty_res lbls repres priv =
+let label_descriptions ty_res lbls repres priv =
let all_labels = Array.create (List.length lbls) dummy_label in
let rec describe_labels num = function
- [] -> []
+ | [] -> []
| (name, mut_flag, ty_arg) :: rest ->
- let lbl =
+ let ldesc =
{ lbl_name = name;
lbl_res = ty_res;
lbl_arg = ty_arg;
@@ -75,8 +79,8 @@ let label_descrs ty_res lbls repres priv =
lbl_all = all_labels;
lbl_repres = repres;
lbl_private = priv } in
- all_labels.(num) <- lbl;
- (name, lbl) :: describe_labels (num+1) rest in
+ all_labels.(num) <- ldesc;
+ ldesc :: describe_labels (num + 1) rest in
describe_labels 0 lbls
exception Constr_not_found
@@ -93,5 +97,5 @@ let rec find_constr tag num_const num_nonconst = function
then cstr
else find_constr tag num_const (num_nonconst + 1) rem
-let find_constr_by_tag tag cstrlist =
- find_constr tag 0 0 cstrlist
+let find_constr_by_tag tag cstrs =
+ find_constr tag 0 0 cstrs
diff --git a/typing/datarepr.mli b/typing/datarepr.mli
index eb440aba27..e15297b9e1 100644
--- a/typing/datarepr.mli
+++ b/typing/datarepr.mli
@@ -18,15 +18,27 @@
open Asttypes
open Types
+val constructor_descriptions:
+ type_expr -> (string * type_expr list) list -> private_flag ->
+ constructor_description list
+
+(* FIXME
val constructor_descrs:
type_expr -> (string * type_expr list) list -> private_flag ->
- (string * constructor_description) list
+ (string * constructor_description) list
+*)
val exception_descr:
- Path.t -> type_expr list -> constructor_description
+ Path.t -> (string * type_expr list) -> constructor_description
+(* FIXME
val label_descrs:
type_expr -> (string * mutable_flag * type_expr) list ->
- record_representation -> private_flag ->
- (string * label_description) list
+ record_representation -> private_flag ->
+ (string * label_description) list
+*)
+val label_descriptions:
+ type_expr -> (string * mutable_flag * type_expr) list ->
+ record_representation -> private_flag ->
+ label_description list
exception Constr_not_found
diff --git a/typing/env.ml b/typing/env.ml
index a654762b14..a6c32a78ab 100644
--- a/typing/env.ml
+++ b/typing/env.ml
@@ -17,11 +17,11 @@
open Config
open Misc
open Asttypes
+open Reftypes
open Longident
open Path
open Types
-
type error =
Not_an_interface of string
| Corrupted_interface of string
@@ -34,7 +34,7 @@ exception Error of error
type summary =
Env_empty
| Env_value of summary * Ident.t * value_description
- | Env_type of summary * Ident.t * type_declaration
+ | Env_type of summary * Ident.t * type_description
| Env_exception of summary * Ident.t * exception_declaration
| Env_module of summary * Ident.t * module_type
| Env_modtype of summary * Ident.t * modtype_declaration
@@ -47,7 +47,7 @@ type t = {
annotations: (Path.t * Annot.ident) Ident.tbl;
constrs: constructor_description Ident.tbl;
labels: label_description Ident.tbl;
- types: (Path.t * type_declaration) Ident.tbl;
+ types: (Path.t * type_description) Ident.tbl;
modules: (Path.t * module_type) Ident.tbl;
modtypes: (Path.t * modtype_declaration) Ident.tbl;
components: (Path.t * module_components) Ident.tbl;
@@ -67,7 +67,7 @@ and structure_components = {
mutable comp_annotations: (string, (Annot.ident * int)) Tbl.t;
mutable comp_constrs: (string, (constructor_description * int)) Tbl.t;
mutable comp_labels: (string, (label_description * int)) Tbl.t;
- mutable comp_types: (string, (type_declaration * int)) Tbl.t;
+ mutable comp_types: (string, (type_description * int)) Tbl.t;
mutable comp_modules: (string, (module_type Lazy.t * int)) Tbl.t;
mutable comp_modtypes: (string, (modtype_declaration * int)) Tbl.t;
mutable comp_components: (string, (module_components * int)) Tbl.t;
@@ -251,7 +251,8 @@ let find proj1 proj2 path env =
| Pdot(p, s, pos) ->
begin match Lazy.force(find_module_descr p env) with
Structure_comps c ->
- let (data, pos) = Tbl.find s (proj2 c) in data
+ let (data, pos) = Tbl.find s (proj2 c) in
+ data
| Functor_comps f ->
raise Not_found
end
@@ -269,11 +270,13 @@ and find_class =
and find_cltype =
find (fun env -> env.cltypes) (fun sc -> sc.comp_cltypes)
+let find_type_declaration path env = fst (find_type path env);;
+
(* Find the manifest type associated to a type when appropriate:
- the type should be public or should have a private row,
- the type should have an associated manifest type. *)
let find_type_expansion path env =
- let decl = find_type path env in
+ let decl = find_type_declaration path env in
match decl.type_manifest with
| Some body when decl.type_private = Public
|| decl.type_kind <> Type_abstract
@@ -289,7 +292,7 @@ let find_type_expansion path env =
In particular, the manifest type associated to a private abstract type
is revealed for the sake of compiler's type-based optimisations. *)
let find_type_expansion_opt path env =
- let decl = find_type path env in
+ let decl = find_type_declaration path env in
match decl.type_manifest with
(* The manifest type of Private abstract data types can still get
an approximation using their manifest type. *)
@@ -316,7 +319,8 @@ let find_module path env =
| Pdot(p, s, pos) ->
begin match Lazy.force (find_module_descr p env) with
Structure_comps c ->
- let (data, pos) = Tbl.find s c.comp_modules in Lazy.force data
+ let (data, pos) = Tbl.find s c.comp_modules in
+ Lazy.force data
| Functor_comps f ->
raise Not_found
end
@@ -427,6 +431,10 @@ and lookup_constructor =
lookup_simple (fun env -> env.constrs) (fun sc -> sc.comp_constrs)
and lookup_label =
lookup_simple (fun env -> env.labels) (fun sc -> sc.comp_labels)
+and lookup_constructor_lid =
+ lookup_simple (fun env -> env.constrs) (fun sc -> sc.comp_constrs)
+and lookup_label_lid =
+ lookup_simple (fun env -> env.labels) (fun sc -> sc.comp_labels)
and lookup_type =
lookup (fun env -> env.types) (fun sc -> sc.comp_types)
and lookup_modtype =
@@ -436,6 +444,48 @@ and lookup_class =
and lookup_cltype =
lookup (fun env -> env.cltypes) (fun sc -> sc.comp_cltypes)
+let lookup_type_kind_description lid_ty env =
+ let path, (_, kind_desc) = lookup_type lid_ty env in
+ kind_desc
+;;
+
+let lookup_type_declaration lid_ty env =
+ let path, (ty_decl, _ty_desc) = lookup_type lid_ty env in
+ path, ty_decl
+;;
+
+let lookup_constructor_of_type cname kind_desc =
+ match kind_desc with
+ | Kind_abstract -> raise Not_found
+ | Kind_variant cdescs ->
+ List.find (fun cdesc -> cdesc.Types.cstr_name = cname) cdescs
+ | Kind_record _ldescs -> raise Not_found
+;;
+
+let lookup_constructor_ref cref env =
+ match cref with
+ | Pconstr lid -> lookup_constructor_lid lid env
+ | Pconstr_ty (lid_ty, cname) ->
+ let kind_desc = lookup_type_kind_description lid_ty env in
+ lookup_constructor_of_type cname kind_desc
+;;
+
+let lookup_label_of_type lname ty_desc =
+ match ty_desc with
+ | Kind_abstract -> raise Not_found
+ | Kind_variant _cdescs -> raise Not_found
+ | Kind_record ldescs ->
+ List.find (fun ldesc -> ldesc.Types.lbl_name = lname) ldescs
+;;
+
+let lookup_label_ref lbl_ref env =
+ match lbl_ref with
+ | Plabel lid -> lookup_label_lid lid env
+ | Plabel_ty (lid_ty, lname) ->
+ let kind_desc = lookup_type_kind_description lid_ty env in
+ lookup_label_of_type lname kind_desc
+;;
+
(* Expand manifest module type names at the top of the given module type *)
let rec scrape_modtype mty env =
@@ -450,20 +500,20 @@ let rec scrape_modtype mty env =
(* Compute constructor descriptions *)
-let constructors_of_type ty_path decl =
+let constructor_descs_of_type ty_path decl =
match decl.type_kind with
- Type_variant cstrs ->
- Datarepr.constructor_descrs
+ | Type_variant cstrs ->
+ Datarepr.constructor_descriptions
(Btype.newgenty (Tconstr(ty_path, decl.type_params, ref Mnil)))
cstrs decl.type_private
| Type_record _ | Type_abstract -> []
(* Compute label descriptions *)
-let labels_of_type ty_path decl =
+let label_descs_of_type ty_path decl =
match decl.type_kind with
Type_record(labels, rep) ->
- Datarepr.label_descrs
+ Datarepr.label_descriptions
(Btype.newgenty (Tconstr(ty_path, decl.type_params, ref Mnil)))
labels rep decl.type_private
| Type_variant _ | Type_abstract -> []
@@ -479,7 +529,7 @@ let rec prefix_idents root pos sub = function
let (pl, final_sub) = prefix_idents root nextpos sub rem in
(p::pl, final_sub)
| Tsig_type(id, decl, _) :: rem ->
- let p = Pdot(root, Ident.name id, nopos) in
+ let p = Pdot(root, Ident.name id, Path.nopos) in
let (pl, final_sub) =
prefix_idents root pos (Subst.add_type id p sub) rem in
(p::pl, final_sub)
@@ -538,20 +588,42 @@ let rec components_of_module env sub path mty =
end
| Tsig_type(id, decl, _) ->
let decl' = Subst.type_declaration sub decl in
- c.comp_types <-
- Tbl.add (Ident.name id) (decl', nopos) c.comp_types;
- List.iter
- (fun (name, descr) ->
- c.comp_constrs <- Tbl.add name (descr, nopos) c.comp_constrs)
- (constructors_of_type path decl');
- List.iter
- (fun (name, descr) ->
- c.comp_labels <- Tbl.add name (descr, nopos) c.comp_labels)
- (labels_of_type path decl');
- env := store_type_infos id path decl !env
+ begin match decl.type_kind with
+ | Type_abstract ->
+ let ty_kind_desc = Kind_abstract in
+ let ty_desc = (decl', ty_kind_desc) in
+ c.comp_types <-
+ Tbl.add (Ident.name id) (ty_desc, nopos) c.comp_types;
+ env := store_type_infos id path (decl, ty_kind_desc) !env
+ | Type_variant cstrs ->
+ let cdescs = constructor_descs_of_type path decl' in
+ let ty_kind_desc = Kind_variant cdescs in
+ let ty_desc = (decl', ty_kind_desc) in
+ c.comp_types <-
+ Tbl.add (Ident.name id) (ty_desc, nopos) c.comp_types;
+ List.iter
+ (fun desc ->
+ c.comp_constrs <-
+ Tbl.add desc.cstr_name (desc, nopos) c.comp_constrs)
+ cdescs;
+ env := store_type_infos id path (decl, ty_kind_desc) !env
+ | Type_record (labls, repres) ->
+ let ldescs = label_descs_of_type path decl' in
+ let ty_kind_desc = Kind_record ldescs in
+ let ty_desc = (decl', ty_kind_desc) in
+ c.comp_types <-
+ Tbl.add (Ident.name id) (ty_desc, nopos) c.comp_types;
+ List.iter
+ (fun desc ->
+ c.comp_labels <-
+ Tbl.add desc.lbl_name (desc, nopos) c.comp_labels)
+ ldescs;
+ env := store_type_infos id path (decl, ty_kind_desc) !env
+ end
| Tsig_exception(id, decl) ->
- let decl' = Subst.exception_declaration sub decl in
- let cstr = Datarepr.exception_descr path decl' in
+ let ty_list = Subst.exception_declaration sub decl in
+ let cstr =
+ Datarepr.exception_descr path (Ident.name id, ty_list) in
c.comp_constrs <-
Tbl.add (Ident.name id) (cstr, !pos) c.comp_constrs;
incr pos
@@ -613,22 +685,44 @@ and store_annot id path annot env =
annotations = Ident.add id (path, annot) env.annotations }
else env
-and store_type id path info env =
- { env with
- constrs =
- List.fold_right
- (fun (name, descr) constrs ->
- Ident.add (Ident.create name) descr constrs)
- (constructors_of_type path info)
- env.constrs;
- labels =
- List.fold_right
- (fun (name, descr) labels ->
- Ident.add (Ident.create name) descr labels)
- (labels_of_type path info)
- env.labels;
- types = Ident.add id (path, info) env.types;
- summary = Env_type(env.summary, id, info) }
+and store_type id path ty_decl env =
+ let ty_decl' = ty_decl in
+ match ty_decl.type_kind with
+ | Type_abstract ->
+ let ty_kind_desc = Kind_abstract in
+ let ty_desc = (ty_decl', ty_kind_desc) in
+ { env with
+ types = Ident.add id (path, ty_desc) env.types;
+ summary = Env_type(env.summary, id, ty_desc);
+ }
+ | Type_variant cstrs ->
+ let cdescs = constructor_descs_of_type path ty_decl in
+ let ty_kind_desc = Kind_variant cdescs in
+ let ty_desc = (ty_decl', ty_kind_desc) in
+ { env with
+ constrs =
+ List.fold_right
+ (fun cdesc constrs ->
+ Ident.add (Ident.create cdesc.cstr_name) cdesc constrs)
+ cdescs
+ env.constrs;
+ types = Ident.add id (path, ty_desc) env.types;
+ summary = Env_type(env.summary, id, ty_desc);
+ }
+ | Type_record (labls, repres) ->
+ let ldescs = label_descs_of_type path ty_decl' in
+ let ty_kind_desc = Kind_record ldescs in
+ let ty_desc = (ty_decl', ty_kind_desc) in
+ { env with
+ labels =
+ List.fold_right
+ (fun ldesc labels ->
+ Ident.add (Ident.create ldesc.lbl_name) ldesc labels)
+ ldescs
+ env.labels;
+ types = Ident.add id (path, ty_desc) env.types;
+ summary = Env_type(env.summary, id, ty_desc);
+ }
and store_type_infos id path info env =
(* Simplified version of store_type that doesn't compute and store
@@ -642,15 +736,19 @@ and store_type_infos id path info env =
and store_exception id path decl env =
{ env with
- constrs = Ident.add id (Datarepr.exception_descr path decl) env.constrs;
+ constrs =
+ Ident.add id
+ (Datarepr.exception_descr path (Ident.name id, decl))
+ env.constrs;
summary = Env_exception(env.summary, id, decl) }
and store_module id path mty env =
{ env with
modules = Ident.add id (path, mty) env.modules;
components =
- Ident.add id (path, components_of_module env Subst.identity path mty)
- env.components;
+ Ident.add id
+ (path, components_of_module env Subst.identity path mty)
+ env.components;
summary = Env_module(env.summary, id, mty) }
and store_modtype id path info env =
@@ -675,7 +773,7 @@ let components_of_functor_appl f p1 p2 =
Hashtbl.find f.fcomp_cache p2
with Not_found ->
let p = Papply(p1, p2) in
- let mty =
+ let mty =
Subst.modtype (Subst.add_module f.fcomp_param p2 Subst.identity)
f.fcomp_res in
let comps = components_of_module f.fcomp_env f.fcomp_subst p mty in
@@ -696,8 +794,8 @@ let add_value id desc env =
let add_annot id annot env =
store_annot id (Pident id) annot env
-and add_type id info env =
- store_type id (Pident id) info env
+and add_type id ty_decl env =
+ store_type id (Pident id) ty_decl env
and add_exception id decl env =
store_exception id (Pident id) decl env
@@ -717,7 +815,8 @@ and add_cltype id ty env =
(* Insertion of bindings by name *)
let enter store_fun name data env =
- let id = Ident.create name in (id, store_fun id (Pident id) data env)
+ let id = Ident.create name in
+ (id, store_fun id (Pident id) data env)
let enter_value = enter store_value
and enter_type = enter store_type
@@ -777,7 +876,7 @@ let open_signature root sg env =
(Subst.cltype_declaration sub decl) env)
env sg pl in
{ newenv with summary = Env_open(env.summary, root) }
-
+
(* Open a signature from a file *)
let open_pers_signature name env =
@@ -787,7 +886,8 @@ let open_pers_signature name env =
(* Read a signature from a file *)
let read_signature modname filename =
- let ps = read_pers_struct modname filename in ps.ps_sig
+ let ps = read_pers_struct modname filename in
+ ps.ps_sig
(* Return the CRC of the interface of the given compilation unit *)
@@ -844,7 +944,7 @@ let save_signature sg modname filename =
(* Make the initial environment *)
-let initial = Predef.build_initial_env add_type add_exception empty
+let initial = Builtin.build_initial_env add_type add_exception empty
(* Return the environment summary *)
diff --git a/typing/env.mli b/typing/env.mli
index 8f00972a62..818ba1d9a5 100644
--- a/typing/env.mli
+++ b/typing/env.mli
@@ -25,7 +25,8 @@ val diff: t -> t -> Ident.t list
(* Lookup by paths *)
val find_value: Path.t -> t -> value_description
-val find_type: Path.t -> t -> type_declaration
+val find_type: Path.t -> t -> type_description
+val find_type_declaration: Path.t -> t -> type_declaration
val find_module: Path.t -> t -> module_type
val find_modtype: Path.t -> t -> modtype_declaration
val find_class: Path.t -> t -> class_declaration
@@ -41,9 +42,16 @@ val find_modtype_expansion: Path.t -> t -> Types.module_type
val lookup_value: Longident.t -> t -> Path.t * value_description
val lookup_annot: Longident.t -> t -> Path.t * Annot.ident
+(*
val lookup_constructor: Longident.t -> t -> constructor_description
val lookup_label: Longident.t -> t -> label_description
-val lookup_type: Longident.t -> t -> Path.t * type_declaration
+*)
+val lookup_constructor_ref :
+ Reftypes.constructor_ref -> t -> constructor_description
+val lookup_label_ref :
+ Reftypes.label_ref -> t -> label_description
+val lookup_type: Longident.t -> t -> Path.t * type_description
+val lookup_type_declaration: Longident.t -> t -> Path.t * type_declaration
val lookup_module: Longident.t -> t -> Path.t * module_type
val lookup_modtype: Longident.t -> t -> Path.t * modtype_declaration
val lookup_class: Longident.t -> t -> Path.t * class_declaration
@@ -116,7 +124,7 @@ val crc_units: Consistbl.t
type summary =
Env_empty
| Env_value of summary * Ident.t * value_description
- | Env_type of summary * Ident.t * type_declaration
+ | Env_type of summary * Ident.t * type_description
| Env_exception of summary * Ident.t * exception_declaration
| Env_module of summary * Ident.t * module_type
| Env_modtype of summary * Ident.t * modtype_declaration
diff --git a/typing/mtype.ml b/typing/mtype.ml
index 50455fb508..ffacb458c5 100644
--- a/typing/mtype.ml
+++ b/typing/mtype.ml
@@ -145,7 +145,7 @@ let enrich_typedecl env p decl =
Some ty -> decl
| None ->
try
- let orig_decl = Env.find_type p env in
+ let orig_decl = Env.find_type_declaration p env in
if orig_decl.type_arity <> decl.type_arity
then decl
else {decl with type_manifest =
diff --git a/typing/parmatch.ml b/typing/parmatch.ml
index 15e6d74e34..9028197b69 100644
--- a/typing/parmatch.ml
+++ b/typing/parmatch.ml
@@ -126,7 +126,7 @@ let get_type_path ty tenv =
let rec get_type_descr ty tenv =
match (Ctype.repr ty).desc with
- | Tconstr (path,_,_) -> Env.find_type path tenv
+ | Tconstr (path,_,_) -> Env.find_type_declaration path tenv
| _ -> fatal_error "Parmatch.get_type_descr"
let rec get_constr tag ty tenv =
diff --git a/typing/predef.ml b/typing/predef.ml
index ce43b5a3bb..b96d40c737 100644
--- a/typing/predef.ml
+++ b/typing/predef.ml
@@ -65,139 +65,3 @@ and type_nativeint = newgenty (Tconstr(path_nativeint, [], ref Mnil))
and type_int32 = newgenty (Tconstr(path_int32, [], ref Mnil))
and type_int64 = newgenty (Tconstr(path_int64, [], ref Mnil))
and type_lazy_t t = newgenty (Tconstr(path_lazy_t, [t], ref Mnil))
-
-let ident_match_failure = Ident.create_predef_exn "Match_failure"
-and ident_out_of_memory = Ident.create_predef_exn "Out_of_memory"
-and ident_invalid_argument = Ident.create_predef_exn "Invalid_argument"
-and ident_failure = Ident.create_predef_exn "Failure"
-and ident_not_found = Ident.create_predef_exn "Not_found"
-and ident_sys_error = Ident.create_predef_exn "Sys_error"
-and ident_end_of_file = Ident.create_predef_exn "End_of_file"
-and ident_division_by_zero = Ident.create_predef_exn "Division_by_zero"
-and ident_stack_overflow = Ident.create_predef_exn "Stack_overflow"
-and ident_sys_blocked_io = Ident.create_predef_exn "Sys_blocked_io"
-and ident_assert_failure = Ident.create_predef_exn "Assert_failure"
-and ident_undefined_recursive_module =
- Ident.create_predef_exn "Undefined_recursive_module"
-
-let path_match_failure = Pident ident_match_failure
-and path_assert_failure = Pident ident_assert_failure
-and path_undefined_recursive_module = Pident ident_undefined_recursive_module
-
-let build_initial_env add_type add_exception empty_env =
- let decl_abstr =
- {type_params = [];
- type_arity = 0;
- type_kind = Type_abstract;
- type_private = Public;
- type_manifest = None;
- type_variance = []}
- and decl_bool =
- {type_params = [];
- type_arity = 0;
- type_kind = Type_variant(["false", []; "true", []]);
- type_private = Public;
- type_manifest = None;
- type_variance = []}
- and decl_unit =
- {type_params = [];
- type_arity = 0;
- type_kind = Type_variant(["()", []]);
- type_private = Public;
- type_manifest = None;
- type_variance = []}
- and decl_exn =
- {type_params = [];
- type_arity = 0;
- type_kind = Type_variant [];
- type_private = Public;
- type_manifest = None;
- type_variance = []}
- and decl_array =
- let tvar = newgenvar() in
- {type_params = [tvar];
- type_arity = 1;
- type_kind = Type_abstract;
- type_private = Public;
- type_manifest = None;
- type_variance = [true, true, true]}
- and decl_list =
- let tvar = newgenvar() in
- {type_params = [tvar];
- type_arity = 1;
- type_kind =
- Type_variant(["[]", []; "::", [tvar; type_list tvar]]);
- type_private = Public;
- type_manifest = None;
- type_variance = [true, false, false]}
- and decl_format6 =
- {type_params = [
- newgenvar(); newgenvar(); newgenvar();
- newgenvar(); newgenvar(); newgenvar();
- ];
- type_arity = 6;
- type_kind = Type_abstract;
- type_private = Public;
- type_manifest = None;
- type_variance = [
- true, true, true; true, true, true;
- true, true, true; true, true, true;
- true, true, true; true, true, true;
- ]}
- and decl_option =
- let tvar = newgenvar() in
- {type_params = [tvar];
- type_arity = 1;
- type_kind = Type_variant(["None", []; "Some", [tvar]]);
- type_private = Public;
- type_manifest = None;
- type_variance = [true, false, false]}
- and decl_lazy_t =
- let tvar = newgenvar() in
- {type_params = [tvar];
- type_arity = 1;
- type_kind = Type_abstract;
- type_private = Public;
- type_manifest = None;
- type_variance = [true, false, false]}
- in
-
- add_exception ident_match_failure
- [newgenty (Ttuple[type_string; type_int; type_int])] (
- add_exception ident_out_of_memory [] (
- add_exception ident_stack_overflow [] (
- add_exception ident_invalid_argument [type_string] (
- add_exception ident_failure [type_string] (
- add_exception ident_not_found [] (
- add_exception ident_sys_blocked_io [] (
- add_exception ident_sys_error [type_string] (
- add_exception ident_end_of_file [] (
- add_exception ident_division_by_zero [] (
- add_exception ident_assert_failure
- [newgenty (Ttuple[type_string; type_int; type_int])] (
- add_exception ident_undefined_recursive_module
- [newgenty (Ttuple[type_string; type_int; type_int])] (
- add_type ident_int64 decl_abstr (
- add_type ident_int32 decl_abstr (
- add_type ident_nativeint decl_abstr (
- add_type ident_lazy_t decl_lazy_t (
- add_type ident_option decl_option (
- add_type ident_format6 decl_format6 (
- add_type ident_list decl_list (
- add_type ident_array decl_array (
- add_type ident_exn decl_exn (
- add_type ident_unit decl_unit (
- add_type ident_bool decl_bool (
- add_type ident_float decl_abstr (
- add_type ident_string decl_abstr (
- add_type ident_char decl_abstr (
- add_type ident_int decl_abstr (
- empty_env)))))))))))))))))))))))))))
-
-let builtin_values =
- List.map (fun id -> Ident.make_global id; (Ident.name id, id))
- [ident_match_failure; ident_out_of_memory; ident_stack_overflow;
- ident_invalid_argument;
- ident_failure; ident_not_found; ident_sys_error; ident_end_of_file;
- ident_division_by_zero; ident_sys_blocked_io;
- ident_assert_failure; ident_undefined_recursive_module ]
diff --git a/typing/predef.mli b/typing/predef.mli
index b7bbb6f4b2..0ced58cc87 100644
--- a/typing/predef.mli
+++ b/typing/predef.mli
@@ -47,19 +47,18 @@ val path_int32: Path.t
val path_int64: Path.t
val path_lazy_t: Path.t
-val path_match_failure: Path.t
-val path_assert_failure : Path.t
-val path_undefined_recursive_module : Path.t
-
-(* To build the initial environment. Since there is a nasty mutual
- recursion between predef and env, we break it by parameterizing
- over Env.t, Env.add_type and Env.add_exception. *)
-
-val build_initial_env:
- (Ident.t -> type_declaration -> 'a -> 'a) ->
- (Ident.t -> exception_declaration -> 'a -> 'a) ->
- 'a -> 'a
-
-(* To initialize linker tables *)
-
-val builtin_values: (string * Ident.t) list
+val ident_int: Ident.t
+val ident_char: Ident.t
+val ident_string: Ident.t
+val ident_float: Ident.t
+val ident_bool: Ident.t
+val ident_unit: Ident.t
+val ident_exn: Ident.t
+val ident_array: Ident.t
+val ident_list: Ident.t
+val ident_format6: Ident.t
+val ident_option: Ident.t
+val ident_nativeint: Ident.t
+val ident_int32: Ident.t
+val ident_int64: Ident.t
+val ident_lazy_t: Ident.t
diff --git a/typing/printtyp.ml b/typing/printtyp.ml
index 2134afb568..c3859be995 100644
--- a/typing/printtyp.ml
+++ b/typing/printtyp.ml
@@ -59,6 +59,21 @@ let rec path ppf = function
| Papply(p1, p2) ->
fprintf ppf "%a(%a)" path p1 path p2
+(* Print label and constructor references *)
+let constructor_ref ppf cstr_ref =
+ match cstr_ref with
+ | Reftypes.Pconstr lid -> fprintf ppf "%a" longident lid
+ | Reftypes.Pconstr_ty (lid_ty, constr_name) ->
+ fprintf ppf "%a.^%s" longident lid_ty constr_name
+;;
+
+let label_ref ppf lbl_ref =
+ match lbl_ref with
+ | Reftypes.Plabel lid -> fprintf ppf "%a" longident lid
+ | Reftypes.Plabel_ty (lid_ty, cstr_name) ->
+ fprintf ppf "%a.^%s" longident lid_ty cstr_name
+;;
+
(* Print a recursive annotation *)
let tree_of_rec = function
@@ -524,10 +539,18 @@ let rec tree_of_type_decl id decl =
begin match decl.type_kind with
| Type_abstract -> ()
| Type_variant [] -> ()
+(*
+ | Type_variant cstrs ->
+ List.iter
+ (fun (_cname, cdesc) -> List.iter mark_loops cdesc.cstr_args) cstrs *)
| Type_variant cstrs ->
List.iter (fun (_, args) -> List.iter mark_loops args) cstrs
| Type_record(l, rep) ->
List.iter (fun (_, _, ty) -> mark_loops ty) l
+(*
+ | Type_record(lbls, _rep) ->
+ List.iter
+ (fun (_lname, ldesc) -> mark_loops ldesc.lbl_arg) lbls*)
end;
let type_param =
@@ -580,9 +603,15 @@ let rec tree_of_type_decl id decl =
in
(name, args, ty, priv, constraints)
+(*and tree_of_constructor (cname, cdesc) =
+ (cname, tree_of_typlist false cdesc.cstr_args) *)
+
and tree_of_constructor (name, args) =
(name, tree_of_typlist false args)
+(*and tree_of_label (lname, ldesc) =
+ (lname, ldesc.lbl_mut = Mutable, tree_of_typexp false ldesc.lbl_arg) *)
+
and tree_of_label (name, mut, arg) =
(name, mut = Mutable, tree_of_typexp false arg)
@@ -895,7 +924,8 @@ let has_explanation unif t3 t4 =
Tfield _, _ | _, Tfield _
| Tunivar, Tvar | Tvar, Tunivar
| Tvariant _, Tvariant _ -> true
- | Tconstr (p, _, _), Tvar | Tvar, Tconstr (p, _, _) ->
+ | Tconstr (p, _, _), Tvar
+ | Tvar, Tconstr (p, _, _) ->
unif && min t3.level t4.level < Path.binding_time p
| _ -> false
diff --git a/typing/printtyp.mli b/typing/printtyp.mli
index 5e3402ff8f..b97291cec3 100644
--- a/typing/printtyp.mli
+++ b/typing/printtyp.mli
@@ -20,6 +20,8 @@ open Outcometree
val longident: formatter -> Longident.t -> unit
val ident: formatter -> Ident.t -> unit
+val constructor_ref : formatter -> Reftypes.constructor_ref -> unit
+val label_ref : formatter -> Reftypes.label_ref -> unit
val tree_of_path: Path.t -> out_ident
val path: formatter -> Path.t -> unit
val raw_type_expr: formatter -> type_expr -> unit
diff --git a/typing/typeclass.ml b/typing/typeclass.ml
index 7f6c1de241..037c2d9a79 100644
--- a/typing/typeclass.ml
+++ b/typing/typeclass.ml
@@ -762,12 +762,13 @@ and class_expr cl_num val_env met_env scl =
let loc = default.pexp_loc in
let scases =
[{ppat_loc = loc; ppat_desc =
- Ppat_construct(Longident.Lident"Some",
+ Ppat_construct(Reftypes.Pconstr (Longident.Lident"Some"),
Some{ppat_loc = loc; ppat_desc = Ppat_var"*sth*"},
false)},
{pexp_loc = loc; pexp_desc = Pexp_ident(Longident.Lident"*sth*")};
{ppat_loc = loc; ppat_desc =
- Ppat_construct(Longident.Lident"None", None, false)},
+ Ppat_construct(Reftypes.Pconstr (Longident.Lident"None"),
+ None, false)},
default] in
let smatch =
{pexp_loc = loc; pexp_desc =
diff --git a/typing/typecore.ml b/typing/typecore.ml
index fb91522698..87e8cd0591 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -16,6 +16,7 @@
open Misc
open Asttypes
+open Reftypes
open Parsetree
open Types
open Typedtree
@@ -24,30 +25,32 @@ open Ctype
type error =
Unbound_value of Longident.t
- | Unbound_constructor of Longident.t
- | Unbound_label of Longident.t
+ | Unbound_constructor_ref of Reftypes.constructor_ref
+ | Unbound_label_ref of Reftypes.label_ref
+ | Unbound_type of Longident.t
| Unbound_module of Longident.t
| Unbound_functor of Longident.t
- | Polymorphic_label of Longident.t
- | Constructor_arity_mismatch of Longident.t * int * int
- | Label_mismatch of Longident.t * (type_expr * type_expr) list
+ | Polymorphic_label_ref of label_ref
+ | Constructor_ref_arity_mismatch of constructor_ref * int * int
+ | Label_ref_mismatch of label_ref * (type_expr * type_expr) list
| Pattern_type_clash of (type_expr * type_expr) list
| Multiply_bound_variable of string
| Orpat_vars of Ident.t
| Expr_type_clash of (type_expr * type_expr) list
| Apply_non_function of type_expr
| Apply_wrong_label of label * type_expr
- | Label_multiply_defined of Longident.t
+ | Label_ref_multiply_defined of label_ref
| Label_missing of string list
- | Label_not_mutable of Longident.t
+ | Label_ref_not_mutable of label_ref
| Incomplete_format of string
| Bad_conversion of string * int * char
| Undefined_method of type_expr * string
| Undefined_inherited_method of string
| Unbound_class of Longident.t
| Virtual_class of Longident.t
- | Private_type of type_expr
- | Private_label of Longident.t * type_expr
+ | Private_type_constructor_ref of constructor_ref * type_expr
+ | Private_type_label_ref of label_ref * type_expr
+ | Private_type_field_assignment of label_ref * type_expr
| Unbound_instance_variable of string
| Instance_variable_not_mutable of string
| Not_subtype of (type_expr * type_expr) list * (type_expr * type_expr) list
@@ -98,6 +101,69 @@ let rp node =
node
;;
+(* Narrowing type errors for identifiers: report unbound functors first, then
+ unbound modules, then unbound identifier, instead of blindly reporting an
+ unbound error on a complex longident as a whole. *)
+let rec narrow_unbound_lid_error env lid make_error =
+ let module_is_bound mlid =
+ ignore (Env.lookup_module mlid env) in
+ match lid with
+ | Longident.Lident _ -> make_error lid
+ | Longident.Ldot (mlid, _) ->
+ begin
+ try
+ module_is_bound mlid;
+ make_error lid with
+ | Not_found -> Unbound_module mlid
+ end
+ | Longident.Lapply (flid, mlid) ->
+ begin
+ try
+ module_is_bound flid;
+ begin
+ try
+ module_is_bound mlid;
+ make_error lid with
+ | Not_found -> Unbound_module mlid
+ end with
+ | Not_found -> Unbound_functor flid
+ end
+;;
+
+let unbound_ident_error loc env lid make_error =
+ let err = narrow_unbound_lid_error env lid make_error in
+ raise (Error (loc, err))
+;;
+
+let narrow_ref_error env tlid rname make_error =
+ narrow_unbound_lid_error env tlid
+ (fun tlid ->
+ try
+ ignore (Env.lookup_type_declaration tlid env);
+ make_error rname
+ with
+ | Not_found -> Unbound_type tlid)
+;;
+
+let unbound_label_ref_error loc env lref make_error =
+ let err =
+ match lref with
+ | Plabel llid -> narrow_unbound_lid_error env llid make_error
+ | Plabel_ty (tlid, lname) ->
+ narrow_ref_error env tlid lname
+ (fun name -> make_error (Longident.Lident name)) in
+ raise (Error (loc, err))
+;;
+
+let unbound_constr_ref_error loc env cref make_error =
+ let err =
+ match cref with
+ | Pconstr clid -> narrow_unbound_lid_error env clid make_error
+ | Pconstr_ty (tlid, cname) ->
+ narrow_ref_error env tlid cname
+ (fun name -> make_error (Longident.Lident name)) in
+ raise (Error (loc, err))
+;;
(* Typing of constants *)
@@ -116,12 +182,16 @@ let type_option ty =
newty (Tconstr(Predef.path_option,[ty], ref Mnil))
let option_none ty loc =
- let cnone = Env.lookup_constructor (Longident.Lident "None") Env.initial in
+ let cnone =
+ Env.lookup_constructor_ref
+ (Pconstr (Longident.Lident "None")) Env.initial in
{ exp_desc = Texp_construct(cnone, []);
exp_type = ty; exp_loc = loc; exp_env = Env.initial }
let option_some texp =
- let csome = Env.lookup_constructor (Longident.Lident "Some") Env.initial in
+ let csome =
+ Env.lookup_constructor_ref
+ (Pconstr (Longident.Lident "Some")) Env.initial in
{ exp_desc = Texp_construct(csome, [texp]); exp_loc = texp.exp_loc;
exp_type = type_option texp.exp_type; exp_env = texp.exp_env }
@@ -134,10 +204,10 @@ let rec extract_label_names sexp env ty =
let ty = repr ty in
match ty.desc with
| Tconstr (path, _, _) ->
- let td = Env.find_type path env in
+ let td = Env.find_type_declaration path env in
begin match td.type_kind with
- | Type_record (fields, _) ->
- List.map (fun (name, _, _) -> name) fields
+ | Type_record (lbls, _repr) ->
+ List.map (fun (lname, _, _) -> lname) lbls
| Type_abstract when td.type_manifest <> None ->
extract_label_names sexp env (expand_head env ty)
| _ -> assert false
@@ -240,7 +310,7 @@ let enter_orpat_variables loc env p1_vs p2_vs =
with
| Unify trace ->
raise(Error(loc, Pattern_type_clash(trace)))
- end ;
+ end;
(x2,x1)::unify_vars rem1 rem2
end
| [],[] -> []
@@ -255,7 +325,7 @@ let enter_orpat_variables loc env p1_vs p2_vs =
let rec build_as_type env p =
match p.pat_desc with
- Tpat_alias(p1, _) -> build_as_type env p1
+ Tpat_alias(p, _) -> build_as_type env p
| Tpat_tuple pl ->
let tyl = List.map (build_as_type env) pl in
newty (Ttuple tyl)
@@ -268,9 +338,10 @@ let rec build_as_type env p =
ty_res
| Tpat_variant(l, p', _) ->
let ty = may_map (build_as_type env) p' in
- newty (Tvariant{row_fields=[l, Rpresent ty]; row_more=newvar();
- row_bound=(); row_name=None;
- row_fixed=false; row_closed=false})
+ newty (Tvariant {
+ row_fields=[l, Rpresent ty]; row_more=newvar();
+ row_bound=(); row_name=None;
+ row_fixed=false; row_closed=false})
| Tpat_record lpl ->
let lbl = fst(List.hd lpl) in
if lbl.lbl_private = Private then p.pat_type else
@@ -307,7 +378,7 @@ let rec build_as_type env p =
let build_or_pat env loc lid =
let path, decl =
- try Env.lookup_type lid env
+ try Env.lookup_type_declaration lid env
with Not_found ->
raise(Typetexp.Error(loc, Typetexp.Unbound_type_constructor lid))
in
@@ -344,7 +415,7 @@ let build_or_pat env loc lid =
pat_env=env; pat_type=ty})
pats
in
- match pats with
+ match pats with
[] -> raise(Error(loc, Not_a_variant_type lid))
| pat :: pats ->
let r =
@@ -354,21 +425,29 @@ let build_or_pat env loc lid =
pat pats in
rp { r with pat_loc = loc }
-let rec find_record_qual = function
- | [] -> None
- | (Longident.Ldot (modname, _), _) :: _ -> Some modname
- | _ :: rest -> find_record_qual rest
-
-let type_label_a_list type_lid_a lid_a_list =
- match find_record_qual lid_a_list with
- | None -> List.map type_lid_a lid_a_list
- | Some modname ->
- List.map
- (function
- | (Longident.Lident id), sarg ->
- type_lid_a (Longident.Ldot (modname, id), sarg)
- | lid_a -> type_lid_a lid_a)
- lid_a_list
+let add_modname_to_lref modname = function
+ | Plabel (Longident.Lident id) -> Plabel (Longident.Ldot (modname, id))
+ | lref -> lref
+
+let add_typename_to_lref ty_lid = function
+ | Plabel (Longident.Lident lname) -> Plabel_ty (ty_lid, lname)
+ | lref -> lref
+
+let rec find_record_label_qualifier = function
+ | [] -> (fun lref -> lref)
+ | (Plabel (Longident.Lident _lbl_name), _) :: rest ->
+ find_record_label_qualifier rest
+ | (Plabel (Longident.Ldot (modname, _lblname)), _) :: _ ->
+ (fun lref -> add_modname_to_lref modname lref)
+ | (Plabel_ty (ty_lid, _lbl_name), _) :: _ ->
+ (fun lref -> add_typename_to_lref ty_lid lref)
+ | (_, _) :: rest -> find_record_label_qualifier rest
+
+let type_record_fields type_field fields =
+ let make_record_label_ref = find_record_label_qualifier fields in
+ List.map
+ (fun (lref, sarg) -> type_field (make_record_label_ref lref, sarg))
+ fields
(* Checks over the labels mentioned in a record pattern:
no duplicate definitions (error); properly closed (warning) *)
@@ -380,17 +459,22 @@ let check_recordpat_labels loc lbl_pat_list closed =
let all = label1.lbl_all in
let defined = Array.make (Array.length all) false in
let check_defined (label, _) =
- if defined.(label.lbl_pos)
- then raise(Error(loc, Label_multiply_defined
- (Longident.Lident label.lbl_name)))
- else defined.(label.lbl_pos) <- true in
+ if defined.(label.lbl_pos) then
+ raise
+ (Error (loc,
+ Label_ref_multiply_defined
+ (Plabel (Longident.Lident label.lbl_name)))) else
+ defined.(label.lbl_pos) <- true in
+
List.iter check_defined lbl_pat_list;
+
if closed = Closed
&& Warnings.is_active (Warnings.Non_closed_record_pattern "")
then begin
let undefined = ref [] in
for i = 0 to Array.length all - 1 do
- if not defined.(i) then undefined := all.(i).lbl_name :: !undefined
+ if not defined.(i) then
+ undefined := all.(i).lbl_name :: !undefined
done;
if !undefined <> [] then begin
let u = String.concat ", " (List.rev !undefined) in
@@ -460,37 +544,49 @@ let rec type_pat env sp =
pat_loc = loc;
pat_type = newty (Ttuple(List.map (fun p -> p.pat_type) pl));
pat_env = env }
- | Ppat_construct(lid, sarg, explicit_arity) ->
- let constr =
- try
- Env.lookup_constructor lid env
- with Not_found ->
- raise(Error(loc, Unbound_constructor lid)) in
+ | Ppat_construct(cref, sarg, explicit_arity) ->
+ let cdesc =
+ try Env.lookup_constructor_ref cref env with
+ | Not_found ->
+ unbound_constr_ref_error loc env cref
+ (fun clid -> Unbound_constructor_ref (Pconstr clid)) in
+
let sargs =
match sarg with
- None -> []
- | Some {ppat_desc = Ppat_tuple spl} when explicit_arity -> spl
- | Some {ppat_desc = Ppat_tuple spl} when constr.cstr_arity > 1 -> spl
- | Some({ppat_desc = Ppat_any} as sp) when constr.cstr_arity <> 1 ->
- if constr.cstr_arity = 0 then
+ | None -> []
+ | Some { ppat_desc = Ppat_tuple spl }
+ when explicit_arity -> spl
+ | Some { ppat_desc = Ppat_tuple spl }
+ when cdesc.cstr_arity > 1 -> spl
+ | Some ({ ppat_desc = Ppat_any } as sp)
+ when cdesc.cstr_arity <> 1 ->
+ if cdesc.cstr_arity = 0 then
Location.prerr_warning sp.ppat_loc
- Warnings.Wildcard_arg_to_constant_constr;
- replicate_list sp constr.cstr_arity
- | Some sp -> [sp] in
- if List.length sargs <> constr.cstr_arity then
- raise(Error(loc, Constructor_arity_mismatch(lid,
- constr.cstr_arity, List.length sargs)));
+ Warnings.Wildcard_arg_to_constant_constr;
+ replicate_list sp cdesc.cstr_arity
+ | Some sp -> [ sp ] in
+
+ if List.length sargs <> cdesc.cstr_arity then
+ raise
+ (Error (loc,
+ Constructor_ref_arity_mismatch
+ (cref, cdesc.cstr_arity, List.length sargs)));
+
let args = List.map (type_pat env) sargs in
- let (ty_args, ty_res) = instance_constructor constr in
+
+ let (ty_args, ty_res) = instance_constructor cdesc in
+
List.iter2 (unify_pat env) args ty_args;
+
rp {
- pat_desc = Tpat_construct(constr, args);
+ pat_desc = Tpat_construct(cdesc, args);
pat_loc = loc;
pat_type = ty_res;
pat_env = env }
| Ppat_variant(l, sarg) ->
let arg = may_map (type_pat env) sarg in
- let arg_type = match arg with None -> [] | Some arg -> [arg.pat_type] in
+ let arg_type =
+ match arg with None -> [] | Some arg -> [arg.pat_type] in
let row = { row_fields =
[l, Reither(arg = None, arg_type, true, ref None)];
row_bound = ();
@@ -503,24 +599,28 @@ let rec type_pat env sp =
pat_loc = loc;
pat_type = newty (Tvariant row);
pat_env = env }
- | Ppat_record(lid_sp_list, closed) ->
- let ty = newvar() in
- let type_label_pat (lid, sarg) =
- let label =
- try
- Env.lookup_label lid env
- with Not_found ->
- raise(Error(loc, Unbound_label lid)) in
+ | Ppat_record(fields, closed) ->
+ let ty = newvar () in
+
+ let type_field (lref, sarg) =
+ let ldesc =
+ try Env.lookup_label_ref lref env with
+ | Not_found ->
+ unbound_label_ref_error loc env lref
+ (fun llid -> Unbound_label_ref (Plabel llid)) in
+
begin_def ();
- let (vars, ty_arg, ty_res) = instance_label false label in
+ let (vars, ty_arg, ty_res) = instance_label false ldesc in
if vars = [] then end_def ();
begin try
unify env ty_res ty
with Unify trace ->
- raise(Error(loc, Label_mismatch(lid, trace)))
+ raise (Error (loc, Label_ref_mismatch (lref, trace)))
end;
+
let arg = type_pat env sarg in
unify_pat env arg ty_arg;
+
if vars <> [] then begin
end_def ();
generalize ty_arg;
@@ -529,17 +629,20 @@ let rec type_pat env sp =
let tv = expand_head env tv in
tv.desc <> Tvar || tv.level <> generic_level in
if List.exists instantiated vars then
- raise (Error(loc, Polymorphic_label lid))
+ raise (Error (loc, Polymorphic_label_ref lref))
end;
- (label, arg)
- in
- let lbl_pat_list = type_label_a_list type_label_pat lid_sp_list in
- check_recordpat_labels loc lbl_pat_list closed;
+
+ (ldesc, arg) in
+
+ let ldesc_arg_list = type_record_fields type_field fields in
+
+ check_recordpat_labels loc ldesc_arg_list closed;
+
rp {
- pat_desc = Tpat_record lbl_pat_list;
+ pat_desc = Tpat_record ldesc_arg_list;
pat_loc = loc;
pat_type = ty;
- pat_env = env }
+ pat_env = env; }
| Ppat_array spl ->
let pl = List.map (type_pat env) spl in
let ty_elt = newvar() in
@@ -553,13 +656,13 @@ let rec type_pat env sp =
let initial_pattern_variables = !pattern_variables in
let p1 = type_pat env sp1 in
let p1_variables = !pattern_variables in
- pattern_variables := initial_pattern_variables ;
+ pattern_variables := initial_pattern_variables;
let p2 = type_pat env sp2 in
let p2_variables = !pattern_variables in
unify_pat env p2 p1.pat_type;
let alpha_env =
enter_orpat_variables loc env p1_variables p2_variables in
- pattern_variables := p1_variables ;
+ pattern_variables := p1_variables;
rp {
pat_desc = Tpat_or(p1, alpha_pat alpha_env p2, None);
pat_loc = loc;
@@ -582,7 +685,9 @@ let rec type_pat env sp =
build_or_pat env loc lid
let get_ref r =
- let v = !r in r := []; v
+ let v = !r in
+ r := [];
+ v
let add_pattern_variables env =
let pv = get_ref pattern_variables in
@@ -898,7 +1003,7 @@ let rec approx_type env sty =
newty (Ttuple (List.map (approx_type env) args))
| Ptyp_constr (lid, ctl) ->
begin try
- let (path, decl) = Env.lookup_type lid env in
+ let (path, decl) = Env.lookup_type_declaration lid env in
if List.length ctl <> decl.type_arity then raise Not_found;
let tyl = List.map (approx_type env) ctl in
newconstr path tyl
@@ -998,9 +1103,13 @@ let self_coercion = ref ([] : (Path.t * Location.t list ref) list)
(* Helpers for packaged modules. *)
let create_package_type loc env (p, l) =
let s = !Typetexp.transl_modtype_longident loc env p in
- newty (Tpackage (s,
- List.map fst l,
- List.map (Typetexp.transl_simple_type env false) (List.map snd l)))
+ newty
+ (Tpackage (
+ s,
+ List.map fst l,
+ List.map
+ (Typetexp.transl_simple_type env false)
+ (List.map snd l)))
(* Typing of expressions *)
@@ -1015,42 +1124,13 @@ let unify_exp env exp expected_ty =
| Tags(l1,l2) ->
raise(Typetexp.Error(exp.exp_loc, Typetexp.Variant_tags (l1, l2)))
-let rec narrow_unbound_lid_error env make_error lid =
- let module_is_bound mlid =
- ignore (Env.lookup_module mlid env) in
- match lid with
- | Longident.Lident _ -> make_error lid
- | Longident.Ldot (mlid, _) ->
- begin
- try
- module_is_bound mlid;
- make_error lid with
- | Not_found -> Unbound_module mlid
- end
- | Longident.Lapply (flid, mlid) ->
- begin
- try
- module_is_bound flid;
- begin
- try
- module_is_bound mlid;
- make_error lid with
- | Not_found -> Unbound_module mlid
- end with
- | Not_found -> Unbound_functor flid
- end
-;;
-
-let unbound_ident_error loc env make_error lid =
- let err = narrow_unbound_lid_error env make_error lid in
- raise (Error (loc, err))
-;;
let rec type_exp env sexp =
let loc = sexp.pexp_loc in
match sexp.pexp_desc with
| Pexp_ident lid ->
- begin try
+ begin
+ try
if !Clflags.annotations then begin
try let (path, annot) = Env.lookup_annot lid env in
Stypes.record
@@ -1072,15 +1152,17 @@ let rec type_exp env sexp =
in
Texp_ident(path, desc)
| Val_unbound ->
- raise(Error(loc, Masked_instance_variable lid))
+ raise (Error(loc, Masked_instance_variable lid))
| _ ->
Texp_ident(path, desc)
end;
exp_loc = loc;
exp_type = instance desc.val_type;
exp_env = env }
- with Not_found ->
- unbound_ident_error loc env (fun lid -> Unbound_value lid) lid
+ with
+ | Not_found ->
+ unbound_ident_error loc env lid
+ (fun lid -> Unbound_value lid)
end
| Pexp_constant cst ->
re {
@@ -1161,134 +1243,155 @@ let rec type_exp env sexp =
exp_loc = loc;
exp_type = newty (Ttuple(List.map (fun exp -> exp.exp_type) expl));
exp_env = env }
- | Pexp_construct(lid, sarg, explicit_arity) ->
- type_construct env loc lid sarg explicit_arity (newvar ())
+ | Pexp_construct(cref, sarg, explicit_arity) ->
+ type_construct env loc cref sarg explicit_arity (newvar ())
| Pexp_variant(l, sarg) ->
let arg = may_map (type_exp env) sarg in
let arg_type = may_map (fun arg -> arg.exp_type) arg in
re {
exp_desc = Texp_variant(l, arg);
exp_loc = loc;
- exp_type= newty (Tvariant{row_fields = [l, Rpresent arg_type];
- row_more = newvar ();
- row_bound = ();
- row_closed = false;
- row_fixed = false;
- row_name = None});
- exp_env = env }
- | Pexp_record(lid_sexp_list, opt_sexp) ->
- let ty = newvar() in
+ exp_type =
+ newty (
+ Tvariant {
+ row_fields = [ l, Rpresent arg_type ];
+ row_more = newvar ();
+ row_bound = ();
+ row_closed = false;
+ row_fixed = false;
+ row_name = None;
+ });
+ exp_env = env;
+ }
+ | Pexp_record (fields, opt_sexp) ->
+ let ty = newvar () in
let num_fields = ref 0 in
- let type_label_exp (lid, sarg) =
- let label =
- try
- Env.lookup_label lid env
- with Not_found ->
- raise(Error(loc, Unbound_label lid)) in
+
+ let type_field (lref, sarg) =
+ let ldesc =
+ try Env.lookup_label_ref lref env with
+ | Not_found ->
+ unbound_label_ref_error loc env lref
+ (fun llid -> Unbound_label_ref (Plabel llid)) in
begin_def ();
if !Clflags.principal then begin_def ();
- let (vars, ty_arg, ty_res) = instance_label true label in
+ let (vars, ty_arg, ty_res) = instance_label true ldesc in
if !Clflags.principal then begin
end_def ();
generalize_structure ty_arg;
- generalize_structure ty_res
+ generalize_structure ty_res;
end;
- begin try
- unify env (instance ty_res) ty
- with Unify trace ->
- raise(Error(loc, Label_mismatch(lid, trace)))
+ begin
+ try unify env (instance ty_res) ty with
+ | Unify trace ->
+ raise (Error (loc, Label_ref_mismatch (lref, trace)))
end;
let arg = type_argument env sarg ty_arg in
end_def ();
- check_univars env (vars <> []) "field value" arg label.lbl_arg vars;
- num_fields := Array.length label.lbl_all;
- if label.lbl_private = Private then
- raise(Error(loc, Private_type ty));
- (label, {arg with exp_type = instance arg.exp_type}) in
- let lbl_exp_list = type_label_a_list type_label_exp lid_sexp_list in
- let rec check_duplicates seen_pos lid_sexp lbl_exp =
- match (lid_sexp, lbl_exp) with
- ((lid, _) :: rem1, (lbl, _) :: rem2) ->
- if List.mem lbl.lbl_pos seen_pos
- then raise(Error(loc, Label_multiply_defined lid))
- else check_duplicates (lbl.lbl_pos :: seen_pos) rem1 rem2
- | (_, _) -> () in
- check_duplicates [] lid_sexp_list lbl_exp_list;
+ check_univars env (vars <> []) "field value" arg ldesc.lbl_arg vars;
+
+ num_fields := Array.length ldesc.lbl_all;
+
+ if ldesc.lbl_private = Private then
+ raise (Error (loc, Private_type_label_ref (lref, ty)));
+ (ldesc, {arg with exp_type = instance arg.exp_type}) in
+
+ let ldesc_arg_list = type_record_fields type_field fields in
+
+ let rec check_duplicate_fields seen_pos fields ldesc_arg_list =
+ match fields, ldesc_arg_list with
+ | (lref, _sarg) :: fields, (ldesc, _arg) :: ldesc_arg_list ->
+ if List.mem ldesc.lbl_pos seen_pos then
+ raise (Error (loc, Label_ref_multiply_defined lref)) else
+ check_duplicate_fields
+ (ldesc.lbl_pos :: seen_pos)
+ fields ldesc_arg_list
+ | _, _ -> () in
+
+ check_duplicate_fields [] fields ldesc_arg_list;
+
let opt_exp =
- match opt_sexp, lbl_exp_list with
- None, _ -> None
- | Some sexp, (lbl, _) :: _ ->
+ match opt_sexp, ldesc_arg_list with
+ | None, _ -> None
+ | Some sexp, (ldesc, _arg) :: _ ->
let ty_exp = newvar () in
- let unify_kept lbl =
- if List.for_all (fun (lbl',_) -> lbl'.lbl_pos <> lbl.lbl_pos)
- lbl_exp_list
+ let unify_kept ldesc =
+ if List.for_all
+ (fun (other_ldesc, _other_arg) ->
+ other_ldesc.lbl_pos <> ldesc.lbl_pos)
+ ldesc_arg_list
then begin
- let _, ty_arg1, ty_res1 = instance_label false lbl
- and _, ty_arg2, ty_res2 = instance_label false lbl in
+ let _, ty_arg1, ty_res1 = instance_label false ldesc
+ and _, ty_arg2, ty_res2 = instance_label false ldesc in
unify env ty_exp ty_res1;
unify env ty ty_res2;
- unify env ty_arg1 ty_arg2
+ unify env ty_arg1 ty_arg2;
end in
- Array.iter unify_kept lbl.lbl_all;
- Some(type_expect env sexp ty_exp)
- | _ -> assert false
- in
- if opt_sexp = None && List.length lid_sexp_list <> !num_fields then begin
+ Array.iter unify_kept ldesc.lbl_all;
+ Some (type_expect env sexp ty_exp)
+ | _ -> assert false in
+
+ if opt_sexp = None && List.length fields <> !num_fields then
let present_indices =
- List.map (fun (lbl, _) -> lbl.lbl_pos) lbl_exp_list in
+ List.map (fun (ldesc, _arg) -> ldesc.lbl_pos) ldesc_arg_list in
let label_names = extract_label_names sexp env ty in
let rec missing_labels n = function
- [] -> []
+ | [] -> []
| lbl :: rem ->
if List.mem n present_indices then missing_labels (n + 1) rem
else lbl :: missing_labels (n + 1) rem
in
let missing = missing_labels 0 label_names in
raise(Error(loc, Label_missing missing))
- end
- else if opt_sexp <> None && List.length lid_sexp_list = !num_fields then
+ else if opt_sexp <> None && List.length fields = !num_fields then
Location.prerr_warning loc Warnings.Useless_record_with;
re {
- exp_desc = Texp_record(lbl_exp_list, opt_exp);
+ exp_desc = Texp_record(ldesc_arg_list, opt_exp);
exp_loc = loc;
exp_type = ty;
- exp_env = env }
- | Pexp_field(sarg, lid) ->
+ exp_env = env; }
+ | Pexp_field(sarg, lref) ->
let arg = type_exp env sarg in
- let label =
- try
- Env.lookup_label lid env
- with Not_found ->
- raise(Error(loc, Unbound_label lid)) in
- let (_, ty_arg, ty_res) = instance_label false label in
+ let ldesc =
+ try Env.lookup_label_ref lref env with
+ | Not_found ->
+ unbound_label_ref_error loc env lref
+ (fun llid -> Unbound_label_ref (Plabel llid)) in
+
+ let (_, ty_arg, ty_res) = instance_label false ldesc in
unify_exp env arg ty_res;
re {
- exp_desc = Texp_field(arg, label);
+ exp_desc = Texp_field(arg, ldesc);
exp_loc = loc;
exp_type = ty_arg;
- exp_env = env }
- | Pexp_setfield(srecord, lid, snewval) ->
+ exp_env = env;
+ }
+ | Pexp_setfield(srecord, lref, snewval) ->
let record = type_exp env srecord in
- let label =
- try
- Env.lookup_label lid env
- with Not_found ->
- raise(Error(loc, Unbound_label lid)) in
- if label.lbl_mut = Immutable then
- raise(Error(loc, Label_not_mutable lid));
+ let ldesc =
+ try Env.lookup_label_ref lref env with
+ | Not_found ->
+ unbound_label_ref_error loc env lref
+ (fun llid -> Unbound_label_ref (Plabel llid)) in
+
+ if ldesc.lbl_mut = Immutable then
+ raise (Error (loc, Label_ref_not_mutable lref));
+
begin_def ();
- let (vars, ty_arg, ty_res) = instance_label true label in
- unify_exp env record ty_res;
- let newval = type_expect env snewval ty_arg in
+ let (vars, ty_arg, ty_res) = instance_label true ldesc in
+ unify_exp env record ty_res;
+ let newval = type_expect env snewval ty_arg in
end_def ();
- check_univars env (vars <> []) "field value" newval label.lbl_arg vars;
- if label.lbl_private = Private then
- raise(Error(loc, Private_label(lid, ty_res)));
+
+ check_univars env (vars <> []) "field value" newval ldesc.lbl_arg vars;
+ if ldesc.lbl_private = Private then
+ raise (Error (loc, Private_type_field_assignment (lref, ty_res)));
re {
- exp_desc = Texp_setfield(record, label, newval);
+ exp_desc = Texp_setfield(record, ldesc, newval);
exp_loc = loc;
exp_type = instance Predef.type_unit;
- exp_env = env }
+ exp_env = env;
+ }
| Pexp_array(sargl) ->
let ty = newvar() in
let argl = List.map (fun sarg -> type_expect env sarg ty) sargl in
@@ -1668,7 +1771,8 @@ let rec type_exp env sexp =
Ctype.init_def(Ident.current_time());
let body = type_exp new_env sbody in
- (* Replace every instance of this type constructor in the resulting type. *)
+ (* Replace every instance of this type constructor
+ in the resulting type. *)
let seen = Hashtbl.create 8 in
let rec replace t =
if Hashtbl.mem seen t.id then ()
@@ -1941,23 +2045,24 @@ and type_application env funct sargs =
else
type_args [] [] ty ty sargs []
-and type_construct env loc lid sarg explicit_arity ty_expected =
- let constr =
- try
- Env.lookup_constructor lid env
- with Not_found ->
- raise(Error(loc, Unbound_constructor lid)) in
+and type_construct env loc cref sarg explicit_arity ty_expected =
+ let cdesc =
+ try Env.lookup_constructor_ref cref env with
+ | Not_found ->
+ unbound_constr_ref_error loc env cref
+ (fun clid -> Unbound_constructor_ref (Pconstr clid)) in
let sargs =
match sarg with
- None -> []
+ | None -> []
| Some {pexp_desc = Pexp_tuple sel} when explicit_arity -> sel
- | Some {pexp_desc = Pexp_tuple sel} when constr.cstr_arity > 1 -> sel
+ | Some {pexp_desc = Pexp_tuple sel} when cdesc.cstr_arity > 1 -> sel
| Some se -> [se] in
- if List.length sargs <> constr.cstr_arity then
- raise(Error(loc, Constructor_arity_mismatch
- (lid, constr.cstr_arity, List.length sargs)));
+ if List.length sargs <> cdesc.cstr_arity then
+ raise (Error (loc,
+ Constructor_ref_arity_mismatch
+ (cref, cdesc.cstr_arity, List.length sargs)));
if !Clflags.principal then begin_def ();
- let (ty_args, ty_res) = instance_constructor constr in
+ let (ty_args, ty_res) = instance_constructor cdesc in
if !Clflags.principal then begin
end_def ();
List.iter generalize_structure ty_args;
@@ -1965,15 +2070,15 @@ and type_construct env loc lid sarg explicit_arity ty_expected =
end;
let texp =
re {
- exp_desc = Texp_construct(constr, []);
+ exp_desc = Texp_construct(cdesc, []);
exp_loc = loc;
exp_type = instance ty_res;
exp_env = env } in
unify_exp env texp ty_expected;
let args = List.map2 (type_argument env) sargs ty_args in
- if constr.cstr_private = Private then
- raise(Error(loc, Private_type ty_res));
- { texp with exp_desc = Texp_construct(constr, args) }
+ if cdesc.cstr_private = Private then
+ raise (Error (loc, Private_type_constructor_ref (cref, ty_res)));
+ { texp with exp_desc = Texp_construct(cdesc, args) }
(* Typing of an expression with an expected type.
Some constructs are treated specially to provide better error messages. *)
@@ -1996,10 +2101,11 @@ and type_expect ?in_function env sexp ty_expected =
exp_env = env } in
unify_exp env exp ty_expected;
exp
- | Pexp_construct(lid, sarg, explicit_arity) ->
- type_construct env loc lid sarg explicit_arity ty_expected
+ | Pexp_construct(cref, sarg, explicit_arity) ->
+ type_construct env loc cref sarg explicit_arity ty_expected
| Pexp_let(rec_flag, spat_sexp_list, sbody) ->
- let (pat_exp_list, new_env) = type_let env rec_flag spat_sexp_list None in
+ let (pat_exp_list, new_env) =
+ type_let env rec_flag spat_sexp_list None in
let body = type_expect new_env sbody ty_expected in
re {
exp_desc = Texp_let(rec_flag, pat_exp_list, body);
@@ -2017,16 +2123,23 @@ and type_expect ?in_function env sexp ty_expected =
| Pexp_function (l, Some default, [spat, sbody]) ->
let default_loc = default.pexp_loc in
let scases = [
- {ppat_loc = default_loc;
- ppat_desc =
- Ppat_construct
- (Longident.Lident "Some",
- Some {ppat_loc = default_loc; ppat_desc = Ppat_var "*sth*"},
- false)},
- {pexp_loc = default_loc;
- pexp_desc = Pexp_ident(Longident.Lident "*sth*")};
- {ppat_loc = default_loc;
- ppat_desc = Ppat_construct(Longident.Lident "None", None, false)},
+ { ppat_loc = default_loc;
+ ppat_desc =
+ Ppat_construct
+ (Pconstr (Longident.Lident "Some"),
+ Some {
+ ppat_loc = default_loc;
+ ppat_desc = Ppat_var "*sth*";
+ },
+ false);
+ },
+ { pexp_loc = default_loc;
+ pexp_desc = Pexp_ident (Longident.Lident "*sth*");
+ };
+ { ppat_loc = default_loc;
+ ppat_desc =
+ Ppat_construct (Pconstr (Longident.Lident "None"), None, false);
+ },
default;
] in
let smatch = {
@@ -2046,14 +2159,16 @@ and type_expect ?in_function env sexp ty_expected =
Pexp_function (
l,
None,
- [ {ppat_loc = loc;
- ppat_desc = Ppat_var "*opt*"},
- {pexp_loc = loc;
- pexp_desc =
- Pexp_let(Default, [spat, smatch], sbody);
- }
+ [
+ { ppat_loc = loc;
+ ppat_desc = Ppat_var "*opt*";
+ },
+ { pexp_loc = loc;
+ pexp_desc =
+ Pexp_let (Default, [ spat, smatch ], sbody);
+ };
]
- )
+ );
} in
type_expect ?in_function env sfun ty_expected
| Pexp_function (l, _, caselist) ->
@@ -2304,35 +2419,39 @@ open Printtyp
let report_error ppf = function
| Unbound_value lid ->
fprintf ppf "Unbound value %a" longident lid
+ | Unbound_type lid ->
+ fprintf ppf "Unbound type %a" longident lid
| Unbound_module lid ->
fprintf ppf "Unbound module %a" longident lid
| Unbound_functor lid ->
fprintf ppf "Unbound functor %a" longident lid
- | Unbound_constructor lid ->
- fprintf ppf "Unbound constructor %a" longident lid
- | Unbound_label lid ->
- fprintf ppf "Unbound record field label %a" longident lid
- | Polymorphic_label lid ->
+ | Unbound_constructor_ref cref ->
+ fprintf ppf "Unbound value constructor %a" Printtyp.constructor_ref cref
+ | Unbound_label_ref lref ->
+ fprintf ppf "Unbound record field label %a" Printtyp.label_ref lref
+ | Polymorphic_label_ref lref ->
fprintf ppf "@[The record field label %a is polymorphic.@ %s@]"
- longident lid "You cannot instantiate it in a pattern."
- | Constructor_arity_mismatch(lid, expected, provided) ->
+ label_ref lref "You cannot instantiate it in a pattern."
+ | Constructor_ref_arity_mismatch (cref, expected, provided) ->
fprintf ppf
- "@[The constructor %a@ expects %i argument(s),@ \
+ "@[The value constructor %a@ expects %i argument(s),@ \
but is applied here to %i argument(s)@]"
- longident lid expected provided
- | Label_mismatch(lid, trace) ->
+ constructor_ref cref expected provided
+ | Label_ref_mismatch (lref, trace) ->
report_unification_error ppf trace
(function ppf ->
fprintf ppf "The record field label %a@ belongs to the type"
- longident lid)
+ label_ref lref)
(function ppf ->
fprintf ppf "but is mixed here with labels of type")
| Pattern_type_clash trace ->
report_unification_error ppf trace
(function ppf ->
- fprintf ppf "This pattern matches values of type")
+ fprintf ppf "%s"
+ "This pattern matches values of type")
(function ppf ->
- fprintf ppf "but a pattern was expected which matches values of type")
+ fprintf ppf "%s"
+ "but a pattern was expected which matches values of type")
| Multiply_bound_variable name ->
fprintf ppf "Variable %s is bound several times in this matching" name
| Orpat_vars id ->
@@ -2364,15 +2483,15 @@ let report_error ppf = function
"@[<v>@[<2>The function applied to this argument has type@ %a@]@.\
This argument cannot be applied %a@]"
type_expr ty print_label l
- | Label_multiply_defined lid ->
+ | Label_ref_multiply_defined lref ->
fprintf ppf "The record field label %a is defined several times"
- longident lid
+ label_ref lref
| Label_missing labels ->
let print_labels ppf = List.iter (fun lbl -> fprintf ppf "@ %s" lbl) in
fprintf ppf "@[<hov>Some record field labels are undefined:%a@]"
print_labels labels
- | Label_not_mutable lid ->
- fprintf ppf "The record field label %a is not mutable" longident lid
+ | Label_ref_not_mutable lref ->
+ fprintf ppf "The record field label %a is not mutable" label_ref lref
| Incomplete_format s ->
fprintf ppf "Premature end of format string ``%S''" s
| Bad_conversion (fmt, i, c) ->
@@ -2443,11 +2562,17 @@ let report_error ppf = function
"The instance variable %a@ \
cannot be accessed from the definition of another instance variable"
longident lid
- | Private_type ty ->
- fprintf ppf "Cannot create values of the private type %a" type_expr ty
- | Private_label (lid, ty) ->
+ | Private_type_constructor_ref (cref, ty) ->
+ fprintf ppf
+ "Cannot use constructor %a to create a value of the private type %a"
+ constructor_ref cref type_expr ty
+ | Private_type_label_ref (lref, ty) ->
+ fprintf ppf
+ "Cannot use label field %a to create a value of the private type %a"
+ label_ref lref type_expr ty
+ | Private_type_field_assignment (lref, ty) ->
fprintf ppf "Cannot assign field %a of the private type %a"
- longident lid type_expr ty
+ label_ref lref type_expr ty
| Not_a_variant_type lid ->
fprintf ppf "The type %a@ is not a variant type" longident lid
| Incoherent_label_order ->
diff --git a/typing/typecore.mli b/typing/typecore.mli
index a1a9ecd927..57b19276aa 100644
--- a/typing/typecore.mli
+++ b/typing/typecore.mli
@@ -15,6 +15,7 @@
(* Type inference for the core language *)
open Asttypes
+open Reftypes
open Types
open Format
@@ -64,30 +65,32 @@ val self_coercion : (Path.t * Location.t list ref) list ref
type error =
Unbound_value of Longident.t
- | Unbound_constructor of Longident.t
- | Unbound_label of Longident.t
+ | Unbound_constructor_ref of Reftypes.constructor_ref
+ | Unbound_label_ref of Reftypes.label_ref
+ | Unbound_type of Longident.t
| Unbound_module of Longident.t
| Unbound_functor of Longident.t
- | Polymorphic_label of Longident.t
- | Constructor_arity_mismatch of Longident.t * int * int
- | Label_mismatch of Longident.t * (type_expr * type_expr) list
+ | Polymorphic_label_ref of label_ref
+ | Constructor_ref_arity_mismatch of constructor_ref * int * int
+ | Label_ref_mismatch of label_ref * (type_expr * type_expr) list
| Pattern_type_clash of (type_expr * type_expr) list
| Multiply_bound_variable of string
| Orpat_vars of Ident.t
| Expr_type_clash of (type_expr * type_expr) list
| Apply_non_function of type_expr
| Apply_wrong_label of label * type_expr
- | Label_multiply_defined of Longident.t
+ | Label_ref_multiply_defined of label_ref
| Label_missing of string list
- | Label_not_mutable of Longident.t
+ | Label_ref_not_mutable of label_ref
| Incomplete_format of string
| Bad_conversion of string * int * char
| Undefined_method of type_expr * string
| Undefined_inherited_method of string
| Unbound_class of Longident.t
| Virtual_class of Longident.t
- | Private_type of type_expr
- | Private_label of Longident.t * type_expr
+ | Private_type_constructor_ref of constructor_ref * type_expr
+ | Private_type_label_ref of label_ref * type_expr
+ | Private_type_field_assignment of label_ref * type_expr
| Unbound_instance_variable of string
| Instance_variable_not_mutable of string
| Not_subtype of (type_expr * type_expr) list * (type_expr * type_expr) list
diff --git a/typing/typedecl.ml b/typing/typedecl.ml
index 016a2a2263..f6906e1409 100644
--- a/typing/typedecl.ml
+++ b/typing/typedecl.ml
@@ -64,7 +64,7 @@ let enter_type env (name, sdecl) id =
let update_type temp_env env id loc =
let path = Path.Pident id in
- let decl = Env.find_type path temp_env in
+ let decl = Env.find_type_declaration path temp_env in
match decl.type_manifest with None -> ()
| Some ty ->
let params = List.map (fun _ -> Ctype.newvar ()) decl.type_params in
@@ -312,7 +312,7 @@ let check_abbrev env (_, sdecl) (id, decl) =
begin match (Ctype.repr ty).desc with
Tconstr(path, args, _) ->
begin try
- let decl' = Env.find_type path env in
+ let decl' = Env.find_type_declaration path env in
if List.length args = List.length decl.type_params
&& Ctype.equal env false args decl.type_params
&& Includecore.type_declarations env id
@@ -422,7 +422,7 @@ let compute_variance env tvl nega posi cntr ty =
| Tconstr (path, tl, _) ->
if tl = [] then () else begin
try
- let decl = Env.find_type path env in
+ let decl = Env.find_type_declaration path env in
List.iter2
(fun ty (co,cn,ct) ->
compute_variance_rec
@@ -707,9 +707,9 @@ let transl_exception env excdecl =
let transl_exn_rebind env loc lid =
let cdescr =
try
- Env.lookup_constructor lid env
+ Env.lookup_constructor_ref (Reftypes.Pconstr lid) env
with Not_found ->
- raise(Error(loc, Unbound_exception lid)) in
+ raise (Error (loc, Unbound_exception lid)) in
match cdescr.cstr_tag with
Cstr_exception path -> (path, cdescr.cstr_args)
| _ -> raise(Error(loc, Not_an_exception lid))
diff --git a/typing/typemod.ml b/typing/typemod.ml
index 8c590b4588..accf17721c 100644
--- a/typing/typemod.ml
+++ b/typing/typemod.ml
@@ -245,8 +245,9 @@ let check_recmod_typedecls env sdecls decls =
(fun (_, smty) (id, mty) ->
List.iter
(fun path ->
- Typedecl.check_recmod_typedecl env smty.pmty_loc recmod_ids
- path (Env.find_type path env))
+ Typedecl.check_recmod_typedecl
+ env smty.pmty_loc recmod_ids path
+ (Env.find_type_declaration path env))
(Mtype.type_paths env (Pident id) mty))
sdecls decls
diff --git a/typing/types.ml b/typing/types.ml
index 5996719d4d..c69eaa57a0 100644
--- a/typing/types.ml
+++ b/typing/types.ml
@@ -42,7 +42,7 @@ and type_desc =
and row_desc =
{ row_fields: (label * row_field) list;
row_more: type_expr;
- row_bound: unit;
+ row_bound: unit; (* kept for compatibility *)
row_closed: bool;
row_fixed: bool;
row_name: (Path.t * type_expr list) option }
@@ -105,7 +105,8 @@ and value_kind =
(* Constructor descriptions *)
type constructor_description =
- { cstr_res: type_expr; (* Type of the result *)
+ { cstr_name: string; (* Short name *)
+ cstr_res: type_expr; (* Type of the result *)
cstr_args: type_expr list; (* Type of the arguments *)
cstr_arity: int; (* Number of arguments *)
cstr_tag: constructor_tag; (* Tag for heap blocks *)
@@ -151,6 +152,14 @@ and type_kind =
| Type_record of
(string * mutable_flag * type_expr) list * record_representation
+type type_kind_description =
+ | Kind_abstract
+ | Kind_variant of constructor_description list
+ | Kind_record of label_description list
+;;
+
+type type_description = type_declaration * type_kind_description;;
+
type exception_declaration = type_expr list
(* Type expressions for the class language *)
diff --git a/typing/types.mli b/typing/types.mli
index 2f57df3473..bd8251166e 100644
--- a/typing/types.mli
+++ b/typing/types.mli
@@ -103,7 +103,8 @@ and value_kind =
(* Constructor descriptions *)
type constructor_description =
- { cstr_res: type_expr; (* Type of the result *)
+ { cstr_name: string; (* Short name *)
+ cstr_res: type_expr; (* Type of the result *)
cstr_args: type_expr list; (* Type of the arguments *)
cstr_arity: int; (* Number of arguments *)
cstr_tag: constructor_tag; (* Tag for heap blocks *)
@@ -149,6 +150,13 @@ and type_kind =
| Type_record of
(string * mutable_flag * type_expr) list * record_representation
+and type_kind_description =
+ | Kind_abstract
+ | Kind_variant of constructor_description list
+ | Kind_record of label_description list
+
+and type_description = type_declaration * type_kind_description
+
type exception_declaration = type_expr list
(* Type expressions for the class language *)
diff --git a/typing/typetexp.ml b/typing/typetexp.ml
index 60b24c3826..8bf3ac9b38 100644
--- a/typing/typetexp.ml
+++ b/typing/typetexp.ml
@@ -27,7 +27,7 @@ type error =
| Unbound_type_constructor_2 of Path.t
| Type_arity_mismatch of Longident.t * int * int
| Bound_type_variable of string
- | Recursive_type
+(* | Recursive_type*)
| Unbound_class of Longident.t
| Unbound_row_variable of Longident.t
| Type_mismatch of (type_expr * type_expr) list
@@ -37,7 +37,7 @@ type error =
| Constructor_mismatch of type_expr * type_expr
| Not_a_variant of type_expr
| Variant_tags of string * string
- | Invalid_variable_name of string
+ | Invalid_type_variable_name of string
| Cannot_quantify of string * type_expr
| Multiple_constraints_on_type of string
@@ -68,9 +68,10 @@ let create_package_mty fake loc env (p, l) =
ptype_manifest = if fake then None else Some t;
ptype_variance = [];
ptype_loc = loc} in
- {pmty_desc=Pmty_with (mty, [ Longident.Lident s, Pwith_type d ]); pmty_loc=loc}
+ { pmty_desc = Pmty_with (mty, [ Longident.Lident s, Pwith_type d ]);
+ pmty_loc = loc; }
)
- {pmty_desc=Pmty_ident p; pmty_loc=loc}
+ { pmty_desc = Pmty_ident p; pmty_loc = loc }
l
(* Translation of type expressions *)
@@ -91,10 +92,14 @@ let widen (gl, tv) =
restore_global_level gl;
type_variables := tv
+let check_type_variable_name loc name =
+ if name <> "" && name.[0] = '_' then
+ raise (Error (loc, Invalid_type_variable_name ("'" ^ name)))
+;;
+
let enter_type_variable strict loc name =
try
- if name <> "" && name.[0] = '_' then
- raise (Error (loc, Invalid_variable_name ("'" ^ name)));
+ check_type_variable_name loc name;
let v = Tbl.find name !type_variables in
if strict then raise Already_bound;
v
@@ -115,7 +120,8 @@ let wrap_method ty =
| _ -> Ctype.newty (Tpoly (ty, []))
let new_pre_univar () =
- let v = newvar () in pre_univars := v :: !pre_univars; v
+ let v = newvar () in
+ pre_univars := v :: !pre_univars; v
let rec swap_list = function
x :: y :: l -> y :: x :: swap_list l
@@ -131,8 +137,7 @@ let rec transl_type env policy styp =
raise (Error (styp.ptyp_loc, Unbound_type_variable "_"))
else newvar ()
| Ptyp_var name ->
- if name <> "" && name.[0] = '_' then
- raise (Error (styp.ptyp_loc, Invalid_variable_name ("'" ^ name)));
+ check_type_variable_name styp.ptyp_loc name;
begin try
instance (List.assoc name !univars)
with Not_found -> try
@@ -151,14 +156,14 @@ let rec transl_type env policy styp =
newty (Ttuple(List.map (transl_type env policy) stl))
| Ptyp_constr(lid, stl) ->
let (path, decl) =
- let lid, env =
- match lid with
- | Longident.Ldot (Longident.Lident "*predef*", lid) ->
- Longident.Lident lid, Env.initial
- | _ -> lid, env
- in
+ let lid, env =
+ match lid with
+ | Longident.Ldot (Longident.Lident "*predef*", lid) ->
+ Longident.Lident lid, Env.initial
+ | _ -> lid, env
+ in
try
- Env.lookup_type lid env
+ Env.lookup_type_declaration lid env
with Not_found ->
raise(Error(styp.ptyp_loc, Unbound_type_constructor lid)) in
if List.length stl <> decl.type_arity then
@@ -189,7 +194,7 @@ let rec transl_type env policy styp =
| Ptyp_class(lid, stl, present) ->
let (path, decl, is_variant) =
try
- let (path, decl) = Env.lookup_type lid env in
+ let (path, decl) = Env.lookup_type_declaration lid env in
let rec check decl =
match decl.type_manifest with
None -> raise Not_found
@@ -197,7 +202,7 @@ let rec transl_type env policy styp =
match (repr ty).desc with
Tvariant row when Btype.static_row row -> ()
| Tconstr (path, _, _) ->
- check (Env.find_type path env)
+ check (Env.find_type_declaration path env)
| _ -> raise Not_found
in check decl;
Location.prerr_warning styp.ptyp_loc Warnings.Deprecated;
@@ -210,7 +215,7 @@ let rec transl_type env policy styp =
| Longident.Ldot(r, s) -> Longident.Ldot (r, "#" ^ s)
| Longident.Lapply(_, _) -> fatal_error "Typetexp.transl_type"
in
- let (path, decl) = Env.lookup_type lid2 env in
+ let (path, decl) = Env.lookup_type_declaration lid2 env in
(path, decl, false)
with Not_found ->
raise(Error(styp.ptyp_loc, Unbound_class lid))
@@ -348,7 +353,7 @@ let rec transl_type env policy styp =
let row = Btype.row_repr row in
row.row_fields
| {desc=Tvar}, Some(p, _) ->
- raise(Error(sty.ptyp_loc, Unbound_type_constructor_2 p))
+ raise(Error(sty.ptyp_loc, Unbound_type_constructor_2 p))
| _ ->
raise(Error(sty.ptyp_loc, Not_a_variant ty))
in
@@ -511,7 +516,7 @@ let transl_simple_type_univars env styp =
(fun acc v ->
let v = repr v in
if v.level <> Btype.generic_level || v.desc <> Tvar then acc
- else (v.desc <- Tunivar ; v :: acc))
+ else (v.desc <- Tunivar; v :: acc))
[] !pre_univars
in
make_fixed_univars typ;
@@ -551,8 +556,8 @@ let report_error ppf = function
longident lid expected provided
| Bound_type_variable name ->
fprintf ppf "Already bound type parameter '%s" name
- | Recursive_type ->
- fprintf ppf "This type is recursive"
+(* | Recursive_type ->
+ fprintf ppf "%s" "This type is recursive" *)
| Unbound_class lid ->
fprintf ppf "Unbound class %a" longident lid
| Unbound_row_variable lid ->
@@ -560,17 +565,17 @@ let report_error ppf = function
| Type_mismatch trace ->
Printtyp.unification_error true trace
(function ppf ->
- fprintf ppf "This type")
+ fprintf ppf "%s" "This type")
ppf
(function ppf ->
- fprintf ppf "should be an instance of type")
+ fprintf ppf "%s" "should be an instance of type")
| Alias_type_mismatch trace ->
Printtyp.unification_error true trace
(function ppf ->
- fprintf ppf "This alias is bound to type")
+ fprintf ppf "%s" "This alias is bound to type")
ppf
(function ppf ->
- fprintf ppf "but is used as an instance of type")
+ fprintf ppf "%s" "but is used as an instance of type")
| Present_has_conjunction l ->
fprintf ppf "The present constructor %s has a conjunctive type" l
| Present_has_no_type l ->
@@ -590,7 +595,7 @@ let report_error ppf = function
fprintf ppf
"Variant tags `%s@ and `%s have the same hash value.@ Change one of them."
lab1 lab2
- | Invalid_variable_name name ->
+ | Invalid_type_variable_name name ->
fprintf ppf "The type variable name %s is not allowed in programs" name
| Cannot_quantify (name, v) ->
fprintf ppf "This type scheme cannot quantify '%s :@ %s." name
diff --git a/typing/typetexp.mli b/typing/typetexp.mli
index 47b6fef261..759b857e99 100644
--- a/typing/typetexp.mli
+++ b/typing/typetexp.mli
@@ -42,7 +42,7 @@ type error =
| Unbound_type_constructor_2 of Path.t
| Type_arity_mismatch of Longident.t * int * int
| Bound_type_variable of string
- | Recursive_type
+(* | Recursive_type *)
| Unbound_class of Longident.t
| Unbound_row_variable of Longident.t
| Type_mismatch of (Types.type_expr * Types.type_expr) list
@@ -52,7 +52,7 @@ type error =
| Constructor_mismatch of Types.type_expr * Types.type_expr
| Not_a_variant of Types.type_expr
| Variant_tags of string * string
- | Invalid_variable_name of string
+ | Invalid_type_variable_name of string
| Cannot_quantify of string * Types.type_expr
| Multiple_constraints_on_type of string
View Lorry Controller Status