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, 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. */
51 extern double floor();
61 switch (7 & (int) obj
) {
62 case 2: case 6: /* SCM_INUMP(obj) */
63 return SCM_INUM(obj
) % n
;
66 return (unsigned)(scm_downcase(SCM_ICHR(obj
))) % n
;
69 case (int) SCM_EOL
: d
= 256; break;
71 case (int) SCM_BOOL_T
: d
= 257; break;
72 case (int) SCM_BOOL_F
: d
= 258; break;
73 case (int) SCM_EOF_VAL
: d
= 259; break;
74 default: d
= 263; /* perhaps should be error */
77 default: return 263 % n
; /* perhaps should be error */
79 switch SCM_TYP7(obj
) {
80 default: return 263 % n
;
82 switch SCM_TYP16(obj
) {
84 bighash
: return SCM_INUM(scm_modulo(obj
, SCM_MAKINUM(n
)));
85 default: return 263 % n
;
89 double r
= SCM_REALPART(obj
);
91 obj
= scm_inexact_to_exact (obj
);
92 if SCM_IMP(obj
) return SCM_INUM(obj
) % n
;
96 obj
= scm_number_to_string(obj
, SCM_MAKINUM(10));
101 case scm_tc7_mb_string
:
102 case scm_tc7_substring
:
103 case scm_tc7_mb_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
:
145 return (((unsigned int) obj
) >> 1) % n
;
149 SCM_PROC(s_hashq
, "hashq", 2, 0, 0, scm_hashq
);
156 SCM_ASSERT(SCM_INUMP(n
) && 0 <= n
, n
, SCM_ARG2
, s_hashq
);
157 return SCM_MAKINUM(scm_ihashq (obj
, SCM_INUM (n
)));
170 return ((unsigned int)(scm_downcase(SCM_ICHR(obj
)))) % n
; /* downcase!?!! */
172 if (SCM_NIMP(obj
) && SCM_NUMP(obj
))
173 return (unsigned int) scm_hasher(obj
, n
, 10);
175 return ((unsigned int)obj
) % n
;
179 SCM_PROC(s_hashv
, "hashv", 2, 0, 0, scm_hashv
);
186 SCM_ASSERT(SCM_INUMP(n
) && 0 <= n
, n
, SCM_ARG2
, s_hashv
);
187 return SCM_MAKINUM(scm_ihashv (obj
, SCM_INUM (n
)));
199 return (unsigned int)scm_hasher (obj
, n
, 10);
202 SCM_PROC(s_hash
, "hash", 2, 0, 0, scm_hash
);
209 SCM_ASSERT(SCM_INUMP(n
) && 0 <= n
, n
, SCM_ARG2
, s_hash
);
210 return SCM_MAKINUM(scm_ihash(obj
, SCM_INUM(n
)));