package / ocaml-base-compiler.4.10.0 / middle_end / convert_primitives.ml
1 (**************************************************************************)
2 (* *)
3 (* OCaml *)
4 (* *)
5 (* Pierre Chambart, OCamlPro *)
6 (* Mark Shinwell and Leo White, Jane Street Europe *)
7 (* *)
8 (* Copyright 2017 OCamlPro SAS *)
9 (* Copyright 2017 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 let convert_unsafety is_unsafe : Clambda_primitives.is_safe =
20 if is_unsafe then
21 Unsafe
22 else
23 Safe
24
25 let convert (prim : Lambda.primitive) : Clambda_primitives.primitive =
26 match prim with
27 | Pmakeblock (tag, mutability, shape) ->
28 Pmakeblock (tag, mutability, shape)
29 | Pfield field -> Pfield field
30 | Pfield_computed -> Pfield_computed
31 | Psetfield (field, imm_or_pointer, init_or_assign) ->
32 Psetfield (field, imm_or_pointer, init_or_assign)
33 | Psetfield_computed (imm_or_pointer, init_or_assign) ->
34 Psetfield_computed (imm_or_pointer, init_or_assign)
35 | Pfloatfield field -> Pfloatfield field
36 | Psetfloatfield (field, init_or_assign) ->
37 Psetfloatfield (field, init_or_assign)
38 | Pduprecord (repr, size) -> Pduprecord (repr, size)
39 | Pccall prim -> Pccall prim
40 | Praise kind -> Praise kind
41 | Psequand -> Psequand
42 | Psequor -> Psequor
43 | Pnot -> Pnot
44 | Pnegint -> Pnegint
45 | Paddint -> Paddint
46 | Psubint -> Psubint
47 | Pmulint -> Pmulint
48 | Pdivint is_safe -> Pdivint is_safe
49 | Pmodint is_safe -> Pmodint is_safe
50 | Pandint -> Pandint
51 | Porint -> Porint
52 | Pxorint -> Pxorint
53 | Plslint -> Plslint
54 | Plsrint -> Plsrint
55 | Pasrint -> Pasrint
56 | Pintcomp comp -> Pintcomp comp
57 | Poffsetint offset -> Poffsetint offset
58 | Poffsetref offset -> Poffsetref offset
59 | Pintoffloat -> Pintoffloat
60 | Pfloatofint -> Pfloatofint
61 | Pnegfloat -> Pnegfloat
62 | Pabsfloat -> Pabsfloat
63 | Paddfloat -> Paddfloat
64 | Psubfloat -> Psubfloat
65 | Pmulfloat -> Pmulfloat
66 | Pdivfloat -> Pdivfloat
67 | Pfloatcomp comp -> Pfloatcomp comp
68 | Pstringlength -> Pstringlength
69 | Pstringrefu -> Pstringrefu
70 | Pstringrefs -> Pstringrefs
71 | Pbyteslength -> Pbyteslength
72 | Pbytesrefu -> Pbytesrefu
73 | Pbytessetu -> Pbytessetu
74 | Pbytesrefs -> Pbytesrefs
75 | Pbytessets -> Pbytessets
76 | Pmakearray (kind, mutability) -> Pmakearray (kind, mutability)
77 | Pduparray (kind, mutability) -> Pduparray (kind, mutability)
78 | Parraylength kind -> Parraylength kind
79 | Parrayrefu kind -> Parrayrefu kind
80 | Parraysetu kind -> Parraysetu kind
81 | Parrayrefs kind -> Parrayrefs kind
82 | Parraysets kind -> Parraysets kind
83 | Pisint -> Pisint
84 | Pisout -> Pisout
85 | Pcvtbint (src, dest) -> Pcvtbint (src, dest)
86 | Pnegbint bi -> Pnegbint bi
87 | Paddbint bi -> Paddbint bi
88 | Psubbint bi -> Psubbint bi
89 | Pmulbint bi -> Pmulbint bi
90 | Pbintofint bi -> Pbintofint bi
91 | Pintofbint bi -> Pintofbint bi
92 | Pandbint bi -> Pandbint bi
93 | Porbint bi -> Porbint bi
94 | Pxorbint bi -> Pxorbint bi
95 | Plslbint bi -> Plslbint bi
96 | Plsrbint bi -> Plsrbint bi
97 | Pasrbint bi -> Pasrbint bi
98 | Pbbswap bi -> Pbbswap bi
99 | Pdivbint { size; is_safe } -> Pdivbint { size; is_safe }
100 | Pmodbint { size; is_safe } -> Pmodbint { size; is_safe }
101 | Pbintcomp (bi, comp) -> Pbintcomp (bi, comp)
102 | Pbigarrayref (safe, dims, kind, layout) ->
103 Pbigarrayref (safe, dims, kind, layout)
104 | Pbigarrayset (safe, dims, kind, layout) ->
105 Pbigarrayset (safe, dims, kind, layout)
106 | Pstring_load_16 is_unsafe ->
107 Pstring_load (Sixteen, convert_unsafety is_unsafe)
108 | Pstring_load_32 is_unsafe ->
109 Pstring_load (Thirty_two, convert_unsafety is_unsafe)
110 | Pstring_load_64 is_unsafe ->
111 Pstring_load (Sixty_four, convert_unsafety is_unsafe)
112 | Pbytes_load_16 is_unsafe ->
113 Pbytes_load (Sixteen, convert_unsafety is_unsafe)
114 | Pbytes_load_32 is_unsafe ->
115 Pbytes_load (Thirty_two, convert_unsafety is_unsafe)
116 | Pbytes_load_64 is_unsafe ->
117 Pbytes_load (Sixty_four, convert_unsafety is_unsafe)
118 | Pbytes_set_16 is_unsafe ->
119 Pbytes_set (Sixteen, convert_unsafety is_unsafe)
120 | Pbytes_set_32 is_unsafe ->
121 Pbytes_set (Thirty_two, convert_unsafety is_unsafe)
122 | Pbytes_set_64 is_unsafe ->
123 Pbytes_set (Sixty_four, convert_unsafety is_unsafe)
124 | Pbigstring_load_16 is_unsafe ->
125 Pbigstring_load (Sixteen, convert_unsafety is_unsafe)
126 | Pbigstring_load_32 is_unsafe ->
127 Pbigstring_load (Thirty_two, convert_unsafety is_unsafe)
128 | Pbigstring_load_64 is_unsafe ->
129 Pbigstring_load (Sixty_four, convert_unsafety is_unsafe)
130 | Pbigstring_set_16 is_unsafe ->
131 Pbigstring_set (Sixteen, convert_unsafety is_unsafe)
132 | Pbigstring_set_32 is_unsafe ->
133 Pbigstring_set (Thirty_two, convert_unsafety is_unsafe)
134 | Pbigstring_set_64 is_unsafe ->
135 Pbigstring_set (Sixty_four, convert_unsafety is_unsafe)
136 | Pbigarraydim dim -> Pbigarraydim dim
137 | Pbswap16 -> Pbswap16
138 | Pint_as_pointer -> Pint_as_pointer
139 | Popaque -> Popaque
140
141 | Pbytes_to_string
142 | Pbytes_of_string
143 | Pctconst _
144 | Pignore
145 | Prevapply
146 | Pdirapply
147 | Pidentity
148 | Pgetglobal _
149 | Psetglobal _
150 ->
151 Misc.fatal_errorf "lambda primitive %a can't be converted to \
152 clambda primitive"
153 Printlambda.primitive prim
154