[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
SRFI-1 in Scheme
|
From: |
Ludovic Courtès |
|
Subject: |
SRFI-1 in Scheme |
|
Date: |
Tue, 13 Jul 2010 00:57:07 +0200 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/23.2 (gnu/linux) |
Hello!
The attached patch is a first stab at re-implementing SRFI-1 in Scheme.
Here’s a quick benchmark of ‘fold’, for large and small lists:
- in C
("srfi-1.bm: fold: fold" 30 user 5.55 benchmark 5.54999599456787
bench/interp 5.54999599456787 gc 0.0)
("srfi-1.bm: fold: fold" 2000000 user 4.41 benchmark 4.14297119140625
bench/interp 4.14297119140625 gc 0.0)
- in Scheme (debug engine)
("srfi-1.bm: fold: fold" 30 user 6.04 benchmark 6.03999599456787
bench/interp 6.03999599456787 gc 0.0)
("srfi-1.bm: fold: fold" 2000000 user 5.14 benchmark 4.87297119140625
bench/interp 4.87297119140625 gc 0.0)
- in Scheme (regular engine)
("srfi-1.bm: fold: fold" 30 user 5.46 benchmark 5.45999656677246
bench/interp 5.45999656677246 gc 0.0)
("srfi-1.bm: fold: fold" 2000000 user 4.64 benchmark 4.4111181640625
bench/interp 4.4111181640625 gc 0.0)
IOW, with the debug engine (currently the default) and for large lists
‘fold’ in Scheme is ~9% slower than in C; for small lists it’s ~17%
slower.
With the regular engine, Scheme is ~2% faster for large lists and still
~5% slower for small lists.
I’m tempted to put this in and then make the regular engine the default
unless ‘--debug’ is specified.
What do you think?
Thanks,
Ludo’.
From 927b96b48d4870c768da093741af6e6bcd438cad Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <address@hidden>
Date: Tue, 13 Jul 2010 00:07:12 +0200
Subject: [PATCH] Start rewriting SRFI-1 in Scheme.
This partially reverts commit e556f8c3c6b74ee6596e8dcbe829109d7745da2c
(Fri May 6 2005).
* module/srfi/srfi-1.scm (xcons, list-tabulate, not-pair?, car+cdr,
last, fold, list-index): New procedures.
* srfi/srfi-1.c (srfi1_module): New variable.
(CACHE_VAR): New macro.
(scm_srfi1_car_plus_cdr, scm_srfi1_fold, scm_srfi1_last,
scm_srfi1_list_index, scm_srfi1_list_tabulate, scm_srfi1_not_pair_p,
scm_srfi1_xcons): Rewrite as proxies of the corresponding Scheme
procedure.
* test-suite/tests/srfi-1.test ("list-tabulate")["-1"]: Change exception
type to `exception:wrong-type-arg'.
* benchmark-suite/benchmarks/srfi-1.bm: New file.
* benchmark-suite/Makefile.am (SCM_BENCHMARKS): Add
`benchmarks/srfi-1.bm'.
---
benchmark-suite/Makefile.am | 1 +
benchmark-suite/benchmarks/srfi-1.bm | 38 ++++
module/srfi/srfi-1.scm | 64 +++++++-
srfi/srfi-1.c | 318 ++++++----------------------------
test-suite/tests/srfi-1.test | 4 +-
5 files changed, 154 insertions(+), 271 deletions(-)
create mode 100644 benchmark-suite/benchmarks/srfi-1.bm
diff --git a/benchmark-suite/Makefile.am b/benchmark-suite/Makefile.am
index d99e457..b58219a 100644
--- a/benchmark-suite/Makefile.am
+++ b/benchmark-suite/Makefile.am
@@ -5,6 +5,7 @@ SCM_BENCHMARKS = benchmarks/0-reference.bm \
benchmarks/if.bm \
benchmarks/logand.bm \
benchmarks/read.bm \
+ benchmarks/srfi-1.bm \
benchmarks/srfi-13.bm \
benchmarks/structs.bm \
benchmarks/subr.bm \
diff --git a/benchmark-suite/benchmarks/srfi-1.bm
b/benchmark-suite/benchmarks/srfi-1.bm
new file mode 100644
index 0000000..2888934
--- /dev/null
+++ b/benchmark-suite/benchmarks/srfi-1.bm
@@ -0,0 +1,38 @@
+;;; -*- mode: scheme; coding: utf-8; -*-
+;;; SRFI-1.
+;;;
+;;; Copyright 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
+;;; as published by the Free Software Foundation; either version 3, or
+;;; (at your option) any later version.
+;;;
+;;; This program 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 software; see the file COPYING.LESSER. If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (benchmarks srfi-1)
+ #:use-module (srfi srfi-1)
+ #:use-module (benchmark-suite lib))
+
+(define %big-list
+ (iota 1000000))
+
+(define %small-list
+ (iota 10))
+
+
+(with-benchmark-prefix "fold"
+
+ (benchmark "fold" 30
+ (fold (lambda (x y) y) #f %big-list))
+
+ (benchmark "fold" 2000000
+ (fold (lambda (x y) y) #f %small-list)))
diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm
index c32eb1c..27aa39e 100644
--- a/module/srfi/srfi-1.scm
+++ b/module/srfi/srfi-1.scm
@@ -1,6 +1,6 @@
;;; srfi-1.scm --- List Library
-;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2009 Free Software
Foundation, Inc.
+;; Copyright (C) 2001, 2002, 2003, 2004, 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
@@ -225,6 +225,11 @@
;;; Constructors
+(define (xcons d a)
+ "Like `cons', but with interchanged arguments. Useful mostly when passed to
+higher-order procedures."
+ (cons a d))
+
;; internal helper, similar to (scsh utilities) check-arg.
(define (check-arg-type pred arg caller)
(if (pred arg)
@@ -235,7 +240,15 @@
;; the srfi spec doesn't seem to forbid inexact integers.
(define (non-negative-integer? x) (and (integer? x) (>= x 0)))
-
+(define (list-tabulate n init-proc)
+ "Return an N-element list, where each list element is produced by applying
the
+procedure INIT-PROC to the corresponding list index. The order in which
+INIT-PROC is applied to the indices is not specified."
+ (check-arg-type non-negative-integer? n "list-tabulate")
+ (let lp ((n n) (acc '()))
+ (if (<= n 0)
+ acc
+ (lp (- n 1) (cons (init-proc (- n 1)) acc)))))
(define (circular-list elt1 . elts)
(set! elts (cons elt1 elts))
@@ -294,6 +307,13 @@
(else
(error "not a proper list in null-list?"))))
+(define (not-pair? x)
+ "Return #t if X is not a pair, #f otherwise.
+
+This is shorthand notation `(not (pair? X))' and is supposed to be used for
+end-of-list checking in contexts where dotted lists are allowed."
+ (not (pair? x)))
+
(define (list= elt= . rest)
(define (lists-equal a b)
(let lp ((a a) (b b))
@@ -317,9 +337,17 @@
(define third caddr)
(define fourth cadddr)
+(define (car+cdr x)
+ "Return two values, the `car' and the `cdr' of PAIR."
+ (values (car x) (cdr x)))
+
(define take list-head)
(define drop list-tail)
+(define (last pair)
+ "Return the last element of the non-empty, finite list PAIR."
+ (car (last-pair pair)))
+
;;; Miscelleneous: length, append, concatenate, reverse, zip & count
(define (zip clist1 . rest)
@@ -343,6 +371,21 @@
;;; Fold, unfold & map
+(define (fold kons knil list1 . rest)
+ "Apply PROC to the elements of LIST1 ... LISTN to build a result, and return
+that result. See the manual for details."
+ (if (null? rest)
+ (let f ((knil knil) (list1 list1))
+ (if (null? list1)
+ knil
+ (f (kons (car list1) knil) (cdr list1))))
+ (let f ((knil knil) (lists (cons list1 rest)))
+ (if (any null? lists)
+ knil
+ (let ((cars (map1 car lists))
+ (cdrs (map1 cdr lists)))
+ (f (apply kons (append! cars (list knil))) cdrs))))))
+
(define (fold-right kons knil clist1 . rest)
(if (null? rest)
(let f ((list1 clist1))
@@ -463,6 +506,23 @@
(else
(and (pred (car ls)) (lp (cdr ls)))))))
+(define (list-index pred clist1 . rest)
+ "Return the index of the first set of elements, one from each of
+CLIST1 ... CLISTN, that satisfies PRED."
+ (if (null? rest)
+ (let lp ((l clist1) (i 0))
+ (if (null? l)
+ #f
+ (if (pred (car l))
+ i
+ (lp (cdr l) (+ i 1)))))
+ (let lp ((lists (cons clist1 rest)) (i 0))
+ (cond ((any1 null? lists)
+ #f)
+ ((apply pred (map1 car lists)) i)
+ (else
+ (lp (map1 cdr lists) (+ i 1)))))))
+
;;; Association lists
(define alist-cons acons)
diff --git a/srfi/srfi-1.c b/srfi/srfi-1.c
index 537c2b3..71cfcf9 100644
--- a/srfi/srfi-1.c
+++ b/srfi/srfi-1.c
@@ -27,13 +27,32 @@
#include "srfi-1.h"
-/* The intent of this file is to gradually replace those Scheme
- * procedures in srfi-1.scm which extends core primitive procedures,
+/* The intent of this file was to gradually replace those Scheme
+ * procedures in srfi-1.scm that extend core primitive procedures,
* so that using srfi-1 won't have performance penalties.
*
- * Please feel free to contribute any new replacements!
+ * However, we now prefer to write these procedures in Scheme, let the compiler
+ * optimize them, and have the VM execute them efficiently.
*/
+
+/* The `(srfi srfi-1)' module. */
+static SCM srfi1_module = SCM_BOOL_F;
+
+/* Cache variable NAME in C variable VAR. */
+#define CACHE_VAR(var, name) \
+ static SCM var = SCM_BOOL_F; \
+ if (scm_is_false (var)) \
+ { \
+ if (SCM_UNLIKELY (scm_is_false (srfi1_module))) \
+ srfi1_module = scm_c_resolve_module ("srfi srfi-1"); \
+ \
+ var = scm_module_variable (srfi1_module, \
+ scm_from_locale_symbol (name)); \
+ if (scm_is_false (var)) \
+ abort (); \
+ }
+
static long
srfi1_ilength (SCM sx)
{
@@ -253,16 +272,12 @@ SCM_DEFINE (scm_srfi1_break_x, "break!", 2, 0, 0,
#undef FUNC_NAME
-SCM_DEFINE (scm_srfi1_car_plus_cdr, "car+cdr", 1, 0, 0,
- (SCM pair),
- "Return two values, the @sc{car} and the @sc{cdr} of @var{pair}.")
-#define FUNC_NAME s_scm_srfi1_car_plus_cdr
+SCM
+scm_srfi1_car_plus_cdr (SCM pair)
{
- SCM_VALIDATE_CONS (SCM_ARG1, pair);
- return scm_values (scm_list_2 (SCM_CAR (pair), SCM_CDR (pair)));
+ CACHE_VAR (car_plus_cdr, "car+cdr");
+ return scm_call_1 (car_plus_cdr, pair);
}
-#undef FUNC_NAME
-
SCM_DEFINE (scm_srfi1_concatenate, "concatenate", 1, 0, 0,
(SCM lstlst),
@@ -935,131 +950,19 @@ SCM_DEFINE (scm_srfi1_find_tail, "find-tail", 2, 0, 0,
}
#undef FUNC_NAME
-
-SCM_DEFINE (scm_srfi1_fold, "fold", 3, 0, 1,
- (SCM proc, SCM init, SCM list1, SCM rest),
- "Apply @var{proc} to the elements of @var{lst1} @dots{}\n"
- "@var{lstN} to build a result, and return that result.\n"
- "\n"
- "Each @var{proc} call is @code{(@var{proc} @var{elem1} @dots{}\n"
- "@var{elemN} @var{previous})}, where @var{elem1} is from\n"
- "@var{lst1}, through @var{elemN} from @var{lstN}.\n"
- "@var{previous} is the return from the previous call to\n"
- "@var{proc}, or the given @var{init} for the first call. If any\n"
- "list is empty, just @var{init} is returned.\n"
- "\n"
- "@code{fold} works through the list elements from first to last.\n"
- "The following shows a list reversal and the calls it makes,\n"
- "\n"
- "@example\n"
- "(fold cons '() '(1 2 3))\n"
- "\n"
- "(cons 1 '())\n"
- "(cons 2 '(1))\n"
- "(cons 3 '(2 1)\n"
- "@result{} (3 2 1)\n"
- "@end example\n"
- "\n"
- "If @var{lst1} through @var{lstN} have different lengths,\n"
- "@code{fold} stops when the end of the shortest is reached.\n"
- "Ie.@: elements past the length of the shortest are ignored in\n"
- "the other @var{lst}s. At least one @var{lst} must be\n"
- "non-circular.\n"
- "\n"
- "The way @code{fold} builds a result from iterating is quite\n"
- "general, it can do more than other iterations like say\n"
- "@code{map} or @code{filter}. The following for example removes\n"
- "adjacent duplicate elements from a list,\n"
- "\n"
- "@example\n"
- "(define (delete-adjacent-duplicates lst)\n"
- " (fold-right (lambda (elem ret)\n"
- " (if (equal? elem (first ret))\n"
- " ret\n"
- " (cons elem ret)))\n"
- " (list (last lst))\n"
- " lst))\n"
- "(delete-adjacent-duplicates '(1 2 3 3 4 4 4 5))\n"
- "@result{} (1 2 3 4 5)\n"
- "@end example\n"
- "\n"
- "Clearly the same sort of thing can be done with a\n"
- "@code{for-each} and a variable in which to build the result,\n"
- "but a self-contained @var{proc} can be re-used in multiple\n"
- "contexts, where a @code{for-each} would have to be written out\n"
- "each time.")
-#define FUNC_NAME s_scm_srfi1_fold
+SCM
+scm_srfi1_fold (SCM proc, SCM init, SCM list1, SCM rest)
{
- SCM lst;
- int argnum;
- SCM_VALIDATE_REST_ARGUMENT (rest);
-
- if (scm_is_null (rest))
- {
- /* one list */
- SCM_VALIDATE_PROC (SCM_ARG1, proc);
-
- for ( ; scm_is_pair (list1); list1 = SCM_CDR (list1))
- init = scm_call_2 (proc, SCM_CAR (list1), init);
-
- /* check below that list1 is a proper list, and done */
- lst = list1;
- argnum = 2;
- }
- else
- {
- /* two or more lists */
- SCM vec, args, a;
- size_t len, i;
-
- /* vec is the list arguments */
- vec = scm_vector (scm_cons (list1, rest));
- len = SCM_SIMPLE_VECTOR_LENGTH (vec);
-
- /* args is the argument list to pass to proc, same length as vec,
- re-used for each call */
- args = scm_make_list (SCM_I_MAKINUM (len+1), SCM_UNDEFINED);
-
- for (;;)
- {
- /* first elem of each list in vec into args, and step those
- vec entries onto their next element */
- for (i = 0, a = args, argnum = 2;
- i < len;
- i++, a = SCM_CDR (a), argnum++)
- {
- lst = SCM_SIMPLE_VECTOR_REF (vec, i); /* list argument */
- if (! scm_is_pair (lst))
- goto check_lst_and_done;
- SCM_SETCAR (a, SCM_CAR (lst)); /* arg for proc */
- SCM_SIMPLE_VECTOR_SET (vec, i, SCM_CDR (lst)); /* rest of lst */
- }
- SCM_SETCAR (a, init);
-
- init = scm_apply (proc, args, SCM_EOL);
- }
- }
-
- check_lst_and_done:
- SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, argnum, FUNC_NAME, "list");
- return init;
+ CACHE_VAR (fold, "fold");
+ return scm_apply_3 (fold, proc, init, list1, rest);
}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_srfi1_last, "last", 1, 0, 0,
- (SCM lst),
- "Like @code{cons}, but with interchanged arguments. Useful\n"
- "mostly when passed to higher-order procedures.")
-#define FUNC_NAME s_scm_srfi1_last
+SCM
+scm_srfi1_last (SCM lst)
{
- SCM pair = scm_last_pair (lst);
- /* scm_last_pair returns SCM_EOL for an empty list */
- SCM_VALIDATE_CONS (SCM_ARG1, pair);
- return SCM_CAR (pair);
+ CACHE_VAR (last, "last");
+ return scm_call_1 (last, lst);
}
-#undef FUNC_NAME
-
SCM_DEFINE (scm_srfi1_length_plus, "length+", 1, 0, 0,
(SCM lst),
@@ -1073,106 +976,12 @@ SCM_DEFINE (scm_srfi1_length_plus, "length+", 1, 0, 0,
#undef FUNC_NAME
-SCM_DEFINE (scm_srfi1_list_index, "list-index", 2, 0, 1,
- (SCM pred, SCM list1, SCM rest),
- "Return the index of the first set of elements, one from each of\n"
- "@address@hidden@var{lstN}, which satisfies @var{pred}.\n"
- "\n"
- "@var{pred} is called as @code{(@var{pred} elem1 @dots{}\n"
- "elemN)}. Searching stops when the end of the shortest\n"
- "@var{lst} is reached. The return index starts from 0 for the\n"
- "first set of elements. If no set of elements pass then the\n"
- "return is @code{#f}.\n"
- "\n"
- "@example\n"
- "(list-index odd? '(2 4 6 9)) @result{} 3\n"
- "(list-index = '(1 2 3) '(3 1 2)) @result{} #f\n"
- "@end example")
-#define FUNC_NAME s_scm_srfi1_list_index
+SCM
+scm_srfi1_list_index (SCM pred, SCM list1, SCM rest)
{
- long n = 0;
- SCM lst;
- int argnum;
- SCM_VALIDATE_REST_ARGUMENT (rest);
-
- if (scm_is_null (rest))
- {
- /* one list */
- SCM_VALIDATE_PROC (SCM_ARG1, pred);
-
- for ( ; scm_is_pair (list1); n++, list1 = SCM_CDR (list1))
- if (scm_is_true (scm_call_1 (pred, SCM_CAR (list1))))
- return SCM_I_MAKINUM (n);
-
- /* not found, check below that list1 is a proper list */
- end_list1:
- lst = list1;
- argnum = 2;
- }
- else if (scm_is_pair (rest) && scm_is_null (SCM_CDR (rest)))
- {
- /* two lists */
- SCM list2 = SCM_CAR (rest);
- SCM_VALIDATE_PROC (SCM_ARG1, pred);
-
- for ( ; ; n++)
- {
- if (! scm_is_pair (list1))
- goto end_list1;
- if (! scm_is_pair (list2))
- {
- lst = list2;
- argnum = 3;
- break;
- }
- if (scm_is_true (scm_call_2 (pred,
- SCM_CAR (list1), SCM_CAR (list2))))
- return SCM_I_MAKINUM (n);
-
- list1 = SCM_CDR (list1);
- list2 = SCM_CDR (list2);
- }
- }
- else
- {
- /* three or more lists */
- SCM vec, args, a;
- size_t len, i;
-
- /* vec is the list arguments */
- vec = scm_vector (scm_cons (list1, rest));
- len = SCM_SIMPLE_VECTOR_LENGTH (vec);
-
- /* args is the argument list to pass to pred, same length as vec,
- re-used for each call */
- args = scm_make_list (SCM_I_MAKINUM (len), SCM_UNDEFINED);
-
- for ( ; ; n++)
- {
- /* first elem of each list in vec into args, and step those
- vec entries onto their next element */
- for (i = 0, a = args, argnum = 2;
- i < len;
- i++, a = SCM_CDR (a), argnum++)
- {
- lst = SCM_SIMPLE_VECTOR_REF (vec, i); /* list argument */
- if (! scm_is_pair (lst))
- goto not_found_check_lst;
- SCM_SETCAR (a, SCM_CAR (lst)); /* arg for pred */
- SCM_SIMPLE_VECTOR_SET (vec, i, SCM_CDR (lst)); /* rest of lst */
- }
-
- if (scm_is_true (scm_apply (pred, args, SCM_EOL)))
- return SCM_I_MAKINUM (n);
- }
- }
-
- not_found_check_lst:
- SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, argnum, FUNC_NAME, "list");
- return SCM_BOOL_F;
+ CACHE_VAR (list_index, "list-index");
+ return scm_apply_2 (list_index, pred, list1, rest);
}
-#undef FUNC_NAME
-
/* This routine differs from the core list-copy in allowing improper lists.
Maybe the core could allow them similarly. */
@@ -1206,25 +1015,12 @@ SCM_DEFINE (scm_srfi1_list_copy, "list-copy", 1, 0, 0,
}
#undef FUNC_NAME
-
-SCM_DEFINE (scm_srfi1_list_tabulate, "list-tabulate", 2, 0, 0,
- (SCM n, SCM proc),
- "Return an @var{n}-element list, where each list element is\n"
- "produced by applying the procedure @var{init-proc} to the\n"
- "corresponding list index. The order in which @var{init-proc}\n"
- "is applied to the indices is not specified.")
-#define FUNC_NAME s_scm_srfi1_list_tabulate
+SCM
+scm_srfi1_list_tabulate (SCM n, SCM proc)
{
- long i, nn;
- SCM ret = SCM_EOL;
- nn = scm_to_signed_integer (n, 0, LONG_MAX);
- SCM_VALIDATE_PROC (SCM_ARG2, proc);
- for (i = nn-1; i >= 0; i--)
- ret = scm_cons (scm_call_1 (proc, scm_from_long (i)), ret);
- return ret;
+ CACHE_VAR (list_tabulate, "list-tabulate");
+ return scm_call_2 (list_tabulate, n, proc);
}
-#undef FUNC_NAME
-
SCM_DEFINE (scm_srfi1_lset_adjoin, "lset-adjoin", 2, 0, 1,
(SCM equal, SCM lst, SCM rest),
@@ -1609,21 +1405,12 @@ SCM_DEFINE (scm_srfi1_ninth, "ninth", 1, 0, 0,
}
#undef FUNC_NAME
-
-SCM_DEFINE (scm_srfi1_not_pair_p, "not-pair?", 1, 0, 0,
- (SCM obj),
- "Return @code{#t} is @var{obj} is not a pair, @code{#f}\n"
- "otherwise.\n"
- "\n"
- "This is shorthand notation @code{(not (pair? @var{obj}))} and\n"
- "is supposed to be used for end-of-list checking in contexts\n"
- "where dotted lists are allowed.")
-#define FUNC_NAME s_scm_srfi1_not_pair_p
+SCM
+scm_srfi1_not_pair_p (SCM obj)
{
- return scm_from_bool (! scm_is_pair (obj));
+ CACHE_VAR (not_pair_p, "not-pair?");
+ return scm_call_1 (not_pair_p, obj);
}
-#undef FUNC_NAME
-
SCM_DEFINE (scm_srfi1_partition, "partition", 2, 0, 0,
(SCM pred, SCM list),
@@ -2153,17 +1940,14 @@ SCM_DEFINE (scm_srfi1_tenth, "tenth", 1, 0, 0,
#undef FUNC_NAME
-SCM_DEFINE (scm_srfi1_xcons, "xcons", 2, 0, 0,
- (SCM d, SCM a),
- "Like @code{cons}, but with interchanged arguments. Useful\n"
- "mostly when passed to higher-order procedures.")
-#define FUNC_NAME s_scm_srfi1_xcons
+SCM
+scm_srfi1_xcons (SCM d, SCM a)
{
- return scm_cons (a, d);
+ CACHE_VAR (xcons, "xcons");
+ return scm_call_2 (xcons, d, a);
}
-#undef FUNC_NAME
-
+
void
scm_init_srfi_1 (void)
{
diff --git a/test-suite/tests/srfi-1.test b/test-suite/tests/srfi-1.test
index ecff82f..909f58c 100644
--- a/test-suite/tests/srfi-1.test
+++ b/test-suite/tests/srfi-1.test
@@ -1,6 +1,6 @@
;;;; srfi-1.test --- Test suite for Guile's SRFI-1 functions. -*- scheme -*-
;;;;
-;;;; Copyright 2003, 2004, 2005, 2006, 2008, 2009 Free Software Foundation,
Inc.
+;;;; Copyright 2003, 2004, 2005, 2006, 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
@@ -1563,7 +1563,7 @@
(with-test-prefix "list-tabulate"
- (pass-if-exception "-1" exception:out-of-range
+ (pass-if-exception "-1" exception:wrong-type-arg
(list-tabulate -1 identity))
(pass-if "0"
(equal? '() (list-tabulate 0 identity)))
--
1.7.0
pgp8QOoA_lN63.pgp
Description: PGP signature
- SRFI-1 in Scheme,
Ludovic Courtès <=
- Re: SRFI-1 in Scheme, Andy Wingo, 2010/07/13
- Re: SRFI-1 in Scheme, Ludovic Courtès, 2010/07/13
- Re: SRFI-1 in Scheme, Andy Wingo, 2010/07/13
- Re: SRFI-1 in Scheme, Ludovic Courtès, 2010/07/13
- Re: SRFI-1 in Scheme, Andy Wingo, 2010/07/14
- Re: SRFI-1 in Scheme, Ludovic Courtès, 2010/07/15
- Re: SRFI-1 in Scheme, Andy Wingo, 2010/07/19
- Re: SRFI-1 in Scheme, Ludovic Courtès, 2010/07/20
- Re: SRFI-1 in Scheme, Andy Wingo, 2010/07/20
- Re: SRFI-1 in Scheme, Ludovic Courtès, 2010/07/21