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
|
(**************************************************************************)
(* *)
(* 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)
| Pmakelazyblock tag ->
Pmakelazyblock tag
| Pfield (field, imm_or_pointer, mutability) ->
Pfield (field, imm_or_pointer, mutability)
| 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)
| Prunstack -> Prunstack
| Pperform -> Pperform
| Presume -> Presume
| Preperform -> Preperform
| 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
| Patomic_load -> Patomic_load
| Popaque -> Popaque
| Pdls_get -> Pdls_get
| Ppoll -> Ppoll
| Pbytes_to_string
| Pbytes_of_string
| Pctconst _
| Pignore
| Pgetglobal _
| Psetglobal _
->
Misc.fatal_errorf "lambda primitive %a can't be converted to \
clambda primitive"
Printlambda.primitive prim
|