Permalink
Browse files

Store types in symbol_v.

This makes the types available to the back end.
  • Loading branch information...
xlq committed Aug 31, 2012
1 parent 1704cae commit f49b024f9a47ffa0aa0425d4cb46c4be5987f9eb
Showing with 34 additions and 26 deletions.
  1. +3 −3 icode.ml
  2. +1 −1 icode.mli
  3. +8 −4 symbols.ml
  4. +2 −1 symbols.mli
  5. +20 −17 type_checking.ml
@@ -40,7 +40,7 @@ and block =
mutable bl_body : iterm option;
mutable bl_free : Symbols.Sets.t;
mutable bl_preconditions: expr list;
mutable bl_in : (ttype * symbol_v) Symbols.Maps.t;
mutable bl_in : symbol_v Symbols.Maps.t;
}
let rec dump_term (f: formatter) = function
@@ -80,10 +80,10 @@ 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 _ (t, x) ->
Symbols.Maps.iter (fun _ x ->
puts f ("| "
^ full_name_v x
^ ": " ^ string_of_type t);
^ ": " ^ string_of_type x.ver_type);
break f
) bl.bl_in
end else if not (Symbols.Sets.is_empty bl.bl_free) then begin
@@ -60,7 +60,7 @@ and block =
mutable bl_free : Symbols.Sets.t;
mutable bl_preconditions: expr list;
(* XXX: bl_free_types and bl_free are redundant! *)
mutable bl_in : (ttype * symbol_v) Symbols.Maps.t;
mutable bl_in : symbol_v Symbols.Maps.t;
}
val new_block_id: unit -> int
@@ -35,6 +35,7 @@ and symbol = {
and symbol_v = {
ver_symbol : symbol;
ver_number : int;
mutable ver_type : ttype;
}
and symbol_info =
@@ -149,11 +150,14 @@ let new_symbol scope name info =
scope.sym_children <- new_sym :: scope.sym_children;
new_sym
let new_version sym =
let new_version sym t =
let sym_v = {
ver_symbol = sym;
ver_number = (List.fold_left
(fun a b -> max a b.ver_number) 0 sym.sym_versions) + 1;
ver_symbol = sym;
ver_number =
(match sym.sym_versions with
| [] -> 1
| x::_ -> x.ver_number + 1);
ver_type = t;
} in
sym.sym_versions <- sym_v :: sym.sym_versions;
sym_v
@@ -49,6 +49,7 @@ and symbol = {
and symbol_v = {
ver_symbol : symbol;
ver_number : int; (* for dumping and ordering *)
mutable ver_type : ttype;
}
and symbol_info =
@@ -78,7 +79,7 @@ val string_of_expr : expr -> string
val describe_symbol : symbol -> string
val find_in : symbol -> string -> symbol option
val new_symbol : symbol -> string -> symbol_info -> symbol
val new_version : symbol -> symbol_v
val new_version : symbol -> ttype -> symbol_v
val find : symbol -> string -> symbol option
val find_variable : symbol -> string -> symbol
val dump_symbols : unit -> unit
@@ -13,7 +13,7 @@ type context = {
(* The current pass. *)
tc_pass : pass;
(* The types and current versions of variables. *)
tc_vars : (ttype * symbol_v) Symbols.Maps.t;
tc_vars : symbol_v Symbols.Maps.t;
(* The type that's expected of the term or expression being
typed under this context. *)
tc_expected : ttype option;
@@ -193,8 +193,8 @@ let rec type_check_expr
let t = got_type context Integer_type in
Integer_literal(i), t
| Var(x) ->
let t, x' = Symbols.Maps.find x context.tc_vars in
let t = got_type context t in
let x' = Symbols.Maps.find x context.tc_vars in
let t = got_type context x'.ver_type in
Var_v(x'), t
| Comparison(op, lhs, rhs) ->
let operand_context = {context with tc_expected = None} in
@@ -217,12 +217,12 @@ let rec type_check
{context with tc_expected = None}
src
in
let dest_version = new_version dest in
let dest_version = new_version dest src_type in
type_check
state
{context with
tc_vars = Symbols.Maps.add
dest (src_type, dest_version) context.tc_vars;
dest dest_version context.tc_vars;
tc_facts =
Comparison(EQ, Var_v(dest_version), src)
:: context.tc_facts}
@@ -257,9 +257,9 @@ let rec type_check
Unit_type
| Jump_term(jmp) ->
let preconditions = ref jmp.jmp_target.bl_preconditions in
Symbols.Maps.iter (fun x (target_t, target) ->
let source_t, source_version = Symbols.Maps.find x context.tc_vars in
let t = coerce context source_t target_t in
Symbols.Maps.iter (fun x target ->
let source_version = Symbols.Maps.find x context.tc_vars in
let t = coerce context source_version.ver_type target.ver_type in
ignore t;
preconditions :=
List.map
@@ -360,11 +360,14 @@ let resolve_unknowns_in_type
let resolve_unknowns
(changed: bool ref)
(vars: (ttype * symbol_v) Symbols.Maps.t):
(ttype * symbol_v) Symbols.Maps.t
(vars: symbol_v Symbols.Maps.t):
symbol_v Symbols.Maps.t
=
Symbols.Maps.map
(fun (t, version) -> (resolve_unknowns_in_type changed t, version))
(fun x ->
x.ver_type <-
resolve_unknowns_in_type changed x.ver_type;
x)
vars
let type_check_blocks
@@ -379,7 +382,7 @@ let type_check_blocks
if block == entry_point then begin
Symbols.Maps.mapi
(fun parameter_sym parameter_type ->
(parameter_type, new_version parameter_sym))
(new_version parameter_sym parameter_type))
parameters
end else begin
Symbols.Maps.empty
@@ -391,10 +394,10 @@ let type_check_blocks
vars
end else begin
Symbols.Maps.add parameter_sym
((Unknown_type
{unk_incoming = [];
unk_outgoing = []}),
new_version parameter_sym)
(new_version parameter_sym
(Unknown_type
{unk_incoming = [];
unk_outgoing = []}))
vars
end
) block.bl_free initial_vars
@@ -413,7 +416,7 @@ let type_check_blocks
tc_vars = block.bl_in;
tc_expected = Some Unit_type;
tc_facts = List.map
(bind_versions (fun x -> snd (Symbols.Maps.find x block.bl_in)))
(bind_versions (fun x -> 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 f49b024

Please sign in to comment.