1 /* Copyright (C) 1995,1996,1997 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, Inc., 59 Temple Place, Suite 330,
16 * Boston, MA 02111-1307 USA
18 * As a special exception, the Free Software Foundation gives permission
19 * for additional uses of the text contained in its release of GUILE.
21 * The exception is that, if you link the GUILE library with other files
22 * to produce an executable, this does not by itself cause the
23 * resulting executable to be covered by the GNU General Public License.
24 * Your use of that executable is in no way restricted on account of
25 * linking the GUILE library code into it.
27 * This exception does not however invalidate any other reasons why
28 * the executable file might be covered by the GNU General Public License.
30 * This exception applies only to the code released by the
31 * Free Software Foundation under the name GUILE. If you copy
32 * code from other Free Software Foundation releases into a copy of
33 * GUILE, as the General Public License permits, the exception does
34 * not apply to the code that you add in this way. To avoid misleading
35 * anyone as to the status of such modified files, you must delete
36 * this exception notice from them.
38 * If you write modifications of your own for GUILE, it is your choice
39 * whether to permit this exception to apply to your modifications.
40 * If you do not wish that, delete this exception notice. */
42 /* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
43 gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
51 #include "scm_validate.h"
56 extern double floor();
61 scm_hasher(SCM obj
, unsigned long n
, scm_sizet d
)
63 switch (7 & (int) obj
) {
64 case 2: case 6: /* SCM_INUMP(obj) */
65 return SCM_INUM(obj
) % n
;
68 return (unsigned)(scm_downcase(SCM_ICHR(obj
))) % n
;
71 case (int) SCM_EOL
: d
= 256; break;
73 case (int) SCM_BOOL_T
: d
= 257; break;
74 case (int) SCM_BOOL_F
: d
= 258; break;
75 case (int) SCM_EOF_VAL
: d
= 259; break;
76 default: d
= 263; /* perhaps should be error */
79 default: return 263 % n
; /* perhaps should be error */
81 switch SCM_TYP7(obj
) {
82 default: return 263 % n
;
84 switch SCM_TYP16(obj
) {
86 bighash
: return SCM_INUM(scm_modulo(obj
, SCM_MAKINUM(n
)));
87 default: return 263 % n
;
91 double r
= SCM_REALPART(obj
);
93 obj
= scm_inexact_to_exact (obj
);
94 if SCM_IMP(obj
) return SCM_INUM(obj
) % n
;
98 obj
= scm_number_to_string(obj
, SCM_MAKINUM(10));
101 case scm_tcs_symbols
:
103 case scm_tc7_substring
:
104 return scm_strhash(SCM_ROUCHARS(obj
), (scm_sizet
) SCM_ROLENGTH(obj
), n
);
108 scm_sizet len
= SCM_LENGTH(obj
);
109 SCM
*data
= SCM_VELTS(obj
);
114 while (i
--) h
= ((h
<<8) + (scm_hasher(data
[h
% len
], n
, 2))) % n
;
120 unsigned long h
= (n
)-1;
121 while (i
--) h
= ((h
<<8) + (scm_hasher(data
[i
], n
, d
/len
))) % n
;
125 case scm_tcs_cons_imcar
: case scm_tcs_cons_nimcar
:
126 if (d
) return (scm_hasher(SCM_CAR(obj
), n
, d
/2)+scm_hasher(SCM_CDR(obj
), n
, d
/2)) % n
;
129 return ((SCM_RDNG
& SCM_CAR(obj
)) ? 260 : 261) % n
;
130 case scm_tcs_closures
: case scm_tc7_contin
: case scm_tcs_subrs
:
141 scm_ihashq (SCM obj
, unsigned int n
)
143 return (((unsigned int) obj
) >> 1) % n
;
147 SCM_DEFINE (scm_hashq
, "hashq", 2, 0, 0,
149 "@deffnx primitive hashv key size
150 @deffnx primitive hash key size
151 Default hash functions for Guile hash tables. @var{key} is the
152 object to be hashed, and @var{size} is the size of the target hash
153 table. Each function returns an integer in the range 0 to
155 #define FUNC_NAME s_scm_hashq
157 SCM_VALIDATE_INUM_MIN (2,n
,0);
158 return SCM_MAKINUM(scm_ihashq (obj
, SCM_INUM (n
)));
167 scm_ihashv (SCM obj
, unsigned int n
)
170 return ((unsigned int)(scm_downcase(SCM_ICHR(obj
)))) % n
; /* downcase!?!! */
173 return (unsigned int) scm_hasher(obj
, n
, 10);
175 return ((unsigned int)obj
) % n
;
179 SCM_DEFINE (scm_hashv
, "hashv", 2, 0, 0,
182 #define FUNC_NAME s_scm_hashv
184 SCM_VALIDATE_INUM_MIN (2,n
,0);
185 return SCM_MAKINUM(scm_ihashv (obj
, SCM_INUM (n
)));
194 scm_ihash (SCM obj
, unsigned int n
)
196 return (unsigned int)scm_hasher (obj
, n
, 10);
199 SCM_DEFINE (scm_hash
, "hash", 2, 0, 0,
202 #define FUNC_NAME s_scm_hash
204 SCM_VALIDATE_INUM_MIN (2,n
,0);
205 return SCM_MAKINUM(scm_ihash(obj
, SCM_INUM(n
)));