summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.depend10
-rw-r--r--Changes2
-rw-r--r--bytecomp/translcore.ml14
-rw-r--r--byterun/fail.h1
-rw-r--r--otherlibs/dynlink/.depend8
-rw-r--r--parsing/parser.mly24
-rw-r--r--parsing/parsetree.mli2
-rw-r--r--parsing/printast.ml5
-rw-r--r--stdlib/.depend8
-rw-r--r--stdlib/pervasives.ml1
-rw-r--r--stdlib/pervasives.mli2
-rw-r--r--tools/ocamldep.ml2
-rw-r--r--tools/ocamlprof.ml3
-rw-r--r--typing/predef.ml9
-rw-r--r--typing/predef.mli1
-rw-r--r--typing/typecore.ml15
-rw-r--r--typing/typedtree.ml2
-rw-r--r--typing/typedtree.mli2
-rw-r--r--utils/config.mlp2
19 files changed, 73 insertions, 40 deletions
diff --git a/.depend b/.depend
index 237358257..9d13dd98a 100644
--- a/.depend
+++ b/.depend
@@ -186,16 +186,14 @@ typing/typecore.cmo: parsing/asttypes.cmi typing/btype.cmi utils/clflags.cmo \
typing/ctype.cmi typing/env.cmi typing/ident.cmi parsing/location.cmi \
parsing/longident.cmi utils/misc.cmi typing/parmatch.cmi \
parsing/parsetree.cmi typing/path.cmi typing/predef.cmi \
- typing/primitive.cmi typing/printtyp.cmi typing/typedtree.cmi \
- typing/types.cmi typing/typetexp.cmi utils/warnings.cmi \
- typing/typecore.cmi
+ typing/printtyp.cmi typing/typedtree.cmi typing/types.cmi \
+ typing/typetexp.cmi utils/warnings.cmi typing/typecore.cmi
typing/typecore.cmx: parsing/asttypes.cmi typing/btype.cmx utils/clflags.cmx \
typing/ctype.cmx typing/env.cmx typing/ident.cmx parsing/location.cmx \
parsing/longident.cmx utils/misc.cmx typing/parmatch.cmx \
parsing/parsetree.cmi typing/path.cmx typing/predef.cmx \
- typing/primitive.cmx typing/printtyp.cmx typing/typedtree.cmx \
- typing/types.cmx typing/typetexp.cmx utils/warnings.cmx \
- typing/typecore.cmi
+ typing/printtyp.cmx typing/typedtree.cmx typing/types.cmx \
+ typing/typetexp.cmx utils/warnings.cmx typing/typecore.cmi
typing/typedecl.cmo: parsing/asttypes.cmi typing/btype.cmi utils/clflags.cmo \
utils/config.cmi typing/ctype.cmi typing/env.cmi typing/ident.cmi \
typing/includecore.cmi parsing/location.cmi parsing/longident.cmi \
diff --git a/Changes b/Changes
index 64dae1f3d..42fe00132 100644
--- a/Changes
+++ b/Changes
@@ -6,6 +6,8 @@ Standard library:
Both compilers:
- Option -warn-error to turn warnings into errors.
+- Assertions are now type-checked even if the -noassert option is given,
+ thus -noassert doesn't change the types of your modules anymore.
Objective Caml 3.00:
diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml
index 7eca06aa4..c4a7e3e5b 100644
--- a/bytecomp/translcore.ml
+++ b/bytecomp/translcore.ml
@@ -431,6 +431,15 @@ let event_function exp lam =
lam None
+let assert_failed loc =
+ Lprim(Praise, [Lprim(Pmakeblock(0, Immutable),
+ [transl_path Predef.path_assert_failure;
+ Lconst(Const_block(0,
+ [Const_base(Const_string !Location.input_name);
+ Const_base(Const_int loc.Location.loc_start);
+ Const_base(Const_int loc.Location.loc_end)]))])])
+;;
+
(* Translation of expressions *)
let rec transl_exp e =
@@ -585,6 +594,11 @@ let rec transl_exp e =
(Lvar cpy))
| Texp_letmodule(id, modl, body) ->
Llet(Strict, id, !transl_module Tcoerce_none None modl, transl_exp body)
+ | Texp_assert (cond) ->
+ if !Clflags.noassert
+ then lambda_unit
+ else Lifthenelse (transl_exp cond, lambda_unit, assert_failed e.exp_loc)
+ | Texp_assertfalse -> assert_failed e.exp_loc
| _ ->
fatal_error "Translcore.transl"
diff --git a/byterun/fail.h b/byterun/fail.h
index 143d34ff7..dc94645f4 100644
--- a/byterun/fail.h
+++ b/byterun/fail.h
@@ -30,6 +30,7 @@
#define MATCH_FAILURE_EXN 7 /* "Match_failure" */
#define STACK_OVERFLOW_EXN 8 /* "Stack_overflow" */
#define SYS_BLOCKED_IO 9 /* "Sys_blocked_io" */
+#define ASSERT_FAILURE_EXN 10 /* "Assert_failure" */
#ifdef POSIX_SIGNALS
struct longjmp_buffer {
diff --git a/otherlibs/dynlink/.depend b/otherlibs/dynlink/.depend
index d6e2f6702..aea012ee0 100644
--- a/otherlibs/dynlink/.depend
+++ b/otherlibs/dynlink/.depend
@@ -1,8 +1,8 @@
dynlink.cmo: ../../utils/config.cmi ../../bytecomp/emitcode.cmi \
- ../../bytecomp/meta.cmi ../../utils/misc.cmi ../../bytecomp/opcodes.cmo \
- ../../bytecomp/symtable.cmi dynlink.cmi
+ ../../typing/ident.cmi ../../bytecomp/meta.cmi ../../utils/misc.cmi \
+ ../../bytecomp/opcodes.cmo ../../bytecomp/symtable.cmi dynlink.cmi
dynlink.cmx: ../../utils/config.cmx ../../bytecomp/emitcode.cmx \
- ../../bytecomp/meta.cmx ../../utils/misc.cmx ../../bytecomp/opcodes.cmx \
- ../../bytecomp/symtable.cmx dynlink.cmi
+ ../../typing/ident.cmx ../../bytecomp/meta.cmx ../../utils/misc.cmx \
+ ../../bytecomp/opcodes.cmx ../../bytecomp/symtable.cmx dynlink.cmi
extract_crc.cmo: dynlink.cmi
extract_crc.cmx: dynlink.cmx
diff --git a/parsing/parser.mly b/parsing/parser.mly
index 1fa2b835d..a96f05774 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -57,28 +57,10 @@ let ghpat d = { ppat_desc = d; ppat_loc = symbol_gloc () };;
let ghtyp d = { ptyp_desc = d; ptyp_loc = symbol_gloc () };;
let mkassert e =
- let l = symbol_rloc () in
- let triple = ghexp (Pexp_tuple
- [ghexp (Pexp_constant (Const_string !input_name));
- ghexp (Pexp_constant (Const_int l.loc_start));
- ghexp (Pexp_constant (Const_int l.loc_end))])
- in
- let excep = Ldot (Lident "Pervasives", "Assert_failure") in
- let bucket = ghexp (Pexp_construct (excep, Some triple, false)) in
- let raise_ = ghexp (Pexp_ident (Ldot (Lident "Pervasives", "raise"))) in
- let raise_af = ghexp (Pexp_apply (raise_, ["", bucket])) in
-
- let under = ghpat Ppat_any in
- let false_ = ghexp (Pexp_construct (Lident "false", None, false)) in
- let try_e = ghexp (Pexp_try (e, [(under, false_)])) in
-
- let not_ = ghexp (Pexp_ident (Ldot (Lident "Pervasives", "not"))) in
- let not_try_e = ghexp (Pexp_apply (not_, ["", try_e])) in
match e with
- | {pexp_desc = Pexp_construct (Lident "false", None, false) } -> raise_af
- | _ -> if !Clflags.noassert
- then mkexp (Pexp_construct (Lident "()", None, false))
- else mkexp (Pexp_ifthenelse (not_try_e, raise_af, None))
+ | {pexp_desc = Pexp_construct (Lident "false", None, false) } ->
+ mkexp (Pexp_assertfalse)
+ | _ -> mkexp (Pexp_assert (e))
;;
let mklazy e =
diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli
index 60c8a9998..99c19a0b6 100644
--- a/parsing/parsetree.mli
+++ b/parsing/parsetree.mli
@@ -101,6 +101,8 @@ and expression_desc =
| Pexp_setinstvar of string * expression
| Pexp_override of (string * expression) list
| Pexp_letmodule of string * module_expr * expression
+ | Pexp_assert of expression
+ | Pexp_assertfalse
(* Value descriptions *)
diff --git a/parsing/printast.ml b/parsing/printast.ml
index 243395545..93553007a 100644
--- a/parsing/printast.ml
+++ b/parsing/printast.ml
@@ -266,6 +266,11 @@ and expression i ppf x =
line i ppf "Pexp_letmodule \"%s\"\n" s;
module_expr i ppf me;
expression i ppf e;
+ | Pexp_assert (e) ->
+ line i ppf "Pexp_assert";
+ expression i ppf e;
+ | Pexp_assertfalse ->
+ line i ppf "Pexp_assertfalse";
and value_description i ppf x =
line i ppf "value_description\n";
diff --git a/stdlib/.depend b/stdlib/.depend
index 6fbea6ba9..6c18ecadb 100644
--- a/stdlib/.depend
+++ b/stdlib/.depend
@@ -4,8 +4,8 @@ parsing.cmi: lexing.cmi obj.cmi
printf.cmi: buffer.cmi
arg.cmo: array.cmi list.cmi printf.cmi string.cmi sys.cmi arg.cmi
arg.cmx: array.cmx list.cmx printf.cmx string.cmx sys.cmx arg.cmi
-array.cmo: pervasives.cmi array.cmi
-array.cmx: pervasives.cmx array.cmi
+array.cmo: array.cmi
+array.cmx: array.cmi
buffer.cmo: string.cmi sys.cmi buffer.cmi
buffer.cmx: string.cmx sys.cmx buffer.cmi
callback.cmo: obj.cmi callback.cmi
@@ -14,8 +14,8 @@ char.cmo: char.cmi
char.cmx: char.cmi
digest.cmo: string.cmi digest.cmi
digest.cmx: string.cmx digest.cmi
-filename.cmo: buffer.cmi pervasives.cmi string.cmi sys.cmi filename.cmi
-filename.cmx: buffer.cmx pervasives.cmx string.cmx sys.cmx filename.cmi
+filename.cmo: buffer.cmi string.cmi sys.cmi filename.cmi
+filename.cmx: buffer.cmx string.cmx sys.cmx filename.cmi
format.cmo: buffer.cmi obj.cmi string.cmi format.cmi
format.cmx: buffer.cmx obj.cmx string.cmx format.cmi
gc.cmo: printf.cmi sys.cmi gc.cmi
diff --git a/stdlib/pervasives.ml b/stdlib/pervasives.ml
index 6e5cab16c..20412d421 100644
--- a/stdlib/pervasives.ml
+++ b/stdlib/pervasives.ml
@@ -22,7 +22,6 @@ let failwith s = raise(Failure s)
let invalid_arg s = raise(Invalid_argument s)
exception Exit
-exception Assert_failure of (string * int * int)
(* Comparisons *)
diff --git a/stdlib/pervasives.mli b/stdlib/pervasives.mli
index 1411c7dcc..89c188600 100644
--- a/stdlib/pervasives.mli
+++ b/stdlib/pervasives.mli
@@ -59,7 +59,7 @@ external raise : exn -> 'a = "%raise"
apply. The arguments are the location of the pattern-matching
in the source code (file name, position of first character,
position of last character). *)
-exception Assert_failure of (string * int * int)
+(*- exception Assert_failure of (string * int * int) *)
(* Exception raised when an assertion fails. The arguments are
the location of the pattern-matching in the source code
(file name, position of first character, position of last
diff --git a/tools/ocamldep.ml b/tools/ocamldep.ml
index 9a5ff26ba..a9d62530a 100644
--- a/tools/ocamldep.ml
+++ b/tools/ocamldep.ml
@@ -144,6 +144,8 @@ let rec add_expr bv exp =
| Pexp_override sel -> List.iter (fun (s, e) -> add_expr bv e) sel
| Pexp_letmodule(id, m, e) ->
add_module bv m; add_expr (StringSet.add id bv) e
+ | Pexp_assert (e) -> add_expr bv e
+ | Pexp_assertfalse -> ()
and add_pat_expr_list bv pel =
List.iter (fun (p, e) -> add_pattern bv p; add_expr bv e) pel
diff --git a/tools/ocamlprof.ml b/tools/ocamlprof.ml
index 0274b558a..3d29af248 100644
--- a/tools/ocamlprof.ml
+++ b/tools/ocamlprof.ml
@@ -279,6 +279,9 @@ and rw_exp iflag sexp =
rewrite_mod iflag smod;
rewrite_exp iflag sexp
+ | Pexp_assert (cond) -> rewrite_exp iflag cond
+ | Pexp_assertfalse -> ()
+
and rewrite_ifbody iflag ghost sifbody =
if !instr_if && not ghost then
insert_profile rw_exp sifbody
diff --git a/typing/predef.ml b/typing/predef.ml
index b32faada4..b2d1bf22a 100644
--- a/typing/predef.ml
+++ b/typing/predef.ml
@@ -72,8 +72,10 @@ and ident_end_of_file = Ident.create "End_of_file"
and ident_division_by_zero = Ident.create "Division_by_zero"
and ident_stack_overflow = Ident.create "Stack_overflow"
and ident_sys_blocked_io = Ident.create "Sys_blocked_io"
+and ident_assert_failure = Ident.create "Assert_failure"
let path_match_failure = Pident ident_match_failure
+and path_assert_failure = Pident ident_assert_failure
let build_initial_env add_type add_exception empty_env =
let decl_abstr =
@@ -140,6 +142,8 @@ let build_initial_env add_type add_exception empty_env =
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_type ident_int64 decl_abstr (
add_type ident_int32 decl_abstr (
add_type ident_nativeint decl_abstr (
@@ -154,11 +158,12 @@ let build_initial_env add_type add_exception empty_env =
add_type ident_string decl_abstr (
add_type ident_char decl_abstr (
add_type ident_int decl_abstr (
- empty_env))))))))))))))))))))))))
+ 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_division_by_zero; ident_sys_blocked_io;
+ ident_assert_failure ]
diff --git a/typing/predef.mli b/typing/predef.mli
index b88f0d98e..bc8cb4181 100644
--- a/typing/predef.mli
+++ b/typing/predef.mli
@@ -46,6 +46,7 @@ val path_int32: Path.t
val path_int64: Path.t
val path_match_failure: Path.t
+val path_assert_failure : Path.t
(* To build the initial environment. Since there is a nasty mutual
recursion between predef and env, we break it by parameterizing
diff --git a/typing/typecore.ml b/typing/typecore.ml
index 27fd25d5c..1f6458847 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -1002,6 +1002,21 @@ let rec type_exp env sexp =
exp_loc = sexp.pexp_loc;
exp_type = ty;
exp_env = env }
+ | Pexp_assert (e) ->
+ let cond = type_expect env e (instance Predef.type_bool) in
+ {
+ exp_desc = Texp_assert (cond);
+ exp_loc = sexp.pexp_loc;
+ exp_type = instance Predef.type_unit;
+ exp_env = env;
+ }
+ | Pexp_assertfalse ->
+ {
+ exp_desc = Texp_assertfalse;
+ exp_loc = sexp.pexp_loc;
+ exp_type = newvar ();
+ exp_env = env;
+ }
and type_argument env sarg ty_expected =
let rec no_labels ty =
diff --git a/typing/typedtree.ml b/typing/typedtree.ml
index d4c391d2d..0b5c0a5a5 100644
--- a/typing/typedtree.ml
+++ b/typing/typedtree.ml
@@ -74,6 +74,8 @@ and expression_desc =
| Texp_setinstvar of Path.t * Path.t * expression
| Texp_override of Path.t * (Path.t * expression) list
| Texp_letmodule of Ident.t * module_expr * expression
+ | Texp_assert of expression
+ | Texp_assertfalse
and meth =
Tmeth_name of string
diff --git a/typing/typedtree.mli b/typing/typedtree.mli
index 5729f2037..78a8620f7 100644
--- a/typing/typedtree.mli
+++ b/typing/typedtree.mli
@@ -73,6 +73,8 @@ and expression_desc =
| Texp_setinstvar of Path.t * Path.t * expression
| Texp_override of Path.t * (Path.t * expression) list
| Texp_letmodule of Ident.t * module_expr * expression
+ | Texp_assert of expression
+ | Texp_assertfalse
and meth =
Tmeth_name of string
diff --git a/utils/config.mlp b/utils/config.mlp
index eb552c481..8677d23ed 100644
--- a/utils/config.mlp
+++ b/utils/config.mlp
@@ -12,7 +12,7 @@
(* $Id$ *)
-let version = "3.00+19 (2000-11-20)"
+let version = "3.00+20 (2000-12-03)"
let standard_library =
try
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-24 07:54:07 +0000