ok

driver/main_args.ml

@@ -73,8 +73,13 @@ let mk_dtypes f =
   "-dtypes", Arg.Unit f, " (deprecated) same as -annot"
 ;;
 
+let mk_easy f =
+  "-easy", Arg.Unit f, " activate all -easy* flags"
+;;
+(* currently only an alias for -easytype *)
+
 let mk_easytype f =
-  "-easytype", Arg.Unit f, " easier typing of beginner's code"
+  "-easytype", Arg.Unit f, " more informative typing errors"
 ;;
 
 let mk_for_pack_byt () =
@@ -690,6 +695,7 @@ struct
     mk_dllib F._dllib;
     mk_dllpath F._dllpath;
     mk_dtypes F._annot;
+    mk_easy F._easytype;
     mk_easytype F._easytype;
     mk_for_pack_byt ();
     mk_g_byt F._g;

test.ml

@@ -1,2 +1,21 @@
-let x : (int list * int list) =
-  if true then ([], [true]) else ([3], [])
+let rec f x = 
+  match x with
+  | 0 -> 0.0
+  | _ -> print_float (f (x-1))
+  | _ -> print_int (f (x-1))
+
+(*
+let _ =
+  let x = ref [] in
+  x := [3];
+  x := [4.0]
+*)
+
+
+(*
+let _ =
+  let y = ref 2 in
+  if x > 0
+    y = 3;
+  print_int y
+  *)

test.sh

@@ -1 +1 @@
-boot/ocamlrun ./ocamlc -I stdlib -easytype test.ml
+boot/ocamlrun ./ocamlc -I stdlib -easy test.ml

tools/ocamloptp.ml

