miniscm: add better support for immutable strings, and refactor to use real strings

1 files changed, 73 insertions, 44 deletions

diff --git a/set.scm b/set.scm
index a8683b1..52d10b6 100644
--- a/set.scm
+++ b/set.scm
@@ -410,14 +410,36 @@
 ;;; For strings
 ;;; ;;;;;;;;;;;
 
-(cond-expand
- ((not miniscm-unslisp)
-  (define (string<=> x y)
+(define integer<=>
+  (lambda (x y)
     (cond
-      ((string<? x y) '<)
-      ((string>? x y) '>)
-      (else '=))))
- (else #f))
+      ((< x y) '<)
+      ((= x y) '=)
+      (else '>))))
+
+(define char<=>
+  (lambda (x y)
+    (integer<=> (char->integer x)
+                (char->integer y))))
+
+(define string<=>
+  (lambda (x y)
+    (let ((x-len (string-length x))
+          (y-len (string-length y)))
+      (letrec ((loop
+                (lambda (i)
+                  (cond
+                    ((and (= i x-len) (= i y-len)) '=)
+                    ((= i x-len) '<)
+                    ((= i y-len) '>)
+                    (else
+                     (let ((dir (char<=>
+                                 (string-ref x i)
+                                 (string-ref y i))))
+                       (if (eq? dir '=)
+                           (loop (+ i 1))
+                           dir)))))))
+        (loop 0)))))
 
 (cond-expand
  ((and (not miniscm-unslisp) (not r7rs))
@@ -438,6 +460,13 @@
 (define %smap:split (map:split map:string<=>))
 (define smap:union (map:union %smap:split))
 
+(define smap:insert-many
+  (lambda (smap . pairs)
+    (fold (lambda (pair smap)
+            (smap:insert smap (car pair) (cdr pair)))
+          smap
+          pairs)))
+
 ;;; ;;;;;
 ;;; Tests
 ;;; ;;;;;
@@ -528,21 +557,21 @@
                (else #t)))))
    (cons "insert then delete"
          (lambda ()
-           (let ((insert-return (smap:insert '() (string #\a) 5)))
+           (let ((insert-return (smap:insert '() "a" 5)))
              (cond
                ((not (pair? insert-return)) "invalid insert return")
                ((not (null? (cdr insert-return))) "string found in empty tree")
                (else
                 (let ((tree (car insert-return)))
-                  (let ((found (smap:search tree (string #\a))))
+                  (let ((found (smap:search tree "a")))
                     (cond
                       ((null? found) "string not in tree")
-                      ((not (equal? (map:key tree) (string #\a)))
+                      ((not (equal? (map:key tree) "a"))
                        "returned key not equal to a")
                       ((not (equal? (map:val tree) 5))
                        "returned value not equal to 5")
                       (else
-                       (let ((delete-return (smap:delete tree (string #\a))))
+                       (let ((delete-return (smap:delete tree "a")))
                          (cond
                            ((not (pair? delete-return))
                             "invalid delete return")
@@ -553,19 +582,19 @@
    (cons "insert a few unique then delete"
          (lambda ()
            (let ((to-insert (list
-                             (list (string #\a #\b #\c) 1 #f)
-                             (list (string #\a #\b #\d) 2 #f)
-                             (list (string #\d #\e #\f) 3 #f)
-                             (list (string #\1 #\2 #\3 #\a #\C) 4 #f)
-                             (list (string #\q #\w #\e) 5 #f)
-                             (list (string #\1 #\2 #\3) 5 #f)
-                             (list (string #\l #\i #\s #\p) 6 #f)
-                             (list (string #\c) 7 #f)
-                             (list (string #\s #\c #\m) 8 #f)
-                             (list (string #\a #\l #\g #\o #\l) 9 #f)
-                             (list (string #\a #\s #\m) 10 #f)
-                             (list (string #\4) 11 #f)
-                             (list (string #\a #\s #\m #\e) 12 #f))))
+                             (list "abc" 1 #f)
+                             (list "abd" 2 #f)
+                             (list "def" 3 #f)
+                             (list "123aC" 4 #f)
+                             (list "qwe" 5 #f)
+                             (list "123" 5 #f)
+                             (list "lisp" 6 #f)
+                             (list "c" 7 #f)
+                             (list "scm" 8 #f)
+                             (list "algol" 9 #f)
+                             (list "asm" 10 #f)
+                             (list "4" 11 #f)
+                             (list "asme" 12 #f))))
              (display "insert all") (newline)
              (let ((tree (%set:insert-all '() to-insert)))
                (if (string? tree)
@@ -589,22 +618,22 @@
          (lambda ()
            (let ((tree (%set:insert-all '()
                                         (list
-                                         (list (string #\a #\b #\c #\d) 1 #f)
-                                         (list (string #\e #\f #\g #\h) 2 #f)
-                                         (list (string #\1 #\4 #\2 #\9 #\3) 3 #f)
-                                         (list (string #\a #\b #\c #\d #\e) 4 #f)))))
+                                         (list "abcd" 1 #f)
+                                         (list "efgh" 2 #f)
+                                         (list "14293" 3 #f)
+                                         (list "abcde" 4 #f)))))
              (if (string? tree)
                  tree
                  (let ((tree (smap:update tree
-                                          (string #\a #\b #\c #\d #\e)
+                                          "abcde"
                                           (lambda (key oldnode)
                                             10))))
                    (let ((res (%set:search-all tree
                                                (list
-                                                (list (string #\a #\b #\c #\d) 1 1)
-                                                (list (string #\e #\f #\g #\h) 2 2)
-                                                (list (string #\1 #\4 #\2 #\9 #\3) 3 3)
-                                                (list (string #\a #\b #\c #\d #\e) 10 10)))))
+                                                (list "abcd" 1 1)
+                                                (list "efgh" 2 2)
+                                                (list "14293" 3 3)
+                                                (list "abcde" 10 10)))))
                      (if (string? res)
                          res
                          #t)))))))
@@ -612,20 +641,20 @@
          (lambda ()
            (let ((tree1 (%set:insert-all '()
                                          (list
-                                          (list (string #\a) 1 #f)
-                                          (list (string #\b) 2 #f)
-                                          (list (string #\c) 3 #f))))
+                                          (list "a" 1 #f)
+                                          (list "b" 2 #f)
+                                          (list "c" 3 #f))))
                  (tree2 (%set:insert-all '()
                                          (list
-                                          (list (string #\c) 4 #f)
-                                          (list (string #\d) 5 #f)
-                                          (list (string #\e) 6 #f)))))
+                                          (list "c" 4 #f)
+                                          (list "d" 5 #f)
+                                          (list "e" 6 #f)))))
              (let ((tree (smap:union tree1 tree2))
                    (to-search (list
-                               (list (string #\a) 1 1)
-                               (list (string #\b) 2 2)
-                               (list (string #\c) 3 3)
-                               (list (string #\d) 5 5)
-                               (list (string #\e) 6 6))))
+                               (list "a" 1 1)
+                               (list "b" 2 2)
+                               (list "c" 3 3)
+                               (list "d" 5 5)
+                               (list "e" 6 6))))
                (not (string? (%set:search-all tree to-search)))))))))