[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-10-184-g2
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. release_1-9-10-184-g25f4cd8 |
|
Date: |
Fri, 21 May 2010 21:45:29 +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=25f4cd87c2e10ddd7faaa69a7a54ac3600492780
The branch, master has been updated
via 25f4cd87c2e10ddd7faaa69a7a54ac3600492780 (commit)
via 7df2621d72a6efbe43042596d1e410bd1f97e3ca (commit)
via 17ee350cb2974b7eb71283dd4d9802363ec10dc5 (commit)
via d9113d47c6be44b40c870bdb98e29c48657d4cc9 (commit)
via 36d58fc31e3af93c81e1e41235c2b094fa38c3f8 (commit)
via 6b7d701e730124eef9f5a74db38d0486526bb952 (commit)
via 5a6621244f1a1e93ab5c024f9da05565950ffafe (commit)
via 723ae5b370b5084b658e1e3b0d2fac8aec81121c (commit)
via d6e70467bafdf5417000a14e168493aca8d0b80d (commit)
via 02851b26c7862d3549a494eb895e31e48053e321 (commit)
via 52c9a3381dae7416debfc03fead39101820f9fad (commit)
via d44a0d12b4afd7ffa589a26d79b2062b65c5dc5d (commit)
via b2669c41a771ca7ceed2d02737d124a476ab281b (commit)
via a4c8a02e09399d2a9dc971ff984db7102fc77214 (commit)
via f31b7b6a1c9ee374aab3c3abc29911e369edf4aa (commit)
via d648f569891bc0d790afc3f27632e2a2b71e5bb7 (commit)
from b766109224c8b6ddb42acca419ce6b0b234a386d (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 25f4cd87c2e10ddd7faaa69a7a54ac3600492780
Author: Andy Wingo <address@hidden>
Date: Fri May 21 23:44:15 2010 +0200
boot-9 comment cleanup
* module/ice-9/boot-9.scm: Remove needless comment.
commit 7df2621d72a6efbe43042596d1e410bd1f97e3ca
Author: Andy Wingo <address@hidden>
Date: Fri May 21 23:43:58 2010 +0200
lambda* in make-mutable-parameter
* module/ice-9/boot-9.scm (make-mutable-parameter): Use lambda*.
commit 17ee350cb2974b7eb71283dd4d9802363ec10dc5
Author: Andy Wingo <address@hidden>
Date: Fri May 21 23:43:35 2010 +0200
define* in repl-reader
* module/ice-9/boot-9.scm (repl-reader): Use define*.
commit d9113d47c6be44b40c870bdb98e29c48657d4cc9
Author: Andy Wingo <address@hidden>
Date: Fri May 21 23:43:16 2010 +0200
define* in try-module-autoload
* module/ice-9/boot-9.scm (try-module-autoload): Use define*.
commit 36d58fc31e3af93c81e1e41235c2b094fa38c3f8
Author: Andy Wingo <address@hidden>
Date: Fri May 21 23:42:54 2010 +0200
define* in resolve-interface
* module/ice-9/boot-9.scm (resolve-interface): Use define* with proper
keyword arguments, for great justice.
commit 6b7d701e730124eef9f5a74db38d0486526bb952
Author: Andy Wingo <address@hidden>
Date: Fri May 21 23:42:17 2010 +0200
lambda* in resolve-module
* module/ice-9/boot-9.scm (resolve-module): Use lambda*.
commit 5a6621244f1a1e93ab5c024f9da05565950ffafe
Author: Andy Wingo <address@hidden>
Date: Fri May 21 23:41:49 2010 +0200
define* in load-module
* module/ice-9/boot-9.scm (load-module): Use define*.
commit 723ae5b370b5084b658e1e3b0d2fac8aec81121c
Author: Andy Wingo <address@hidden>
Date: Fri May 21 23:37:54 2010 +0200
define* in module-observe-weak
* module/ice-9/boot-9.scm (module-observe-weak): Use define*.
commit d6e70467bafdf5417000a14e168493aca8d0b80d
Author: Andy Wingo <address@hidden>
Date: Fri May 21 23:37:21 2010 +0200
define* in load
* module/ice-9/boot-9.scm (load): Use define*.
commit 02851b26c7862d3549a494eb895e31e48053e321
Author: Andy Wingo <address@hidden>
Date: Fri May 21 23:36:47 2010 +0200
case-lambda in dup->{in,out,}port, dup
* module/ice-9/boot-9.scm (dup->port, dup->inport, dup->outport, dup):
Use case-lambda. Not particularly elegant.
commit 52c9a3381dae7416debfc03fead39101820f9fad
Author: Andy Wingo <address@hidden>
Date: Fri May 21 23:36:00 2010 +0200
define* in file-set-position
* module/ice-9/boot-9.scm (file-set-position): Use define*.
commit d44a0d12b4afd7ffa589a26d79b2062b65c5dc5d
Author: Andy Wingo <address@hidden>
Date: Fri May 21 23:35:24 2010 +0200
define* in record-constructor
* module/ice-9/boot-9.scm (record-constructor): Use define*.
commit b2669c41a771ca7ceed2d02737d124a476ab281b
Author: Andy Wingo <address@hidden>
Date: Fri May 21 23:34:54 2010 +0200
define* in make-record-type
* module/ice-9/boot-9.scm (make-record-type): Use define*.
commit a4c8a02e09399d2a9dc971ff984db7102fc77214
Author: Andy Wingo <address@hidden>
Date: Fri May 21 23:34:06 2010 +0200
lambda* in string-any, string-every
* module/ice-9/boot-9.scm (string-any, string-every): Use lambda*.
commit f31b7b6a1c9ee374aab3c3abc29911e369edf4aa
Author: Andy Wingo <address@hidden>
Date: Fri May 21 23:33:28 2010 +0200
lambda* in catch
* module/ice-9/boot-9.scm (catch): Use lambda*.
commit d648f569891bc0d790afc3f27632e2a2b71e5bb7
Author: Andy Wingo <address@hidden>
Date: Fri May 21 23:32:43 2010 +0200
lambda* in make-prompt-tag
* module/ice-9/boot-9.scm (make-prompt-tag): Use lambda*.
-----------------------------------------------------------------------
Summary of changes:
module/ice-9/boot-9.scm | 195 +++++++++++++++++++++--------------------------
1 files changed, 86 insertions(+), 109 deletions(-)
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 4bdd86b..5e6c441 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -48,8 +48,10 @@
;; Define delimited continuation operators, and implement catch and throw in
;; terms of them.
-(define (make-prompt-tag . stem)
- (gensym (if (pair? stem) (car stem) "prompt")))
+(define make-prompt-tag
+ (lambda* (#:optional (stem "prompt"))
+ (gensym stem)))
+
(define default-prompt-tag
;; not sure if we should expose this to the user as a fluid
(let ((%default-prompt-tag (make-prompt-tag)))
@@ -117,9 +119,7 @@
(apply prev thrown-k args)))))
(define! 'catch
- ;; Until we get optargs support into Guile's C evaluator, we have to fake
it
- ;; here.
- (lambda (k thunk handler . pre-unwind-handler)
+ (lambda* (k thunk handler #:optional pre-unwind-handler)
"Invoke @var{thunk} in the dynamic context of @var{handler} for
exceptions matching @var{key}. If thunk throws to the symbol
@var{key}, then @var{handler} is invoked this way:
@@ -163,10 +163,9 @@ non-locally, that exit determines the continuation."
(lambda ()
(with-fluids
((%exception-handler
- (if (null? pre-unwind-handler)
- (default-throw-handler tag k)
- (custom-throw-handler tag k
- (car pre-unwind-handler)))))
+ (if pre-unwind-handler
+ (custom-throw-handler tag k pre-unwind-handler)
+ (default-throw-handler tag k))))
(thunk)))
(lambda (cont k . args)
(apply handler k args))))))
@@ -295,11 +294,8 @@ If there is no handler at all, Guile prints an error and
then exits."
;; this is scheme wrapping the C code so the final pred call is a tail call,
;; per SRFI-13 spec
-(define (string-any char_pred s . rest)
- (let ((start (if (null? rest)
- 0 (car rest)))
- (end (if (or (null? rest) (null? (cdr rest)))
- (string-length s) (cadr rest))))
+(define string-any
+ (lambda* (char_pred s #:optional (start 0) (end (string-length s)))
(if (and (procedure? char_pred)
(> end start)
(<= end (string-length s))) ;; let c-code handle range error
@@ -309,11 +305,8 @@ If there is no handler at all, Guile prints an error and
then exits."
;; this is scheme wrapping the C code so the final pred call is a tail call,
;; per SRFI-13 spec
-(define (string-every char_pred s . rest)
- (let ((start (if (null? rest)
- 0 (car rest)))
- (end (if (or (null? rest) (null? (cdr rest)))
- (string-length s) (cadr rest))))
+(define string-every
+ (lambda* (char_pred s #:optional (start 0) (end (string-length s)))
(if (and (procedure? char_pred)
(> end start)
(<= end (string-length s))) ;; let c-code handle range error
@@ -647,7 +640,7 @@ If there is no handler at all, Guile prints an error and
then exits."
(define (record-type? obj)
(and (struct? obj) (eq? record-type-vtable (struct-vtable obj))))
-(define (make-record-type type-name fields . opt)
+(define* (make-record-type type-name fields #:optional printer)
;; Pre-generate constructors for nfields < 20.
(define-syntax make-constructor
(lambda (x)
@@ -702,8 +695,7 @@ If there is no handler at all, Guile prints an error and
then exits."
(make-struct-layout
(apply string-append
(map (lambda (f) "pw") fields)))
- (or (and (pair? opt) (car opt))
- default-record-printer)
+ (or printer default-record-printer)
type-name
(copy-tree fields))))
(struct-set! rtd (+ vtable-offset-user 2)
@@ -725,17 +717,16 @@ If there is no handler at all, Guile prints an error and
then exits."
(struct-ref obj (+ 1 vtable-offset-user))
(error 'not-a-record-type obj)))
-(define (record-constructor rtd . opt)
- (if (null? opt)
+(define* (record-constructor rtd #:optional field-names)
+ (if (not field-names)
(struct-ref rtd (+ 2 vtable-offset-user))
- (let ((field-names (car opt)))
- (primitive-eval
- `(lambda ,field-names
- (make-struct ',rtd 0 ,@(map (lambda (f)
- (if (memq f field-names)
- f
- #f))
- (record-type-fields rtd))))))))
+ (primitive-eval
+ `(lambda ,field-names
+ (make-struct ',rtd 0 ,@(map (lambda (f)
+ (if (memq f field-names)
+ f
+ #f))
+ (record-type-fields rtd)))))))
(define (record-predicate rtd)
(lambda (obj) (and (struct? obj) (eq? rtd (struct-vtable obj)))))
@@ -908,9 +899,8 @@ If there is no handler at all, Guile prints an error and
then exits."
(define (tms:cstime obj) (vector-ref obj 4))
(define file-position ftell)
-(define (file-set-position port offset . whence)
- (let ((whence (if (eq? whence '()) SEEK_SET (car whence))))
- (seek port offset whence)))
+(define* (file-set-position port offset #:optional (whence SEEK_SET))
+ (seek port offset whence))
(define (move->fdes fd/port fd)
(cond ((integer? fd/port)
@@ -927,23 +917,39 @@ If there is no handler at all, Guile prints an error and
then exits."
(if (> revealed 0)
(set-port-revealed! port (- revealed 1)))))
-(define (dup->port port/fd mode . maybe-fd)
- (let ((port (fdopen (apply dup->fdes port/fd maybe-fd)
- mode)))
- (if (pair? maybe-fd)
- (set-port-revealed! port 1))
- port))
-
-(define (dup->inport port/fd . maybe-fd)
- (apply dup->port port/fd "r" maybe-fd))
-
-(define (dup->outport port/fd . maybe-fd)
- (apply dup->port port/fd "w" maybe-fd))
-
-(define (dup port/fd . maybe-fd)
- (if (integer? port/fd)
- (apply dup->fdes port/fd maybe-fd)
- (apply dup->port port/fd (port-mode port/fd) maybe-fd)))
+(define dup->port
+ (case-lambda
+ ((port/fd mode)
+ (fdopen (dup->fdes port/fd) mode))
+ ((port/fd mode new-fd)
+ (let ((port (fdopen (dup->fdes port/fd new-fd) mode)))
+ (set-port-revealed! port 1)
+ port))))
+
+(define dup->inport
+ (case-lambda
+ ((port/fd)
+ (dup->port port/fd "r"))
+ ((port/fd new-fd)
+ (dup->port port/fd "r" new-fd))))
+
+(define dup->outport
+ (case-lambda
+ ((port/fd)
+ (dup->port port/fd "w"))
+ ((port/fd new-fd)
+ (dup->port port/fd "w" new-fd))))
+
+(define dup
+ (case-lambda
+ ((port/fd)
+ (if (integer? port/fd)
+ (dup->fdes port/fd)
+ (dup->port port/fd (port-mode port/fd))))
+ ((port/fd new-fd)
+ (if (integer? port/fd)
+ (dup->fdes port/fd new-fd)
+ (dup->port port/fd (port-mode port/fd) new-fd)))))
(define (duplicate-port port modes)
(dup->port port modes))
@@ -1083,7 +1089,7 @@ If there is no handler at all, Guile prints an error and
then exits."
(set! %load-hook %load-announce)
-(define (load name . reader)
+(define* (load name #:optional reader)
;; Returns the .go file corresponding to `name'. Does not search load
;; paths, only the fallback path. If the .go file is missing or out of
;; date, and autocompilation is enabled, will try autocompilation, just
@@ -1131,7 +1137,7 @@ If there is no handler at all, Guile prints an error and
then exits."
";;; WARNING: compilation of ~a failed:\n;;; key ~a,
throw_args ~s\n"
name k args)
#f)))
- (with-fluids ((current-reader (and (pair? reader) (car reader))))
+ (with-fluids ((current-reader reader))
(let ((cfn (and=> (and=> (false-if-exception (canonicalize-path name))
compiled-file-name)
fresh-compiled-file-name)))
@@ -1627,7 +1633,7 @@ If there is no handler at all, Guile prints an error and
then exits."
(set-module-observers! module (cons proc (module-observers module)))
(cons module proc))
-(define (module-observe-weak module observer-id . proc)
+(define* (module-observe-weak module observer-id #:optional (proc observer-id))
;; Register PROC as an observer of MODULE under name OBSERVER-ID (which can
;; be any Scheme object). PROC is invoked and passed MODULE any time
;; MODULE is modified. PROC gets unregistered when OBSERVER-ID gets GC'd
@@ -1637,9 +1643,7 @@ If there is no handler at all, Guile prints an error and
then exits."
;; The two-argument version is kept for backward compatibility: when called
;; with two arguments, the observer gets unregistered when closure PROC
;; gets GC'd (making it impossible to use an anonymous lambda for PROC).
-
- (let ((proc (if (null? proc) observer-id (car proc))))
- (hashq-set! (module-weak-observers module) observer-id proc)))
+ (hashq-set! (module-weak-observers module) observer-id proc))
(define (module-unobserve token)
(let ((module (car token))
@@ -1983,19 +1987,18 @@ If there is no handler at all, Guile prints an error
and then exits."
(define basic-load load)
-(define (load-module filename . reader)
+(define* (load-module filename #:optional reader)
(save-module-excursion
(lambda ()
(let ((oldname (and (current-load-port)
(port-filename (current-load-port)))))
- (apply basic-load
- (if (and oldname
- (> (string-length filename) 0)
- (not (char=? (string-ref filename 0) #\/))
- (not (string=? (dirname oldname) ".")))
- (string-append (dirname oldname) "/" filename)
- filename)
- reader)))))
+ (basic-load (if (and oldname
+ (> (string-length filename) 0)
+ (not (char=? (string-ref filename 0) #\/))
+ (not (string=? (dirname oldname) ".")))
+ (string-append (dirname oldname) "/" filename)
+ filename)
+ reader)))))
@@ -2401,11 +2404,8 @@ If there is no handler at all, Guile prints an error and
then exits."
;; Define the-root-module as '(guile).
(module-define-submodule! root 'guile the-root-module)
- (lambda (name . args) ;; #:optional (autoload #t) (version #f)
- (let* ((already (nested-ref-module root name))
- (numargs (length args))
- (autoload (or (= numargs 0) (car args)))
- (version (and (> numargs 1) (cadr args))))
+ (lambda* (name #:optional (autoload #t) (version #f))
+ (let ((already (nested-ref-module root name)))
(cond
((and already
(or (not autoload) (module-public-interface already)))
@@ -2469,25 +2469,15 @@ If there is no handler at all, Guile prints an error
and then exits."
;; or its public interface is not available. Signal "no binding"
;; error if selected binding does not exist in the used module.
;;
-(define (resolve-interface name . args)
-
- (define (get-keyword-arg args kw def)
- (cond ((memq kw args)
- => (lambda (kw-arg)
- (if (null? (cdr kw-arg))
- (error "keyword without value: " kw))
- (cadr kw-arg)))
- (else
- def)))
-
- (let* ((select (get-keyword-arg args #:select #f))
- (hide (get-keyword-arg args #:hide '()))
- (renamer (or (get-keyword-arg args #:renamer #f)
- (let ((prefix (get-keyword-arg args #:prefix #f)))
- (and prefix (symbol-prefix-proc prefix)))
- identity))
- (version (get-keyword-arg args #:version #f))
- (module (resolve-module name #t version))
+(define* (resolve-interface name #:key
+ (select #f)
+ (hide '())
+ (prefix #f)
+ (renamer (if prefix
+ (symbol-prefix-proc prefix)
+ identity))
+ version)
+ (let* ((module (resolve-module name #t version))
(public-i (and module (module-public-interface module))))
(and (or (not module) (not public-i))
(error "no code for module" name))
@@ -2710,10 +2700,9 @@ module '(ice-9 q) '(make-q q-length))}."
;; This function is called from "modules.c". If you change it, be
;; sure to update "modules.c" as well.
-(define (try-module-autoload module-name . args)
+(define* (try-module-autoload module-name #:optional version)
(let* ((reverse-name (reverse module-name))
(name (symbol->string (car reverse-name)))
- (version (and (not (null? args)) (car args)))
(dir-hint-module-name (reverse (cdr reverse-name)))
(dir-hint (apply string-append
(map (lambda (elt)
@@ -3068,15 +3057,12 @@ module '(ice-9 q) '(make-q q-length))}."
;;; The default repl-reader function. We may override this if we've
;;; the readline library.
(define repl-reader
- (lambda (prompt . reader)
+ (lambda* (prompt #:optional (reader (fluid-ref current-reader)))
(if (not (char-ready?))
(display (if (string? prompt) prompt (prompt))))
(force-output)
(run-hook before-read-hook)
- ((or (and (pair? reader) (car reader))
- (fluid-ref current-reader)
- read)
- (current-input-port))))
+ ((or reader read) (current-input-port))))
(define (scm-style-repl)
@@ -3519,11 +3505,8 @@ module '(ice-9 q) '(make-q q-length))}."
(if (null? args)
(fluid-ref fluid)
(fluid-set! fluid (converter (car args))))))))
- (lambda (init . converter)
- (let ((fluid (make-fluid))
- (converter (if (null? converter)
- identity
- (car converter))))
+ (lambda* (init #:optional (converter identity))
+ (let ((fluid (make-fluid)))
(fluid-set! fluid (converter init))
(make fluid converter)))))
@@ -3922,12 +3905,6 @@ module '(ice-9 q) '(make-q q-length))}."
;;; Place the user in the guile-user module.
;;;
-;;; FIXME: annotate ?
-;; (define (syncase exp)
-;; (with-fluids ((expansion-eval-closure
-;; (module-eval-closure (current-module))))
-;; (deannotate/source-properties (macroexpand (annotate exp)))))
-
;; FIXME:
(module-use! the-scm-module (resolve-interface '(srfi srfi-4)))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. release_1-9-10-184-g25f4cd8,
Andy Wingo <=