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
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
|
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* 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 Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* $Id$ *)
(* The "lambda" intermediate code *)
open Asttypes
type primitive =
Pidentity
| Pignore
(* Globals *)
| Pgetglobal of Ident.t
| Psetglobal of Ident.t
(* Operations on heap blocks *)
| Pmakeblock of int * mutable_flag
| Pfield of int
| Psetfield of int * bool
| Pfloatfield of int
| Psetfloatfield of int
| Pduprecord of Types.record_representation * int
(* Force lazy values *)
| Plazyforce
(* External call *)
| Pccall of Primitive.description
(* Exceptions *)
| Praise
(* Boolean operations *)
| Psequand | Psequor | Pnot
(* Integer operations *)
| Pnegint | Paddint | Psubint | Pmulint | Pdivint | Pmodint
| Pandint | Porint | Pxorint
| Plslint | Plsrint | Pasrint
| Pintcomp of comparison
| Poffsetint of int
| Poffsetref of int
(* Float operations *)
| Pintoffloat | Pfloatofint
| Pnegfloat | Pabsfloat
| Paddfloat | Psubfloat | Pmulfloat | Pdivfloat
| Pfloatcomp of comparison
(* String operations *)
| Pstringlength | Pstringrefu | Pstringsetu | Pstringrefs | Pstringsets
(* Array operations *)
| Pmakearray of array_kind
| Parraylength of array_kind
| Parrayrefu of array_kind
| Parraysetu of array_kind
| Parrayrefs of array_kind
| Parraysets of array_kind
(* Test if the argument is a block or an immediate integer *)
| Pisint
(* Test if the (integer) argument is outside an interval *)
| Pisout
(* Bitvect operations *)
| Pbittest
(* Operations on boxed integers (Nativeint.t, Int32.t, Int64.t) *)
| Pbintofint of boxed_integer
| Pintofbint of boxed_integer
| Pcvtbint of boxed_integer (*source*) * boxed_integer (*destination*)
| Pnegbint of boxed_integer
| Paddbint of boxed_integer
| Psubbint of boxed_integer
| Pmulbint of boxed_integer
| Pdivbint of boxed_integer
| Pmodbint of boxed_integer
| Pandbint of boxed_integer
| Porbint of boxed_integer
| Pxorbint of boxed_integer
| Plslbint of boxed_integer
| Plsrbint of boxed_integer
| Pasrbint of boxed_integer
| Pbintcomp of boxed_integer * comparison
(* Operations on big arrays: (unsafe, #dimensions, kind, layout) *)
| Pbigarrayref of bool * int * bigarray_kind * bigarray_layout
| Pbigarrayset of bool * int * bigarray_kind * bigarray_layout
and comparison =
Ceq | Cneq | Clt | Cgt | Cle | Cge
and array_kind =
Pgenarray | Paddrarray | Pintarray | Pfloatarray
and boxed_integer =
Pnativeint | Pint32 | Pint64
and bigarray_kind =
Pbigarray_unknown
| Pbigarray_float32 | Pbigarray_float64
| Pbigarray_sint8 | Pbigarray_uint8
| Pbigarray_sint16 | Pbigarray_uint16
| Pbigarray_int32 | Pbigarray_int64
| Pbigarray_caml_int | Pbigarray_native_int
| Pbigarray_complex32 | Pbigarray_complex64
and bigarray_layout =
Pbigarray_unknown_layout
| Pbigarray_c_layout
| Pbigarray_fortran_layout
type structured_constant =
Const_base of constant
| Const_pointer of int
| Const_block of int * structured_constant list
| Const_float_array of string list
| Const_immstring of string
type function_kind = Curried | Tupled
type let_kind = Strict | Alias | StrictOpt | Variable
(* Meaning of kinds for let x = e in e':
Strict: e may have side-effets; always evaluate e first
(If e is a simple expression, e.g. a variable or constant,
we may still substitute e'[x/e].)
Alias: e is pure, we can substitute e'[x/e] if x has 0 or 1 occurrences
in e'
StrictOpt: e does not have side-effects, but depend on the store;
we can discard e if x does not appear in e'
Variable: the variable x is assigned later in e' *)
type meth_kind = Self | Public | Cached
type shared_code = (int * int) list (* stack size -> code label *)
type lambda =
Lvar of Ident.t
| Lconst of structured_constant
| Lapply of lambda * lambda list * Location.t
| Lfunction of function_kind * Ident.t list * lambda
| Llet of let_kind * Ident.t * lambda * lambda
| Lletrec of (Ident.t * lambda) list * lambda
| Lprim of primitive * lambda list
| Lswitch of lambda * lambda_switch
| Lstaticraise of int * lambda list
| Lstaticcatch of lambda * (int * Ident.t list) * lambda
| Ltrywith of lambda * Ident.t * lambda
| Lifthenelse of lambda * lambda * lambda
| Lsequence of lambda * lambda
| Lwhile of lambda * lambda
| Lfor of Ident.t * lambda * lambda * direction_flag * lambda
| Lassign of Ident.t * lambda
| Lsend of meth_kind * lambda * lambda * lambda list * Location.t
| Levent of lambda * lambda_event
| Lifused of Ident.t * lambda
and lambda_switch =
{ sw_numconsts: int; (* Number of integer cases *)
sw_consts: (int * lambda) list; (* Integer cases *)
sw_numblocks: int; (* Number of tag block cases *)
sw_blocks: (int * lambda) list; (* Tag block cases *)
sw_failaction : lambda option} (* Action to take if failure *)
and lambda_event =
{ lev_loc: Location.t;
lev_kind: lambda_event_kind;
lev_repr: int ref option;
lev_env: Env.summary }
and lambda_event_kind =
Lev_before
| Lev_after of Types.type_expr
| Lev_function
val same: lambda -> lambda -> bool
val const_unit: structured_constant
val lambda_unit: lambda
val name_lambda: lambda -> (Ident.t -> lambda) -> lambda
val name_lambda_list: lambda list -> (lambda list -> lambda) -> lambda
val iter: (lambda -> unit) -> lambda -> unit
module IdentSet: Set.S with type elt = Ident.t
val free_variables: lambda -> IdentSet.t
val free_methods: lambda -> IdentSet.t
val transl_path: Path.t -> lambda
val make_sequence: ('a -> lambda) -> 'a list -> lambda
val subst_lambda: lambda Ident.tbl -> lambda -> lambda
val bind : let_kind -> Ident.t -> lambda -> lambda -> lambda
val commute_comparison : comparison -> comparison
val negate_comparison : comparison -> comparison
(***********************)
(* For static failures *)
(***********************)
(* Get a new static failure ident *)
val next_raise_count : unit -> int
val staticfail : lambda (* Anticipated static failure *)
(* Check anticipated failure, substitute its final value *)
val is_guarded: lambda -> bool
val patch_guarded : lambda -> lambda -> lambda
|
