;;; WebAssembly assembler
;;; Copyright (C) 2023, 2024, 2026 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.

;;; DWARF support based on Guile's (system vm assembler), which has the
;;; following copyright:
;;; Guile bytecode assembler

;;; Copyright (C) 2001, 2009-2023, 2025, 2025 Free Software Foundation, Inc.
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
;;; License as published by the Free Software Foundation; either
;;; version 3 of the License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; Lesser General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with this library; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

;;; Commentary:
;;;
;;; Assembler for WebAssembly.
;;;
;;; Code:

(define-module (wasm assemble)
  #:use-module (ice-9 binary-ports)
  #:use-module (ice-9 match)
  #:use-module (ice-9 vlist)
  #:use-module (rnrs bytevectors)
  #:use-module (system vm dwarf)
  #:use-module ((system vm linker)
                #:select (make-string-table
                          string-table-intern!
                          string-table-size
                          string-table-writer))
  #:use-module (wasm types)
  #:export (dwarf-producer
            dwarf-language
            assemble-wasm))

(define dwarf-producer
  (make-parameter "Hoot"))
(define dwarf-language
  (make-parameter 'scheme))

(define (string-table-finish strtab)
  (let ((bv (make-bytevector (string-table-size strtab))))
    ((string-table-writer strtab) bv)
    bv))

(define (port-position port)
  (seek port 0 SEEK_CUR))

;; -> 5 values: .debug_info, .debug_abbrev, .debug_str, .debug_loc, .debug_lines
;; Mostly derived from Guile's (system vm assembler).
(define (link-debug funcs sources code-size)
  (define (put-uleb128 port val)
    (let lp ((val val))
      (let ((next (ash val -7)))
        (if (zero? next)
            (put-u8 port val)
            (begin
              (put-u8 port (logior #x80 (logand val #x7f)))
              (lp next))))))

  (define (put-sleb128 port val)
    (let lp ((val val))
      (if (<= 0 (+ val 64) 127)
          (put-u8 port (logand val #x7f))
          (begin
            (put-u8 port (logior #x80 (logand val #x7f)))
            (lp (ash val -7))))))

  (define (put-s8 port val)
    (let ((bv (make-bytevector 1)))
      (bytevector-s8-set! bv 0 val)
      (put-bytevector port bv)))

  (define (put-u16 port val)
    (let ((bv (make-bytevector 2)))
      (bytevector-u16-set! bv 0 val (endianness little))
      (put-bytevector port bv)))

  (define (put-u32 port val)
    (let ((bv (make-bytevector 4)))
      (bytevector-u32-set! bv 0 val (endianness little))
      (put-bytevector port bv)))

  (define (put-u64 port val)
    (let ((bv (make-bytevector 8)))
      (bytevector-u64-set! bv 0 val (endianness little))
      (put-bytevector port bv)))

  (define (make-compile-unit-die)
    `(compile-unit
      (@ (producer ,(dwarf-producer))
         (language ,(dwarf-language))
         (low-pc 0)
         (high-pc ,code-size)
         (stmt-list 0))
      ,@(map (match-lambda
               (#(attrs low-pc high-pc)
                `(subprogram
                  (@ ,@attrs
                     (low-pc ,low-pc)
                     (high-pc ,(- high-pc low-pc))))))
             (reverse funcs))))

  (define-values (die-port get-die-bv) (open-bytevector-output-port))
  (define-values (abbrev-port get-abbrev-bv) (open-bytevector-output-port))
  ;; (tag has-kids? attrs forms) -> code
  (define abbrevs vlist-null)
  (define strtab (make-string-table))
  (define-values (line-port get-line-bv) (open-bytevector-output-port))
  ;; file -> code
  (define files vlist-null)

  (define (attribute-name->code* attr)
    (if (eq? attr 'introspectable?)
        #x2da4
        (attribute-name->code attr)))

  (define (write-abbrev code tag has-children? attrs forms)
    (put-uleb128 abbrev-port code)
    (put-uleb128 abbrev-port (tag-name->code tag))
    (put-u8 abbrev-port (children-name->code (if has-children? 'yes 'no)))
    (for-each (lambda (attr form)
                (put-uleb128 abbrev-port (attribute-name->code* attr))
                (put-uleb128 abbrev-port (form-name->code form)))
              attrs forms)
    (put-uleb128 abbrev-port 0)
    (put-uleb128 abbrev-port 0))

  (define (intern-abbrev tag has-children? attrs forms)
    (let ((key (list tag has-children? attrs forms)))
      (match (vhash-assoc key abbrevs)
        ((_ . code) code)
        (#f (let ((code (1+ (vlist-length abbrevs))))
              (set! abbrevs (vhash-cons key code abbrevs))
              (write-abbrev code tag has-children? attrs forms)
              code)))))

  (define (intern-file file)
    (match (vhash-assoc file files)
      ((_ . code) code)
      (#f (let ((code (1+ (vlist-length files))))
            (set! files (vhash-cons file code files))
            code))))

  (define (write-sources)
    (define base -4)
    (define range 15)
    (define min-inc 1)                ; Minimum PC increment.

    (let lp ((sources sources)
             (out '()))
      (match sources
        (((pc . #(file line col)) . sources)
         (lp sources
             ;; Guile line and column numbers are 0-indexed, but
             ;; they are 1-indexed for DWARF.
             (if (and line col)
                 (cons (list pc
                             (if (string? file) (intern-file file) 0)
                             (1+ line)
                             (1+ col))
                       out)
                 out)))
        (()
         ;; Compilation unit header for .debug_line.  We write in
         ;; DWARF 2 format because more tools understand it than DWARF
         ;; 4, which incompatibly adds another field to this header.

         (put-u32 line-port 0)    ; Length; will patch later.
         (put-u16 line-port 2)    ; DWARF 2 format.
         (put-u32 line-port 0)    ; Prologue length; will patch later.
         (put-u8 line-port min-inc) ; Minimum instruction length: 1 byte.
         (put-u8 line-port 1)       ; Default is-stmt: true.

         (put-s8 line-port base) ; Line base.  See the DWARF standard.
         (put-u8 line-port range) ; Line range.  See the DWARF standard.
         (put-u8 line-port 10) ; Opcode base: the first "special" opcode.

         ;; A table of the number of uleb128 arguments taken by each
         ;; of the standard opcodes.
         (put-u8 line-port 0)         ; 1: copy
         (put-u8 line-port 1)         ; 2: advance-pc
         (put-u8 line-port 1)         ; 3: advance-line
         (put-u8 line-port 1)         ; 4: set-file
         (put-u8 line-port 1)         ; 5: set-column
         (put-u8 line-port 0)         ; 6: negate-stmt
         (put-u8 line-port 0)         ; 7: set-basic-block
         (put-u8 line-port 0)         ; 8: const-add-pc
         (put-u8 line-port 1)         ; 9: fixed-advance-pc

         ;; Include directories, as a zero-terminated sequence of
         ;; nul-terminated strings.  Nothing, for the moment.
         (put-u8 line-port 0)

         ;; File table.  For each file that contributes to this
         ;; compilation unit, a nul-terminated file name string, and a
         ;; uleb128 for each of directory the file was found in, the
         ;; modification time, and the file's size in bytes.  We pass
         ;; zero for the latter three fields.
         (vlist-fold-right
          (lambda (pair seed)
            (match pair
              ((file . code)
               (put-bytevector line-port (string->utf8 file))
               (put-u8 line-port 0)
               (put-uleb128 line-port 0)   ; directory
               (put-uleb128 line-port 0)   ; mtime
               (put-uleb128 line-port 0))) ; size
            seed)
          #f
          files)
         (put-u8 line-port 0)         ; 0 byte terminating file list.

         ;; Patch prologue length.
         (let ((offset (port-position line-port)))
           (seek line-port 6 SEEK_SET)
           (put-u32 line-port (- offset 10))
           (seek line-port offset SEEK_SET))

         ;; Now write the statement program.
         (let ()
           (define (extended-op opcode payload-len)
             (put-u8 line-port 0)                     ; extended op
             (put-uleb128 line-port (1+ payload-len)) ; payload-len + opcode
             (put-uleb128 line-port opcode))
           (define (end-sequence pc)
             (let ((pc-inc (/ (- code-size pc) min-inc)))
               (put-u8 line-port 2)   ; advance-pc
               (put-uleb128 line-port pc-inc))
             (extended-op 1 0))
           (define (advance-pc pc-inc line-inc)
             (let ((spec (+ (- line-inc base)
                            (* (/ pc-inc min-inc) range)
                            10)))
               (cond
                ((or (< line-inc base) (>= line-inc (+ base range)))
                 (advance-line line-inc)
                 (advance-pc pc-inc 0))
                ((<= spec 255)
                 (put-u8 line-port spec))
                ((< spec 500)
                 (put-u8 line-port 8) ; const-advance-pc
                 (advance-pc (- pc-inc (* (floor/ (- 255 10) range) min-inc))
                             line-inc))
                (else
                 (put-u8 line-port 2) ; advance-pc
                 (put-uleb128 line-port (/ pc-inc min-inc))
                 (advance-pc 0 line-inc)))))
           (define (advance-line inc)
             (put-u8 line-port 3)
             (put-sleb128 line-port inc))
           (define (set-file file)
             (put-u8 line-port 4)
             (put-uleb128 line-port file))
           (define (set-column col)
             (put-u8 line-port 5)
             (put-uleb128 line-port col))

           (let lp ((in out) (pc 0) (file 1) (line 1) (col 0))
             (match in
               (()
                (when (null? out)
                  ;; There was no source info in the first place.  Set
                  ;; file register to 0 before adding final row.
                  (set-file 0))
                (end-sequence pc))
               (((pc* file* line* col*) . in*)
                (cond
                 ((and (eqv? file file*) (eqv? line line*) (eqv? col col*))
                  (lp in* pc file line col))
                 (else
                  (unless (eqv? col col*)
                    (set-column col*))
                  (unless (eqv? file file*)
                    (set-file file*))
                  (advance-pc (- pc* pc) (- line* line))
                  (lp in* pc* file* line* col*)))))))))))

  (define (compute-code attr val)
    (match attr
      ('name (string-table-intern! strtab val))
      ('low-pc val)
      ('high-pc val)
      ('producer (string-table-intern! strtab val))
      ('language (language-name->code val))
      ('stmt-list val)
      ('introspectable? val)))

  (define (choose-form attr val code)
    (cond
     ((string? val) 'strp)
     ((eq? attr 'stmt-list) 'sec-offset)
     ((eq? attr 'low-pc) 'addr)
     ((eqv? val #t) 'flag-present)
     ((exact-integer? code)
      (cond
       ((< code 0) 'sleb128)
       ((<= code #xff) 'data1)
       ((<= code #xffff) 'data2)
       ((<= code #xffffffff) 'data4)
       ((<= code #xffffffffffffffff) 'data8)
       (else 'uleb128)))
     (else (error "unhandled case" attr val code))))

  (define (write-value code form)
    (match form
      ('flag-present (values))
      ('data1 (put-u8 die-port code))
      ('data2 (put-u16 die-port code))
      ('data4 (put-u32 die-port code))
      ('data8 (put-u64 die-port code))
      ('uleb128 (put-uleb128 die-port code))
      ('sleb128 (put-sleb128 die-port code))
      ('addr (put-u32 die-port code))
      ('sec-offset (put-u32 die-port code))
      ('strp (put-u32 die-port code))))

  (define (write-die die)
    (match die
      ((tag ('@ (attrs vals) ...) children ...)
       (let* ((codes (map compute-code attrs vals))
              (forms (map choose-form attrs vals codes))
              (has-children? (not (null? children)))
              (abbrev-code (intern-abbrev tag has-children? attrs forms)))
         (put-uleb128 die-port abbrev-code)
         (for-each write-value codes forms)
         (when has-children?
           (for-each write-die children)
           (put-uleb128 die-port 0))))))

  ;; Compilation unit header.
  (put-u32 die-port 0)                  ; Length; will patch later.
  (put-u16 die-port 4)                  ; DWARF 4.
  (put-u32 die-port 0)                  ; Abbrevs offset.
  (put-u8 die-port 4)                   ; Address size.

  (write-die (make-compile-unit-die))

  ;; Terminate the abbrevs list.
  (put-uleb128 abbrev-port 0)

  (write-sources)

  (define (patch-length bv)
    ;; Patch DWARF32 length.
    (bytevector-u32-set! bv 0 (- (bytevector-length bv) 4)
                         (endianness little))
    bv)

  (values (make-custom ".debug_info" (patch-length (get-die-bv)))
          (make-custom ".debug_abbrev" (get-abbrev-bv))
          (make-custom ".debug_str" (string-table-finish strtab))
          (make-custom ".debug_loc" #vu8())
          (make-custom ".debug_line" (patch-length (get-line-bv)))))

(define (assemble-wasm wasm)
  (define (put-uleb port val)
    (let lp ((val val))
      (let ((next (ash val -7)))
        (if (zero? next)
            (put-u8 port val)
            (begin
              (put-u8 port (logior #x80 (logand val #x7f)))
              (lp next))))))

  (define (put-sleb port val)
    (let lp ((val val))
      (if (<= 0 (+ val 64) 127)
          (put-u8 port (logand val #x7f))
          (begin
            (put-u8 port (logior #x80 (logand val #x7f)))
            (lp (ash val -7))))))

  (define (put-u32le port val)
    (let ((bv (u32vector 0)))
      (bytevector-u32-set! bv 0 val (endianness little))
      (put-bytevector port bv)))

  (define (->s32 val)
    (if (< val (ash 1 31)) val (- val (ash 1 32))))
  (define (->s64 val)
    (if (< val (ash 1 63)) val (- val (ash 1 64))))

  (define (emit-u8 port val) (put-u8 port val))
  (define (emit-u32 port val) (put-uleb port val))
  (define (emit-s32 port val) (put-sleb port (->s32 val)))
  (define (emit-s64 port val) (put-sleb port (->s64 val)))
  (define (emit-f32 port val) (put-bytevector port (f32vector val)))
  (define (emit-f64 port val) (put-bytevector port (f64vector val)))

  (define (emit-vec port items emit)
    (emit-u32 port (length items))
    (for-each (lambda (item) (emit port item)) items))

  (define (emit-vec/u8 port bv)
    (emit-u32 port (bytevector-length bv))
    (put-bytevector port bv))

  (define (emit-heap-type port ht)
    (match ht
      ((and (? exact-integer?) (not (? negative?))) (put-sleb port ht))
      ('noexn (emit-u8 port #x74))
      ('nofunc (emit-u8 port #x73))
      ('noextern (emit-u8 port #x72))
      ('none (emit-u8 port #x71))
      ('func (emit-u8 port #x70))
      ('extern (emit-u8 port #x6F))
      ('any (emit-u8 port #x6E))
      ('eq (emit-u8 port #x6D))
      ('i31 (emit-u8 port #x6C))
      ('struct (emit-u8 port #x6B))
      ('array (emit-u8 port #x6A))
      ('exn (emit-u8 port #x69))
      ('string (emit-u8 port #x67))
      ('stringview_wtf8 (emit-u8 port #x66))
      ('stringview_wtf16 (emit-u8 port #x62))
      ('stringview_iter (emit-u8 port #x61))

      (_ (error "unexpected heap type" ht))))

  (define (emit-val-type port vt)
    (match vt
      ('i32 (emit-u8 port #x7F))
      ('i64 (emit-u8 port #x7E))
      ('f32 (emit-u8 port #x7D))
      ('f64 (emit-u8 port #x7C))
      ('v128 (emit-u8 port #x7B))
      ('nullexnref (emit-u8 port #x74))
      ('nullfuncref (emit-u8 port #x73))
      ('nullexternref (emit-u8 port #x72))
      ('nullref (emit-u8 port #x71))
      ('funcref (emit-u8 port #x70))
      ('externref (emit-u8 port #x6F))
      ('anyref (emit-u8 port #x6E))
      ('eqref (emit-u8 port #x6D))
      ('i31ref (emit-u8 port #x6C))
      ('structref (emit-u8 port #x6B))
      ('arrayref (emit-u8 port #x6A))
      ('exnref (emit-u8 port #x69))

      ;; Non-finalized proposals below.
      ('stringref (emit-u8 port #x67))
      ('stringview_wtf8ref (emit-u8 port #x66))
      ('stringview_wtf16ref (emit-u8 port #x62))
      ('stringview_iterref (emit-u8 port #x61))

      (($ <ref-type> nullable? ht)
       (emit-u8 port (if nullable? #x63 #x64))
       (emit-heap-type port ht))

      (_ (error "unexpected valtype" vt))))

  (define (emit-result-type port rt)
    (emit-vec port rt emit-val-type))

  (define (emit-block-type port bt)
    (match bt
      (#f (emit-u8 port #x40))
      ((? exact-integer?) (emit-s32 port bt))
      ((or (? symbol?) ($ <ref-type>)) (emit-val-type port bt))
      (($ <type-use> #f ($ <func-sig> () ())) (emit-u8 port #x40))
      (($ <type-use> #f ($ <func-sig> () (vt))) (emit-val-type port vt))
      (($ <type-use> idx) (emit-s32 port idx))))

  (define (emit-limits port limits)
    (match limits
      (($ <limits> min #f)
       (emit-u8 port #x00)
       (emit-u32 port min))
      (($ <limits> min max)
       (emit-u8 port #x01)
       (emit-u32 port min)
       (emit-u32 port max))))

  (define (emit-ref-type port rt)
    (match rt
      ((or 'i32 'i64 'f32 'f64 'i128)
       (error "unexpected reftype" rt))
      (_ (emit-val-type port rt))))

  (define (emit-elem-type port et)
    (emit-ref-type port et))

  (define (emit-table-type port tt)
    (match tt
      (($ <table-type> limits elem-type)
       (emit-elem-type port elem-type)
       (emit-limits port limits))))

  (define (emit-mem-type port mt)
    (match mt
      (($ <mem-type> limits) (emit-limits port limits))))

  (define (emit-global-type port gt)
    (match gt
      (($ <global-type> mutable? vt)
       (emit-val-type port vt)
       (emit-u8 port (if mutable? 1 0)))))

  (define (emit-tag-type port tt)
    (match tt
      (($ <tag-type> attribute type)
       (match attribute
         ('exception (emit-u8 port #x00))
         (_ (error "bad tag attribute" attribute)))
       (emit-type-use port type))))

  (define (emit-name port str)
    (emit-vec/u8 port (string->utf8 str)))

  (define (emit-end port)
    (emit-u8 port #x0B))

  (define (make-debug-ctx) (vector '() '()))
  (define (add-source! ctx pc src)
    (match ctx
      ('no-ctx (error "sources not allowed"))
      (#(sources attrs)
       (vector-set! ctx 0 (acons pc src sources)))))
  (define (add-attr! ctx name val)
    (match ctx
      ('no-ctx (error "name not allowed"))
      (#(sources attrs)
       (vector-set! ctx 1 (cons (list name val) attrs)))))

  (define (emit-instruction port ctx inst)
    (define (bad-instruction) (error "bad instruction" inst))

    (define-values (op args)
      (match inst
        ((op args ...) (values op args))
        (op (values op '()))))

    (define (emit-source)
      (match args
        ((src)
         (add-source! ctx (port-position port) src))))
    (define (emit-attr)
      (match args
        ((name val)
         (add-attr! ctx name val))))
    (define (emit code)
      (match args
        (() (emit-u8 port code))
        (_ (bad-instruction))))
    (define (emit-block code)
      (match args
        ((label bt insts)
         (emit-u8 port code)
         (emit-block-type port bt)
         (emit-instructions port ctx insts)
         (emit-end port))
        (_ (bad-instruction))))
    (define (emit-if code)
      (define else-code #x05)
      (match args
        ((label bt consequent alternate)
         (emit-u8 port code)
         (emit-block-type port bt)
         (emit-instructions port ctx consequent)
         (unless (null? alternate)
           (emit-u8 port else-code)
           (emit-instructions port ctx alternate))
         (emit-end port))
        (_ (bad-instruction))))
    (define (emit-try_table code)
      (match args
        ((label bt catches body)
         (emit-u8 port code)
         (emit-block-type port bt)
         (emit-vec port catches
                   (lambda (port catch)
                     (match catch
                       (('catch tag label)
                        (emit-u8 port #x00)
                        (emit-u32 port tag)
                        (emit-u32 port label))
                       (('catch_ref tag label)
                        (emit-u8 port #x01)
                        (emit-u32 port tag)
                        (emit-u32 port label))
                       (('catch_all label)
                        (emit-u8 port #x02)
                        (emit-u32 port label))
                       (('catch_all_ref label)
                        (emit-u8 port #x03)
                        (emit-u32 port label)))))
         (emit-instructions port ctx body)
         (emit-end port))))
    (define (emit-idx code)
      (match args
        ((idx)
         (emit-u8 port code)
         (emit-u32 port idx))
        (_ (bad-instruction))))
    (define (emit-br_table code)
      (match args
        ((targets default)
         (emit-u8 port code)
         (emit-vec port targets emit-u32)
         (emit-u32 port default))
        (_ (bad-instruction))))
    (define (emit-call_indirect code)
      (match args
        ((table type)
         (emit-u8 port code)
         (emit-u32 port type)
         (emit-u32 port table))
        (_ (bad-instruction))))
    (define (emit-select old-code new-code)
      (match args
        (()
         (emit-u8 port old-code))
        ((types)
         (emit-u8 port new-code)
         (emit-vec port types emit-val-type))
        (_ (bad-instruction))))
    (define (emit-mem code)
      (match args
        ((($ <mem-arg> id offset align))
         (emit-u8 port code)
         (emit-u32 port
                   (if (zero? id)
                       align
                       (logior align (ash 1 6))))
         (unless (zero? id)
           (emit-u32 port id))
         (emit-u32 port offset))
        (_ (bad-instruction))))
    (define (emit-const code emit-val)
      (match args
        ((val)
         (emit-u8 port code)
         (emit-val port val))
        (_ (bad-instruction))))
    (define (emit-ht code)
      (match args
        ((ht)
         (emit-u8 port code)
         (emit-heap-type port ht))
        (_ (bad-instruction))))
    (define (emit-gc-op code)
      (emit-u8 port #xfb)
      (put-uleb port code))
    (define (emit-gc code)
      (match args
        (() (emit-gc-op code))
        (_ (bad-instruction))))
    (define (emit-gc-idx code)
      (match args
        ((idx)
         (emit-gc-op code)
         (emit-u32 port idx))
        (_ (bad-instruction))))
    (define (emit-gc-idx-idx code)
      (match args
        ((idx0 idx1)
         (emit-gc-op code)
         (emit-u32 port idx0)
         (emit-u32 port idx1))
        (_ (bad-instruction))))
    (define (emit-gc-idx-len code)
      (emit-gc-idx-idx code))
    (define (emit-gc-rt code nullable-code)
      (match args
        ((($ <ref-type> nullable? ht))
         (emit-gc-op (if nullable? nullable-code code))
         (emit-heap-type port ht))
        (_ (bad-instruction))))
    (define (emit-gc-idx-rt-rt code)
      (match args
        ((idx ($ <ref-type> nullable1? ht1) ($ <ref-type> nullable2? ht2))
         (emit-gc-op code)
         (emit-u8 port (logior (if nullable1? 1 0) (if nullable2? 2 0)))
         (emit-u32 port idx)
         (emit-heap-type port ht1)
         (emit-heap-type port ht2))
        (_ (bad-instruction))))
    (define (emit-misc-op code)
      (emit-u8 port #xfc)
      (put-uleb port code))
    (define (emit-misc code)
      (match args
        (()
         (emit-misc-op code))
        (_ (bad-instruction))))
    (define (emit-misc-idx code)
      (match args
        ((idx)
         (emit-misc-op code)
         (emit-u32 port idx))
        (_ (bad-instruction))))
    (define (emit-misc-idx-idx code)
      (match args
        ((idx0 idx1)
         (emit-misc-op code)
         (emit-u32 port idx0)
         (emit-u32 port idx1))
        (_ (bad-instruction))))
    (define (emit-simd-splat code)
      (match args
        (()
         (emit-u8 port #xfd)
         (emit-u32 port code))
        (_ (bad-instruction))))

    (match op
      ('$source             (emit-source))
      ('$attr               (emit-attr))
      ('unreachable         (emit #x00))
      ('nop                 (emit #x01))
      ('block               (emit-block #x02))
      ('loop                (emit-block #x03))
      ('if                  (emit-if #x04))
      ('try_table           (emit-try_table #x1f))
      ('throw               (emit-idx #x08))
      ('throw_ref           (emit #x0A))
      ('br                  (emit-idx #x0C))
      ('br_if               (emit-idx #x0D))
      ('br_table            (emit-br_table #x0E))
      ('return              (emit #x0F))
      ('call                (emit-idx #x10))
      ('call_indirect       (emit-call_indirect #x11))
      ('return_call         (emit-idx #x12))
      ('return_call_indirect (emit-call_indirect #x13))
      ('call_ref            (emit-idx #x14))
      ('return_call_ref     (emit-idx #x15))
      ('drop                (emit #x1A))
      ('select              (emit-select #x1B #x1C))
      ('local.get           (emit-idx #x20))
      ('local.set           (emit-idx #x21))
      ('local.tee           (emit-idx #x22))
      ('global.get          (emit-idx #x23))
      ('global.set          (emit-idx #x24))
      ('table.get           (emit-idx #x25))
      ('table.set           (emit-idx #x26))
      ('i32.load            (emit-mem #x28))
      ('i64.load            (emit-mem #x29))
      ('f32.load            (emit-mem #x2A))
      ('f64.load            (emit-mem #x2B))
      ('i32.load8_s         (emit-mem #x2C))
      ('i32.load8_u         (emit-mem #x2D))
      ('i32.load16_s        (emit-mem #x2E))
      ('i32.load16_u        (emit-mem #x2F))
      ('i64.load8_s         (emit-mem #x30))
      ('i64.load8_u         (emit-mem #x31))
      ('i64.load16_s        (emit-mem #x32))
      ('i64.load16_u        (emit-mem #x33))
      ('i64.load32_s        (emit-mem #x34))
      ('i64.load32_u        (emit-mem #x35))
      ('i32.store           (emit-mem #x36))
      ('i64.store           (emit-mem #x37))
      ('f32.store           (emit-mem #x38))
      ('f64.store           (emit-mem #x39))
      ('i32.store8          (emit-mem #x3A))
      ('i32.store16         (emit-mem #x3B))
      ('i64.store8          (emit-mem #x3C))
      ('i64.store16         (emit-mem #x3D))
      ('i64.store32         (emit-mem #x3E))
      ('memory.size         (emit-idx #x3F))
      ('memory.grow         (emit-idx #x40))
      ('i32.const           (emit-const #x41 emit-s32))
      ('i64.const           (emit-const #x42 emit-s64))
      ('f32.const           (emit-const #x43 emit-f32))
      ('f64.const           (emit-const #x44 emit-f64))
      ('i32.eqz             (emit #x45))
      ('i32.eq              (emit #x46))
      ('i32.ne              (emit #x47))
      ('i32.lt_s            (emit #x48))
      ('i32.lt_u            (emit #x49))
      ('i32.gt_s            (emit #x4A))
      ('i32.gt_u            (emit #x4B))
      ('i32.le_s            (emit #x4C))
      ('i32.le_u            (emit #x4D))
      ('i32.ge_s            (emit #x4E))
      ('i32.ge_u            (emit #x4F))
      ('i64.eqz             (emit #x50))
      ('i64.eq              (emit #x51))
      ('i64.ne              (emit #x52))
      ('i64.lt_s            (emit #x53))
      ('i64.lt_u            (emit #x54))
      ('i64.gt_s            (emit #x55))
      ('i64.gt_u            (emit #x56))
      ('i64.le_s            (emit #x57))
      ('i64.le_u            (emit #x58))
      ('i64.ge_s            (emit #x59))
      ('i64.ge_u            (emit #x5A))
      ('f32.eq              (emit #x5B))
      ('f32.ne              (emit #x5C))
      ('f32.lt              (emit #x5D))
      ('f32.gt              (emit #x5E))
      ('f32.le              (emit #x5F))
      ('f32.ge              (emit #x60))
      ('f64.eq              (emit #x61))
      ('f64.ne              (emit #x62))
      ('f64.lt              (emit #x63))
      ('f64.gt              (emit #x64))
      ('f64.le              (emit #x65))
      ('f64.ge              (emit #x66))
      ('i32.clz             (emit #x67))
      ('i32.ctz             (emit #x68))
      ('i32.popcnt          (emit #x69))
      ('i32.add             (emit #x6A))
      ('i32.sub             (emit #x6B))
      ('i32.mul             (emit #x6C))
      ('i32.div_s           (emit #x6D))
      ('i32.div_u           (emit #x6E))
      ('i32.rem_s           (emit #x6F))
      ('i32.rem_u           (emit #x70))
      ('i32.and             (emit #x71))
      ('i32.or              (emit #x72))
      ('i32.xor             (emit #x73))
      ('i32.shl             (emit #x74))
      ('i32.shr_s           (emit #x75))
      ('i32.shr_u           (emit #x76))
      ('i32.rotl            (emit #x77))
      ('i32.rotr            (emit #x78))
      ('i64.clz             (emit #x79))
      ('i64.ctz             (emit #x7A))
      ('i64.popcnt          (emit #x7B))
      ('i64.add             (emit #x7C))
      ('i64.sub             (emit #x7D))
      ('i64.mul             (emit #x7E))
      ('i64.div_s           (emit #x7F))
      ('i64.div_u           (emit #x80))
      ('i64.rem_s           (emit #x81))
      ('i64.rem_u           (emit #x82))
      ('i64.and             (emit #x83))
      ('i64.or              (emit #x84))
      ('i64.xor             (emit #x85))
      ('i64.shl             (emit #x86))
      ('i64.shr_s           (emit #x87))
      ('i64.shr_u           (emit #x88))
      ('i64.rotl            (emit #x89))
      ('i64.rotr            (emit #x8A))
      ('f32.abs             (emit #x8B))
      ('f32.neg             (emit #x8C))
      ('f32.ceil            (emit #x8D))
      ('f32.floor           (emit #x8E))
      ('f32.trunc           (emit #x8F))
      ('f32.nearest         (emit #x90))
      ('f32.sqrt            (emit #x91))
      ('f32.add             (emit #x92))
      ('f32.sub             (emit #x93))
      ('f32.mul             (emit #x94))
      ('f32.div             (emit #x95))
      ('f32.min             (emit #x96))
      ('f32.max             (emit #x97))
      ('f32.copysign        (emit #x98))
      ('f64.abs             (emit #x99))
      ('f64.neg             (emit #x9A))
      ('f64.ceil            (emit #x9B))
      ('f64.floor           (emit #x9C))
      ('f64.trunc           (emit #x9D))
      ('f64.nearest         (emit #x9E))
      ('f64.sqrt            (emit #x9F))
      ('f64.add             (emit #xA0))
      ('f64.sub             (emit #xA1))
      ('f64.mul             (emit #xA2))
      ('f64.div             (emit #xA3))
      ('f64.min             (emit #xA4))
      ('f64.max             (emit #xA5))
      ('f64.copysign        (emit #xA6))
      ('i32.wrap_i64        (emit #xA7))
      ('i32.trunc_f32_s     (emit #xA8))
      ('i32.trunc_f32_u     (emit #xA9))
      ('i32.trunc_f64_s     (emit #xAA))
      ('i32.trunc_f64_u     (emit #xAB))
      ('i64.extend_i32_s    (emit #xAC))
      ('i64.extend_i32_u    (emit #xAD))
      ('i64.trunc_f32_s     (emit #xAE))
      ('i64.trunc_f32_u     (emit #xAF))
      ('i64.trunc_f64_s     (emit #xB0))
      ('i64.trunc_f64_u     (emit #xB1))
      ('f32.convert_i32_s   (emit #xB2))
      ('f32.convert_i32_u   (emit #xB3))
      ('f32.convert_i64_s   (emit #xB4))
      ('f32.convert_i64_u   (emit #xB5))
      ('f32.demote_f64      (emit #xB6))
      ('f64.convert_i32_s   (emit #xB7))
      ('f64.convert_i32_u   (emit #xB8))
      ('f64.convert_i64_s   (emit #xB9))
      ('f64.convert_i64_u   (emit #xBA))
      ('f64.promote_f32     (emit #xBB))
      ('i32.reinterpret_f32 (emit #xBC))
      ('i64.reinterpret_f64 (emit #xBD))
      ('f32.reinterpret_i32 (emit #xBE))
      ('f64.reinterpret_i64 (emit #xBF))
      ('i32.extend8_s       (emit #xc0))
      ('i32.extend16_s      (emit #xc1))
      ('i64.extend8_s       (emit #xc2))
      ('i64.extend16_s      (emit #xc3))
      ('i64.extend32_s      (emit #xc4))

      ;; GC.
      ('ref.null            (emit-ht #xd0))
      ('ref.is_null         (emit #xd1))
      ('ref.func            (emit-idx #xd2))
      ('ref.eq              (emit #xd3))
      ('ref.as_non_null     (emit #xd4))
      ('struct.new          (emit-gc-idx 0))
      ('struct.new_default  (emit-gc-idx 1))
      ('struct.get          (emit-gc-idx-idx 2))
      ('struct.get_s        (emit-gc-idx-idx 3))
      ('struct.get_u        (emit-gc-idx-idx 4))
      ('struct.set          (emit-gc-idx-idx 5))
      ('array.new           (emit-gc-idx 6))
      ('array.new_default   (emit-gc-idx 7))
      ('array.new_fixed     (emit-gc-idx-len 8))
      ('array.new_data      (emit-gc-idx-idx 9))
      ('array.new_elem      (emit-gc-idx-idx 10))
      ('array.get           (emit-gc-idx 11))
      ('array.get_s         (emit-gc-idx 12))
      ('array.get_u         (emit-gc-idx 13))
      ('array.set           (emit-gc-idx 14))
      ('array.len           (emit-gc 15))
      ('array.fill          (emit-gc-idx 16))
      ('array.copy          (emit-gc-idx-idx 17))
      ('array.init_data     (emit-gc-idx-idx 18))
      ('array.init_elem     (emit-gc-idx-idx 19))
      ('ref.test            (emit-gc-rt 20 21))
      ('ref.cast            (emit-gc-rt 22 23))
      ('br_on_cast          (emit-gc-idx-rt-rt 24))
      ('br_on_cast_fail     (emit-gc-idx-rt-rt 25))
      ('any.convert_extern  (emit-gc 26))
      ('extern.convert_any  (emit-gc 27))
      ('ref.i31             (emit-gc 28))
      ('i31.get_s           (emit-gc 29))
      ('i31.get_u           (emit-gc 30))

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

      ;; Vector opcodes.
      ('i8x16.splat                        (emit-simd-splat #x0f))
      ('i16x8.splat                        (emit-simd-splat #x10))
      ('i32x4.splat                        (emit-simd-splat #x11))
      ('i64x2.splat                        (emit-simd-splat #x12))
      ('f32x4.splat                        (emit-simd-splat #x13))
      ('f64x2.splat                        (emit-simd-splat #x14))

      ;; Misc opcodes.
      ('i32.trunc_sat_f32_s                (emit-misc #x00))
      ('i32.trunc_sat_f32_u                (emit-misc #x01))
      ('i32.trunc_sat_f64_s                (emit-misc #x02))
      ('i32.trunc_sat_f64_u                (emit-misc #x03))
      ('i64.trunc_sat_f32_s                (emit-misc #x04))
      ('i64.trunc_sat_f32_u                (emit-misc #x05))
      ('i64.trunc_sat_f64_s                (emit-misc #x06))
      ('i64.trunc_sat_f64_u                (emit-misc #x07))
      ('memory.init                        (emit-misc-idx-idx #x08))
      ('data.drop                          (emit-misc-idx #x09))
      ('memory.copy                        (emit-misc-idx-idx #x0a))
      ('memory.fill                        (emit-misc-idx #x0b))
      ('table.init                         (emit-misc-idx-idx #x0c))
      ('elem.drop                          (emit-misc-idx #x0d))
      ('table.copy                         (emit-misc-idx-idx #x0e))
      ('table.grow                         (emit-misc-idx #x0f))
      ('table.size                         (emit-misc-idx #x10))
      ('table.fill                         (emit-misc-idx #x11))

      (_ (bad-instruction))))

  (define (emit-instructions port ctx insts)
    (for-each (lambda (inst) (emit-instruction port ctx inst)) insts))

  (define (emit-expr port expr)
    (emit-instructions port 'no-debug-ctx expr)
    (emit-end port))

  (define (emit-type-def port def)
    (define (emit-field-type port mutable? st)
      (match st
        ('i8 (emit-u8 port #x78))
        ('i16 (emit-u8 port #x77))
        (_ (emit-val-type port st)))
      (emit-u8 port (if mutable? 1 0)))
    (define (emit-field port field)
      (match field
        (($ <field> id mutable? type)
         (emit-field-type port mutable? type))))
    (define (emit-base-type-def port def)
      (match def
        (($ <func-sig> (($ <param> _ param-type) ...) (result-type ...))
         (emit-u8 port #x60)
         (emit-result-type port param-type)
         (emit-result-type port result-type))
        (($ <struct-type> fields)
         (emit-u8 port #x5f)
         (emit-vec port fields emit-field))
        (($ <array-type> mutable? type)
         (emit-u8 port #x5e)
         (emit-field-type port mutable? type))))
    (define (emit-sub-type-def port def)
      (match def
        (($ <sub-type> final? supers def)
         (emit-u8 port (if final? #x4f #x50))
         (emit-vec port supers emit-u32)
         (emit-base-type-def port def))
        (_ (emit-base-type-def port def))))
    (match def
      (($ <rec-group> (($ <type> _ def) ...))
       (emit-u8 port #x4e)
       (emit-vec port def emit-sub-type-def))
      (($ <type> id def)
       (emit-sub-type-def port def))))

  (define (emit-type-use port type)
    (match type
      (($ <type-use> idx)
       (emit-u32 port idx))))

  (define (emit-import port import)
    (match import
      (($ <import> mod name kind id type)
       (emit-name port mod)
       (emit-name port name)
       (match kind
         ('func
          (emit-u8 port #x00)
          (emit-type-use port type))
         ('table
          (emit-u8 port #x01)
          (emit-table-type port type))
         ('memory
          (emit-u8 port #x02)
          (emit-mem-type port type))
         ('global
          (emit-u8 port #x03)
          (emit-global-type port type))
         ('tag
          (emit-u8 port #x04)
          (emit-tag-type port type))))))

  (define (emit-func-decl port func)
    (match func
      (($ <func> id type locals body)
       (emit-type-use port type))))

  (define (emit-table port table)
    (match table
      (($ <table> id type #f)
       (emit-table-type port type))
      (($ <table> id type init)
       (emit-u8 port #x40)
       (emit-u8 port #x00)
       (emit-table-type port type)
       (emit-expr port init))))

  (define (emit-memory port memory)
    (match memory
      (($ <memory> id type)
       (emit-mem-type port type))))

  (define (emit-global port global)
    (match global
      (($ <global> id type init)
       (emit-global-type port type)
       (emit-expr port init))))

  (define (emit-export port export)
    (match export
      (($ <export> name kind id)
       (emit-name port name)
       (match kind
         ('func (emit-u8 port #x00))
         ('table (emit-u8 port #x01))
         ('memory (emit-u8 port #x02))
         ('global (emit-u8 port #x03))
         ('tag (emit-u8 port #x04)))
       (emit-u32 port id))))

  (define (emit-element port elem)
    (define (funcref? t)
      (match t
        ((or 'funcref ($ <ref-type> #t 'func)) #t)
        (_ #f)))
    (match elem
      (($ <elem> id 'active 0 (? funcref?) offset ((('ref.func idx)) ...))
       (emit-u8 port #x00)
       (emit-expr port offset)
       (emit-vec port idx emit-u32))
      (($ <elem> id 'passive #f (? funcref?) #f ((('ref.func idx)) ...))
       (emit-u8 port #x01)
       (emit-u8 port #x00) ;; elemkind: funcref
       (emit-vec port idx emit-u32))
      (($ <elem> id 'active table (? funcref?) offset ((('ref.func idx)) ...))
       (emit-u8 port #x02)
       (emit-u32 port table)
       (emit-expr port offset)
       (emit-u8 port #x00) ;; elemkind: funcref
       (emit-vec port idx emit-u32))
      (($ <elem> id 'declarative #f (? funcref?) #f ((('ref.func idx)) ...))
       (emit-u8 port #x03)
       (emit-u8 port #x00) ;; elemkind: funcref
       (emit-vec port idx emit-u32))
      (($ <elem> id 'active 0 (? funcref?) offset (expr ...))
       (emit-u8 port #x04)
       (emit-expr port offset)
       (emit-vec port expr emit-expr))
      (($ <elem> id 'passive #f type #f (expr ...))
       (emit-u8 port #x05)
       (emit-ref-type port type)
       (emit-vec port expr emit-expr))
      (($ <elem> id 'active table type offset (expr ...))
       (emit-u8 port #x06)
       (emit-u32 port table)
       (emit-expr port offset)
       (emit-ref-type port type)
       (emit-vec port expr emit-expr))
      (($ <elem> id 'declarative #f type #f (expr ...))
       (emit-u8 port #x07)
       (emit-ref-type port type)
       (emit-vec port expr emit-expr))))

  (define (emit-func-def port func)
    (define (emit-compressed-locals port locals)
      (define compressed
        (let compress ((locals locals))
          (match locals
            (() '())
            ((($ <local> id type) . locals)
             (match (compress locals)
               (((count . (? (lambda (vt) (equal? vt type)))) . compressed)
                (acons (1+ count) type compressed))
               (compressed (acons 1 type compressed)))))))
      (emit-vec port compressed
                (lambda (port pair)
                  (match pair
                    ((count . vt)
                     (emit-u32 port count)
                     (emit-val-type port vt))))))
    (match func
      (($ <func> id type locals body)
       (define debug-ctx (make-debug-ctx))
       (define bytes
         (call-with-output-bytevector
          (lambda (port)
            (emit-compressed-locals port locals)
            (emit-instructions port debug-ctx body)
            (emit-end port))))
       (emit-u32 port (bytevector-length bytes))
       (define low-pc (port-position port))
       (define high-pc (+ low-pc (bytevector-length bytes)))
       (put-bytevector port bytes)
       (match debug-ctx
         (#(local-sources attrs)
          (values (map (match-lambda
                         ((pc . src)
                          (cons (+ pc low-pc) src)))
                       local-sources)
                  (vector (reverse attrs) low-pc high-pc)))))))

  (define (emit-data port data)
    (match data
      (($ <data> id 'active 0 offset init)
       (emit-u8 port #x00)
       (emit-expr port offset)
       (emit-vec/u8 port init))
      (($ <data> id 'passive #f offset init)
       (emit-u8 port #x01)
       (emit-vec/u8 port init))
      (($ <data> id 'active mem offset init)
       (emit-u8 port #x02)
       (emit-u32 port mem)
       (emit-expr port offset)
       (emit-vec/u8 port init))))

  (define (emit-custom port custom)
    (match custom
      (($ <custom> name bytes)
       (emit-name port name)
       (put-bytevector port bytes))
      (($ <names> module function local label type table memory global elem
                  data field tag)
       (define (id->string id)
         (substring (symbol->string id) 1))
       (define (emit-name-map port name-map)
         (emit-vec port name-map
                   (lambda (port pair)
                     (match pair
                       ((id . name)
                        (emit-u32 port id)
                        (emit-name port (id->string name)))))))
       (define (emit-indirect-name-map port iname-map)
         (emit-vec port iname-map
                   (lambda (port pair)
                     (match pair
                       ((id . name-map)
                        (emit-u32 port id)
                        (emit-name-map port name-map))))))
       (define (emit-subsection port id subsection)
         (emit-u8 port id)
         (emit-vec/u8 port subsection))
       (define (emit-names port id name-map)
         (unless (null? name-map)
           (emit-subsection port id
                            (call-with-output-bytevector
                             (lambda (port)
                               (emit-name-map port name-map))))))
       (define (emit-indirect-names port id iname-map)
         (unless (null? iname-map)
           (emit-subsection port id
                            (call-with-output-bytevector
                             (lambda (port)
                               (emit-indirect-name-map port iname-map))))))
       (let ((bytes
              (call-with-output-bytevector
               (lambda (port)
                 (when module
                   (emit-subsection port 0
                                    (call-with-output-bytevector
                                     (lambda (port)
                                       (emit-name port (id->string module))))))
                 (emit-names port 1 function)
                 (emit-indirect-names port 2 local)
                 (emit-indirect-names port 3 label)
                 (emit-names port 4 type)
                 (emit-names port 5 table)
                 (emit-names port 6 memory)
                 (emit-names port 7 global)
                 (emit-names port 8 elem)
                 (emit-names port 9 data)
                 (emit-indirect-names port 10 field)
                 (emit-names port 11 tag)))))
         (emit-custom port (make-custom "name" bytes))))))

  (define (emit-tag port tag)
    (match tag
      (($ <tag> id type)
       (emit-tag-type port type))))

  (define (emit-section port code bytes)
    (emit-u8 port code)
    (emit-vec/u8 port bytes))

  (define (emit-vec-section port code items emit-item)
    (unless (null? items)
      (emit-section port code
                    (call-with-output-bytevector
                     (lambda (port)
                       (emit-vec port items emit-item))))))

  (match wasm
    (($ <wasm> id types imports funcs tables memories globals exports start
        elems datas tags strings custom)
     (call-with-output-bytevector
      (lambda (port)
        (put-bytevector port #vu8(#x00 #x61 #x73 #x6d)) ;; "\0asm"
        (put-bytevector port #vu8(1 0 0 0))             ;; version
        (emit-vec-section port 1 types emit-type-def)
        (emit-vec-section port 2 imports emit-import)
        (emit-vec-section port 3 funcs emit-func-decl)
        (emit-vec-section port 4 tables emit-table)
        (emit-vec-section port 5 memories emit-memory)
        (emit-vec-section port 13 tags emit-tag)
        (unless (null? strings)
          (emit-section port 14 (call-with-output-bytevector
                                 (lambda (port)
                                   (emit-u8 port #x00)
                                   (emit-vec port strings emit-name)))))
        (emit-vec-section port 6 globals emit-global)
        (emit-vec-section port 7 exports emit-export)
        (when start
          (emit-section port 8 (call-with-output-bytevector
                                (lambda (port)
                                  (emit-u32 port start)))))
        (emit-vec-section port 9 elems emit-element)
        (unless (null? datas)
          (emit-section port 12 (call-with-output-bytevector
                                 (lambda (port)
                                   (emit-u32 port (length datas))))))
        (define sources '())
        (define meta '())
        (define code-section-size 0)
        (unless (null? funcs)
          (emit-section
           port 10
           (call-with-output-bytevector
            (lambda (port)
              (emit-vec
               port funcs
               (lambda (port func)
                 (call-with-values (lambda () (emit-func-def port func))
                   (lambda (func-sources func-meta)
                     (set! sources (append func-sources sources))
                     (set! meta (cons func-meta meta))))))
              (set! code-section-size (port-position port))))))
        (emit-vec-section port 11 datas emit-data)
        (call-with-values
            (lambda ()
              (match (vector meta sources)
                (#((#(() _ _) ...) ())
                 ;; No attrs and no sources?  No debuginfo.
                 (values #f #f #f #f #f))
                (_
                 (link-debug meta sources code-section-size))))
          (lambda (debug_info debug_abbrev debug_str debug_loc debug_lines)
            (define (maybe-adjoin custom . maybe-sections)
              (let lp ((maybe-sections maybe-sections) (out custom))
                (match maybe-sections
                  (() out)
                  ((#f . maybe-sections) (lp maybe-sections out))
                  ((section . maybe-sections)
                   (lp maybe-sections (cons section out))))))
            (let ((custom (maybe-adjoin custom
                                        debug_info
                                        debug_abbrev
                                        debug_str
                                        debug_loc
                                        debug_lines)))
              (unless (null? custom)
                (for-each (lambda (custom)
                            (emit-section port 0
                                          (call-with-output-bytevector
                                           (lambda (port)
                                             (emit-custom port custom)))))
                          custom))))))))))
