add assembly intermediate language
[bpt/guile.git] / libguile / alist.c
index a3cdde6..ca55b08 100644 (file)
@@ -1,52 +1,33 @@
-/* Copyright (C) 1995, 96, 97, 98, 99, 2000, 2001 Free Software Foundation, Inc.
+/* Copyright (C) 1995, 96, 97, 98, 99, 2000, 2001, 2004, 2006, 2008 Free Software Foundation, Inc.
  * 
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2, 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 General Public License for more details.
- * 
- * You should have received a copy of the GNU General Public License
- * along with this software; see the file COPYING.  If not, write to
- * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
- * Boston, MA 02111-1307 USA
- *
- * As a special exception, the Free Software Foundation gives permission
- * for additional uses of the text contained in its release of GUILE.
- *
- * The exception is that, if you link the GUILE library with other files
- * to produce an executable, this does not by itself cause the
- * resulting executable to be covered by the GNU General Public License.
- * Your use of that executable is in no way restricted on account of
- * linking the GUILE library code into it.
- *
- * This exception does not however invalidate any other reasons why
- * the executable file might be covered by the GNU General Public License.
+ * This library 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 2.1 of the License, or (at your option) any later version.
  *
- * This exception applies only to the code released by the
- * Free Software Foundation under the name GUILE.  If you copy
- * code from other Free Software Foundation releases into a copy of
- * GUILE, as the General Public License permits, the exception does
- * not apply to the code that you add in this way.  To avoid misleading
- * anyone as to the status of such modified files, you must delete
- * this exception notice from them.
+ * This library 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.
  *
- * If you write modifications of your own for GUILE, it is your choice
- * whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice.  */
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ */
 
 
 \f
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
 #include "libguile/_scm.h"
 #include "libguile/eq.h"
 #include "libguile/list.h"
 #include "libguile/lang.h"
 
 #include "libguile/validate.h"
+#include "libguile/pairs.h"
 #include "libguile/alist.h"
 
 \f
@@ -59,9 +40,9 @@ SCM_DEFINE (scm_acons, "acons", 3, 0, 0,
            "function is @emph{not} destructive; @var{alist} is not modified.")
 #define FUNC_NAME s_scm_acons
 {
-  return scm_alloc_cell (SCM_UNPACK (scm_alloc_cell (SCM_UNPACK (key),
-                                                    SCM_UNPACK (value))),
-                        SCM_UNPACK (alist));
+  return scm_cell (SCM_UNPACK (scm_cell (SCM_UNPACK (key),
+                                        SCM_UNPACK (value))),
+                  SCM_UNPACK (alist));
 }
 #undef FUNC_NAME
 
