Commits

camlspotter committed d77dbed

no check of pattern position yet

  • Participants
  • Parent commits 9e5e42a
  • Branches indent-warning

Comments (0)

Files changed (3)

typing/typecore.ml

 
 module Checkpos = struct
 
-  (* CR jfuruse: already warned switch should be mutable field of constr *)
+  type constr_unit = {
+    pos : int;
+    mutable warned : bool;
+    source : string;
+  }
   type constr = {
-    eq_or_right : (int * bool) option;
-    eq_or_left : (int * bool) option;
-    sequence_eq_or_left : (int * bool) option; (* never inherited into subexps *)
+    eq_or_right : constr_unit option;
+    eq_or_left : constr_unit option;
+    sequence_eq_or_left : constr_unit option; (* never inherited into subexps *)
   }
 
   let empty = { eq_or_right = None; eq_or_left = None; sequence_eq_or_left = None }
 
-  let eq_or_left constr n = 
+  let eq_or_left constr n name = 
     match constr.eq_or_left with
-    | None -> { constr with eq_or_left = Some (n, false) }
-    | Some (m, _) when n < m -> { constr with eq_or_left = Some (n, false) }
-    | Some _ -> constr
+    | Some { pos=m } when m < n -> constr
+    | _ -> { constr with eq_or_left = Some { pos=n; warned=false; source=name } }
 
-  let sequence_eq_or_left constr n = 
+  let sequence_eq_or_left constr n name = 
     match constr.sequence_eq_or_left with
-    | None -> { constr with sequence_eq_or_left = Some (n, false) } 
-    | Some (m, _) when n < m -> { constr with sequence_eq_or_left = Some (n, false) } 
-    | Some _ -> constr
+    | Some { pos=m } when m < n -> constr
+    | _ -> { constr with sequence_eq_or_left = Some { pos=n; warned=false; source= name } } 
 
-  let eq_or_right constr n = 
+  let eq_or_right constr n name = 
     match constr.eq_or_right with
-    | None -> { constr with eq_or_right = Some (n, false) }
-    | Some (m, _) when m < n -> { constr with eq_or_right = Some (n, false) }
-    | Some _ -> constr
+    | Some { pos=m } when n < m -> constr
+    | _ -> { constr with eq_or_right = Some { pos=n; warned=false; source=name } }
 
   let get_pos loc = 
     let (_,_,pos) = Location.get_pos_info loc.Location.loc_start in
   let rec check constr pexp = 
     let loc = pexp.pexp_loc in
     let pos = get_pos loc in
-    let constr = match constr.eq_or_right with
-      | None | Some (_, true) -> constr
-      | Some (eq_or_right, false) -> 
-	  if pos < eq_or_right then begin
-	    Location.prerr_warning loc Warnings.Confusing_indent;
-	    { constr with eq_or_right = Some (eq_or_right, true) }
-	  end else constr
-    in
-    let constr = match constr.eq_or_left with
-      | None | Some (_, true) -> constr
-      | Some (eq_or_left, false) -> 
-	  if eq_or_left < pos then begin
-	    Location.prerr_warning loc Warnings.Confusing_indent;
-	    { constr with eq_or_left = Some (eq_or_left, true) }
-	  end else constr
-    in
+    begin match constr.eq_or_right with
+      | None | Some { warned= true } -> ()
+      | Some c -> 
+	  if pos < c.pos then begin
+	    c.warned <- true;
+	    Location.prerr_warning loc (Warnings.Confusing_indent c.source);
+	  end
+    end;
+    begin match constr.eq_or_left with
+      | None | Some { warned= true } -> ()
+      | Some c -> 
+	  if c.pos < pos then begin
+	    c.warned <- true;
+	    Location.prerr_warning loc (Warnings.Confusing_indent c.source);
+	  end
+    end;
     (* CR jfuruse: no need of updating the boolean *)
-    let constr = match constr.sequence_eq_or_left with
-      | None | Some (_, true) -> constr
-      | Some (sequence_eq_or_left, false) -> 
-	  if sequence_eq_or_left < pos then begin
-	    Location.prerr_warning loc Warnings.Confusing_indent;
-	    { constr with sequence_eq_or_left = Some (sequence_eq_or_left, true) }
-	  end else constr
-    in
+    begin match constr.sequence_eq_or_left with
+      | None | Some { warned= true } -> ()
+      | Some c -> 
+	  if c.pos < pos then begin
+	    c.warned <- true;
+	    Location.prerr_warning loc (Warnings.Confusing_indent c.source);
+	  end 
+    end;
     let constr = { constr with sequence_eq_or_left = None } in
     match pexp.pexp_desc with
     | Pexp_ident _ -> ()
 	(* defs do not inherit constr *)
 	iter_snds (check empty) pexps;
 	(* body must occur right of the let *)
