Merge the stylistic patch from master branch.

TODO

+* Changes that could be applied to the code back-end:
+    [action] could now be inlined into [run]
+    [initiate] and [bookkeeping] could be merged?
+    [env.shifted] could be removed; use [env.token] instead
+
 * Clarifier si ocamlbuild doit recevoir -use-ocamlfind, -no-ocamlfind,
   ou rien; tester en particulier sous Windows?
 

src/_tags

+# Enable Jonathan's "nazi warnings".
+<*>: my_warnings
+
 # Tag both parser source files with origin_parser.
 <{yacc-parser,fancy-parser}.mly>:origin_parser
 

src/action.ml

@@ -97,7 +97,7 @@ let rename_pkeywords (psym, first_prod, last_prod) phi l =
 		      (* Similarly for $endpos. *)
 		    | Left, WhereEnd   -> last_prod, (used1, true)
 		      (* $i cannot be combined with inlining. *)
-		    | RightDollar i, w -> assert false
+		    | RightDollar _, _ -> assert false
 		    | RightNamed s, w  -> 
 			(* In the host rule, $startpos(x) is changed to 
 			   to $startpos(first_prod) (same thing for $endpos). *)
@@ -118,7 +118,7 @@ let rename_pkeywords (psym, first_prod, last_prod) phi l =
 		      (from_pos, to_pos) :: phi else phi), 
 		   (used1, used2))
 
-	    | x -> pk :: l, phi, (used1, used2))
+	    | _ -> pk :: l, phi, (used1, used2))
 
     ([], phi, (false, false)) l
 		
@@ -159,7 +159,7 @@ let keywords action =
 let pkeywords action = 
   action.pkeywords
 
-let rec print f action = 
+let print f action = 
   let module P = Printer.Make (struct let f = f 
 				      let locate_stretches = None 
 				      let raw_stretch_action = true

src/codeBackend.ml

@@ -230,25 +230,6 @@ let statecon s =
 let estatecon s =
   EData (statecon s, [])
 
-let rec begins_with s1 s2 i1 i2 n1 n2 =
-  if i1 = n1 then
-    true
-  else if i2 = n2 then
-    false
-  else if String.unsafe_get s1 i1 = String.unsafe_get s2 i2 then
-    begins_with s1 s2 (i1 + 1) (i2 + 1) n1 n2
-  else
-    false
-
-let begins_with s1 s2 =
-  begins_with s1 s2 0 0 (String.length s1) (String.length s2)
-
-(* This predicate tells whether a data constructor represents a state.
-   It is based on the name, which is inelegant and inefficient. TEMPORARY *)
-
-let is_statecon : string -> bool =
-  begins_with (dataprefix "State")
-
 let pstatecon s =
   PData (statecon s, [])
 
@@ -323,9 +304,6 @@ let insertif condition x =
 let var x : expr =
   EVar x
 
-let vars xs =
-  List.map var xs
-
 let pvar x : pattern =
   PVar x
 
@@ -770,7 +748,7 @@ let reducecellparams prod i holds_state symbol =
      used in the semantic action, then it is dropped using a wildcard
      pattern. *)
 
-  let semvpat t =
+  let semvpat _t =
     if used.(i) then
       PVar ids.(i)
     else
@@ -1078,8 +1056,7 @@ let errorbookkeeping e =
     ))
 
 (* This code is used to indicate that a new error has been detected in
-   state [s]. [covered] is the set of tokens that [s] knows how to
-   handle.
+   state [s].
 
    If I am correct, the count of shifted tokens is never -1
    here. Indeed, that would mean that we first found an error, and
@@ -1097,7 +1074,7 @@ let errorbookkeeping e =
    resetting [env.shifted] to zero, to counter-act the effect of
    [discard], which increments that counter. *)
 
-let initiate covered s =
+let initiate s =
 
   blet (
     [ assertshifted ],
@@ -1112,9 +1089,7 @@ let initiate covered s =
    input stream. It does not set up exception handlers for dealing
    with errors. *)
 
-(* TEMPORARY I believe [action] could now be inlined into [run] *)
-
-let rec runactiondef s : valdef list =
+let runactiondef s : valdef list =
 
   match Invariant.has_default_reduction s with
   | Some (prod, toks) as defred ->
