Browse Source

remove useless stuff, use latest menhir

pull/2/head
zapashcanon 6 months ago
parent
commit
c5b7587118
Signed by: zapashcanon GPG Key ID: 8981C3C62D1D28F1
  1. 3
      dune-project
  2. 40
      src/dune
  3. 113
      src/int32.ml
  4. 30920
      src/menhir_parser.messages
  5. 8
      src/menhir_parser.mly

3
dune-project

@ -1,5 +1,7 @@
(lang dune 2.8)
(using menhir 2.1)
(name woi)
(license ISC)
@ -24,4 +26,3 @@
(>= 4.08))
(integers
(>= 0.5.1))))
(using menhir 2.1)

40
src/dune

@ -12,7 +12,6 @@
interpret
lexer
menhir_parser
menhir_parser_errors
pp
simplify
stack
@ -31,42 +30,5 @@
(libraries sedlex woi))
(menhir
(flags --table --canonical --explain)
(flags --table --canonical)
(modules menhir_parser))
(rule
(target menhir_parser_errors.ml)
(action
(with-stdout-to
menhir_parser_errors.ml
(run
menhir
--canonical
menhir_parser.mly
;--compile-errors
;menhir_parser.messages
)))
(deps menhir_parser.mly menhir_parser.messages))
;(rule
; (alias gen_menhir_messages)
; (target menhir_parser.messages.raw)
; (action
; (with-stdout-to
; menhir_parser.messages.raw
; (run menhir --canonical --list-errors menhir_parser.mly)))
; (deps menhir_parser.mly))
;(rule
; (alias update_menhir_messages)
; (target menhir_parser.messages.new)
; (action
; (with-stdout-to
; menhir_parser.messages.new
; (run
; menhir
; --canonical
; --update-errors
; menhir_parser.messages
; menhir_parser.mly)))
; (deps menhir_parser.mly menhir_parser.messages))

113
src/int32.ml