-	check (eq_or_right constr pos) e
-    | Pexp_function ("", eopt, pexps) -> 
-	(* the real function -> *)
-	assert (eopt = None);
+	check (eq_or_right constr pos "let") e
+    | Pexp_function (_, eopt, pexps) -> 
+	(* it may be let f x = e *)
+	iter_opt (check empty) eopt;
 	(* case exp must be right either the function or pat *)
 	List.iter (fun (pat, exp) ->
 	  let pos' = get_pos pat.ppat_loc in
-	  check (eq_or_right constr (min pos pos')) exp) pexps
-    | Pexp_function (_, eopt, pexps) -> 
-	(* it may be let f x = e *)
-	iter_opt (check empty) eopt;
-	iter_snds (check empty) pexps
+	  check (eq_or_right constr (min (pos+1) pos') "function") exp) pexps
     | Pexp_apply (e, lexps) -> check constr e; iter_snds (check constr) lexps
     | Pexp_match (e, pexps) -> 
 	check empty e;
 	(* case exp must be right either the function or pat *)
 	List.iter (fun (pat, exp) ->
 	  let pos' = get_pos pat.ppat_loc in
-	  check (eq_or_right constr (min pos pos')) exp) pexps
+	  check (eq_or_right constr (min (pos+1) pos') "match") exp) pexps
     | Pexp_try (e, pexps) -> 
 	check empty e;
 	(* case exp must be right either the function or pat *)
 	List.iter (fun (pat, exp) ->
 	  let pos' = get_pos pat.ppat_loc in
-	  check (eq_or_right constr (min pos pos')) exp) pexps
+	  check (eq_or_right constr (min (pos+1) pos') "try") exp) pexps
     | Pexp_tuple es -> List.iter (check constr) es
     | Pexp_construct (_, eopt, _) -> iter_opt (check empty) eopt
     | Pexp_variant (_, eopt) -> iter_opt (check empty) eopt
 	List.iter (check empty) es
     | Pexp_ifthenelse (e1, e2, eopt) -> 
 	check empty e1;
-	let constr = eq_or_right constr pos in
+	let constr = eq_or_right constr pos "if" in
 	(* then must appear right of if *)
 	check constr e2;
 	(* else must appear right of if *)
                                     | Pexp_try _) } as e1), e2) ->
 	check constr e1;
 	(* e2 must appear left of if/function/let/match/try *)
-	check (sequence_eq_or_left constr (get_pos e1.pexp_loc)) e2
+	check (sequence_eq_or_left constr (get_pos e1.pexp_loc) "seq") e2
     | Pexp_sequence (e1, e2) ->
 	check constr e1;
 	(* if e2 is in the different line of e1, e2 must appear left of e1 (or the same ?) *)
 	if get_line e1.pexp_loc <> get_line e2.pexp_loc then
-	  check (sequence_eq_or_left constr (get_pos e1.pexp_loc)) e2
+	  check (sequence_eq_or_left constr (get_pos e1.pexp_loc) "seq2") e2
 	else check empty e2
     | Pexp_while(e1, e2) -> 
 	check empty e1;

utils/warnings.ml

   | Bad_module_name of string
   | Unused_var of string             (* Y *)
   | Unused_var_strict of string      (* Z *)
-  | Confusing_indent                 (* I *)
+  | Confusing_indent of string       (* I *)
 ;;
 
 let letter = function        (* 'a' is all *)
   | All_clauses_guarded ->      'x'
   | Unused_var _ ->             'y'
   | Unused_var_strict _ ->      'z'
-  | Confusing_indent ->         'i'
+  | Confusing_indent _ ->         'i'
 ;;
 
 let active = Array.create 27 true;;
        but no fields are borrowed from the original."
   | Bad_module_name (modname) ->
       "bad source file name: \"" ^ modname ^ "\" is not a valid module name."
-  | Confusing_indent ->
-      "confusing indent."
+  | Confusing_indent s ->
+      "confusing indent. (" ^ s ^ ")"
 ;;
 
 let nerrors = ref 0;;

utils/warnings.mli

   | Bad_module_name of string
   | Unused_var of string             (* Y *)
   | Unused_var_strict of string      (* Z *)
-  | Confusing_indent                 (* I *)
+  | Confusing_indent of string       (* I *)
 ;;
 
 val parse_options : bool -> string -> unit;;