;; Hierarchical hash tables.

;;  A hierarchical hash table (HHT) is an implementation of a finite
;;  function which maps tag SEQUENCES to values. All operations on HHTs
;;  have the semantics of operations on finite functions.


(module hhash mzscheme

  (require "dict.ss"
           (lib "match.ss"))

  (provide 
           hhash-ref
           hhash-set!
           hhash-remove-all!
           ;; hhash-new             happens automatically
           hhash-for-each
           hhash-for-each-leaf
           hhash-for-each-hhash
           make-hhash
           hhash?
           hhash-accumulate!
           hhash->dict
           dict->hhash
           )

  ;; FIXME: make abstract
  (define hhash? hash-table?)

  ;; TREE



  (define (hhash-ref hhash path . f)
    (call/ec
     (lambda (exit)
       (define (error-thunk)
         (exit
          (match f
                 (()       (error 'path-not-found "~a" path))
                 ((fn/val) (if (procedure? fn/val)
                               (fn/val)
                               fn/val)))))
       (let down ((p path)
                  (h hhash))
         (match p
                (() h)
                ((tag . p+)
                 (down p+ (hash-table-get h tag error-thunk))))))))
                

  ;; Will create subpath if necessary.
  (define (hhash-set! hhash path value)
    (let down ((p path)
               (h hhash))
      (match p
             ((tag)
              (hash-table-put! h tag value))
             ((tag . p+)
              (let ((child
                     (hash-table-get h tag #f)))
                (unless child
                  (set! child (make-hash-table))
                  (hash-table-put! h tag child))
                (if (hash-table? child)
                    (down (cdr p) child)
                    (error 'invalid-path "~a" path)))))))

  (define (path->parent path)  (reverse (cdr (reverse path))))

  (define (hhash-remove-all! hhash path remove? kill!)
    (let ((table
           (hhash-ref hhash path)))
    (hhash-for-each-leaf
     table
     (lambda (name value)
       (when (remove? name value)          
         (when kill! (kill! name value))
         (hash-table-remove! table name))))))
  

  ;; The condition is that a hhash created from a dictionary cannot
  ;; contain empty list values. This is because dictionaries are
  ;; always implemented as nested alists, and the empty dictionary is
  ;; indistinguishable from the empty list.

  ;; FIXME: use hash-table->alist

  (define (dict->hhash dict)
    (define hhash (make-hhash))
    (for-each
     (match-lambda 
      ((key . value)
       (hash-table-put! hhash
                        key
                        (if (dict? value)
                            (dict->hhash value)
                            value))))
     dict)
    hhash)

  (define (hhash->dict hhash)
    (hash-table-map
     hhash
     (lambda (key value)
       (cons key
             (if (hhash? value)
                 (hhash->dict value)
                 value)))))
             

  (define (make-hhash) (make-hash-table))

  (define ((each pred?) table visit)
    (hash-table-for-each
     table
     (lambda (name value)
       (when (pred? value)
         (visit name value)))))

  (define (hhash-leaf? l) (not (hash-table? l)))
  (define hhash-dir? hash-table?)

  (define hhash-for-each-leaf  (each hhash-leaf?))
  (define hhash-for-each-hhash (each hhash-dir?))
  (define hhash-for-each       (each (lambda  args #t)))


  ;; Combinations

  ;; Combining trees if they have very different topology is quite
  ;; awkward, and something i don't know how to do well. So I'm going
  ;; to take the following route:

  ;; Combining trees = combining the flat (path . value) pairs, and
  ;; translating it back to tree structure. So basicly, a tree is just
  ;; a flat function accessed by composable tags.

  (define (hhash-for-each-path top-table visit)
    (let down ((path  '())
               (table top-table))
      (hash-table-for-each
       table
       (lambda (name value)
         (let ((fqn (append path (list name))))
         
         (if (hhash-dir? value)
             (down fqn value)
             (visit fqn value)))))))
       

  ;; Update a hhash with stuff from another hhash.
  (define (hhash-accumulate!  hhash stuff)
    (hhash-for-each-path
     stuff
     (lambda (path value)
       (hhash-set! hhash path value)))
    hhash)
  
                    
    
  


  
  ;; (define (hhash-update  hhash  stuff)
    
  


  ;; GRAPH

  ;; FIXME: unify with graph.ss from sweb
  

)