move rewriters to implementation file, make rewriter cycle-detecting

1 files changed, 17 insertions, 0 deletions

diff --git a/lib/cuprate/implementation/srfi-125-eq-map.scm b/lib/cuprate/implementation/srfi-125-eq-map.scm
new file mode 100644
index 0000000..3a1d7b9
--- /dev/null
+++ b/lib/cuprate/implementation/srfi-125-eq-map.scm
@@ -0,0 +1,17 @@
+(define (make-eq-map)
+  (define counter-table (make-hash-table (make-eq-comparator)))
+  (define used-table (make-hash-table (make-eq-comparator)))
+  (define counter 0)
+  (lambda (msg obj)
+    (case msg
+      ((contains?) (hash-table-contains? counter-table obj))
+      ((cycle-counter) (let ((num (hash-table-ref counter-table obj)))
+                         (hash-table-set! used-table obj #t)
+                         (string->symbol
+                          (string-append "#"
+                                         (number->string num)
+                                         "#"))))
+      ((cycle-used?) (hash-table-contains? used-table obj))
+      ((intern!) (hash-table-set! counter-table obj counter)
+                 (set! counter (+ counter 1)))
+      (else (error "invalid message" msg)))))
\ No newline at end of file