Guile-hoot/module/wasm/parse.scm

;;; WebAssembly binary parser
;;; Copyright (C) 2023 Igalia, S.L.
;;; Copyright (C) 2024 David Thompson <dave@spritely.institute>
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;;    http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.

;;; Commentary:
;;;
;;; Parser for WebAssembly binary format
;;;
;;; Code:

(define-module (wasm parse)
  #:use-module (ice-9 binary-ports)
  #:use-module (ice-9 match)
  #:use-module (rnrs bytevectors)
  #:use-module (srfi srfi-11)
  #:use-module (wasm types)
  #:export (parse-wasm))

(define (parse-wasm port)
  (define (match-u8 port u8)
    (match (lookahead-u8 port)
      ((? (lambda (x) (eqv? x u8))) (get-u8 port))
      (_ #f)))

  (define (expect-u8 port u8)
    (unless (match-u8 port u8)
      (error "unexpected byte" u8 (get-u8 port))))

  (define (get-uleb port)
    (let lp ((n 0) (shift 0))
      (let ((b (get-u8 port)))
        (if (zero? (logand b #x80))
            (logior (ash b shift) n)
            (lp (logior (ash (logxor #x80 b) shift) n)
                (+ shift 7))))))

  (define (get-sleb port)
    (let lp ((n 0) (shift 0))
      (let ((b (get-u8 port)))
        (if (zero? (logand b #x80))
            (logior (ash b shift) n
                    (if (zero? (logand #x40 b))
                        0
                        (- (ash 1 (+ shift 7)))))
            (lp (logior (ash (logxor #x80 b) shift) n)
                (+ shift 7))))))

  (define (get-bytes port n)
    (let ((bytes (get-bytevector-n port n)))
      (unless (eqv? (bytevector-length bytes) n)
        (error "unexpected EOF while reading bytes"))
      bytes))

  (define (get-name port)
    (let* ((len (get-uleb port))
           (bytes (get-bytes port len)))
      (utf8->string bytes)))

  (define (parse-vec port parse-one)
    (let lp ((n (get-uleb port)))
      (if (zero? n)
          '()
          (let ((item (parse-one port)))
            (cons item (lp (1- n)))))))

  (define (parse-vec/u8 port)
    (get-bytes port (get-uleb port)))

  (define (parse-heap-type port)
    (cond
     ((match-u8 port #x73) 'nofunc)
     ((match-u8 port #x72) 'noextern)
     ((match-u8 port #x71) 'none)
     ((match-u8 port #x70) 'func)
     ((match-u8 port #x6F) 'extern)
     ((match-u8 port #x6E) 'any)
     ((match-u8 port #x6D) 'eq)
     ((match-u8 port #x6C) 'i31)
     ((match-u8 port #x6B) 'struct)
     ((match-u8 port #x6A) 'array)
     ((match-u8 port #x67) 'string)
     ((match-u8 port #x66) 'stringview_wtf8)
     ((match-u8 port #x62) 'stringview_wtf16)
     ((match-u8 port #x61) 'stringview_iter)
     (else
      (let ((val (get-sleb port)))
        (when (negative? val) (error "unexpected negative heap type" val))
        val))))

  (define (parse-val-type port)
    (match (get-u8 port)
      (#x7F 'i32)
      (#x7E 'i64)
      (#x7D 'f32)
      (#x7C 'f64)
      (#x7B 'v128)
      (#x73 'nullfuncref)
      (#x72 'nullexternref)
      (#x71 'nullref)
      (#x70 'funcref)
      (#x6F 'externref)
      (#x6E 'anyref)
      (#x6D 'eqref)
      (#x6C 'i31ref)
      (#x6B 'structref)
      (#x6A 'arrayref)
      (#x64 (make-ref-type #f (parse-heap-type port)))
      (#x63 (make-ref-type #t (parse-heap-type port)))
      (#x67 'stringref)
      (#x66 'stringview_wtf8ref)
      (#x62 'stringview_wtf16ref)
      (#x61 'stringview_iterref)
      (byte (error "unexpected byte" byte))))

  (define (parse-ref-type port)
    (match (parse-val-type port)
      ((and numeric (or 'i32 'i64 'f32 'f64 'v128))
       (error "unexpected numeric type" numeric))
      (type type)))

  (define (parse-limits port)
    (match (get-u8 port)
      (#x00 (make-limits (get-uleb port) #f))
      (#x01 (let ((min (get-uleb port)))
              (make-limits min (get-uleb port))))
      (byte (error "unexpected byte byte"))))

  (define (parse-types port)
    (define (parse-storage-type port)
      (cond
       ((match-u8 port #x78) 'i8)
       ((match-u8 port #x77) 'i16)
       (else (parse-val-type port))))
    (define (parse-field-def port)
      (let ((type (parse-storage-type port)))
        (make-field #f
                    (match (get-u8 port)
                      (#x00 #f)
                      (#x01 #t)
                      (byte (error "unexpected mutability" byte)))
                    type)))
    (define (parse-base-type port)
      (match (get-u8 port)
        (#x5E (match (parse-field-def port)
                (($ <field> #f mutable? type)
                 (make-array-type mutable? type))))
        (#x5F (make-struct-type (parse-vec port parse-field-def)))
        (#x60 (let* ((params (map (lambda (type)
                                    (make-param #f type))
                                  (parse-vec port parse-val-type)))
                     (results (parse-vec port parse-val-type)))
                (make-func-sig params results)))
        (byte (error "unexpected" byte))))
    (define (parse-sub-type port)
      (make-type #f (cond
                     ((match-u8 port #x4F)
                      (let ((supers (parse-vec port get-uleb)))
                        (make-sub-type #t supers (parse-base-type port))))
                     ((match-u8 port #x50)
                      (let ((supers (parse-vec port get-uleb)))
                        (make-sub-type #f supers (parse-base-type port))))
                     (else (parse-base-type port)))))
    (define (parse-rec-group port)
      (if (match-u8 port #x4E)
          (make-rec-group (parse-vec port parse-sub-type))
          (parse-sub-type port)))
    (parse-vec port parse-rec-group))

  (define (parse-type-use port)
    (let ((idx (get-uleb port)))
      (make-type-use idx #f)))

  (define (parse-table-type port)
    (let* ((type (parse-ref-type port))
           (limits (parse-limits port)))
      (make-table-type limits type)))

  (define (parse-mem-type port)
    (make-mem-type (parse-limits port)))

  (define (parse-global-type port)
    (let ((type (parse-val-type port)))
      (match (get-u8 port)
        (#x00 (make-global-type #f type))
        (#x01 (make-global-type #t type))
        (byte (error "unexpected byte" byte)))))

  (define (parse-tag-type port)
    (match (get-u8 port)
      (#x00 (make-tag-type 'exception (parse-type-use port)))
      (byte (error "unexpected byte" byte))))

  (define (parse-imports port)
    (define (parse-import port)
      (let* ((mod (get-name port))
             (name (get-name port)))
        (match (get-u8 port)
          (#x00 (make-import mod name 'func #f (parse-type-use port)))
          (#x01 (make-import mod name 'table #f (parse-table-type port)))
          (#x02 (make-import mod name 'memory #f (parse-mem-type port)))
          (#x03 (make-import mod name 'global #f (parse-global-type port)))
          (#x04 (make-import mod name 'tag #f (parse-tag-type port)))
          (byte (error "unexpected byte" byte)))))
    (parse-vec port parse-import))

  (define (parse-func-decls port)
    (parse-vec port parse-type-use))

  (define (parse-expr port)
    (define (parse-idx) (get-uleb port))
    (define (parse-block-type)
      (cond
       ((match-u8 port #x40) #f)
       ((= #x40 (logand #xc0 (lookahead-u8 port))) (parse-val-type port))
       (else (get-sleb port))))
    (define (parse-mem-arg)
      (let* ((align* (get-uleb port))
             (align (logand align* (lognot (ash 1 6))))
             (idx (if (logtest align* (ash 1 6))
                      (get-uleb port)
                      0))
             (offset (get-uleb port)))
        (make-mem-arg 0 offset align)))
    (define (parse-body*)
      (let lp ((insts '()))
        (define (k inst)
          (lp (cons inst insts)))
        (match (get-u8 port)
          (#x0B (values (reverse insts) 'end))
          (#x05 (values (reverse insts) 'else))
          (#x07 (values (reverse insts) 'catch))
          (#x18 (values (reverse insts) 'delegate))
          (#x19 (values (reverse insts) 'catch_all))

          (#x00 (k `(unreachable)))
          (#x01 (k `(nop)))
          (#x02 (let* ((type (parse-block-type))
                       (body (parse-body)))
                  (k `(block #f ,type ,body))))
          (#x03 (let* ((type (parse-block-type))
                       (body (parse-body)))
                  (k `(loop #f ,type ,body))))
          (#x04 (let*-values (((type) (parse-block-type))
                              ((consequent end-tok) (parse-body*)))
                  (match end-tok
                    ('end (k `(if #f ,type ,consequent ())))
                    ('else (k `(if #f ,type ,consequent ,(parse-body))))
                    (_ (error "unexpected token" end-tok)))))
          (#x06 (let*-values (((type) (parse-block-type))
                              ((body end-tok) (parse-body*)))
                  (let lp ((catches '()) (end-tok end-tok))
                    (match end-tok
                      ('end
                       (k `(try #f ,type ,body ,(reverse catches) ())))
                      ('catch
                       (let ((tag-idx (parse-idx)))
                         (let-values (((catch end-tok) (parse-body*)))
                           (lp (cons (cons tag-idx catch) catches) end-tok))))
                      ('catch_all
                       (let-values (((catch-all end-tok) (parse-body*)))
                         (unless (eq? end-tok 'end)
                           (error "expected end after catch_all" end-tok))
                         (k `(try #f ,type ,body ,(reverse catches)
                                  ,catch-all))))
                      ('delegate
                       (unless (null? catches)
                         (error "can't delegate with catches"))
                       (k `(try_delegate #f ,type ,body ,(parse-idx))))
                      (_ (error "unexpected token" end-tok))))))
          (#x08 (k `(throw ,(parse-idx))))
          (#x09 (k `(rethrow ,(parse-idx))))
          (#x0c (k `(br ,(parse-idx))))
          (#x0d (k `(br_if ,(parse-idx))))
          (#x0e (let ((targets (parse-vec port get-uleb)))
                  (k `(br_table ,targets ,(parse-idx)))))
          (#x0f (k `(return)))
          (#x10 (k `(call ,(parse-idx))))
          (#x11 (let* ((type (parse-idx))
                       (table (parse-idx)))
                  (k `(call_indirect ,table ,type))))
          (#x12 (k `(return_call ,(parse-idx))))
          (#x13 (let* ((type (parse-idx))
                       (table (parse-idx)))
                  (k `(return_call_indirect ,table ,type))))
          (#x14 (k `(call_ref ,(parse-idx))))
          (#x15 (k `(return_call_ref ,(parse-idx))))
          (#x1a (k `(drop)))
          (#x1b (k `(select)))
          (#x1c (k `(select ,(parse-vec port parse-val-type))))
          (#x20 (k `(local.get ,(parse-idx))))
          (#x21 (k `(local.set ,(parse-idx))))
          (#x22 (k `(local.tee ,(parse-idx))))
          (#x23 (k `(global.get ,(parse-idx))))
          (#x24 (k `(global.set ,(parse-idx))))
          (#x25 (k `(table.get ,(parse-idx))))
          (#x26 (k `(table.set ,(parse-idx))))

          (#x28 (k `(i32.load ,(parse-mem-arg))))
          (#x29 (k `(i64.load ,(parse-mem-arg))))
          (#x2a (k `(f32.load ,(parse-mem-arg))))
          (#x2b (k `(f64.load ,(parse-mem-arg))))
          (#x2c (k `(i32.load8_s ,(parse-mem-arg))))
          (#x2d (k `(i32.load8_u ,(parse-mem-arg))))
          (#x2e (k `(i32.load16_s ,(parse-mem-arg))))
          (#x2f (k `(i32.load16_u ,(parse-mem-arg))))
          (#x30 (k `(i64.load8_s ,(parse-mem-arg))))
          (#x31 (k `(i64.load8_u ,(parse-mem-arg))))
          (#x32 (k `(i64.load16_s ,(parse-mem-arg))))
          (#x33 (k `(i64.load16_u ,(parse-mem-arg))))
          (#x34 (k `(i64.load32_s ,(parse-mem-arg))))
          (#x35 (k `(i64.load32_u ,(parse-mem-arg))))

          (#x36 (k `(i32.store ,(parse-mem-arg))))
          (#x37 (k `(i64.store ,(parse-mem-arg))))
          (#x38 (k `(f32.store ,(parse-mem-arg))))
          (#x39 (k `(f64.store ,(parse-mem-arg))))
          (#x3a (k `(i32.store8 ,(parse-mem-arg))))
          (#x3b (k `(i32.store16 ,(parse-mem-arg))))
          (#x3c (k `(i64.store8 ,(parse-mem-arg))))
          (#x3d (k `(i64.store16 ,(parse-mem-arg))))
          (#x3e (k `(i64.store32 ,(parse-mem-arg))))

          (#x3f (k `(memory.size ,(parse-idx))))
          (#x40 (k `(memory.grow ,(parse-idx))))

          (#x41 (k `(i32.const ,(get-sleb port))))
          (#x42 (k `(i64.const ,(get-sleb port))))
          (#x43 (k `(f32.const
                     ,(let ((bytes (get-bytes port 4)))
                        (bytevector-ieee-single-ref bytes 0
                                                    (endianness little))))))
          (#x44 (k `(f64.const
                     ,(let ((bytes (get-bytes port 8)))
                        (bytevector-ieee-double-ref bytes 0
                                                    (endianness little))))))

          (#x45 (k '(i32.eqz)))
          (#x46 (k '(i32.eq)))
          (#x47 (k '(i32.ne)))
          (#x48 (k '(i32.lt_s)))
          (#x49 (k '(i32.lt_u)))
          (#x4a (k '(i32.gt_s)))
          (#x4b (k '(i32.gt_u)))
          (#x4c (k '(i32.le_s)))
          (#x4d (k '(i32.le_u)))
          (#x4e (k '(i32.ge_s)))
          (#x4f (k '(i32.ge_u)))
          (#x50 (k '(i64.eqz)))
          (#x51 (k '(i64.eq)))
          (#x52 (k '(i64.ne)))
          (#x53 (k '(i64.lt_s)))
          (#x54 (k '(i64.lt_u)))
          (#x55 (k '(i64.gt_s)))
          (#x56 (k '(i64.gt_u)))
          (#x57 (k '(i64.le_s)))
          (#x58 (k '(i64.le_u)))
          (#x59 (k '(i64.ge_s)))
          (#x5a (k '(i64.ge_u)))
          (#x5b (k '(f32.eq)))
          (#x5c (k '(f32.ne)))
          (#x5d (k '(f32.lt)))
          (#x5e (k '(f32.gt)))
          (#x5f (k '(f32.le)))
          (#x60 (k '(f32.ge)))
          (#x61 (k '(f64.eq)))
          (#x62 (k '(f64.ne)))
          (#x63 (k '(f64.lt)))
          (#x64 (k '(f64.gt)))
          (#x65 (k '(f64.le)))
          (#x66 (k '(f64.ge)))
          (#x67 (k '(i32.clz)))
          (#x68 (k '(i32.ctz)))
          (#x69 (k '(i32.popcnt)))
          (#x6a (k '(i32.add)))
          (#x6b (k '(i32.sub)))
          (#x6c (k '(i32.mul)))
          (#x6d (k '(i32.div_s)))
          (#x6e (k '(i32.div_u)))
          (#x6f (k '(i32.rem_s)))
          (#x70 (k '(i32.rem_u)))
          (#x71 (k '(i32.and)))
          (#x72 (k '(i32.or)))
          (#x73 (k '(i32.xor)))
          (#x74 (k '(i32.shl)))
          (#x75 (k '(i32.shr_s)))
          (#x76 (k '(i32.shr_u)))
          (#x77 (k '(i32.rotl)))
          (#x78 (k '(i32.rotr)))
          (#x79 (k '(i64.clz)))
          (#x7a (k '(i64.ctz)))
          (#x7b (k '(i64.popcnt)))
          (#x7c (k '(i64.add)))
          (#x7d (k '(i64.sub)))
          (#x7e (k '(i64.mul)))
          (#x7f (k '(i64.div_s)))
          (#x80 (k '(i64.div_u)))
          (#x81 (k '(i64.rem_s)))
          (#x82 (k '(i64.rem_u)))
          (#x83 (k '(i64.and)))
          (#x84 (k '(i64.or)))
          (#x85 (k '(i64.xor)))
          (#x86 (k '(i64.shl)))
          (#x87 (k '(i64.shr_s)))
          (#x88 (k '(i64.shr_u)))
          (#x89 (k '(i64.rotl)))
          (#x8a (k '(i64.rotr)))
          (#x8b (k '(f32.abs)))
          (#x8c (k '(f32.neg)))
          (#x8d (k '(f32.ceil)))
          (#x8e (k '(f32.floor)))
          (#x8f (k '(f32.trunc)))
          (#x90 (k '(f32.nearest)))
          (#x91 (k '(f32.sqrt)))
          (#x92 (k '(f32.add)))
          (#x93 (k '(f32.sub)))
          (#x94 (k '(f32.mul)))
          (#x95 (k '(f32.div)))
          (#x96 (k '(f32.min)))
          (#x97 (k '(f32.max)))
          (#x98 (k '(f32.copysign)))
          (#x99 (k '(f64.abs)))
          (#x9a (k '(f64.neg)))
          (#x9b (k '(f64.ceil)))
          (#x9c (k '(f64.floor)))
          (#x9d (k '(f64.trunc)))
          (#x9e (k '(f64.nearest)))
          (#x9f (k '(f64.sqrt)))
          (#xa0 (k '(f64.add)))
          (#xa1 (k '(f64.sub)))
          (#xa2 (k '(f64.mul)))
          (#xa3 (k '(f64.div)))
          (#xa4 (k '(f64.min)))
          (#xa5 (k '(f64.max)))
          (#xa6 (k '(f64.copysign)))
          (#xa7 (k '(i32.wrap_i64)))
          (#xa8 (k '(i32.trunc_f32_s)))
          (#xa9 (k '(i32.trunc_f32_u)))
          (#xaa (k '(i32.trunc_f64_s)))
          (#xab (k '(i32.trunc_f64_u)))
          (#xac (k '(i64.extend_i32_s)))
          (#xad (k '(i64.extend_i32_u)))
          (#xae (k '(i64.trunc_f32_s)))
          (#xaf (k '(i64.trunc_f32_u)))
          (#xb0 (k '(i64.trunc_f64_s)))
          (#xb1 (k '(i64.trunc_f64_u)))
          (#xb2 (k '(f32.convert_i32_s)))
          (#xb3 (k '(f32.convert_i32_u)))
          (#xb4 (k '(f32.convert_i64_s)))
          (#xb5 (k '(f32.convert_i64_u)))
          (#xb6 (k '(f32.demote_f64)))
          (#xb7 (k '(f64.convert_i32_s)))
          (#xb8 (k '(f64.convert_i32_u)))
          (#xb9 (k '(f64.convert_i64_s)))
          (#xba (k '(f64.convert_i64_u)))
          (#xbb (k '(f64.promote_f32)))
          (#xbc (k '(i32.reinterpret_f32)))
          (#xbd (k '(i64.reinterpret_f64)))
          (#xbe (k '(f32.reinterpret_i32)))
          (#xbf (k '(f64.reinterpret_i64)))
          (#xc0 (k '(i32.extend8_s)))
          (#xc1 (k '(i32.extend16_s)))
          (#xc2 (k '(i64.extend8_s)))
          (#xc3 (k '(i64.extend16_s)))
          (#xc4 (k '(i64.extend32_s)))

          (#xd0 (k `(ref.null ,(parse-heap-type port))))
          (#xd1 (k `(ref.is_null)))
          (#xd2 (k `(ref.func ,(parse-idx))))
          (#xd3 (k `(ref.eq)))
          (#xd4 (k `(ref.as_non_null)))

          (#xfb
           (match (get-uleb port)
             (0 (k `(struct.new ,(parse-idx))))
             (1 (k `(struct.new_default ,(parse-idx))))
             (2 (let* ((type (parse-idx))
                       (field (parse-idx)))
                  (k `(struct.get ,type ,field))))
             (3 (let* ((type (parse-idx))
                       (field (parse-idx)))
                  (k `(struct.get_s ,type ,field))))
             (4 (let* ((type (parse-idx))
                       (field (parse-idx)))
                  (k `(struct.get_u ,type ,field))))
             (5 (let* ((type (parse-idx))
                       (field (parse-idx)))
                  (k `(struct.set ,type ,field))))
             (6 (k `(array.new ,(parse-idx))))
             (7 (k `(array.new_default ,(parse-idx))))
             (8 (let* ((type (parse-idx))
                       (len (get-uleb port)))
                  (k `(array.new_fixed ,type ,len))))
             (9 (let* ((type (parse-idx))
                       (data (parse-idx)))
                  (k `(array.new_data ,type ,data))))
             (10 (let* ((type (parse-idx))
                        (elem (parse-idx)))
                   (k `(array.new_elem ,type ,elem))))
             (11 (k `(array.get ,(parse-idx))))
             (12 (k `(array.get_s ,(parse-idx))))
             (13 (k `(array.get_u ,(parse-idx))))
             (14 (k `(array.set ,(parse-idx))))
             (15 (k `(array.len)))
             (16 (k `(array.fill ,(parse-idx))))
             (17 (let* ((dst (parse-idx))
                        (src (parse-idx)))
                   (k `(array.copy ,dst ,src))))
             (18 (let* ((dst (parse-idx))
                        (src (parse-idx)))
                   (k `(array.init_data ,dst ,src))))
             (19 (let* ((dst (parse-idx))
                        (src (parse-idx)))
                   (k `(array.init_elem ,dst ,src))))
             (20 (k `(ref.test ,(make-ref-type #f (parse-heap-type port)))))
             (21 (k `(ref.test ,(make-ref-type #t (parse-heap-type port)))))
             (22 (k `(ref.cast ,(make-ref-type #f (parse-heap-type port)))))
             (23 (k `(ref.cast ,(make-ref-type #t (parse-heap-type port)))))
             (24 (let* ((flags (get-u8 port))
                        (rt1 (make-ref-type (logtest 1 flags)
                                            (parse-heap-type port)))
                        (rt2 (make-ref-type (logtest 2 flags)
                                            (parse-heap-type port))))
                   `(br_on_cast ,rt1 ,rt2)))
             (25 (let* ((flags (get-u8 port))
                        (rt1 (make-ref-type (logtest 1 flags)
                                            (parse-heap-type port)))
                        (rt2 (make-ref-type (logtest 2 flags)
                                            (parse-heap-type port))))
                   `(br_on_cast_fail ,rt1 ,rt2)))
             (26 (k `(extern.internalize)))
             (27 (k `(extern.externalize)))
             (28 (k `(ref.i31)))
             (29 (k `(i31.get_s)))
             (30 (k `(i31.get_u)))

             (#x80 (k `(string.new_utf8 ,(parse-idx))))
             (#x81 (k `(string.new_wtf16 ,(parse-idx))))
             (#x82 (k `(string.const ,(parse-idx))))
             (#x83 (k `(string.measure_utf8)))
             (#x84 (k `(string.measure_wtf8)))
             (#x85 (k `(string.measure_wtf16)))
             (#x86 (k `(string.encode_utf8 ,(parse-idx))))
             (#x87 (k `(string.encode_wtf16 ,(parse-idx))))
             (#x88 (k `(string.concat)))
             (#x89 (k `(string.eq)))
             (#x8a (k `(string.is_usv_sequence)))
             (#x8b (k `(string.new_lossy_utf8 ,(parse-idx))))
             (#x8c (k `(string.new_wtf8 ,(parse-idx))))
             (#x8d (k `(string.encode_lossy_utf8 ,(parse-idx))))
             (#x8e (k `(string.encode_wtf8 ,(parse-idx))))
             (#x90 (k `(string.as_wtf8)))
             (#x91 (k `(stringview_wtf8.advance)))
             (#x92 (k `(stringview_wtf8.encode_utf8 ,(parse-idx))))
             (#x93 (k `(stringview_wtf8.slice)))
             (#x94 (k `(stringview_wtf8.encode_lossy_utf8 ,(parse-idx))))
             (#x95 (k `(stringview_wtf8.encode_wtf8 ,(parse-idx))))
             (#x98 (k `(string.as_wtf16)))
             (#x99 (k `(stringview_wtf16.length)))
             (#x9a (k `(stringview_wtf16.get_codeunit)))
             (#x9b (k `(stringview_wtf16.encode ,(parse-idx))))
             (#x9c (k `(stringview_wtf16.slice)))
             (#xa0 (k `(string.as_iter)))
             (#xa1 (k `(stringview_iter.next)))
             (#xa2 (k `(stringview_iter.advance)))
             (#xa3 (k `(stringview_iter.rewind)))
             (#xa4 (k `(stringview_iter.slice)))
             (#xa8 (k `(string.compare)))
             (#xa9 (k `(string.from_code_point)))
             (#xb0 (k `(string.new_utf8_array)))
             (#xb1 (k `(string.new_wtf16_array)))
             (#xb2 (k `(string.encode_utf8_array)))
             (#xb3 (k `(string.encode_wtf16_array)))
             (#xb4 (k `(string.new_lossy_utf8_array)))
             (#xb5 (k `(string.new_wtf8_array)))
             (#xb6 (k `(string.encode_lossy_utf8_array)))
             (#xb7 (k `(string.encode_wtf8_array)))
             (idx (error "unexpected GC opcode" idx))))

          (#xfc
           (match (get-uleb port)
             (#x00 (k `(i32.trunc_sat_f32_s)))
             (#x01 (k `(i32.trunc_sat_f32_u)))
             (#x02 (k `(i32.trunc_sat_f64_s)))
             (#x03 (k `(i32.trunc_sat_f64_u)))
             (#x04 (k `(i64.trunc_sat_f32_s)))
             (#x05 (k `(i64.trunc_sat_f32_u)))
             (#x06 (k `(i64.trunc_sat_f64_s)))
             (#x07 (k `(i64.trunc_sat_f64_u)))
             (#x08 (let* ((data (parse-idx))
                          (mem (parse-idx)))
                     (k `(memory.init ,data ,mem))))
             (#x09 (k `(data.drop ,(parse-idx))))
             (#x0a (let* ((dst (parse-idx))
                          (src (parse-idx)))
                     (k `(memory.copy ,dst ,src))))
             (#x0b (k `(memory.fill ,(parse-idx))))
             (#x0c (let* ((elem (parse-idx))
                          (table (parse-idx)))
                     (k `(table.init ,elem ,table))))
             (#x0d (k `(elem.drop ,(parse-idx))))
             (#x0e (let* ((dst (parse-idx))
                          (src (parse-idx)))
                     (k `(table.copy ,dst ,src))))
             (#x0f (k `(table.grow ,(get-uleb port))))
             (#x10 (k `(table.size ,(get-uleb port))))
             (#x11 (k `(table.fill ,(get-uleb port))))
             (idx (error "unexpected misc instruction" idx))))

          (#xfd
           (match (get-uleb port)
             (#x00 (k `(v128.load ,(parse-mem-arg))))
             (#x01 (k `(v128.load8x8_s ,(parse-mem-arg))))
             (#x02 (k `(v128.load8x8_u ,(parse-mem-arg))))
             (#x03 (k `(v128.load16x4_s ,(parse-mem-arg))))
             (#x04 (k `(v128.load16x4_u ,(parse-mem-arg))))
             (#x05 (k `(v128.load32x2_s ,(parse-mem-arg))))
             (#x06 (k `(v128.load32x2_u ,(parse-mem-arg))))
             (#x07 (k `(v128.load8_splat ,(parse-mem-arg))))
             (#x08 (k `(v128.load16_splat ,(parse-mem-arg))))
             (#x09 (k `(v128.load32_splat ,(parse-mem-arg))))
             (#x0a (k `(v128.load64_splat ,(parse-mem-arg))))
             (#x0b (k `(v128.store ,(parse-mem-arg))))

             (#x0c (k `(v128.const ,(get-bytes port 16))))
             (#x0d (k `(i8x16.shuffle ,(get-bytes port 16))))

             (#x0e (k `(i8x16.swizzle)))
             (#x0f (k `(i8x16.splat)))
             (#x10 (k `(i16x8.splat)))
             (#x11 (k `(i32x4.splat)))
             (#x12 (k `(i64x2.splat)))
             (#x13 (k `(f32x4.splat)))
             (#x14 (k `(f64x2.splat)))
             (#x15 (k `(i8x16.extract_lane_s ,(get-u8 port))))
             (#x16 (k `(i8x16.extract_lane_u ,(get-u8 port))))
             (#x17 (k `(i8x16.replace_lane ,(get-u8 port))))
             (#x18 (k `(i16x8.extract_lane_s ,(get-u8 port))))
             (#x19 (k `(i16x8.extract_lane_u ,(get-u8 port))))
             (#x1a (k `(i16x8.replace_lane ,(get-u8 port))))
             (#x1b (k `(i32x4.extract_lane ,(get-u8 port))))
             (#x1c (k `(i32x4.replace_lane ,(get-u8 port))))
             (#x1d (k `(i64x2.extract_lane ,(get-u8 port))))
             (#x1e (k `(i64x2.replace_lane ,(get-u8 port))))
             (#x1f (k `(f32x4.extract_lane ,(get-u8 port))))
             (#x20 (k `(f32x4.replace_lane ,(get-u8 port))))
             (#x21 (k `(f64x2.extract_lane ,(get-u8 port))))
             (#x22 (k `(f64x2.replace_lane ,(get-u8 port))))
             (#x23 (k `(i8x16.eq)))
             (#x24 (k `(i8x16.ne)))
             (#x25 (k `(i8x16.lt_s)))
             (#x26 (k `(i8x16.lt_u)))
             (#x27 (k `(i8x16.gt_s)))
             (#x28 (k `(i8x16.gt_u)))
             (#x29 (k `(i8x16.le_s)))
             (#x2a (k `(i8x16.le_u)))
             (#x2b (k `(i8x16.ge_s)))
             (#x2c (k `(i8x16.ge_u)))
             (#x2d (k `(i16x8.eq)))
             (#x2e (k `(i16x8.ne)))
             (#x2f (k `(i16x8.lt_s)))
             (#x30 (k `(i16x8.lt_u)))
             (#x31 (k `(i16x8.gt_s)))
             (#x32 (k `(i16x8.gt_u)))
             (#x33 (k `(i16x8.le_s)))
             (#x34 (k `(i16x8.le_u)))
             (#x35 (k `(i16x8.ge_s)))
             (#x36 (k `(i16x8.ge_u)))
             (#x37 (k `(i32x4.eq)))
             (#x38 (k `(i32x4.ne)))
             (#x39 (k `(i32x4.lt_s)))
             (#x3a (k `(i32x4.lt_u)))
             (#x3b (k `(i32x4.gt_s)))
             (#x3c (k `(i32x4.gt_u)))
             (#x3d (k `(i32x4.le_s)))
             (#x3e (k `(i32x4.le_u)))
             (#x3f (k `(i32x4.ge_s)))
             (#x40 (k `(i32x4.ge_u)))
             (#x41 (k `(f32x4.eq)))
             (#x42 (k `(f32x4.ne)))
             (#x43 (k `(f32x4.lt)))
             (#x44 (k `(f32x4.gt)))
             (#x45 (k `(f32x4.le)))
             (#x46 (k `(f32x4.ge)))
             (#x47 (k `(f64x2.eq)))
             (#x48 (k `(f64x2.ne)))
             (#x49 (k `(f64x2.lt)))
             (#x4a (k `(f64x2.gt)))
             (#x4b (k `(f64x2.le)))
             (#x4c (k `(f64x2.ge)))
             (#x4d (k `(v128.not)))
             (#x4e (k `(v128.and)))
             (#x4f (k `(v128.andnot)))
             (#x50 (k `(v128.or)))
             (#x51 (k `(v128.xor)))
             (#x52 (k `(v128.bitselect)))
             (#x53 (k `(v128.any_true)))

             (#x54 (let* ((mem-arg (parse-mem-arg))
                          (lane (get-u8 port)))
                     (k `(v128.load8_lane ,mem-arg ,lane))))
             (#x55 (let* ((mem-arg (parse-mem-arg))
                          (lane (get-u8 port)))
                     (k `(v128.load16_lane ,mem-arg ,lane))))
             (#x56 (let* ((mem-arg (parse-mem-arg))
                          (lane (get-u8 port)))
                     (k `(v128.load32_lane ,mem-arg ,lane))))
             (#x57 (let* ((mem-arg (parse-mem-arg))
                          (lane (get-u8 port)))
                     (k `(v128.load64_lane ,mem-arg ,lane))))
             (#x58 (let* ((mem-arg (parse-mem-arg))
                          (lane (get-u8 port)))
                     (k `(v128.store8_lane ,mem-arg ,lane))))
             (#x59 (let* ((mem-arg (parse-mem-arg))
                          (lane (get-u8 port)))
                     (k `(v128.store16_lane ,mem-arg ,lane))))
             (#x5a (let* ((mem-arg (parse-mem-arg))
                          (lane (get-u8 port)))
                     (k `(v128.store32_lane ,mem-arg ,lane))))
             (#x5b (let* ((mem-arg (parse-mem-arg))
                          (lane (get-u8 port)))
                     (k `(v128.store64_lane ,mem-arg ,lane))))
             (#x5c (k `(v128.load32_zero ,(parse-mem-arg))))
             (#x5d (k `(v128.load64_zero ,(parse-mem-arg))))

             (#x5e (k `(f32x4.demote_f64x2_zero)))
             (#x5f (k `(f64x2.promote_low_f32x4)))
             (#x60 (k `(i8x16.abs)))
             (#x61 (k `(i8x16.neg)))
             (#x62 (k `(i8x16.popcnt)))
             (#x63 (k `(i8x16.all_true)))
             (#x64 (k `(i8x16.bitmask)))
             (#x65 (k `(i8x16.narrow_i16x8_s)))
             (#x66 (k `(i8x16.narrow_i16x8_u)))
             (#x67 (k `(f32x4.ceil)))
             (#x68 (k `(f32x4.floor)))
             (#x69 (k `(f32x4.trunc)))
             (#x6a (k `(f32x4.nearest)))
             (#x6b (k `(i8x16.shl)))
             (#x6c (k `(i8x16.shr_s)))
             (#x6d (k `(i8x16.shr_u)))
             (#x6e (k `(i8x16.add)))
             (#x6f (k `(i8x16.add_sat_s)))
             (#x70 (k `(i8x16.add_sat_u)))
             (#x71 (k `(i8x16.sub)))
             (#x72 (k `(i8x16.sub_sat_s)))
             (#x73 (k `(i8x16.sub_sat_u)))
             (#x74 (k `(f64x2.ceil)))
             (#x75 (k `(f64x2.floor)))
             (#x76 (k `(i8x16.min_s)))
             (#x77 (k `(i8x16.min_u)))
             (#x78 (k `(i8x16.max_s)))
             (#x79 (k `(i8x16.max_u)))
             (#x7a (k `(f64x2.trunc)))
             (#x7b (k `(i8x16.avgr_u)))
             (#x7c (k `(i16x8.extadd_pairwise_i8x16_s)))
             (#x7d (k `(i16x8.extadd_pairwise_i8x16_u)))
             (#x7e (k `(i32x4.extadd_pairwise_i16x8_s)))
             (#x7f (k `(i32x4.extadd_pairwise_i16x8_u)))
             (#x80 (k `(i16x8.abs)))
             (#x81 (k `(i16x8.neg)))
             (#x82 (k `(i16x8.q15mulr_sat_s)))
             (#x83 (k `(i16x8.all_true)))
             (#x84 (k `(i16x8.bitmask)))
             (#x85 (k `(i16x8.narrow_i32x4_s)))
             (#x86 (k `(i16x8.narrow_i32x4_u)))
             (#x87 (k `(i16x8.extend_low_i8x16_s)))
             (#x88 (k `(i16x8.extend_high_i8x16_s)))
             (#x89 (k `(i16x8.extend_low_i8x16_u)))
             (#x8a (k `(i16x8.extend_high_i8x16_u)))
             (#x8b (k `(i16x8.shl)))
             (#x8c (k `(i16x8.shr_s)))
             (#x8d (k `(i16x8.shr_u)))
             (#x8e (k `(i16x8.add)))
             (#x8f (k `(i16x8.add_sat_s)))
             (#x90 (k `(i16x8.add_sat_u)))
             (#x91 (k `(i16x8.sub)))
             (#x92 (k `(i16x8.sub_sat_s)))
             (#x93 (k `(i16x8.sub_sat_u)))
             (#x94 (k `(f64x2.nearest)))
             (#x95 (k `(i16x8.mul)))
             (#x96 (k `(i16x8.min_s)))
             (#x97 (k `(i16x8.min_u)))
             (#x98 (k `(i16x8.max_s)))
             (#x99 (k `(i16x8.max_u)))
             (#x9b (k `(i16x8.avgr_u)))
             (#x9c (k `(i16x8.extmul_low_i8x16_s)))
             (#x9d (k `(i16x8.extmul_high_i8x16_s)))
             (#x9e (k `(i16x8.extmul_low_i8x16_u)))
             (#x9f (k `(i16x8.extmul_high_i8x16_u)))
             (#xa0 (k `(i32x4.abs)))
             (#xa1 (k `(i32x4.neg)))
             (#xa3 (k `(i32x4.all_true)))
             (#xa4 (k `(i32x4.bitmask)))
             (#xa7 (k `(i32x4.extend_low_i16x8_s)))
             (#xa8 (k `(i32x4.extend_high_i16x8_s)))
             (#xa9 (k `(i32x4.extend_low_i16x8_u)))
             (#xaa (k `(i32x4.extend_high_i16x8_u)))
             (#xab (k `(i32x4.shl)))
             (#xac (k `(i32x4.shr_s)))
             (#xad (k `(i32x4.shr_u)))
             (#xae (k `(i32x4.add)))
             (#xb1 (k `(i32x4.sub)))
             (#xb5 (k `(i32x4.mul)))
             (#xb6 (k `(i32x4.min_s)))
             (#xb7 (k `(i32x4.min_u)))
             (#xb8 (k `(i32x4.max_s)))
             (#xb9 (k `(i32x4.max_u)))
             (#xba (k `(i32x4.dot_i16x8_s)))
             (#xbc (k `(i32x4.extmul_low_i16x8_s)))
             (#xbd (k `(i32x4.extmul_high_i16x8_s)))
             (#xbe (k `(i32x4.extmul_low_i16x8_u)))
             (#xbf (k `(i32x4.extmul_high_i16x8_u)))
             (#xc0 (k `(i64x2.abs)))
             (#xc1 (k `(i64x2.neg)))
             (#xc3 (k `(i64x2.all_true)))
             (#xc4 (k `(i64x2.bitmask)))
             (#xc7 (k `(i64x2.extend_low_i32x4_s)))
             (#xc8 (k `(i64x2.extend_high_i32x4_s)))
             (#xc9 (k `(i64x2.extend_low_i32x4_u)))
             (#xca (k `(i64x2.extend_high_i32x4_u)))
             (#xcb (k `(i64x2.shl)))
             (#xcc (k `(i64x2.shr_s)))
             (#xcd (k `(i64x2.shr_u)))
             (#xce (k `(i64x2.add)))
             (#xd1 (k `(i64x2.sub)))
             (#xd5 (k `(i64x2.mul)))
             (#xd6 (k `(i64x2.eq)))
             (#xd7 (k `(i64x2.ne)))
             (#xd8 (k `(i64x2.lt_s)))
             (#xd9 (k `(i64x2.gt_s)))
             (#xda (k `(i64x2.le_s)))
             (#xdb (k `(i64x2.ge_s)))
             (#xdc (k `(i64x2.extmul_low_i32x4_s)))
             (#xdd (k `(i64x2.extmul_high_i32x4_s)))
             (#xde (k `(i64x2.extmul_low_i32x4_u)))
             (#xdf (k `(i64x2.extmul_high_i32x4_u)))
             (#xe0 (k `(f32x4.abs)))
             (#xe1 (k `(f32x4.neg)))
             (#xe3 (k `(f32x4.sqrt)))
             (#xe4 (k `(f32x4.add)))
             (#xe5 (k `(f32x4.sub)))
             (#xe6 (k `(f32x4.mul)))
             (#xe7 (k `(f32x4.div)))
             (#xe8 (k `(f32x4.min)))
             (#xe9 (k `(f32x4.max)))
             (#xea (k `(f32x4.pmin)))
             (#xeb (k `(f32x4.pmax)))
             (#xec (k `(f64x2.abs)))
             (#xed (k `(f64x2.neg)))
             (#xef (k `(f64x2.sqrt)))
             (#xf0 (k `(f64x2.add)))
             (#xf1 (k `(f64x2.sub)))
             (#xf2 (k `(f64x2.mul)))
             (#xf3 (k `(f64x2.div)))
             (#xf4 (k `(f64x2.min)))
             (#xf5 (k `(f64x2.max)))
             (#xf6 (k `(f64x2.pmin)))
             (#xf7 (k `(f64x2.pmax)))
             (#xf8 (k `(i32x4.trunc_sat_f32x4_s)))
             (#xf9 (k `(i32x4.trunc_sat_f32x4_u)))
             (#xfa (k `(f32x4.convert_i32x4_s)))
             (#xfb (k `(f32x4.convert_i32x4_u)))
             (#xfc (k `(i32x4.trunc_sat_f64x2_s_zero)))
             (#xfd (k `(i32x4.trunc_sat_f64x2_u_zero)))
             (#xfe (k `(f64x2.convert_low_i32x4_s)))
             (#xff (k `(f64x2.convert_low_i32x4_u)))

             (#x100 (k `(i8x16.relaxed_swizzle)))
             (#x101 (k `(i32x4.relaxed_trunc_f32x4_s)))
             (#x102 (k `(i32x4.relaxed_trunc_f32x4_u)))
             (#x103 (k `(i32x4.relaxed_trunc_f64x2_s_zero)))
             (#x104 (k `(i32x4.relaxed_trunc_f64x2_u_zero)))
             (#x105 (k `(f32x4.qfma)))
             (#x106 (k `(f32x4.qfms)))
             (#x107 (k `(f64x2.qfma)))
             (#x108 (k `(f64x2.qfms)))
             (#x109 (k `(i8x16.relaxed_laneselect)))
             (#x10a (k `(i16x8.relaxed_laneselect)))
             (#x10b (k `(i32x4.relaxed_laneselect)))
             (#x10c (k `(i64x2.relaxed_laneselect)))
             (#x10d (k `(f32x4.relaxed_min)))
             (#x10e (k `(f32x4.relaxed_max)))
             (#x10f (k `(f64x2.relaxed_min)))
             (#x110 (k `(f64x2.relaxed_max)))
             (#x111 (k `(i16x8.relaxed_q15mulr_s)))
             (#x112 (k `(i16x8.dot_i8x16_i7x16_s)))
             (#x113 (k `(i32x4.dot_i8x16_i7x16_add_s)))

             (idx (error "unexpected simd instruction" idx))))

          (#xfe
           (match (get-uleb port)
             (#x00 (k `(memory.atomic.notify ,(parse-mem-arg))))
             (#x01 (k `(memory.atomic.wait32 ,(parse-mem-arg))))
             (#x02 (k `(memory.atomic.wait64 ,(parse-mem-arg))))
             (#x03 (k `(atomic.fence))) ;; no mem arg
             (#x10 (k `(i32.atomic.load ,(parse-mem-arg))))
             (#x11 (k `(i64.atomic.load ,(parse-mem-arg))))
             (#x12 (k `(i32.atomic.load8_u ,(parse-mem-arg))))
             (#x13 (k `(i32.atomic.load16_u ,(parse-mem-arg))))
             (#x14 (k `(i64.atomic.load8_u ,(parse-mem-arg))))
             (#x15 (k `(i64.atomic.load16_u ,(parse-mem-arg))))
             (#x16 (k `(i64.atomic.load32_u ,(parse-mem-arg))))
             (#x17 (k `(i32.atomic.store ,(parse-mem-arg))))
             (#x18 (k `(i64.atomic.store ,(parse-mem-arg))))
             (#x19 (k `(i32.atomic.store8 ,(parse-mem-arg))))
             (#x1a (k `(i32.atomic.store16 ,(parse-mem-arg))))
             (#x1b (k `(i64.atomic.store8 ,(parse-mem-arg))))
             (#x1c (k `(i64.atomic.store16 ,(parse-mem-arg))))
             (#x1d (k `(i64.atomic.store32 ,(parse-mem-arg))))
             (#x1e (k `(i32.atomic.rmw.add ,(parse-mem-arg))))
             (#x1f (k `(i64.atomic.rmw.add ,(parse-mem-arg))))
             (#x20 (k `(i32.atomic.rmw8.add_u ,(parse-mem-arg))))
             (#x21 (k `(i32.atomic.rmw16.add_u ,(parse-mem-arg))))
             (#x22 (k `(i64.atomic.rmw8.add_u ,(parse-mem-arg))))
             (#x23 (k `(i64.atomic.rmw16.add_u ,(parse-mem-arg))))
             (#x24 (k `(i64.atomic.rmw32.add_u ,(parse-mem-arg))))
             (#x25 (k `(i32.atomic.rmw.sub ,(parse-mem-arg))))
             (#x26 (k `(i64.atomic.rmw.sub ,(parse-mem-arg))))
             (#x27 (k `(i32.atomic.rmw8.sub_u ,(parse-mem-arg))))
             (#x28 (k `(i32.atomic.rmw16.sub_u ,(parse-mem-arg))))
             (#x29 (k `(i64.atomic.rmw8.sub_u ,(parse-mem-arg))))
             (#x2a (k `(i64.atomic.rmw16.sub_u ,(parse-mem-arg))))
             (#x2b (k `(i64.atomic.rmw32.sub_u ,(parse-mem-arg))))
             (#x2c (k `(i32.atomic.rmw.and ,(parse-mem-arg))))
             (#x2d (k `(i64.atomic.rmw.and ,(parse-mem-arg))))
             (#x2e (k `(i32.atomic.rmw8.and_u ,(parse-mem-arg))))
             (#x2f (k `(i32.atomic.rmw16.and_u ,(parse-mem-arg))))
             (#x30 (k `(i64.atomic.rmw8.and_u ,(parse-mem-arg))))
             (#x31 (k `(i64.atomic.rmw16.and_u ,(parse-mem-arg))))
             (#x32 (k `(i64.atomic.rmw32.and_u ,(parse-mem-arg))))
             (#x33 (k `(i32.atomic.rmw.or ,(parse-mem-arg))))
             (#x34 (k `(i64.atomic.rmw.or ,(parse-mem-arg))))
             (#x35 (k `(i32.atomic.rmw8.or_u ,(parse-mem-arg))))
             (#x36 (k `(i32.atomic.rmw16.or_u ,(parse-mem-arg))))
             (#x37 (k `(i64.atomic.rmw8.or_u ,(parse-mem-arg))))
             (#x38 (k `(i64.atomic.rmw16.or_u ,(parse-mem-arg))))
             (#x39 (k `(i64.atomic.rmw32.or_u ,(parse-mem-arg))))
             (#x3a (k `(i32.atomic.rmw.xor ,(parse-mem-arg))))
             (#x3b (k `(i64.atomic.rmw.xor ,(parse-mem-arg))))
             (#x3c (k `(i32.atomic.rmw8.xor_u ,(parse-mem-arg))))
             (#x3d (k `(i32.atomic.rmw16.xor_u ,(parse-mem-arg))))
             (#x3e (k `(i64.atomic.rmw8.xor_u ,(parse-mem-arg))))
             (#x3f (k `(i64.atomic.rmw16.xor_u ,(parse-mem-arg))))
             (#x40 (k `(i64.atomic.rmw32.xor_u ,(parse-mem-arg))))
             (#x41 (k `(i32.atomic.rmw.xchg ,(parse-mem-arg))))
             (#x42 (k `(i64.atomic.rmw.xchg ,(parse-mem-arg))))
             (#x43 (k `(i32.atomic.rmw8.xchg_u ,(parse-mem-arg))))
             (#x44 (k `(i32.atomic.rmw16.xchg_u ,(parse-mem-arg))))
             (#x45 (k `(i64.atomic.rmw8.xchg_u ,(parse-mem-arg))))
             (#x46 (k `(i64.atomic.rmw16.xchg_u ,(parse-mem-arg))))
             (#x47 (k `(i64.atomic.rmw32.xchg_u ,(parse-mem-arg))))
             (#x48 (k `(i32.atomic.rmw.cmpxchg ,(parse-mem-arg))))
             (#x49 (k `(i64.atomic.rmw.cmpxchg ,(parse-mem-arg))))
             (#x4a (k `(i32.atomic.rmw8.cmpxchg_u ,(parse-mem-arg))))
             (#x4b (k `(i32.atomic.rmw16.cmpxchg_u ,(parse-mem-arg))))
             (#x4c (k `(i64.atomic.rmw8.cmpxchg_u ,(parse-mem-arg))))
             (#x4d (k `(i64.atomic.rmw16.cmpxchg_u ,(parse-mem-arg))))
             (#x4e (k `(i64.atomic.rmw32.cmpxchg_u ,(parse-mem-arg))))

             (idx (error "unexpected atomic instruction" idx))))

          (byte (error "unexpected opcode" byte)))))
    (define (parse-body)
      (let-values (((body end-tok) (parse-body*)))
        (match end-tok
          ('end body)
          (_ (error "unexpected token" end-tok)))))
    (parse-body))

  (define (parse-tables port)
    (define (parse-table port)
      (cond
       ((match-u8 port #x40)
        (expect-u8 port #x00)
        (let* ((type (parse-table-type port))
               (init (parse-expr port)))
          (make-table #f type init)))
       (else
        (make-table #f (parse-table-type port) #f))))
    (parse-vec port parse-table))

  (define (parse-memories port)
    (define (parse-memory port)
      (make-memory #f (parse-mem-type port)))
    (parse-vec port parse-memory))

  (define (parse-tag port)
    (make-tag #f (parse-tag-type port)))
  (define (parse-tags port)
    (parse-vec port parse-tag))

  (define (parse-strings port)
    (expect-u8 port #x00)
    (parse-vec port get-name))

  (define (parse-globals port)
    (define (parse-global port)
      (let ((type (parse-global-type port)))
        (make-global #f type (parse-expr port))))
    (parse-vec port parse-global))

  (define (parse-exports port)
    (define (parse-export port)
      (let* ((name (get-name port))
             (type (match (get-u8 port)
                     (#x00 'func)
                     (#x01 'table)
                     (#x02 'memory)
                     (#x03 'global)
                     (#x04 'tag)
                     (byte (error "unexpected byte" byte)))))
        (make-export name type (get-uleb port))))
    (parse-vec port parse-export))

  (define (parse-start port)
    (get-uleb port))

  (define (parse-elems port)
    (define (parse-elem port)
      (define (ref-funcs indexes)
        (map (lambda (idx) `((ref.func ,idx))) indexes))
      (match (get-u8 port)
        (#x00 (let* ((offset (parse-expr port)))
                (make-elem #f 'active 0 'funcref offset
                           (ref-funcs (parse-vec port get-uleb)))))
        (#x01 (expect-u8 port #x00)
              (make-elem #f 'passive #f 'funcref #f
                         (ref-funcs (parse-vec port get-uleb))))
        (#x02 (let* ((table (get-uleb port))
                     (offset (parse-expr port)))
                (expect-u8 port #x00)
                (make-elem #f 'active table 'funcref offset
                           (ref-funcs (parse-vec port get-uleb)))))
        (#x03 (expect-u8 port #x00)
              (make-elem #f 'declarative #f 'funcref #f
                         (ref-funcs (parse-vec port get-uleb))))
        (#x04 (let ((offset (parse-expr port)))
                (make-elem #f 'active 0 'funcref offset
                           (parse-vec port parse-expr))))
        (#x05 (let ((type (parse-ref-type port)))
                (make-elem #f 'passive #f type #f
                           (parse-vec port parse-expr))))
        (#x06 (let ((table (get-uleb port))
                    (offset (parse-expr port))
                    (type (parse-ref-type port)))
                (make-elem #f 'active table type offset
                           (parse-vec port parse-expr))))
        (#x07 (let ((type (parse-ref-type port)))
                (make-elem #f 'declarative #f type #f
                           (parse-vec port parse-expr))))
        (byte (error "unexpected byte" byte))))
    (parse-vec port parse-elem))

  (define (parse-func-bodies port)
    (define (parse-code port)
      (call-with-input-bytevector
       (parse-vec/u8 port)
       (lambda (port)
         (define (parse-local port)
           (let ((n (get-uleb port)))
             (make-list n (make-local #f (parse-val-type port)))))
         (let* ((locals (apply append (parse-vec port parse-local)))
                (body (parse-expr port)))
           (unless (eof-object? (lookahead-u8 port))
             (error "unexpected trailing bytes in function"))
           (make-func #f #f locals body)))))
    (parse-vec port parse-code))

  (define (parse-data-count port)
    (get-uleb port))

  (define (parse-data port)
    (define (parse-segment port)
      (match (get-u8 port)
        (#x00 (let ((offset (parse-expr port)))
                (make-data #f 'active 0 offset (parse-vec/u8 port))))
        (#x01 (make-data #f 'passive #f #f (parse-vec/u8 port)))
        (#x02 (let* ((mem (get-uleb port))
                     (offset (parse-expr port)))
                (make-data #f 'active mem offset (parse-vec/u8 port))))
        (byte (error "unexpected data segment kind" byte))))
    (parse-vec port parse-segment))

  (define (parse-section port code parse default)
    (if (match-u8 port code)
        (call-with-input-bytevector
         (parse-vec/u8 port)
         (lambda (port)
           (let ((parsed (parse port)))
             (unless (eof-object? (lookahead-u8 port))
               (error "failed to consume bytes in section" code))
             parsed)))
        (default)))

  (define (parse-names port)
    (define (parse-id port)
      (string->symbol (string-append "$" (get-name port))))
    (define (parse-name-map port)
      (parse-vec port (lambda (port)
                        (cons (get-uleb port) (parse-id port)))))
    (define (parse-indirect-name-map port)
      (parse-vec port (lambda (port)
                        (cons (get-uleb port) (parse-name-map port)))))
    (define (parse-subsection port)
      (match (get-u8 port)
        (0
         (cons 0 (call-with-input-bytevector (parse-vec/u8 port)
                                               parse-id)))
        ((and n (or 1 4 5 6 7 8 9 11))
         (cons n (call-with-input-bytevector (parse-vec/u8 port)
                                               parse-name-map)))
        ((and n (or 2 3 10))
         (cons n (call-with-input-bytevector (parse-vec/u8 port)
                                               parse-indirect-name-map)))
        (n (error "unexpected name subsection" n))))
    (let ((subs (let loop ()
                  (if (eof-object? (lookahead-u8 port))
                      '()
                      (cons (parse-subsection port) (loop))))))
      (define (lookup id default)
        (or (assq-ref subs id) default))
      (make-names (lookup 0 #f)
                  (lookup 1 '())
                  (lookup 2 '())
                  (lookup 3 '())
                  (lookup 4 '())
                  (lookup 5 '())
                  (lookup 6 '())
                  (lookup 7 '())
                  (lookup 8 '())
                  (lookup 9 '())
                  (lookup 10 '())
                  (lookup 11 '()))))

  (define (parse-custom port custom)
    (match (parse-section port #x00
                          (lambda (port)
                            (let ((name (get-name port)))
                              (if (string=? name "name")
                                  (parse-names port)
                                  (make-custom name (get-bytevector-all port)))))
                          (lambda () #f))
      (#f custom)
      (sec (parse-custom port (cons sec custom)))))

  (define-syntax-rule (parse-sections ((custom 0 parse-custom custom-init)
                                       (sec code parse default)
                                       ...)
                        body ...)
    (let ((custom custom-init))
      (let*-values (((custom sec)
                     (let ((custom (parse-custom port custom)))
                       (values custom
                               (parse-section port code parse
                                              (lambda () default)))))
                    ...)
        (let ((custom (parse-custom port custom)))
          body ...))))

  (let ((bytes (get-bytes port 8)))
    (unless (equal? bytes #vu8(#x00 #x61 #x73 #x6D #x01 #x00 #x00 #x00))
      (error "unexpected wasm header" bytes)))
  (parse-sections ((custom 0 parse-custom '())
                   (types 1 parse-types '())
                   (imports 2 parse-imports '())
                   (func-decls 3 parse-func-decls '())
                   (tables 4 parse-tables '())
                   (memories 5 parse-memories '())
                   (tags 13 parse-tags '())
                   (strings 14 parse-strings '())
                   (globals 6 parse-globals '())
                   (exports 7 parse-exports '())
                   (start 8 parse-start #f)
                   (elems 9 parse-elems '())
                   (data-count 12 parse-data-count #f)
                   (func-defs 10 parse-func-bodies '())
                   (data 11 parse-data '()))
    (let* ((flattened-types (let lp ((types types))
                              (match types
                                (() '())
                                ((($ <rec-group> members) . types)
                                 (append members (lp types)))
                                ((type . types) (cons type (lp types))))))
           (ntypes (length flattened-types)))
      (define (resolve-type-use idx)
        (unless (< idx ntypes)
          (error "type index out of bounds"))
        (make-type-use idx (type-val (list-ref flattened-types idx))))
      (define (resolve-import-type-use import)
        (match import
          (($ <import> mod name 'func id ($ <type-use> idx #f))
           (make-import mod name 'func id (resolve-type-use idx)))
          (($ <import> mod name 'tag id
                       ($ <tag-type> attribute ($ <type-use> idx #f)))
           (make-import mod name 'tag id
                        (make-tag-type attribute (resolve-type-use idx))))
          (_ import)))
      (unless (= (length func-decls) (length func-defs))
        (error "should be as many func decls as defs"))
      (when data-count
        (unless (= (length data) data-count)
          (error "bad data-count" data-count)))
      (make-wasm #f
                 types
                 (map resolve-import-type-use imports)
                 (map (match-lambda*
                       ((($ <type-use> idx #f)
                         ($ <func> #f #f locals body))
                        (make-func #f (resolve-type-use idx) locals body)))
                      func-decls
                      func-defs)
                 tables
                 memories
                 globals
                 exports
                 start
                 elems
                 data
                 (map (match-lambda
                        (($ <tag> #f ($ <tag-type> attribute ($ <type-use> idx #f)))
                         (let ((type (resolve-type-use idx)))
                           (make-tag #f (make-tag-type attribute type)))))
                      tags)
                 strings
                 custom))))

;;; Local Variables:
;;; eval: (put 'parse-sections 'scheme-indent-function 1)
;;; End: