[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-300-ga24cd
|
From: |
Ludovic Courtès |
|
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-300-ga24cda1 |
|
Date: |
Fri, 05 Apr 2013 20:56:12 +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=a24cda1d26e09ddddb2cfe6633d7fee7a1b66d35
The branch, stable-2.0 has been updated
via a24cda1d26e09ddddb2cfe6633d7fee7a1b66d35 (commit)
via d09b201d59f55f692323f82866512cba2cb29c76 (commit)
via ab1ca17986ee758b7ec4088bf3f6a596872b1677 (commit)
via b5159a471a1acbe1ad08ee5365d123912fcc607d (commit)
via 55e26a49dbc5fa7ccbf218305d88b0b37db4db3f (commit)
via d888b531681c8528a2daafe0bea70c0a42313da6 (commit)
from 96965a6ecb04b5380fd6d618e70d64dec3ac37be (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 a24cda1d26e09ddddb2cfe6633d7fee7a1b66d35
Author: Ludovic Courtès <address@hidden>
Date: Fri Apr 5 22:54:02 2013 +0200
Update `NEWS'.
commit d09b201d59f55f692323f82866512cba2cb29c76
Author: Daniel Llorens <address@hidden>
Date: Wed Apr 3 22:52:21 2013 +0200
Deprecate scm_array_fill_int()
* libguile/array-map.h, libgule/array-map.c: move scm_array_fill_int
to the deprecated section.
Signed-off-by: Ludovic Courtès <address@hidden>
commit ab1ca17986ee758b7ec4088bf3f6a596872b1677
Author: Daniel Llorens <address@hidden>
Date: Wed Apr 3 22:40:40 2013 +0200
Remove double indirection in array-fill!
* libguile/array-map.c: new function rafill, like scm_array_fill_int,
but factors GVSET out of the loop. Use it in scm_array_fill_x instead of
scm_array_fill_int.
* test-suite/tests/arrays.test: add test for array-fill! with stride != 1.
Signed-off-by: Ludovic Courtès <address@hidden>
commit b5159a471a1acbe1ad08ee5365d123912fcc607d
Author: Daniel Llorens <address@hidden>
Date: Wed Apr 3 22:31:47 2013 +0200
Tests for array-copy!
* test-suite/tests/arrays.test: tests for arguments of rank 0, 1 and 2.
Signed-off-by: Ludovic Courtès <address@hidden>
commit 55e26a49dbc5fa7ccbf218305d88b0b37db4db3f
Author: Ludovic Courtès <address@hidden>
Date: Thu Apr 4 14:14:25 2013 +0800
Add `call/ec' and `let/ec'.
Based on a patch by Nala Ginrut <address@hidden>,
with suggestions from Mark H. Weaver.
* module/ice-9/control.scm (call-with-escape-continuation, call/ec): New
procedures.
(let-escape-continuation, let/ec): New macros.
* module/ice-9/futures.scm (let/ec): Remove.
* test-suite/tests/control.test ("escape-only continuations")["call/ec",
"let/ec"]: New tests.
* doc/ref/api-control.texi (Prompt Primitives): Document `call/ec',
`let/ec', and their long names.
commit d888b531681c8528a2daafe0bea70c0a42313da6
Author: Ludovic Courtès <address@hidden>
Date: Fri Apr 5 22:28:25 2013 +0200
tests: Add `pass-if-equal' support in `c&e'.
* test-suite/test-suite/lib.scm (c&e): Add case for `pass-if-equal'.
-----------------------------------------------------------------------
Summary of changes:
NEWS | 18 +++++++++++-
doc/guile-api.alist | 1 -
doc/ref/api-control.texi | 49 ++++++++++++++++++++++++++++++++-
libguile/array-map.c | 60 ++++++++++++++++++++++++++---------------
libguile/array-map.h | 2 +-
module/ice-9/control.scm | 32 ++++++++++++++++++++-
module/ice-9/futures.scm | 11 +-------
test-suite/test-suite/lib.scm | 9 +++++-
test-suite/tests/arrays.test | 50 +++++++++++++++++++++++++++++++++-
test-suite/tests/control.test | 30 +++++++++++++++++++-
10 files changed, 218 insertions(+), 44 deletions(-)
diff --git a/NEWS b/NEWS
index 92dc19f..c17e3cb 100644
--- a/NEWS
+++ b/NEWS
@@ -69,8 +69,10 @@ complete reduction of forms such as:
A number (ahem) of numeric operations on have been made faster, among
them GCD and logarithms.
-Finally, `array-ref' and `array-set!' on arrays of rank 1 or 2 is now
-faster, because it avoids building a rest list.
+Finally, `array-ref', `array-set!' on arrays of rank 1 or 2 is now
+faster, because it avoids building a rest list. Similarly, the
+one-argument case of `array-for-each' and `array-map!' has been
+optimized, and `array-copy!' and `array-fill!' are faster.
** `include' resolves relative file names relative to including file.
@@ -158,6 +160,14 @@ This module, present in Guile since 1996 but never used or
documented,
has never worked in Guile 2.0. It has now been deprecated and will be
removed in Guile 2.2.
+** Deprecate undocumented array-related C functions.
+
+These are `scm_array_fill_int', `scm_ra_eqp', `scm_ra_lessp',
+`scm_ra_leqp', `scm_ra_grp', `scm_ra_greqp', `scm_ra_sum',
+`scm_ra_product', `scm_ra_difference', `scm_ra_divide', and
+`scm_array_identity'.
+
+
* New interfaces
** `round-ash', a bit-shifting operator that rounds on right-shift.
@@ -178,6 +188,10 @@ See XXX for documentation on `system-file-name-convention',
`file-name-separator?', `absolute-file-name?', and
`file-name-separator-string'.
+** Escape continuations with `call/ec' and `let/ec'
+
+See "Prompt Primitives".
+
** `array-length', an array's first dimension.
See "Array Procedures".
diff --git a/doc/guile-api.alist b/doc/guile-api.alist
index 5830c91..78d3a5c 100644
--- a/doc/guile-api.alist
+++ b/doc/guile-api.alist
@@ -1359,7 +1359,6 @@
(scm_array_copy_x (groups scm C) (scan-data T))
(scm_array_dimensions (groups scm C) (scan-data T))
(scm_array_equal_p (groups scm C) (scan-data T))
-(scm_array_fill_int (groups scm C) (scan-data T))
(scm_array_fill_x (groups scm C) (scan-data T))
(scm_array_for_each (groups scm C) (scan-data T))
(scm_array_identity (groups scm C) (scan-data T))
diff --git a/doc/ref/api-control.texi b/doc/ref/api-control.texi
index 320812d..278a03d 100644
--- a/doc/ref/api-control.texi
+++ b/doc/ref/api-control.texi
@@ -574,9 +574,56 @@ both.
Before moving on, we should mention that if the handler of a prompt is a
@code{lambda} expression, and the first argument isn't referenced, an abort to
-that prompt will not cause a continuation to be reified. This can be an
+that prompt will not cause a continuation to be reified. This can be an
important efficiency consideration to keep in mind.
address@hidden continuation, escape
+One example where this optimization matters is @dfn{escape
+continuations}. Escape continuations are delimited continuations whose
+only use is to make a non-local exit---i.e., to escape from the current
+continuation. Such continuations are invoked only once, and for this
+reason they are sometimes called @dfn{one-shot continuations}.
+
+The constructs below are syntactic sugar atop prompts to simplify the
+use of escape continuations.
+
address@hidden {Scheme Procedure} call-with-escape-continuation proc
address@hidden {Scheme Procedure} call/ec proc
+Call @var{proc} with an escape continuation.
+
+In the example below, the @var{return} continuation is used to escape
+the continuation of the call to @code{fold}.
+
address@hidden
+(use-modules (ice-9 control)
+ (srfi srfi-1))
+
+(define (prefix x lst)
+ ;; Return all the elements before the first occurrence
+ ;; of X in LST.
+ (call/ec
+ (lambda (return)
+ (fold (lambda (element prefix)
+ (if (equal? element x)
+ (return (reverse prefix)) ; escape `fold'
+ (cons element prefix)))
+ '()
+ lst))))
+
+(prefix 'a '(0 1 2 a 3 4 5))
address@hidden (0 1 2)
address@hidden lisp
address@hidden deffn
+
address@hidden {Scheme Syntax} let-escape-continuation k body @dots{}
address@hidden {Scheme Syntax} let/ec k body @dots{}
+Bind @var{k} within @var{body} to an escape continuation.
+
+This is equivalent to
address@hidden(call/ec (lambda (@var{k}) @var{body} @dots{}))}.
address@hidden deffn
+
+
@node Shift and Reset
@subsubsection Shift, Reset, and All That
diff --git a/libguile/array-map.c b/libguile/array-map.c
index b5b8cec..2779458 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -318,6 +318,23 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra,
const char *what)
}
}
+static int
+rafill (SCM dst, SCM fill)
+{
+ long n = (SCM_I_ARRAY_DIMS (dst)->ubnd - SCM_I_ARRAY_DIMS (dst)->lbnd + 1);
+ scm_t_array_handle h;
+ size_t i;
+ ssize_t inc;
+ scm_generalized_vector_get_handle (SCM_I_ARRAY_V (dst), &h);
+ i = h.base + h.dims[0].lbnd + SCM_I_ARRAY_BASE (dst)*h.dims[0].inc;
+ inc = SCM_I_ARRAY_DIMS (dst)->inc * h.dims[0].inc;
+
+ for (; n-- > 0; i += inc)
+ h.impl->vset (&h, i, fill);
+
+ scm_array_handle_release (&h);
+ return 1;
+}
SCM_DEFINE (scm_array_fill_x, "array-fill!", 2, 0, 0,
(SCM ra, SCM fill),
@@ -325,31 +342,11 @@ SCM_DEFINE (scm_array_fill_x, "array-fill!", 2, 0, 0,
"returned is unspecified.")
#define FUNC_NAME s_scm_array_fill_x
{
- scm_ramapc (scm_array_fill_int, fill, ra, SCM_EOL, FUNC_NAME);
+ scm_ramapc (rafill, fill, ra, SCM_EOL, FUNC_NAME);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
-/* to be used as cproc in scm_ramapc to fill an array dimension with
- "fill". */
-int
-scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED)
-#define FUNC_NAME s_scm_array_fill_x
-{
- unsigned long i;
- unsigned long n = SCM_I_ARRAY_DIMS (ra)->ubnd - SCM_I_ARRAY_DIMS (ra)->lbnd
+ 1;
- long inc = SCM_I_ARRAY_DIMS (ra)->inc;
- unsigned long base = SCM_I_ARRAY_BASE (ra);
-
- ra = SCM_I_ARRAY_V (ra);
-
- for (i = base; n--; i += inc)
- GVSET (ra, i, fill);
-
- return 1;
-}
-#undef FUNC_NAME
-
static int
racp (SCM src, SCM dst)
@@ -394,10 +391,29 @@ SCM_DEFINE (scm_array_copy_x, "array-copy!", 2, 0, 0,
}
#undef FUNC_NAME
-/* Functions callable by ARRAY-MAP! */
#if SCM_ENABLE_DEPRECATED == 1
+/* to be used as cproc in scm_ramapc to fill an array dimension with
+ "fill". */
+int
+scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED)
+{
+ unsigned long i;
+ unsigned long n = SCM_I_ARRAY_DIMS (ra)->ubnd - SCM_I_ARRAY_DIMS (ra)->lbnd
+ 1;
+ long inc = SCM_I_ARRAY_DIMS (ra)->inc;
+ unsigned long base = SCM_I_ARRAY_BASE (ra);
+
+ ra = SCM_I_ARRAY_V (ra);
+
+ for (i = base; n--; i += inc)
+ GVSET (ra, i, fill);
+
+ return 1;
+}
+
+/* Functions callable by ARRAY-MAP! */
+
int
scm_ra_eqp (SCM ra0, SCM ras)
{
diff --git a/libguile/array-map.h b/libguile/array-map.h
index eb1aa37..b0592d8 100644
--- a/libguile/array-map.h
+++ b/libguile/array-map.h
@@ -31,7 +31,6 @@
SCM_API int scm_ra_matchp (SCM ra0, SCM ras);
SCM_API int scm_ramapc (void *cproc, SCM data, SCM ra0, SCM lra,
const char *what);
-SCM_API int scm_array_fill_int (SCM ra, SCM fill, SCM ignore);
SCM_API SCM scm_array_fill_x (SCM ra, SCM fill);
SCM_API SCM scm_array_copy_x (SCM src, SCM dst);
SCM_API SCM scm_array_map_x (SCM ra0, SCM proc, SCM lra);
@@ -42,6 +41,7 @@ SCM_INTERNAL void scm_init_array_map (void);
#if SCM_ENABLE_DEPRECATED == 1
+SCM_DEPRECATED int scm_array_fill_int (SCM ra, SCM fill, SCM ignore);
SCM_DEPRECATED int scm_ra_eqp (SCM ra0, SCM ras);
SCM_DEPRECATED int scm_ra_lessp (SCM ra0, SCM ras);
SCM_DEPRECATED int scm_ra_leqp (SCM ra0, SCM ras);
diff --git a/module/ice-9/control.scm b/module/ice-9/control.scm
index 5f25738..3eb71a4 100644
--- a/module/ice-9/control.scm
+++ b/module/ice-9/control.scm
@@ -1,6 +1,6 @@
;;; Beyond call/cc
-;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2011, 2013 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
@@ -21,7 +21,9 @@
(define-module (ice-9 control)
#:re-export (call-with-prompt abort-to-prompt
default-prompt-tag make-prompt-tag)
- #:export (% abort shift reset shift* reset*))
+ #:export (% abort shift reset shift* reset*
+ call-with-escape-continuation call/ec
+ let-escape-continuation let/ec))
(define (abort . args)
(apply abort-to-prompt (default-prompt-tag) args))
@@ -76,3 +78,29 @@
(define (shift* fc)
(shift c (fc c)))
+
+(define (call-with-escape-continuation proc)
+ "Call PROC with an escape continuation."
+ (let ((tag (list 'call/ec)))
+ (call-with-prompt tag
+ (lambda ()
+ (proc (lambda args
+ (apply abort-to-prompt tag args))))
+ (lambda (_ . args)
+ (apply values args)))))
+
+(define call/ec call-with-escape-continuation)
+
+(define-syntax-rule (let-escape-continuation k body ...)
+ "Bind K to an escape continuation within the lexical extent of BODY."
+ (let ((tag (list 'let/ec)))
+ (call-with-prompt tag
+ (lambda ()
+ (let ((k (lambda args
+ (apply abort-to-prompt tag args))))
+ body ...))
+ (lambda (_ . results)
+ (apply values results)))))
+
+(define-syntax-rule (let/ec k body ...)
+ (let-escape-continuation k body ...))
diff --git a/module/ice-9/futures.scm b/module/ice-9/futures.scm
index 35a36ca..90bbe53 100644
--- a/module/ice-9/futures.scm
+++ b/module/ice-9/futures.scm
@@ -23,6 +23,7 @@
#:use-module (srfi srfi-11)
#:use-module (ice-9 q)
#:use-module (ice-9 match)
+ #:use-module (ice-9 control)
#:export (future make-future future? touch))
;;; Author: Ludovic Courtès <address@hidden>
@@ -105,16 +106,6 @@ touched."
(lambda () (begin e0 e1 ...))
(lambda () (unlock-mutex x)))))
-(define-syntax-rule (let/ec k e e* ...) ; TODO: move to core
- (let ((tag (make-prompt-tag)))
- (call-with-prompt
- tag
- (lambda ()
- (let ((k (lambda args (apply abort-to-prompt tag args))))
- e e* ...))
- (lambda (_ res) res))))
-
-
(define %future-prompt
;; The prompt futures abort to when they want to wait for another
;; future.
diff --git a/test-suite/test-suite/lib.scm b/test-suite/test-suite/lib.scm
index 7517b4e..e25df78 100644
--- a/test-suite/test-suite/lib.scm
+++ b/test-suite/test-suite/lib.scm
@@ -1,6 +1,6 @@
;;;; test-suite/lib.scm --- generic support for testing
;;;; Copyright (C) 1999, 2000, 2001, 2004, 2006, 2007, 2009, 2010,
-;;;; 2011, 2012 Free Software Foundation, Inc.
+;;;; 2011, 2012, 2013 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
@@ -469,13 +469,18 @@
(with-test-prefix* prefix (lambda () body ...)))))
(define-syntax c&e
- (syntax-rules (pass-if pass-if-exception)
+ (syntax-rules (pass-if pass-if-equal pass-if-exception)
"Run the given tests both with the evaluator and the compiler/VM."
((_ (pass-if test-name exp))
(begin (pass-if (string-append test-name " (eval)")
(primitive-eval 'exp))
(pass-if (string-append test-name " (compile)")
(compile 'exp #:to 'value #:env (current-module)))))
+ ((_ (pass-if-equal test-name val exp))
+ (begin (pass-if-equal (string-append test-name " (eval)") val
+ (primitive-eval 'exp))
+ (pass-if-equal (string-append test-name " (compile)") val
+ (compile 'exp #:to 'value #:env (current-module)))))
((_ (pass-if-exception test-name exc exp))
(begin (pass-if-exception (string-append test-name " (eval)")
exc (primitive-eval 'exp))
diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index d88a1cb..0b3d57c 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -291,7 +291,55 @@
(pass-if "0" (array-fill! a 0) #t)
(pass-if "123" (array-fill! a 123) #t)
(pass-if "-123" (array-fill! a -123) #t)
- (pass-if "5/8" (array-fill! a 5/8) #t))))
+ (pass-if "5/8" (array-fill! a 5/8) #t)))
+
+ (with-test-prefix "noncompact"
+ (let* ((a (make-array 0 3 3))
+ (b (make-shared-array a (lambda (i) (list i i)) 3)))
+ (array-fill! b 9)
+ (pass-if
+ (and (equal? b #(9 9 9))
+ (equal? a #2((9 0 0) (0 9 0) (0 0 9))))))))
+
+;;;
+;;; array-copy!
+;;;
+
+(with-test-prefix "array-copy!"
+
+ (pass-if "rank 2"
+ (let ((a #2((1 2) (3 4)))
+ (b (make-array 0 2 2))
+ (c (make-array 0 2 2))
+ (d (make-array 0 2 2))
+ (e (make-array 0 2 2)))
+ (array-copy! a b)
+ (array-copy! a (transpose-array c 1 0))
+ (array-copy! (transpose-array a 1 0) d)
+ (array-copy! (transpose-array a 1 0) (transpose-array e 1 0))
+ (and (equal? a #2((1 2) (3 4)))
+ (equal? b #2((1 2) (3 4)))
+ (equal? c #2((1 3) (2 4)))
+ (equal? d #2((1 3) (2 4)))
+ (equal? e #2((1 2) (3 4))))))
+
+ (pass-if "rank 1"
+ (let* ((a #2((1 2) (3 4)))
+ (b (make-shared-array a (lambda (j) (list 1 j)) 2))
+ (c (make-shared-array a (lambda (i) (list (- 1 i) 1)) 2))
+ (d (make-array 0 2))
+ (e (make-array 0 2)))
+ (array-copy! b d)
+ (array-copy! c e)
+ (and (equal? d #(3 4))
+ (equal? e #(4 2)))))
+
+ (pass-if "rank 0"
+ (let ((a #0(99))
+ (b (make-array 0)))
+ (array-copy! a b)
+ (equal? b #0(99)))))
+
;;;
;;; array-in-bounds?
diff --git a/test-suite/tests/control.test b/test-suite/tests/control.test
index 1c30b9c..5b292c4 100644
--- a/test-suite/tests/control.test
+++ b/test-suite/tests/control.test
@@ -1,7 +1,7 @@
;;;; -*- scheme -*-
;;;; control.test --- test suite for delimited continuations
;;;;
-;;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;;;; Copyright (C) 2010, 2011, 2013 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
@@ -20,6 +20,7 @@
(define-module (test-suite test-control)
#:use-module (ice-9 control)
#:use-module (system vm vm)
+ #:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (test-suite lib))
@@ -77,7 +78,32 @@
(abort 'foo 'bar 'baz)
(error "unexpected exit"))
(lambda (k . args)
- args)))))
+ args))))
+
+ (pass-if-equal "call/ec" '(0 1 2) ; example from the manual
+ (let ((prefix
+ (lambda (x lst)
+ (call/ec
+ (lambda (return)
+ (fold (lambda (element prefix)
+ (if (equal? element x)
+ (return (reverse prefix))
+ (cons element prefix)))
+ '()
+ lst))))))
+ (prefix 'a '(0 1 2 a 3 4 5))))
+
+ (pass-if-equal "let/ec" '(0 1 2)
+ (let ((prefix
+ (lambda (x lst)
+ (let/ec return
+ (fold (lambda (element prefix)
+ (if (equal? element x)
+ (return (reverse prefix))
+ (cons element prefix)))
+ '()
+ lst)))))
+ (prefix 'a '(0 1 2 a 3 4 5)))))
;;; And the case in which the compiler has to reify the continuation.
(with-test-prefix/c&e "reified continuations"
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-300-ga24cda1,
Ludovic Courtès <=