forked from ocaml/ocaml
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathclambda_primitives.ml
170 lines (153 loc) · 6.15 KB
/
clambda_primitives.ml
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
(**************************************************************************)
(* *)
(* 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. *)
(* *)
(**************************************************************************)
type mutable_flag = Asttypes.mutable_flag
type immediate_or_pointer = Lambda.immediate_or_pointer
type initialization_or_assignment = Lambda.initialization_or_assignment
type is_safe = Lambda.is_safe
type boxed =
| Boxed
| Unboxed
type memory_access_size =
| Sixteen
| Thirty_two
| Sixty_four
type lazy_block_tag = Lambda.lazy_block_tag
type primitive =
| Pread_symbol of string
(* Operations on heap blocks *)
| Pmakeblock of int * mutable_flag * block_shape
| Pmakelazyblock of lazy_block_tag
| Pfield of int * immediate_or_pointer * mutable_flag
| Pfield_computed
| Psetfield of int * immediate_or_pointer * initialization_or_assignment
| Psetfield_computed of immediate_or_pointer * initialization_or_assignment
| Pfloatfield of int
| Psetfloatfield of int * initialization_or_assignment
| Pduprecord of Types.record_representation * int
(* Context switches *)
| Prunstack
| Pperform
| Presume
| Preperform
(* External call *)
| Pccall of Primitive.description
(* Exceptions *)
| Praise of raise_kind
(* Boolean operations *)
| Psequand | Psequor | Pnot
(* Integer operations *)
| Pnegint | Paddint | Psubint | Pmulint
| Pdivint of is_safe | Pmodint of is_safe
| Pandint | Porint | Pxorint
| Plslint | Plsrint | Pasrint
| Pintcomp of integer_comparison
| Pcompare_ints | Pcompare_floats | Pcompare_bints of boxed_integer
| Poffsetint of int
| Poffsetref of int
(* Float operations *)
| Pintoffloat | Pfloatofint
| Pnegfloat | Pabsfloat
| Paddfloat | Psubfloat | Pmulfloat | Pdivfloat
| Pfloatcomp of float_comparison
(* String operations *)
| Pstringlength | Pstringrefu | Pstringrefs
| Pbyteslength | Pbytesrefu | Pbytessetu | Pbytesrefs | Pbytessets
(* Array operations *)
| Pmakearray of array_kind * mutable_flag
| Pduparray of array_kind * mutable_flag
(** For [Pduparray], the argument must be an immutable array.
The arguments of [Pduparray] give the kind and mutability of the
array being *produced* by the duplication. *)
| 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
(* 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 { size : boxed_integer; is_safe : is_safe }
| Pmodbint of { size : boxed_integer; is_safe : is_safe }
| 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 * 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
(* size of the nth dimension of a big array *)
| Pbigarraydim of int
(* load/set 16,32,64 bits from a string: (unsafe)*)
| Pstring_load of (memory_access_size * is_safe)
| Pbytes_load of (memory_access_size * is_safe)
| Pbytes_set of (memory_access_size * is_safe)
(* load/set 16,32,64 bits from a
(char, int8_unsigned_elt, c_layout) Bigarray.Array1.t : (unsafe) *)
| Pbigstring_load of (memory_access_size * is_safe)
| Pbigstring_set of (memory_access_size * is_safe)
(* byte swap *)
| Pbswap16
| Pbbswap of boxed_integer
(* Integer to external pointer *)
| Pint_as_pointer
(* Atomic operations *)
| Patomic_load
(* Inhibition of optimisation *)
| Popaque
(* Fetch domain-local state *)
| Pdls_get
(* Poll for runtime actions *)
| Ppoll
and integer_comparison = Lambda.integer_comparison =
Ceq | Cne | Clt | Cgt | Cle | Cge
and float_comparison = Lambda.float_comparison =
CFeq | CFneq | CFlt | CFnlt | CFgt | CFngt | CFle | CFnle | CFge | CFnge
and array_kind = Lambda.array_kind =
Pgenarray | Paddrarray | Pintarray | Pfloatarray
and value_kind = Lambda.value_kind =
(* CR mshinwell: Pfloatval should be renamed to Pboxedfloatval *)
Pgenval | Pfloatval | Pboxedintval of boxed_integer | Pintval
and block_shape = Lambda.block_shape
and boxed_integer = Primitive.boxed_integer =
Pnativeint | Pint32 | Pint64
and bigarray_kind = Lambda.bigarray_kind =
Pbigarray_unknown
| Pbigarray_float16 | 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 = Lambda.bigarray_layout =
Pbigarray_unknown_layout
| Pbigarray_c_layout
| Pbigarray_fortran_layout
and raise_kind = Lambda.raise_kind =
| Raise_regular
| Raise_reraise
| Raise_notrace
let equal (x: primitive) (y: primitive) = x = y