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 *)
(* *)
(* Pierre Chambart, OCamlPro *)
(* Mark Shinwell and Leo White, Jane Street Europe *)
(* *)
(* Copyright 2013--2016 OCamlPro SAS *)
(* Copyright 2014--2016 Jane Street Group LLC *)
(* *)
(* 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. *)
(* *)
(**************************************************************************)
[@@@ocaml.warning "+a-4-9-30-40-41-42"]
type effects = No_effects | Only_generative_effects | Arbitrary_effects
type coeffects = No_coeffects | Has_coeffects
let for_primitive (prim : Clambda_primitives.primitive) =
match prim with
| Pmakeblock _
| Pmakearray (_, Mutable) -> Only_generative_effects, No_coeffects
| Pmakearray (_, Immutable) -> No_effects, No_coeffects
| Pduparray (_, Immutable) ->
No_effects, No_coeffects (* Pduparray (_, Immutable) is allowed only on
immutable arrays. *)
| Pduparray (_, Mutable) | Pduprecord _ ->
Only_generative_effects, Has_coeffects
| Pccall { prim_name =
( "caml_format_float" | "caml_format_int" | "caml_int32_format"
| "caml_nativeint_format" | "caml_int64_format" ) } ->
No_effects, No_coeffects
| Pccall _ -> Arbitrary_effects, Has_coeffects
| Praise _ -> Arbitrary_effects, No_coeffects
| Pnot
| Pnegint
| Paddint
| Psubint
| Pmulint
| Pandint
| Porint
| Pxorint
| Plslint
| Plsrint
| Pasrint
| Pintcomp _ -> No_effects, No_coeffects
| Pcompare_ints | Pcompare_floats | Pcompare_bints _
-> No_effects, No_coeffects
| Pdivbint { is_safe = Unsafe }
| Pmodbint { is_safe = Unsafe }
| Pdivint Unsafe
| Pmodint Unsafe ->
No_effects, No_coeffects (* Will not raise [Division_by_zero]. *)
| Pdivbint { is_safe = Safe }
| Pmodbint { is_safe = Safe }
| Pdivint Safe
| Pmodint Safe ->
Arbitrary_effects, No_coeffects
| Poffsetint _ -> No_effects, No_coeffects
| Poffsetref _ -> Arbitrary_effects, Has_coeffects
| Pintoffloat
| Pfloatofint
| Pnegfloat
| Pabsfloat
| Paddfloat
| Psubfloat
| Pmulfloat
| Pdivfloat
| Pfloatcomp _ -> No_effects, No_coeffects
| Pstringlength | Pbyteslength
| Parraylength _ ->
No_effects, Has_coeffects (* That old chestnut: [Obj.truncate]. *)
| Pisint
| Pisout
| Pbintofint _
| Pintofbint _
| Pcvtbint _
| Pnegbint _
| Paddbint _
| Psubbint _
| Pmulbint _
| Pandbint _
| Porbint _
| Pxorbint _
| Plslbint _
| Plsrbint _
| Pasrbint _
| Pbintcomp _ -> No_effects, No_coeffects
| Pbigarraydim _ ->
No_effects, Has_coeffects (* Some people resize bigarrays in place. *)
| Pread_symbol _
| Pfield _
| Pfield_computed
| Pfloatfield _
| Parrayrefu _
| Pstringrefu
| Pbytesrefu
| Pstring_load (_, Unsafe)
| Pbytes_load (_, Unsafe)
| Pbigarrayref (true, _, _, _)
| Pbigstring_load (_, Unsafe) ->
No_effects, Has_coeffects
| Parrayrefs _
| Pstringrefs
| Pbytesrefs
| Pstring_load (_, Safe)
| Pbytes_load (_, Safe)
| Pbigarrayref (false, _, _, _)
| Pbigstring_load (_, Safe) ->
(* May trigger a bounds check exception. *)
Arbitrary_effects, Has_coeffects
| Psetfield _
| Psetfield_computed _
| Psetfloatfield _
| Parraysetu _
| Parraysets _
| Pbytessetu
| Pbytessets
| Pbytes_set _
| Pbigarrayset _
| Pbigstring_set _ ->
(* Whether or not some of these are "unsafe" is irrelevant; they always
have an effect. *)
Arbitrary_effects, No_coeffects
| Pbswap16
| Pbbswap _ -> No_effects, No_coeffects
| Pint_as_pointer -> No_effects, No_coeffects
| Popaque -> Arbitrary_effects, Has_coeffects
| Psequand
| Psequor ->
(* Removed by [Closure_conversion] in the flambda pipeline. *)
No_effects, No_coeffects
type return_type =
| Float
| Other
let return_type_of_primitive (prim:Clambda_primitives.primitive) =
match prim with
| Pfloatofint
| Pnegfloat
| Pabsfloat
| Paddfloat
| Psubfloat
| Pmulfloat
| Pdivfloat
| Pfloatfield _
| Parrayrefu Pfloatarray
| Parrayrefs Pfloatarray ->
Float
| _ ->
Other
|