@ -9,8 +9,6 @@ let popcnt =
let mask = 0xffff_ffffL in
fun [@inline] x -> Int64.popcnt (Int64.logand (Int64.of_int32 x) mask)
let bitwidth = 32
let to_hex_string = Printf.sprintf "%lx"
let of_int64 = Int64.to_int32
@ -32,7 +30,7 @@ let cmp_u x op y = op (add x min_int) (add y min_int)
let divrem_u n d =
if d = zero then raise Division_by_zero
else
let t = shift_right d (bitwidth - 1) in
let t = shift_right d (32 - 1) in
let n' = logand n (lognot t) in
let q = shift_left (div (shift_right_logical n' 1) d) 1 in
let r = sub n (mul q d) in
@ -42,31 +40,20 @@ let of_bits x = x
let to_bits x = x
let zero = zero
let one = one
let ten = of_int 10
let lognot = lognot
let abs = abs
let neg = neg
(* If bit (bitwidth - 1) is set, sx will sign-extend t to maintain the
(* If bit (32 - 1) is set, sx will sign-extend t to maintain the
* invariant that small ints are stored sign-extended inside a wider int. *)
let sx x =
let i = 64 - bitwidth in
Int64.to_int32 @@ Int64.(shift_right (shift_left (Int64.of_int32 x) i) i)
Int64.to_int32 @@ Int64.(shift_right (shift_left (Int64.of_int32 x) 32) 32)
(* We don't override min_int and max_int since those are used
* by other functions (like parsing), and rely on it being
* min/max for int32 *)
(* The smallest signed |bitwidth|-bits int. *)
let low_int = shift_left minus_one (bitwidth - 1)
(* The smallest signed |32|-bits int. *)
let low_int = shift_left minus_one 31
(* The largest signed |bitwidth|-bits int. *)
(* The largest signed |32|-bits int. *)
let high_int = logxor low_int minus_one
(* result is truncated toward zero *)
@ -89,11 +76,11 @@ let rem_u x y =
let avgr_u x y =
let open Int64 in
(* Mask with bottom #bitwidth bits set *)
let mask = shift_right_logical minus_one (64 - bitwidth) in
(* Mask with bottom #32 bits set *)
let mask = shift_right_logical minus_one 32 in
let x64 = logand mask (to_int64 x) in
let y64 = logand mask (to_int64 y) in
of_int64 (div (add (add x64 y64) one) (of_int 2))
of_int64 (div (add (add x64 y64) one) 2L)
let and_ = logand
@ -101,43 +88,43 @@ let or_ = logor
let xor = logxor
(* WebAssembly's shifts mask the shift count according to the bitwidth. *)
let shift f x y = f x (to_int (logand y (of_int (bitwidth - 1))))
(* WebAssembly's shifts mask the shift count according to the 32. *)
let shift f x y = f x (to_int (logand y 31l))
let shl x y = sx (shift shift_left x y)
let shr_s x y = shift shift_right x y
(* Check if we are storing smaller ints. *)
let needs_extend = shl one (of_int (bitwidth - 1)) <> min_int
let needs_extend = shl one 31l <> min_int
(*
* When Int is used to store a smaller int, it is stored in signed extended
* form. Some instructions require the unsigned form, which requires masking
* away the top 32-bitwidth bits.
* away the top 32-32 bits.
*)
let as_unsigned x =
if not needs_extend then x
else
(* Mask with bottom #bitwidth bits set *)
let mask = shift_right_logical minus_one (32 - bitwidth) in
(* Mask with bottom #32 bits set *)
let mask = shift_right_logical minus_one 0 in
logand x mask
let shr_u x y = sx (shift shift_right_logical (as_unsigned x) y)
(* We must mask the count to implement rotates via shifts. *)
let clamp_rotate_count n = to_int (logand n (of_int (bitwidth - 1)))
let clamp_rotate_count n = to_int (logand n 31l)
let rotl x y =
let n = clamp_rotate_count y in
or_ (shl x (of_int n)) (shr_u x (of_int (bitwidth - n)))
or_ (shl x (of_int n)) (shr_u x (of_int (32 - n)))
let rotr x y =
let n = clamp_rotate_count y in
or_ (shr_u x (of_int n)) (shl x (of_int (bitwidth - n)))
or_ (shr_u x (of_int n)) (shl x (of_int (32 - n)))
let extend_s n x =
let shift = bitwidth - n in
let shift = 32 - n in
shift_right (shift_left x shift) shift
let eqz x = x = zero
@ -166,35 +153,6 @@ let saturate_s x = sx (min (max x low_int) high_int)
let saturate_u x = sx (min (max x zero) (as_unsigned minus_one))
(* add/sub for int, used for higher-precision arithmetic for I8 and I16 *)
let add_int x y =
assert (bitwidth < 32);
of_int (to_int x + to_int y)
let sub_int x y =
assert (bitwidth < 32);
of_int (to_int x - to_int y)
let add_sat_s x y = saturate_s (add_int x y)
let add_sat_u x y = saturate_u (add_int (as_unsigned x) (as_unsigned y))
let sub_sat_s x y = saturate_s (sub_int x y)
let sub_sat_u x y = saturate_u (sub_int (as_unsigned x) (as_unsigned y))
let q15mulr_sat_s x y =
(* mul x64 y64 can overflow int64 when both are int32 min, but this is only
* used by i16x8, so we are fine for now. *)
assert (bitwidth < 32);
let x64 = to_int64 x in
let y64 = to_int64 y in
saturate_s (of_int64 Int64.(shift_right (add (mul x64 y64) 0x4000L) 15))
let to_int_s = to_int
let of_int_s = of_int
(* String conversion that allows leading signs and unsigned values *)
let require b = if not b then failwith "of_string"
@ -212,22 +170,22 @@ let hex_digit = function
let max_upper, max_lower = divrem_u minus_one ten
let sign_extend i =
(* This module is used with I32 and I64, but the bitwidth can be less
(* This module is used with I32 and I64, but the 32 can be less
* than that, e.g. for I16. When used for smaller integers, the stored value
* needs to be signed extended, e.g. parsing -1 into a I16 (backed by Int32)
* should have all high bits set. We can do that by logor with a mask,
* where the mask is minus_one left shifted by bitwidth. But if bitwidth
* where the mask is minus_one left shifted by 32. But if 32
* matches the number of bits of Rep, the shift will be incorrect.
* -1 (Int32) << 32 = -1
* Then the logor will be also wrong. So we check and bail out early.
* *)
if not needs_extend then i
else
let sign_bit = logand (of_int (1 lsl (bitwidth - 1))) i in
let sign_bit = logand (of_int (1 lsl (32 - 1))) i in
if sign_bit = zero then i
else
(* Build a sign-extension mask *)
let sign_mask = shift_left minus_one bitwidth in
let sign_mask = shift_left minus_one 32 in
logor sign_mask i
let of_string s =
@ -277,28 +235,3 @@ let of_string_u s =
let n = of_string s in
require (s.[0] <> '+' && s.[0] <> '-');
n
(* String conversion that groups digits for readability *)
let rec add_digits buf s i j k n =
if i < j then begin
if k = 0 then Buffer.add_char buf '_';
Buffer.add_char buf s.[i];
add_digits buf s (i + 1) j ((k + n - 1) mod n) n
end
let group_digits n s =
let len = String.length s in
let num = if s.[0] = '-' then 1 else 0 in
let buf = Buffer.create (len * (n + 1) / n) in
Buffer.add_substring buf s 0 num;
add_digits buf s num len (((len - num) mod n) + n) n;
Buffer.contents buf
let to_string_s i = group_digits 3 (to_string i)
let to_string_u i =
if i >= zero then group_digits 3 (to_string i)
else group_digits 3 (to_string (div_u i ten) ^ to_string (rem_u i ten))
let to_hex_string i = "0x" ^ group_digits 4 (to_hex_string i)

30920
src/menhir_parser.messages

File diff suppressed because it is too large

8
src/menhir_parser.mly

@ -3,12 +3,10 @@
%token NAN_ARITH NAN_CANON ASSERT_INVALID ASSERT_MALFORMED ASSERT_EXHAUSTION ASSERT_TRAP ASSERT_UNLINKABLE PARAM RESULT FUNCREF EXTERNREF I32 I64 F32 F64 CLZ CTZ POPCNT ABS NEG SQRT CEIL FLOOR TRUNC NEAREST SIGNED UNSIGNED ADD SUB MUL DIV REM AND OR XOR SHL SHR ROTL ROTR MIN MAX COPYSIGN EQZ EQ NE LT GT LE GE EXTEND8 EXTEND16 EXTEND32 EXTEND_I32 WRAP_I64 TABLE GROW INIT COPY TEE ITEM REF SELECT DEMOTE_F64 DROP UNDERSCORE GET FILL CONVERT PROMOTE_F32 SIZE SET IS_NULL LOCAL NULL REINTERPRET GLOBAL ELEM STORE8 STORE16 STORE STORE32 BR_TABLE CALL LOAD LOAD8 LOAD16 LOOP DATA BR_IF BR OFFSET UNREACHABLE CALL_INDIRECT LOAD32 BLOCK ALIGN EQUAL MEMORY RETURN NOP FUNC EXPORT IMPORT EXTERN MUTABLE MODULE RPAR LPAR EOF IF ELSE THEN DOT CONST START TYPE DECLARE END INVOKE ASSERT_RETURN QUOTE REGISTER TRUNC_SAT BINARY
%{
open Types
let u32_of_i32 = Unsigned.UInt32.of_int32
let u32_of_i32 = Uint32.of_int32
let u32 s =
try Unsigned.UInt32.of_string s
try Uint32.of_string s
with Failure _ -> failwith (Format.sprintf "error u32 constant `%s` out of range" s)
let i32 s = Int32.of_string s
@ -19,6 +17,8 @@ let f64 s = Float64.of_string s
let f32 s = Float32.of_string s
open Types
%}
%start <Types.file> file

Loading…
Cancel
Save