Permalink
Browse files

Translate records.

  • Loading branch information...
xlq committed Oct 31, 2012
1 parent 7d1f2af commit 716da64288e8fff28e0e9cb921909f8ea246787b
Showing with 114 additions and 35 deletions.
  1. +36 −4 backend_c.ml
  2. +22 −10 symbols.ml
  3. +12 −9 symbols.mli
  4. +43 −11 translation.ml
  5. +1 −1 type_checking.ml
View
@@ -9,8 +9,11 @@ let rec erase_type t =
match t with
| Boolean_type -> Boolean_type
| Integer_type -> Integer_type
| Record_type record_sym -> Record_type record_sym
| Uninitialised(t) -> erase_type t
(* The collect_types functions create a symbol -> type map. *)
let collect_types_type types loc x t =
let t = erase_type t in
match
@@ -77,14 +80,15 @@ let c_name_of_local sym =
let c_name_of_symbol sym =
match sym.sym_info with
| Variable_sym | Parameter_sym _ ->
| Variable_sym | Parameter_sym _ | Field_sym _ ->
c_name_of_local sym
| _ ->
String.concat "__" (dotted_name sym)
let c_name_of_type = function
| Boolean_type -> "bool"
| Integer_type -> "int"
| Record_type record_sym -> "struct " ^ c_name_of_symbol record_sym
let c_name_of_subprogram ({sym_info = Subprogram_sym(info)} as sym) =
c_name_of_symbol sym
@@ -180,6 +184,31 @@ let translate_block f block =
translate_icode f (unsome block.bl_body);
undent f
let rec declare_type f = function
| Boolean_type | Integer_type -> ()
| Uninitialised t -> declare_type f t
| Record_type record_sym ->
if not record_sym.sym_translated then begin
List.iter (fun {sym_info=Field_sym field_type} ->
declare_type f field_type) record_sym.sym_children;
puts f ("struct " ^ c_name_of_symbol record_sym ^ " {");
break f;
indent f;
List.iter (fun ({sym_info=Field_sym field_type} as field) ->
puts f (c_name_of_type field_type ^ " "
^ c_name_of_symbol field ^ ";");
break f
) record_sym.sym_children;
undent f;
puts f "};";
break f;
break f;
record_sym.sym_translated <- true
end
let declare_types f types =
Symbols.Maps.iter (fun _ t -> declare_type f t) types
let declare_locals f types =
Symbols.Maps.iter (fun x t ->
match x.sym_info with
@@ -229,14 +258,17 @@ let translate
=
start_output compiler;
let f = new_formatter () in
let types = ref Symbols.Maps.empty in
collect_types_blocks types blocks;
declare_types f !types;
declare_function f subprogram_sym;
break f;
puts f "{";
break f; indent f;
let types = ref Symbols.Maps.empty in
collect_types_blocks types blocks;
declare_locals f !types;
break f;
translate_block f entry_point;
View
@@ -15,6 +15,7 @@ type ttype =
| Boolean_type
| Integer_type
| Uninitialised of ttype
| Record_type of symbol
and unknown = {
mutable unk_incoming : ttype list;
@@ -32,14 +33,14 @@ and expr =
| Comparison of comparison * expr * expr
and symbol = {
sym_id : int;
sym_name : string;
sym_declared : Lexing.position option;
sym_parent : symbol option;
mutable sym_children : symbol list;
mutable sym_info : symbol_info;
mutable sym_last_version
: int;
sym_id : int;
sym_name : string;
sym_declared : Lexing.position option;
sym_parent : symbol option;
mutable sym_children : symbol list;
mutable sym_info : symbol_info;
mutable sym_last_version: int;
mutable sym_translated : bool;
}
and symbol_v = {
@@ -51,11 +52,13 @@ and symbol_v = {
and symbol_info =
| Unfinished_sym
| Erroneous_sym
| Package_sym
| Subprogram_sym of subprogram_info
| Variable_sym
| Parameter_sym of param_mode * ttype
| Record_sym
| Record_sym of expr list
| Field_sym of ttype
and subprogram_info = {
mutable sub_parameters : symbol list;
@@ -90,6 +93,7 @@ let root_symbol = {
sym_children = [];
sym_info = Package_sym;
sym_last_version = 0;
sym_translated = false;
}
let dotted_name sym =
@@ -117,6 +121,7 @@ let rec string_of_type = function
| Unknown_type _ -> "<unknown>"
| Boolean_type -> "Boolean"
| Integer_type -> "Integer"
| Record_type type_sym -> full_name type_sym
let rec string_of_expr = function
| Boolean_literal(_,true) -> "True"
@@ -137,6 +142,8 @@ let string_of_lvalue = function
let describe_symbol sym =
(match sym.sym_info with
| Unfinished_sym -> "incomplete symbol"
| Erroneous_sym -> "erroneous symbol"
| Package_sym -> "package"
| Subprogram_sym _-> "subprogram"
| Variable_sym -> "variable"
@@ -147,6 +154,8 @@ let describe_symbol sym =
| Out_parameter -> "out "
| In_out_parameter -> "in out "
) ^ "parameter"
| Record_sym _ -> "record type"
| Field_sym _ -> "field"
) ^ " `" ^ full_name sym ^ "'"
let find_in scope name =
@@ -164,6 +173,7 @@ let new_overloaded_symbol scope name loc info =
sym_children = [];
sym_info = info;
sym_last_version = 0;
sym_translated = false;
} in
scope.sym_children <- new_sym :: scope.sym_children;
new_sym
@@ -200,8 +210,10 @@ let same_types t1 t2 =
match t1, t2 with
| Boolean_type, Boolean_type
| Integer_type, Integer_type -> true
| Record_type s1, Record_type s2 -> s1 == s2
| Boolean_type, _ | _, Boolean_type
| Integer_type, _ | _, Integer_type -> false
| Integer_type, _ | _, Integer_type
| Record_type _, _ | _, Record_type _ -> false
let free_variables e =
let rec search vars = function
View
@@ -17,6 +17,7 @@ type ttype =
| Boolean_type
| Integer_type
| Uninitialised of ttype
| Record_type of symbol
and unknown = {
(* Incoming candidate types. These are types from
@@ -45,14 +46,14 @@ and expr =
(* A symbol. Each symbol has one symbol object representing it - symbol objects
can and should be compared physically (i.e. == not =). *)
and symbol = {
sym_id : int; (* unique identifier *)
sym_name : string;
sym_declared : Lexing.position option;
sym_parent : symbol option;
mutable sym_children : symbol list;
mutable sym_info : symbol_info;
mutable sym_last_version
: int;
sym_id : int; (* unique identifier *)
sym_name : string;
sym_declared : Lexing.position option;
sym_parent : symbol option;
mutable sym_children : symbol list;
mutable sym_info : symbol_info;
mutable sym_last_version: int;
mutable sym_translated : bool;
}
(* A symbol_v is a version of a symbol. In constraints, etc., each symbol_v is
@@ -70,11 +71,13 @@ and symbol_v = {
and symbol_info =
| Unfinished_sym (* symbol_info not yet set *)
| Erroneous_sym (* symbol whose declaration was erroneous *)
| Package_sym
| Subprogram_sym of subprogram_info
| Variable_sym
| Parameter_sym of param_mode * ttype
| Record_sym
| Record_sym of expr list
| Field_sym of ttype
and subprogram_info = {
mutable sub_parameters : symbol list;
View
@@ -135,10 +135,19 @@ let rec translate_type
Boolean_type
| Parse_tree.Named_type(loc, ["Integer"]) ->
Integer_type
| Parse_tree.Named_type(loc, name) ->
Errors.semantic_error loc
("Undefined type `" ^ String.concat "." name ^ "'.");
raise Bail_out
| Parse_tree.Named_type(loc, [name]) ->
begin match find scope name with
| [] ->
Errors.semantic_error loc
("Undefined type `" ^ name ^ "'.");
raise Bail_out
| [{sym_info = Record_sym _} as type_sym] ->
Record_type type_sym
| sym::_ ->
Errors.semantic_error loc
("Type expected but " ^ describe_symbol sym ^ " found.");
raise Bail_out
end
let rec translate_expr
(scope: symbol)
@@ -328,10 +337,14 @@ let translate_subprogram_prototype state scope sub =
(Some param.Parse_tree.param_location)
Unfinished_sym
in
let t = translate_type
scope param.Parse_tree.param_type
in
sym.sym_info <- Parameter_sym(param.Parse_tree.param_mode, t);
begin try
let t = translate_type
scope param.Parse_tree.param_type in
sym.sym_info <- Parameter_sym(param.Parse_tree.param_mode, t);
with e ->
sym.sym_info <- Erroneous_sym;
raise e
end;
sym :: parameters
with Bail_out -> parameters
) sub.Parse_tree.sub_parameters [];
@@ -410,9 +423,28 @@ let translate_type_declaration state scope loc name decl =
already_declared_error sym loc;
raise Bail_out
end;
let type_sym = new_symbol scope name (Some loc) Record_sym in
(* TODO *)
()
let type_sym = new_symbol scope name (Some loc) Unfinished_sym in
match decl with
| Parse_tree.Record_type_decl(fields) ->
let constraints = ref [] in
let rec process_field = function
| Parse_tree.Record_constraint(e) ->
constraints :=
(translate_expr type_sym e) :: !constraints
| Parse_tree.Record_field(loc, name, t) ->
begin match find type_sym name with
| [] -> ()
| sym::_ ->
already_declared_error sym loc;
raise Bail_out
end;
let t = translate_type scope t in
let field_sym = new_symbol type_sym name
(Some loc) (Field_sym t) in
ignore field_sym;
in
List.iter process_field fields;
type_sym.sym_info <- Record_sym !constraints
let translate_declarations state scope declarations =
List.iter (fun declaration ->
View
@@ -438,7 +438,7 @@ let rec propagate_decision unk decided =
let rec resolve_unknowns_in_type remaining t =
match t with
| Boolean_type | Integer_type -> t
| Boolean_type | Integer_type | Record_type _ -> t
| Unknown_type({unk_decided = Some t}) -> t
| Unknown_type({unk_decided = None} as unk) ->
let rec fold result = function

0 comments on commit 716da64

Please sign in to comment.