1 (**************************************************************************)
2 (* *)
3 (* OCaml *)
4 (* *)
5 (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
6 (* *)
7 (* Copyright 1996 Institut National de Recherche en Informatique et *)
8 (* en Automatique. *)
9 (* *)
10 (* All rights reserved. This file is distributed under the terms of *)
11 (* the GNU Lesser General Public License version 2.1, with the *)
12 (* special exception on linking described in the file LICENSE. *)
13 (* *)
14 (**************************************************************************)
15
16 (* A variant of the "lambda" code with direct / indirect calls explicit
17 and closures explicit too *)
18
19 open Asttypes
20 open Lambda
21
22 type function_label = string
23
24 type ustructured_constant =
25 | Uconst_float of float
26 | Uconst_int32 of int32
27 | Uconst_int64 of int64
28 | Uconst_nativeint of nativeint
29 | Uconst_block of int * uconstant list
30 | Uconst_float_array of float list
31 | Uconst_string of string
32 | Uconst_closure of ufunction list * string * uconstant list
33
34 and uconstant =
35 | Uconst_ref of string * ustructured_constant option
36 | Uconst_int of int
37 | Uconst_ptr of int
38
39 and uphantom_defining_expr =
40 | Uphantom_const of uconstant
41 (** The phantom-let-bound variable is a constant. *)
42 | Uphantom_var of Backend_var.t
43 (** The phantom-let-bound variable is an alias for another variable. *)
44 | Uphantom_offset_var of { var : Backend_var.t; offset_in_words : int; }
45 (** The phantom-let-bound-variable's value is defined by adding the given
46 number of words to the pointer contained in the given identifier. *)
47 | Uphantom_read_field of { var : Backend_var.t; field : int; }
48 (** The phantom-let-bound-variable's value is found by adding the given
49 number of words to the pointer contained in the given identifier, then
50 dereferencing. *)
51 | Uphantom_read_symbol_field of { sym : string; field : int; }
52 (** As for [Uphantom_read_var_field], but with the pointer specified by
53 a symbol. *)
54 | Uphantom_block of { tag : int; fields : Backend_var.t list; }
55 (** The phantom-let-bound variable points at a block with the given
56 structure. *)
57
58 and ulambda =
59 Uvar of Backend_var.t
60 | Uconst of uconstant
61 | Udirect_apply of function_label * ulambda list * Debuginfo.t
62 | Ugeneric_apply of ulambda * ulambda list * Debuginfo.t
63 | Uclosure of ufunction list * ulambda list
64 | Uoffset of ulambda * int
65 | Ulet of mutable_flag * value_kind * Backend_var.With_provenance.t
66 * ulambda * ulambda
67 | Uphantom_let of Backend_var.With_provenance.t
68 * uphantom_defining_expr option * ulambda
69 | Uletrec of (Backend_var.With_provenance.t * ulambda) list * ulambda
70 | Uprim of Clambda_primitives.primitive * ulambda list * Debuginfo.t
71 | Uswitch of ulambda * ulambda_switch * Debuginfo.t
72 | Ustringswitch of ulambda * (string * ulambda) list * ulambda option
73 | Ustaticfail of int * ulambda list
74 | Ucatch of
75 int *
76 (Backend_var.With_provenance.t * value_kind) list *
77 ulambda *
78 ulambda
79 | Utrywith of ulambda * Backend_var.With_provenance.t * ulambda
80 | Uifthenelse of ulambda * ulambda * ulambda
81 | Usequence of ulambda * ulambda
82 | Uwhile of ulambda * ulambda
83 | Ufor of Backend_var.With_provenance.t * ulambda * ulambda
84 * direction_flag * ulambda
85 | Uassign of Backend_var.t * ulambda
86 | Usend of meth_kind * ulambda * ulambda * ulambda list * Debuginfo.t
87 | Uunreachable
88
89 and ufunction = {
90 label : function_label;
91 arity : int;
92 params : (Backend_var.With_provenance.t * value_kind) list;
93 return : value_kind;
94 body : ulambda;
95 dbg : Debuginfo.t;
96 env : Backend_var.t option;
97 }
98
99 and ulambda_switch =
100 { us_index_consts: int array;
101 us_actions_consts: ulambda array;
102 us_index_blocks: int array;
103 us_actions_blocks: ulambda array}
104
105 (* Description of known functions *)
106
107 type function_description =
108 { fun_label: function_label; (* Label of direct entry point *)
109 fun_arity: int; (* Number of arguments *)
110 mutable fun_closed: bool; (* True if environment not used *)
111 mutable fun_inline: (Backend_var.With_provenance.t list * ulambda) option;
112 mutable fun_float_const_prop: bool (* Can propagate FP consts *)
113 }
114
115 (* Approximation of values *)
116
117 type value_approximation =
118 Value_closure of function_description * value_approximation
119 | Value_tuple of value_approximation array
120 | Value_unknown
121 | Value_const of uconstant
122 | Value_global_field of string * int
123
124 (* Comparison functions for constants *)
125
126 val compare_structured_constants:
127 ustructured_constant -> ustructured_constant -> int
128 val compare_constants:
129 uconstant -> uconstant -> int
130
131 type usymbol_provenance = {
132 original_idents : Ident.t list;
133 module_path : Path.t;
134 }
135
136 type uconstant_block_field =
137 | Uconst_field_ref of string
138 | Uconst_field_int of int
139
140 type preallocated_block = {
141 symbol : string;
142 exported : bool;
143 tag : int;
144 fields : uconstant_block_field option list;
145 provenance : usymbol_provenance option;
146 }
147
148 type preallocated_constant = {
149 symbol : string;
150 exported : bool;
151 definition : ustructured_constant;
152 provenance : usymbol_provenance option;
153 }
154
155 type with_constants =
156 ulambda * preallocated_block list * preallocated_constant list
157