;;
;; util-bst-ldict.scm
;;
;; BST-based symbol dictionary.
;;
;; ISC License
;;
;; Copyright 2023 Brmlab, z.s.
;; Dominik Pantůček <dominik.pantucek@trustica.cz>
;;
;; Permission to use, copy, modify, and/or distribute this software
;; for any purpose with or without fee is hereby granted, provided
;; that the above copyright notice and this permission notice appear
;; in all copies.
;; 
;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
;;

(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?)

 )