Commit 7ccb8785 authored by Pietro Abate's avatar Pietro Abate

[r2003-05-10 17:49:06 by cvscast] Unused branches

Original author: cvscast
Date: 2003-05-10 17:49:06+00:00
parent 61f370d7
......@@ -137,7 +137,8 @@ let run ppf ppf_err input =
in
let type_decl decl =
insert_type_bindings (Typer.type_let_decl !typing_env decl)
insert_type_bindings (Typer.type_let_decl !typing_env decl);
Typer.report_unused_branches ()
in
let eval_decl decl =
......@@ -155,6 +156,7 @@ let run ppf ppf_err input =
| Ast.EvalStatement e ->
let (fv,e) = Typer.expr e in
let t = Typer.type_check !typing_env e Types.any true in
Typer.report_unused_branches ();
Location.dump_loc ppf e.Typed.exp_loc;
if not !quiet then
Format.fprintf ppf "|- %a@\n@." print_norm t;
......@@ -165,6 +167,7 @@ let run ppf ppf_err input =
| Ast.LetDecl (p,e) ->
let decl = Typer.let_decl p e in
type_decl decl;
Typer.report_unused_branches ();
eval_decl decl
| Ast.TypeDecl _ -> ()
| Ast.Debug l -> debug ppf l
......@@ -173,6 +176,7 @@ let run ppf ppf_err input =
let do_fun_decls decls =
let decls = List.map (fun (p,e) -> Typer.let_decl p e) decls in
Typer.report_unused_branches ();
insert_type_bindings (Typer.type_rec_funs !typing_env decls);
List.iter eval_decl decls
in
......
......@@ -2,6 +2,10 @@ type source = [ `None | `File of string | `Stream | `String of string ]
type loc = source * int * int
type viewport = [ `Html | `Text ]
let merge_loc ((s1,i1,j1) as loc1) (s2,i2,j2) =
if s1 = s2 then (s1, min i1 i2, max j1 j2)
else loc1
let source = ref `None
let source_stack = ref []
let push_source s = source_stack := !source :: !source_stack; source := s
......
......@@ -8,6 +8,8 @@ exception Generic of string
val noloc:loc
val nopos:int * int
val merge_loc: loc -> loc -> loc
val raise_loc: int -> int -> exn -> 'a
val raise_generic: string -> 'a
val raise_loc_generic: loc -> string -> 'a
......
......@@ -68,6 +68,7 @@ and branches = {
mutable br_compiled : compiled_branches option;
}
and branch = {
br_loc : loc;
mutable br_used : bool;
br_pat : tpat;
br_body : texpr
......
......@@ -479,6 +479,8 @@ let pat p =
module Fv = IdSet
let all_branches = ref []
(* IDEA: introduce a node Loc in the AST to override nolocs
in sub-expressions *)
......@@ -568,17 +570,22 @@ let rec expr loc' { loc = loc; descr = d } =
and branches loc b =
let fv = ref Fv.empty in
let accept = ref Types.empty in
let b = List.map
(fun (p,e) ->
let (fv2,e) = expr loc e in
let p = pat p in
let fv2 = Fv.diff fv2 (Patterns.fv p) in
fv := Fv.cup !fv fv2;
accept := Types.cup !accept (Types.descr (Patterns.accept p));
{ Typed.br_used = false;
Typed.br_pat = p;
Typed.br_body = e }
) b in
let branch (p,e) =
let br_loc = merge_loc p.loc e.loc in
let (fv2,e) = expr loc e in
let p = pat p in
let fv2 = Fv.diff fv2 (Patterns.fv p) in
fv := Fv.cup !fv fv2;
accept := Types.cup !accept (Types.descr (Patterns.accept p));
let br =
{
Typed.br_loc = br_loc;
Typed.br_used = br_loc = noloc;
Typed.br_pat = p;
Typed.br_body = e } in
all_branches := br :: !all_branches;
br in
let b = List.map branch b in
(!fv,
{
Typed.br_typ = Types.empty;
......@@ -1011,6 +1018,17 @@ and type_int_binop f loc1 t1 loc2 t2 =
(t2,Types.Int.any,
"The second argument must be an integer"));
Types.Int.put
(f (Types.Int.get t1) (Types.Int.get t2));
(f (Types.Int.get t1) (Types.Int.get t2))
let report_unused_branches () =
List.iter
(fun b ->
if not b.br_used then
warning b.br_loc "This branch is not used"
)
!all_branches;
all_branches := []
......@@ -27,3 +27,6 @@ val type_let_decl: env -> Typed.let_decl -> (id * Types.descr) list
val type_rec_funs: env -> Typed.let_decl list -> (id * Types.descr) list
(* Assume that all the expressions are Absstractions *)
val report_unused_branches : unit -> unit
(* Issue warnings for unused branches *)
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