(declare (unit util-bst-ldict))

(import duck)

(module*
 util-bst-ldict
 #:doc ("Reimplementation of old list-based symbol dictionary using new BST backend.")
 (
  ldict<?
  make-ldict
  ldict?
  ldict-empty?
  ldict-contains?
  ldict-ref
  ldict-remove
  ldict-set
  ldict-keys
  ldict-map
  ldict-filter
  ldict-reduce
  ldict-equal?
  )

 (import scheme
	 util-bst
	 util-proc)

 (define (ldict<? a b)
   (if (number? a)
       (< a b)
       (if (string? a)
	   (string<? a b)
	   (string<? (symbol->string a)
		     (symbol->string b)))))

 (define (make-ldict . equality?/pairs)
   (let ((equality? (if (or (null? equality?/pairs)
			    (not (procedure? (car equality?/pairs))))
			eq?
			(car equality?/pairs)))
	 (pairs (if (or (null? equality?/pairs)
			(procedure? (car equality?/pairs)))
		    '()
		    (car equality?/pairs))))
     (let loop ((ld (make-bst 'ldict equality? ldict<?))
		(pairs pairs))
       (if (null? pairs)
	   ld
	   (loop (ldict-set ld (caar pairs) (cdar pairs))
		 (cdr pairs))))))

 (define ldict? (bst? 'ldict))

 (define ldict-empty? bst-empty?)
 (define ldict-contains? bst-contains?)
 (define ldict-ref bst-ref)
 (define ldict-remove bst-remove)
 (define ldict-set bst-set)
 (define ldict-keys bst-keys)

 (define (ldict-map proc ld)
   (let ((i 0)
	 (both? ((procedure-arity>=? 2) proc))
	 (index? ((procedure-arity>=? 3) proc)))
     (bst-map-bst ld
		  (lambda (k v)
		    (let ((r (if both?
				 (if index?
				     (proc k v i)
				     (proc k v))
				 (proc v))))
		      (set! i (add1 i))
		      r)))))

 (define (ldict-filter pred? ld)
   (bst-filter ld pred?))

 (define (ldict-reduce init proc ld)
   (bst-reduce ld proc init))

 (define ldict-equal? bst-equal?)

 )