blob: 600778ae922efbef03180aad37b852a95b72d36b (
plain)
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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
(**************************************************************************)
(* *)
(* 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
and uphantom_defining_expr =
| Uphantom_const of uconstant
(** The phantom-let-bound variable is a constant. *)
| Uphantom_var of Backend_var.t
(** The phantom-let-bound variable is an alias for another variable. *)
| Uphantom_offset_var of { var : Backend_var.t; offset_in_words : int; }
(** The phantom-let-bound-variable's value is defined by adding the given
number of words to the pointer contained in the given identifier. *)
| Uphantom_read_field of { var : Backend_var.t; field : int; }
(** The phantom-let-bound-variable's value is found by adding the given
number of words to the pointer contained in the given identifier, then
dereferencing. *)
| Uphantom_read_symbol_field of { sym : string; field : int; }
(** As for [Uphantom_read_var_field], but with the pointer specified by
a symbol. *)
| Uphantom_block of { tag : int; fields : Backend_var.t list; }
(** The phantom-let-bound variable points at a block with the given
structure. *)
and ulambda =
Uvar of Backend_var.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 * Backend_var.With_provenance.t
* ulambda * ulambda
| Uphantom_let of Backend_var.With_provenance.t
* uphantom_defining_expr option * ulambda
| Uletrec of (Backend_var.With_provenance.t * ulambda) list * ulambda
| Uprim of Clambda_primitives.primitive * ulambda list * Debuginfo.t
| Uswitch of ulambda * ulambda_switch * Debuginfo.t
| Ustringswitch of ulambda * (string * ulambda) list * ulambda option
| Ustaticfail of int * ulambda list
| Ucatch of
int *
(Backend_var.With_provenance.t * value_kind) list *
ulambda *
ulambda
| Utrywith of ulambda * Backend_var.With_provenance.t * ulambda
| Uifthenelse of ulambda * ulambda * ulambda
| Usequence of ulambda * ulambda
| Uwhile of ulambda * ulambda
| Ufor of Backend_var.With_provenance.t * ulambda * ulambda
* direction_flag * ulambda
| Uassign of Backend_var.t * ulambda
| Usend of meth_kind * ulambda * ulambda * ulambda list * Debuginfo.t
| Uunreachable
and ufunction = {
label : function_label;
arity : int;
params : (Backend_var.With_provenance.t * value_kind) list;
return : value_kind;
body : ulambda;
dbg : Debuginfo.t;
env : Backend_var.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: (Backend_var.With_provenance.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 usymbol_provenance = {
original_idents : Ident.t list;
module_path : Path.t;
}
type uconstant_block_field =
| Uconst_field_ref of string
| Uconst_field_int of int
type preallocated_block = {
symbol : string;
exported : bool;
tag : int;
fields : uconstant_block_field option list;
provenance : usymbol_provenance option;
}
type preallocated_constant = {
symbol : string;
exported : bool;
definition : ustructured_constant;
provenance : usymbol_provenance option;
}
type with_constants =
ulambda * preallocated_block list * preallocated_constant list
|
