Merge remote-tracking branch 'origin/stable-2.0'

libguile/__scm.h

@@ -536,10 +536,10 @@ SCM_API void scm_async_tick (void);
     while (0)
 
 /* SCM_ASYNC_TICK_WITH_CODE is only available to Guile itself */
-# define SCM_ASYNC_TICK_WITH_CODE(stmt)                                 \
+# define SCM_ASYNC_TICK_WITH_CODE(thr, stmt)                            \
     do                                                                  \
       {                                                                 \
-	if (SCM_UNLIKELY (SCM_I_CURRENT_THREAD->pending_asyncs))	\
+	if (SCM_UNLIKELY (thr->pending_asyncs))                         \
 	  {                                                             \
             stmt;                                                       \
             scm_async_click ();                                         \

libguile/eval.c

@@ -596,171 +596,31 @@ SCM_DEFINE (scm_nconc2last, "apply:nconc2last", 1, 0, 0,
 #undef FUNC_NAME
 
 
-
-/* Typechecking for multi-argument MAP and FOR-EACH.
-
-   Verify that each element of the vector ARGV, except for the first,
-   is a proper list whose length is LEN.  Attribute errors to WHO,
-   and claim that the i'th element of ARGV is WHO's i+2'th argument.  */
-static inline void
-check_map_args (SCM argv,
-		long len,
-		SCM gf,
-		SCM proc,
-		SCM args,
-		const char *who)
-{
-  long i;
-
-  for (i = SCM_SIMPLE_VECTOR_LENGTH (argv) - 1; i >= 1; i--)
-    {
-      SCM elt = SCM_SIMPLE_VECTOR_REF (argv, i);
-      long elt_len = scm_ilength (elt);
-
-      if (elt_len < 0)
-	{
-	  if (gf)
-	    scm_apply_generic (gf, scm_cons (proc, args));
-	  else
-	    scm_wrong_type_arg (who, i + 2, elt);
-	}
-
-      if (elt_len != len)
-	scm_out_of_range_pos (who, elt, scm_from_long (i + 2));
-    }
-}
-
-
-SCM_GPROC (s_map, "map", 2, 0, 1, scm_map, g_map);
-
-/* Note: Currently, scm_map applies PROC to the argument list(s)
-   sequentially, starting with the first element(s).  This is used in
-   evalext.c where the Scheme procedure `map-in-order', which guarantees
-   sequential behaviour, is implemented using scm_map.  If the
-   behaviour changes, we need to update `map-in-order'.
-*/
-
 SCM 
 scm_map (SCM proc, SCM arg1, SCM args)
-#define FUNC_NAME s_map
 {
-  long i, len;
+  static SCM var = SCM_BOOL_F;
-  SCM res = SCM_EOL;
-  SCM *pres = &res;
 
-  len = scm_ilength (arg1);
+  if (scm_is_false (var))
-  SCM_GASSERTn (len >= 0,
+    var = scm_private_variable (scm_the_root_module (),
-		g_map, scm_cons2 (proc, arg1, args), SCM_ARG2, s_map);
+                                scm_from_latin1_symbol ("map"));
-  SCM_VALIDATE_REST_ARGUMENT (args);
+
-  if (scm_is_null (args))
+  return scm_apply (scm_variable_ref (var),
-    {
+                    scm_cons (proc, scm_cons (arg1, args)), SCM_EOL);
-      SCM_GASSERT2 (scm_is_true (scm_procedure_p (proc)), g_map, proc, arg1, SCM_ARG1, s_map);
-      while (SCM_NIMP (arg1))
-	{
-	  *pres = scm_list_1 (scm_call_1 (proc, SCM_CAR (arg1)));
-	  pres = SCM_CDRLOC (*pres);
-	  arg1 = SCM_CDR (arg1);
-	}
-      return res;
-    }
-  if (scm_is_null (SCM_CDR (args)))
-    {
-      SCM arg2 = SCM_CAR (args);
-      int len2 = scm_ilength (arg2);
-      SCM_GASSERTn (scm_is_true (scm_procedure_p (proc)), g_map,
-                    scm_cons2 (proc, arg1, args), SCM_ARG1, s_map);
-      SCM_GASSERTn (len2 >= 0,
-		    g_map, scm_cons2 (proc, arg1, args), SCM_ARG3, s_map);
-      if (len2 != len)
-	SCM_OUT_OF_RANGE (3, arg2);
-      while (SCM_NIMP (arg1))
-	{
-	  *pres = scm_list_1 (scm_call_2 (proc, SCM_CAR (arg1), SCM_CAR (arg2)));
-	  pres = SCM_CDRLOC (*pres);
-	  arg1 = SCM_CDR (arg1);
-	  arg2 = SCM_CDR (arg2);
-	}
-      return res;
-    }
-  arg1 = scm_cons (arg1, args);
-  args = scm_vector (arg1);
-  check_map_args (args, len, g_map, proc, arg1, s_map);
-  while (1)
-    {
-      arg1 = SCM_EOL;
-      for (i = SCM_SIMPLE_VECTOR_LENGTH (args) - 1; i >= 0; i--)
-	{
-	  SCM elt = SCM_SIMPLE_VECTOR_REF (args, i);
-	  if (SCM_IMP (elt)) 
-	    return res;
-	  arg1 = scm_cons (SCM_CAR (elt), arg1);
-	  SCM_SIMPLE_VECTOR_SET (args, i, SCM_CDR (elt));
-	}
-      *pres = scm_list_1 (scm_apply (proc, arg1, SCM_EOL));
-      pres = SCM_CDRLOC (*pres);
-    }
 }
-#undef FUNC_NAME
-
-
-SCM_GPROC (s_for_each, "for-each", 2, 0, 1, scm_for_each, g_for_each);
 
 SCM 
 scm_for_each (SCM proc, SCM arg1, SCM args)
-#define FUNC_NAME s_for_each
 {
-  long i, len;
+  static SCM var = SCM_BOOL_F;
-  len = scm_ilength (arg1);
+
-  SCM_GASSERTn (len >= 0, g_for_each, scm_cons2 (proc, arg1, args),
+  if (scm_is_false (var))
-		SCM_ARG2, s_for_each);
+    var = scm_private_variable (scm_the_root_module (),
-  SCM_VALIDATE_REST_ARGUMENT (args);
+                                scm_from_latin1_symbol ("for-each"));
-  if (scm_is_null (args))
+
-    {
+  return scm_apply (scm_variable_ref (var),
-      SCM_GASSERT2 (scm_is_true (scm_procedure_p (proc)), g_for_each,
+                    scm_cons (proc, scm_cons (arg1, args)), SCM_EOL);
-                    proc, arg1, SCM_ARG1, s_for_each);
-      while (SCM_NIMP (arg1))
-	{
-	  scm_call_1 (proc, SCM_CAR (arg1));
-	  arg1 = SCM_CDR (arg1);
-	}
-      return SCM_UNSPECIFIED;
-    }
-  if (scm_is_null (SCM_CDR (args)))
-    {
-      SCM arg2 = SCM_CAR (args);
-      int len2 = scm_ilength (arg2);
-      SCM_GASSERTn (scm_is_true (scm_procedure_p (proc)), g_for_each,
-		    scm_cons2 (proc, arg1, args), SCM_ARG1, s_for_each);
-      SCM_GASSERTn (len2 >= 0, g_for_each,
-		    scm_cons2 (proc, arg1, args), SCM_ARG3, s_for_each);
-      if (len2 != len)
-	SCM_OUT_OF_RANGE (3, arg2);
-      while (SCM_NIMP (arg1))
-	{
-	  scm_call_2 (proc, SCM_CAR (arg1), SCM_CAR (arg2));
-	  arg1 = SCM_CDR (arg1);
-	  arg2 = SCM_CDR (arg2);
-	}
-      return SCM_UNSPECIFIED;
-    }
-  arg1 = scm_cons (arg1, args);
-  args = scm_vector (arg1);
-  check_map_args (args, len, g_for_each, proc, arg1, s_for_each);
-  while (1)
-    {
-      arg1 = SCM_EOL;
-      for (i = SCM_SIMPLE_VECTOR_LENGTH (args) - 1; i >= 0; i--)
-	{
-	  SCM elt = SCM_SIMPLE_VECTOR_REF (args, i);
-	  if (SCM_IMP (elt))
-	    return SCM_UNSPECIFIED;
-	  arg1 = scm_cons (SCM_CAR (elt), arg1);
-	  SCM_SIMPLE_VECTOR_SET (args, i, SCM_CDR (elt));
-	}
-      scm_apply (proc, arg1, SCM_EOL);
-    }
 }
-#undef FUNC_NAME
 
 
 static SCM

libguile/evalext.c

@@ -1,4 +1,4 @@
-/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009, 2010, 2011 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 License
@@ -55,9 +55,6 @@ SCM_DEFINE (scm_defined_p, "defined?", 1, 1, 0,
 #undef FUNC_NAME
 
 
-SCM_REGISTER_PROC (s_map_in_order, "map-in-order", 2, 0, 1, scm_map);
-
-
 SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
 	    (SCM obj),
 	    "Return #t for objects which Guile considers self-evaluating")

libguile/list.c

@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,2000,2001,2003,2004,2008,2009,2010
+/* Copyright (C) 1995,1996,1997,2000,2001,2003,2004,2008,2009,2010,2011
  * Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
@@ -617,8 +617,32 @@ SCM_DEFINE (scm_memq, "memq", 2, 0, 0,
 	    "returned.")
 #define FUNC_NAME s_scm_memq
 {
-  SCM_VALIDATE_LIST (2, lst);
+  SCM hare = lst, tortoise = lst;
-  return scm_c_memq (x, lst);
+  
+  while (scm_is_pair (hare))
+    {
+      if (scm_is_eq (SCM_CAR (hare), x))
+	return hare;
+      else
+        hare = SCM_CDR (hare);
+
+      if (!scm_is_pair (hare))
+        break;
+
+      if (scm_is_eq (SCM_CAR (hare), x))
+	return hare;
+      else
+        hare = SCM_CDR (hare);
+
+      tortoise = SCM_CDR (tortoise);
+      if (SCM_UNLIKELY (scm_is_eq (hare, tortoise)))
+        break;
+    }
+
+  if (SCM_LIKELY (scm_is_null (hare)))
+    return SCM_BOOL_F;
+  else
+    scm_wrong_type_arg_msg (FUNC_NAME, 2, lst, "list");
 }
 #undef FUNC_NAME
 
@@ -633,13 +657,32 @@ SCM_DEFINE (scm_memv, "memv", 2, 0, 0,
 	    "returned.")
 #define FUNC_NAME s_scm_memv
 {
-  SCM_VALIDATE_LIST (2, lst);
+  SCM hare = lst, tortoise = lst;
-  for (; !SCM_NULL_OR_NIL_P (lst); lst = SCM_CDR (lst))
+  
+  while (scm_is_pair (hare))
     {
-      if (! scm_is_false (scm_eqv_p (SCM_CAR (lst), x)))
+      if (scm_is_true (scm_eqv_p (SCM_CAR (hare), x)))
-	return lst;
+	return hare;
+      else
+        hare = SCM_CDR (hare);
+
+      if (!scm_is_pair (hare))
+        break;
+
+      if (scm_is_true (scm_eqv_p (SCM_CAR (hare), x)))
+	return hare;
+      else
+        hare = SCM_CDR (hare);
+
+      tortoise = SCM_CDR (tortoise);
+      if (SCM_UNLIKELY (scm_is_eq (hare, tortoise)))
+        break;
     }
-  return SCM_BOOL_F;
+
+  if (SCM_LIKELY (scm_is_null (hare)))
+    return SCM_BOOL_F;
+  else
+    scm_wrong_type_arg_msg (FUNC_NAME, 2, lst, "list");
 }
 #undef FUNC_NAME
 

libguile/srfi-1.c

@@ -44,32 +44,6 @@
  */
 
 
-static long
-srfi1_ilength (SCM sx)
-{
-  long i = 0;
-  SCM tortoise = sx;
-  SCM hare = sx;
-
-  do {
-    if (SCM_NULL_OR_NIL_P(hare)) return i;
-    if (!scm_is_pair (hare)) return -2;
-    hare = SCM_CDR(hare);
-    i++;
-    if (SCM_NULL_OR_NIL_P(hare)) return i;
-    if (!scm_is_pair (hare)) return -2;
-    hare = SCM_CDR(hare);
-    i++;
-    /* For every two steps the hare takes, the tortoise takes one.  */
-    tortoise = SCM_CDR(tortoise);
-  }
-  while (! scm_is_eq (hare, tortoise));
-
-  /* If the tortoise ever catches the hare, then the list must contain
-     a cycle.  */
-  return -1;
-}
-
 static SCM
 equal_trampoline (SCM proc, SCM arg1, SCM arg2)
 {
@@ -760,202 +734,6 @@ SCM_DEFINE (scm_srfi1_lset_difference_x, "lset-difference!", 2, 0, 1,
 #undef FUNC_NAME
 
 
-/* Typechecking for multi-argument MAP and FOR-EACH.
-
-   Verify that each element of the vector ARGV, except for the first,
-   is a list and return minimum length.  Attribute errors to WHO,
-   and claim that the i'th element of ARGV is WHO's i+2'th argument.  */
-static inline int
-check_map_args (SCM argv,
-		long len,
-		SCM gf,
-		SCM proc,
-		SCM args,
-		const char *who)
-{
-  long i;
-  SCM elt;
-
-  for (i = SCM_SIMPLE_VECTOR_LENGTH (argv) - 1; i >= 1; i--)
-    {
-      long elt_len;
-      elt = SCM_SIMPLE_VECTOR_REF (argv, i);
-
-      if (!(scm_is_null (elt) || scm_is_pair (elt)))
-	goto check_map_error;
-	
-      elt_len = srfi1_ilength (elt);
-      if (elt_len < -1)
-	goto check_map_error;
-
-      if (len < 0 || (elt_len >= 0 && elt_len < len))
-	len = elt_len;
-    }
-
-  if (len < 0)
-    {
-      /* i == 0 */
-      elt = SCM_EOL;
-    check_map_error:
-      if (gf)
-	scm_apply_generic (gf, scm_cons (proc, args));
-      else
-	scm_wrong_type_arg (who, i + 2, elt);
-    }
-
-  scm_remember_upto_here_1 (argv);
-  return len;
-}
-
-
-SCM_GPROC (s_srfi1_map, "map", 2, 0, 1, scm_srfi1_map, g_srfi1_map);
-
-/* Note: Currently, scm_srfi1_map applies PROC to the argument list(s)
-   sequentially, starting with the first element(s).  This is used in
-   the Scheme procedure `map-in-order', which guarantees sequential
-   behaviour, is implemented using scm_map.  If the behaviour changes,
-   we need to update `map-in-order'.
-*/
-
-SCM 
-scm_srfi1_map (SCM proc, SCM arg1, SCM args)
-#define FUNC_NAME s_srfi1_map
-{
-  long i, len;
-  SCM res = SCM_EOL;
-  SCM *pres = &res;
-
-  len = srfi1_ilength (arg1);
-  SCM_GASSERTn ((scm_is_null (arg1) || scm_is_pair (arg1)) && len >= -1,
-		g_srfi1_map,
-		scm_cons2 (proc, arg1, args), SCM_ARG2, s_srfi1_map);
-  SCM_VALIDATE_REST_ARGUMENT (args);
-  if (scm_is_null (args))
-    {
-      SCM_GASSERT2 (scm_is_true (scm_procedure_p (proc)), g_srfi1_map,
-                    proc, arg1, SCM_ARG1, s_srfi1_map);
-      SCM_GASSERT2 (len >= 0, g_srfi1_map, proc, arg1, SCM_ARG2, s_srfi1_map);
-      while (SCM_NIMP (arg1))
-	{
-	  *pres = scm_list_1 (scm_call_1 (proc, SCM_CAR (arg1)));
-	  pres = SCM_CDRLOC (*pres);
-	  arg1 = SCM_CDR (arg1);
-	}
-      return res;
-    }
-  if (scm_is_null (SCM_CDR (args)))
-    {
-      SCM arg2 = SCM_CAR (args);
-      int len2 = srfi1_ilength (arg2);
-      SCM_GASSERTn (scm_is_true (scm_procedure_p (proc)), g_srfi1_map,
-		    scm_cons2 (proc, arg1, args), SCM_ARG1, s_srfi1_map);
-      if (len < 0 || (len2 >= 0 && len2 < len))
-	len = len2;
-      SCM_GASSERTn ((scm_is_null (arg2) || scm_is_pair (arg2))
-		    && len >= 0 && len2 >= -1,
-		    g_srfi1_map,
-		    scm_cons2 (proc, arg1, args),
-		    len2 >= 0 ? SCM_ARG2 : SCM_ARG3,
-		    s_srfi1_map);
-      while (len > 0)
-	{
-	  *pres = scm_list_1 (scm_call_2 (proc, SCM_CAR (arg1), SCM_CAR (arg2)));
-	  pres = SCM_CDRLOC (*pres);
-	  arg1 = SCM_CDR (arg1);
-	  arg2 = SCM_CDR (arg2);
-	  --len;
-	}
-      return res;
-    }
-  args = scm_vector (arg1 = scm_cons (arg1, args));
-  len = check_map_args (args, len, g_srfi1_map, proc, arg1, s_srfi1_map);
-  while (len > 0)
-    {
-      arg1 = SCM_EOL;
-      for (i = SCM_SIMPLE_VECTOR_LENGTH (args) - 1; i >= 0; i--)
-	{
-	  SCM elt = SCM_SIMPLE_VECTOR_REF (args, i);
-	  arg1 = scm_cons (SCM_CAR (elt), arg1);
-	  SCM_SIMPLE_VECTOR_SET (args, i, SCM_CDR (elt));
-	}
-      *pres = scm_list_1 (scm_apply (proc, arg1, SCM_EOL));
-      pres = SCM_CDRLOC (*pres);
-      --len;
-    }
-  return res;
-}
-#undef FUNC_NAME
-
-SCM_REGISTER_PROC (s_srfi1_map_in_order, "map-in-order", 2, 0, 1, scm_srfi1_map);
-
-SCM_GPROC (s_srfi1_for_each, "for-each", 2, 0, 1, scm_srfi1_for_each, g_srfi1_for_each);
-
-SCM 
-scm_srfi1_for_each (SCM proc, SCM arg1, SCM args)
-#define FUNC_NAME s_srfi1_for_each
-{
-  long i, len;
-  len = srfi1_ilength (arg1);
-  SCM_GASSERTn ((scm_is_null (arg1) || scm_is_pair (arg1)) && len >= -1,
-		g_srfi1_for_each, scm_cons2 (proc, arg1, args),
-		SCM_ARG2, s_srfi1_for_each);
-  SCM_VALIDATE_REST_ARGUMENT (args);
-  if (scm_is_null (args))
-    {
-      SCM_GASSERT2 (scm_is_true (scm_procedure_p (proc)), g_srfi1_for_each,
-                    proc, arg1, SCM_ARG1, s_srfi1_for_each);
-      SCM_GASSERT2 (len >= 0, g_srfi1_for_each, proc, arg1,
-		    SCM_ARG2, s_srfi1_map);
-      while (SCM_NIMP (arg1))
-	{
-	  scm_call_1 (proc, SCM_CAR (arg1));
-	  arg1 = SCM_CDR (arg1);
-	}
-      return SCM_UNSPECIFIED;
-    }
-  if (scm_is_null (SCM_CDR (args)))
-    {
-      SCM arg2 = SCM_CAR (args);
-      int len2 = srfi1_ilength (arg2);
-      SCM_GASSERTn (scm_is_true (scm_procedure_p (proc)), g_srfi1_for_each,
-		    scm_cons2 (proc, arg1, args), SCM_ARG1, s_srfi1_for_each);
-      if (len < 0 || (len2 >= 0 && len2 < len))
-	len = len2;
-      SCM_GASSERTn ((scm_is_null (arg2) || scm_is_pair (arg2))
-		    && len >= 0 && len2 >= -1,
-		    g_srfi1_for_each,
-		    scm_cons2 (proc, arg1, args),
-		    len2 >= 0 ? SCM_ARG2 : SCM_ARG3,
-		    s_srfi1_for_each);
-      while (len > 0)
-	{
-	  scm_call_2 (proc, SCM_CAR (arg1), SCM_CAR (arg2));
-	  arg1 = SCM_CDR (arg1);
-	  arg2 = SCM_CDR (arg2);
-	  --len;
-	}
-      return SCM_UNSPECIFIED;
-    }
-  args = scm_vector (arg1 = scm_cons (arg1, args));
-  len = check_map_args (args, len, g_srfi1_for_each, proc, arg1,
-			s_srfi1_for_each);
-  while (len > 0)
-    {
-      arg1 = SCM_EOL;
-      for (i = SCM_SIMPLE_VECTOR_LENGTH (args) - 1; i >= 0; i--)
-	{
-	  SCM elt = SCM_SIMPLE_VECTOR_REF (args, i);
-	  arg1 = scm_cons (SCM_CAR (elt), arg1);
-	  SCM_SIMPLE_VECTOR_SET (args, i, SCM_CDR (elt));
-	}
-      scm_apply (proc, arg1, SCM_EOL);
-      --len;
-    }
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-
 SCM_DEFINE (scm_srfi1_assoc, "assoc", 2, 1, 0,
 	    (SCM key, SCM alist, SCM pred),
 	    "Behaves like @code{assq} but uses third argument @var{pred?}\n"
@@ -1175,16 +953,9 @@ scm_register_srfi_1 (void)
 void
 scm_init_srfi_1 (void)
 {
-  SCM the_root_module = scm_lookup_closure_module (SCM_BOOL_F);
 #ifndef SCM_MAGIC_SNARFER
 #include "libguile/srfi-1.x"
 #endif
-  scm_c_extend_primitive_generic
-    (SCM_VARIABLE_REF (scm_c_module_lookup (the_root_module, "map")),
-     SCM_VARIABLE_REF (scm_c_lookup ("map")));
-  scm_c_extend_primitive_generic
-    (SCM_VARIABLE_REF (scm_c_module_lookup (the_root_module, "for-each")),
-     SCM_VARIABLE_REF (scm_c_lookup ("for-each")));
 }
 
 /* End of srfi-1.c.  */

libguile/srfi-1.h

@@ -39,8 +39,6 @@ SCM_INTERNAL SCM scm_srfi1_find_tail (SCM pred, SCM lst);
 SCM_INTERNAL SCM scm_srfi1_length_plus (SCM lst);
 SCM_INTERNAL SCM scm_srfi1_lset_difference_x (SCM equal, SCM lst, SCM rest);
 SCM_INTERNAL SCM scm_srfi1_list_copy (SCM lst);
-SCM_INTERNAL SCM scm_srfi1_map (SCM proc, SCM arg1, SCM args);
-SCM_INTERNAL SCM scm_srfi1_for_each (SCM proc, SCM arg1, SCM args);
 SCM_INTERNAL SCM scm_srfi1_assoc (SCM key, SCM alist, SCM pred);
 SCM_INTERNAL SCM scm_srfi1_partition (SCM pred, SCM list);
 SCM_INTERNAL SCM scm_srfi1_partition_x (SCM pred, SCM list);

libguile/vm-engine.c

@@ -52,7 +52,7 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
 #endif
   SCM *stack_limit = vp->stack_limit;	/* stack limit address */
 
-  SCM dynstate = SCM_I_CURRENT_THREAD->dynamic_state;
+  scm_i_thread *current_thread = SCM_I_CURRENT_THREAD;
   scm_t_int64 vm_cookie = vp->cookie++;
 
   /* Internal variables */

libguile/vm-engine.h

@@ -244,7 +244,7 @@
   RUN_HOOK (SCM_VM_RESTORE_CONTINUATION_HOOK)
 
 #define VM_HANDLE_INTERRUPTS                     \
-  SCM_ASYNC_TICK_WITH_CODE (SYNC_REGISTER ())
+  SCM_ASYNC_TICK_WITH_CODE (current_thread, SYNC_REGISTER ())
 
 
 /*

libguile/vm-i-system.c

@@ -1635,7 +1635,7 @@ VM_DEFINE_INSTRUCTION (89, wind_fluids, "wind-fluids", 1, -1, 0)
   wf = scm_i_make_with_fluids (n, sp + 1, sp + 1 + n);
   NULLSTACK (2 * n);
 
-  scm_i_swap_with_fluids (wf, dynstate);
+  scm_i_swap_with_fluids (wf, current_thread->dynamic_state);
   scm_i_set_dynwinds (scm_cons (wf, scm_i_dynwinds ()));
   NEXT;
 }
@@ -1645,7 +1645,7 @@ VM_DEFINE_INSTRUCTION (90, unwind_fluids, "unwind-fluids", 0, 0, 0)
   SCM wf;
   wf = scm_car (scm_i_dynwinds ());
   scm_i_set_dynwinds (scm_cdr (scm_i_dynwinds ()));
-  scm_i_swap_with_fluids (wf, dynstate);
+  scm_i_swap_with_fluids (wf, current_thread->dynamic_state);
   NEXT;
 }
 
@@ -1655,7 +1655,7 @@ VM_DEFINE_INSTRUCTION (91, fluid_ref, "fluid-ref", 0, 1, 1)
   SCM fluids;
   
   CHECK_UNDERFLOW ();
-  fluids = SCM_I_DYNAMIC_STATE_FLUIDS (dynstate);
+  fluids = SCM_I_DYNAMIC_STATE_FLUIDS (current_thread->dynamic_state);
   if (SCM_UNLIKELY (!SCM_FLUID_P (*sp))
       || ((num = SCM_I_FLUID_NUM (*sp)) >= SCM_SIMPLE_VECTOR_LENGTH (fluids)))
     {
@@ -1683,7 +1683,7 @@ VM_DEFINE_INSTRUCTION (92, fluid_set, "fluid-set", 0, 2, 0)
   SCM val, fluid, fluids;
   
   POP2 (val, fluid);
-  fluids = SCM_I_DYNAMIC_STATE_FLUIDS (dynstate);
+  fluids = SCM_I_DYNAMIC_STATE_FLUIDS (current_thread->dynamic_state);
   if (SCM_UNLIKELY (!SCM_FLUID_P (fluid))
       || ((num = SCM_I_FLUID_NUM (fluid)) >= SCM_SIMPLE_VECTOR_LENGTH (fluids)))
     {

module/ice-9/boot-9.scm

@@ -263,6 +263,50 @@ If there is no handler at all, Guile prints an error and then exits."
 
 
 
+;;; Boot versions of `map' and `for-each', enough to get the expander
+;;; running.
+;;;
+(define map
+  (case-lambda
+    ((f l)
+     (let map1 ((l l))
+       (if (null? l)
+           '()
+           (cons (f (car l)) (map1 (cdr l))))))
+    ((f l1 l2)
+     (let map2 ((l1 l1) (l2 l2))
+       (if (null? l1)
+           '()
+           (cons (f (car l1) (car l2))
+                 (map2 (cdr l1) (cdr l2))))))
+    ((f l1 . rest)
+     (let lp ((l1 l1) (rest rest))
+       (if (null? l1)
+           '()
+           (cons (apply f (car l1) (map car rest))
+                 (lp (cdr l1) (map cdr rest))))))))
+
+(define for-each
+  (case-lambda
+    ((f l)
+     (let for-each1 ((l l))
+       (if (pair? l)
+           (begin
+             (f (car l))
+             (for-each1 (cdr l))))))
+    ((f l1 l2)
+     (let for-each2 ((l1 l1) (l2 l2))
+       (if (pair? l1)
+           (begin
+             (f (car l1) (car l2))
+             (for-each2 (cdr l1) (cdr l2))))))
+    ((f l1 . rest)
+     (let lp ((l1 l1) (rest rest))
+       (if (pair? l1)
+           (begin
+             (apply f (car l1) (map car rest))
+             (lp (cdr l1) (map cdr rest))))))))
+
 ;;; {and-map and or-map}
 ;;;
 ;;; (and-map fn lst) is like (and (fn (car lst)) (fn (cadr lst)) (fn...) ...)
@@ -479,6 +523,147 @@ If there is no handler at all, Guile prints an error and then exits."
      (define sym
        (if (module-locally-bound? (current-module) 'sym) sym val)))))
 
+;;; The real versions of `map' and `for-each', with cycle detection, and
+;;; that use reverse! instead of recursion in the case of `map'.
+;;;
+(define map
+  (case-lambda
+    ((f l)
+     (let map1 ((hare l) (tortoise l) (move? #f) (out '()))
+       (if (pair? hare)
+           (if move?
+               (if (eq? tortoise hare)
+                   (scm-error 'wrong-type-arg "map" "Circular list: ~S"
+                              (list l) #f)
+                   (map1 (cdr hare) (cdr tortoise) #f
+                       (cons (f (car hare)) out)))
+               (map1 (cdr hare) tortoise #t
+                     (cons (f (car hare)) out)))
+           (if (null? hare)
+               (reverse! out)
+               (scm-error 'wrong-type-arg "map" "Not a list: ~S"
+                          (list l) #f)))))
+    
+    ((f l1 l2)
+     (let map2 ((h1 l1) (h2 l2) (t1 l1) (t2 l2) (move? #f) (out '()))
+       (cond
+        ((pair? h1)
+         (cond
+          ((not (pair? h2))
+           (scm-error 'wrong-type-arg "map"
+                      (if (list? h2)
+                          "List of wrong length: ~S"
+                          "Not a list: ~S")
+                      (list l2) #f))
+          ((not move?)
+           (map2 (cdr h1) (cdr h2) t1 t2 #t
+                 (cons (f (car h1) (car h2)) out)))
+          ((eq? t1 h1)
+           (scm-error 'wrong-type-arg "map" "Circular list: ~S"
+                      (list l1) #f))
+          ((eq? t2 h2)
+           (scm-error 'wrong-type-arg "map" "Circular list: ~S"
+                      (list l2) #f))
+          (else
+           (map2 (cdr h1) (cdr h2) (cdr t1) (cdr t2) #f
+                 (cons (f (car h1) (car h2)) out)))))
+
+        ((and (null? h1) (null? h2))
+         (reverse! out))
+        
+        ((null? h1)
+         (scm-error 'wrong-type-arg "map"
+                    (if (list? h2)
+                        "List of wrong length: ~S"
+                        "Not a list: ~S")
+                    (list l2) #f))
+        (else
+         (scm-error 'wrong-type-arg "map"
+                    "Not a list: ~S"
+                    (list l1) #f)))))
+
+    ((f l1 . rest)
+     (let ((len (length l1)))
+       (let mapn ((rest rest))
+         (or (null? rest)
+             (if (= (length (car rest)) len)
+                 (mapn (cdr rest))
+                 (scm-error 'wrong-type-arg "map" "List of wrong length: ~S"
+                            (list (car rest)) #f)))))
+     (let mapn ((l1 l1) (rest rest) (out '()))
+       (if (null? l1)
+           (reverse! out)
+           (mapn (cdr l1) (map cdr rest)
+                 (cons (apply f (car l1) (map car rest)) out)))))))
+
+(define map-in-order map)
+
+(define for-each
+  (case-lambda
+    ((f l)
+     (let for-each1 ((hare l) (tortoise l) (move? #f))
+       (if (pair? hare)
+           (if move?
+               (if (eq? tortoise hare)
+                   (scm-error 'wrong-type-arg "for-each" "Circular list: ~S"
+                              (list l) #f)
+                   (begin
+                     (f (car hare))
+                     (for-each1 (cdr hare) (cdr tortoise) #f)))
+               (begin
+                 (f (car hare))
+                 (for-each1 (cdr hare) tortoise #t)))
+           
+           (if (not (null? hare))
+               (scm-error 'wrong-type-arg "for-each" "Not a list: ~S"
+                          (list l) #f)))))
+    
+    ((f l1 l2)
+     (let for-each2 ((h1 l1) (h2 l2) (t1 l1) (t2 l2) (move? #f))
+       (cond
+        ((and (pair? h1) (pair? h2))
+         (cond
+          ((not move?)
+           (f (car h1) (car h2))
+           (for-each2 (cdr h1) (cdr h2) t1 t2 #t))
+          ((eq? t1 h1)
+           (scm-error 'wrong-type-arg "for-each" "Circular list: ~S"
+                      (list l1) #f))
+          ((eq? t2 h2)
+           (scm-error 'wrong-type-arg "for-each" "Circular list: ~S"
+                      (list l2) #f))
+          (else
+           (f (car h1) (car h2))
+           (for-each2 (cdr h1) (cdr h2) (cdr t1) (cdr t2) #f))))
+
+        ((if (null? h1)
+             (or (null? h2) (pair? h2))
+             (and (pair? h1) (null? h2)))
+         (if #f #f))
+        
+        ((list? h1)
+         (scm-error 'wrong-type-arg "for-each" "Unexpected tail: ~S"
+                    (list h2) #f))
+        (else
+         (scm-error 'wrong-type-arg "for-each" "Unexpected tail: ~S"
+                    (list h1) #f)))))
+
+    ((f l1 . rest)
+     (let ((len (length l1)))
+       (let for-eachn ((rest rest))
+         (or (null? rest)
+             (if (= (length (car rest)) len)
+                 (for-eachn (cdr rest))
+                 (scm-error 'wrong-type-arg "for-each" "List of wrong length: ~S"
+                            (list (car rest)) #f)))))
+     
+     (let for-eachn ((l1 l1) (rest rest))
+       (if (pair? l1)
+           (begin
+             (apply f (car l1) (map car rest))
+             (for-eachn (cdr l1) (map cdr rest))))))))
+
+
 
 
 ;;;

module/ice-9/psyntax.scm

@@ -156,25 +156,6 @@
   (set-current-module (resolve-module '(guile))))
 
 (let ()
-  ;; Private version of and-map that handles multiple lists.
-  (define and-map*
-    (lambda (f first . rest)
-      (or (null? first)
-          (if (null? rest)
-              (let andmap ((first first))
-                (let ((x (car first)) (first (cdr first)))
-                  (if (null? first)
-                      (f x)
-                      (and (f x) (andmap first)))))
-              (let andmap ((first first) (rest rest))
-                (let ((x (car first))
-                      (xr (map car rest))
-                      (first (cdr first))
-                      (rest (map cdr rest)))
-                  (if (null? first)
-                      (apply f x xr)
-                      (and (apply f x xr) (andmap first rest)))))))))
-
   (define-syntax define-expansion-constructors
     (lambda (x)
       (syntax-case x ()
@@ -1747,7 +1728,13 @@
                ((vector? x)
                 (let ((old (vector->list x)))
                   (let ((new (map f old)))
-                    (if (and-map* eq? old new) x (list->vector new)))))
+                    ;; inlined and-map with two args
+                    (let lp ((l1 old) (l2 new))
+                      (if (null? l1)
+                          x
+                          (if (eq? (car l1) (car l2))
+                              (lp (cdr l1) (cdr l2))
+                              (list->vector new)))))))
                (else x))))))
 
     ;; lexical variables

module/srfi/srfi-1.scm

@@ -418,20 +418,20 @@ a list of those after."
   (let lp ((l (cons clist1 rest)) (acc '()))
     (if (any null? l)
       (reverse! acc)
-      (lp (map1 cdr l) (cons (map1 car l) acc)))))
+      (lp (map cdr l) (cons (map car l) acc)))))
 
 
 (define (unzip1 l)
-  (map1 first l))
+  (map first l))
 (define (unzip2 l)
-  (values (map1 first l) (map1 second l)))
+  (values (map first l) (map second l)))
 (define (unzip3 l)
-  (values (map1 first l) (map1 second l) (map1 third l)))
+  (values (map first l) (map second l) (map third l)))
 (define (unzip4 l)
-  (values (map1 first l) (map1 second l) (map1 third l) (map1 fourth l)))
+  (values (map first l) (map second l) (map third l) (map fourth l)))
 (define (unzip5 l)
-  (values (map1 first l) (map1 second l) (map1 third l) (map1 fourth l)
+  (values (map first l) (map second l) (map third l) (map fourth l)
-	  (map1 fifth l)))
+	  (map fifth l)))
 
 ;;; Fold, unfold & map
 
@@ -446,8 +446,8 @@ that result.  See the manual for details."
       (let f ((knil knil) (lists (cons list1 rest)))
 	(if (any null? lists)
 	    knil
-	    (let ((cars (map1 car lists))
+	    (let ((cars (map car lists))
-		  (cdrs (map1 cdr lists)))
+		  (cdrs (map cdr lists)))
 	      (f (apply kons (append! cars (list knil))) cdrs))))))
 
 (define (fold-right kons knil clist1 . rest)
@@ -458,12 +458,12 @@ that result.  See the manual for details."
             result
             (loop (cdr lst)
                   (kons (car lst) result))))
-      (let loop ((lists  (map1 reverse (cons clist1 rest)))
+      (let loop ((lists  (map reverse (cons clist1 rest)))
                  (result knil))
         (if (any1 null? lists)
             result
-            (loop (map1 cdr lists)
+            (loop (map cdr lists)
-                  (apply kons (append! (map1 car lists) (list result))))))))
+                  (apply kons (append! (map car lists) (list result))))))))
 
 (define (pair-fold kons knil clist1 . rest)
   (if (null? rest)
@@ -475,7 +475,7 @@ that result.  See the manual for details."
       (let f ((knil knil) (lists (cons clist1 rest)))
 	(if (any null? lists)
 	    knil
-	    (let ((tails (map1 cdr lists)))
+	    (let ((tails (map cdr lists)))
 	      (f (apply kons (append! lists (list knil))) tails))))))
 
 
@@ -488,7 +488,7 @@ that result.  See the manual for details."
     (let f ((lists (cons clist1 rest)))
       (if (any null? lists)
 	knil
-	(apply kons (append! lists (list (f (map1 cdr lists)))))))))
+	(apply kons (append! lists (list (f (map cdr lists)))))))))
 
 (define* (unfold p f g seed #:optional (tail-gen (lambda (x) '())))
   (define (reverse+tail lst seed)
@@ -530,10 +530,79 @@ has just one element then that's the return value."
       ridentity
       (fold-right f (last lst) (drop-right lst 1))))
 
+(define map
+  (case-lambda
+    ((f l)
+     (let map1 ((hare l) (tortoise l) (move? #f) (out '()))
+       (if (pair? hare)
+           (if move?
+               (if (eq? tortoise hare)
+                   (scm-error 'wrong-type-arg "map" "Circular list: ~S"
+                              (list l) #f)
+                   (map1 (cdr hare) (cdr tortoise) #f
+                       (cons (f (car hare)) out)))
+               (map1 (cdr hare) tortoise #t
+                     (cons (f (car hare)) out)))
+           (if (null? hare)
+               (reverse! out)
+               (scm-error 'wrong-type-arg "map" "Not a list: ~S"
+                          (list l) #f)))))
+    
+    ((f l1 . rest)
+     (let ((len (fold (lambda (ls len)
+                        (let ((ls-len (length+ ls)))
+                          (if len
+                              (if ls-len (min ls-len len) len)
+                              ls-len)))
+                      (length+ l1)
+                      rest)))
+       (if (not len)
+           (scm-error 'wrong-type-arg "map"
+                      "Args do not contain a proper (finite) list: ~S"
+                      (list (cons l1 rest)) #f))
+       (let mapn ((l1 l1) (rest rest) (len len) (out '()))
+         (if (zero? len)
+             (reverse! out)
+             (mapn (cdr l1) (map cdr rest) (1- len)
+                   (cons (apply f (car l1) (map car rest)) out))))))))
 
-;; Internal helper procedure.  Map `f' over the single list `ls'.
+(define for-each
-;;
+  (case-lambda
-(define map1 map)
+    ((f l)
+     (let for-each1 ((hare l) (tortoise l) (move? #f))
+       (if (pair? hare)
+           (if move?
+               (if (eq? tortoise hare)
+                   (scm-error 'wrong-type-arg "for-each" "Circular list: ~S"
+                              (list l) #f)
+                   (begin
+                     (f (car hare))
+                     (for-each1 (cdr hare) (cdr tortoise) #f)))
+               (begin
+                 (f (car hare))
+                 (for-each1 (cdr hare) tortoise #t)))
+           
+           (if (not (null? hare))
+               (scm-error 'wrong-type-arg "for-each" "Not a list: ~S"
+                          (list l) #f)))))
+    
+    ((f l1 . rest)
+     (let ((len (fold (lambda (ls len)
+                        (let ((ls-len (length+ ls)))
+                          (if len
+                              (if ls-len (min ls-len len) len)
+                              ls-len)))
+                      (length+ l1)
+                      rest)))
+       (if (not len)
+           (scm-error 'wrong-type-arg "for-each"
+                      "Args do not contain a proper (finite) list: ~S"
+                      (list (cons l1 rest)) #f))
+       (let for-eachn ((l1 l1) (rest rest) (len len))
+         (if (> len 0)
+             (begin
+               (apply f (car l1) (map car rest))
+               (for-eachn (cdr l1) (map cdr rest) (1- len)))))))))
 
 (define (append-map f clist1 . rest)
   (concatenate (apply map f clist1 rest)))
@@ -561,10 +630,10 @@ the list returned."
                (rl '()))
         (if (any1 null? l)
             (reverse! rl)
-            (let ((res (apply proc (map1 car l))))
+            (let ((res (apply proc (map car l))))
               (if res
-                  (lp (map1 cdr l) (cons res rl))
+                  (lp (map cdr l) (cons res rl))
-                  (lp (map1 cdr l) rl)))))))
+                  (lp (map cdr l) rl)))))))
 
 (define (pair-for-each f clist1 . rest)
   (if (null? rest)
@@ -579,7 +648,7 @@ the list returned."
 	(if #f #f)
 	(begin
 	  (apply f l)
-	  (lp (map1 cdr l)))))))
+	  (lp (map cdr l)))))))
 
 
 ;;; Searching
@@ -677,10 +746,10 @@ all fail the predicate PRED, and the remainder of LST."
       (let lp ((lists (cons ls lists)))
 	(cond ((any1 null? lists)
 	       #f)
-	      ((any1 null? (map1 cdr lists))
+	      ((any1 null? (map cdr lists))
-	       (apply pred (map1 car lists)))
+	       (apply pred (map car lists)))
 	      (else
-	       (or (apply pred (map1 car lists)) (lp (map1 cdr lists))))))))
+	       (or (apply pred (map car lists)) (lp (map cdr lists))))))))
 
 (define (any1 pred ls)
   (let lp ((ls ls))
@@ -697,10 +766,10 @@ all fail the predicate PRED, and the remainder of LST."
       (let lp ((lists (cons ls lists)))
 	(cond ((any1 null? lists)
 	       #t)
-	      ((any1 null? (map1 cdr lists))
+	      ((any1 null? (map cdr lists))
-	       (apply pred (map1 car lists)))
+	       (apply pred (map car lists)))
 	      (else
-	       (and (apply pred (map1 car lists)) (lp (map1 cdr lists))))))))
+	       (and (apply pred (map car lists)) (lp (map cdr lists))))))))
 
 (define (every1 pred ls)
   (let lp ((ls ls))
@@ -724,9 +793,9 @@ CLIST1 ... CLISTN, that satisfies PRED."
     (let lp ((lists (cons clist1 rest)) (i 0))
       (cond ((any1 null? lists)
 	     #f)
-	    ((apply pred (map1 car lists)) i)
+	    ((apply pred (map car lists)) i)
 	    (else
-	     (lp (map1 cdr lists) (+ i 1)))))))
+	     (lp (map cdr lists) (+ i 1)))))))
 
 ;;; Association lists
 

test-suite/tests/eval.test

@@ -1,5 +1,5 @@
 ;;;; eval.test --- tests guile's evaluator     -*- scheme -*-
-;;;; Copyright (C) 2000, 2001, 2006, 2007, 2009, 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2000, 2001, 2006, 2007, 2009, 2010, 2011 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
@@ -28,6 +28,11 @@
 (define exception:failed-match
   (cons 'syntax-error "failed to match any pattern"))
 
+(define exception:not-a-list
+  (cons 'wrong-type-arg "Not a list"))
+
+(define exception:wrong-length
+  (cons 'wrong-type-arg "wrong length"))
 
 ;;;
 ;;; miscellaneous
@@ -192,19 +197,19 @@
     (with-test-prefix "different length lists"
 
       (pass-if-exception "first list empty"
-	exception:out-of-range
+        exception:wrong-length
 	(map + '() '(1)))
 
       (pass-if-exception "second list empty"
-	exception:out-of-range
+        exception:wrong-length
 	(map + '(1) '()))
 
       (pass-if-exception "first list shorter"
-	exception:out-of-range
+	exception:wrong-length
 	(map + '(1) '(2 3)))
 
       (pass-if-exception "second list shorter"
-	exception:out-of-range
+	exception:wrong-length
 	(map + '(1 2) '(3)))
     )))
 

test-suite/tests/ports.test

@@ -486,7 +486,10 @@
                   (make-check
                    (syntax-rules (-> error eof)
                      ((_ port (proc -> error))
-                      (decoding-error? port (proc port)))
+                      (if (eq? 'substitute
+                               (port-conversion-strategy port))
+                          (eq? (proc port) #\?)
+                          (decoding-error? port (proc port))))
                      ((_ port (proc -> eof))
                       (eof-object? (proc port)))
                      ((_ port (proc -> char))
@@ -510,7 +513,8 @@
                                              ((peek-char -> e1)
                                               (read-char -> e1))
                                              expected ...))))
-                  (test-decoding-error
+
+                  (test-decoding-error*
                       (syntax-rules ()
                         ((_ sequence encoding strategy (expected ...))
                          (begin
@@ -532,56 +536,56 @@
                                       (u8-list->bytevector 'sequence))))
                               (set-port-encoding! p encoding)
                               (set-port-conversion-strategy! p strategy)
-                              (make-peek+read-checks p #f expected ...))))))))
+                              (make-peek+read-checks p #f expected
+                                                     ...)))))))
+                  (test-decoding-error
+                      (syntax-rules ()
+                        ((_ sequence encoding (expected ...))
+                         (begin
+                           (test-decoding-error* sequence encoding 'error
+                             (expected ...))
 
-    (test-decoding-error (255 65 66 67) "UTF-8" 'error
+                           ;; `escape' should behave exactly like `error'.
+                           (test-decoding-error* sequence encoding 'escape
+                             (expected ...))
+
+                           (test-decoding-error* sequence encoding 'substitute
+                             (expected ...)))))))
+
+    (test-decoding-error (255 65 66 67) "UTF-8"
       (error #\A #\B #\C eof))
 
-    (test-decoding-error (255 65 66 67) "UTF-8" 'escape
+    (test-decoding-error (255 206 187 206 188) "UTF-8"
-      ;; `escape' should behave exactly like `error'.
+      (error #\λ #\μ eof))
-      (error #\A #\B #\C eof))
 
-    (test-decoding-error (255 206 187 206 188) "UTF-8" 'substitute
+    (test-decoding-error (206 187 206) "UTF-8"
-      (#\? #\λ #\μ eof))
-
-    (test-decoding-error (206 187 206) "UTF-8" 'error
       ;; Unterminated sequence.
       (#\λ error eof))
 
-    (test-decoding-error (206 187 206) "UTF-8" 'substitute
-      ;; Unterminated sequence.
-      (#\λ #\? eof))
-
     ;; Check how ill-formed UTF-8 sequences are handled (see Table 3-7
     ;; of the "Conformance" chapter of Unicode 6.0.0.)
 
-    (test-decoding-error (#xc0 #x80 #x41) "UTF-8" 'error
+    (test-decoding-error (#xc0 #x80 #x41) "UTF-8"
       (error                ;; C0: should be in the C2..DF range
        error                ;; 80: invalid
        #\A
        eof))
 
-    (test-decoding-error (#xc0 #x80 #x41) "UTF-8" 'substitute
+    (test-decoding-error (#xc2 #x41 #x42) "UTF-8"
-      (#\?                  ;; C0: should be in the C2..DF range
-       #\?                  ;; 80: invalid
-       #\A
-       eof))
-
-    (test-decoding-error (#xc2 #x41 #x42) "UTF-8" 'error
       (error                ;; 41: should be in the 80..BF range
        #\B
        eof))
 
-    (test-decoding-error (#xe0 #x88 #x88) "UTF-8" 'error
+    (test-decoding-error (#xe0 #x88 #x88) "UTF-8"
       (error                ;; 2nd byte should be in the A0..BF range
        eof))
 
-    (test-decoding-error (#xe0 #xa0 #x41 #x42) "UTF-8" 'error
+    (test-decoding-error (#xe0 #xa0 #x41 #x42) "UTF-8"
       (error                ;; 3rd byte should be in the 80..BF range
        #\B
        eof))
 
-    (test-decoding-error (#xf0 #x88 #x88 #x88) "UTF-8" 'error
+    (test-decoding-error (#xf0 #x88 #x88 #x88) "UTF-8"
       (error                ;; 2nd byte should be in the 90..BF range
        eof))))