@@ -1180,7 +1155,7 @@ let rec runactiondef s : valdef list =
 	if TerminalSet.subset TerminalSet.universe covered then
 	  branches
 	else
-	  branches @ [ { branchpat = PWildcard; branchbody = initiate covered s } ]
+	  branches @ [ { branchpat = PWildcard; branchbody = initiate s } ]
       in
 
       (* Finally, construct the code for [run] and [action]. The

src/codeBits.ml

@@ -79,7 +79,7 @@ let rec simplify = function
 
 (* Building a [let] construct, with on-the-fly simplification. *)
 
-let rec blet (bindings, body) =
+let blet (bindings, body) =
   match simplify bindings with
   | [] ->
       body

src/codePieces.ml

@@ -125,7 +125,7 @@ let symval symbol x =
   match semvtype symbol with
   | [] ->
       []
-  | [ t ] ->
+  | [ _t ] ->
       [ x ]
   | _ ->
       assert false

src/compressedBitSet.ml

@@ -192,7 +192,7 @@ let rec compare s1 s2 =
 	else if ss1 > ss2 then 1
 	else compare qs1 qs2
 
-let rec equal s1 s2 =
+let equal s1 s2 =
   compare s1 s2 = 0
 
 let rec disjoint s1 s2 = 

src/conflict.ml

@@ -287,7 +287,7 @@ let explain_reduce_item
 
       (* Otherwise, explore the transitions out of this item. *)
 
-      let prod, nt, rhs, pos, length = Item.def item in
+      let prod, _nt, rhs, pos, length = Item.def item in
 
       (* Shift transition, followed only if the symbol matches
 	 the symbol found in the input string. *)
@@ -363,7 +363,7 @@ let () =
 	| Item.Shift (Symbol.T tok, _)
 	  when Terminal.equal tok P.token ->
 	      shift + 1, reduce
-	| Item.Reduce prod
+	| Item.Reduce _
 	  when TerminalSet.mem P.token toks ->
 	    shift, reduce + 1
 	| _ ->
@@ -413,7 +413,7 @@ let () =
 	      let derivation = explain_shift_item P.source P.path item in
 	      Item.Map.add item derivation derivations
 
-	  | Item.Reduce prod
+	  | Item.Reduce _
 	    when TerminalSet.mem P.token toks ->
 
 	      still_looking_for_shift_item,

src/coqBackend.ml

@@ -253,7 +253,7 @@ module Run (T: sig end) = struct
 
   let write_init f =
     write_inductive_alphabet f "initstate" (
-      ProductionMap.fold (fun prod node l ->
+      ProductionMap.fold (fun _prod node l ->
 	(print_init node)::l) Lr1.entry []);
     fprintf f "Instance InitStateAlph : Alphabet initstate := _.\n\n"
 

src/derivation.ml

@@ -270,7 +270,7 @@ and common_forest cforest1 forest2 : cforest * cforest * forest =
    items, because this is convenient for the application that we have in mind,
    but this assumption is really irrelevant. *)
 
-let rec factor forests =
+let factor forests =
   match
     Item.Map.fold (fun item forest accu ->
       match accu with

src/dot.ml

@@ -123,6 +123,8 @@ end) = struct
     );
 
     G.iter (fun ?style ~label source ->
+      ignore style; (* avoid unused variable warnings *)
+      ignore label;
       G.successors (fun ?style ~label destination ->
 	fprintf f "%s %s %s [ label=\"%s\"%s ] ;\n"
 	  (G.name source)

src/fancy-parser.mly

@@ -83,11 +83,12 @@ declaration:
 
 | TOKEN OCAMLTYPE? clist(terminal) error
 | TOKEN OCAMLTYPE? error
-    { Error.error (Positions.two $startpos $endpos) "\
-Syntax error in a %token declaration.
-Here are sample valid declarations:
-  %token DOT SEMICOLON
-  %token <string> LID UID"
+    { Error.error (Positions.two $startpos $endpos) (String.concat "\n" [
+      "Syntax error in a %token declaration.";
+      "Here are sample valid declarations:";
+      "  %token DOT SEMICOLON";
+      "  %token <string> LID UID";
+      ])
     }
 
 | START t = OCAMLTYPE? nts = clist(nonterminal) %prec decl
@@ -103,11 +104,12 @@ Here are sample valid declarations:
 
 | START OCAMLTYPE? clist(nonterminal) error
 | START OCAMLTYPE? error
-    { Error.error (Positions.two $startpos $endpos) "\
-Syntax error in a %start declaration.
-Here are sample valid declarations:
-  %start expression phrase
-  %start <int> date time"
+    { Error.error (Positions.two $startpos $endpos) (String.concat "\n" [
+      "Syntax error in a %start declaration.";
+      "Here are sample valid declarations:";
+      "  %start expression phrase";
+      "  %start <int> date time";
+      ])
     }
 
 | TYPE t = OCAMLTYPE ss = clist(actual_parameter) %prec decl
@@ -117,11 +119,12 @@ Here are sample valid declarations:
 | TYPE OCAMLTYPE clist(actual_parameter) error
 | TYPE OCAMLTYPE error
 | TYPE error
-    { Error.error (Positions.two $startpos $endpos) "\
-Syntax error in a %type declaration.
-Here are sample valid declarations:
-  %type <Syntax.expression> expression
-  %type <int> date time"
+    { Error.error (Positions.two $startpos $endpos) (String.concat "\n" [
+      "Syntax error in a %type declaration.";
+      "Here are sample valid declarations:";
+      "  %type <Syntax.expression> expression";
+      "  %type <int> date time";
+      ])
     }
 
 | k = priority_keyword ss = clist(symbol) %prec decl
@@ -130,22 +133,24 @@ Here are sample valid declarations:
 
 | priority_keyword clist(symbol) error
 | priority_keyword error
-    { Error.error (Positions.two $startpos $endpos) "\
-Syntax error in a precedence declaration.
-Here are sample valid declarations:
-  %left PLUS TIMES
-  %nonassoc unary_minus
-  %right CONCAT"
+    { Error.error (Positions.two $startpos $endpos) (String.concat "\n" [
+      "Syntax error in a precedence declaration.";
+      "Here are sample valid declarations:";
+      "  %left PLUS TIMES";
+      "  %nonassoc unary_minus";
+      "  %right CONCAT";
+      ])
     }
 
 | PARAMETER t = OCAMLTYPE
     { [ with_poss $startpos $endpos (DParameter t) ] }
 
 | PARAMETER error
-    { Error.error (Positions.two $startpos $endpos) "\
-Syntax error in a %parameter declaration.
-Here is a sample valid declaration:
-  %parameter <X : sig type t end>"
+    { Error.error (Positions.two $startpos $endpos) (String.concat "\n" [
+      "Syntax error in a %parameter declaration.";
+      "Here is a sample valid declaration:";
+      "  %parameter <X : sig type t end>";
+      ])
     }
 
 | error

src/infer.ml

@@ -304,7 +304,7 @@ let depend grammar =
 	  ) dependencies in
 	  if List.length dependencies > 0 then begin
 	    Printf.printf "%s.ml %s.mli:" base base;
-	    List.iter (fun (basename, filename) ->
+	    List.iter (fun (_basename, filename) ->
 	      Printf.printf " %s" filename
 	    ) dependencies;
 	    Printf.printf "\n%!"

src/inliner.ml

@@ -9,7 +9,7 @@ open CodeBits
    checking against it in this way is quite cheap, and lets me sleep
    safely.) *)
 
-class locals table = object(self)
+class locals table = object
 
   method pvar (locals : StringSet.t) (id : string) =
     if Hashtbl.mem table id then StringSet.add id locals else locals
@@ -70,7 +70,7 @@ let inline ({ valdefs = defs } as p : program) =
     object
 	inherit [ StringSet.t, unit ] Traverse.fold
 	inherit locals table
-	method evar locals () id =
+	method! evar locals () id =
 	  visit locals id
     end
   in
@@ -203,7 +203,7 @@ let inline ({ valdefs = defs } as p : program) =
     object (self)
       inherit [ StringSet.t ] Traverse.map as super
       inherit locals table
-      method eapp locals e actuals =
+      method! eapp locals e actuals =
 	match e with
 	| EVar id when
 	    (Hashtbl.mem table id) &&       (* a global identifier *)

src/invariant.ml

@@ -33,7 +33,7 @@ let stack_symbols : Lr0.node -> Symbol.t array =
   in
   Misc.tabulate Lr0.n (fun node ->
     Item.Set.fold (fun item accu ->
-      let prod, nt, rhs, pos, length = Item.def item in
+      let _prod, _nt, rhs, pos, _length = Item.def item in
       if pos > Array.length accu then Array.sub rhs 0 pos else accu
     ) (Lr0.items node) dummy
   )
@@ -189,7 +189,7 @@ let stack_states : Lr1.node -> property =
 
 	empty
 
-    | Some symbol ->
+    | Some _symbol ->
 
 	(* If [node] is not a start state, then include the contribution of
 	   every incoming transition. We compute a join over all predecessors.
@@ -629,7 +629,7 @@ let rec require where symbol =
   end
 
 and require_aux where prod =
-  let nt, rhs = Production.def prod in
+  let _nt, rhs = Production.def prod in
   let length = Array.length rhs in
   if length > 0 then
     match where with

src/item.ml

@@ -44,10 +44,6 @@ let def t =
   assert ((pos >= 0) && (pos <= length));
   prod, nt, rhs, pos, length
 
-let nt t =
-  let _, nt, _, _, _ = def t in
-  nt
-
 let startnt t =
   let _, _, rhs, pos, length = def t in
   assert (pos = 0 && length = 1);
@@ -60,7 +56,7 @@ let startnt t =
 (* Printing. *)
 
 let print item =
-  let _, nt, rhs, pos, length = def item in
+  let _, nt, rhs, pos, _ = def item in
   Printf.sprintf "%s -> %s" (Nonterminal.print false nt) (Symbol.printaod 0 pos rhs)
 
 (* Classifying items. *)
@@ -154,7 +150,7 @@ module Closure (L : Lookahead.S) = struct
 
   let () =
     Production.iter (fun prod ->
-      let nt, rhs = Production.def prod in
+      let _nt, rhs = Production.def prod in
       let length = Array.length rhs in
       mapping.(Production.p2i prod) <- Array.init (length+1) (fun pos ->
 
@@ -194,7 +190,7 @@ module Closure (L : Lookahead.S) = struct
 
   let () =
     Production.iter (fun prod ->
-      let nt, rhs = Production.def prod in
+      let _nt, rhs = Production.def prod in
       let length = Array.length rhs in
       Array.iteri (fun pos node ->
 

src/lr1.ml

@@ -564,7 +564,7 @@ let () =
 
 		end
 
-	    | prod1 :: prod2 :: _ ->
+	    | _prod1 :: _prod2 :: _ ->
 
 		(* This is a shift/reduce/reduce conflict. If the priorities
 		   are such that each individual shift/reduce conflict is solved
@@ -616,7 +616,7 @@ let () =
 	      | []
 	      | [ _ ] ->
 		  ()
-	      | prod1 :: prod2 :: _ ->
+	      | _prod1 :: _prod2 :: _ ->
 
 		  (* There is no transition in addition to the reduction(s). We
 		     have a pure reduce/reduce conflict. Do nothing about it at
@@ -1043,7 +1043,7 @@ let default_conflict_resolution () =
       let has_ambiguity = ref false in
       let toks = ref TerminalSet.empty in
 
-      TerminalMap.iter (fun tok prods ->
+      TerminalMap.iter (fun tok _prods ->
 	node.reductions <- reductions;
 	has_ambiguity := true;
 	toks := TerminalSet.add tok !toks

src/misc.ml

@@ -264,7 +264,7 @@ let gcp s1 s2 =
 
 (* [gcps] returns the greatest common prefix of a nonempty list of strings. *)
 
-let rec gcps = function
+let gcps = function
   | [] ->
       assert false
   | s :: ss ->

src/myocamlbuild.ml

@@ -7,7 +7,9 @@ open Command
 
 let flags () =
   (* -inline 1000 *)
-  flag ["ocaml"; "compile"; "native"] (S [A "-inline"; A "1000"])
+  flag ["ocaml"; "compile"; "native"] (S [A "-inline"; A "1000"]);
+  (* nazi warnings *)
+  flag ["ocaml"; "compile"; "my_warnings"] (S[A "-w"; A "@1..49-4-9-33"])
 
 (* ---------------------------------------------------------------------------- *)
 

src/packedIntArray.ml

@@ -95,7 +95,7 @@ let pack (a : int array) : t =
 
     for j = 0 to n - 1 do
       let c = ref 0 in
-      for x = 1 to w do
+      for _x = 1 to w do
 	c := (!c lsl k) lor next()
       done;
       s.[j] <- Char.chr !c

src/parameterizedGrammar.ml

@@ -58,7 +58,8 @@ let string_of paren_fun ?paren ?colors t : string =
       "("^ s ^")"
     else s
 
-let rec paren_nt_type ((white, black) as colors) = function
+let rec paren_nt_type colors = function
+  (* [colors] is a pair [white, black] *)
     
     Arrow [] -> 
       "*", false
@@ -93,17 +94,23 @@ and paren_var (white, black) x =
 	  (s, p)
     end
 
-let string_of_nt_type ?paren ?colors t = 
+let string_of_nt_type ?colors t = 
+  (* TEMPORARY note: always called without a [colors] argument! *)
   string_of ?colors paren_nt_type t
 
-let string_of_var ?paren ?colors v = 
+let string_of_var ?colors v = 
+  (* TEMPORARY note: always called without a [colors] argument! *)
   string_of ?colors paren_var v
 
+(* for debugging:
+
 (* [print_env env] returns a string description of the typing environment. *)
 let print_env = 
   List.iter (fun (k, (_, v)) -> 
 	       Printf.eprintf "%s: %s\n" k (string_of_var v))
 
+*)
+
 (* [occurs_check x y] checks that [x] does not occur within [y]. *)
 
 let dfs action x =
@@ -154,8 +161,8 @@ let rec unify_var toplevel x y =
   if not (UnionFind.equivalent x y) then
     let reprx, repry = UnionFind.find x, UnionFind.find y in
       match reprx.structure, repry.structure with
-	  None, Some t    -> occurs_check x y; UnionFind.union x y
-	| Some t, None    -> occurs_check y x; UnionFind.union y x
+	  None, Some _    -> occurs_check x y; UnionFind.union x y
+	| Some _, None    -> occurs_check y x; UnionFind.union y x
 	| None, None      -> UnionFind.union x y
 	| Some t, Some t' -> unify toplevel t t'; UnionFind.union x y
 	    
@@ -254,7 +261,7 @@ let check_grammar p_grammar =
      is implemented by [successors]. Non terminals are indexed using
      [nt].
   *) 
-  let nt, conv, iconv = index_map p_grammar.p_rules in
+  let nt, conv, _iconv = index_map p_grammar.p_rules in
   let parameters, name, branches, positions = 
     (fun n -> (nt n).pr_parameters), (fun n -> (nt n).pr_nt),
     (fun n -> (nt n).pr_branches), (fun n -> (nt n).pr_positions)
@@ -456,11 +463,13 @@ let rec subst_parameter subst = function
 let subst_parameters subst = 
   List.map (subst_parameter subst)
 
+(* TEMPORARY why unused?
 let names_of_p_grammar p_grammar = 
   StringMap.fold (fun tok _ acu -> StringSet.add tok acu) 
     p_grammar.p_tokens StringSet.empty 
     $$ (StringMap.fold (fun nt _ acu -> StringSet.add nt acu)
 	  p_grammar.p_rules)
+*)
 
 let expand p_grammar = 
   (* Check that it is safe to expand this parameterized grammar. *)

src/partialGrammar.ml

@@ -260,9 +260,10 @@ let rename nonterminal filename =
 (* A nonterminal is considered public if it is declared using %public
    or %start. *)
 
+(* TEMPORARY why unused?
 let is_public grammar prule =
   prule.pr_public_flag || StringMap.mem prule.pr_nt grammar.p_start_symbols
-
+*)
 (* ------------------------------------------------------------------------- *)
 type symbol_kind =
     
@@ -275,29 +276,29 @@ type symbol_kind =
   (* The symbol is a token. *)
   | Token of token_properties
 
-  (* We do not know yet what does the symbol means. 
+  (* We do not know yet what the symbol means. 
      This is defined in the sequel or it is free in the partial grammar. *)
   | DontKnow of Positions.t
 
 type symbol_table =
     (symbol, symbol_kind) Hashtbl.t
 
-let find_symbol symbols symbol =
+let find_symbol (symbols : symbol_table) symbol =
   Hashtbl.find symbols symbol
 
-let add_in_symbol_table symbols symbol kind =
+let add_in_symbol_table (symbols : symbol_table) symbol kind =
   use_name symbol;
   Hashtbl.add symbols symbol kind;
   symbols
 
-let replace_in_symbol_table symbols symbol kind =
+let replace_in_symbol_table (symbols : symbol_table) symbol kind =
   Hashtbl.replace symbols symbol kind;
   symbols
 
-let empty_symbol_table () =
+let empty_symbol_table () : symbol_table =
   Hashtbl.create 13
 
-let store_symbol symbols symbol kind = 
+let store_symbol (symbols : symbol_table) symbol kind = 
   try
     let sym_info = find_symbol symbols symbol in
       match sym_info, kind with
@@ -361,6 +362,8 @@ let store_private_nonterminal tokens symbols symbol positions =
   non_terminal_is_not_a_token tokens symbol positions;
   store_symbol symbols symbol (PrivateNonTerminal (List.hd positions))
 
+(* for debugging, presumably:
+
 let string_of_kind = function
   | PublicNonTerminal p ->
       Printf.sprintf "public (%s)" (Positions.string_of_pos p)
@@ -386,6 +389,7 @@ let string_of_symbol_table t =
 		    (Printf.sprintf "%s: %s\n" 
 		       (fill_blank k) (string_of_kind v))) t;
     Buffer.contents b
+*)
 
 let is_private_symbol t x = 
   try
@@ -398,6 +402,7 @@ let is_private_symbol t x =
   with Not_found -> 
     false
 
+(* TEMPORARY why unused?
 let is_public_symbol t x = 
   try
     match Hashtbl.find t x with
@@ -408,6 +413,7 @@ let is_public_symbol t x =
 	  false
   with Not_found -> 
     false
+*)
 
 let fold_on_private_symbols f init t = 
   Hashtbl.fold 
@@ -466,7 +472,7 @@ let symbols_of grammar (pgrammar : ConcreteSyntax.grammar) =
   in
     List.fold_left symbols_of_rule (empty_symbol_table ()) pgrammar.pg_rules
 
-let merge_rules tokens symbols pgs = 
+let merge_rules symbols pgs = 
 
   (* Retrieve all the public symbols. *)
   let public_symbols =
@@ -495,7 +501,7 @@ let merge_rules tokens symbols pgs =
 	 else 
 	   (StringSet.add symbol defined, clashes))
   in 
-  let private_symbols, clashes = 
+  let _private_symbols, clashes = 
     List.fold_left detect_private_symbol_clashes (StringSet.empty, StringSet.empty) symbols
   in 
   let rpgs = List.map 
@@ -579,7 +585,7 @@ let join grammar pgrammar =
    bounds and that they are not used when symbols are explicitly
    named. Check also that no two symbols carry the same name. *)
 
-let check_keywords grammar producers action =
+let check_keywords producers action =
   let length = List.length producers in
     List.iter
       (function keyword ->
@@ -589,7 +595,7 @@ let check_keywords grammar producers action =
 	       if i < 1 || i > length then
 		 Error.errorp keyword
 		   (Printf.sprintf "$%d refers to a nonexistent symbol." i);
-	       let ido, param = List.nth producers (i - 1) in
+	       let ido, _ = List.nth producers (i - 1) in
 	       begin
 		 match ido with
 		   | Some { value = id } ->
@@ -603,7 +609,7 @@ let check_keywords grammar producers action =
 	       let found =
 		 ref false 
 	       in
-	       List.iter (fun (ido, param) ->
+	       List.iter (fun (ido, _) ->
 		 match ido with
 		 | Some { value = id' } when id = id' ->
 		     found := true
@@ -634,7 +640,7 @@ let check_parameterized_grammar_is_well_defined grammar =
 	      "the type of the start symbol %s is unspecified." nonterminal);
     ) grammar.p_start_symbols;
 
-  let rec parameter_head_symb = function
+  let parameter_head_symb = function
     | ParameterVar id -> id