package / ocaml-base-compiler.4.10.0 / middle_end / semantics_of_primitives.ml
154 lines | 4814 chars
1 (**************************************************************************)
2 (* *)
3 (* OCaml *)
4 (* *)
5 (* Pierre Chambart, OCamlPro *)
6 (* Mark Shinwell and Leo White, Jane Street Europe *)
7 (* *)
8 (* Copyright 2013--2016 OCamlPro SAS *)
9 (* Copyright 2014--2016 Jane Street Group LLC *)
10 (* *)
11 (* All rights reserved. This file is distributed under the terms of *)
12 (* the GNU Lesser General Public License version 2.1, with the *)
13 (* special exception on linking described in the file LICENSE. *)
14 (* *)
15 (**************************************************************************)
16
17 [@@@ocaml.warning "+a-4-9-30-40-41-42"]
18
19 type effects = No_effects | Only_generative_effects | Arbitrary_effects
20 type coeffects = No_coeffects | Has_coeffects
21
22 let for_primitive (prim : Clambda_primitives.primitive) =
23 match prim with
24 | Pmakeblock _
25 | Pmakearray (_, Mutable) -> Only_generative_effects, No_coeffects
26 | Pmakearray (_, Immutable) -> No_effects, No_coeffects
27 | Pduparray (_, Immutable) ->
28 No_effects, No_coeffects (* Pduparray (_, Immutable) is allowed only on
29 immutable arrays. *)
30 | Pduparray (_, Mutable) | Pduprecord _ ->
31 Only_generative_effects, Has_coeffects
32 | Pccall { prim_name =
33 ( "caml_format_float" | "caml_format_int" | "caml_int32_format"
34 | "caml_nativeint_format" | "caml_int64_format" ) } ->
35 No_effects, No_coeffects
36 | Pccall _ -> Arbitrary_effects, Has_coeffects
37 | Praise _ -> Arbitrary_effects, No_coeffects
38 | Pnot
39 | Pnegint
40 | Paddint
41 | Psubint
42 | Pmulint
43 | Pandint
44 | Porint
45 | Pxorint
46 | Plslint
47 | Plsrint
48 | Pasrint
49 | Pintcomp _ -> No_effects, No_coeffects
50 | Pdivbint { is_safe = Unsafe }
51 | Pmodbint { is_safe = Unsafe }
52 | Pdivint Unsafe
53 | Pmodint Unsafe ->
54 No_effects, No_coeffects (* Will not raise [Division_by_zero]. *)
55 | Pdivbint { is_safe = Safe }
56 | Pmodbint { is_safe = Safe }
57 | Pdivint Safe
58 | Pmodint Safe ->
59 Arbitrary_effects, No_coeffects
60 | Poffsetint _ -> No_effects, No_coeffects
61 | Poffsetref _ -> Arbitrary_effects, Has_coeffects
62 | Pintoffloat
63 | Pfloatofint
64 | Pnegfloat
65 | Pabsfloat
66 | Paddfloat
67 | Psubfloat
68 | Pmulfloat
69 | Pdivfloat
70 | Pfloatcomp _ -> No_effects, No_coeffects
71 | Pstringlength | Pbyteslength
72 | Parraylength _ ->
73 No_effects, Has_coeffects (* That old chestnut: [Obj.truncate]. *)
74 | Pisint
75 | Pisout
76 | Pbintofint _
77 | Pintofbint _
78 | Pcvtbint _
79 | Pnegbint _
80 | Paddbint _
81 | Psubbint _
82 | Pmulbint _
83 | Pandbint _
84 | Porbint _
85 | Pxorbint _
86 | Plslbint _
87 | Plsrbint _
88 | Pasrbint _
89 | Pbintcomp _ -> No_effects, No_coeffects
90 | Pbigarraydim _ ->
91 No_effects, Has_coeffects (* Some people resize bigarrays in place. *)
92 | Pread_symbol _
93 | Pfield _
94 | Pfield_computed
95 | Pfloatfield _
96 | Parrayrefu _
97 | Pstringrefu
98 | Pbytesrefu
99 | Pstring_load (_, Unsafe)
100 | Pbytes_load (_, Unsafe)
101 | Pbigarrayref (true, _, _, _)
102 | Pbigstring_load (_, Unsafe) ->
103 No_effects, Has_coeffects
104 | Parrayrefs _
105 | Pstringrefs
106 | Pbytesrefs
107 | Pstring_load (_, Safe)
108 | Pbytes_load (_, Safe)
109 | Pbigarrayref (false, _, _, _)
110 | Pbigstring_load (_, Safe) ->
111 (* May trigger a bounds check exception. *)
112 Arbitrary_effects, Has_coeffects
113 | Psetfield _
114 | Psetfield_computed _
115 | Psetfloatfield _
116 | Parraysetu _
117 | Parraysets _
118 | Pbytessetu
119 | Pbytessets
120 | Pbytes_set _
121 | Pbigarrayset _
122 | Pbigstring_set _ ->
123 (* Whether or not some of these are "unsafe" is irrelevant; they always
124 have an effect. *)
125 Arbitrary_effects, No_coeffects
126 | Pbswap16
127 | Pbbswap _ -> No_effects, No_coeffects
128 | Pint_as_pointer -> No_effects, No_coeffects
129 | Popaque -> Arbitrary_effects, Has_coeffects
130 | Psequand
131 | Psequor ->
132 (* Removed by [Closure_conversion] in the flambda pipeline. *)
133 No_effects, No_coeffects
134
135 type return_type =
136 | Float
137 | Other
138
139 let return_type_of_primitive (prim:Clambda_primitives.primitive) =
140 match prim with
141 | Pfloatofint
142 | Pnegfloat
143 | Pabsfloat
144 | Paddfloat
145 | Psubfloat
146 | Pmulfloat
147 | Pdivfloat
148 | Pfloatfield _
149 | Parrayrefu Pfloatarray
150 | Parrayrefs Pfloatarray ->
151 Float
152 | _ ->
153 Other
154