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.
<{yacc-parser,fancy-parser}.mly>:origin_parser
......
......@@ -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
......
......@@ -269,25 +269,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, [])
......@@ -365,9 +346,6 @@ let insertif condition x =
let var x : expr =
EVar x
let vars xs =
List.map var xs
let pvar x : pattern =
PVar x
......@@ -827,7 +805,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
......@@ -1237,7 +1215,7 @@ let initiate covered s =
recovery can in fact not be performed, so no self-call to [action]
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
| Some (prod, toks) as defred ->
......
......@@ -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
......
......@@ -125,7 +125,7 @@ let symval symbol x =
match semvtype symbol with
| [] ->
[]
| [ t ] ->
| [ _t ] ->
[ x ]
| _ ->
assert false
......
......@@ -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 =
......
......@@ -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,
......
......@@ -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"
......
......@@ -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
......
......@@ -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)
......
......@@ -79,11 +79,12 @@ declaration:
| TOKEN OCAMLTYPE? clist(terminal) error
| TOKEN OCAMLTYPE? error
{ Error.signal (Positions.two $startpos $endpos) "\
Syntax error in a %token declaration.
Here are sample valid declarations:
%token DOT SEMICOLON
%token <string> LID UID";
{ Error.signal (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";
]);
[]
}
......@@ -100,11 +101,12 @@ Here are sample valid declarations:
| START OCAMLTYPE? clist(nonterminal) error
| START OCAMLTYPE? error
{ Error.signal (Positions.two $startpos $endpos) "\
Syntax error in a %start declaration.
Here are sample valid declarations:
%start expression phrase
%start <int> date time";
{ Error.signal (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";
]);
[]
}
......@@ -115,11 +117,12 @@ Here are sample valid declarations:
| TYPE OCAMLTYPE clist(actual_parameter) error
| TYPE OCAMLTYPE error
| TYPE error
{ Error.signal (Positions.two $startpos $endpos) "\
Syntax error in a %type declaration.
Here are sample valid declarations:
%type <Syntax.expression> expression
%type <int> date time";
{ Error.signal (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";
]);
[]
}
......@@ -129,12 +132,13 @@ Here are sample valid declarations:
| priority_keyword clist(symbol) error
| priority_keyword error
{ Error.signal (Positions.two $startpos $endpos) "\
Syntax error in a precedence declaration.
Here are sample valid declarations:
%left PLUS TIMES
%nonassoc unary_minus
%right CONCAT";
{ Error.signal (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";
]);
[]
}
......@@ -142,10 +146,11 @@ Here are sample valid declarations:
{ [ with_poss $startpos $endpos (DParameter t) ] }
| PARAMETER error
{ Error.signal (Positions.two $startpos $endpos) "\
Syntax error in a %parameter declaration.
Here is a sample valid declaration:
%parameter <X : sig type t end>";
{ Error.signal (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>";
]);
[]
}
......
......@@ -305,7 +305,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%!"
......
......@@ -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 *)
......
......@@ -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
......
......@@ -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 ->
......
......@@ -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
......
......@@ -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 ->
......
......@@ -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"])
(* ---------------------------------------------------------------------------- *)
......
......@@ -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
......
......@@ -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. *)
......
......@@ -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
......@@ -635,7 +641,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
| ParameterApp (id, _) -> id
in
......@@ -708,7 +714,7 @@ let check_parameterized_grammar_is_well_defined grammar =
) StringSet.empty producers);
check_keywords grammar producers action;
check_keywords producers action;
match sprec with
......@@ -759,5 +765,5 @@ let join_partial_grammars pgs =
let grammar = List.fold_left join empty_grammar pgs in
let symbols = List.map (symbols_of grammar) pgs in
let tpgs = List.combine symbols pgs in
let rules = merge_rules grammar.p_tokens symbols tpgs in
let rules = merge_rules symbols tpgs in
check_parameterized_grammar_is_well_defined { grammar with p_rules = rules }
......@@ -249,7 +249,7 @@ module Make (X : Endianness.S) = struct
[d]. If a binding already exists for [k], it is overridden. *)
let add k d m =
fine_add (fun old_binding new_binding -> new_binding) k d m
fine_add (fun _old_binding new_binding -> new_binding) k d m
(* [singleton k d] returns a map whose only binding is from [k] to [d]. *)
......@@ -415,7 +415,7 @@ module Make (X : Endianness.S) = struct
[m2]. Bindings in [m2] take precedence over those in [m1]. *)
let union m1 m2 =
fine_union (fun d d' -> d') m1 m2
fine_union (fun _d d' -> d') m1 m2
(* [iter f m] invokes [f k x], in turn, for each binding from key [k] to element [x] in the map [m]. Keys are
presented to [f] according to some unspecified, but fixed, order. *)
......@@ -593,17 +593,6 @@ module Domain = struct
let singleton x =
Leaf x
(* [is_singleton s] returns [Some x] if [s] is a singleton
containing [x] as its only element; otherwise, it returns
[None]. *)
let is_singleton = function
| Leaf x ->
Some x
| Empty
| Branch _ ->
None
(* [choose s] returns an arbitrarily chosen element of [s], if [s]
is nonempty, and raises [Not_found] otherwise. *)
......@@ -671,18 +660,6 @@ module Domain = struct
with Unchanged ->
s
(* [make2 x y] creates a set whose elements are [x] and [y]. [x] and [y] need not be distinct. *)
let make2 x y =
add x (Leaf y)
(* [fine_add] does not make much sense for sets of integers. Better warn the user. *)
type decision = int -> int -> int
let fine_add decision x s =
assert false
(* [remove x s] returns a set whose elements are all elements of [s], except [x]. *)
let remove x s =
......@@ -767,11 +744,6 @@ module Domain = struct
join p s q t
(* [fine_union] does not make much sense for sets of integers. Better warn the user. *)
let fine_union decision s1 s2 =
assert false
(* [build] is a ``smart constructor''. It builds a [Branch] node with the specified arguments, but ensures
that the newly created node does not have an [Empty] child. *)
......@@ -786,48 +758,6 @@ module Domain = struct
| _, _ ->
Branch(p, m, t0, t1)
(* [diff s t] returns the set difference of [s] and [t], that is, $s\setminus t$. *)
let rec diff s t =
match s, t with
| Empty, _
| _, Empty ->
s
| Leaf x, _ ->
if mem x t then Empty else s
| _, Leaf x ->
remove x s
| Branch(p, m, s0, s1), Branch(q, n, t0, t1) ->
if (p = q) && (m = n) then
(* The trees have the same prefix. Compute the differences of their sub-trees. *)
build p m (diff s0 t0) (diff s1 t1)
else if (X.shorter m n) && (match_prefix q p m) then
(* [q] contains [p]. Subtract [t] off a sub-tree of [s]. *)
if (q land m) = 0 then
build p m (diff s0 t) s1
else
build p m s0 (diff s1 t)
else if (X.shorter n m) && (match_prefix p q n) then
(* [p] contains [q]. Subtract a sub-tree of [t] off [s]. *)
diff s (if (p land n) = 0 then t0 else t1)
else
(* The prefixes disagree. *)
s
(* [inter s t] returns the set intersection of [s] and [t], that is, $s\cap t$. *)