Skip to content

Commit 362eabc

Browse files
vouillonvouillon
committed
More refined type for caml_ba_uint8_* operations
1 parent 065a877 commit 362eabc

File tree

3 files changed

+67
-69
lines changed

3 files changed

+67
-69
lines changed

‎compiler/lib-wasm/generate.ml

Lines changed: 42 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -116,10 +116,12 @@ module Generate (Target : Target_sig.S) = struct
116116
; "caml_bytes_set32", (`Mutator, [ Value; Value; Int32 ], Value)
117117
; "caml_bytes_set64", (`Mutator, [ Value; Value; Int64 ], Value)
118118
; "caml_lxm_next", (`Pure, [ Value ], Int64)
119-
; "caml_ba_uint8_get32", (`Mutator, [ Value; Value ], Int32)
120-
; "caml_ba_uint8_get64", (`Mutator, [ Value; Value ], Int64)
121-
; "caml_ba_uint8_set32", (`Mutator, [ Value; Value; Int32 ], Value)
122-
; "caml_ba_uint8_set64", (`Mutator, [ Value; Value; Int64 ], Value)
119+
; "caml_ba_uint8_get16", (`Mutator, [ Value; Int ], Int)
120+
; "caml_ba_uint8_get32", (`Mutator, [ Value; Int ], Int32)
121+
; "caml_ba_uint8_get64", (`Mutator, [ Value; Int ], Int64)
122+
; "caml_ba_uint8_set16", (`Mutator, [ Value; Int; Int ], Value)
123+
; "caml_ba_uint8_set32", (`Mutator, [ Value; Int; Int32 ], Value)
124+
; "caml_ba_uint8_set64", (`Mutator, [ Value; Int; Int64 ], Value)
123125
; "caml_nextafter_float", (`Pure, [ Float; Float ], Float)
124126
; "caml_classify_float", (`Pure, [ Float ], Value)
125127
; "caml_ldexp_float", (`Pure, [ Float; Value ], Float)
@@ -1018,36 +1020,45 @@ module Generate (Target : Target_sig.S) = struct
10181020
match p with
10191021
| Extern name when String.Hashtbl.mem internal_primitives name ->
10201022
snd (String.Hashtbl.find internal_primitives name) ctx context l
1023+
| Extern name when String.Hashtbl.mem specialized_primitives name ->
1024+
let ((_, arg_typ, res_typ) as typ) =
1025+
String.Hashtbl.find specialized_primitives name
1026+
in
1027+
let* f = register_import ~name (Fun (specialized_primitive_type typ)) in
1028+
let rec loop acc arg_typ l =
1029+
match arg_typ, l with
1030+
| [], [] -> box_value res_typ (return (W.Call (f, List.rev acc)))
1031+
| repr :: rem, x :: r ->
1032+
let* x =
1033+
unbox_value
1034+
repr
1035+
(transl_prim_arg
1036+
ctx
1037+
?typ:
1038+
(match repr with
1039+
| Int -> Some (Int Normalized)
1040+
| _ -> None)
1041+
x)
1042+
in
1043+
loop (x :: acc) rem r
1044+
| [], _ :: _ | _ :: _, [] -> assert false
1045+
in
1046+
loop [] arg_typ l
10211047
| _ -> (
10221048
let l = List.map ~f:(fun x -> transl_prim_arg ctx x) l in
10231049
match p, l with
1024-
| Extern name, l -> (
1025-
try
1026-
let ((_, arg_typ, res_typ) as typ) =
1027-
String.Hashtbl.find specialized_primitives name
1028-
in
1029-
let* f = register_import ~name (Fun (specialized_primitive_type typ)) in
1030-
let rec loop acc arg_typ l =
1031-
match arg_typ, l with
1032-
| [], [] -> box_value res_typ (return (W.Call (f, List.rev acc)))
1033-
| repr :: rem, x :: r ->
1034-
let* x = unbox_value repr x in
1035-
loop (x :: acc) rem r
1036-
| [], _ :: _ | _ :: _, [] -> assert false
1037-
in
1038-
loop [] arg_typ l
1039-
with Not_found ->
1040-
let* f =
1041-
register_import ~name (Fun (Type.primitive_type (List.length l)))
1042-
in
1043-
let rec loop acc l =
1044-
match l with
1045-
| [] -> return (W.Call (f, List.rev acc))
1046-
| x :: r ->
1047-
let* x = x in
1048-
loop (x :: acc) r
1049-
in
1050-
loop [] l)
1050+
| Extern name, l ->
1051+
let* f =
1052+
register_import ~name (Fun (Type.primitive_type (List.length l)))
1053+
in
1054+
let rec loop acc l =
1055+
match l with
1056+
| [] -> return (W.Call (f, List.rev acc))
1057+
| x :: r ->
1058+
let* x = x in
1059+
loop (x :: acc) r
1060+
in
1061+
loop [] l
10511062
| IsInt, [ x ] -> Value.is_int x
10521063
| Vectlength, [ x ] -> Memory.gen_array_length x
10531064
| (Not | Lt | Le | Eq | Neq | Ult | Array_get | IsInt | Vectlength), _ ->

‎compiler/lib-wasm/typing.ml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -203,6 +203,7 @@ let prim_type ~approx prim args =
203203
| "caml_bytes_get32" -> Number Int32
204204
| "caml_bytes_get64" -> Number Int64
205205
| "caml_lxm_next" -> Number Int64
206+
| "caml_ba_uint8_get16" -> Int Normalized
206207
| "caml_ba_uint8_get32" -> Number Int32
207208
| "caml_ba_uint8_get64" -> Number Int64
208209
| "caml_nextafter_float" -> Number Float

‎runtime/wasm/bigarray.wat

Lines changed: 24 additions & 38 deletions
Original file line numberDiff line numberDiff line change
@@ -1923,117 +1923,103 @@
19231923
(return (i32.const 0)))
19241924

