scheme-libraries/retropikzel/wasm/util.scm

90 lines
3.9 KiB
Scheme

(define (body-item->sexp item)
(cond ((not (list? item)) item)
((equal? (car item) 'local)
`(define ,(list-ref item 1) 0))
((equal? (car item) 'global.get)
(list-ref item 1))
((equal? (car item) 'global.set)
`(set! ,(list-ref item 1) ,@(map body-item->sexp (list-tail item 2))))
((equal? (car item) 'global.tee)
`(set! ,(list-ref item 1) ,@(map body-item->sexp (list-tail item 2))))
((equal? (car item) 'local.get)
(list-ref item 1))
((equal? (car item) 'local.set)
`(set! ,(list-ref item 1) ,@(map body-item->sexp (list-tail item 2))))
((equal? (car item) 'local.tee)
`(set! ,(list-ref item 1) ,@(map body-item->sexp (list-tail item 2))))
((equal? (car item) 'result)
#f)
((equal? (car item) 'i32.const)
(list-ref item 1))
((equal? (car item) 'i32.and)
`(bitwise-and ,@(map body-item->sexp (cdr item))))
((equal? (car item) 'i32.add)
`(+ ,@(map body-item->sexp (cdr item))))
((equal? (car item) 'i32.sub)
`(- ,@(map body-item->sexp (cdr item))))
((equal? (car item) 'i32.store)
`(bytevector-s32-set! (vector-ref memory-index ,(body-item->sexp (list-ref item 2)))
,(offset=N->N (list-ref item 1))
,(body-item->sexp (list-ref item 3))
(endianness 'little)))
((equal? (car item) 'i32.load)
(if (> (length item) 2)
`(bytevector-s32-ref (vector-ref memory-index ,(body-item->sexp (list-ref item 2)))
,(offset=N->N (list-ref item 1))
(endianness 'little))
`(bytevector-s32-ref (vector-ref memory-idex 0)
,(body-item->sexp (list-ref item 1))
(endianness 'little))))
((equal? (car item) 'call)
`(,@(map body-item->sexp (cdr item))))
;((equal? (car item) 'block) (display "HERE: block ") (write (list-tail item 2)) (newline) `(call-with-current-continuation (lambda (,(list-ref item 1)) ,@(map body-item->sexp (list-tail item 2)))))
;((or (equal? (car item) 'i32.eqz)) `(= ,@(map body-item->sexp (cdr item))))
;((equal? (car item) 'br_if) `(when (= 1 ,@(map body-item->sexp (list-tail item 2))) (,(list-ref item 1))))
(else (map body-item->sexp item))))
(define webassembly-page-size 65536)
(define (symbol-append sym1 sym2)
(string->symbol (string-append (symbol->string sym1) (symbol->string sym2))))
(define (char-index str c)
(letrec*
((looper
(lambda (index)
(cond ((>= index (string-length str)) -1)
((char=? c (string-ref str index)) index)
(else (looper (+ index 1)))))))
(looper 0)))
(define (offset=N->N sym)
(string->number
(string-copy
(symbol->string sym)
(+ (char-index (symbol->string sym) #\=) 1))))
(define (symbol-starts-with? sym str)
(if (not (symbol? sym))
#f
(let ((sym-str (symbol->string sym)))
(and (>= (string-length sym-str) (string-length str))
(string=? (string-copy sym-str 0 (string-length str)) str)))))
(define string-split
(lambda (str mark)
(let* ((str-l (string->list str))
(res (list))
(last-index 0)
(index 0)
(splitter (lambda (c)
(cond ((char=? c mark)
(begin
(set! res (append res (list (string-copy str last-index index))))
(set! last-index (+ index 1))))
((equal? (length str-l) (+ index 1))
(set! res (append res (list (string-copy str last-index (+ index 1)))))))
(set! index (+ index 1)))))
(for-each splitter str-l)
res)))