summaryrefslogtreecommitdiff
path: root/middle_end/convert_primitives.ml
blob: 4ea177393e010b2122e89bc24e50bf33edc63387 (plain)
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
(**************************************************************************)
(*                                                                        *)
(*                                 OCaml                                  *)
(*                                                                        *)
(*                       Pierre Chambart, OCamlPro                        *)
(*           Mark Shinwell and Leo White, Jane Street Europe              *)
(*                                                                        *)
(*   Copyright 2017 OCamlPro SAS                                          *)
(*   Copyright 2017 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"]

let convert_unsafety is_unsafe : Clambda_primitives.is_safe =
  if is_unsafe then
    Unsafe
  else
    Safe

let convert (prim : Lambda.primitive) : Clambda_primitives.primitive =
  match prim with
  | Pmakeblock (tag, mutability, shape) ->
      Pmakeblock (tag, mutability, shape)
  | Pfield field -> Pfield field
  | Pfield_computed -> Pfield_computed
  | Psetfield (field, imm_or_pointer, init_or_assign) ->
      Psetfield (field, imm_or_pointer, init_or_assign)
  | Psetfield_computed (imm_or_pointer, init_or_assign) ->
      Psetfield_computed (imm_or_pointer, init_or_assign)
  | Pfloatfield field -> Pfloatfield field
  | Psetfloatfield (field, init_or_assign) ->
      Psetfloatfield (field, init_or_assign)
  | Pduprecord (repr, size) -> Pduprecord (repr, size)
  | Pccall prim -> Pccall prim
  | Praise kind -> Praise kind
  | Psequand -> Psequand
  | Psequor -> Psequor
  | Pnot -> Pnot
  | Pnegint -> Pnegint
  | Paddint -> Paddint
  | Psubint -> Psubint
  | Pmulint -> Pmulint
  | Pdivint is_safe -> Pdivint is_safe
  | Pmodint is_safe -> Pmodint is_safe
  | Pandint -> Pandint
  | Porint -> Porint
  | Pxorint -> Pxorint
  | Plslint -> Plslint
  | Plsrint -> Plsrint
  | Pasrint -> Pasrint
  | Pintcomp comp -> Pintcomp comp
  | Pcompare_ints -> Pcompare_ints
  | Pcompare_floats -> Pcompare_floats
  | Pcompare_bints bi -> Pcompare_bints bi
  | Poffsetint offset -> Poffsetint offset
  | Poffsetref offset -> Poffsetref offset
  | Pintoffloat -> Pintoffloat
  | Pfloatofint -> Pfloatofint
  | Pnegfloat -> Pnegfloat
  | Pabsfloat -> Pabsfloat
  | Paddfloat -> Paddfloat
  | Psubfloat -> Psubfloat
  | Pmulfloat -> Pmulfloat
  | Pdivfloat -> Pdivfloat
  | Pfloatcomp comp -> Pfloatcomp comp
  | Pstringlength -> Pstringlength
  | Pstringrefu -> Pstringrefu
  | Pstringrefs -> Pstringrefs
  | Pbyteslength -> Pbyteslength
  | Pbytesrefu -> Pbytesrefu
  | Pbytessetu -> Pbytessetu
  | Pbytesrefs -> Pbytesrefs
  | Pbytessets -> Pbytessets
  | Pmakearray (kind, mutability) -> Pmakearray (kind, mutability)
  | Pduparray (kind, mutability) -> Pduparray (kind, mutability)
  | Parraylength kind -> Parraylength kind
  | Parrayrefu kind -> Parrayrefu kind
  | Parraysetu kind -> Parraysetu kind
  | Parrayrefs kind -> Parrayrefs kind
  | Parraysets kind -> Parraysets kind
  | Pisint -> Pisint
  | Pisout -> Pisout
  | Pcvtbint (src, dest) -> Pcvtbint (src, dest)
  | Pnegbint bi -> Pnegbint bi
  | Paddbint bi -> Paddbint bi
  | Psubbint bi -> Psubbint bi
  | Pmulbint bi -> Pmulbint bi
  | Pbintofint bi -> Pbintofint bi
  | Pintofbint bi -> Pintofbint bi
  | Pandbint bi -> Pandbint bi
  | Porbint bi -> Porbint bi
  | Pxorbint bi -> Pxorbint bi
  | Plslbint bi -> Plslbint bi
  | Plsrbint bi -> Plsrbint bi
  | Pasrbint bi -> Pasrbint bi
  | Pbbswap bi -> Pbbswap bi
  | Pdivbint { size; is_safe } -> Pdivbint { size; is_safe }
  | Pmodbint { size; is_safe } -> Pmodbint { size; is_safe }
  | Pbintcomp (bi, comp) -> Pbintcomp (bi, comp)
  | Pbigarrayref (safe, dims, kind, layout) ->
      Pbigarrayref (safe, dims, kind, layout)
  | Pbigarrayset (safe, dims, kind, layout) ->
      Pbigarrayset (safe, dims, kind, layout)
  | Pstring_load_16 is_unsafe ->
      Pstring_load (Sixteen, convert_unsafety is_unsafe)
  | Pstring_load_32 is_unsafe ->
      Pstring_load (Thirty_two, convert_unsafety is_unsafe)
  | Pstring_load_64 is_unsafe ->
      Pstring_load (Sixty_four, convert_unsafety is_unsafe)
  | Pbytes_load_16 is_unsafe ->
      Pbytes_load (Sixteen, convert_unsafety is_unsafe)
  | Pbytes_load_32 is_unsafe ->
      Pbytes_load (Thirty_two, convert_unsafety is_unsafe)
  | Pbytes_load_64 is_unsafe ->
      Pbytes_load (Sixty_four, convert_unsafety is_unsafe)
  | Pbytes_set_16 is_unsafe ->
      Pbytes_set (Sixteen, convert_unsafety is_unsafe)
  | Pbytes_set_32 is_unsafe ->
      Pbytes_set (Thirty_two, convert_unsafety is_unsafe)
  | Pbytes_set_64 is_unsafe ->
      Pbytes_set (Sixty_four, convert_unsafety is_unsafe)
  | Pbigstring_load_16 is_unsafe ->
      Pbigstring_load (Sixteen, convert_unsafety is_unsafe)
  | Pbigstring_load_32 is_unsafe ->
      Pbigstring_load (Thirty_two, convert_unsafety is_unsafe)
  | Pbigstring_load_64 is_unsafe ->
      Pbigstring_load (Sixty_four, convert_unsafety is_unsafe)
  | Pbigstring_set_16 is_unsafe ->
      Pbigstring_set (Sixteen, convert_unsafety is_unsafe)
  | Pbigstring_set_32 is_unsafe ->
      Pbigstring_set (Thirty_two, convert_unsafety is_unsafe)
  | Pbigstring_set_64 is_unsafe ->
      Pbigstring_set (Sixty_four, convert_unsafety is_unsafe)
  | Pbigarraydim dim -> Pbigarraydim dim
  | Pbswap16 -> Pbswap16
  | Pint_as_pointer -> Pint_as_pointer
  | Popaque -> Popaque

  | Pbytes_to_string
  | Pbytes_of_string
  | Pctconst _
  | Pignore
  | Prevapply
  | Pdirapply
  | Pidentity
  | Pgetglobal _
  | Psetglobal _
    ->
      Misc.fatal_errorf "lambda primitive %a can't be converted to \
                         clambda primitive"
        Printlambda.primitive prim