19251925
(func (export "caml_ba_uint8_get16")
1926-
(param $vba (ref eq)) (param $i (ref eq)) (result (ref eq))
1926+
(param $vba (ref eq)) (param $i i32) (result i32)
19271927
(local $ba (ref $bigarray))
19281928
(local $view (ref extern))
1929-
(local $p i32)
19301929
(local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
19311930
(local.set $view (struct.get $bigarray $ba_view (local.get $ba)))
1932-
(local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
1933-
(if (i32.lt_s (local.get $p) (i32.const 0))
1931+
(if (i32.lt_s (local.get $i) (i32.const 0))
19341932
(then (call $caml_bound_error)))
1935-
(if (i32.ge_u (i32.add (local.get $p) (i32.const 1))
1933+
(if (i32.ge_u (i32.add (local.get $i) (i32.const 1))
19361934
(array.get $int_array
19371935
(struct.get $bigarray $ba_dim (local.get $ba))
19381936
(i32.const 0)))
19391937
(then (call $caml_bound_error)))
1940-
(ref.i31
1941-
(call $dv_get_ui16 (local.get $view) (local.get $p) (i32.const 1))))
1938+
(call $dv_get_ui16 (local.get $view) (local.get $i) (i32.const 1)))
19421939

19431940
(func (export "caml_ba_uint8_get32")
1944-
(param $vba (ref eq)) (param $i (ref eq)) (result i32)
1941+
(param $vba (ref eq)) (param $i i32) (result i32)
19451942
(local $ba (ref $bigarray))
19461943
(local $view (ref extern))
1947-
(local $p i32)
19481944
(local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
19491945
(local.set $view (struct.get $bigarray $ba_view (local.get $ba)))
1950-
(local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
1951-
(if (i32.lt_s (local.get $p) (i32.const 0))
1946+
(if (i32.lt_s (local.get $i) (i32.const 0))
19521947
(then (call $caml_bound_error)))
1953-
(if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
1948+
(if (i32.ge_u (i32.add (local.get $i) (i32.const 3))
19541949
(array.get $int_array
19551950
(struct.get $bigarray $ba_dim (local.get $ba))
19561951
(i32.const 0)))
19571952
(then (call $caml_bound_error)))
1958-
(return_call $dv_get_i32 (local.get $view) (local.get $p) (i32.const 1)))
1953+
(return_call $dv_get_i32 (local.get $view) (local.get $i) (i32.const 1)))
19591954

19601955
(func (export "caml_ba_uint8_get64")
1961-
(param $vba (ref eq)) (param $i (ref eq)) (result i64)
1956+
(param $vba (ref eq)) (param $i i32) (result i64)
19621957
(local $ba (ref $bigarray))
19631958
(local $view (ref extern))
1964-
(local $p i32)
19651959
(local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
19661960
(local.set $view (struct.get $bigarray $ba_view (local.get $ba)))
1967-
(local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
1968-
(if (i32.lt_s (local.get $p) (i32.const 0))
1961+
(if (i32.lt_s (local.get $i) (i32.const 0))
19691962
(then (call $caml_bound_error)))
1970-
(if (i32.ge_u (i32.add (local.get $p) (i32.const 7))
1963+
(if (i32.ge_u (i32.add (local.get $i) (i32.const 7))
19711964
(array.get $int_array
19721965
(struct.get $bigarray $ba_dim (local.get $ba))
19731966
(i32.const 0)))
19741967
(then (call $caml_bound_error)))
19751968
(call $dv_get_i64
1976-
(local.get $view) (local.get $p) (i32.const 1)))
1969+
(local.get $view) (local.get $i) (i32.const 1)))
19771970

19781971
(func (export "caml_ba_uint8_set16")
1979-
(param $vba (ref eq)) (param $i (ref eq)) (param $v (ref eq))
1972+
(param $vba (ref eq)) (param $i i32) (param $d i32)
19801973
(result (ref eq))
19811974
(local $ba (ref $bigarray))
19821975
(local $view (ref extern))
1983-
(local $p i32) (local $d i32)
19841976
(local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
19851977
(local.set $view (struct.get $bigarray $ba_view (local.get $ba)))
1986-
(local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
1987-
(local.set $d (i31.get_s (ref.cast (ref i31) (local.get $v))))
1988-
(if (i32.lt_s (local.get $p) (i32.const 0))
1978+
(if (i32.lt_s (local.get $i) (i32.const 0))
19891979
(then (call $caml_bound_error)))
1990-
(if (i32.ge_u (i32.add (local.get $p) (i32.const 1))
1980+
(if (i32.ge_u (i32.add (local.get $i) (i32.const 1))
19911981
(array.get $int_array
19921982
(struct.get $bigarray $ba_dim (local.get $ba))
19931983
(i32.const 0)))
19941984
(then (call $caml_bound_error)))
19951985
(call $dv_set_i16
1996-
(local.get $view) (local.get $p) (local.get $d) (i32.const 1))
1986+
(local.get $view) (local.get $i) (local.get $d) (i32.const 1))
19971987
(ref.i31 (i32.const 0)))
19981988

19991989
(func (export "caml_ba_uint8_set32")
2000-
(param $vba (ref eq)) (param $i (ref eq)) (param $d i32)
1990+
(param $vba (ref eq)) (param $i i32) (param $d i32)
20011991
(result (ref eq))
20021992
(local $ba (ref $bigarray))
20031993
(local $view (ref extern))
2004-
(local $p i32)
20051994
(local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
20061995
(local.set $view (struct.get $bigarray $ba_view (local.get $ba)))
2007-
(local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
2008-
(if (i32.lt_s (local.get $p) (i32.const 0))
1996+
(if (i32.lt_s (local.get $i) (i32.const 0))
20091997
(then (call $caml_bound_error)))
2010-
(if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
1998+
(if (i32.ge_u (i32.add (local.get $i) (i32.const 3))
20111999
(array.get $int_array
20122000
(struct.get $bigarray $ba_dim (local.get $ba))
20132001
(i32.const 0)))
20142002
(then (call $caml_bound_error)))
20152003
(call $dv_set_i32
2016-
(local.get $view) (local.get $p) (local.get $d) (i32.const 1))
2004+
(local.get $view) (local.get $i) (local.get $d) (i32.const 1))
20172005
(ref.i31 (i32.const 0)))
20182006

20192007
(func (export "caml_ba_uint8_set64")
2020-
(param $vba (ref eq)) (param $i (ref eq)) (param $d i64)
2008+
(param $vba (ref eq)) (param $i i32) (param $d i64)
20212009
(result (ref eq))
20222010
(local $ba (ref $bigarray))
20232011
(local $view (ref extern))
2024-
(local $p i32)
20252012
(local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
20262013
(local.set $view (struct.get $bigarray $ba_view (local.get $ba)))
2027-
(local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
2028-
(if (i32.lt_s (local.get $p) (i32.const 0))
2014+
(if (i32.lt_s (local.get $i) (i32.const 0))
20292015
(then (call $caml_bound_error)))
2030-
(if (i32.ge_u (i32.add (local.get $p) (i32.const 7))
2016+
(if (i32.ge_u (i32.add (local.get $i) (i32.const 7))
20312017
(array.get $int_array
20322018
(struct.get $bigarray $ba_dim (local.get $ba))
20332019
(i32.const 0)))
20342020
(then (call $caml_bound_error)))
20352021
(call $dv_set_i64
2036-
(local.get $view) (local.get $p) (local.get $d) (i32.const 1))
2022+
(local.get $view) (local.get $i) (local.get $d) (i32.const 1))
20372023
(ref.i31 (i32.const 0)))
20382024

20392025
(export "caml_bytes_of_uint8_array" (func $caml_string_of_uint8_array))

0 commit comments

Comments
 (0)