guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, master, updated. release_1-9-3-19-ge5f


From: Ludovic Courtès
Subject: [Guile-commits] GNU Guile branch, master, updated. release_1-9-3-19-ge5f5113
Date: Sun, 20 Sep 2009 22:38:30 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=e5f5113c21f396705d7479a570c96690135c9d36

The branch, master has been updated
       via  e5f5113c21f396705d7479a570c96690135c9d36 (commit)
       via  a2ca7252121e968798b0638b758ea99d7bf62409 (commit)
      from  f65e2b1ec5ae1962e57322ac3085ab4d44025694 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit e5f5113c21f396705d7479a570c96690135c9d36
Author: Ludovic Courtès <address@hidden>
Date:   Mon Sep 21 00:35:19 2009 +0200

    Remove unused variables in system/language.
    
    * module/language/assembly.scm (byte-length): Don't match unused
      record slots.
    
    * module/language/tree-il.scm (tree-il->scheme, post-order!,
      pre-order!): Likewise.
    
    * module/language/tree-il/analyze.scm (analyze-lexicals): Likewise.
    
    * module/language/tree-il/compile-glil.scm (flatten): Likewise.
    
    * module/language/assembly/disassemble.scm (disassemble-load-program):
      Don't match unused list elements.
    
    * module/language/glil/decompile-assembly.scm (decompile-toplevel,
      decompile-load-program): Likewise.
    
    * module/system/xref.scm (program-callee-rev-vars): Likewise.
    
    * module/language/assembly/compile-bytecode.scm
      (write-bytecode)[write-sized-loader]: Remove.
    
    * module/language/assembly/decompile-bytecode.scm (decode-load-program):
      Factorize `pad' variables.
    
    * module/language/ecmascript/base.scm (object->value/string,
      object->value/number)[v]: Remove.
    
    * module/language/ecmascript/tokenize.scm (read-slash)[c0]: Remove.
    
    * module/language/objcode/spec.scm (decompile-value)[nargs]: Remove.
    
    * module/system/repl/command.scm (time)[vms-start, vms-end]: Remove.
    
    * module/system/repl/repl.scm (prompting-meta-read): Use `prompt'.

commit a2ca7252121e968798b0638b758ea99d7bf62409
Author: Ludovic Courtès <address@hidden>
Date:   Mon Sep 21 00:10:28 2009 +0200

    Remove unused variables in ice-9/goops/srfi/scripts.
    
    * module/ice-9/boot-9.scm (scm-style-repl)[-abort]: Remove.
    
    * module/oop/goops.scm (class)[slot-defs]: Remove.
      (compute-slot-accessors)[name]: Remove.
      (compute-get-n-set)[env]: Remove.
    
    * module/oop/goops/active-slot.scm (compute-get-n-set)[env, name]:
      Remove.
    
    * module/oop/goops/dispatch.scm (cache-try-hash!)[max-misses]: Remove.
    
    * module/oop/goops/save.scm (make-mapper)[dims]: Remove.
    
    * module/scripts/autofrisk.scm (>>checks)[prog]: Remove.
    
    * module/srfi/srfi-19.scm (priv:read-directives)[ireaderf, eireader4]:
      Remove.

-----------------------------------------------------------------------

Summary of changes:
 module/ice-9/boot-9.scm                         |   10 +---------
 module/language/assembly.scm                    |    2 +-
 module/language/assembly/compile-bytecode.scm   |    8 --------
 module/language/assembly/decompile-bytecode.scm |    3 +--
 module/language/assembly/disassemble.scm        |    5 ++---
 module/language/ecmascript/base.scm             |   18 ++++++++----------
 module/language/ecmascript/tokenize.scm         |    5 +++--
 module/language/glil/decompile-assembly.scm     |    4 ++--
 module/language/objcode/spec.scm                |    3 +--
 module/language/tree-il.scm                     |   22 +++++++++++-----------
 module/language/tree-il/analyze.scm             |   22 +++++++++++-----------
 module/language/tree-il/compile-glil.scm        |   12 ++++++------
 module/oop/goops.scm                            |   11 ++++-------
 module/oop/goops/active-slot.scm                |    4 +---
 module/oop/goops/dispatch.scm                   |    5 ++---
 module/oop/goops/save.scm                       |    5 ++---
 module/scripts/autofrisk.scm                    |    3 +--
 module/srfi/srfi-19.scm                         |    4 +---
 module/system/repl/command.scm                  |    6 ++----
 module/system/repl/repl.scm                     |    2 +-
 module/system/xref.scm                          |    2 +-
 21 files changed, 62 insertions(+), 94 deletions(-)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index b1bc3c9..a1537d1 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -2811,15 +2811,7 @@ module '(ice-9 q) '(make-q q-length))}."
                          (display ";;; QUIT executed, repl exitting")
                          (newline)
                          (repl-report)))
