Write integer of_string from scratch

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

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))

ml-proto/test/of_string-overflow-hex-u32.fail.wast

@@ -0,0 +1 @@
+(module (func (i32.const 0x100000000)))

ml-proto/test/of_string-overflow-hex-u64.fail.wast

@@ -0,0 +1 @@
+(module (func (i64.const 0x10000000000000000)))

ml-proto/test/of_string-overflow-s32.fail.wast

@@ -0,0 +1 @@
+(module (func (i32.const -2147483649)))

ml-proto/test/of_string-overflow-s64.fail.wast

@@ -0,0 +1 @@
+(module (func (i64.const -9223372036854775809)))

ml-proto/test/of_string-overflow-u32.fail.wast

@@ -0,0 +1 @@
+(module (func (i32.const 4294967296)))

ml-proto/test/of_string-overflow-u64.fail.wast

@@ -0,0 +1 @@
+(module (func (i64.const 18446744073709551616)))