The intent is to maintain the readability of `pmatch' invocations.
* module/language/assembly/disassemble.scm (disassemble-load-program):
Don't use wildcards in `pmatch' invocations, even when the matched
elements are unused.
* module/language/glil/decompile-assembly.scm (decompile-toplevel,
decompile-load-program): Likewise.
* module/system/xref.scm (program-callee-rev-vars): Likewise.
* module/language/assembly.scm (byte-length): Likewise.
* module/language/tree-il/compile-glil.scm (flatten): Likewise.
(+ 1 *len-len* (string-length str)))
((load-array ,bv)
(+ 1 *len-len* (bytevector-length bv)))
- ((load-program _ _ _ _ ,len ,meta . _)
+ ((load-program ,nargs ,nrest ,nlocs ,labels ,len ,meta . ,code)
(+ 1 *program-header-len* len (if meta (1- (byte-length meta)) 0)))
((,inst . _) (guard (>= (instruction-length inst) 0))
(+ 1 (instruction-length inst)))
(define (disassemble-load-program asm env)
(pmatch asm
- ((load-program ,nargs _ _ ,labels _ _ . ,code)
+ ((load-program ,nargs ,nrest ,nlocs ,labels ,len ,meta . ,code)
(let ((objs (and env (assq-ref env 'objects)))
(free-vars (and env (assq-ref env 'free-vars)))
(meta (and env (assq-ref env 'meta)))
(define (decompile-toplevel x)
(pmatch x
- ((load-program ,nargs ,nrest ,nlocs ,labels _ ,meta . ,body)
+ ((load-program ,nargs ,nrest ,nlocs ,labels ,len ,meta . ,body)
(decompile-load-program nargs nrest nlocs
(decompile-meta meta)
body labels #f))
(lp (cdr in) stack out (1+ pos)))
((make-false)
(lp (cdr in) (cons #f stack) out (1+ pos)))
- ((load-program ,a ,b ,c ,d ,labels _ ,meta . ,body)
+ ((load-program ,a ,b ,c ,d ,labels ,sublen ,meta . ,body)
(lp (cdr in)
(cons (decompile-load-program a b c d (decompile-meta meta)
body labels (car stack))
;; rename & goto
(for-each (lambda (sym)
(pmatch (hashq-ref (hashq-ref allocation sym) self)
- ((#t _ . ,index)
+ ((#t ,boxed? . ,index)
;; set unboxed, as the proc prelude will box if needed
(emit-code #f (make-glil-lexical #t #f 'set index)))
(,x (error "what" x))))
(for-each
(lambda (loc)
(pmatch loc
- ((,local? _ . ,n)
+ ((,local? ,boxed? . ,n)
(emit-code #f (make-glil-lexical local? #f 'ref n)))
(else (error "what" x loc))))
free-locs)
(for-each
(lambda (loc)
(pmatch loc
- ((,local? _ . ,n)
+ ((,local? ,boxed? . ,n)
(emit-code #f (make-glil-lexical local? #f 'ref n)))
(else (error "what" x loc))))
free-locs)
(progv (make-vector (vector-length objects) #f))
(asm (decompile (program-objcode prog) #:to 'assembly)))
(pmatch asm
- ((load-program _ _ _ _ _ . ,body)
+ ((load-program ,nargs ,nrest ,nlocs ,labels ,len . ,body)
(for-each
(lambda (x)
(pmatch x