@@ -57,6 +57,7 @@ module Options = Main_args.Make_optcomp_options (struct
   let _g = option "-g"
   let _i = option "-i"
   let _I s = option_with_arg "-I" s
+  let _easy = option "-easy"
   let _easytype = option "-easytype"
   let _impl s = with_impl := true; option_with_arg "-impl" s
   let _inline n = option_with_int "-inline" n

typing/ctype.ml

@@ -17,6 +17,9 @@ open Asttypes
 open Types
 open Btype
 
+(* Global flag to activate easytype typing mode *)
+let activate_easytype = ref false
+
 (*
    Type manipulation after type inference
    ======================================

typing/ctype.mli

@@ -15,6 +15,9 @@
 open Asttypes
 open Types
 
+(* Global flag to activate easytype typing mode *)
+val activate_easytype : bool ref
+
 exception Unify of (type_expr * type_expr) list
 exception Tags of label * label
 exception Subtype of

typing/printtyp.ml

@@ -22,6 +22,9 @@ open Types
 open Btype
 open Outcometree
 
+let hack_to_display_message_at_the_right_place_easy =
+  ref false
+
 (* Print a long identifier *)
 
 let rec longident ppf = function
@@ -1259,18 +1262,23 @@ let print_tags ppf fields =
       fprintf ppf "`%s" t;
       List.iter (fun (t, _) -> fprintf ppf ",@ `%s" t) fields
 
+(* AC: TODO: get rid of this function and have get_explanation return an option *)
 let has_explanation unif t3 t4 =
   match t3.desc, t4.desc with
   (* case added for easytype *)
   | (Tconstr (p, [ty1], _), ty2 | ty2, Tconstr (p, [ty1], _)) 
-     when (match p with Pdot(Pident id, "ref", pos) 
+     when !activate_easytype && 
+          (match p with Pdot(Pident id, "ref", pos) 
            when Ident.same id ident_pervasive -> true | _ -> false) 
-     -> true
+     -> hack_to_display_message_at_the_right_place_easy := true; 
+        true
   (* case added for easytype *)
   | (Tarrow (_, ty1, _, _), ty2 | ty2, Tarrow (_, ty1, _, _)) 
      when (*AC: could also generalize to: (expand_head env ty1).desc *) 
+       !activate_easytype && 
        (match ty1.desc with Tconstr (p,_,_) when Path.same p Predef.path_unit -> true | _ -> false)
-     -> true
+     -> hack_to_display_message_at_the_right_place_easy := true;
+        true
 
   | Tfield _, (Tnil|Tconstr _) | (Tnil|Tconstr _), Tfield _
   | Tnil, Tconstr _ | Tconstr _, Tnil
@@ -1295,13 +1303,15 @@ let explanation unif t3 t4 ppf =
      AC--TODO: apply the case only when ty1 is unifiable with ty2,
      however do so without performing any side-effects on them. *)
   | (Tconstr (p, [ty1], _), ty2 | ty2, Tconstr (p, [ty1], _)) 
-     when (match p with Pdot(Pident id, "ref", pos) 
+     when !activate_easytype && 
+          (match p with Pdot(Pident id, "ref", pos) 
            when Ident.same id ident_pervasive -> true | _ -> false) ->
       fprintf ppf
         "@,@[You are probably missing a `!' operator somewhere.@]"
   (* case added for easytype *)
   | (Tarrow (_, ty1, _, _), ty2 | ty2, Tarrow (_, ty1, _, _)) 
-     when (*AC: could also generalize to: (expand_head env ty1).desc *) 
+     when !activate_easytype && 
+       (*AC: could also generalize to: (expand_head env ty1).desc *) 
        (match ty1.desc with Tconstr (p,_,_) when Path.same p Predef.path_unit -> true | _ -> false) ->
       fprintf ppf
         "@,@[You probably forgot to provide `()' as argument somewhere.@]"

typing/printtyp.mli

@@ -85,3 +85,5 @@ val report_ambiguous_type_error:
 
 (* for toploop *)
 val hide_rec_items: signature_item list -> unit
+
+val hack_to_display_message_at_the_right_place_easy : bool ref

typing/typecore.ml

@@ -20,11 +20,13 @@ open Typedtree
 open Btype
 open Ctype
 
-(* Global flag to activate easytype typing mode *)
-let activate_easytype = ref false
+(* AC: TODO: type trace = (type_expr * type_expr) list *)
 
+(* Flag to control the behavior of error reporting 
+   on application, whether or not to show the original
+   ocaml error message *)
+let show_original_error_after_easy = false
 
-(* TODO: type trace = (type_expr * type_expr) list *)
 
 type easy_error_piece = Printtyp.easy_error_piece
 type easy_reporter = Format.formatter -> (easy_error_piece * easy_error_piece * easy_error_piece * easy_error_piece) -> unit
@@ -2534,7 +2536,7 @@ and type_expect_ ?in_function env sexp ty_expected =
             exp_env = env }
       end
   | Pexp_sequence(sexp1, sexp2) ->
-      let exp1 = type_statement_easify env sexp1 
+      let exp1 = type_statement_easify ~force_easy:true env sexp1 
         (easy_report_so_but_string "This expression is followed by a semi-column") in
       let exp2 = type_expect env sexp2 ty_expected in
       re {
@@ -3845,8 +3847,8 @@ and easy_report_so_but_string s : easy_reporter =
 and easy_report_but_string s : easy_reporter = 
   easy_report_but (format_string s)
 
-and type_statement_easify env sexp report =
-  if !activate_easytype
+and type_statement_easify ?(force_easy=false) env sexp report =
+  if !activate_easytype || force_easy
     then type_statement_easy env sexp report
     else type_statement env sexp
 
@@ -3882,7 +3884,9 @@ and type_statement_easy env sexp report =
   let expected_ty = instance_def Predef.type_unit in
   unify_exp_easy env exp expected_ty 
     (fun ppf (m1,m2,m3,m4) -> report ppf (m1,m2,m3,
-      fun ppf () -> match msg_add with Some m -> Format.fprintf ppf "\n%s" m | None -> m4 ppf ()))
+      fun ppf () -> match msg_add with 
+        | Some m -> Format.fprintf ppf "@.%s" m; Printtyp.hack_to_display_message_at_the_right_place_easy := true
+        | None -> m4 ppf ()))
     (*deprecated: (report_adding report msg_add)*)
 
 (* note: should call type_expect_easify with a ty_expected
@@ -4370,22 +4374,29 @@ let rec report_error env ppf = function
   | Expr_type_clash_easy (report, trace) ->
       let ms = get_unification_error_easy env trace in
       report ppf ms
-  (* --AC: problem with the order
   | Apply_error_easy (explain, loc, Expr_type_clash trace) ->
       let (m1,m2,m3,m4) = get_unification_error_easy env trace in
       explain ppf;
-      fprintf ppf "%a\n---\n" m4 ();
-      Location.print_error ppf loc;
-      let msg1 = "This expression has type" in
-      let msg2 = "but an expression was expected of type" in
-      Format.fprintf ppf
-        "@[<v>\
-          @[%s@;<1 2>[%a]@ \
-            %s@;<1 2>[%a].\
-          @]%a
-         @]"
-       msg1 m1 () msg2 m2 () m3 () 
-   *)
+      let (m4a_call,m4b) = 
+        if !Printtyp.hack_to_display_message_at_the_right_place_easy 
+          then ((fun () -> fprintf ppf "%a@." m4 ()), format_string "")
+          else ((fun () -> ()), m4)
+        in
+      m4a_call();
+      if show_original_error_after_easy then begin
+        Format.fprintf ppf "----@.";
+        Location.print_error ppf loc;
+        let msg1 = "This expression has type" in
+        let msg2 = "but an expression was expected of type" in
+        Format.fprintf ppf
+          "@[<v>\
+            @[%s@;<1 2>[%a]@ \
+              %s@;<1 2>[%a].\
+            @]%a \
+            %a \
+           @]"
+         msg1 m1 () msg2 m2 () m3 () m4b ()
+      end
   | Apply_error_easy (explain, loc, Apply_non_function typ) ->
       explain ppf;
       (* Note: some copy-paste from code further below *)
@@ -4397,9 +4408,11 @@ let rec report_error env ppf = function
       end
   | Apply_error_easy (explain, loc, original_error) ->
       explain ppf;
-      fprintf ppf "@\n";
-      Location.print_error ppf loc;
-      report_error env ppf original_error
+      if show_original_error_after_easy then begin
+        fprintf ppf "@\n";
+        Location.print_error ppf loc;
+        report_error env ppf original_error
+      end
   | Apply_non_function typ ->
       reset_and_mark_loops typ;
       begin match (repr typ).desc with

typing/typecore.mli

@@ -16,9 +16,6 @@ open Asttypes
 open Types
 open Format
 
-(* Global flag to activate easytype typing mode *)
-val activate_easytype : bool ref
-
 val is_nonexpansive: Typedtree.expression -> bool
 
 val type_binding:

typing/typemod.ml

@@ -44,12 +44,12 @@ type error =
 
 exception Error of Location.t * Env.t * error
 
-(* Wrapper for making a new call with Typecore.activate_easytype := false
-   in case the first call ends on a typing error *)
+(* Wrapper for making a new call with Ctype.activate_easytype := true
+  in case the first call ends on a typing error *)
 let wrap_typing_easy fct =
   try fct()
   with Typecore.Error _ | Typetexp.Error _ ->
-    Typecore.activate_easytype := true;
+    Ctype.activate_easytype := true;
     fct()
 
 open Typedtree

typing/typetexp.ml

@@ -876,7 +876,7 @@ let report_error env ppf = function
   | Unbound_value_missing_rec_easy (lid, loc) ->
       fprintf ppf "Unbound value %a.\n" longident lid;
       let (_, line, _) = Location.get_pos_info loc.Location.loc_start in
-      fprintf ppf "You are probably missing the \"rec\" keyword on line %i." line;
+      fprintf ppf "@.You are probably missing the `rec' keyword on line %i." line;
   | Unbound_module lid ->
       fprintf ppf "Unbound module %a" longident lid;
       spellcheck ppf Env.fold_modules env lid;