Permalink
Browse files

Make sure overloaded subprograms don't conflict.

  • Loading branch information...
xlq committed Sep 16, 2012
1 parent 44ca415 commit 50157cedb5e678ab5a51f6a36de3a3b03ea913d1
Showing with 92 additions and 8 deletions.
  1. +1 −1 constraint_checking.ml
  2. +17 −7 translation.ml
  3. +72 −0 type_checking.ml
  4. +2 −0 type_checking.mli
View
@@ -247,7 +247,7 @@ let constraint_check_blocks blocks entry_point =
| From_postconditions(loc,_,_)
| From_preconditions(loc,_,_) ->
Errors.semantic_error loc
("Original constraint was here.")
("Original constraint is here.")
| From_static_assertion _ -> ()
end
end
View
@@ -69,7 +69,7 @@ let report_previous_declaration sym =
| None -> ()
| Some loc ->
Errors.semantic_error loc
"Previous declaration was here."
"Previous declaration is here."
let already_declared_error old_sym new_loc =
Errors.semantic_error new_loc
@@ -278,12 +278,17 @@ and translate_block
let translate_subprogram_prototype state scope sub =
match sub.Parse_tree.sub_name with [name] ->
begin match find scope name with
| [] -> ()
| [x] when is_subprogram x -> ()
| [x] -> already_declared_error x sub.Parse_tree.sub_location
| results -> ()
end;
let competing_declarations =
match find scope name with
| [] -> []
| [x] when is_subprogram x -> [x]
| [x] ->
already_declared_error x sub.Parse_tree.sub_location;
[]
| results ->
assert (List.for_all is_subprogram results);
results
in
let subprogram_info = {
sub_parameters = [];
sub_preconditions = [];
@@ -336,7 +341,12 @@ let translate_subprogram_prototype state scope sub =
in
subprogram_info.sub_preconditions <- pre;
subprogram_info.sub_postconditions <- post;
(* Type-check the preconditions and postconditions. *)
Type_checking.type_check_subprogram_declaration subprogram_info;
(* Check that the parameter types of this subprogram aren't the same as
those of another subprogram with the same name. (If they were, a call
to this subprogram would always be ambiguous.) *)
Type_checking.check_overload competing_declarations subprogram_sym;
(* Translate the body later. *)
state.st_subprograms <-
(subprogram_sym, sub) :: state.st_subprograms
View
@@ -157,6 +157,78 @@ let type_check_subprogram_declaration info =
assert (match changes with {chg_incoming=[]; chg_outgoing=[]} -> true
| _ -> false)
let same_mode a b =
match a, b with
| Const_parameter, Const_parameter
| In_parameter, In_parameter
| Out_parameter, Out_parameter
| In_out_parameter, In_out_parameter -> true
| _ -> false
(* XXX: This is very similar to coerce. *)
let conflicting_types t1 t2 =
match t1, t2 with
| Unit_type, Unit_type
| Boolean_type, Boolean_type
| Integer_type, Integer_type -> true
| Unit_type, _ | _, Unit_type
| Boolean_type, _ | _, Boolean_type
| Integer_type, _ | _, Integer_type -> false
let check_overload
(competing: symbol list)
({sym_declared = Some loc;
sym_info = Subprogram_sym(info)} as subprogram)
=
let rec loop = function
| [], [], _ ->
(* There are no conflicting declarations. *)
[]
| [], decls, [] ->
(* Remove declarations that have more parameters than this one. *)
List.filter
(function
| (_, []) -> true
| (_, _::_) -> false)
decls
| filtered, [], param::params ->
(* Next parameter. *)
loop ([], filtered, params)
| filtered, (decl, [])::decls, param::params ->
(* This declaration has fewer arguments. Filter it. *)
loop (filtered, decls, param::params)
| filtered, (decl, decl_param::decl_params)::decls, param::params ->
let {sym_info = Parameter_sym(decl_mode, decl_t)} = decl_param in
let {sym_info = Parameter_sym(mode, t)} = param in
if (same_mode mode decl_mode)
&& (conflicting_types t decl_t) then
(* Still conflicting. *)
loop ((decl, decl_params)::filtered, decls, param::params)
else
loop (filtered, decls, param::params)
in
match loop
([],
List.map
(fun ({sym_info = Subprogram_sym(info)} as subprogram) ->
(subprogram, info.sub_parameters)) competing,
info.sub_parameters)
with
| [] -> ()
| competing ->
Errors.semantic_error loc
("Declaration of "
^ describe_symbol subprogram
^ " competes with "
^ (match competing with
| [_] -> " an earlier declaration."
| _::_::_ -> " earlier declarations."));
List.iter (fun (competing, _) ->
Errors.semantic_error (unsome competing.sym_declared)
("Conflicting declaration of "
^ describe_symbol competing ^ " is here.")
) competing
let rec type_check state iterm =
match iterm with
| Return_term(ret) ->
View
@@ -3,4 +3,6 @@ open Icode
val type_check_subprogram_declaration : subprogram_info -> unit
val check_overload : symbol list -> symbol -> unit
val type_check_blocks : block list -> unit

0 comments on commit 50157ce

Please sign in to comment.