SRFI-1 in Scheme

SRFI-1 in Scheme

[Ludovic Courtès]

[-- Attachment #1.1: Type: text/plain, Size: 1320 bytes --]

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’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: the patch --]
[-- Type: text/x-patch, Size: 21065 bytes --]

From 927b96b48d4870c768da093741af6e6bcd438cad Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
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))
+
+\f
+(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"
-	    "@var{lst1}@dots{}@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
-
 
+\f
 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


[-- Attachment #2: Type: application/pgp-signature, Size: 197 bytes --]

Re: SRFI-1 in Scheme

[Andy Wingo]

Hi,

On Tue 13 Jul 2010 00:57, ludo@gnu.org (Ludovic Courtès) writes:

> The attached patch is a first stab at re-implementing SRFI-1 in
> Scheme.
>
> 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

Cool, looks good to me.

> and then make the regular engine the default unless ‘--debug’ is
> specified.

I would prefer to keep the debug VM as the default. At the very least,
one should be able to switch VMs. This can come when we delimit call/cc,
I think -- I have some patches for that for 2.2.

Andy
-- 
http://wingolog.org/

Re: SRFI-1 in Scheme

[Ludovic Courtès]

Hey!

Andy Wingo <wingo@pobox.com> writes:

> On Tue 13 Jul 2010 00:57, ludo@gnu.org (Ludovic Courtès) writes:
>
>> The attached patch is a first stab at re-implementing SRFI-1 in
>> Scheme.
>>
>> 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
>
> Cool, looks good to me.

Just to make sure, did you read the figures right?  With the debug
engine, the slowdown is noticeable.

>> and then make the regular engine the default unless ‘--debug’ is
>> specified.
>
> I would prefer to keep the debug VM as the default.

AFAICS the only difference between the two engine is VM_USE_HOOKS.
Hooks are only used in (system vm coverage) at this point, so we don’t
lose much by disabling them.

Am I overlooking something?

> At the very least, one should be able to switch VMs.

You mean switch VMs for the code being executed?  (For code to be
executed than can already be done using ‘vm-apply’.)

Thanks,
Ludo’.

Re: SRFI-1 in Scheme

[Andy Wingo]

Greets

On Wed 14 Jul 2010 00:09, ludo@gnu.org (Ludovic Courtès) writes:

> Just to make sure, did you read the figures right?  With the debug
> engine, the slowdown is noticeable.

Yes, I saw the numbers :)

> AFAICS the only difference between the two engine is VM_USE_HOOKS.
> Hooks are only used in (system vm coverage) at this point, so we don’t
> lose much by disabling them.

Tracing and call-counting profiling too. They will be used when stepping soon.

>> At the very least, one should be able to switch VMs.
>
> You mean switch VMs for the code being executed?

Yes.

>  (For code to be
> executed than can already be done using ‘vm-apply’.)

That would only apply until a function was subsequently called from C.

Andy
-- 
http://wingolog.org/

Re: SRFI-1 in Scheme

[Ludovic Courtès]

Hey,

Andy Wingo <wingo@pobox.com> writes:

> On Wed 14 Jul 2010 00:09, ludo@gnu.org (Ludovic Courtès) writes:

>> AFAICS the only difference between the two engine is VM_USE_HOOKS.
>> Hooks are only used in (system vm coverage) at this point, so we don’t
>> lose much by disabling them.
>
> Tracing and call-counting profiling too. They will be used when stepping soon.

Right.

To clarify, I’d enable the debug engine for interactive use, but not for
‘-s’, ‘-c’, and when a script is passed as an argument (analogous to
what 1.8 does with the evaluators.)

Tracing and stepping are typically only used interactively, so that’s
OK.  Coverage and profiling can start a new VM that suits their needs,
à la ‘with-code-coverage’.

So my impression is that the behavior above would usually have no
drawbacks for the end user, in that it wouldn’t visibly reduce
functionality.

What do you think?

Thanks,
Ludo’.

Re: SRFI-1 in Scheme

[Andy Wingo]

Hi,

On Wed 14 Jul 2010 00:44, ludo@gnu.org (Ludovic Courtès) writes:

> To clarify, I’d enable the debug engine for interactive use, but not for
> ‘-s’, ‘-c’, and when a script is passed as an argument (analogous to
> what 1.8 does with the evaluators.)

I agree in principle, but I think the switching VMs bit is not fully
baked yet, and so we should not recommend multiple VMs in 2.0. I would
prefer to keep the situation as it is now, for 2.0.

Andy
-- 
http://wingolog.org/

Re: SRFI-1 in Scheme

[Ludovic Courtès]

Hi!

Andy Wingo <wingo@pobox.com> writes:

> On Wed 14 Jul 2010 00:44, ludo@gnu.org (Ludovic Courtès) writes:
>
>> To clarify, I’d enable the debug engine for interactive use, but not for
>> ‘-s’, ‘-c’, and when a script is passed as an argument (analogous to
>> what 1.8 does with the evaluators.)
>
> I agree in principle, but I think the switching VMs bit is not fully
> baked yet, and so we should not recommend multiple VMs in 2.0. I would
> prefer to keep the situation as it is now, for 2.0.

OK, a conservative choice may be wiser for 2.0.

Just to make sure I understand, though: do you mean switching VMs “on
the fly” (i.e., changing the VM currently executing the code), or
switching VMs statically, before booting?  The latter (which is what I
had in mind) seems easy to do–unless I overlook something, that is.  :-)

