Commit 99fd6612 authored by POTTIER Francois's avatar POTTIER Francois

Enabled nazi warnings.

A lot of cosmetic changes in order to avoid warnings (mostly unused variables).
parent 2c1983e7
# Enable Jonathan's "nazi warnings".
<*>: my_warnings
# Tag both parser source files with origin_parser. # Tag both parser source files with origin_parser.
<{yacc-parser,fancy-parser}.mly>:origin_parser <{yacc-parser,fancy-parser}.mly>:origin_parser
......
...@@ -97,7 +97,7 @@ let rename_pkeywords (psym, first_prod, last_prod) phi l = ...@@ -97,7 +97,7 @@ let rename_pkeywords (psym, first_prod, last_prod) phi l =
(* Similarly for $endpos. *) (* Similarly for $endpos. *)
| Left, WhereEnd -> last_prod, (used1, true) | Left, WhereEnd -> last_prod, (used1, true)
(* $i cannot be combined with inlining. *) (* $i cannot be combined with inlining. *)
| RightDollar i, w -> assert false | RightDollar _, _ -> assert false
| RightNamed s, w -> | RightNamed s, w ->
(* In the host rule, $startpos(x) is changed to (* In the host rule, $startpos(x) is changed to
to $startpos(first_prod) (same thing for $endpos). *) to $startpos(first_prod) (same thing for $endpos). *)
...@@ -118,7 +118,7 @@ let rename_pkeywords (psym, first_prod, last_prod) phi l = ...@@ -118,7 +118,7 @@ let rename_pkeywords (psym, first_prod, last_prod) phi l =
(from_pos, to_pos) :: phi else phi), (from_pos, to_pos) :: phi else phi),
(used1, used2)) (used1, used2))
| x -> pk :: l, phi, (used1, used2)) | _ -> pk :: l, phi, (used1, used2))
([], phi, (false, false)) l ([], phi, (false, false)) l
...@@ -159,7 +159,7 @@ let keywords action = ...@@ -159,7 +159,7 @@ let keywords action =
let pkeywords action = let pkeywords action =
action.pkeywords action.pkeywords
let rec print f action = let print f action =
let module P = Printer.Make (struct let f = f let module P = Printer.Make (struct let f = f
let locate_stretches = None let locate_stretches = None
let raw_stretch_action = true let raw_stretch_action = true
......
...@@ -269,25 +269,6 @@ let statecon s = ...@@ -269,25 +269,6 @@ let statecon s =
let estatecon s = let estatecon s =
EData (statecon 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 = let pstatecon s =
PData (statecon s, []) PData (statecon s, [])
...@@ -365,9 +346,6 @@ let insertif condition x = ...@@ -365,9 +346,6 @@ let insertif condition x =
let var x : expr = let var x : expr =
EVar x EVar x
let vars xs =
List.map var xs
let pvar x : pattern = let pvar x : pattern =
PVar x PVar x
...@@ -827,7 +805,7 @@ let reducecellparams prod i holds_state symbol = ...@@ -827,7 +805,7 @@ let reducecellparams prod i holds_state symbol =
used in the semantic action, then it is dropped using a wildcard used in the semantic action, then it is dropped using a wildcard
pattern. *) pattern. *)
let semvpat t = let semvpat _t =
if used.(i) then if used.(i) then
PVar ids.(i) PVar ids.(i)
else else
...@@ -1237,7 +1215,7 @@ let initiate covered s = ...@@ -1237,7 +1215,7 @@ let initiate covered s =
recovery can in fact not be performed, so no self-call to [action] recovery can in fact not be performed, so no self-call to [action]
will be generated and [action] will be inlined into [run]. *) will be generated and [action] will be inlined into [run]. *)
let rec runactiondef s : valdef list = let runactiondef s : valdef list =
match Invariant.has_default_reduction s with match Invariant.has_default_reduction s with
| Some (prod, toks) as defred -> | Some (prod, toks) as defred ->
......
...@@ -79,7 +79,7 @@ let rec simplify = function ...@@ -79,7 +79,7 @@ let rec simplify = function
(* Building a [let] construct, with on-the-fly simplification. *) (* Building a [let] construct, with on-the-fly simplification. *)
let rec blet (bindings, body) = let blet (bindings, body) =
match simplify bindings with match simplify bindings with
| [] -> | [] ->
body body
......
...@@ -125,7 +125,7 @@ let symval symbol x = ...@@ -125,7 +125,7 @@ let symval symbol x =
match semvtype symbol with match semvtype symbol with
| [] -> | [] ->
[] []
| [ t ] -> | [ _t ] ->
[ x ] [ x ]
| _ -> | _ ->
assert false assert false
......
...@@ -192,7 +192,7 @@ let rec compare s1 s2 = ...@@ -192,7 +192,7 @@ let rec compare s1 s2 =
else if ss1 > ss2 then 1 else if ss1 > ss2 then 1
else compare qs1 qs2 else compare qs1 qs2
let rec equal s1 s2 = let equal s1 s2 =
compare s1 s2 = 0 compare s1 s2 = 0
let rec disjoint s1 s2 = let rec disjoint s1 s2 =
......
...@@ -287,7 +287,7 @@ let explain_reduce_item ...@@ -287,7 +287,7 @@ let explain_reduce_item
(* Otherwise, explore the transitions out of this 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 (* Shift transition, followed only if the symbol matches
the symbol found in the input string. *) the symbol found in the input string. *)
...@@ -363,7 +363,7 @@ let () = ...@@ -363,7 +363,7 @@ let () =
| Item.Shift (Symbol.T tok, _) | Item.Shift (Symbol.T tok, _)
when Terminal.equal tok P.token -> when Terminal.equal tok P.token ->
shift + 1, reduce shift + 1, reduce
| Item.Reduce prod | Item.Reduce _
when TerminalSet.mem P.token toks -> when TerminalSet.mem P.token toks ->
shift, reduce + 1 shift, reduce + 1
| _ -> | _ ->
...@@ -413,7 +413,7 @@ let () = ...@@ -413,7 +413,7 @@ let () =
let derivation = explain_shift_item P.source P.path item in let derivation = explain_shift_item P.source P.path item in
Item.Map.add item derivation derivations Item.Map.add item derivation derivations
| Item.Reduce prod | Item.Reduce _
when TerminalSet.mem P.token toks -> when TerminalSet.mem P.token toks ->
still_looking_for_shift_item, still_looking_for_shift_item,
......
...@@ -253,7 +253,7 @@ module Run (T: sig end) = struct ...@@ -253,7 +253,7 @@ module Run (T: sig end) = struct
let write_init f = let write_init f =
write_inductive_alphabet f "initstate" ( write_inductive_alphabet f "initstate" (
ProductionMap.fold (fun prod node l -> ProductionMap.fold (fun _prod node l ->
(print_init node)::l) Lr1.entry []); (print_init node)::l) Lr1.entry []);
fprintf f "Instance InitStateAlph : Alphabet initstate := _.\n\n" fprintf f "Instance InitStateAlph : Alphabet initstate := _.\n\n"
......
...@@ -270,7 +270,7 @@ and common_forest cforest1 forest2 : cforest * cforest * forest = ...@@ -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, items, because this is convenient for the application that we have in mind,
but this assumption is really irrelevant. *) but this assumption is really irrelevant. *)
let rec factor forests = let factor forests =
match match
Item.Map.fold (fun item forest accu -> Item.Map.fold (fun item forest accu ->
match accu with match accu with
......
...@@ -123,6 +123,8 @@ end) = struct ...@@ -123,6 +123,8 @@ end) = struct
); );
G.iter (fun ?style ~label source -> G.iter (fun ?style ~label source ->
ignore style; (* avoid unused variable warnings *)
ignore label;
G.successors (fun ?style ~label destination -> G.successors (fun ?style ~label destination ->
fprintf f "%s %s %s [ label=\"%s\"%s ] ;\n" fprintf f "%s %s %s [ label=\"%s\"%s ] ;\n"
(G.name source) (G.name source)
......
...@@ -79,11 +79,12 @@ declaration: ...@@ -79,11 +79,12 @@ declaration:
| TOKEN OCAMLTYPE? clist(terminal) error | TOKEN OCAMLTYPE? clist(terminal) error
| TOKEN OCAMLTYPE? error | TOKEN OCAMLTYPE? error
{ Error.signal (Positions.two $startpos $endpos) "\ { Error.signal (Positions.two $startpos $endpos) (String.concat "\n" [
Syntax error in a %token declaration. "Syntax error in a %token declaration.";
Here are sample valid declarations: "Here are sample valid declarations:";
%token DOT SEMICOLON " %token DOT SEMICOLON";
%token <string> LID UID"; " %token <string> LID UID";
]);
[] []
} }
...@@ -100,11 +101,12 @@ Here are sample valid declarations: ...@@ -100,11 +101,12 @@ Here are sample valid declarations:
| START OCAMLTYPE? clist(nonterminal) error | START OCAMLTYPE? clist(nonterminal) error
| START OCAMLTYPE? error | START OCAMLTYPE? error
{ Error.signal (Positions.two $startpos $endpos) "\ { Error.signal (Positions.two $startpos $endpos) (String.concat "\n" [
Syntax error in a %start declaration. "Syntax error in a %start declaration.";
Here are sample valid declarations: "Here are sample valid declarations:";
%start expression phrase " %start expression phrase";
%start <int> date time"; " %start <int> date time";
]);
[] []
} }
...@@ -115,11 +117,12 @@ Here are sample valid declarations: ...@@ -115,11 +117,12 @@ Here are sample valid declarations:
| TYPE OCAMLTYPE clist(actual_parameter) error | TYPE OCAMLTYPE clist(actual_parameter) error
| TYPE OCAMLTYPE error | TYPE OCAMLTYPE error
| TYPE error | TYPE error
{ Error.signal (Positions.two $startpos $endpos) "\ { Error.signal (Positions.two $startpos $endpos) (String.concat "\n" [
Syntax error in a %type declaration. "Syntax error in a %type declaration.";
Here are sample valid declarations: "Here are sample valid declarations:";
%type <Syntax.expression> expression " %type <Syntax.expression> expression";
%type <int> date time"; " %type <int> date time";
]);
[] []
} }
...@@ -129,12 +132,13 @@ Here are sample valid declarations: ...@@ -129,12 +132,13 @@ Here are sample valid declarations:
| priority_keyword clist(symbol) error | priority_keyword clist(symbol) error
| priority_keyword error | priority_keyword error
{ Error.signal (Positions.two $startpos $endpos) "\ { Error.signal (Positions.two $startpos $endpos) (String.concat "\n" [
Syntax error in a precedence declaration. "Syntax error in a precedence declaration.";
Here are sample valid declarations: "Here are sample valid declarations:";
%left PLUS TIMES " %left PLUS TIMES";
%nonassoc unary_minus " %nonassoc unary_minus";
%right CONCAT"; " %right CONCAT";
]);
[] []
} }
...@@ -142,10 +146,11 @@ Here are sample valid declarations: ...@@ -142,10 +146,11 @@ Here are sample valid declarations:
{ [ with_poss $startpos $endpos (DParameter t) ] } { [ with_poss $startpos $endpos (DParameter t) ] }
| PARAMETER error | PARAMETER error
{ Error.signal (Positions.two $startpos $endpos) "\ { Error.signal (Positions.two $startpos $endpos) (String.concat "\n" [
Syntax error in a %parameter declaration. "Syntax error in a %parameter declaration.";
Here is a sample valid declaration: "Here is a sample valid declaration:";
%parameter <X : sig type t end>"; " %parameter <X : sig type t end>";
]);
[] []
} }
......
...@@ -305,7 +305,7 @@ let depend grammar = ...@@ -305,7 +305,7 @@ let depend grammar =
) dependencies in ) dependencies in
if List.length dependencies > 0 then begin if List.length dependencies > 0 then begin
Printf.printf "%s.ml %s.mli:" base base; Printf.printf "%s.ml %s.mli:" base base;
List.iter (fun (basename, filename) -> List.iter (fun (_basename, filename) ->
Printf.printf " %s" filename Printf.printf " %s" filename
) dependencies; ) dependencies;
Printf.printf "\n%!" Printf.printf "\n%!"
......
...@@ -9,7 +9,7 @@ open CodeBits ...@@ -9,7 +9,7 @@ open CodeBits
checking against it in this way is quite cheap, and lets me sleep checking against it in this way is quite cheap, and lets me sleep
safely.) *) safely.) *)
class locals table = object(self) class locals table = object
method pvar (locals : StringSet.t) (id : string) = method pvar (locals : StringSet.t) (id : string) =
if Hashtbl.mem table id then StringSet.add id locals else locals if Hashtbl.mem table id then StringSet.add id locals else locals
...@@ -70,7 +70,7 @@ let inline ({ valdefs = defs } as p : program) = ...@@ -70,7 +70,7 @@ let inline ({ valdefs = defs } as p : program) =
object object
inherit [ StringSet.t, unit ] Traverse.fold inherit [ StringSet.t, unit ] Traverse.fold
inherit locals table inherit locals table
method evar locals () id = method! evar locals () id =
visit locals id visit locals id
end end
in in
...@@ -203,7 +203,7 @@ let inline ({ valdefs = defs } as p : program) = ...@@ -203,7 +203,7 @@ let inline ({ valdefs = defs } as p : program) =
object (self) object (self)
inherit [ StringSet.t ] Traverse.map as super inherit [ StringSet.t ] Traverse.map as super
inherit locals table inherit locals table
method eapp locals e actuals = method! eapp locals e actuals =
match e with match e with
| EVar id when | EVar id when
(Hashtbl.mem table id) && (* a global identifier *) (Hashtbl.mem table id) && (* a global identifier *)
......
...@@ -33,7 +33,7 @@ let stack_symbols : Lr0.node -> Symbol.t array = ...@@ -33,7 +33,7 @@ let stack_symbols : Lr0.node -> Symbol.t array =
in in
Misc.tabulate Lr0.n (fun node -> Misc.tabulate Lr0.n (fun node ->
Item.Set.fold (fun item accu -> 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 if pos > Array.length accu then Array.sub rhs 0 pos else accu
) (Lr0.items node) dummy ) (Lr0.items node) dummy
) )
...@@ -189,7 +189,7 @@ let stack_states : Lr1.node -> property = ...@@ -189,7 +189,7 @@ let stack_states : Lr1.node -> property =
empty empty
| Some symbol -> | Some _symbol ->
(* If [node] is not a start state, then include the contribution of (* If [node] is not a start state, then include the contribution of
every incoming transition. We compute a join over all predecessors. every incoming transition. We compute a join over all predecessors.
...@@ -629,7 +629,7 @@ let rec require where symbol = ...@@ -629,7 +629,7 @@ let rec require where symbol =
end end
and require_aux where prod = 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 let length = Array.length rhs in
if length > 0 then if length > 0 then
match where with match where with
......
...@@ -44,10 +44,6 @@ let def t = ...@@ -44,10 +44,6 @@ let def t =
assert ((pos >= 0) && (pos <= length)); assert ((pos >= 0) && (pos <= length));
prod, nt, rhs, pos, length prod, nt, rhs, pos, length
let nt t =
let _, nt, _, _, _ = def t in
nt
let startnt t = let startnt t =
let _, _, rhs, pos, length = def t in let _, _, rhs, pos, length = def t in
assert (pos = 0 && length = 1); assert (pos = 0 && length = 1);
...@@ -60,7 +56,7 @@ let startnt t = ...@@ -60,7 +56,7 @@ let startnt t =
(* Printing. *) (* Printing. *)
let print item = 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) Printf.sprintf "%s -> %s" (Nonterminal.print false nt) (Symbol.printaod 0 pos rhs)
(* Classifying items. *) (* Classifying items. *)
...@@ -154,7 +150,7 @@ module Closure (L : Lookahead.S) = struct ...@@ -154,7 +150,7 @@ module Closure (L : Lookahead.S) = struct
let () = let () =
Production.iter (fun prod -> Production.iter (fun prod ->
let nt, rhs = Production.def prod in let _nt, rhs = Production.def prod in
let length = Array.length rhs in let length = Array.length rhs in
mapping.(Production.p2i prod) <- Array.init (length+1) (fun pos -> mapping.(Production.p2i prod) <- Array.init (length+1) (fun pos ->
...@@ -194,7 +190,7 @@ module Closure (L : Lookahead.S) = struct ...@@ -194,7 +190,7 @@ module Closure (L : Lookahead.S) = struct
let () = let () =
Production.iter (fun prod -> Production.iter (fun prod ->
let nt, rhs = Production.def prod in let _nt, rhs = Production.def prod in
let length = Array.length rhs in let length = Array.length rhs in
Array.iteri (fun pos node -> Array.iteri (fun pos node ->
......
...@@ -564,7 +564,7 @@ let () = ...@@ -564,7 +564,7 @@ let () =
end end
| prod1 :: prod2 :: _ -> | _prod1 :: _prod2 :: _ ->
(* This is a shift/reduce/reduce conflict. If the priorities (* This is a shift/reduce/reduce conflict. If the priorities
are such that each individual shift/reduce conflict is solved are such that each individual shift/reduce conflict is solved
...@@ -616,7 +616,7 @@ let () = ...@@ -616,7 +616,7 @@ let () =
| [] | []
| [ _ ] -> | [ _ ] ->
() ()
| prod1 :: prod2 :: _ -> | _prod1 :: _prod2 :: _ ->
(* There is no transition in addition to the reduction(s). We (* There is no transition in addition to the reduction(s). We
have a pure reduce/reduce conflict. Do nothing about it at have a pure reduce/reduce conflict. Do nothing about it at
...@@ -1043,7 +1043,7 @@ let default_conflict_resolution () = ...@@ -1043,7 +1043,7 @@ let default_conflict_resolution () =
let has_ambiguity = ref false in let has_ambiguity = ref false in
let toks = ref TerminalSet.empty in let toks = ref TerminalSet.empty in
TerminalMap.iter (fun tok prods -> TerminalMap.iter (fun tok _prods ->
node.reductions <- reductions; node.reductions <- reductions;
has_ambiguity := true; has_ambiguity := true;
toks := TerminalSet.add tok !toks toks := TerminalSet.add tok !toks
......
...@@ -264,7 +264,7 @@ let gcp s1 s2 = ...@@ -264,7 +264,7 @@ let gcp s1 s2 =
(* [gcps] returns the greatest common prefix of a nonempty list of strings. *) (* [gcps] returns the greatest common prefix of a nonempty list of strings. *)
let rec gcps = function let gcps = function
| [] -> | [] ->
assert false assert false
| s :: ss -> | s :: ss ->
......
...@@ -7,7 +7,9 @@ open Command ...@@ -7,7 +7,9 @@ open Command
let flags () = let flags () =
(* -inline 1000 *) (* -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"])
(* ---------------------------------------------------------------------------- *) (* ---------------------------------------------------------------------------- *)
......
...@@ -95,7 +95,7 @@ let pack (a : int array) : t = ...@@ -95,7 +95,7 @@ let pack (a : int array) : t =
for j = 0 to n - 1 do for j = 0 to n - 1 do
let c = ref 0 in let c = ref 0 in
for x = 1 to w do for _x = 1 to w do
c := (!c lsl k) lor next() c := (!c lsl k) lor next()
done; done;
s.[j] <- Char.chr !c s.[j] <- Char.chr !c
......
...@@ -58,7 +58,8 @@ let string_of paren_fun ?paren ?colors t : string = ...@@ -58,7 +58,8 @@ let string_of paren_fun ?paren ?colors t : string =
"("^ s ^")" "("^ s ^")"
else 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 [] -> Arrow [] ->
"*", false "*", false
...@@ -93,17 +94,23 @@ and paren_var (white, black) x = ...@@ -93,17 +94,23 @@ and paren_var (white, black) x =
(s, p) (s, p)
end 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 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 string_of ?colors paren_var v
(* for debugging:
(* [print_env env] returns a string description of the typing environment. *) (* [print_env env] returns a string description of the typing environment. *)
let print_env = let print_env =
List.iter (fun (k, (_, v)) -> List.iter (fun (k, (_, v)) ->
Printf.eprintf "%s: %s\n" k (string_of_var v)) Printf.eprintf "%s: %s\n" k (string_of_var v))
*)
(* [occurs_check x y] checks that [x] does not occur within [y]. *) (* [occurs_check x y] checks that [x] does not occur within [y]. *)
let dfs action x = let dfs action x =
...@@ -154,8 +161,8 @@ let rec unify_var toplevel x y = ...@@ -154,8 +161,8 @@ let rec unify_var toplevel x y =
if not (UnionFind.equivalent x y) then if not (UnionFind.equivalent x y) then
let reprx, repry = UnionFind.find x, UnionFind.find y in let reprx, repry = UnionFind.find x, UnionFind.find y in
match reprx.structure, repry.structure with match reprx.structure, repry.structure with
None, Some t -> occurs_check x y; UnionFind.union x y None, Some _ -> occurs_check x y; UnionFind.union x y
| Some t, None -> occurs_check y x; UnionFind.union y x | Some _, None -> occurs_check y x; UnionFind.union y x
| None, None -> UnionFind.union x y | None, None -> UnionFind.union x y
| Some t, Some t' -> unify toplevel t t'; 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 = ...@@ -254,7 +261,7 @@ let check_grammar p_grammar =
is implemented by [successors]. Non terminals are indexed using is implemented by [successors]. Non terminals are indexed using
[nt]. [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 = let parameters, name, branches, positions =
(fun n -> (nt n).pr_parameters), (fun n -> (nt n).pr_nt), (fun n -> (nt n).pr_parameters), (fun n -> (nt n).pr_nt),
(fun n -> (nt n).pr_branches), (fun n -> (nt n).pr_positions) (fun n -> (nt n).pr_branches), (fun n -> (nt n).pr_positions)
...@@ -456,11 +463,13 @@ let rec subst_parameter subst = function ...@@ -456,11 +463,13 @@ let rec subst_parameter subst = function
let subst_parameters subst = let subst_parameters subst =
List.map (subst_parameter subst) List.map (subst_parameter subst)
(* TEMPORARY why unused?
let names_of_p_grammar p_grammar = let names_of_p_grammar p_grammar =
StringMap.fold (fun tok _ acu -> StringSet.add tok acu)