;;; Hoot WebAssembly toolkit

;;; Copyright (C) 2026 Igalia, S.L.
;;;
;;; 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:
;;;
;;; Stripping debug information from a compiled Wasm module.
;;;
;;; Code:

(define-module (wasm strip)
  #:use-module (ice-9 match)
  #:use-module (ice-9 binary-ports)
  #:use-module (rnrs bytevectors)
  #:export (strip))

(define %wasm-header #vu8(#x00 #x61 #x73 #x6D #x01 #x00 #x00 #x00))

(define* (strip port #:key external-debug-info)
  (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-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 (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-name port name)
    (let ((bytes (string->utf8 name)))
      (put-uleb port (bytevector-length bytes))
      (put-bytevector port bytes)))

  (let ((bytes (get-bytes port 8)))
    (unless (equal? bytes %wasm-header)
      (error "unexpected wasm header" bytes)))

  (define (external-debug-info-section)
    (call-with-output-bytevector
     (lambda (port)
       (put-name port "external_debug_info")
       (put-name port external-debug-info))))

  (define (finish main-sections debug-sections)
    (define (write-wasm sections)
      (call-with-output-bytevector
       (lambda (port)
         (put-bytevector port %wasm-header)
         (for-each (match-lambda
                     ((id . bytes)
                      (put-u8 port id)
                      (put-uleb port (bytevector-length bytes))
                      (put-bytevector port bytes)))
                   sections))))
    (values (write-wasm main-sections)
            (match debug-sections
              (() #f)
              (sections (write-wasm sections)))))

  (let lp ((main-sections '()) (debug-sections '()))
    (match (get-u8 port)
      ((? eof-object?)
       (finish (reverse (if (and external-debug-info
                                 (not (null? debug-sections)))
                            (acons 0 (external-debug-info-section)
                                   main-sections)
                            main-sections))
               (reverse debug-sections)))
      (id
       (let* ((len (get-uleb port))
              (bytes (get-bytes port len)))
         (cond
          ((eq? id 0)
           (match (call-with-input-bytevector bytes get-name)
             ((or ".debug_info"
                  ".debug_abbrev"
                  ".debug_str"
                  ".debug_loc"
                  ".debug_line"
                  ".debug_pubnames"
                  ".debug_aranges")
              (lp main-sections (acons id bytes debug-sections)))
             ("external_debug_info"
              (lp main-sections debug-sections))
             (_
              (lp (acons id bytes main-sections) debug-sections))))
          (else
           (lp (acons id bytes main-sections) debug-sections))))))))
