diff --git a/ml-proto/spec/int.ml b/ml-proto/spec/int.ml index 51a353ca9e..f53a18cc88 100644 --- a/ml-proto/spec/int.ml +++ b/ml-proto/spec/int.ml @@ -8,6 +8,7 @@ sig val zero : t val one : t val minus_one : t + val neg : t -> t val shift_left : t -> int -> t val shift_right : t -> int -> t val logand : t -> t -> t @@ -21,7 +22,6 @@ sig val shift_right_logical : t -> int -> t val of_int : int -> t val to_int : t -> int - val of_string : string -> t val to_string : t -> string val bitwidth : int @@ -103,6 +103,8 @@ struct let to_bits x = x let zero = Rep.zero + let ten = Rep.of_int 10 + let max_upper, max_lower = divrem_u Rep.minus_one ten (* add, sub, and mul are sign-agnostic and do not trap on overflow. *) let add = Rep.add @@ -208,7 +210,51 @@ struct let ge_s x y = x >= y let ge_u x y = cmp_u x (>=) y - let of_string = Rep.of_string + let parse_hexdigit = function + | '0' .. '9' as c -> Char.code c - Char.code '0' + | 'a' .. 'f' as c -> 0xa + Char.code c - Char.code 'a' + | 'A' .. 'F' as c -> 0xa + Char.code c - Char.code 'A' + | _ -> failwith "of_string" + + let parse_decdigit c = + if '0' > c || '9' < c then failwith "of_string"; + Rep.of_int (int_of_char c - Char.code '0') + + let require b = if not b then failwith "of_string" + + (* This implementation allows leading signs and unsigned values *) + let of_string x = + let open Rep in + let len = String.length x in + let rec parse_hex i num = + if i = len then num + else begin + require (le_u num (shr_u minus_one (of_int 4))); + parse_hex (i + 1) (logor (shift_left num 4) (of_int (parse_hexdigit x.[i]))) + end + in + let rec parse_dec i num = + if i = len then num + else begin + let new_digit = parse_decdigit x.[i] in + require (le_u num max_upper && (num <> max_upper || le_u new_digit max_lower)); + parse_dec (i + 1) (add (mul num ten) new_digit) + end + in + let parse_int i = + if i + 3 <= len && x.[i] = '0' && x.[i + 1] = 'x' then + parse_hex (i + 2) zero + else + parse_dec i zero + in + match x.[0] with + | '+' -> parse_int 1 + | '-' -> + let y = (parse_int 1) in + require (ge_s (sub y one) minus_one); + neg y + | _ -> parse_int 0 + let to_string = Rep.to_string let of_int = Rep.of_int diff --git a/ml-proto/test/int_literals.wast b/ml-proto/test/int_literals.wast index a60adb439d..bc545992dc 100644 --- a/ml-proto/test/int_literals.wast +++ b/ml-proto/test/int_literals.wast @@ -8,6 +8,8 @@ (func $i32.inc_smin (result i32) (return (i32.add (i32.const -0x80000000) (i32.const 1)))) (func $i32.neg_zero (result i32) (return (i32.const -0x0))) (func $i32.not_octal (result i32) (return (i32.const 010))) + (func $i32.unsigned_decimal (result i32) (return (i32.const 4294967295))) + (func $i32.plus_sign (result i32) (return (i32.const +42))) (func $i64.test (result i64) (return (i64.const 0x0CABBA6E0ba66a6e))) (func $i64.umax (result i64) (return (i64.const 0xffffffffffffffff))) @@ -18,6 +20,8 @@ (func $i64.inc_smin (result i64) (return (i64.add (i64.const -0x8000000000000000) (i64.const 1)))) (func $i64.neg_zero (result i64) (return (i64.const -0x0))) (func $i64.not_octal (result i64) (return (i64.const 010))) + (func $i64.unsigned_decimal (result i64) (return (i64.const 18446744073709551615))) + (func $i64.plus_sign (result i64) (return (i64.const +42))) (export "i32.test" $i32.test) (export "i32.umax" $i32.umax) @@ -28,6 +32,8 @@ (export "i32.inc_smin" $i32.inc_smin) (export "i32.neg_zero" $i32.neg_zero) (export "i32.not_octal" $i32.not_octal) + (export "i32.unsigned_decimal" $i32.unsigned_decimal) + (export "i32.plus_sign" $i32.plus_sign) (export "i64.test" $i64.test) (export "i64.umax" $i64.umax) @@ -38,6 +44,8 @@ (export "i64.inc_smin" $i64.inc_smin) (export "i64.neg_zero" $i64.neg_zero) (export "i64.not_octal" $i64.not_octal) + (export "i64.unsigned_decimal" $i64.unsigned_decimal) + (export "i64.plus_sign" $i64.plus_sign) ) (assert_return (invoke "i32.test") (i32.const 195940365)) @@ -49,6 +57,8 @@ (assert_return (invoke "i32.inc_smin") (i32.const -2147483647)) (assert_return (invoke "i32.neg_zero") (i32.const 0)) (assert_return (invoke "i32.not_octal") (i32.const 10)) +(assert_return (invoke "i32.unsigned_decimal") (i32.const -1)) +(assert_return (invoke "i32.plus_sign") (i32.const 42)) (assert_return (invoke "i64.test") (i64.const 913028331277281902)) (assert_return (invoke "i64.umax") (i64.const -1)) @@ -59,3 +69,5 @@ (assert_return (invoke "i64.inc_smin") (i64.const -9223372036854775807)) (assert_return (invoke "i64.neg_zero") (i64.const 0)) (assert_return (invoke "i64.not_octal") (i64.const 10)) +(assert_return (invoke "i64.unsigned_decimal") (i64.const -1)) +(assert_return (invoke "i64.plus_sign") (i64.const 42)) diff --git a/ml-proto/test/of_string-overflow-hex-u32.fail.wast b/ml-proto/test/of_string-overflow-hex-u32.fail.wast new file mode 100644 index 0000000000..1323a1f0b0 --- /dev/null +++ b/ml-proto/test/of_string-overflow-hex-u32.fail.wast @@ -0,0 +1 @@ +(module (func (i32.const 0x100000000))) diff --git a/ml-proto/test/of_string-overflow-hex-u64.fail.wast b/ml-proto/test/of_string-overflow-hex-u64.fail.wast new file mode 100644 index 0000000000..d13d6e4b46 --- /dev/null +++ b/ml-proto/test/of_string-overflow-hex-u64.fail.wast @@ -0,0 +1 @@ +(module (func (i64.const 0x10000000000000000))) diff --git a/ml-proto/test/of_string-overflow-s32.fail.wast b/ml-proto/test/of_string-overflow-s32.fail.wast new file mode 100644 index 0000000000..4dda960273 --- /dev/null +++ b/ml-proto/test/of_string-overflow-s32.fail.wast @@ -0,0 +1 @@ +(module (func (i32.const -2147483649))) diff --git a/ml-proto/test/of_string-overflow-s64.fail.wast b/ml-proto/test/of_string-overflow-s64.fail.wast new file mode 100644 index 0000000000..1034b0b001 --- /dev/null +++ b/ml-proto/test/of_string-overflow-s64.fail.wast @@ -0,0 +1 @@ +(module (func (i64.const -9223372036854775809))) diff --git a/ml-proto/test/of_string-overflow-u32.fail.wast b/ml-proto/test/of_string-overflow-u32.fail.wast new file mode 100644 index 0000000000..8f226177bd --- /dev/null +++ b/ml-proto/test/of_string-overflow-u32.fail.wast @@ -0,0 +1 @@ +(module (func (i32.const 4294967296))) diff --git a/ml-proto/test/of_string-overflow-u64.fail.wast b/ml-proto/test/of_string-overflow-u64.fail.wast new file mode 100644 index 0000000000..cfa2c46b58 --- /dev/null +++ b/ml-proto/test/of_string-overflow-u64.fail.wast @@ -0,0 +1 @@ +(module (func (i64.const 18446744073709551616)))