X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/2de257bd0594f64e85feb2e3eddac49357cd04a8..eb7e1603ad497d0efff686e26e23af987c567721:/libguile/alist.c diff --git a/libguile/alist.c b/libguile/alist.c index 9dbf9a5a2..05eed0241 100644 --- a/libguile/alist.c +++ b/libguile/alist.c @@ -1,78 +1,43 @@ -/* Copyright (C) 1995-2000 Free Software Foundation, Inc. +/* Copyright (C) 1995, 96, 97, 98, 99, 2000, 2001 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. + * 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. * - * 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 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + */ -/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999, - gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */ -#include -#include "_scm.h" -#include "eq.h" -#include "list.h" +#include "libguile/_scm.h" +#include "libguile/eq.h" +#include "libguile/list.h" +#include "libguile/lang.h" -#include "scm_validate.h" -#include "alist.h" +#include "libguile/validate.h" +#include "libguile/alist.h" SCM_DEFINE (scm_acons, "acons", 3, 0, 0, (SCM key, SCM value, SCM alist), -"Adds a new key-value pair to @var{alist}. A new pair is -created whose car is @var{key} and whose cdr is @var{value}, and the -pair is consed onto @var{alist}, and the new list is returned. This -function is @emph{not} destructive; @var{alist} is not modified.") + "Add a new key-value pair to @var{alist}. A new pair is\n" + "created whose car is @var{key} and whose cdr is @var{value}, and the\n" + "pair is consed onto @var{alist}, and the new list is returned. This\n" + "function is @emph{not} destructive; @var{alist} is not modified.") #define FUNC_NAME s_scm_acons { - SCM pair; - SCM head; - - SCM_NEWCELL (pair); - SCM_SETCAR (pair, key); - SCM_SETCDR (pair, value); - - SCM_NEWCELL (head); - SCM_SETCAR (head, pair); - SCM_SETCDR (head, alist); - - return head; + return scm_cell (SCM_UNPACK (scm_cell (SCM_UNPACK (key), + SCM_UNPACK (value))), + SCM_UNPACK (alist)); } #undef FUNC_NAME @@ -80,14 +45,14 @@ function is @emph{not} destructive; @var{alist} is not modified.") SCM_DEFINE (scm_sloppy_assq, "sloppy-assq", 2, 0, 0, (SCM key, SCM alist), -"Behaves like @code{assq} but does not do any error checking. -Recommended only for use in Guile internals.") + "Behaves like @code{assq} but does not do any error checking.\n" + "Recommended only for use in Guile internals.") #define FUNC_NAME s_scm_sloppy_assq { for (; SCM_CONSP (alist); alist = SCM_CDR (alist)) { SCM tmp = SCM_CAR (alist); - if (SCM_CONSP (tmp) && SCM_CAR (tmp) == key) + if (SCM_CONSP (tmp) && SCM_EQ_P (SCM_CAR (tmp), key)) return tmp; } return SCM_BOOL_F; @@ -98,8 +63,8 @@ Recommended only for use in Guile internals.") SCM_DEFINE (scm_sloppy_assv, "sloppy-assv", 2, 0, 0, (SCM key, SCM alist), -"Behaves like @code{assv} but does not do any error checking. -Recommended only for use in Guile internals.") + "Behaves like @code{assv} but does not do any error checking.\n" + "Recommended only for use in Guile internals.") #define FUNC_NAME s_scm_sloppy_assv { for (; SCM_CONSP (alist); alist = SCM_CDR (alist)) @@ -116,8 +81,8 @@ Recommended only for use in Guile internals.") SCM_DEFINE (scm_sloppy_assoc, "sloppy-assoc", 2, 0, 0, (SCM key, SCM alist), -"Behaves like @code{assoc} but does not do any error checking. -Recommended only for use in Guile internals.") + "Behaves like @code{assoc} but does not do any error checking.\n" + "Recommended only for use in Guile internals.") #define FUNC_NAME s_scm_sloppy_assoc { for (; SCM_CONSP (alist); alist = SCM_CDR (alist)) @@ -136,25 +101,28 @@ Recommended only for use in Guile internals.") SCM_DEFINE (scm_assq, "assq", 2, 0, 0, (SCM key, SCM alist), -"@deffnx primitive assv key alist -@deffnx primitive assoc key alist -Fetches the entry in @var{alist} that is associated with @var{key}. To -decide whether the argument @var{key} matches a particular entry in -@var{alist}, @code{assq} compares keys with @code{eq?}, @code{assv} -uses @code{eqv?} and @code{assoc} uses @code{equal?}. If @var{key} -cannot be found in @var{alist} (according to whichever equality -predicate is in use), then @code{#f} is returned. These functions -return the entire alist entry found (i.e. both the key and the value).") + "@deffnx {Scheme Procedure} assv key alist\n" + "@deffnx {Scheme Procedure} assoc key alist\n" + "Fetch the entry in @var{alist} that is associated with @var{key}. To\n" + "decide whether the argument @var{key} matches a particular entry in\n" + "@var{alist}, @code{assq} compares keys with @code{eq?}, @code{assv}\n" + "uses @code{eqv?} and @code{assoc} uses @code{equal?}. If @var{key}\n" + "cannot be found in @var{alist} (according to whichever equality\n" + "predicate is in use), then return @code{#f}. These functions\n" + "return the entire alist entry found (i.e. both the key and the value).") #define FUNC_NAME s_scm_assq { - for (; SCM_CONSP (alist); alist = SCM_CDR (alist)) + SCM ls = alist; + for (; SCM_CONSP (ls); ls = SCM_CDR (ls)) { - SCM tmp = SCM_CAR (alist); - SCM_VALIDATE_CONS (SCM_ARG2, tmp); - if (SCM_CAR (tmp) == key) + SCM tmp = SCM_CAR (ls); + SCM_ASSERT_TYPE (SCM_CONSP (tmp), alist, SCM_ARG2, FUNC_NAME, + "association list"); + if (SCM_EQ_P (SCM_CAR (tmp), key)) return tmp; } - SCM_VALIDATE_NULL (2, alist); + SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (ls), alist, SCM_ARG2, FUNC_NAME, + "association list"); return SCM_BOOL_F; } #undef FUNC_NAME @@ -162,17 +130,20 @@ return the entire alist entry found (i.e. both the key and the value).") SCM_DEFINE (scm_assv, "assv", 2, 0, 0, (SCM key, SCM alist), -"Behaves like @code{assq} but uses @code{eqv?} for key comparison.") + "Behaves like @code{assq} but uses @code{eqv?} for key comparison.") #define FUNC_NAME s_scm_assv { - for(; SCM_CONSP (alist); alist = SCM_CDR (alist)) + SCM ls = alist; + for(; SCM_CONSP (ls); ls = SCM_CDR (ls)) { - SCM tmp = SCM_CAR (alist); - SCM_VALIDATE_CONS (SCM_ARG2, tmp); + SCM tmp = SCM_CAR (ls); + SCM_ASSERT_TYPE (SCM_CONSP (tmp), alist, SCM_ARG2, FUNC_NAME, + "association list"); if (SCM_NFALSEP (scm_eqv_p (SCM_CAR (tmp), key))) return tmp; } - SCM_VALIDATE_NULL (2, alist); + SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (ls), alist, SCM_ARG2, FUNC_NAME, + "association list"); return SCM_BOOL_F; } #undef FUNC_NAME @@ -180,17 +151,20 @@ SCM_DEFINE (scm_assv, "assv", 2, 0, 0, SCM_DEFINE (scm_assoc, "assoc", 2, 0, 0, (SCM key, SCM alist), -"Behaves like @code{assq} but uses @code{equal?} for key comparison.") + "Behaves like @code{assq} but uses @code{equal?} for key comparison.") #define FUNC_NAME s_scm_assoc { - for(; SCM_CONSP (alist); alist = SCM_CDR (alist)) + SCM ls = alist; + for(; SCM_CONSP (ls); ls = SCM_CDR (ls)) { - SCM tmp = SCM_CAR (alist); - SCM_VALIDATE_CONS (SCM_ARG2, tmp); + SCM tmp = SCM_CAR (ls); + SCM_ASSERT_TYPE (SCM_CONSP (tmp), alist, SCM_ARG2, FUNC_NAME, + "association list"); if (SCM_NFALSEP (scm_equal_p (SCM_CAR (tmp), key))) return tmp; } - SCM_VALIDATE_NULL (2, alist); + SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (ls), alist, SCM_ARG2, FUNC_NAME, + "association list"); return SCM_BOOL_F; } #undef FUNC_NAME @@ -198,20 +172,30 @@ SCM_DEFINE (scm_assoc, "assoc", 2, 0, 0, +/* Dirk:API2.0:: We should not return #f if the key was not found. In the + * current solution we can not distinguish between finding a (key . #f) pair + * and not finding the key at all. + * + * Possible alternative solutions: + * 1) Remove assq-ref from the API: assq is sufficient. + * 2) Signal an error (what error type?) if the key is not found. + * 3) provide an additional 'default' parameter. + * 3.1) The default parameter is mandatory. + * 3.2) The default parameter is optional, but if no default is given and + * the key is not found, signal an error (what error type?). + */ SCM_DEFINE (scm_assq_ref, "assq-ref", 2, 0, 0, (SCM alist, SCM key), -"@deffnx primitive assv-ref alist key -@deffnx primitive assoc-ref alist key -Like @code{assq}, @code{assv} and @code{assoc}, except that only the -value associated with @var{key} in @var{alist} is returned. These -functions are equivalent to - -@lisp -(let ((ent (@var{associator} @var{key} @var{alist}))) - (and ent (cdr ent))) -@end lisp - -where @var{associator} is one of @code{assq}, @code{assv} or @code{assoc}.") + "@deffnx {Scheme Procedure} assv-ref alist key\n" + "@deffnx {Scheme Procedure} assoc-ref alist key\n" + "Like @code{assq}, @code{assv} and @code{assoc}, except that only the\n" + "value associated with @var{key} in @var{alist} is returned. These\n" + "functions are equivalent to\n\n" + "@lisp\n" + "(let ((ent (@var{associator} @var{key} @var{alist})))\n" + " (and ent (cdr ent)))\n" + "@end lisp\n\n" + "where @var{associator} is one of @code{assq}, @code{assv} or @code{assoc}.") #define FUNC_NAME s_scm_assq_ref { SCM handle; @@ -228,7 +212,7 @@ where @var{associator} is one of @code{assq}, @code{assv} or @code{assoc}.") SCM_DEFINE (scm_assv_ref, "assv-ref", 2, 0, 0, (SCM alist, SCM key), -"Behaves like @code{assq-ref} but uses @code{eqv?} for key comparison.") + "Behaves like @code{assq-ref} but uses @code{eqv?} for key comparison.") #define FUNC_NAME s_scm_assv_ref { SCM handle; @@ -245,7 +229,7 @@ SCM_DEFINE (scm_assv_ref, "assv-ref", 2, 0, 0, SCM_DEFINE (scm_assoc_ref, "assoc-ref", 2, 0, 0, (SCM alist, SCM key), -"Behaves like @code{assq-ref} but uses @code{equal?} for key comparison.") + "Behaves like @code{assq-ref} but uses @code{equal?} for key comparison.") #define FUNC_NAME s_scm_assoc_ref { SCM handle; @@ -266,16 +250,15 @@ SCM_DEFINE (scm_assoc_ref, "assoc-ref", 2, 0, 0, SCM_DEFINE (scm_assq_set_x, "assq-set!", 3, 0, 0, (SCM alist, SCM key, SCM val), -"@deffnx primitive assv-set! alist key value -@deffnx primitive assoc-set! alist key value -Reassociate @var{key} in @var{alist} with @var{value}: find any existing -@var{alist} entry for @var{key} and associate it with the new -@var{value}. If @var{alist} does not contain an entry for @var{key}, -add a new one. Return the (possibly new) alist. - -These functions do not attempt to verify the structure of @var{alist}, -and so may cause unusual results if passed an object that is not an -association list.") + "@deffnx {Scheme Procedure} assv-set! alist key value\n" + "@deffnx {Scheme Procedure} assoc-set! alist key value\n" + "Reassociate @var{key} in @var{alist} with @var{value}: find any existing\n" + "@var{alist} entry for @var{key} and associate it with the new\n" + "@var{value}. If @var{alist} does not contain an entry for @var{key},\n" + "add a new one. Return the (possibly new) alist.\n\n" + "These functions do not attempt to verify the structure of @var{alist},\n" + "and so may cause unusual results if passed an object that is not an\n" + "association list.") #define FUNC_NAME s_scm_assq_set_x { SCM handle; @@ -293,7 +276,7 @@ association list.") SCM_DEFINE (scm_assv_set_x, "assv-set!", 3, 0, 0, (SCM alist, SCM key, SCM val), -"Behaves like @code{assq-set!} but uses @code{eqv?} for key comparison.") + "Behaves like @code{assq-set!} but uses @code{eqv?} for key comparison.") #define FUNC_NAME s_scm_assv_set_x { SCM handle; @@ -311,7 +294,7 @@ SCM_DEFINE (scm_assv_set_x, "assv-set!", 3, 0, 0, SCM_DEFINE (scm_assoc_set_x, "assoc-set!", 3, 0, 0, (SCM alist, SCM key, SCM val), -"Behaves like @code{assq-set!} but uses @code{equal?} for key comparison.") + "Behaves like @code{assq-set!} but uses @code{equal?} for key comparison.") #define FUNC_NAME s_scm_assoc_set_x { SCM handle; @@ -332,57 +315,51 @@ SCM_DEFINE (scm_assoc_set_x, "assoc-set!", 3, 0, 0, SCM_DEFINE (scm_assq_remove_x, "assq-remove!", 2, 0, 0, (SCM alist, SCM key), -"@deffnx primitive assv-remove! alist key -@deffnx primitive assoc-remove! alist key -Delete any entry in @var{alist} associated with @var{key}, and return -the resulting alist.") + "@deffnx {Scheme Procedure} assv-remove! alist key\n" + "@deffnx {Scheme Procedure} assoc-remove! alist key\n" + "Delete the first entry in @var{alist} associated with @var{key}, and return\n" + "the resulting alist.") #define FUNC_NAME s_scm_assq_remove_x { SCM handle; handle = scm_sloppy_assq (key, alist); if (SCM_CONSP (handle)) - { - return scm_delq_x (handle, alist); - } - else - return alist; + alist = scm_delq1_x (handle, alist); + + return alist; } #undef FUNC_NAME SCM_DEFINE (scm_assv_remove_x, "assv-remove!", 2, 0, 0, (SCM alist, SCM key), -"Behaves like @code{assq-remove!} but uses @code{eqv?} for key comparison.") + "Behaves like @code{assq-remove!} but uses @code{eqv?} for key comparison.") #define FUNC_NAME s_scm_assv_remove_x { SCM handle; handle = scm_sloppy_assv (key, alist); if (SCM_CONSP (handle)) - { - return scm_delv_x (handle, alist); - } - else - return alist; + alist = scm_delq1_x (handle, alist); + + return alist; } #undef FUNC_NAME SCM_DEFINE (scm_assoc_remove_x, "assoc-remove!", 2, 0, 0, (SCM alist, SCM key), -"Behaves like @code{assq-remove!} but uses @code{equal?} for key comparison.") + "Behaves like @code{assq-remove!} but uses @code{equal?} for key comparison.") #define FUNC_NAME s_scm_assoc_remove_x { SCM handle; handle = scm_sloppy_assoc (key, alist); if (SCM_CONSP (handle)) - { - return scm_delete_x (handle, alist); - } - else - return alist; + alist = scm_delq1_x (handle, alist); + + return alist; } #undef FUNC_NAME @@ -394,6 +371,12 @@ SCM_DEFINE (scm_assoc_remove_x, "assoc-remove!", 2, 0, 0, void scm_init_alist () { -#include "alist.x" +#include "libguile/alist.x" } + +/* + Local Variables: + c-file-style: "gnu" + End: +*/