Permalink
Browse files

Report where uninitialised variables are used.

  • Loading branch information...
xlq committed Sep 1, 2012
1 parent bb94c5e commit a72fb2d91f47721f7089f1936ca38d9608f24ba3
Showing with 73 additions and 31 deletions.
  1. +2 −2 backend_c.ml
  2. +45 −15 icode.ml
  3. +7 −2 icode.mli
  4. +2 −2 translation.ml
  5. +17 −10 type_checking.ml
View
@@ -166,10 +166,10 @@ let translate
declare_locals f subprogram_sym;
break f;
translate_block {tc_vars=entry_point.bl_in} f entry_point;
translate_block {tc_vars=Symbols.Maps.map snd entry_point.bl_in} f entry_point;
List.iter (fun block ->
if block != entry_point then
translate_block {tc_vars=block.bl_in} f block
translate_block {tc_vars=Symbols.Maps.map snd block.bl_in} f block
) blocks;
undent f;
puts f "}";
View
@@ -10,6 +10,10 @@ let new_block_id () =
type loc = Parse_tree.loc
type liveness_origin =
| Used_variable of Lexing.position
| From_parameters
type iterm =
| Null_term of loc
| Assignment_term of loc * symbol_v * expr * iterm
@@ -40,9 +44,9 @@ and block =
bl_id : int;
bl_statement : Parse_tree.statement;
mutable bl_body : iterm option;
mutable bl_free : Symbols.Sets.t;
mutable bl_free : liveness_origin Symbols.Maps.t;
mutable bl_preconditions: expr list;
mutable bl_in : symbol_v Symbols.Maps.t;
mutable bl_in : (liveness_origin * symbol_v) Symbols.Maps.t;
}
let rec dump_term (f: formatter) = function
@@ -82,14 +86,14 @@ let dump_block (f: formatter) (bl: block) =
puts f ("block" ^ string_of_int bl.bl_id ^ ":");
break f;
if not (Symbols.Maps.is_empty bl.bl_in) then begin
Symbols.Maps.iter (fun _ x ->
Symbols.Maps.iter (fun _ (_, x) ->
puts f ("| "
^ full_name_v x
^ ": " ^ string_of_type (unsome x.ver_type));
break f
) bl.bl_in
end else if not (Symbols.Sets.is_empty bl.bl_free) then begin
Symbols.Sets.iter (fun x ->
end else if not (Symbols.Maps.is_empty bl.bl_free) then begin
Symbols.Maps.iter (fun x origin ->
puts f ("| " ^ full_name x ^ ": <unknown>");
break f
) bl.bl_free
@@ -106,12 +110,38 @@ let dump_block (f: formatter) (bl: block) =
let dump_blocks (f: formatter) (blocks: block list) =
List.iter (dump_block f) blocks
let map_minus_set
(a: 'a Symbols.Maps.t)
(b: Symbols.Sets.t): 'a Symbols.Maps.t
=
Symbols.Sets.fold Symbols.Maps.remove b a
let equal_keys a b =
let rec compare = function
| [], [] -> true
| [], _ | _, [] -> false
| (x,_)::l, (x',_)::l' when x == x' -> compare (l, l')
| _::_, _::_ -> false
in compare (Symbols.Maps.bindings a, Symbols.Maps.bindings b)
let map_union_map =
Symbols.Maps.merge
(fun _ a b ->
match a, b with
| None, None -> None
| Some a, None -> Some a
| None, Some b -> Some b
| Some a, Some b ->
(* Choose one arbitrarily. *)
Some a
)
let calculate_free_names (blocks: block list): unit =
(* First pass: collect free and bound names. *)
let (jumps: (block * jump_info) list ref) = ref [] in
List.iter (fun block ->
let rec search (free: Symbols.Sets.t) (bound: Symbols.Sets.t):
iterm -> Symbols.Sets.t
let rec search (free: liveness_origin Symbols.Maps.t) (bound: Symbols.Sets.t):
iterm -> liveness_origin Symbols.Maps.t
= function
| Null_term _ | Inspect_type_term _ -> free
| Assignment_term(_,x,m,p) ->
@@ -144,22 +174,22 @@ let calculate_free_names (blocks: block list): unit =
search
(esearch free bound expr)
bound tail
and esearch (free: Symbols.Sets.t) (bound: Symbols.Sets.t):
expr -> Symbols.Sets.t
and esearch (free: liveness_origin Symbols.Maps.t) (bound: Symbols.Sets.t):
expr -> liveness_origin Symbols.Maps.t
= function
| Boolean_literal _ | Integer_literal _ -> free
| Var(_,x) ->
| Var(loc, x) ->
if Symbols.Sets.mem x bound then begin
(* x was bound further up. *)
free
end else begin
(* x is not bound - it was live at the start of this block. *)
Symbols.Sets.add x free
Symbols.Maps.add x (Used_variable loc) free
end
| Comparison(op, lhs, rhs) ->
esearch (esearch free bound lhs) bound rhs
in
block.bl_free <- search Symbols.Sets.empty Symbols.Sets.empty
block.bl_free <- search Symbols.Maps.empty Symbols.Sets.empty
(unsome block.bl_body)
) blocks;
@@ -169,16 +199,16 @@ let calculate_free_names (blocks: block list): unit =
changed := false;
List.iter (fun (block, jump) ->
let jump_free =
Symbols.Sets.diff
map_minus_set
jump.jmp_target.bl_free (* variables that are free in the jump target *)
jump.jmp_bound (* and are not bound above the jump in its block *)
in
let new_free =
Symbols.Sets.union
map_union_map
block.bl_free
jump_free
in
if not (Symbols.Sets.equal block.bl_free new_free) then begin
if not (equal_keys block.bl_free new_free) then begin
block.bl_free <- new_free;
changed := true
end
View
@@ -14,6 +14,11 @@ open Symbols
type loc = Parse_tree.loc
(* Reason why a variable is live at a particular point. *)
type liveness_origin =
| Used_variable of Lexing.position
| From_parameters
type iterm =
| Null_term of loc
| Assignment_term of loc * symbol_v (* destination *)
@@ -61,10 +66,10 @@ and block =
(* Set of free varibles in the body, with types.
Analogous to the variables that are
live when entering the block. *)
mutable bl_free : Symbols.Sets.t;
mutable bl_free : liveness_origin Symbols.Maps.t;
mutable bl_preconditions: expr list;
(* XXX: bl_free_types and bl_free are redundant! *)
mutable bl_in : symbol_v Symbols.Maps.t;
mutable bl_in : (liveness_origin * symbol_v) Symbols.Maps.t;
}
val new_block_id: unit -> int
View
@@ -138,7 +138,7 @@ let make_block
bl_id = new_block_id ();
bl_statement = statement;
bl_body = None;
bl_free = Symbols.Sets.empty;
bl_free = Symbols.Maps.empty;
bl_preconditions = [];
bl_in = Symbols.Maps.empty;
}
@@ -271,7 +271,7 @@ let translate_subprogram_prototype state context sub =
^ describe_symbol sym ^ ".");
raise Bail_out
in
let context = {context with
let context = {(*context with*)
ctx_scope = subprogram_sym;
ctx_after = None;
} in
View
@@ -35,6 +35,12 @@ let assert_unit t =
| Unit_type -> true
| _ -> false)
let report_liveness_origin sym = function
| Used_variable loc ->
Errors.semantic_error loc
(String.capitalize (describe_symbol sym)
^ " is used here.")
(* Get versions for the variables in the given expression.
I.e. change all Var to Var_version. *)
let rec bind_versions
@@ -264,14 +270,15 @@ let rec type_check
Unit_type
| Jump_term(jmp) ->
let preconditions = ref jmp.jmp_target.bl_preconditions in
Symbols.Maps.iter (fun x target ->
Symbols.Maps.iter (fun x (origin, target) ->
try
let source_version = try
Symbols.Maps.find x context.tc_vars
with Not_found ->
Errors.semantic_error jmp.jmp_location
(String.capitalize (describe_symbol x)
^ " must be initialised by now, but might not be.");
report_liveness_origin x origin;
raise Type_error
in
let t = coerce context (unsome source_version.ver_type) (unsome target.ver_type) in
@@ -394,14 +401,14 @@ let resolve_unknowns_in_type
let resolve_unknowns
(changed: bool ref)
(vars: symbol_v Symbols.Maps.t):
symbol_v Symbols.Maps.t
(vars: ('a * symbol_v) Symbols.Maps.t):
('a * symbol_v) Symbols.Maps.t
=
Symbols.Maps.map
(fun x ->
(fun (origin, x) ->
x.ver_type <-
Some (resolve_unknowns_in_type changed (unsome x.ver_type));
x)
(origin, x))
vars
let type_check_blocks
@@ -418,14 +425,14 @@ let type_check_blocks
(fun parameter_sym parameter_type ->
let param' = new_version parameter_sym in
param'.ver_type <- Some parameter_type;
param')
(From_parameters, param'))
parameters
end else begin
Symbols.Maps.empty
end
in
block.bl_in <-
Symbols.Sets.fold (fun x vars ->
Symbols.Maps.fold (fun x origin vars ->
if Symbols.Maps.mem x vars then begin
vars
end else begin
@@ -442,7 +449,7 @@ let type_check_blocks
unk_outgoing = []}
in
xv.ver_type <- Some t;
Symbols.Maps.add x xv vars
Symbols.Maps.add x (origin, xv) vars
end;
end
) block.bl_free initial_vars
@@ -458,10 +465,10 @@ let type_check_blocks
} in
let context = {
tc_pass = if !first_pass then Guessing_pass else Checking_pass;
tc_vars = block.bl_in;
tc_vars = Symbols.Maps.map snd block.bl_in;
tc_expected = Some Unit_type;
tc_facts = List.map
(bind_versions (fun x -> Symbols.Maps.find x block.bl_in))
(bind_versions (fun x -> snd (Symbols.Maps.find x block.bl_in)))
block.bl_preconditions;
} in
let t = type_check state context (unsome block.bl_body) in

0 comments on commit a72fb2d

Please sign in to comment.