@@ -73,10 +54,10 @@ SCM_DEFINE (scm_sloppy_assq, "sloppy-assq", 2, 0, 0,
            "Recommended only for use in Guile internals.")
 #define FUNC_NAME s_scm_sloppy_assq
 {
-  for (; SCM_CONSP (alist); alist = SCM_CDR (alist))
+  for (; scm_is_pair (alist); alist = SCM_CDR (alist))
     {
       SCM tmp = SCM_CAR (alist);
-      if (SCM_CONSP (tmp) && SCM_EQ_P (SCM_CAR (tmp), key))
+      if (scm_is_pair (tmp) && scm_is_eq (SCM_CAR (tmp), key))
        return tmp;
     }
   return SCM_BOOL_F;
@@ -91,11 +72,11 @@ SCM_DEFINE (scm_sloppy_assv, "sloppy-assv", 2, 0, 0,
            "Recommended only for use in Guile internals.")
 #define FUNC_NAME s_scm_sloppy_assv
 {
-  for (; SCM_CONSP (alist); alist = SCM_CDR (alist))
+  for (; scm_is_pair (alist); alist = SCM_CDR (alist))
     {
       SCM tmp = SCM_CAR (alist);
-      if (SCM_CONSP (tmp)
-         && SCM_NFALSEP (scm_eqv_p (SCM_CAR (tmp), key)))
+      if (scm_is_pair (tmp)
+         && scm_is_true (scm_eqv_p (SCM_CAR (tmp), key)))
        return tmp;
     }
   return SCM_BOOL_F;
@@ -109,11 +90,11 @@ SCM_DEFINE (scm_sloppy_assoc, "sloppy-assoc", 2, 0, 0,
            "Recommended only for use in Guile internals.")
 #define FUNC_NAME s_scm_sloppy_assoc
 {
-  for (; SCM_CONSP (alist); alist = SCM_CDR (alist))
+  for (; scm_is_pair (alist); alist = SCM_CDR (alist))
     {
       SCM tmp = SCM_CAR (alist);
-      if (SCM_CONSP (tmp)
-         && SCM_NFALSEP (scm_equal_p (SCM_CAR (tmp), key)))
+      if (scm_is_pair (tmp)
+         && scm_is_true (scm_equal_p (SCM_CAR (tmp), key)))
        return tmp;
     }
   return SCM_BOOL_F;
@@ -137,12 +118,12 @@ SCM_DEFINE (scm_assq, "assq", 2, 0, 0,
 #define FUNC_NAME s_scm_assq
 {
   SCM ls = alist;
-  for (; SCM_CONSP (ls); ls = SCM_CDR (ls)) 
+  for(; scm_is_pair (ls); ls = SCM_CDR (ls)) 
     {
       SCM tmp = SCM_CAR (ls);
-      SCM_ASSERT_TYPE (SCM_CONSP (tmp), alist, SCM_ARG2, FUNC_NAME,
+      SCM_ASSERT_TYPE (scm_is_pair (tmp), alist, SCM_ARG2, FUNC_NAME,
                       "association list");
-      if (SCM_EQ_P (SCM_CAR (tmp), key))
+      if (scm_is_eq (SCM_CAR (tmp), key))
        return tmp;
     }
   SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (ls), alist, SCM_ARG2, FUNC_NAME,
@@ -158,12 +139,12 @@ SCM_DEFINE (scm_assv, "assv", 2, 0, 0,
 #define FUNC_NAME s_scm_assv
 {
   SCM ls = alist;
-  for(; SCM_CONSP (ls); ls = SCM_CDR (ls)) 
+  for(; scm_is_pair (ls); ls = SCM_CDR (ls)) 
     {
       SCM tmp = SCM_CAR (ls);
-      SCM_ASSERT_TYPE (SCM_CONSP (tmp), alist, SCM_ARG2, FUNC_NAME,
+      SCM_ASSERT_TYPE (scm_is_pair (tmp), alist, SCM_ARG2, FUNC_NAME,
                       "association list");
-      if (SCM_NFALSEP (scm_eqv_p (SCM_CAR (tmp), key)))
+      if (scm_is_true (scm_eqv_p (SCM_CAR (tmp), key)))
        return tmp;
     }
   SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (ls), alist, SCM_ARG2, FUNC_NAME,
@@ -179,12 +160,12 @@ SCM_DEFINE (scm_assoc, "assoc", 2, 0, 0,
 #define FUNC_NAME s_scm_assoc
 {
   SCM ls = alist;
-  for(; SCM_CONSP (ls); ls = SCM_CDR (ls)) 
+  for(; scm_is_pair (ls); ls = SCM_CDR (ls)) 
     {
       SCM tmp = SCM_CAR (ls);
-      SCM_ASSERT_TYPE (SCM_CONSP (tmp), alist, SCM_ARG2, FUNC_NAME,
+      SCM_ASSERT_TYPE (scm_is_pair (tmp), alist, SCM_ARG2, FUNC_NAME,
                       "association list");
-      if (SCM_NFALSEP (scm_equal_p (SCM_CAR (tmp), key)))
+      if (scm_is_true (scm_equal_p (SCM_CAR (tmp), key)))
        return tmp;
     }
   SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (ls), alist, SCM_ARG2, FUNC_NAME,
@@ -225,7 +206,7 @@ SCM_DEFINE (scm_assq_ref, "assq-ref", 2, 0, 0,
   SCM handle;
 
   handle = scm_sloppy_assq (key, alist);
-  if (SCM_CONSP (handle))
+  if (scm_is_pair (handle))
     {
       return SCM_CDR (handle);
     }
@@ -242,7 +223,7 @@ SCM_DEFINE (scm_assv_ref, "assv-ref", 2, 0, 0,
   SCM handle;
 
   handle = scm_sloppy_assv (key, alist);
-  if (SCM_CONSP (handle))
+  if (scm_is_pair (handle))
     {
       return SCM_CDR (handle);
     }
@@ -259,7 +240,7 @@ SCM_DEFINE (scm_assoc_ref, "assoc-ref", 2, 0, 0,
   SCM handle;
 
   handle = scm_sloppy_assoc (key, alist);
-  if (SCM_CONSP (handle))
+  if (scm_is_pair (handle))
     {
       return SCM_CDR (handle);
     }
@@ -288,7 +269,7 @@ SCM_DEFINE (scm_assq_set_x, "assq-set!", 3, 0, 0,
   SCM handle;
 
   handle = scm_sloppy_assq (key, alist);
-  if (SCM_CONSP (handle))
+  if (scm_is_pair (handle))
     {
       SCM_SETCDR (handle, val);
       return alist;
@@ -306,7 +287,7 @@ SCM_DEFINE (scm_assv_set_x, "assv-set!", 3, 0, 0,
   SCM handle;
 
   handle = scm_sloppy_assv (key, alist);
-  if (SCM_CONSP (handle))
+  if (scm_is_pair (handle))
     {
       SCM_SETCDR (handle, val);
       return alist;
@@ -324,7 +305,7 @@ SCM_DEFINE (scm_assoc_set_x, "assoc-set!", 3, 0, 0,
   SCM handle;
 
   handle = scm_sloppy_assoc (key, alist);
-  if (SCM_CONSP (handle))
+  if (scm_is_pair (handle))
     {
       SCM_SETCDR (handle, val);
       return alist;
@@ -348,7 +329,7 @@ SCM_DEFINE (scm_assq_remove_x, "assq-remove!", 2, 0, 0,
   SCM handle;
 
   handle = scm_sloppy_assq (key, alist);
-  if (SCM_CONSP (handle))
+  if (scm_is_pair (handle))
     alist = scm_delq1_x (handle, alist);
 
   return alist;
@@ -364,7 +345,7 @@ SCM_DEFINE (scm_assv_remove_x, "assv-remove!", 2, 0, 0,
   SCM handle;
 
   handle = scm_sloppy_assv (key, alist);
-  if (SCM_CONSP (handle))
+  if (scm_is_pair (handle))
     alist = scm_delq1_x (handle, alist);
 
   return alist;
@@ -380,7 +361,7 @@ SCM_DEFINE (scm_assoc_remove_x, "assoc-remove!", 2, 0, 0,
   SCM handle;
 
   handle = scm_sloppy_assoc (key, alist);
-  if (SCM_CONSP (handle))
+  if (scm_is_pair (handle))
     alist = scm_delq1_x (handle, alist);
 
   return alist;
@@ -395,9 +376,7 @@ SCM_DEFINE (scm_assoc_remove_x, "assoc-remove!", 2, 0, 0,
 void
 scm_init_alist ()
 {
-#ifndef SCM_MAGIC_SNARFER
 #include "libguile/alist.x"
-#endif
 }