[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. release_1-9-6-133-ge6
|
From: |
Ludovic Courtès |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. release_1-9-6-133-ge63dda6 |
|
Date: |
Mon, 11 Jan 2010 00:48:55 +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=e63dda67d70eb4cb92cbc406510a0f21337374a4
The branch, master has been updated
via e63dda67d70eb4cb92cbc406510a0f21337374a4 (commit)
via 0ea72faa4e448356665bab3d679d71e0958963aa (commit)
via 7385dc1243aa9862239c2551d523b1df3fdc63c3 (commit)
via bf943698b6f37f35c22e245d6b56df9d19411ebf (commit)
via 6734191c6822d41920c322d83fa0e17221d95dc3 (commit)
via e6251e7bd98fbc64e9dbf489c8afaf426af46919 (commit)
via bce5cb56413da437c29628c529cec47649d12eb9 (commit)
via bcae9a98b0dd82b7be93e90134a01a03b44b4af7 (commit)
from 7cd554943b455248f8488f7b70b6dc31fc4cc67c (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 e63dda67d70eb4cb92cbc406510a0f21337374a4
Author: Ludovic Courtès <address@hidden>
Date: Mon Jan 11 00:25:20 2010 +0100
Move `feature?' to `deprecated.scm'.
* module/ice-9/boot-9.scm (feature?): Move to...
* module/ice-9/deprecated.scm (feature?): ... here.
commit 0ea72faa4e448356665bab3d679d71e0958963aa
Author: Ludovic Courtès <address@hidden>
Date: Mon Jan 11 00:23:12 2010 +0100
Make `(ice-9 deprecated)' a module of its own.
* module/ice-9/boot-9.scm: Load `deprecated.scm' with
`resolve-interface' instead of `primitive-load-path'.
* module/ice-9/deprecated.scm: Turned into a module, `(ice-9
deprecated)'.
commit 7385dc1243aa9862239c2551d523b1df3fdc63c3
Author: Ludovic Courtès <address@hidden>
Date: Sun Jan 10 23:58:48 2010 +0100
Make `boot-9.scm' more friendly with `-Wunused-toplevel'.
* module/ice-9/boot-9.scm: Switch back to the `(guile)' modules at the
end when compiling.
commit bf943698b6f37f35c22e245d6b56df9d19411ebf
Author: Ludovic Courtès <address@hidden>
Date: Sun Jan 10 23:57:01 2010 +0100
Fix SRFI-19 exports.
* module/srfi/srfi-19.scm: Export `time-monotonic->julian-day' and
`time-monotonic->modified-julian-day'. Remove obscure `current-time'
hack. Use `(define-module :export ...)' instead of `(export ...)'.
commit 6734191c6822d41920c322d83fa0e17221d95dc3
Author: Ludovic Courtès <address@hidden>
Date: Sun Jan 10 23:52:15 2010 +0100
Remove unused top-level variables.
* module/ice-9/runq.scm (fork-strips): Remove.
* module/language/assembly.scm (*block-alignment*): Remove.
* module/language/assembly/disassemble.scm (disassemble-objects,
simplify): Remove.
* module/srfi/srfi-18.scm (mutex-owners): Remove.
* module/srfi/srfi-19.scm (leap-year?): Remove.
* module/system/base/compile.scm (dsu-sort): Remove.
* module/texinfo.scm (ascii->char): Remove.
* module/texinfo/html.scm (ignored?): Remove.
* module/texinfo/indexing.scm (def-name): Remove.
* module/texinfo/plain-text.scm (ignore): Remove.
commit e6251e7bd98fbc64e9dbf489c8afaf426af46919
Author: Ludovic Courtès <address@hidden>
Date: Sun Jan 10 23:48:43 2010 +0100
Have "guile-tools compile" use the current locale.
* meta/guile-tools.in (main): Install the user's locale.
commit bce5cb56413da437c29628c529cec47649d12eb9
Author: Ludovic Courtès <address@hidden>
Date: Sun Jan 10 23:47:55 2010 +0100
Provide Guile-friendly `coding:' meta-data.
* module/ice-9/i18n.scm, module/rnrs/bytevector.scm,
module/rnrs/io/ports.scm, module/scripts/compile.scm,
module/srfi/srfi-35.scm, module/srfi/srfi-88.scm: Write `coding:'
comment at the top.
commit bcae9a98b0dd82b7be93e90134a01a03b44b4af7
Author: Ludovic Courtès <address@hidden>
Date: Mon Jan 11 01:19:16 2010 +0100
Add `-Wunused-toplevel' compiler warning.
* module/language/tree-il/analyze.scm (<reference-dag>): New record
type.
(dag-reachable-nodes, dag-reachable-nodes*, unused-variable-analysis):
New variables.
(unbound-variable-analysis): Slightly simplify the `up' procedure.
* module/language/tree-il/compile-glil.scm (%warning-passes): Add
`unused-toplevel'.
* module/system/base/message.scm (%warning-types): Likewise.
* test-suite/tests/tree-il.test (%opts-w-unused-toplevel): New variable.
("warnings")["unused-toplevel"]: New test prefix.
-----------------------------------------------------------------------
Summary of changes:
meta/guile-tools.in | 3 +-
module/ice-9/boot-9.scm | 12 +--
module/ice-9/deprecated.scm | 36 +++++++-
module/ice-9/i18n.scm | 11 +--
module/ice-9/runq.scm | 3 +-
module/language/assembly.scm | 4 +-
module/language/assembly/disassemble.scm | 16 ---
module/language/tree-il/analyze.scm | 150 +++++++++++++++++++++++++++++-
module/language/tree-il/compile-glil.scm | 1 +
module/rnrs/bytevector.scm | 10 +--
module/rnrs/io/ports.scm | 10 +--
module/scripts/compile.scm | 8 +-
module/srfi/srfi-18.scm | 3 +-
module/srfi/srfi-19.scm | 20 +---
module/srfi/srfi-35.scm | 11 +--
module/srfi/srfi-88.scm | 6 +-
module/system/base/compile.scm | 7 +-
module/system/base/message.scm | 8 ++-
module/texinfo.scm | 4 +-
module/texinfo/html.scm | 4 +-
module/texinfo/indexing.scm | 5 +-
module/texinfo/plain-text.scm | 5 +-
test-suite/tests/tree-il.test | 108 +++++++++++++++++++++
23 files changed, 332 insertions(+), 113 deletions(-)
diff --git a/meta/guile-tools.in b/meta/guile-tools.in
index 51d103f..74870ff 100755
--- a/meta/guile-tools.in
+++ b/meta/guile-tools.in
@@ -6,7 +6,7 @@ exec guile $GUILE_FLAGS -e '(@@ (guile-tools) main)' -s "$0"
"$@"
;;;; guile-tools --- running scripts bundled with Guile
;;;; Andy Wingo <address@hidden> --- April 2009
;;;;
-;;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2010 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
@@ -109,6 +109,7 @@ PROGRAM is run with ARGS.
m)))
(define (main args)
+ (setlocale LC_ALL "")
(if (or (equal? (cdr args) '())
(equal? (cdr args) '("list")))
(list-scripts)
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index bbffda0..a32e2b6 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -3543,13 +3543,7 @@ module '(ice-9 q) '(make-q q-length))}."
;;;
(begin-deprecated
- (define (feature? sym)
- (issue-deprecation-warning
- "`feature?' is deprecated. Use `provided?' instead.")
- (provided? sym)))
-
-(begin-deprecated
- (primitive-load-path "ice-9/deprecated"))
+ (module-use! the-scm-module (resolve-interface '(ice-9 deprecated))))
@@ -3568,4 +3562,8 @@ module '(ice-9 q) '(make-q q-length))}."
(define-module (guile-user)
#:autoload (system base compile) (compile))
+;; Remain in the `(guile)' module at compilation-time so that the
+;; `-Wunused-toplevel' warning works as expected.
+(eval-when (compile) (set-current-module the-root-module))
+
;;; boot-9.scm ends here
diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm
index 0d632b2..82cd726 100644
--- a/module/ice-9/deprecated.scm
+++ b/module/ice-9/deprecated.scm
@@ -1,4 +1,4 @@
-;;;; Copyright (C) 2003, 2005, 2006, 2009 Free Software Foundation, Inc.
+;;;; Copyright (C) 2003, 2005, 2006, 2009, 2010 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
@@ -15,11 +15,35 @@
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
;;;;
+(define-module (ice-9 deprecated)
+ #:export (substring-move-left! substring-move-right!
+ dynamic-maybe-call dynamic-maybe-link
+ try-module-linked try-module-dynamic-link
+ list* feature? eval-case unmemoize-expr
+ $asinh
+ $acosh
+ $atanh
+ $sqrt
+ $abs
+ $exp
+ $log
+ $sin
+ $cos
+ $tan
+ $asin
+ $acos
+ $atan
+ $sinh
+ $cosh
+ $tanh
+ closure?))
+
;;;; Deprecated definitions.
(define substring-move-left! substring-move!)
(define substring-move-right! substring-move!)
+
;; This method of dynamically linking Guile Extensions is deprecated.
;; Use `load-extension' explicitly from Scheme code instead.
@@ -162,12 +186,15 @@
(and (find-and-link-dynamic-module module-name)
(init-dynamic-module module-name)))
+
(define (list* . args)
(issue-deprecation-warning "'list*' is deprecated. Use 'cons*' instead.")
(apply cons* args))
-;; The strange prototype system for uniform arrays has been
-;; deprecated.
+(define (feature? sym)
+ (issue-deprecation-warning
+ "`feature?' is deprecated. Use `provided?' instead.")
+ (provided? sym))
(define-macro (eval-case . clauses)
(issue-deprecation-warning
@@ -186,6 +213,8 @@
(else
`(begin))))
+;; The strange prototype system for uniform arrays has been
+;; deprecated.
(read-hash-extend
#\y
(lambda (c port)
@@ -224,6 +253,7 @@
(define ($sinh z) (sinh z))
(define ($cosh z) (cosh z))
(define ($tanh z) (tanh z))
+
(define (closure? x)
(issue-deprecation-warning
"`closure?' is deprecated. Use `procedure?' instead.")
diff --git a/module/ice-9/i18n.scm b/module/ice-9/i18n.scm
index 52d7cb4..6fa31e4 100644
--- a/module/ice-9/i18n.scm
+++ b/module/ice-9/i18n.scm
@@ -1,6 +1,6 @@
-;;;; i18n.scm --- internationalization support
+;;;; i18n.scm --- internationalization support -*- coding: utf-8 -*-
-;;;; Copyright (C) 2006, 2007, 2009 Free Software Foundation, Inc.
+;;;; Copyright (C) 2006, 2007, 2009, 2010 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
@@ -16,7 +16,7 @@
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
-;;; Author: Ludovic Courtès <address@hidden>
+;;; Author: Ludovic Courtès <address@hidden>
;;; Commentary:
;;;
@@ -414,9 +414,4 @@ number of fractional digits to be displayed."
;; `YESSTR' and `NOSTR' are considered deprecated so we don't provide them.
-
-;;; Local Variables:
-;;; coding: latin-1
-;;; End:
-
;;; i18n.scm ends here
diff --git a/module/ice-9/runq.scm b/module/ice-9/runq.scm
index c14eb89..78a4203 100644
--- a/module/ice-9/runq.scm
+++ b/module/ice-9/runq.scm
@@ -1,6 +1,6 @@
;;;; runq.scm --- the runq data structure
;;;;
-;;;; Copyright (C) 1996, 2001, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 1996, 2001, 2006, 2010 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
@@ -208,7 +208,6 @@
;;; runq, strips of the parallel subtasks will run
;;; round-robin style.
;;;
-(define fork-strips (lambda args args))
;;;;
diff --git a/module/language/assembly.scm b/module/language/assembly.scm
index 541096c..95604b2 100644
--- a/module/language/assembly.scm
+++ b/module/language/assembly.scm
@@ -1,6 +1,6 @@
;;; Guile Virtual Machine Assembly
-;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010 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
@@ -58,8 +58,6 @@
(define *program-alignment* 8)
-(define *block-alignment* 8)
-
(define (addr+ addr code)
(fold (lambda (x len) (+ (byte-length x) len))
addr
diff --git a/module/language/assembly/disassemble.scm
b/module/language/assembly/disassemble.scm
index 0c47061..d072d3b 100644
--- a/module/language/assembly/disassemble.scm
+++ b/module/language/assembly/disassemble.scm
@@ -88,13 +88,6 @@
(else
(error "bad load-program form" asm))))
-(define (disassemble-objects objs)
- (display "Objects:\n\n")
- (let ((len (vector-length objs)))
- (do ((n 0 (1+ n)))
- ((= n len) (newline))
- (print-info n (vector-ref objs n) #f #f))))
-
(define (disassemble-free-vars free-vars)
(display "Free variables:\n\n")
(let lp ((i 0))
@@ -164,12 +157,3 @@
;; i am format's daddy.
(define (print-info addr info extra src)
(format #t "address@hidden address@hidden;; address@hidden@[~61t at
~a~]\n" addr info extra src))
-
-(define (simplify x)
- (cond ((string? x)
- (cond ((string-index x #\newline) =>
- (lambda (i) (set! x (substring x 0 i)))))
- (cond ((> (string-length x) 16)
- (set! x (string-append (substring x 0 13) "..."))))))
- x)
-
diff --git a/module/language/tree-il/analyze.scm
b/module/language/tree-il/analyze.scm
index abda760..f9e5b2f 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -6,12 +6,12 @@
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
-;;;;
+;;;;
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;;; Lesser General Public License for more details.
-;;;;
+;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
@@ -21,6 +21,7 @@
(define-module (language tree-il analyze)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-11)
#:use-module (system base syntax)
#:use-module (system base message)
#:use-module (system vm program)
@@ -29,6 +30,7 @@
#:export (analyze-lexicals
analyze-tree
unused-variable-analysis
+ unused-toplevel-analysis
unbound-variable-analysis
arity-analysis))
@@ -637,6 +639,146 @@ accurate information is missing from a given `tree-il'
element."
;;;
+;;; Unused top-level variable analysis.
+;;;
+
+;; <reference-dag> record top-level definitions that are made, references to
+;; top-level definitions and their context (the top-level definition in which
+;; the reference appears), as well as the current context (the top-level
+;; definition we're currently in). The second part (`refs' below) is
+;; effectively a DAG from which we can determine unused top-level definitions.
+(define-record-type <reference-dag>
+ (make-reference-dag refs defs toplevel-context)
+ reference-dag?
+ (defs reference-dag-defs) ;; ((NAME . LOC) ...)
+ (refs reference-dag-refs) ;; ((REF-CONTEXT REF ...) ...)
+ (toplevel-context reference-dag-toplevel-context)) ;; NAME | #f
+
+(define (dag-reachable-nodes root refs)
+ ;; Return the list of nodes reachable from ROOT in DAG REFS. REFS is an
alist
+ ;; representing edges: ((A B C) (B A) (C)) corresponds to
+ ;;
+ ;; ,-------.
+ ;; v |
+ ;; A ----> B
+ ;; |
+ ;; v
+ ;; C
+
+ (let loop ((root root)
+ (path '())
+ (result '()))
+ (if (or (memq root path)
+ (memq root result))
+ result
+ (let ((children (assoc-ref refs root)))
+ (if (not children)
+ result
+ (let ((path (cons root path)))
+ (append children
+ (fold (lambda (child result)
+ (loop child path result))
+ result
+ children))))))))
+
+(define (dag-reachable-nodes* roots refs)
+ ;; Return the list of nodes in REFS reachable from the nodes listed in ROOTS.
+ ;; FIXME: Choose a more efficient algorithm.
+ (apply lset-union eq?
+ (map (lambda (node)
+ (cons node (dag-reachable-nodes node refs)))
+ roots)))
+
+(define unused-toplevel-analysis
+ ;; Report unused top-level definitions that are not exported.
+ (let ((add-ref-from-context
+ (lambda (dag name)
+ ;; Add an edge CTX -> NAME in DAG.
+ (let* ((refs (reference-dag-refs dag))
+ (defs (reference-dag-defs dag))
+ (ctx (reference-dag-toplevel-context dag))
+ (ctx-refs (or (assoc-ref refs ctx) '())))
+ (make-reference-dag (alist-cons ctx (cons name ctx-refs)
+ (alist-delete ctx refs eq?))
+ defs ctx)))))
+ (define (macro-variable? name env)
+ (and (module? env)
+ (let ((var (module-variable env name)))
+ (and var (variable-bound? var)
+ (macro? (variable-ref var))))))
+
+ (make-tree-analysis
+ (lambda (x dag env locs)
+ ;; X is a leaf.
+ (let ((ctx (reference-dag-toplevel-context dag)))
+ (record-case x
+ ((<toplevel-ref> name src)
+ (add-ref-from-context dag name))
+ (else dag))))
+
+ (lambda (x dag env locs)
+ ;; Going down into X.
+ (let ((ctx (reference-dag-toplevel-context dag))
+ (refs (reference-dag-refs dag))
+ (defs (reference-dag-defs dag)))
+ (record-case x
+ ((<toplevel-define> name src)
+ (let ((refs refs)
+ (defs (alist-cons name (or src (find pair? locs))
+ defs)))
+ (make-reference-dag refs defs name)))
+ ((<toplevel-set> name src)
+ (add-ref-from-context dag name))
+ (else dag))))
+
+ (lambda (x dag env locs)
+ ;; Leaving X's scope.
+ (record-case x
+ ((<toplevel-define>)
+ (let ((refs (reference-dag-refs dag))
+ (defs (reference-dag-defs dag)))
+ (make-reference-dag refs defs #f)))
+ (else dag)))
+
+ (lambda (dag env)
+ ;; Process the resulting reference DAG: determine all private
definitions
+ ;; not reachable from any public definition. Macros
+ ;; (syntax-transformers), which are globally bound, never considered
+ ;; unused since we can't tell whether a macro is actually used; in
+ ;; addition, macros are considered roots of the DAG since they may use
+ ;; private bindings. FIXME: The `make-syntax-transformer' calls don't
+ ;; contain any literal `toplevel-ref' of the global bindings they use so
+ ;; this strategy fails.
+ (define (exported? name)
+ (if (module? env)
+ (module-variable (module-public-interface env) name)
+ #t))
+
+ (let-values (((public-defs private-defs)
+ (partition (lambda (name+src)
+ (let ((name (car name+src)))
+ (or (exported? name)
+ (macro-variable? name env))))
+ (reference-dag-defs dag))))
+ (let* ((roots (cons #f (map car public-defs)))
+ (refs (reference-dag-refs dag))
+ (reachable (dag-reachable-nodes* roots refs))
+ (unused (filter (lambda (name+src)
+ ;; FIXME: This is inefficient when
+ ;; REACHABLE is large (e.g., boot-9.scm);
+ ;; use a vhash or equivalent.
+ (not (memq (car name+src) reachable)))
+ private-defs)))
+ (for-each (lambda (name+loc)
+ (let ((name (car name+loc))
+ (loc (cdr name+loc)))
+ (warning 'unused-toplevel loc name)))
+ (reverse unused)))))
+
+ (make-reference-dag '() '() #f))))
+
+
+;;;
;;; Unbound variable analysis.
;;;
@@ -732,9 +874,7 @@ accurate information is missing from a given `tree-il'
element."
(lambda (x info env locs)
;; Leaving X's scope.
- (let ((refs (toplevel-info-refs info))
- (defs (toplevel-info-defs info)))
- (make-toplevel-info refs defs)))
+ info)
(lambda (toplevel env)
;; Post-process the result.
diff --git a/module/language/tree-il/compile-glil.scm
b/module/language/tree-il/compile-glil.scm
index a2102c9..bfa57a1 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -45,6 +45,7 @@
(define %warning-passes
`((unused-variable . ,unused-variable-analysis)
+ (unused-toplevel . ,unused-toplevel-analysis)
(unbound-variable . ,unbound-variable-analysis)
(arity-mismatch . ,arity-analysis)))
diff --git a/module/rnrs/bytevector.scm b/module/rnrs/bytevector.scm
index 32929c6..56b8a64 100644
--- a/module/rnrs/bytevector.scm
+++ b/module/rnrs/bytevector.scm
@@ -1,6 +1,6 @@
-;;;; bytevector.scm --- R6RS bytevector API
+;;;; bytevector.scm --- R6RS bytevector API -*- coding: utf-8 -*-
-;;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2010 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
@@ -16,7 +16,7 @@
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
-;;; Author: Ludovic Courtès <address@hidden>
+;;; Author: Ludovic Courtès <address@hidden>
;;; Commentary:
;;;
@@ -78,8 +78,4 @@
`(quote ,sym)
(error "unsupported endianness" sym)))
-;;; Local Variables:
-;;; coding: latin-1
-;;; End:
-
;;; bytevector.scm ends here
diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm
index d1b96b3..308a36c 100644
--- a/module/rnrs/io/ports.scm
+++ b/module/rnrs/io/ports.scm
@@ -1,6 +1,6 @@
-;;;; ports.scm --- R6RS port API
+;;;; ports.scm --- R6RS port API -*- coding: utf-8 -*-
-;;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2010 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
@@ -16,7 +16,7 @@
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
-;;; Author: Ludovic Courtès <address@hidden>
+;;; Author: Ludovic Courtès <address@hidden>
;;; Commentary:
;;;
@@ -104,8 +104,4 @@ read from/written to in @var{port}."
(lambda ()
(close-port port))))
-;;; Local Variables:
-;;; coding: latin-1
-;;; End:
-
;;; ports.scm ends here
diff --git a/module/scripts/compile.scm b/module/scripts/compile.scm
index 9b14f2f..3e451a6 100644
--- a/module/scripts/compile.scm
+++ b/module/scripts/compile.scm
@@ -1,6 +1,6 @@
-;;; Compile --- Command-line Guile Scheme compiler
+;;; Compile --- Command-line Guile Scheme compiler -*- coding: iso-8859-1 -*-
-;; Copyright 2005,2008,2009 Free Software Foundation, Inc.
+;; Copyright 2005,2008,2009,2010 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
@@ -177,7 +177,3 @@ Report bugs to <~A>.~%"
input-files)))
(define main compile)
-
-;;; Local Variables:
-;;; coding: latin-1
-;;; End:
diff --git a/module/srfi/srfi-18.scm b/module/srfi/srfi-18.scm
index 4a171b4..4921a95 100644
--- a/module/srfi/srfi-18.scm
+++ b/module/srfi/srfi-18.scm
@@ -1,6 +1,6 @@
;;; srfi-18.scm --- Multithreading support
-;; Copyright (C) 2008, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 2008, 2009, 2010 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
@@ -105,7 +105,6 @@
(define terminated-thread-exception (list 'terminated-thread-exception))
(define uncaught-exception (list 'uncaught-exception))
-(define mutex-owners (make-weak-key-hash-table))
(define object-names (make-weak-key-hash-table))
(define object-specifics (make-weak-key-hash-table))
(define thread-start-conds (make-weak-key-hash-table))
diff --git a/module/srfi/srfi-19.scm b/module/srfi/srfi-19.scm
index 8a86b35..e73e4d6 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, 2009 Free
Software Foundation, Inc.
+;; Copyright (C) 2001, 2002, 2003, 2005, 2006, 2007, 2008, 2009, 2010 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
@@ -43,15 +43,8 @@
:use-module (srfi srfi-8)
:use-module (srfi srfi-9)
:autoload (ice-9 rdelim) (read-line)
- :use-module (ice-9 i18n))
-
-(begin-deprecated
- ;; Prevent `export' from re-exporting core bindings. This behaviour
- ;; of `export' is deprecated and will disappear in one of the next
- ;; releases.
- (define current-time #f))
-
-(export ;; Constants
+ :use-module (ice-9 i18n)
+ :export (;; Constants
time-duration
time-monotonic
time-process
@@ -116,6 +109,8 @@
modified-julian-day->time-tai
modified-julian-day->time-utc
time-monotonic->date
+ time-monotonic->julian-day
+ time-monotonic->modified-julian-day
time-monotonic->time-tai
time-monotonic->time-tai!
time-monotonic->time-utc
@@ -136,7 +131,7 @@
time-utc->time-tai!
;; Date to string/string to date converters.
date->string
- string->date)
+ string->date))
(cond-expand-provide (current-module) '(srfi-19))
@@ -738,9 +733,6 @@
(or (= (modulo year 400) 0)
(and (= (modulo year 4) 0) (not (= (modulo year 100) 0)))))
-(define (leap-year? date)
- (priv:leap-year? (date-year date)))
-
;; Map 1-based month number M to number of days in the year before the
;; start of month M (in a non-leap year).
(define priv:month-assoc '((1 . 0) (2 . 31) (3 . 59) (4 . 90)
diff --git a/module/srfi/srfi-35.scm b/module/srfi/srfi-35.scm
index 5d6557d..7f1ff7f 100644
--- a/module/srfi/srfi-35.scm
+++ b/module/srfi/srfi-35.scm
@@ -1,6 +1,6 @@
-;;; srfi-35.scm --- Conditions
+;;; srfi-35.scm --- Conditions -*- coding: utf-8 -*-
-;; Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 2007, 2008, 2009, 2010 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
@@ -16,7 +16,7 @@
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-;;; Author: Ludovic Courtès <address@hidden>
+;;; Author: Ludovic Courtès <address@hidden>
;;; Commentary:
@@ -352,9 +352,4 @@ by C."
(define-condition-type &error &serious
error?)
-
-;;; Local Variables:
-;;; coding: latin-1
-;;; End:
-
;;; srfi-35.scm ends here
diff --git a/module/srfi/srfi-88.scm b/module/srfi/srfi-88.scm
index 9538f5c..b9056a4 100644
--- a/module/srfi/srfi-88.scm
+++ b/module/srfi/srfi-88.scm
@@ -1,6 +1,6 @@
-;;; srfi-88.scm --- Keyword Objects
+;;; srfi-88.scm --- Keyword Objects -*- coding: utf-8 -*-
-;; Copyright (C) 2008, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 2008, 2009, 2010 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
@@ -16,7 +16,7 @@
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-;;; Author: Ludovic Courtès <address@hidden>
+;;; Author: Ludovic Courtès <address@hidden>
;;; Commentary:
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index da3f7cd..0caa248 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -1,6 +1,6 @@
;;; High-level compiler interface
-;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010 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
@@ -109,11 +109,6 @@
(ensure-writable-dir (dirname dir))
(mkdir dir))))
-(define (dsu-sort list key less)
- (map cdr
- (stable-sort (map (lambda (x) (cons (key x) x)) list)
- (lambda (x y) (less (car x) (car y))))))
-
;;; This function is among the trickiest I've ever written. I tried many
;;; variants. In the end, simple is best, of course.
;;;
diff --git a/module/system/base/message.scm b/module/system/base/message.scm
index bacf041..98bf5cf 100644
--- a/module/system/base/message.scm
+++ b/module/system/base/message.scm
@@ -1,6 +1,6 @@
;;; User interface messages
-;; Copyright (C) 2009 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010 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
@@ -81,6 +81,12 @@
(format port "~A: warning: unused variable `~A'~%"
loc name)))
+ (unused-toplevel
+ "report unused local top-level variables"
+ ,(lambda (port loc name)
+ (format port "~A: warning: possibly unused local top-level
variable `~A'~%"
+ loc name)))
+
(unbound-variable
"report possibly unbound variables"
,(lambda (port loc name)
diff --git a/module/texinfo.scm b/module/texinfo.scm
index d792cfa..0b8285e 100644
--- a/module/texinfo.scm
+++ b/module/texinfo.scm
@@ -1,6 +1,6 @@
;;;; (texinfo) -- parsing of texinfo into SXML
;;;;
-;;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;;;; Copyright (C) 2004, 2009 Andy Wingo <wingo at pobox dot com>
;;;; Copyright (C) 2001,2002 Oleg Kiselyov <oleg at pobox dot com>
;;;;
@@ -427,8 +427,6 @@ Examples:
(read-char port)) ; skip \n that follows \r
line)))
-(define ascii->char integer->char)
-
(define (skip-whitespace port)
(skip-while '(#\space #\tab #\return #\newline) port))
diff --git a/module/texinfo/html.scm b/module/texinfo/html.scm
index f9faf6a..1e37fdc 100644
--- a/module/texinfo/html.scm
+++ b/module/texinfo/html.scm
@@ -1,6 +1,6 @@
;;;; (texinfo html) -- translating stexinfo into shtml
;;;;
-;;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;;;; Copyright (C) 2003,2004,2009 Andy Wingo <wingo at pobox dot com>
;;;;
;;;; This library is free software; you can redistribute it and/or
@@ -210,8 +210,6 @@ name, @code{#}, and the node name."
'(page setfilename setchapternewpage iftex ifinfo ifplaintext ifxml sp vskip
menu ignore syncodeindex comment c dircategory direntry top shortcontents
cindex printindex))
-(define (ignored? tag)
- (memq tag ignore-list))
(define rules
`((% *preorder* . ,(lambda args args)) ;; Keep these around...
diff --git a/module/texinfo/indexing.scm b/module/texinfo/indexing.scm
index bc3d7ab..d7d10cd 100644
--- a/module/texinfo/indexing.scm
+++ b/module/texinfo/indexing.scm
@@ -1,6 +1,6 @@
;;;; (texinfo indexing) -- indexing stexinfo
;;;;
-;;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;;;; Copyright (C) 2003,2004,2009 Andy Wingo <wingo at pobox dot com>
;;;;
;;;; This library is free software; you can redistribute it and/or
@@ -32,9 +32,6 @@
#:use-module (srfi srfi-13)
#:export (stexi-extract-index))
-(define (def-name def)
- (cadr (assq 'name (cdadr def))))
-
(define defines
'(deftp defcv defivar deftypeivar defop deftypeop defmethod
deftypemethod defopt defvr defvar deftypevr deftypevar deffn
diff --git a/module/texinfo/plain-text.scm b/module/texinfo/plain-text.scm
index dfa4c9a..93a7c1d 100644
--- a/module/texinfo/plain-text.scm
+++ b/module/texinfo/plain-text.scm
@@ -1,6 +1,6 @@
;;;; (texinfo plain-text) -- rendering stexinfo as plain text
;;;;
-;;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;;;; Copyright (C) 2003,2004,2009 Andy Wingo <wingo at pobox dot com>
;;;;
;;;; This library is free software; you can redistribute it and/or
@@ -208,9 +208,6 @@
(define (passthrough tag . body)
(stexi->plain-text body))
-(define (ignore . args)
- "")
-
(define (texinfo tag args . body)
(let ((title (chapter 'foo (arg-req 'title args))))
(string-append title (stexi->plain-text body))))
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index f5f85d0..fb875cc 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -554,6 +554,9 @@
(define %opts-w-unused
'(#:warnings (unused-variable)))
+(define %opts-w-unused-toplevel
+ '(#:warnings (unused-toplevel)))
+
(define %opts-w-unbound
'(#:warnings (unbound-variable)))
@@ -615,6 +618,111 @@
(compile '(lambda (x y z) #t)
#:opts %opts-w-unused))))))
+ (with-test-prefix "unused-toplevel"
+
+ (pass-if "used after definition"
+ (null? (call-with-warnings
+ (lambda ()
+ (let ((in (open-input-string
+ "(define foo 2) foo")))
+ (read-and-compile in
+ #:to 'assembly
+ #:opts %opts-w-unused-toplevel))))))
+
+ (pass-if "used before definition"
+ (null? (call-with-warnings
+ (lambda ()
+ (let ((in (open-input-string
+ "(define (bar) foo) (define foo 2) (bar)")))
+ (read-and-compile in
+ #:to 'assembly
+ #:opts %opts-w-unused-toplevel))))))
+
+ (pass-if "unused but public"
+ (let ((in (open-input-string
+ "(define-module (test-suite tree-il x) #:export (bar))
+ (define (bar) #t)")))
+ (null? (call-with-warnings
+ (lambda ()
+ (read-and-compile in
+ #:to 'assembly
+ #:opts %opts-w-unused-toplevel))))))
+
+ (pass-if "unused but public (more)"
+ (let ((in (open-input-string
+ "(define-module (test-suite tree-il x) #:export (bar))
+ (define (bar) (baz))
+ (define (baz) (foo))
+ (define (foo) #t)")))
+ (null? (call-with-warnings
+ (lambda ()
+ (read-and-compile in
+ #:to 'assembly
+ #:opts %opts-w-unused-toplevel))))))
+
+ (pass-if "unused but define-public"
+ ;; FIXME: We don't handle this case for now because `define-public'
+ ;; expands to a relatively complex statement that's hard to match.
+ (throw 'unresolved)
+
+ (null? (call-with-warnings
+ (lambda ()
+ (compile '(define-public foo 2)
+ #:to 'assembly
+ #:opts %opts-w-unused-toplevel)))))
+
+ (pass-if "used by macro"
+ ;; FIXME: See comment about macros at `unused-toplevel-analysis'.
+ (throw 'unresolved)
+
+ (null? (call-with-warnings
+ (lambda ()
+ (let ((in (open-input-string
+ "(define (bar) 'foo)
+ (define-syntax baz
+ (syntax-rules () ((_) (bar))))")))
+ (read-and-compile in
+ #:to 'assembly
+ #:opts %opts-w-unused-toplevel))))))
+
+ (pass-if "unused"
+ (let ((w (call-with-warnings
+ (lambda ()
+ (compile '(define foo 2)
+ #:to 'assembly
+ #:opts %opts-w-unused-toplevel)))))
+ (and (= (length w) 1)
+ (number? (string-contains (car w)
+ (format #f "top-level variable `~A'"
+ 'foo))))))
+
+ (pass-if "unused recursive"
+ (let ((w (call-with-warnings
+ (lambda ()
+ (compile '(define (foo) (foo))
+ #:to 'assembly
+ #:opts %opts-w-unused-toplevel)))))
+ (and (= (length w) 1)
+ (number? (string-contains (car w)
+ (format #f "top-level variable `~A'"
+ 'foo))))))
+
+ (pass-if "unused mutually recursive"
+ (let* ((in (open-input-string
+ "(define (foo) (bar)) (define (bar) (foo))"))
+ (w (call-with-warnings
+ (lambda ()
+ (read-and-compile in
+ #:to 'assembly
+ #:opts %opts-w-unused-toplevel)))))
+ (and (= (length w) 2)
+ (number? (string-contains (car w)
+ (format #f "top-level variable `~A'"
+ 'foo)))
+ (number? (string-contains (cadr w)
+ (format #f "top-level variable `~A'"
+ 'bar)))))))
+
(with-test-prefix "unbound variable"
(pass-if "quiet"
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. release_1-9-6-133-ge63dda6,
Ludovic Courtès <=