/usr/lib/ocaml/compiler-libs/clambda.mli is in ocaml-compiler-libs 4.05.0-10ubuntu1.
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 111 112 113 114 | (**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
(* A variant of the "lambda" code with direct / indirect calls explicit
and closures explicit too *)
open Asttypes
open Lambda
type function_label = string
type ustructured_constant =
| Uconst_float of float
| Uconst_int32 of int32
| Uconst_int64 of int64
| Uconst_nativeint of nativeint
| Uconst_block of int * uconstant list
| Uconst_float_array of float list
| Uconst_string of string
| Uconst_closure of ufunction list * string * uconstant list
and uconstant =
| Uconst_ref of string * ustructured_constant option
| Uconst_int of int
| Uconst_ptr of int
and ulambda =
Uvar of Ident.t
| Uconst of uconstant
| Udirect_apply of function_label * ulambda list * Debuginfo.t
| Ugeneric_apply of ulambda * ulambda list * Debuginfo.t
| Uclosure of ufunction list * ulambda list
| Uoffset of ulambda * int
| Ulet of mutable_flag * value_kind * Ident.t * ulambda * ulambda
| Uletrec of (Ident.t * ulambda) list * ulambda
| Uprim of primitive * ulambda list * Debuginfo.t
| Uswitch of ulambda * ulambda_switch
| Ustringswitch of ulambda * (string * ulambda) list * ulambda option
| Ustaticfail of int * ulambda list
| Ucatch of int * Ident.t list * ulambda * ulambda
| Utrywith of ulambda * Ident.t * ulambda
| Uifthenelse of ulambda * ulambda * ulambda
| Usequence of ulambda * ulambda
| Uwhile of ulambda * ulambda
| Ufor of Ident.t * ulambda * ulambda * direction_flag * ulambda
| Uassign of Ident.t * ulambda
| Usend of meth_kind * ulambda * ulambda * ulambda list * Debuginfo.t
| Uunreachable
and ufunction = {
label : function_label;
arity : int;
params : Ident.t list;
body : ulambda;
dbg : Debuginfo.t;
env : Ident.t option;
}
and ulambda_switch =
{ us_index_consts: int array;
us_actions_consts: ulambda array;
us_index_blocks: int array;
us_actions_blocks: ulambda array}
(* Description of known functions *)
type function_description =
{ fun_label: function_label; (* Label of direct entry point *)
fun_arity: int; (* Number of arguments *)
mutable fun_closed: bool; (* True if environment not used *)
mutable fun_inline: (Ident.t list * ulambda) option;
mutable fun_float_const_prop: bool (* Can propagate FP consts *)
}
(* Approximation of values *)
type value_approximation =
Value_closure of function_description * value_approximation
| Value_tuple of value_approximation array
| Value_unknown
| Value_const of uconstant
| Value_global_field of string * int
(* Comparison functions for constants *)
val compare_structured_constants:
ustructured_constant -> ustructured_constant -> int
val compare_constants:
uconstant -> uconstant -> int
type preallocated_block = {
symbol : string;
exported : bool;
tag : int;
size : int;
}
type preallocated_constant = {
symbol : string;
exported : bool;
definition : ustructured_constant;
}
|