mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 22:10:21 +02:00
Code Activity

Partially revert e5f5113c21.

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2009-09-23 22:13:09 +02:00
parent ec370c6ffb
commit d773ba231c
5 changed files with 8 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

2
module/language/assembly.scm
View file

@ -49,7 +49,7 @@
(+ 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)))

2
module/language/assembly/disassemble.scm
View file

@ -35,7 +35,7 @@
(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)))

4
module/language/glil/decompile-assembly.scm
View file

@ -31,7 +31,7 @@
(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))
@ -123,7 +123,7 @@
(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))

6
module/language/tree-il/compile-glil.scm
View file

@ -422,7 +422,7 @@
;; 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))))
@ -578,7 +578,7 @@
(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)
@ -684,7 +684,7 @@
(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)

2
module/system/xref.scm
View file

@ -35,7 +35,7 @@
(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