1 /* Copyright (C) 1995,1996 Free Software Foundation, Inc.
3 * This program is free software; you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation; either version 2, or (at your option)
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with this software; see the file COPYING. If not, write to
15 * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
17 * As a special exception, the Free Software Foundation gives permission
18 * for additional uses of the text contained in its release of GUILE.
20 * The exception is that, if you link the GUILE library with other files
21 * to produce an executable, this does not by itself cause the
22 * resulting executable to be covered by the GNU General Public License.
23 * Your use of that executable is in no way restricted on account of
24 * linking the GUILE library code into it.
26 * This exception does not however invalidate any other reasons why
27 * the executable file might be covered by the GNU General Public License.
29 * This exception applies only to the code released by the
30 * Free Software Foundation under the name GUILE. If you copy
31 * code from other Free Software Foundation releases into a copy of
32 * GUILE, as the General Public License permits, the exception does
33 * not apply to the code that you add in this way. To avoid misleading
34 * anyone as to the status of such modified files, you must delete
35 * this exception notice from them.
37 * If you write modifications of your own for GUILE, it is your choice
38 * whether to permit this exception to apply to your modifications.
39 * If you do not wish that, delete this exception notice.
54 scm_hash_fn_get_handle (table
, obj
, hash_fn
, assoc_fn
, closure
)
57 unsigned int (*hash_fn
)();
64 SCM_ASSERT (SCM_NIMP (table
) && SCM_VECTORP (table
), table
, SCM_ARG1
, "hash_fn_get_handle");
65 if (SCM_LENGTH (table
) == 0)
67 k
= hash_fn (obj
, SCM_LENGTH (table
), closure
);
68 SCM_ASSERT ((0 <= k
) && (k
< SCM_LENGTH (table
)),
71 "hash_fn_get_handle");
72 h
= assoc_fn (obj
, SCM_VELTS (table
)[k
], closure
);
79 scm_hash_fn_create_handle_x (table
, obj
, init
, hash_fn
, assoc_fn
, closure
)
83 unsigned int (*hash_fn
)();
90 SCM_ASSERT (SCM_NIMP (table
) && SCM_VECTORP (table
), table
, SCM_ARG1
, "hash_fn_create_handle_x");
91 if (SCM_LENGTH (table
) == 0)
93 k
= hash_fn (obj
, SCM_LENGTH (table
), closure
);
94 SCM_ASSERT ((0 <= k
) && (k
< SCM_LENGTH (table
)),
97 "hash_fn_create_handle_x");
99 it
= assoc_fn (obj
, SCM_VELTS (table
)[k
], closure
);
107 old_bucket
= SCM_VELTS (table
)[k
];
108 new_bucket
= scm_acons (obj
, init
, old_bucket
);
109 SCM_VELTS(table
)[k
] = new_bucket
;
111 return SCM_CAR (new_bucket
);
119 scm_hash_fn_ref (table
, obj
, dflt
, hash_fn
, assoc_fn
, closure
)
123 unsigned int (*hash_fn
)();
129 it
= scm_hash_fn_get_handle (table
, obj
, hash_fn
, assoc_fn
, closure
);
140 scm_hash_fn_set_x (table
, obj
, val
, hash_fn
, assoc_fn
, closure
)
144 unsigned int (*hash_fn
)();
150 it
= scm_hash_fn_create_handle_x (table
, obj
, SCM_BOOL_F
, hash_fn
, assoc_fn
, closure
);
151 SCM_SETCDR (it
, val
);
160 scm_hash_fn_remove_x (table
, obj
, hash_fn
, assoc_fn
, delete_fn
, closure
)
163 unsigned int (*hash_fn
)();
171 SCM_ASSERT (SCM_NIMP (table
) && SCM_VECTORP (table
), table
, SCM_ARG1
, "hash_fn_remove_x");
172 if (SCM_LENGTH (table
) == 0)
174 k
= hash_fn (obj
, SCM_LENGTH (table
), closure
);
175 SCM_ASSERT ((0 <= k
) && (k
< SCM_LENGTH (table
)),
179 h
= assoc_fn (obj
, SCM_VELTS (table
)[k
], closure
);
180 SCM_VELTS(table
)[k
] = delete_fn (h
, SCM_VELTS(table
)[k
]);
187 SCM_PROC (s_hashq_get_handle
, "hashq-get-handle", 2, 0, 0, scm_hashq_get_handle
);
190 scm_hashq_get_handle (table
, obj
)
194 return scm_hash_fn_get_handle (table
, obj
, scm_ihashq
, scm_sloppy_assq
, 0);
198 SCM_PROC (s_hashq_create_handle_x
, "hashq-create-handle!", 3, 0, 0, scm_hashq_create_handle_x
);
201 scm_hashq_create_handle_x (table
, obj
, init
)
206 return scm_hash_fn_create_handle_x (table
, obj
, init
, scm_ihashq
, scm_sloppy_assq
, 0);
210 SCM_PROC (s_hashq_ref
, "hashq-ref", 2, 1, 0, scm_hashq_ref
);
213 scm_hashq_ref (table
, obj
, dflt
)
218 if (dflt
== SCM_UNDEFINED
)
220 return scm_hash_fn_ref (table
, obj
, dflt
, scm_ihashq
, scm_sloppy_assq
, 0);
225 SCM_PROC (s_hashq_set_x
, "hashq-set!", 3, 0, 0, scm_hashq_set_x
);
228 scm_hashq_set_x (table
, obj
, val
)
233 return scm_hash_fn_set_x (table
, obj
, val
, scm_ihashq
, scm_sloppy_assq
, 0);
238 SCM_PROC (s_hashq_remove_x
, "hashq-remove!", 2, 0, 0, scm_hashq_remove_x
);
241 scm_hashq_remove_x (table
, obj
)
245 return scm_hash_fn_remove_x (table
, obj
, scm_ihashq
, scm_sloppy_assq
, scm_delq_x
, 0);
251 SCM_PROC (s_hashv_get_handle
, "hashv-get-handle", 2, 0, 0, scm_hashv_get_handle
);
254 scm_hashv_get_handle (table
, obj
)
258 return scm_hash_fn_get_handle (table
, obj
, scm_ihashv
, scm_sloppy_assv
, 0);
262 SCM_PROC (s_hashv_create_handle_x
, "hashv-create-handle!", 3, 0, 0, scm_hashv_create_handle_x
);
265 scm_hashv_create_handle_x (table
, obj
, init
)
270 return scm_hash_fn_create_handle_x (table
, obj
, init
, scm_ihashv
, scm_sloppy_assv
, 0);
274 SCM_PROC (s_hashv_ref
, "hashv-ref", 2, 1, 0, scm_hashv_ref
);
277 scm_hashv_ref (table
, obj
, dflt
)
282 if (dflt
== SCM_UNDEFINED
)
284 return scm_hash_fn_ref (table
, obj
, dflt
, scm_ihashv
, scm_sloppy_assv
, 0);
289 SCM_PROC (s_hashv_set_x
, "hashv-set!", 3, 0, 0, scm_hashv_set_x
);
292 scm_hashv_set_x (table
, obj
, val
)
297 return scm_hash_fn_set_x (table
, obj
, val
, scm_ihashv
, scm_sloppy_assv
, 0);
301 SCM_PROC (s_hashv_remove_x
, "hashv-remove!", 2, 0, 0, scm_hashv_remove_x
);
304 scm_hashv_remove_x (table
, obj
)
308 return scm_hash_fn_remove_x (table
, obj
, scm_ihashv
, scm_sloppy_assv
, scm_delv_x
, 0);
313 SCM_PROC (s_hash_get_handle
, "hash-get-handle", 2, 0, 0, scm_hash_get_handle
);
316 scm_hash_get_handle (table
, obj
)
320 return scm_hash_fn_get_handle (table
, obj
, scm_ihash
, scm_sloppy_assoc
, 0);
324 SCM_PROC (s_hash_create_handle_x
, "hash-create-handle!", 3, 0, 0, scm_hash_create_handle_x
);
327 scm_hash_create_handle_x (table
, obj
, init
)
332 return scm_hash_fn_create_handle_x (table
, obj
, init
, scm_ihash
, scm_sloppy_assoc
, 0);
336 SCM_PROC (s_hash_ref
, "hash-ref", 2, 1, 0, scm_hash_ref
);
339 scm_hash_ref (table
, obj
, dflt
)
344 if (dflt
== SCM_UNDEFINED
)
346 return scm_hash_fn_ref (table
, obj
, dflt
, scm_ihash
, scm_sloppy_assoc
, 0);
351 SCM_PROC (s_hash_set_x
, "hash-set!", 3, 0, 0, scm_hash_set_x
);
354 scm_hash_set_x (table
, obj
, val
)
359 return scm_hash_fn_set_x (table
, obj
, val
, scm_ihash
, scm_sloppy_assoc
, 0);
364 SCM_PROC (s_hash_remove_x
, "hash-remove!", 2, 0, 0, scm_hash_remove_x
);
367 scm_hash_remove_x (table
, obj
)
371 return scm_hash_fn_remove_x (table
, obj
, scm_ihash
, scm_sloppy_assoc
, scm_delete_x
, 0);
377 struct scm_ihashx_closure
386 static unsigned int scm_ihashx
SCM_P ((SCM obj
, unsigned int n
, struct scm_ihashx_closure
* closure
));
389 scm_ihashx (obj
, n
, closure
)
392 struct scm_ihashx_closure
* closure
;
396 answer
= scm_apply (closure
->hash
,
397 scm_listify (obj
, scm_ulong2num ((unsigned long)n
), SCM_UNDEFINED
),
400 return SCM_INUM (answer
);
405 static SCM scm_sloppy_assx
SCM_P ((SCM obj
, SCM alist
, struct scm_ihashx_closure
* closure
));
408 scm_sloppy_assx (obj
, alist
, closure
)
411 struct scm_ihashx_closure
* closure
;
415 answer
= scm_apply (closure
->assoc
,
416 scm_listify (obj
, alist
, SCM_UNDEFINED
),
425 static SCM scm_delx_x
SCM_P ((SCM obj
, SCM alist
, struct scm_ihashx_closure
* closure
));
428 scm_delx_x (obj
, alist
, closure
)
431 struct scm_ihashx_closure
* closure
;
435 answer
= scm_apply (closure
->delete,
436 scm_listify (obj
, alist
, SCM_UNDEFINED
),
444 SCM_PROC (s_hashx_get_handle
, "hashx-get-handle", 4, 0, 0, scm_hashx_get_handle
);
447 scm_hashx_get_handle (hash
, assoc
, table
, obj
)
453 struct scm_ihashx_closure closure
;
455 closure
.assoc
= assoc
;
456 return scm_hash_fn_get_handle (table
, obj
, scm_ihashx
, scm_sloppy_assx
, (void *)&closure
);
460 SCM_PROC (s_hashx_create_handle_x
, "hashx-create-handle!", 5, 0, 0, scm_hashx_create_handle_x
);
463 scm_hashx_create_handle_x (hash
, assoc
, table
, obj
, init
)
470 struct scm_ihashx_closure closure
;
472 closure
.assoc
= assoc
;
473 return scm_hash_fn_create_handle_x (table
, obj
, init
, scm_ihashx
, scm_sloppy_assx
, (void *)&closure
);
478 SCM_PROC (s_hashx_ref
, "hashx-ref", 4, 1, 0, scm_hashx_ref
);
481 scm_hashx_ref (hash
, assoc
, table
, obj
, dflt
)
488 struct scm_ihashx_closure closure
;
489 if (dflt
== SCM_UNDEFINED
)
492 closure
.assoc
= assoc
;
493 return scm_hash_fn_ref (table
, obj
, dflt
, scm_ihashx
, scm_sloppy_assx
, (void *)&closure
);
499 SCM_PROC (s_hashx_set_x
, "hashx-set!", 5, 0, 0, scm_hashx_set_x
);
502 scm_hashx_set_x (hash
, assoc
, table
, obj
, val
)
509 struct scm_ihashx_closure closure
;
511 closure
.assoc
= assoc
;
512 return scm_hash_fn_set_x (table
, obj
, val
, scm_ihashx
, scm_sloppy_assx
, (void *)&closure
);
518 scm_hashx_remove_x (hash
, assoc
, delete, table
, obj
)
525 struct scm_ihashx_closure closure
;
527 closure
.assoc
= assoc
;
528 closure
.delete = delete;
529 return scm_hash_fn_remove_x (table
, obj
, scm_ihashx
, scm_sloppy_assx
, scm_delx_x
, 0);