3 ;;;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
5 ;;;; This program is free software; you can redistribute it and/or modify
6 ;;;; it under the terms of the GNU General Public License as published by
7 ;;;; the Free Software Foundation; either version 2, or (at your option)
8 ;;;; any later version.
10 ;;;; This program is distributed in the hope that it will be useful,
11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 ;;;; GNU General Public License for more details.
15 ;;;; You should have received a copy of the GNU General Public License
16 ;;;; along with this software; see the file COPYING. If not, write to
17 ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
18 ;;;; Boston, MA 02111-1307 USA
22 (define-module #/ice-9/hcons)
25 ;;; {Eq? hash-consing}
27 ;;; A hash conser maintains a private universe of pairs s.t. if
28 ;;; two cons calls pass eq? arguments, the pairs returned are eq?.
30 ;;; A hash conser does not contribute life to the pairs it returns.
33 (define-public (hashq-cons-hash pair n)
34 (modulo (logxor (hashq (car pair) 4194303)
35 (hashq (cdr pair) 4194303))
38 (define-public (hashq-cons-assoc key l)
39 (and l (or (and (pair? l)
42 (eq? (car key) (caaar l))
43 (eq? (cdr key) (cdaar l))
45 (hashq-cons-assoc key (cdr l)))))
47 (define-public (hashq-cons-get-handle table key)
48 (hashx-get-handle hashq-cons-hash hashq-cons-assoc table key #f))
50 (define-public (hashq-cons-create-handle! table key init)
51 (hashx-create-handle! hashq-cons-hash hashq-cons-assoc table key init))
53 (define-public (hashq-cons-ref table key)
54 (hashx-ref hashq-cons-hash hashq-cons-assoc table key #f))
56 (define-public (hashq-cons-set! table key val)
57 (hashx-set! hashq-cons-hash hashq-cons-assoc table key val))
59 (define-public (hashq-cons table a d)
60 (car (hashq-cons-create-handle! table (cons a d) #f)))
62 (define-public (hashq-conser hash-tab-or-size)
63 (let ((table (if (vector? hash-tab-or-size)
65 (make-doubly-weak-hash-table hash-tab-or-size))))
66 (lambda (a d) (hashq-cons table a d))))
71 (define-public (make-gc-buffer n)
72 (let ((ring (make-list n #f)))
76 (set! ring (cdr ring))