@@ -1120,35 +1120,39 @@ let convert_lprim ~big_endian (prim : L.primitive) (args : Simple.t list list)
1120
1120
let dst = K.Standard_int_or_float. Naked_float in
1121
1121
[box_float mode (Unary (Num_conv { src; dst }, arg)) ~current_region ]
1122
1122
| Pnegfloat (Pfloat64, mode ), [[arg]] ->
1123
- [box_float mode (Unary (Float_arith Neg , unbox_float arg)) ~current_region ]
1123
+ [ box_float mode
1124
+ (Unary (Float_arith (Float64 , Neg ), unbox_float arg))
1125
+ ~current_region ]
1124
1126
| Pabsfloat (Pfloat64, mode ), [[arg]] ->
1125
- [box_float mode (Unary (Float_arith Abs , unbox_float arg)) ~current_region ]
1127
+ [ box_float mode
1128
+ (Unary (Float_arith (Float64 , Abs ), unbox_float arg))
1129
+ ~current_region ]
1126
1130
| Paddfloat (Pfloat64, mode ), [[arg1]; [arg2]] ->
1127
1131
[ box_float mode
1128
- (Binary (Float_arith Add , unbox_float arg1, unbox_float arg2))
1132
+ (Binary (Float_arith ( Float64 , Add ) , unbox_float arg1, unbox_float arg2))
1129
1133
~current_region ]
1130
1134
| Psubfloat (Pfloat64, mode ), [[arg1]; [arg2]] ->
1131
1135
[ box_float mode
1132
- (Binary (Float_arith Sub , unbox_float arg1, unbox_float arg2))
1136
+ (Binary (Float_arith ( Float64 , Sub ) , unbox_float arg1, unbox_float arg2))
1133
1137
~current_region ]
1134
1138
| Pmulfloat (Pfloat64, mode ), [[arg1]; [arg2]] ->
1135
1139
[ box_float mode
1136
- (Binary (Float_arith Mul , unbox_float arg1, unbox_float arg2))
1140
+ (Binary (Float_arith ( Float64 , Mul ) , unbox_float arg1, unbox_float arg2))
1137
1141
~current_region ]
1138
1142
| Pdivfloat (Pfloat64, mode ), [[arg1]; [arg2]] ->
1139
1143
[ box_float mode
1140
- (Binary (Float_arith Div , unbox_float arg1, unbox_float arg2))
1144
+ (Binary (Float_arith ( Float64 , Div ) , unbox_float arg1, unbox_float arg2))
1141
1145
~current_region ]
1142
1146
| Pfloatcomp (Pfloat64, comp ), [[arg1]; [arg2]] ->
1143
1147
[ tag_int
1144
1148
(Binary
1145
- ( Float_comp (Yielding_bool (convert_float_comparison comp)),
1149
+ ( Float_comp (Float64 , Yielding_bool (convert_float_comparison comp)),
1146
1150
unbox_float arg1,
1147
1151
unbox_float arg2 )) ]
1148
1152
| Punboxed_float_comp (Pfloat64, comp ), [[arg1]; [arg2]] ->
1149
1153
[ tag_int
1150
1154
(Binary
1151
- ( Float_comp (Yielding_bool (convert_float_comparison comp)),
1155
+ ( Float_comp (Float64 , Yielding_bool (convert_float_comparison comp)),
1152
1156
arg1,
1153
1157
arg2 )) ]
1154
1158
| Punbox_float Pfloat64 , [[arg]] -> [Unary (Unbox_number Naked_float , arg)]
@@ -1166,19 +1170,53 @@ let convert_lprim ~big_endian (prim : L.primitive) (args : Simple.t list list)
1166
1170
let src = K.Standard_int_or_float. Tagged_immediate in
1167
1171
let dst = K.Standard_int_or_float. Naked_float32 in
1168
1172
[box_float32 mode (Unary (Num_conv { src; dst }, arg)) ~current_region ]
1169
- | Pnegfloat (Pfloat32 , _), _
1170
- | Pabsfloat (Pfloat32 , _), _
1171
- | Paddfloat (Pfloat32 , _), _
1172
- | Psubfloat (Pfloat32 , _), _
1173
- | Pmulfloat (Pfloat32 , _), _
1174
- | Pdivfloat (Pfloat32 , _), _
1175
- | Pfloatcomp (Pfloat32 , _), _
1176
- | Punbox_float Pfloat32 , _
1177
- | Pbox_float (Pfloat32 , _), _
1178
- | Pcompare_floats Pfloat32 , _
1179
- | Punboxed_float_comp (Pfloat32, _ ), _ ->
1180
- (* CR mslater: (float32) runtime *)
1181
- assert false
1173
+ | Pnegfloat (Pfloat32, mode ), [[arg]] ->
1174
+ [ box_float32 mode
1175
+ (Unary (Float_arith (Float32 , Neg ), unbox_float32 arg))
1176
+ ~current_region ]
1177
+ | Pabsfloat (Pfloat32, mode ), [[arg]] ->
1178
+ [ box_float32 mode
1179
+ (Unary (Float_arith (Float32 , Abs ), unbox_float32 arg))
1180
+ ~current_region ]
1181
+ | Paddfloat (Pfloat32, mode ), [[arg1]; [arg2]] ->
1182
+ [ box_float32 mode
1183
+ (Binary
1184
+ (Float_arith (Float32 , Add ), unbox_float32 arg1, unbox_float32 arg2))
1185
+ ~current_region ]
1186
+ | Psubfloat (Pfloat32, mode ), [[arg1]; [arg2]] ->
1187
+ [ box_float32 mode
1188
+ (Binary
1189
+ (Float_arith (Float32 , Sub ), unbox_float32 arg1, unbox_float32 arg2))
1190
+ ~current_region ]
1191
+ | Pmulfloat (Pfloat32, mode ), [[arg1]; [arg2]] ->
1192
+ [ box_float32 mode
1193
+ (Binary
1194
+ (Float_arith (Float32 , Mul ), unbox_float32 arg1, unbox_float32 arg2))
1195
+ ~current_region ]
1196
+ | Pdivfloat (Pfloat32, mode ), [[arg1]; [arg2]] ->
1197
+ [ box_float32 mode
1198
+ (Binary
1199
+ (Float_arith (Float32 , Div ), unbox_float32 arg1, unbox_float32 arg2))
1200
+ ~current_region ]
1201
+ | Pfloatcomp (Pfloat32, comp ), [[arg1]; [arg2]] ->
1202
+ [ tag_int
1203
+ (Binary
1204
+ ( Float_comp (Float32 , Yielding_bool (convert_float_comparison comp)),
1205
+ unbox_float32 arg1,
1206
+ unbox_float32 arg2 )) ]
1207
+ | Punboxed_float_comp (Pfloat32, comp ), [[arg1]; [arg2]] ->
1208
+ [ tag_int
1209
+ (Binary
1210
+ ( Float_comp (Float32 , Yielding_bool (convert_float_comparison comp)),
1211
+ arg1,
1212
+ arg2 )) ]
1213
+ | Punbox_float Pfloat32 , [[arg]] -> [Unary (Unbox_number Naked_float32 , arg)]
1214
+ | Pbox_float (Pfloat32, mode ), [[arg]] ->
1215
+ [ Unary
1216
+ ( Box_number
1217
+ ( Naked_float32 ,
1218
+ Alloc_mode.For_allocations. from_lambda mode ~current_region ),
1219
+ arg ) ]
1182
1220
| Punbox_int bi , [[arg]] ->
1183
1221
let kind = boxable_number_of_boxed_integer bi in
1184
1222
[Unary (Unbox_number kind, arg)]
@@ -1818,9 +1856,15 @@ let convert_lprim ~big_endian (prim : L.primitive) (args : Simple.t list list)
1818
1856
| Pcompare_floats Pfloat64 , [[f1]; [f2]] ->
1819
1857
[ tag_int
1820
1858
(Binary
1821
- ( Float_comp (Yielding_int_like_compare_functions () ),
1859
+ ( Float_comp (Float64 , Yielding_int_like_compare_functions () ),
1822
1860
Prim (Unary (Unbox_number Naked_float , f1)),
1823
1861
Prim (Unary (Unbox_number Naked_float , f2)) )) ]
1862
+ | Pcompare_floats Pfloat32 , [[f1]; [f2]] ->
1863
+ [ tag_int
1864
+ (Binary
1865
+ ( Float_comp (Float32 , Yielding_int_like_compare_functions () ),
1866
+ Prim (Unary (Unbox_number Naked_float32 , f1)),
1867
+ Prim (Unary (Unbox_number Naked_float32 , f2)) )) ]
1824
1868
| Pcompare_bints int_kind , [[i1]; [i2]] ->
1825
1869
let unboxing_kind = boxable_number_of_boxed_integer int_kind in
1826
1870
[ tag_int
@@ -1860,18 +1904,17 @@ let convert_lprim ~big_endian (prim : L.primitive) (args : Simple.t list list)
1860
1904
%a (%a)"
1861
1905
Printlambda. primitive prim H. print_list_of_simple_or_prim
1862
1906
(List. flatten args)
1863
- | ( ( Pfield _ | Pnegint | Pnot | Poffsetint _
1864
- | Pintoffloat (Pfloat64 | Pfloat32 )
1865
- | Pfloatofint ((Pfloat64 | Pfloat32 ), _)
1907
+ | ( ( Pfield _ | Pnegint | Pnot | Poffsetint _ | Pintoffloat _
1908
+ | Pfloatofint (_, _)
1866
1909
| Pfloatoffloat32 _ | Pfloat32offloat _
1867
- | Pnegfloat (Pfloat64 , _)
1868
- | Pabsfloat (Pfloat64 , _)
1910
+ | Pnegfloat (_ , _)
1911
+ | Pabsfloat (_ , _)
1869
1912
| Pstringlength | Pbyteslength | Pbintofint _ | Pintofbint _ | Pnegbint _
1870
1913
| Popaque _ | Pduprecord _ | Parraylength _ | Pduparray _ | Pfloatfield _
1871
1914
| Pcvtbint _ | Poffsetref _ | Pbswap16 | Pbbswap _ | Pisint _
1872
1915
| Pint_as_pointer _ | Pbigarraydim _ | Pobj_dup | Pobj_magic _
1873
- | Punbox_float Pfloat64
1874
- | Pbox_float (Pfloat64 , _)
1916
+ | Punbox_float _
1917
+ | Pbox_float (_ , _)
1875
1918
| Punbox_int _ | Pbox_int _ | Punboxed_product_field _ | Pget_header _
1876
1919
| Pufloatfield _ | Patomic_load _ | Pmixedfield _ ),
1877
1920
([] | _ :: _ :: _ | [([] | _ :: _ :: _ )]) ) ->
@@ -1881,12 +1924,12 @@ let convert_lprim ~big_endian (prim : L.primitive) (args : Simple.t list list)
1881
1924
Printlambda. primitive prim H. print_list_of_lists_of_simple_or_prim args
1882
1925
| ( ( Paddint | Psubint | Pmulint | Pandint | Porint | Pxorint | Plslint
1883
1926
| Plsrint | Pasrint | Pdivint _ | Pmodint _ | Psetfield _ | Pintcomp _
1884
- | Paddfloat (Pfloat64 , _)
1885
- | Psubfloat (Pfloat64 , _)
1886
- | Pmulfloat (Pfloat64 , _)
1887
- | Pdivfloat (Pfloat64 , _)
1888
- | Pfloatcomp (Pfloat64 , _)
1889
- | Punboxed_float_comp (Pfloat64 , _)
1927
+ | Paddfloat (_ , _)
1928
+ | Psubfloat (_ , _)
1929
+ | Pmulfloat (_ , _)
1930
+ | Pdivfloat (_ , _)
1931
+ | Pfloatcomp (_ , _)
1932
+ | Punboxed_float_comp (_ , _)
1890
1933
| Pstringrefu | Pbytesrefu | Pstringrefs | Pbytesrefs | Pstring_load_16 _
1891
1934
| Pstring_load_32 _ | Pstring_load_64 _ | Pstring_load_128 _
1892
1935
| Pbytes_load_16 _ | Pbytes_load_32 _ | Pbytes_load_64 _
0 commit comments