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

guile-tools uses srfi-1

Browse source 
* meta/guile-tools.in (guile-tools): Use srfi-1 here, now that we can.
This commit is contained in:
Andy Wingo 2011-01-27 10:57:18 +01:00
parent dce0252bf2
commit a27b0f3682
1 changed files with 3 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

17
meta/guile-tools.in
View file

@ -6,7 +6,7 @@ exec guile $GUILE_FLAGS -e '(@@ (guile-tools) main)' -s "$0" "$@"
;;;; guile-tools --- running scripts bundled with Guile ;;;; guile-tools --- running scripts bundled with Guile
;;;; Andy Wingo <wingo@pobox.com> --- April 2009 ;;;; Andy Wingo <wingo@pobox.com> --- April 2009
;;;; ;;;;
;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;;;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc.
;;;; ;;;;
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -23,7 +23,8 @@ exec guile $GUILE_FLAGS -e '(@@ (guile-tools) main)' -s "$0" "$@"
;;;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;;;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;;;; Boston, MA 02110-1301 USA ;;;; Boston, MA 02110-1301 USA
(define-module (guile-tools)) (define-module (guile-tools)
#:use-module ((srfi srfi-1) #:select (fold append-map)))
;; Hack to provide scripts with the bug-report address. ;; Hack to provide scripts with the bug-report address.
(module-define! the-scm-module (module-define! the-scm-module
@ -31,14 +32,6 @@ exec guile $GUILE_FLAGS -e '(@@ (guile-tools) main)' -s "$0" "$@"
"@PACKAGE_BUGREPORT@") "@PACKAGE_BUGREPORT@")
;; We can't import srfi-1, unfortunately, as we are used early in the
;; boot process, before the srfi-1 shlib is built.
(define (fold kons seed seq)
(if (null? seq)
seed
(fold kons (kons (car seq) seed) (cdr seq))))
(define (display-help) (define (display-help)
(display "\ (display "\
Usage: guile-tools --version Usage: guile-tools --version
@ -87,10 +80,6 @@ There is NO WARRANTY, to the extent permitted by law.
((equal? (car l) (cadr l)) (unique (cdr l))) ((equal? (car l) (cadr l)) (unique (cdr l)))
(else (cons (car l) (unique (cdr l)))))) (else (cons (car l) (unique (cdr l))))))
;; for want of srfi-1
(define (append-map f l)
(apply append (map f l)))
(define (find-submodules head) (define (find-submodules head)
(let ((shead (map symbol->string head))) (let ((shead (map symbol->string head)))
(unique (unique