Support BigInt hash values.

Author: objecthub

Sources/LispKit/Primitives/HashTableLibrary.swift

@@ -19,6 +19,7 @@
 //
 
 import Foundation
+import NumberKit
 
 ///
 /// Hashtable library: based on R6RS spec.
@@ -505,10 +506,23 @@ public final class HashTableLibrary: NativeLibrary {
     return .fixnum(Int64(expr.hashValue))
   }
 
+  private func bucket(_ hval: Expr, _ numBuckets: Int) throws -> Int {
+    switch hval {
+      case .fixnum(let num):
+        return Int(num %% Int64(numBuckets))
+      case .bignum(let num):
+        let n = BigInt(numBuckets)
+        let rem = num % n
+        return Int(rem.isNegative ? (rem + n).intValue! : rem.intValue!)
+      default:
+        throw RuntimeError.type(hval, expected: [.exactIntegerType])
+    }
+  }
+  
   private func hBuckets(_ expr: Expr, hval: Expr?) throws -> Expr {
     let map = try expr.asHashTable()
-    if let hashValue = try hval?.asInt64() {
-      return map.bucketList(Int(hashValue %% Int64(map.bucketCount)))
+    if let hashValue = hval {
+      return map.bucketList(try self.bucket(hashValue, map.bucketCount))
     } else {
       return map.bucketList()
     }
@@ -521,16 +535,15 @@ public final class HashTableLibrary: NativeLibrary {
     if !key.isAtom || !value.isAtom {
       self.context.objects.manage(map)
     }
-    map.add(Int(try hval.asInt64() %% Int64(map.bucketCount)), key, value)
+    map.add(try self.bucket(hval, map.bucketCount), key, value)
     return .void
   }
 
   private func hBucketRepl(_ expr: Expr, hval: Expr, bucket: Expr) throws -> Expr {
     guard case .table(let map) = expr else {
       throw RuntimeError.type(expr, expected: [.tableType])
     }
-    map.replace(Int(try hval.asInt64() %% Int64(map.bucketCount)), bucket)
+    map.replace(try self.bucket(hval, map.bucketCount), bucket)
     return .void
   }
 }
-

Sources/LispKit/Primitives/MathLibrary.swift

@@ -162,6 +162,7 @@ public final class MathLibrary: NativeLibrary {
     self.define(Procedure("fxmin", self.fxMin))
     self.define(Procedure("fxmax", self.fxMax))
     self.define(Procedure("fxrandom", self.fxRandom))
+    self.define(Procedure("integer->fx", self.integerToFx))
     self.define(Procedure("fixnum-width", self.fixnumWidth))
     self.define(Procedure("least-fixnum", self.leastFixnum))
     self.define(Procedure("greatest-fixnum", self.greatestFixnum))
@@ -1727,6 +1728,19 @@ public final class MathLibrary: NativeLibrary {
     return .fixnum(Int64.random(min: min, max: max))
   }
 
+  private static let maxFx = BigInt(Int64.max) + 1
+  
+  private func integerToFx(_ expr: Expr) throws -> Expr {
+    switch expr {
+    case .fixnum(_):
+      return expr
+    case .bignum(let num):
+      return .fixnum((num % MathLibrary.maxFx).intValue!)
+    default:
+      throw RuntimeError.type(expr, expected: [.exactIntegerType])
+    }
+  }
+  
   private func fixnumWidth() -> Expr {
     return .fixnum(Int64(Int64.bitWidth))
   }

Sources/LispKit/Resources/Libraries/srfi/113.sld

@@ -1421,10 +1421,9 @@
 
     ;; Hash over sobs
     (define (sob-hash sob)
-      (let* ((ht (sob-hash-table sob))
-             (hash (comparator-hash-function (sob-comparator sob))))
+      (let* ((hash (comparator-hash-function (sob-comparator sob))))
         (sob-fold
-          (lambda (element result) (+ (hash element) result))
+          (lambda (element result) (fx+ (integer->fx (hash element)) result))
           5381
           sob)))