Thanks,
Ludo’.

Re: SRFI-1 in Scheme

[Andy Wingo]

Hi :)

On Thu 15 Jul 2010 23:40, ludo@gnu.org (Ludovic Courtès) writes:

> Just to make sure I understand, though: do you mean switching VMs “on
> the fly” (i.e., changing the VM currently executing the code), or
> switching VMs statically, before booting?  The latter (which is what I
> had in mind) seems easy to do–unless I overlook something, that is.  :-)

Switching before booting would indeed be easier, and I grudgingly admit
perhaps a good idea, especially for small devices (Maemo, for example).

I would prefer not to enshrine a "regular / debug" split again though. I
guess that's what really bothers me. It's especially egregious if you
can't switch at runtime.

Andy
-- 
http://wingolog.org/

Re: SRFI-1 in Scheme

[Ludovic Courtès]

Hi,

Andy Wingo <wingo@pobox.com> writes:

> I would prefer not to enshrine a "regular / debug" split again though. I
> guess that's what really bothers me. It's especially egregious if you
> can't switch at runtime.

The split survived!  :-)

--8<---------------cut here---------------start------------->8---
$ guile -c 'sdf'
ERROR: In procedure catch-closure:
ERROR: Unbound variable: sdf

$ guile --debug -c 'sdf'
Backtrace:
In ice-9/boot-9.scm:
 170: 8 [catch #t #<catch-closure d5a660> ...]
In unknown file:
   ?: 7 [catch-closure]
In ice-9/boot-9.scm:
  62: 6 [call-with-prompt prompt0 ...]
In module/ice-9/eval.scm:
 389: 5 [eval # #]
In unknown file:
   ?: 4 [eval-string "sdf" #<undefined>]
In module/ice-9/eval.scm:
 356: 3 [eval #<memoized sdf> ()]
In unknown file:
   ?: 2 [memoize-variable-access! #<memoized sdf> #<directory (guile-user) b60120>]
In ice-9/boot-9.scm:
 115: 1 [#<procedure dd08c0 at ice-9/boot-9.scm:109:6 (thrown-k . args)> unbound-variable ...]
In unknown file:
   ?: 0 [catch-closure unbound-variable #f "Unbound variable: ~S" (sdf) #f]

ERROR: In procedure catch-closure:
ERROR: Unbound variable: sdf

$ guile --version
guile (GNU Guile) 1.9.11.176-1b912
--8<---------------cut here---------------end--------------->8---

Don’t get me wrong, this is not to say that we should make the split
even more acute!

I actually think that disabling automatic backtraces is much more
visible that disabling VM hooks.

What do you think?

Thanks,
Ludo’.

Re: SRFI-1 in Scheme

[Andy Wingo]

Yo,

On Tue 20 Jul 2010 18:35, ludo@gnu.org (Ludovic Courtès) writes:

> Andy Wingo <wingo@pobox.com> writes:
>
>> I would prefer not to enshrine a "regular / debug" split again though. I
>> guess that's what really bothers me. It's especially egregious if you
>> can't switch at runtime.
>
> The split survived!  :-)
>
> $ guile -c 'sdf'
> ERROR: In procedure catch-closure:
> ERROR: Unbound variable: sdf
>
> $ guile --debug -c 'sdf'
> Backtrace:
[...]

Hehe. That, to me, is a bug ;-) What do you think about always giving
backtraces for uncaught errors? This does not impact regular vs debug
VMs, as thankfully we can walk any stack now.

Andy
-- 
http://wingolog.org/

Re: SRFI-1 in Scheme

[Andy Wingo]

Actually...

On Tue 20 Jul 2010 18:35, ludo@gnu.org (Ludovic Courtès) writes:

> $ guile --debug -c 'sdf'
> Backtrace:
> In ice-9/boot-9.scm:
>  170: 8 [catch #t #<catch-closure d5a660> ...]
> In unknown file:
>    ?: 7 [catch-closure]
> In ice-9/boot-9.scm:
>   62: 6 [call-with-prompt prompt0 ...]
> In module/ice-9/eval.scm:
>  389: 5 [eval # #]
> In unknown file:
>    ?: 4 [eval-string "sdf" #<undefined>]
> In module/ice-9/eval.scm:
>  356: 3 [eval #<memoized sdf> ()]
> In unknown file:
>    ?: 2 [memoize-variable-access! #<memoized sdf> #<directory (guile-user) b60120>]
> In ice-9/boot-9.scm:
>  115: 1 [#<procedure dd08c0 at ice-9/boot-9.scm:109:6 (thrown-k . args)> unbound-variable ...]
> In unknown file:
>    ?: 0 [catch-closure unbound-variable #f "Unbound variable: ~S" (sdf) #f]
>
> ERROR: In procedure catch-closure:
> ERROR: Unbound variable: sdf

What a terrible backtrace!!!

A
-- 
http://wingolog.org/

Re: SRFI-1 in Scheme

[Ludovic Courtès]

Hey!

Andy Wingo <wingo@pobox.com> writes:

> On Tue 20 Jul 2010 18:35, ludo@gnu.org (Ludovic Courtès) writes:
>
>> Andy Wingo <wingo@pobox.com> writes:
>>
>>> I would prefer not to enshrine a "regular / debug" split again though. I
>>> guess that's what really bothers me. It's especially egregious if you
>>> can't switch at runtime.
>>
>> The split survived!  :-)
>>
>> $ guile -c 'sdf'
>> ERROR: In procedure catch-closure:
>> ERROR: Unbound variable: sdf
>>
>> $ guile --debug -c 'sdf'
>> Backtrace:
> [...]
>
> Hehe. That, to me, is a bug ;-) What do you think about always giving
> backtraces for uncaught errors?

I’m all for it!

Ludo’.

Allowing the choice of a VM engine?

[Ludovic Courtès]

Hello!

Andy Wingo <wingo@pobox.com> writes:

> On Thu 15 Jul 2010 23:40, ludo@gnu.org (Ludovic Courtès) writes:
>
>> Just to make sure I understand, though: do you mean switching VMs “on
>> the fly” (i.e., changing the VM currently executing the code), or
>> switching VMs statically, before booting?  The latter (which is what I
>> had in mind) seems easy to do–unless I overlook something, that is.  :-)
>
> Switching before booting would indeed be easier, and I grudgingly admit
> perhaps a good idea, especially for small devices (Maemo, for example).
>
> I would prefer not to enshrine a "regular / debug" split again though. I
> guess that's what really bothers me. It's especially egregious if you
> can't switch at runtime.

OK, understood.  I agree that having to trade debugging support for
performance was painful with 1.8 and earlier: you’d run your program
“fast”, i.e., without ‘--debug’, and then it would fail without leaving
a backtrace or anything, so you’d have to run it again, “slowly” this
time.

However, I think the trade-off here (running “fast” vs. having the
ability to use VM hooks) is less acute.

There are several ways we could allow users to make their choice:

  1. Similarly to how DEVAL/CEVAL is chosen in 1.8, as proposed in
     <87sk3nt326.fsf@gnu.org>.

  2. With a new specific command-line option to the ‘guile’ binary:
     ‘--disable-vm-hooks’, ‘--enable-vm-hooks’, ‘--fast’,
     ‘--vm-engine=regular’, etc.

The advantage of (2) is that we can choose the default that we consider
the most convenient for users, whereas (1) is biased towards
“performance” by default.

The downside of (2) is that such an option may become pointless when
JIT/AOT compilation is available.


Another possibility would be to keep only the debug engine but somehow
optimize the way VM hooks are handled.  I’m afraid there’s little room
for optimization, though.

What do you think?

Thanks,
Ludo’.

PS: I’m reviving the thread because I’m consistently seeing a 10%
    performance degradation in the SRFI-1 rewrite in Scheme, which I’m
    not comfortable with (not that “higher-level languages are
    inefficient” song again!).

Re: Allowing the choice of a VM engine?

[Andy Wingo]

Hi :)

On Wed 01 Sep 2010 09:04, ludo@gnu.org (Ludovic Courtès) writes:

> PS: I’m reviving the thread because I’m consistently seeing a 10%
>     performance degradation in the SRFI-1 rewrite in Scheme, which I’m
>     not comfortable with (not that “higher-level languages are
>     inefficient” song again!).

So, my thought is that 10% slower is actually pretty good. Of course
without debug hooks things are going to be faster still, but would you
care at all about this if the Scheme version happened to be as fast as
the C version?

But OK. I don't want it to be default, though. How do you feel about
--no-debug, as we have already? We should default to the equivalent of
--debug.

Cheers,

Andy

Ps. I was going to say we should improve compilation instead, but the
hot loop of fold is already pretty tight.

  19    (local-ref 5)                   ;; `list1'
  21    (br-if-not-null :L104)          ;; -> 28              at srfi/srfi-1.scm:408:8
  25    (local-ref 4)                   ;; `knil'
  27    (return)                        
  28    (new-frame)                                           at srfi/srfi-1.scm:410:15
  29    (local-ref 0)                   ;; `kons'
  31    (local-ref 5)                   ;; `list1'
  33    (car)                                                 at srfi/srfi-1.scm:410:21
  34    (local-ref 4)                   ;; `knil'
  36    (call 2)                                              at srfi/srfi-1.scm:410:15
  38    (local-ref 5)                   ;; `list1'
  40    (cdr)                                                 at srfi/srfi-1.scm:410:39
  41    (local-set 5)                   ;; `list1'
  43    (local-set 4)                   ;; `knil'
  45    (br :L105)                      ;; -> 19              at srfi/srfi-1.scm:410:12
-- 
http://wingolog.org/