001: package sisc.modules.hashtable;
002:
003: import sisc.data.*;
004: import sisc.interpreter.*;
005: import sisc.nativefun.*;
006:
007: public class Primitives extends IndexedFixableProcedure {
008:
009: public static final Symbol SHASHB = Symbol
010: .intern("sisc.modules.hashtable.Messages");
011:
012: public static final HashtableBase shash(Value o) {
013: try {
014: return (HashtableBase) o;
015: } catch (ClassCastException e) {
016: typeError(SHASHB, "hashtable", o);
017: }
018: return null;
019: }
020:
021: /**
022: * The Simple procedures are purely functional procedures
023: * which do not need to access interpreter registers to execute
024: */
025: public static class Simple extends IndexedFixableProcedure {
026: public Simple() {
027: }
028:
029: Simple(int id) {
030: super (id);
031: }
032:
033: public Value apply(Value v1) throws ContinuationException {
034: switch (id) {
035: case HTQ:
036: return truth(v1 instanceof HashtableBase);
037: case HT_HASH_BY_EQ:
038: return Quantity.valueOf(System.identityHashCode(v1));
039: case HT_HASH_BY_EQV:
040: return Quantity.valueOf(v1.hashCode());
041: case HT_HASH_BY_EQUAL:
042: return Quantity.valueOf(v1.valueHashCode());
043: case HT_HASH_BY_STRING_EQ:
044: return Quantity.valueOf(string(v1).hashCode());
045: case HT_HASH_BY_STRING_CI_EQ:
046: return Quantity.valueOf(string(v1).toLowerCase()
047: .hashCode());
048: default:
049: HashtableBase h = shash(v1);
050: switch (id) {
051: case HT_TO_ALIST:
052: return h.toAList();
053: case HT_KEYS:
054: return h.keys();
055: case HT_SIZE:
056: return Quantity.valueOf(h.size());
057: case HT_THREAD_SAFEQ:
058: return truth(h instanceof SynchronizedHashtable);
059: case HT_WEAKQ:
060: return truth((h instanceof WeakHashtable)
061: || ((h instanceof SynchronizedHashtable) && ((SynchronizedHashtable) h)
062: .getDelegate() instanceof WeakHashtable));
063: case HT_EQUALSFN:
064: return h.getEqualsProc();
065: case HT_HASHFN:
066: return h.getHashProc();
067: default:
068: throwArgSizeException();
069: return VOID; //dummy
070: }
071: }
072: }
073:
074: public Value apply(Value v1, Value v2)
075: throws ContinuationException {
076: return apply(new Value[] { v1, v2 });
077: }
078:
079: public Value apply(Value v1, Value v2, Value v3)
080: throws ContinuationException {
081: return apply(new Value[] { v1, v2, v3 });
082: }
083:
084: public Value apply(Value[] v) throws ContinuationException {
085: if (id == HT_MAKE) {
086: if (v.length == 4) {
087: Procedure equalsProc = proc(v[0]);
088: Procedure hashProc = proc(v[1]);
089: HashtableBase res = truth(v[3]) ? new WeakHashtable(
090: equalsProc, hashProc)
091: : new Hashtable(equalsProc, hashProc);
092: if (truth(v[2])) {
093: res = new SynchronizedHashtable(res);
094: }
095: return res;
096: } else {
097: throwArgSizeException();
098: }
099: }
100:
101: Value def = FALSE;
102: Value res = null;
103: HashtableBase h = shash(v[0]);
104: switch (id) {
105: case HT_GET:
106: switch (v.length) {
107: case 2:
108: break;
109: case 3:
110: def = v[2];
111: break;
112: default:
113: throwArgSizeException();
114: }
115: res = h.get(v[1]);
116: break;
117: default:
118: throwArgSizeException();
119: }
120: return (res == null) ? def : res;
121: }
122: }
123:
124: /**
125: * The Complex procedures either have a side effect, or
126: * require the interpreter to execute
127: */
128: public static class Complex extends CommonIndexedProcedure {
129: public Complex() {
130: }
131:
132: Complex(int id) {
133: super (id);
134: }
135:
136: public Value apply(Value v1) throws ContinuationException {
137: HashtableBase h = shash(v1);
138: switch (id) {
139: case HT_CLEAR:
140: h.clear();
141: return VOID;
142: default:
143: throwArgSizeException();
144: }
145: return VOID; //dummy
146: }
147:
148: public Value apply(Value v1, Value v2)
149: throws ContinuationException {
150: return apply(new Value[] { v1, v2 });
151: }
152:
153: public Value apply(Value v1, Value v2, Value v3)
154: throws ContinuationException {
155: return apply(new Value[] { v1, v2, v3 });
156: }
157:
158: public Value apply(Value[] v) throws ContinuationException {
159: Value def = FALSE;
160: Value res = null;
161: HashtableBase h = shash(v[0]);
162: switch (id) {
163: case HT_PUT:
164: switch (v.length) {
165: case 3:
166: break;
167: case 4:
168: def = v[3];
169: break;
170: default:
171: throwArgSizeException();
172: }
173: res = h.put(v[1], v[2]);
174: break;
175: case HT_REMOVE:
176: switch (v.length) {
177: case 2:
178: break;
179: case 3:
180: def = v[2];
181: break;
182: default:
183: throwArgSizeException();
184: }
185: res = h.remove(v[1]);
186: break;
187: case HT_ADD_ALIST:
188: switch (v.length) {
189: case 2:
190: h.addAList(pair(v[1]));
191: return h;
192: default:
193: throwArgSizeException();
194: }
195: default:
196: throwArgSizeException();
197: }
198: return (res == null) ? def : res;
199: }
200: }
201:
202: /**
203: * The Index
204: */
205: public static class Index extends IndexedLibraryAdapter {
206:
207: public Index() {
208: define("hashtable/make", HT_MAKE);
209: define("hashtable?", HTQ);
210: define("hashtable/put!", Complex.class, HT_PUT);
211: define("hashtable/get", HT_GET);
212: define("hashtable/remove!", Complex.class, HT_REMOVE);
213: define("hashtable/clear!", Complex.class, HT_CLEAR);
214: define("hashtable/size", HT_SIZE);
215: define("hashtable->alist", HT_TO_ALIST);
216: define("hashtable/add-alist!", Complex.class, HT_ADD_ALIST);
217: define("hashtable/keys", HT_KEYS);
218: define("hashtable/thread-safe?", HT_THREAD_SAFEQ);
219: define("hashtable/weak?", HT_WEAKQ);
220: define("hashtable/equivalence-function", HT_EQUALSFN);
221: define("hashtable/hash-function", HT_HASHFN);
222: define("hash-by-eq", HT_HASH_BY_EQ);
223: define("hash-by-eqv", HT_HASH_BY_EQV);
224: define("hash-by-equal", HT_HASH_BY_EQUAL);
225: define("hash-by-string=", HT_HASH_BY_STRING_EQ);
226: define("hash-by-string-ci=", HT_HASH_BY_STRING_CI_EQ);
227: }
228:
229: public Value construct(Object context, int id) {
230: if (context == null || context == Simple.class) {
231: return new Simple(id);
232: } else
233: return new Complex(id);
234: }
235:
236: }
237:
238: protected static final int
239: //NEXT = 19,
240: HT_MAKE = 0,
241: HTQ = 4, HT_PUT = 5, HT_GET = 6,
242: HT_REMOVE = 7,
243: HT_CLEAR = 8, HT_SIZE = 9,
244: HT_TO_ALIST = 10,
245: HT_ADD_ALIST = 11, HT_KEYS = 12,
246: HT_THREAD_SAFEQ = 13,
247: HT_WEAKQ = 14, HT_HASH_BY_EQ = 1,
248: HT_HASH_BY_EQV = 2,
249: HT_HASH_BY_EQUAL = 3,
250: HT_HASH_BY_STRING_EQ = 17,
251: HT_HASH_BY_STRING_CI_EQ = 18,
252: HT_EQUALSFN = 15,
253: HT_HASHFN = 16;
254: }
255:
256: /*
257: * The contents of this file are subject to the Mozilla Public
258: * License Version 1.1 (the "License"); you may not use this file
259: * except in compliance with the License. You may obtain a copy of
260: * the License at http://www.mozilla.org/MPL/
261: *
262: * Software distributed under the License is distributed on an "AS
263: * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
264: * implied. See the License for the specific language governing
265: * rights and limitations under the License.
266: *
267: * The Original Code is the Second Interpreter of Scheme Code (SISC).
268: *
269: * The Initial Developer of the Original Code is Scott G. Miller.
270: * Portions created by Scott G. Miller are Copyright (C) 2000-2007
271: * Scott G. Miller. All Rights Reserved.
272: *
273: * Contributor(s):
274: * Matthias Radestock
275: *
276: * Alternatively, the contents of this file may be used under the
277: * terms of the GNU General Public License Version 2 or later (the
278: * "GPL"), in which case the provisions of the GPL are applicable
279: * instead of those above. If you wish to allow use of your
280: * version of this file only under the terms of the GPL and not to
281: * allow others to use your version of this file under the MPL,
282: * indicate your decision by deleting the provisions above and
283: * replace them with the notice and other provisions required by
284: * the GPL. If you do not delete the provisions above, a recipient
285: * may use your version of this file under either the MPL or the
286: * GPL.
287: */
|