Commits

Moritz Heidkamp  committed f889da0

Initial commit

  • Participants

Comments (0)

Files changed (4)

File tests/run.scm

+(load-relative "../trie.scm")
+(import trie)
+(use test)
+
+(define trie
+  (make-trie))
+
+(test-assert (not (trie-ref trie (string->list "hey"))))
+
+(trie-insert! trie (string->list "hey") 'foo)
+
+(test 'foo (trie-ref trie (string->list "hey")))
+
+(trie-insert! trie (string->list "heyo") 'bar)
+(trie-insert! trie (string->list "hex") 'baz)
+
+(test 'foo (trie-ref trie (string->list "hey")))
+(test 'bar (trie-ref trie (string->list "heyo")))
+(test 'baz (trie-ref trie (string->list "hex")))
+
+(test-exit)
+((synopsis "A trie (prefix tree) implementation")
+ (author "Moritz Heidkamp")
+ (category data)
+ (license "BSD")
+ (test-depends test))
+(module trie
+
+(make-trie trie? trie-insert! trie-ref trie-ref* trie->list)
+
+(import chicken scheme)
+(use srfi-1 data-structures)
+
+(define-record trie eq? children value)
+
+(define %make-trie make-trie)
+
+(define (make-trie #!optional (eq? eq?))
+  (%make-trie eq? (list) (list)))
+
+(define (add-child! trie key child)
+  (trie-children-set!
+   trie (alist-update! key child (trie-children trie) (trie-eq? trie))))
+
+(define (trie-insert! trie key val)
+  (let loop ((node trie)
+             (key key))
+    (if (null? key)
+        (trie-value-set! node (list val))
+        (let* ((ckey (car key))
+               (child (or (alist-ref ckey (trie-children node) (trie-eq? trie))
+                          (let ((child (make-trie (trie-eq? trie))))
+                            (add-child! node ckey child)
+                            child))))
+          (loop child (cdr key)))))
+  (void))
+
+(define (trie-ref* trie key)
+  (alist-ref key (trie-children trie) (trie-eq? trie)))
+
+(define (trie-ref trie key #!optional (default (constantly #f)))
+  (let loop ((node trie)
+             (key key))
+    (if (null? key)
+        (if (null? (trie-value node))
+            (default)
+            (car (trie-value node)))
+        (let ((child (trie-ref* node (car key))))
+          (if child
+              (loop child (cdr key))
+              (default))))))
+
+
+(define (trie->list trie)
+  (cons
+   (let loop ((trie trie))
+     (map (lambda (child)
+            (cons (car child)
+                  (trie->list (cdr child))))
+          (trie-children trie)))
+   (trie-value trie)))
+
+)
+(compile -d0 -O3 -J -s trie.scm)
+(compile -d0 -O3 -s trie.import.scm)
+
+(install-extension
+ 'trie
+ '("trie.so" "trie.import.so")
+ '((version "0.0.1")))