;;;; Internal procedure definitions (all take a vec argument first)

;;; Sample call of an internal procedure from another internal procedure:
;;; (dcall dref/default vec dictionary key default)

;;; Notes on definitions:
;;; Vec argument is not used except to pass to dcalls
;;; External procedures with a rest argument use a list argument here
;;; External procedures with optional arguments are not optional here
 
(define-syntax dcall
  (syntax-rules ()
    ((dcall dproc vec dictionary arg ...)
     ((vector-ref vec dproc) vec dictionary arg ...))))

(define (idictionary? vec obj)
  (error "dictionary? method not defined"))

(define (idict-empty? vec dictionary)
  (= 0 (dcall dsize vec dictionary)))

(define (idict-contains? vec dictionary key)
  (dcall dref vec dictionary key
         (lambda () #f) (lambda (x) #t)))

(define (idict-ref vec dictionary key failure success)
  (define-values
    (new-dict result)
    (dcall dsearch! vec dictionary key 
           (lambda (_ ignore)
             (ignore (failure)))
           (lambda (key value update _)
             (update key value (success value)))))
  result)

(define (idict-ref/default vec dictionary key default)
  (dcall dref vec dictionary key
         (lambda () default)
         (lambda (x) x)))

;; private
(define (idict-set!* vec dictionary use-old? objs)
  (let loop ((objs objs)
             (dictionary dictionary))
    (cond
      ((null? objs) 
       dictionary)
      ((null? (cdr objs))
       (error "mismatch of key / values argument list" objs))
      (else (let*-values
              (((key) (car objs))
               ((value) (cadr objs))
               ((new-d _) (dcall dsearch! vec dictionary key
                                 (lambda (insert ignore)
                                   (insert value #f))
                                 (lambda (key old-value update delete)
                                   (update key (if use-old? old-value value) #f)))))
              (loop (cddr objs)
                    new-d))))))

(define (idict-set! vec dictionary objs)
  (idict-set!* vec dictionary #f objs))

(define (idict-adjoin! vec dictionary objs)
  (idict-set!* vec dictionary #t objs))

(define (idict-delete! vec dictionary keys)
  (dcall ddelete-all! vec dictionary keys))

(define (idict-delete-all! vec dictionary keylist)
  (let loop ((keylist keylist)
             (dictionary dictionary))
    (cond
      ((null? keylist) dictionary)
      (else (let*-values 
              (((key) (car keylist))
               ((new-d _) (dcall dsearch! vec dictionary key
                                 (lambda (_ ignore) 
                                   (ignore #f))
                                 (lambda (key old-value _ delete)
                                   (delete #f)))))
              (loop (cdr keylist)
                    new-d))))))

(define (idict-replace! vec dictionary key value)
  (define-values
    (new-dict _)
    (dcall dsearch! vec dictionary key
         (lambda (_ ignore)
           (ignore #f))
         (lambda (key old-value update _)
           (update key value #f))))
  new-dict)

(define (idict-intern! vec dictionary key failure)
  (dcall dsearch! vec dictionary key
         (lambda (insert _)
           (let ((value (failure)))
            (insert value value)))
         (lambda (key value update _)
           (update key value value))))

(define (idict-update! vec dictionary key updater failure success)
  (define-values
    (new-dict _)
    (dcall dsearch! vec dictionary key
           (lambda (insert ignore)
             (insert (updater (failure)) #f))
           (lambda (key value update _)
             (update key (updater (success value)) #f))))
  new-dict)

(define (idict-update/default! vec dictionary key updater default)
  (dcall dupdate! vec dictionary key updater
         (lambda () default)
         (lambda (x) x)))

(define (idict-pop! vec dictionary failure)
  (define (do-pop)
    (call/cc
      (lambda (cont)
        (dcall dfor-each vec
               (lambda (key value)
                 (define new-dict
                   (dcall ddelete! vec dictionary (list key)))
                 (cont new-dict key value)) 
               dictionary))))
  (define empty? (dcall dempty? vec dictionary))
  (if empty?
      (failure)
      (do-pop)))

(define (idict-map! vec proc dictionary)
  (error "dict-map method not defined"))

(define (idict-filter! vec pred dictionary)  
  (error "dict-filter! method not defined"))

(define (idict-remove! vec pred dictionary)
  (dcall dfilter! vec (lambda (key value) (not (pred key value))) dictionary))

(define (idict-search! vec dictionary key failure success)
  (error "dict-search! method not defined"))

(define (idict-size vec dictionary)
  (error "dict-size method not defined"))

(define (idict-for-each vec proc dictionary)
  (error "dict-for-each method not defined"))

(define (idict-count vec pred dictionary)
  (dcall dfold vec
         (lambda (key value acc)
           (if (pred key value)
               (+ 1 acc)
               acc))
         0
         dictionary))

(define (idict-any vec pred dictionary)
  (call/cc
    (lambda (cont)
      (dcall dfor-each vec
             (lambda (key value)
               (define ret (pred key value))
               (when ret
                 (cont ret)))
             dictionary)
      #f)))

(define (idict-every vec pred dictionary)
  (define last #t)
  (call/cc
    (lambda (cont)
      (dcall dfor-each vec
             (lambda (key value)
               (define ret (pred key value))
               (when (not ret)
                 (cont #f))
               (set! last ret))
             dictionary)
      last)))

(define (idict-keys vec dictionary)
  (reverse
    (dcall dfold vec
         (lambda (key value acc)
           (cons key acc))
         '()
         dictionary)))

(define (idict-values vec dictionary)
  (reverse
    (dcall dfold vec
         (lambda (key value acc)
           (cons value acc))
         '()
         dictionary)))

(define (idict-entries vec dictionary)
  (values (dcall dkeys vec dictionary)
          (dcall dvalues vec dictionary)))

(define (idict-fold vec proc knil dictionary)
  (define acc knil)
  (dcall dfor-each vec
         (lambda (key value)
           (set! acc (proc key value acc)))
         dictionary)
  acc)

(define (idict-map->list vec proc dictionary)
  (define reverse-lst
    (dcall dfold vec
         (lambda (key value lst)
           (cons (proc key value) lst)) 
         '()
         dictionary))
  (reverse reverse-lst))

(define (idict->alist vec dictionary)
  (dcall dmap->list vec
         cons
         dictionary))

(define model-vec 
  (vector
    idictionary?  idict-empty?  idict-contains?  idict-ref
    idict-ref/default idict-set!  idict-adjoin!  idict-delete!
    idict-delete-all!  idict-replace!  idict-intern!
    idict-update! idict-update/default! idict-pop!  idict-map!
    idict-filter!  idict-remove!  idict-search!  idict-size 
    idict-for-each idict-count idict-any idict-every idict-keys
    idict-values idict-entries idict-fold idict-map->list
    idict->alist))