From d773ba231ce0c8d2c16a50d3449c74c60e0b4921 Mon Sep 17 00:00:00 2001
From: =?utf8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 23 Sep 2009 22:13:09 +0200
Subject: [PATCH] Partially revert e5f5113c21f396705d7479a570c96690135c9d36.

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.
---
 module/language/assembly.scm                | 2 +-
 module/language/assembly/disassemble.scm    | 2 +-
 module/language/glil/decompile-assembly.scm | 4 ++--
 module/language/tree-il/compile-glil.scm    | 6 +++---
 module/system/xref.scm                      | 2 +-
 5 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/module/language/assembly.scm b/module/language/assembly.scm
index 95f8a2d12..683da6cc1 100644
--- a/module/language/assembly.scm
+++ b/module/language/assembly.scm
@@ -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)))
diff --git a/module/language/assembly/disassemble.scm b/module/language/assembly/disassemble.scm
index e40a73c6f..ed2a82f33 100644
--- a/module/language/assembly/disassemble.scm
+++ b/module/language/assembly/disassemble.scm
@@ -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)))
diff --git a/module/language/glil/decompile-assembly.scm b/module/language/glil/decompile-assembly.scm
index ac623db19..3cb887d44 100644
--- a/module/language/glil/decompile-assembly.scm
+++ b/module/language/glil/decompile-assembly.scm
@@ -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))
diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm
index d18d5edd4..d13cf7ca5 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -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)
diff --git a/module/system/xref.scm b/module/system/xref.scm
index 27c0de56d..906ec8e4a 100644
--- a/module/system/xref.scm
+++ b/module/system/xref.scm
@@ -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
-- 
2.20.1