Skip to main content

scheme_rs/
hashtables.rs

1//! Scheme compatible hashtables
2
3use indexmap::IndexSet;
4use parking_lot::RwLock;
5use std::{
6    collections::HashSet,
7    fmt,
8    hash::{DefaultHasher, Hash, Hasher},
9};
10
11use crate::{
12    exceptions::Exception,
13    gc::{Gc, Trace},
14    proc::{ContBarrier, Procedure},
15    registry::bridge,
16    strings::WideString,
17    symbols::Symbol,
18    value::{Expect1, Value, ValueType},
19};
20
21#[derive(Clone, Trace)]
22struct TableEntry {
23    key: Value,
24    val: Value,
25    hash: u64,
26}
27
28impl TableEntry {
29    fn get_hash(&self) -> u64 {
30        self.hash
31    }
32}
33
34#[derive(Trace)]
35pub(crate) struct HashTableInner {
36    /// Inner table of values. This uses an inner RwLock to ensure that we can
37    /// access eq and hash even if the table is locked.
38    ///
39    /// We can't use the std library hashmap since we don't want to bundle the
40    /// eq and hash functions with the key Value, so we use hashbrown's
41    /// HashTable
42    table: RwLock<hashbrown::HashTable<TableEntry>>,
43    /// Equivalence function.
44    eq: Procedure,
45    /// Hash function.
46    hash: Procedure,
47    /// Whether or not the hashtable is mutable
48    mutable: bool,
49}
50
51impl HashTableInner {
52    pub fn size(&self) -> usize {
53        self.table.read().len()
54    }
55
56    #[cfg(not(feature = "async"))]
57    pub fn hash(&self, val: Value) -> Result<u64, Exception> {
58        self.hash.call(&[val], &mut ContBarrier::new())?.expect1()
59    }
60
61    #[cfg(feature = "async")]
62    pub fn hash(&self, val: Value) -> Result<u64, Exception> {
63        self.hash
64            .call_sync(&[val], &mut ContBarrier::new())?
65            .expect1()
66    }
67
68    #[cfg(not(feature = "async"))]
69    pub fn eq(&self, lhs: Value, rhs: Value) -> Result<bool, Exception> {
70        self.eq
71            .call(&[lhs, rhs], &mut ContBarrier::new())?
72            .expect1()
73    }
74
75    #[cfg(feature = "async")]
76    pub fn eq(&self, lhs: Value, rhs: Value) -> Result<bool, Exception> {
77        self.eq
78            .call_sync(&[lhs, rhs], &mut ContBarrier::new())?
79            .expect1()
80    }
81
82    /// Equivalent to `hashtable-ref`
83    pub fn get(&self, key: &Value, default: &Value) -> Result<Value, Exception> {
84        let table = self.table.read();
85        let hash = self.hash(key.clone())?;
86        for entry in table.iter_hash(hash) {
87            if entry.hash == hash && self.eq(key.clone(), entry.key.clone())? {
88                return Ok(entry.val.clone());
89            }
90        }
91        Ok(default.clone())
92    }
93
94    pub fn set(&self, key: &Value, val: &Value) -> Result<(), Exception> {
95        if !self.mutable {
96            return Err(Exception::error("hashtable is immutable"));
97        }
98
99        let mut table = self.table.write();
100        let hash = self.hash(key.clone())?;
101        for entry in table.iter_hash_mut(hash) {
102            if entry.hash == hash && self.eq(key.clone(), entry.key.clone())? {
103                entry.val = val.clone();
104                return Ok(());
105            }
106        }
107
108        // Insert the new entry, guaranteed to be unique.
109        table.insert_unique(
110            hash,
111            TableEntry {
112                key: key.clone(),
113                val: val.clone(),
114                hash,
115            },
116            TableEntry::get_hash,
117        );
118
119        Ok(())
120    }
121
122    pub fn delete(&self, key: &Value) -> Result<(), Exception> {
123        if !self.mutable {
124            return Err(Exception::error("hashtable is immutable"));
125        }
126
127        let mut table = self.table.write();
128        let hash = self.hash(key.clone())?;
129        let buckets = table.iter_hash_buckets(hash).collect::<Vec<_>>();
130        for bucket in buckets.into_iter() {
131            if let Ok(entry) = table.get_bucket_entry(bucket)
132                && let inner = entry.get()
133                && inner.hash == hash
134                && self.eq(key.clone(), inner.key.clone())?
135            {
136                entry.remove();
137                return Ok(());
138            }
139        }
140
141        Ok(())
142    }
143
144    pub fn contains(&self, key: &Value) -> Result<bool, Exception> {
145        let table = self.table.write();
146        let hash = self.hash(key.clone())?;
147        for entry in table.iter_hash(hash) {
148            if entry.hash == hash && self.eq(key.clone(), entry.key.clone())? {
149                return Ok(true);
150            }
151        }
152
153        Ok(false)
154    }
155
156    pub fn update(&self, key: &Value, proc: &Procedure, default: &Value) -> Result<(), Exception> {
157        use std::slice;
158
159        if !self.mutable {
160            return Err(Exception::error("hashtable is immutable"));
161        }
162
163        let mut table = self.table.write();
164        let hash = self.hash(key.clone())?;
165        for entry in table.iter_hash_mut(hash) {
166            if entry.hash == hash && self.eq(key.clone(), entry.key.clone())? {
167                #[cfg(not(feature = "async"))]
168                let updated =
169                    proc.call(slice::from_ref(&entry.val), &mut ContBarrier::new())?[0].clone();
170
171                #[cfg(feature = "async")]
172                let updated = proc
173                    .call_sync(slice::from_ref(&entry.val), &mut ContBarrier::new())?[0]
174                    .clone();
175
176                entry.val = updated;
177                return Ok(());
178            }
179        }
180
181        #[cfg(not(feature = "async"))]
182        let updated = proc.call(slice::from_ref(default), &mut ContBarrier::new())?[0].clone(); // 
183
184        #[cfg(feature = "async")]
185        let updated = proc.call_sync(slice::from_ref(default), &mut ContBarrier::new())?[0].clone();
186
187        table.insert_unique(
188            hash,
189            TableEntry {
190                key: key.clone(),
191                val: updated,
192                hash,
193            },
194            TableEntry::get_hash,
195        );
196
197        Ok(())
198    }
199
200    pub fn copy(&self, mutable: bool) -> Self {
201        Self {
202            table: RwLock::new(self.table.read().clone()),
203            eq: self.eq.clone(),
204            hash: self.hash.clone(),
205            mutable,
206        }
207    }
208
209    pub fn clear(&self) -> Result<(), Exception> {
210        if !self.mutable {
211            return Err(Exception::error("hashtable is immutable"));
212        }
213
214        self.table.write().clear();
215
216        Ok(())
217    }
218
219    pub fn keys(&self) -> Vec<Value> {
220        self.table
221            .read()
222            .iter()
223            .map(|entry| entry.key.clone())
224            .collect()
225    }
226
227    pub fn entries(&self) -> (Vec<Value>, Vec<Value>) {
228        self.table
229            .read()
230            .iter()
231            .map(|entry| (entry.key.clone(), entry.val.clone()))
232            .unzip()
233    }
234}
235
236#[derive(Clone, Trace)]
237pub struct HashTable(pub(crate) Gc<HashTableInner>);
238
239impl HashTable {
240    /*
241    pub fn new_eq() -> Self {
242        todo!()
243    }
244
245    pub fn new_eqv() -> Self {
246        todo!()
247    }
248
249    pub fn new_equal() -> Self {
250        todo!()
251    }
252    */
253
254    pub fn new(hash: Procedure, eq: Procedure) -> Self {
255        Self(Gc::new(HashTableInner {
256            table: RwLock::new(hashbrown::HashTable::new()),
257            eq,
258            hash,
259            mutable: true,
260        }))
261    }
262
263    pub fn with_capacity(hash: Procedure, eq: Procedure, cap: usize) -> Self {
264        Self(Gc::new(HashTableInner {
265            table: RwLock::new(hashbrown::HashTable::with_capacity(cap)),
266            eq,
267            hash,
268            mutable: true,
269        }))
270    }
271
272    pub fn size(&self) -> usize {
273        self.0.size()
274    }
275
276    pub fn get(&self, key: &Value, default: &Value) -> Result<Value, Exception> {
277        self.0.get(key, default)
278    }
279
280    pub fn set(&self, key: &Value, val: &Value) -> Result<(), Exception> {
281        self.0.set(key, val)
282    }
283
284    pub fn delete(&self, key: &Value) -> Result<(), Exception> {
285        self.0.delete(key)
286    }
287
288    pub fn contains(&self, key: &Value) -> Result<bool, Exception> {
289        self.0.contains(key)
290    }
291
292    pub fn update(&self, key: &Value, proc: &Procedure, default: &Value) -> Result<(), Exception> {
293        self.0.update(key, proc, default)
294    }
295
296    pub fn copy(&self, mutable: bool) -> Self {
297        Self(Gc::new(self.0.copy(mutable)))
298    }
299
300    pub fn clear(&self) -> Result<(), Exception> {
301        self.0.clear()
302    }
303
304    pub fn keys(&self) -> Vec<Value> {
305        self.0.keys()
306    }
307
308    pub fn entries(&self) -> (Vec<Value>, Vec<Value>) {
309        self.0.entries()
310    }
311}
312
313impl fmt::Debug for HashTable {
314    fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
315        write!(f, "#hash(")?;
316        for (i, entry) in self.0.table.read().iter().enumerate() {
317            if i > 0 {
318                write!(f, " ")?;
319            }
320            write!(f, "({:?} . {:?})", entry.key, entry.val)?;
321        }
322        write!(f, ")")
323    }
324}
325
326#[derive(Default, Trace)]
327pub struct EqualHashSet {
328    set: HashSet<EqualValue>,
329}
330
331impl EqualHashSet {
332    pub fn new() -> Self {
333        Self::default()
334    }
335
336    pub fn insert(&mut self, new_value: Value) {
337        let new_value = EqualValue(new_value);
338        if !self.set.contains(&new_value) {
339            self.set.insert(new_value);
340        }
341    }
342
343    pub fn get(&mut self, val: &Value) -> &Value {
344        let val = EqualValue(val.clone());
345        &self.set.get(&val).unwrap().0
346    }
347}
348
349#[derive(Clone, Eq, Trace)]
350pub struct EqualValue(pub Value);
351
352impl PartialEq for EqualValue {
353    fn eq(&self, rhs: &Self) -> bool {
354        self.0.equal(&rhs.0)
355    }
356}
357
358impl Hash for EqualValue {
359    fn hash<H: Hasher>(&self, state: &mut H) {
360        self.0.equal_hash(&mut IndexSet::new(), state)
361    }
362}
363
364#[bridge(name = "make-hashtable", lib = "(rnrs hashtables builtins (6))")]
365pub fn make_hashtable(
366    hash_function: &Value,
367    equiv: &Value,
368    rest: &[Value],
369) -> Result<Vec<Value>, Exception> {
370    let hash: Procedure = hash_function.clone().try_into()?;
371    let equiv: Procedure = equiv.clone().try_into()?;
372    let k = match rest {
373        [] => None,
374        [k] => Some(k.try_into()?),
375        x => return Err(Exception::wrong_num_of_args(3, 2 + x.len())),
376    };
377    let hashtable = if let Some(k) = k {
378        HashTable::with_capacity(hash, equiv, k)
379    } else {
380        HashTable::new(hash, equiv)
381    };
382    Ok(vec![Value::from(hashtable)])
383}
384
385#[bridge(name = "hashtable?", lib = "(rnrs hashtables builtins (6))")]
386pub fn hashtable_pred(hashtable: &Value) -> Result<Vec<Value>, Exception> {
387    Ok(vec![Value::from(
388        hashtable.type_of() == ValueType::HashTable,
389    )])
390}
391
392#[bridge(name = "hashtable-size", lib = "(rnrs hashtables builtins (6))")]
393pub fn hashtable_size(hashtable: &Value) -> Result<Vec<Value>, Exception> {
394    let hashtable: HashTable = hashtable.clone().try_into()?;
395    Ok(vec![Value::from(hashtable.size())])
396}
397
398#[bridge(name = "hashtable-ref", lib = "(rnrs hashtables builtins (6))")]
399pub fn hashtable_ref(
400    hashtable: &Value,
401    key: &Value,
402    default: &Value,
403) -> Result<Vec<Value>, Exception> {
404    let hashtable: HashTable = hashtable.clone().try_into()?;
405    Ok(vec![hashtable.get(key, default)?])
406}
407
408#[bridge(name = "hashtable-set!", lib = "(rnrs hashtables builtins (6))")]
409pub fn hashtable_set_bang(
410    hashtable: &Value,
411    key: &Value,
412    obj: &Value,
413) -> Result<Vec<Value>, Exception> {
414    let hashtable: HashTable = hashtable.clone().try_into()?;
415    hashtable.set(key, obj)?;
416    Ok(Vec::new())
417}
418
419#[bridge(name = "hashtable-delete!", lib = "(rnrs hashtables builtins (6))")]
420pub fn hashtable_delete_bang(hashtable: &Value, key: &Value) -> Result<Vec<Value>, Exception> {
421    let hashtable: HashTable = hashtable.clone().try_into()?;
422    hashtable.delete(key)?;
423    Ok(Vec::new())
424}
425
426#[bridge(name = "hashtable-contains?", lib = "(rnrs hashtables builtins (6))")]
427pub fn hashtable_contains_pred(hashtable: &Value, key: &Value) -> Result<Vec<Value>, Exception> {
428    let hashtable: HashTable = hashtable.clone().try_into()?;
429    Ok(vec![Value::from(hashtable.contains(key)?)])
430}
431
432#[bridge(name = "hashtable-update!", lib = "(rnrs hashtables builtins (6))")]
433pub fn hashtable_update_bang(
434    hashtable: &Value,
435    key: &Value,
436    proc: &Value,
437    default: &Value,
438) -> Result<Vec<Value>, Exception> {
439    let hashtable: HashTable = hashtable.clone().try_into()?;
440    let proc: Procedure = proc.clone().try_into()?;
441    hashtable.update(key, &proc, default)?;
442    Ok(Vec::new())
443}
444
445#[bridge(name = "hashtable-copy", lib = "(rnrs hashtables builtins (6))")]
446pub fn hashtable_copy(hashtable: &Value, rest: &[Value]) -> Result<Vec<Value>, Exception> {
447    let hashtable: HashTable = hashtable.clone().try_into()?;
448    let mutable = match rest {
449        [] => false,
450        [mutable] => mutable.is_true(),
451        x => return Err(Exception::wrong_num_of_args(2, 1 + x.len())),
452    };
453    let new_hashtable = hashtable.copy(mutable);
454    Ok(vec![Value::from(new_hashtable)])
455}
456
457#[bridge(name = "hashtable-clear!", lib = "(rnrs hashtables builtins (6))")]
458pub fn hashtable_clear_bang(hashtable: &Value, rest: &[Value]) -> Result<Vec<Value>, Exception> {
459    let hashtable: HashTable = hashtable.clone().try_into()?;
460    let k = match rest {
461        [] => None,
462        [k] => Some(k.try_into()?),
463        x => return Err(Exception::wrong_num_of_args(3, 2 + x.len())),
464    };
465
466    hashtable.clear()?;
467
468    if let Some(k) = k {
469        let mut table = hashtable.0.table.write();
470        if table.capacity() < k {
471            table.shrink_to(k, TableEntry::get_hash);
472        } else {
473            table.reserve(k, TableEntry::get_hash);
474        }
475    }
476
477    Ok(Vec::new())
478}
479
480#[bridge(name = "hashtable-keys", lib = "(rnrs hashtables builtins (6))")]
481pub fn hashtable_keys(hashtable: &Value) -> Result<Vec<Value>, Exception> {
482    let hashtable: HashTable = hashtable.clone().try_into()?;
483    let keys = Value::from(hashtable.keys());
484    Ok(vec![keys])
485}
486
487#[bridge(name = "hashtable-entries", lib = "(rnrs hashtables builtins (6))")]
488pub fn hashtable_entries(hashtable: &Value) -> Result<Vec<Value>, Exception> {
489    let hashtable: HashTable = hashtable.clone().try_into()?;
490    let (keys, values) = hashtable.entries();
491    Ok(vec![Value::from(keys), Value::from(values)])
492}
493
494#[bridge(
495    name = "hashtable-equivalence-function",
496    lib = "(rnrs hashtables builtins (6))"
497)]
498pub fn hashtable_equivalence_function(hashtable: &Value) -> Result<Vec<Value>, Exception> {
499    let hashtable: HashTable = hashtable.clone().try_into()?;
500    let eqv_func = Value::from(hashtable.0.eq.clone());
501    Ok(vec![eqv_func])
502}
503
504#[bridge(
505    name = "hashtable-hash-function",
506    lib = "(rnrs hashtables builtins (6))"
507)]
508pub fn hashtable_hash_function(hashtable: &Value) -> Result<Vec<Value>, Exception> {
509    let hashtable: HashTable = hashtable.clone().try_into()?;
510    let hash_func = Value::from(hashtable.0.hash.clone());
511    Ok(vec![hash_func])
512}
513
514#[bridge(name = "hashtable-mutable?", lib = "(rnrs hashtables builtins (6))")]
515pub fn hashtable_mutable_pred(hashtable: &Value) -> Result<Vec<Value>, Exception> {
516    let hashtable: HashTable = hashtable.clone().try_into()?;
517    let is_mutable = Value::from(hashtable.0.mutable);
518    Ok(vec![is_mutable])
519}
520
521#[bridge(name = "eq-hash", lib = "(rnrs hashtables builtins (6))")]
522pub fn eq_hash(obj: &Value) -> Result<Vec<Value>, Exception> {
523    let mut hasher = DefaultHasher::new();
524    obj.eq_hash(&mut hasher);
525    Ok(vec![Value::from(hasher.finish())])
526}
527
528#[bridge(name = "eqv-hash", lib = "(rnrs hashtables builtins (6))")]
529pub fn eqv_hash(obj: &Value) -> Result<Vec<Value>, Exception> {
530    let mut hasher = DefaultHasher::new();
531    obj.eqv_hash(&mut hasher);
532    Ok(vec![Value::from(hasher.finish())])
533}
534
535#[bridge(name = "equal-hash", lib = "(rnrs hashtables builtins (6))")]
536pub fn equal_hash(obj: &Value) -> Result<Vec<Value>, Exception> {
537    let mut hasher = DefaultHasher::new();
538    obj.equal_hash(&mut IndexSet::default(), &mut hasher);
539    Ok(vec![Value::from(hasher.finish())])
540}
541
542#[bridge(name = "string-hash", lib = "(rnrs hashtables builtins (6))")]
543pub fn string_hash(string: &Value) -> Result<Vec<Value>, Exception> {
544    let string: WideString = string.clone().try_into()?;
545    let mut hasher = DefaultHasher::new();
546    string.hash(&mut hasher);
547    Ok(vec![Value::from(hasher.finish())])
548}
549
550#[bridge(name = "string-ci-hash", lib = "(rnrs hashtables builtins (6))")]
551pub fn string_ci_hash(string: &Value) -> Result<Vec<Value>, Exception> {
552    let string: WideString = string.clone().try_into()?;
553    let mut hasher = DefaultHasher::new();
554    let chars = string.0.chars.read();
555    hasher.write_usize(chars.len());
556    for lowercase in chars.iter().copied().flat_map(char::to_lowercase) {
557        lowercase.hash(&mut hasher);
558    }
559    Ok(vec![Value::from(hasher.finish())])
560}
561
562#[bridge(name = "symbol-hash", lib = "(rnrs hashtables builtins (6))")]
563pub fn symbol_hash(symbol: &Value) -> Result<Vec<Value>, Exception> {
564    let symbol: Symbol = symbol.clone().try_into()?;
565    let mut hasher = DefaultHasher::new();
566    symbol.hash(&mut hasher);
567    Ok(vec![Value::from(hasher.finish())])
568}