/usr/lib/ocaml/compiler-libs/typing/includeclass.ml is in ocaml-compiler-libs 3.12.1-2ubuntu2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 | (***********************************************************************)
(* *)
(* 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: includeclass.ml 10541 2010-06-08 08:43:38Z garrigue $ *)
(* 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 Format
open Ctype
(*
let rec hide_params = function
Tcty_fun ("*", _, cty) -> hide_params cty
| cty -> cty
*)
let include_err ppf =
function
| CM_Virtual_class ->
fprintf ppf "A class cannot be changed from virtual to concrete"
| CM_Parameter_arity_mismatch (ls, lp) ->
fprintf ppf
"The classes do not have the same number of type parameters"
| CM_Type_parameter_mismatch trace ->
fprintf ppf "@[%a@]"
(Printtyp.unification_error false trace
(function ppf ->
fprintf ppf "A type parameter has type"))
(function ppf ->
fprintf ppf "but is expected to have type")
| CM_Class_type_mismatch (cty1, cty2) ->
fprintf ppf
"@[The class type@;<1 2>%a@ is not matched by the class type@;<1 2>%a@]"
Printtyp.class_type cty1 Printtyp.class_type cty2
| CM_Parameter_mismatch trace ->
fprintf ppf "@[%a@]"
(Printtyp.unification_error false trace
(function ppf ->
fprintf ppf "A parameter has type"))
(function ppf ->
fprintf ppf "but is expected to have type")
| CM_Val_type_mismatch (lab, trace) ->
fprintf ppf "@[%a@]"
(Printtyp.unification_error false trace
(function ppf ->
fprintf ppf "The instance variable %s@ has type" lab))
(function ppf ->
fprintf ppf "but is expected to have type")
| CM_Meth_type_mismatch (lab, trace) ->
fprintf ppf "@[%a@]"
(Printtyp.unification_error false trace
(function ppf ->
fprintf ppf "The method %s@ has type" lab))
(function ppf ->
fprintf ppf "but is expected to have type")
| CM_Non_mutable_value lab ->
fprintf ppf
"@[The non-mutable instance variable %s cannot become mutable@]" lab
| CM_Non_concrete_value lab ->
fprintf ppf
"@[The virtual instance variable %s cannot become concrete@]" lab
| CM_Missing_value lab ->
fprintf ppf "@[The first class type has no instance variable %s@]" lab
| CM_Missing_method lab ->
fprintf ppf "@[The first class type has no method %s@]" lab
| CM_Hide_public lab ->
fprintf ppf "@[The public method %s cannot be hidden@]" lab
| CM_Hide_virtual (k, lab) ->
fprintf ppf "@[The virtual %s %s cannot be hidden@]" k lab
| CM_Public_method lab ->
fprintf ppf "@[The public method %s cannot become private" lab
| CM_Virtual_method lab ->
fprintf ppf "@[The virtual method %s cannot become concrete" lab
| CM_Private_method lab ->
fprintf ppf "The private method %s cannot become public" lab
let report_error ppf = function
| [] -> ()
| err :: errs ->
let print_errs ppf errs =
List.iter (fun err -> fprintf ppf "@ %a" include_err err) errs in
fprintf ppf "@[<v>%a%a@]" include_err err print_errs errs
|