-                   args))
-
-          (-abort (lambda ()
-                    (if scm-repl-verbose
-                        (begin
-                          (display ";;; ABORT executed.")
-                          (newline)
-                          (repl-report)))
-                    (repl -read -eval -print))))
+                   args)))
 
     (let ((status (error-catching-repl -read
                                       -eval
diff --git a/module/language/assembly.scm b/module/language/assembly.scm
index 683da6c..95f8a2d 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 ,nargs ,nrest ,nlocs ,labels ,len ,meta . ,code)
+    ((load-program _ _ _ _ ,len ,meta . _)
      (+ 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/compile-bytecode.scm 
b/module/language/assembly/compile-bytecode.scm
index 688cb6b..e8bba9e 100644
--- a/module/language/assembly/compile-bytecode.scm
+++ b/module/language/assembly/compile-bytecode.scm
@@ -80,14 +80,6 @@
   (define (write-loader str)
     (write-loader-len (string-length str))
     (write-string str))
-  (define (write-sized-loader str)
-    (let ((len (string-length str))
-          (wid (string-bytes-per-char str)))
-      (write-loader-len len)
-      (write-byte wid)
-      (if (= wid 4)
-          (write-wide-string str)
-          (write-string str))))
   (define (write-bytevector bv)
     (write-loader-len (bytevector-length bv))
     ;; Ew!
diff --git a/module/language/assembly/decompile-bytecode.scm 
b/module/language/assembly/decompile-bytecode.scm
index 8cdebcf..511c6cc 100644
--- a/module/language/assembly/decompile-bytecode.scm
+++ b/module/language/assembly/decompile-bytecode.scm
@@ -57,8 +57,7 @@
          (e (pop)) (f (pop)) (g (pop)) (h (pop))
          (len (+ a (ash b 8) (ash c 16) (ash d 24)))
          (metalen (+ e (ash f 8) (ash g 16) (ash h 24)))
-         (totlen (+ len metalen))
-         (pad0 (pop)) (pad1 (pop)) (pad2 (pop)) (pad3 (pop))
+         (%unused-pad (begin (pop) (pop) (pop) (pop)))
          (labels '())
          (i 0))
     (define (ensure-label rel1 rel2)
diff --git a/module/language/assembly/disassemble.scm 
b/module/language/assembly/disassemble.scm
index 492acb7..e40a73c 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 ,nrest ,nlocs ,labels ,len ,meta . ,code)
+    ((load-program ,nargs _ _ ,labels _ _ . ,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)))
@@ -106,8 +106,7 @@
 (define *uninteresting-props* '(name))
 
 (define (disassemble-meta meta)
-  (let ((sources (cadr meta))
-        (props (filter (lambda (x)
+  (let ((props (filter (lambda (x)
                          (not (memq (car x) *uninteresting-props*)))
                        (cddr meta))))
     (unless (null? props)
diff --git a/module/language/ecmascript/base.scm 
b/module/language/ecmascript/base.scm
index 1d031fc..f133bb0 100644
--- a/module/language/ecmascript/base.scm
+++ b/module/language/ecmascript/base.scm
@@ -149,17 +149,15 @@
             o))))
               
 (define (object->value/string o)
-  (let ((v (object->string o #f)))
-    (if (is-a? x <js-object>)
-        (object->number o #t)
-        x)))
-              
+  (if (is-a? x <js-object>)
+      (object->number o #t)
+      x))
+
 (define (object->value/number o)
-  (let ((v (object->number o #f)))
-    (if (is-a? x <js-object>)
-        (object->string o #t)
-        x)))
-              
+  (if (is-a? x <js-object>)
+      (object->string o #t)
+      x))
+
 (define (object->value o)
   ;; FIXME: if it's a date, we should try numbers first
   (object->value/string o))
diff --git a/module/language/ecmascript/tokenize.scm 
b/module/language/ecmascript/tokenize.scm
index 1b6a7ee..2ab8045 100644
--- a/module/language/ecmascript/tokenize.scm
+++ b/module/language/ecmascript/tokenize.scm
@@ -50,8 +50,9 @@
       (+ 10 (- (char->integer (char-downcase c)) (char->integer #\a)))))
 
 (define (read-slash port div?)
-  (let* ((c0 (read-char port))
-         (c1 (peek-char port)))
+  (let ((c1 (begin
+              (read-char port)
+              (peek-char port))))
     (cond
      ((eof-object? c1)
       ;; hmm. error if we're not looking for a div? ?
diff --git a/module/language/glil/decompile-assembly.scm 
b/module/language/glil/decompile-assembly.scm
index 3cb887d..ac623db 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 ,len ,meta . ,body)
+    ((load-program ,nargs ,nrest ,nlocs ,labels _ ,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 ,sublen ,meta . ,body)
+          ((load-program ,a ,b ,c ,d ,labels _ ,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/objcode/spec.scm b/module/language/objcode/spec.scm
index 4cb600f..4211027 100644
--- a/module/language/objcode/spec.scm
+++ b/module/language/objcode/spec.scm
@@ -68,8 +68,7 @@
           (meta  (program-meta x))
           (free-vars  (program-free-variables x))
           (binds (program-bindings x))
-          (srcs  (program-sources x))
-          (nargs (arity:nargs (program-arity x))))
+          (srcs  (program-sources x)))
       (let ((blocs (and binds (collapse-locals binds))))
         (values (program-objcode x)
                 `((objects . ,objs)
diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm
index ad8b731..1233632 100644
--- a/module/language/tree-il.scm
+++ b/module/language/tree-il.scm
@@ -226,10 +226,10 @@
     ((<primitive-ref> name)
      name)
     
-    ((<lexical-ref> name gensym)
+    ((<lexical-ref> gensym)
      gensym)
     
-    ((<lexical-set> name gensym exp)
+    ((<lexical-set> gensym exp)
      `(set! ,gensym ,(tree-il->scheme exp)))
     
     ((<module-ref> mod name public?)
@@ -436,37 +436,37 @@ This is an implementation of `foldts' as described by 
Andy Wingo in
          (set! (conditional-then x) (lp then))
          (set! (conditional-else x) (lp else)))
 
-        ((<lexical-set> name gensym exp)
+        ((<lexical-set> exp)
          (set! (lexical-set-exp x) (lp exp)))
                
-        ((<module-set> mod name public? exp)
+        ((<module-set> exp)
          (set! (module-set-exp x) (lp exp)))
 
-        ((<toplevel-set> name exp)
+        ((<toplevel-set> exp)
          (set! (toplevel-set-exp x) (lp exp)))
 
-        ((<toplevel-define> name exp)
+        ((<toplevel-define> exp)
          (set! (toplevel-define-exp x) (lp exp)))
 
-        ((<lambda> vars meta body)
+        ((<lambda> body)
          (set! (lambda-body x) (lp body)))
 
         ((<sequence> exps)
          (set! (sequence-exps x) (map lp exps)))
 
-        ((<let> vars vals body)
+        ((<let> vals body)
          (set! (let-vals x) (map lp vals))
          (set! (let-body x) (lp body)))
 
-        ((<letrec> vars vals body)
+        ((<letrec> vals body)
          (set! (letrec-vals x) (map lp vals))
          (set! (letrec-body x) (lp body)))
 
-        ((<fix> vars vals body)
+        ((<fix> vals body)
          (set! (fix-vals x) (map lp vals))
          (set! (fix-body x) (lp body)))
 
-        ((<let-values> vars exp body)
+        ((<let-values> exp body)
          (set! (let-values-exp x) (lp exp))
          (set! (let-values-body x) (lp body)))
 
diff --git a/module/language/tree-il/analyze.scm 
b/module/language/tree-il/analyze.scm
index b93a0bd..10c1d0b 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -162,7 +162,7 @@
       ((<conditional> test then else)
        (lset-union eq? (step test) (step-tail then) (step-tail else)))
 
-      ((<lexical-ref> name gensym)
+      ((<lexical-ref> gensym)
        (hashq-set! refcounts gensym (1+ (hashq-ref refcounts gensym 0)))
        (if (not (and tail-call-args
                      (memq gensym labels-in-proc)
@@ -172,18 +172,18 @@
            (hashq-set! labels gensym #f))
        (list gensym))
       
-      ((<lexical-set> name gensym exp)
+      ((<lexical-set> gensym exp)
        (hashq-set! assigned gensym #t)
        (hashq-set! labels gensym #f)
        (lset-adjoin eq? (step exp) gensym))
       
-      ((<module-set> mod name public? exp)
+      ((<module-set> exp)
        (step exp))
       
-      ((<toplevel-set> name exp)
+      ((<toplevel-set> exp)
        (step exp))
       
-      ((<toplevel-define> name exp)
+      ((<toplevel-define> exp)
        (step exp))
       
       ((<sequence> exps)
@@ -194,7 +194,7 @@
                (else
                 (lp (cdr exps) (lset-union eq? ret (step (car exps))))))))
       
-      ((<lambda> vars meta body)
+      ((<lambda> vars body)
        (let ((locally-bound (let rev* ((vars vars) (out '()))
                               (cond ((null? vars) out)
                                     ((pair? vars) (rev* (cdr vars)
@@ -326,22 +326,22 @@
       ((<conditional> test then else)
        (max (recur test) (recur then) (recur else)))
 
-      ((<lexical-set> name gensym exp)
+      ((<lexical-set> exp)
        (recur exp))
       
-      ((<module-set> mod name public? exp)
+      ((<module-set> exp)
        (recur exp))
       
-      ((<toplevel-set> name exp)
+      ((<toplevel-set> exp)
        (recur exp))
       
-      ((<toplevel-define> name exp)
+      ((<toplevel-define> exp)
        (recur exp))
       
       ((<sequence> exps)
        (apply max (map recur exps)))
       
-      ((<lambda> vars meta body)
+      ((<lambda> vars body)
        ;; allocate closure vars in order
        (let lp ((c (hashq-ref free-vars x)) (n 0))
          (if (pair? c)
diff --git a/module/language/tree-il/compile-glil.scm 
b/module/language/tree-il/compile-glil.scm
index 9de5c88..d18d5ed 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -251,7 +251,7 @@
        (maybe-emit-return))
 
       ;; FIXME: should represent sequence as exps tail
-      ((<sequence> src exps)
+      ((<sequence> exps)
        (let lp ((exps exps))
          (if (null? (cdr exps))
              (comp-tail (car exps))
@@ -422,7 +422,7 @@
          ;; rename & goto
          (for-each (lambda (sym)
                      (pmatch (hashq-ref (hashq-ref allocation sym) self)
-                       ((#t ,boxed? . ,index)
+                       ((#t _ . ,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))))
@@ -510,7 +510,7 @@
                             'ref (module-name (fluid-ref *comp-module*)) name 
#f))))
          (maybe-emit-return))))
 
-      ((<lexical-ref> src name gensym)
+      ((<lexical-ref> src gensym)
        (case context
          ((push vals tail)
           (pmatch (hashq-ref (hashq-ref allocation gensym) self)
@@ -520,7 +520,7 @@
              (error "badness" x loc)))))
        (maybe-emit-return))
       
-      ((<lexical-set> src name gensym exp)
+      ((<lexical-set> src gensym exp)
        (comp-push exp)
        (pmatch (hashq-ref (hashq-ref allocation gensym) self)
          ((,local? ,boxed? . ,index)
@@ -578,7 +578,7 @@
                   (for-each
                    (lambda (loc)
                      (pmatch loc
-                       ((,local? ,boxed? . ,n)
+                       ((,local? _ . ,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? ,boxed? . ,n)
+                         ((,local? _ . ,n)
                           (emit-code #f (make-glil-lexical local? #f 'ref n)))
                          (else (error "what" x loc))))
                      free-locs)
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index c1754da..a47c4ee 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -1,6 +1,6 @@
 ;;; installed-scm-file
 
-;;;; Copyright (C) 1998,1999,2000,2001,2002, 2003, 2006 Free Software 
Foundation, Inc.
+;;;; Copyright (C) 1998,1999,2000,2001,2002, 2003, 2006, 2009 Free Software 
Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -226,8 +226,7 @@
      slots))
   (if (not (list? supers))
       (goops-error "malformed superclass list: ~S" supers))
-  (let ((slot-defs (cons #f '()))
-        (slots (take-while (lambda (x) (not (keyword? x))) slots))
+  (let ((slots (take-while (lambda (x) (not (keyword? x))) slots))
         (options (or (find-tail keyword? slots) '())))
     `(make-class
       ;; evaluate super class variables
@@ -1074,8 +1073,7 @@
 (define (compute-slot-accessors class slots env)
   (for-each
       (lambda (s g-n-s)
-       (let ((name            (slot-definition-name     s))
-             (getter-function (slot-definition-getter   s))
+       (let ((getter-function (slot-definition-getter   s))
              (setter-function (slot-definition-setter   s))
              (accessor        (slot-definition-accessor s)))
          (if getter-function
@@ -1412,8 +1410,7 @@
     ((#:virtual) ;; No allocation
      ;; slot-ref and slot-set! function must be given by the user
      (let ((get (get-keyword #:slot-ref  (slot-definition-options s) #f))
-          (set (get-keyword #:slot-set! (slot-definition-options s) #f))
-          (env (class-environment class)))
+          (set (get-keyword #:slot-set! (slot-definition-options s) #f)))
        (if (not (and get set))
           (goops-error "You must supply a #:slot-ref and a #:slot-set! in ~S"
                        s))
diff --git a/module/oop/goops/active-slot.scm b/module/oop/goops/active-slot.scm
index 5cd2afe..79aa1b3 100644
--- a/module/oop/goops/active-slot.scm
+++ b/module/oop/goops/active-slot.scm
@@ -1,6 +1,6 @@
 ;;; installed-scm-file
 
-;;;;   Copyright (C) 1999, 2001, 2006 Free Software Foundation, Inc.
+;;;;   Copyright (C) 1999, 2001, 2006, 2009 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -34,9 +34,7 @@
 (define-method (compute-get-n-set (class <active-class>) slot)
   (if (eq? (slot-definition-allocation slot) #:active)
       (let* ((index      (slot-ref class 'nfields))
-            (name        (car slot))
             (s           (cdr slot))
-            (env         (class-environment class))
             (before-ref  (get-keyword #:before-slot-ref  s #f))
             (after-ref   (get-keyword #:after-slot-ref   s #f))
             (before-set! (get-keyword #:before-slot-set! s #f))
diff --git a/module/oop/goops/dispatch.scm b/module/oop/goops/dispatch.scm
index 0dd169d..88abf80 100644
--- a/module/oop/goops/dispatch.scm
+++ b/module/oop/goops/dispatch.scm
@@ -1,4 +1,4 @@
-;;;;   Copyright (C) 1999, 2000, 2001, 2003, 2006 Free Software Foundation, 
Inc.
+;;;;   Copyright (C) 1999, 2000, 2001, 2003, 2006, 2009 Free Software 
Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -186,8 +186,7 @@
       (set! sum (+ sum (struct-ref (car classes) hashset-index))))))
 
 (define (cache-try-hash! min-misses hashset cache entries)
-  (let ((max-misses 0)
-       (mask (- (vector-length cache) 1)))
+  (let ((mask (- (vector-length cache) 1)))
     (let outer ((in entries) (max-misses 0))
       (if (null? in)
           max-misses
diff --git a/module/oop/goops/save.scm b/module/oop/goops/save.scm
index 0c7d71a..b500a0c 100644
--- a/module/oop/goops/save.scm
+++ b/module/oop/goops/save.scm
@@ -1,6 +1,6 @@
 ;;; installed-scm-file
 
-;;;; Copyright (C) 2000,2001,2002, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 2000,2001,2002, 2006, 2009 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -183,8 +183,7 @@
   (enumerate-component! (shared-array-root o) env))
 
 (define (make-mapper array)
-  (let* ((dims (array-dimensions array))
-        (n (array-rank array))
+  (let* ((n (array-rank array))
         (indices (reverse (if (<= n 11)
                               (list-tail '(t s r q p n m l k j i)  (- 11 n))
                               (let loop ((n n)
diff --git a/module/scripts/autofrisk.scm b/module/scripts/autofrisk.scm
index e29ccc9..943c902 100644
--- a/module/scripts/autofrisk.scm
+++ b/module/scripts/autofrisk.scm
@@ -1,6 +1,6 @@
 ;;; autofrisk --- Generate module checks for use with auto* tools
 
-;;     Copyright (C) 2002, 2006 Free Software Foundation, Inc.
+;;     Copyright (C) 2002, 2006, 2009 Free Software Foundation, Inc.
 ;;
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public License
@@ -157,7 +157,6 @@
          (files (apply append (map unglob (cfg 'files-glob))))
          (ncx (cfg 'non-critical-external))
          (nci (cfg 'non-critical-internal))
-         (prog (cfg 'non-critical))
          (report ((make-frisker) files))
          (external (report 'external)))
     (let ((pww-varname (cfg 'pww-varname)))
diff --git a/module/srfi/srfi-19.scm b/module/srfi/srfi-19.scm
index b918249..ba13c03 100644
--- a/module/srfi/srfi-19.scm
+++ b/module/srfi/srfi-19.scm
@@ -1,6 +1,6 @@
 ;;; srfi-19.scm --- Time/Date Library
 
-;;     Copyright (C) 2001, 2002, 2003, 2005, 2006, 2007, 2008 Free Software 
Foundation, Inc.
+;;     Copyright (C) 2001, 2002, 2003, 2005, 2006, 2007, 2008, 2009 Free 
Software Foundation, Inc.
 ;;
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -1345,9 +1345,7 @@
 (define priv:read-directives
   (let ((ireader4 (priv:make-integer-reader 4))
         (ireader2 (priv:make-integer-reader 2))
-        (ireaderf (priv:make-integer-reader #f))
         (eireader2 (priv:make-integer-exact-reader 2))
-        (eireader4 (priv:make-integer-exact-reader 4))
         (locale-reader-abbr-weekday (priv:make-locale-reader
                                      priv:locale-abbr-weekday->index))
         (locale-reader-long-weekday (priv:make-locale-reader
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index a99e1ba..d3d1660 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -337,13 +337,11 @@ Disassemble a file."
 (define-meta-command (time repl (form))
   "time FORM
 Time execution."
-  (let* ((vms-start (vm-stats (repl-vm repl)))
-        (gc-start (gc-run-time))
+  (let* ((gc-start (gc-run-time))
         (tms-start (times))
         (result (repl-eval repl (repl-parse repl form)))
         (tms-end (times))
-        (gc-end (gc-run-time))
-        (vms-end (vm-stats (repl-vm repl))))
+        (gc-end (gc-run-time)))
     (define (get proc start end)
       (exact->inexact (/ (- (proc end) (proc start)) 
internal-time-units-per-second)))
     (repl-print repl result)
diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm
index 2f4a378..bdbf1de 100644
--- a/module/system/repl/repl.scm
+++ b/module/system/repl/repl.scm
@@ -54,7 +54,7 @@
   (let ((prompt (lambda () (repl-prompt repl)))
         (lread (language-reader (repl-language repl))))
     (with-fluid* current-reader (meta-reader lread)
-      (lambda () (repl-reader (lambda () (repl-prompt repl)))))))
+      (lambda () (repl-reader prompt)))))
 
 (define (default-catch-handler . args)
   (pmatch args
diff --git a/module/system/xref.scm b/module/system/xref.scm
index 906ec8e..27c0de5 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 ,nargs ,nrest ,nlocs ,labels ,len . ,body)
+              ((load-program _ _ _ _ _ . ,body)
                (for-each
                 (lambda (x)
                   (pmatch x


hooks/post-receive
-- 
GNU Guile




reply via email to

[Prev in Thread] Current Thread [Next in Thread]