146 lines
4.7 KiB
OCaml
146 lines
4.7 KiB
OCaml
(***********************************************************************)
|
|
(* *)
|
|
(* Objective Caml *)
|
|
(* *)
|
|
(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)
|
|
(* *)
|
|
(* Copyright 1997 Institut National de Recherche en Informatique et *)
|
|
(* en Automatique. All rights reserved. This file is distributed *)
|
|
(* under the terms of the Q Public License version 1.0. *)
|
|
(* *)
|
|
(***********************************************************************)
|
|
|
|
(* $Id$ *)
|
|
|
|
(* Inclusion checks for the class language *)
|
|
|
|
open Types
|
|
|
|
let class_types env cty1 cty2 =
|
|
Ctype.match_class_types env cty1 cty2
|
|
|
|
let class_type_declarations env cty1 cty2 =
|
|
Ctype.match_class_declarations env
|
|
cty1.clty_params cty1.clty_type
|
|
cty2.clty_params cty2.clty_type
|
|
|
|
let class_declarations env cty1 cty2 =
|
|
match cty1.cty_new, cty2.cty_new with
|
|
None, Some _ ->
|
|
[Ctype.CM_Virtual_class]
|
|
| _ ->
|
|
Ctype.match_class_declarations env
|
|
cty1.cty_params cty1.cty_type
|
|
cty2.cty_params cty2.cty_type
|
|
|
|
open Formatmsg
|
|
open Ctype
|
|
|
|
let include_err =
|
|
function
|
|
CM_Virtual_class ->
|
|
print_string "A class cannot be changed from virtual to concrete"
|
|
| CM_Parameter_arity_mismatch (ls, lp) ->
|
|
print_string
|
|
"The classes do not have the same number of type parameters"
|
|
| CM_Type_parameter_mismatch trace ->
|
|
open_box 0;
|
|
Printtyp.unification_error false trace
|
|
(function () ->
|
|
print_string "One type parameter has type")
|
|
(function () ->
|
|
print_string "but is expected to have type");
|
|
close_box ()
|
|
| CM_Class_type_mismatch (cty1, cty2) ->
|
|
open_box 0;
|
|
print_string "The class type"; print_break 1 2;
|
|
Printtyp.class_type cty1;
|
|
print_space ();
|
|
print_string "is not matched by the class type";
|
|
print_break 1 2;
|
|
Printtyp.class_type cty2;
|
|
close_box ()
|
|
| CM_Parameter_mismatch trace ->
|
|
open_box 0;
|
|
Printtyp.unification_error false trace
|
|
(function () ->
|
|
print_string "One parameter has type")
|
|
(function () ->
|
|
print_string "but is expected to have type");
|
|
close_box ()
|
|
| CM_Val_type_mismatch (lab, trace) ->
|
|
open_box 0;
|
|
Printtyp.unification_error false trace
|
|
(function () ->
|
|
print_string "The instance variable ";
|
|
print_string lab; print_space ();
|
|
print_string "has type")
|
|
(function () ->
|
|
print_string "but is expected to have type");
|
|
close_box ()
|
|
| CM_Meth_type_mismatch (lab, trace) ->
|
|
open_box 0;
|
|
Printtyp.unification_error false trace
|
|
(function () ->
|
|
print_string "The method ";
|
|
print_string lab; print_space ();
|
|
print_string "has type")
|
|
(function () ->
|
|
print_string "but is expected to have type");
|
|
close_box ()
|
|
| CM_Non_mutable_value lab ->
|
|
open_box 0;
|
|
print_string "The non-mutable instance variable ";
|
|
print_string lab;
|
|
print_string " cannot become mutable";
|
|
close_box ()
|
|
| CM_Missing_value lab ->
|
|
open_box 0;
|
|
print_string "The first class type has no instance variable ";
|
|
print_string lab;
|
|
close_box ()
|
|
| CM_Missing_method lab ->
|
|
open_box 0;
|
|
print_string "The first class type has no method ";
|
|
print_string lab;
|
|
close_box ()
|
|
| CM_Hide_public lab ->
|
|
open_box 0;
|
|
print_string "The public method ";
|
|
print_string lab;
|
|
print_string " cannot be hidden";
|
|
close_box ()
|
|
| CM_Hide_virtual lab ->
|
|
open_box 0;
|
|
print_string "The virtual method ";
|
|
print_string lab;
|
|
print_string " cannot be hidden";
|
|
close_box ()
|
|
| CM_Public_method lab ->
|
|
open_box 0;
|
|
print_string "The public method ";
|
|
print_string lab;
|
|
print_string " cannot become private";
|
|
close_box ()
|
|
| CM_Virtual_method lab ->
|
|
open_box 0;
|
|
print_string "The virtual method ";
|
|
print_string lab;
|
|
print_string " cannot become concrete";
|
|
close_box ()
|
|
| CM_Private_method lab ->
|
|
open_box 0;
|
|
print_string "The private method ";
|
|
print_string lab;
|
|
print_string " cannot become public";
|
|
close_box ()
|
|
|
|
let report_error errlist =
|
|
match errlist with
|
|
[] -> ()
|
|
| err :: rem ->
|
|
open_vbox 0;
|
|
include_err err;
|
|
List.iter (fun err -> print_space(); include_err err) rem;
|
|
close_box()
|