diff options
| -rw-r--r-- | Changes | 2 | ||||
| -rw-r--r-- | VERSION | 2 | ||||
| -rwxr-xr-x | boot/ocamlc | bin | 1064832 -> 1065100 bytes | |||
| -rwxr-xr-x | boot/ocamldep | bin | 300603 -> 300623 bytes | |||
| -rwxr-xr-x | boot/ocamllex | bin | 165419 -> 165419 bytes | |||
| -rw-r--r-- | driver/main.ml | 1 | ||||
| -rw-r--r-- | driver/main_args.ml | 3 | ||||
| -rw-r--r-- | driver/main_args.mli | 1 | ||||
| -rw-r--r-- | driver/optmain.ml | 2 | ||||
| -rw-r--r-- | tools/ocamlcp.ml | 1 | ||||
| -rw-r--r-- | toplevel/opttopmain.ml | 2 | ||||
| -rw-r--r-- | toplevel/topmain.ml | 2 | ||||
| -rw-r--r-- | typing/typecore.ml | 4 | ||||
| -rw-r--r-- | utils/clflags.ml | 1 | ||||
| -rw-r--r-- | utils/clflags.mli | 1 |
15 files changed, 21 insertions, 1 deletions
@@ -35,6 +35,8 @@ Compilers and toplevel: are not listed in the pattern. - Better error report in case of unbound qualified identifier: if the module is unbound this error is reported in the first place. +- Added option '-strict-sequence' to force left hand part of sequence to have + type unit. - Added option '-no-app-funct' to turn applicative functors off. This option can help working around mysterious type incompatibilities caused by the incomplete comparison of applicative paths F(X).t. @@ -1,4 +1,4 @@ -3.12.0+dev11 (2009-12-01) +3.12.0+dev12 (2009-12-01) # The version string is the first line of this file. # It must be in the format described in stdlib/sys.mli diff --git a/boot/ocamlc b/boot/ocamlc Binary files differindex 18002552f..dc7017f09 100755 --- a/boot/ocamlc +++ b/boot/ocamlc diff --git a/boot/ocamldep b/boot/ocamldep Binary files differindex 572eea704..178d8e4e8 100755 --- a/boot/ocamldep +++ b/boot/ocamldep diff --git a/boot/ocamllex b/boot/ocamllex Binary files differindex 0bb44ed19..0db47b20f 100755 --- a/boot/ocamllex +++ b/boot/ocamllex diff --git a/driver/main.ml b/driver/main.ml index d69a53a3c..566df0a09 100644 --- a/driver/main.ml +++ b/driver/main.ml @@ -119,6 +119,7 @@ module Options = Main_args.Make_options (struct let _pp s = preprocessor := Some s let _principal = set principal let _rectypes = set recursive_types + let _strict_sequence = set strict_sequence let _thread = set use_threads let _vmthread = set use_vmthreads let _unsafe = set fast diff --git a/driver/main_args.ml b/driver/main_args.ml index b1c971869..7256c3583 100644 --- a/driver/main_args.ml +++ b/driver/main_args.ml @@ -44,6 +44,7 @@ module Make_options (F : val _pp : string -> unit val _principal : unit -> unit val _rectypes : unit -> unit + val _strict_sequence : unit -> unit val _thread : unit -> unit val _vmthread : unit -> unit val _unsafe : unit -> unit @@ -118,6 +119,8 @@ struct "-principal", Arg.Unit F._principal, " Check principality of type inference"; "-rectypes", Arg.Unit F._rectypes, " Allow arbitrary recursive types"; + "-strict-sequence", Arg.Unit F._strict_sequence, + " Left hand part of a sequence must have type unit"; "-thread", Arg.Unit F._thread, " Generate code that supports the system threads library"; "-unsafe", Arg.Unit F._unsafe, diff --git a/driver/main_args.mli b/driver/main_args.mli index 30ef02ecd..6097a4816 100644 --- a/driver/main_args.mli +++ b/driver/main_args.mli @@ -44,6 +44,7 @@ module Make_options (F : val _pp : string -> unit val _principal : unit -> unit val _rectypes : unit -> unit + val _strict_sequence : unit -> unit val _thread : unit -> unit val _vmthread : unit -> unit val _unsafe : unit -> unit diff --git a/driver/optmain.ml b/driver/optmain.ml index 268096667..7a6a03859 100644 --- a/driver/optmain.ml +++ b/driver/optmain.ml @@ -157,6 +157,8 @@ let main () = " Check principality of type inference"; "-rectypes", Arg.Set recursive_types, " Allow arbitrary recursive types"; + "-strict-sequence", Arg.Set strict_sequence, + " Left hand part of a sequence must have type unit"; "-shared", Arg.Unit (fun () -> shared := true; dlcode := true), " Produce a dynlinkable plugin"; "-S", Arg.Set keep_asm_file, " Keep intermediate assembly file"; diff --git a/tools/ocamlcp.ml b/tools/ocamlcp.ml index 6302ca5bf..2255320bd 100644 --- a/tools/ocamlcp.ml +++ b/tools/ocamlcp.ml @@ -73,6 +73,7 @@ module Options = Main_args.Make_options (struct let _pp s = incompatible "-pp" let _principal = option "-principal" let _rectypes = option "-rectypes" + let _strict_sequence = option "-strict-sequence" let _thread () = option "-thread" () let _vmthread () = option "-vmthread" () let _unsafe = option "-unsafe" diff --git a/toplevel/opttopmain.ml b/toplevel/opttopmain.ml index b75b35998..4e08353ec 100644 --- a/toplevel/opttopmain.ml +++ b/toplevel/opttopmain.ml @@ -74,6 +74,8 @@ let main () = " do not add default directory to the list of include directories"; "-principal", Arg.Set principal, " Check principality of type inference"; "-rectypes", Arg.Set recursive_types, " Allow arbitrary recursive types"; + "-strict-sequence", Arg.Set strict_sequence, + " Left hand part of a sequence must have type unit"; "-S", Arg.Set keep_asm_file, " Keep intermediate assembly file"; "-unsafe", Arg.Set fast, " No bound checking on array and string access"; "-version", Arg.Unit print_version, " Print version and exit"; diff --git a/toplevel/topmain.ml b/toplevel/topmain.ml index bc4a576f1..a8cab01dd 100644 --- a/toplevel/topmain.ml +++ b/toplevel/topmain.ml @@ -68,6 +68,8 @@ let main () = " do not add default directory to the list of include directories"; "-principal", Arg.Set principal, " Check principality of type inference"; "-rectypes", Arg.Set recursive_types, " Allow arbitrary recursive types"; + "-strict-sequence", Arg.Set recursive_types, + " Left hand part of a sequence must have type unit"; "-unsafe", Arg.Set fast, " No bound checking on array and string access"; "-version", Arg.Unit print_version, " Print version and exit"; "-w", Arg.String (Warnings.parse_options false), diff --git a/typing/typecore.ml b/typing/typecore.ml index e4c64cb31..21ee81a5f 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -2145,6 +2145,10 @@ and type_statement env sexp = begin_def(); let exp = type_exp env sexp in end_def(); + if !Clflags.strict_sequence then + let expected_type = instance Predef.type_unit in + unify env expected_type exp.exp_type; + exp else let ty = expand_head env exp.exp_type and tv = newvar() in begin match ty.desc with | Tarrow _ -> diff --git a/utils/clflags.ml b/utils/clflags.ml index 764465330..1074d3628 100644 --- a/utils/clflags.ml +++ b/utils/clflags.ml @@ -44,6 +44,7 @@ and use_prims = ref "" (* -use-prims ... *) and use_runtime = ref "" (* -use-runtime ... *) and principal = ref false (* -principal *) and recursive_types = ref false (* -rectypes *) +and strict_sequence = ref false (* -strict-sequence *) and applicative_functors = ref true (* -no-app-funct *) and make_runtime = ref false (* -make_runtime *) and gprofile = ref false (* -p *) diff --git a/utils/clflags.mli b/utils/clflags.mli index e7efafcbe..d5357ef39 100644 --- a/utils/clflags.mli +++ b/utils/clflags.mli @@ -41,6 +41,7 @@ val use_prims : string ref val use_runtime : string ref val principal : bool ref val recursive_types : bool ref +val strict_sequence : bool ref val applicative_functors : bool ref val make_runtime : bool ref val gprofile : bool ref |