Commit 17ce8432 authored by Pietro Abate's avatar Pietro Abate

[r2005-01-18 15:43:21 by afrisch] 'always return the empty sequence' warning

Original author: afrisch
Date: 2005-01-18 15:43:21+00:00
parent 4a0f8800
......@@ -185,7 +185,7 @@ let debug ppf tenv cenv = function
Types.Print.print (Types.descr t)
Patterns.Print.print (Patterns.descr p);
let f = Patterns.filter (Types.descr t) p in
List.iter (fun (x,t) ->
IdMap.iteri (fun x t ->
Format.fprintf ppf " %a:%a@." U.print (Id.value x)
print_norm (Types.descr t)) f
| `Accept p ->
......
......@@ -51,6 +51,8 @@ let get_line_number src i =
let lb = Ulexing.from_var_enc_channel enc ic in
let rec count line start = lexer
| '\n' | "\n\r" | '\r' ->
if (Ulexing.lexeme_start lb >= i) then (line, i - start)
else
aux (line + 1) (Ulexing.lexeme_end lb)
| "#utf8" ->
enc := Ulexing.Utf8;
......
......@@ -439,8 +439,7 @@ and filter_node t p : Types.Positive.v id_map =
let filter t p =
let r = filter_node t p in
memo_filter := MemoFilter.empty;
IdMap.get (IdMap.map Types.Positive.solve r)
IdMap.map Types.Positive.solve r
let filter_descr t p =
let r = filter_descr t p in
memo_filter := MemoFilter.empty;
......
......@@ -34,7 +34,7 @@ end
(* Pattern matching: static semantics *)
val accept : node -> Types.Node.t
val filter : Types.t -> node -> (id * Types.Node.t) list
val filter : Types.t -> node -> Types.Node.t id_map
(* Pattern matching: compilation *)
......
......@@ -81,6 +81,7 @@ and branches = {
and branch = {
br_loc : loc;
mutable br_used : bool;
mutable br_vars_empty : fv;
br_pat : tpat;
br_body : texpr
}
......
......@@ -1109,6 +1109,7 @@ and branches env b =
{
Typed.br_loc = br_loc;
Typed.br_used = br_loc = noloc;
Typed.br_vars_empty = Patterns.fv p';
Typed.br_pat = p';
Typed.br_body = e } in
cur_branch := Branch (br, !cur_branch) :: cur_br;
......@@ -1390,8 +1391,14 @@ and branches_aux loc env targ tres constr precise = function
else
( b.br_used <- true;
let res = Patterns.filter targ' p in
let res = List.map (fun (x,t) -> (x,Types.descr t)) res in
let env' = enter_values res env in
let res = IdMap.map Types.descr res in
b.br_vars_empty <-
IdMap.domain (
IdMap.filter (fun x t -> Types.subtype t Sequence.nil_type)
(IdMap.restrict res b.br_vars_empty));
let env' = enter_values (IdMap.get res) env in
let t = type_check env' b.br_body constr precise in
let tres = if precise then Types.cup t tres else tres in
let targ'' = Types.diff targ acc in
......@@ -1426,7 +1433,7 @@ and type_let_decl env l =
let acc = Types.descr (Patterns.accept l.let_pat) in
let t = type_check env l.let_body acc true in
let res = Patterns.filter t l.let_pat in
List.map (fun (x,t) -> (x, Types.descr t)) res
IdMap.mapi_to_list (fun x t -> (x, Types.descr t)) res
and type_rec_funs env l =
let typs =
......@@ -1449,7 +1456,27 @@ let rec unused_branches b =
(fun (Branch (br,s)) ->
if not br.br_used
then warning br.br_loc "This branch is not used"
else unused_branches s
else (
if not (IdSet.is_empty br.br_vars_empty)
then (
let msg =
try
let l =
List.map
(fun x ->
let x = Ident.to_string x in
if x = "$$$" then raise Exit else x)
(IdSet.get br.br_vars_empty) in
let l = String.concat "," l in
"The following variables always match the empty sequence: " ^
l
with Exit ->
"This projection always returns the empty sequence"
in
warning br.br_loc msg
);
unused_branches s
)
)
b
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment