;;;; sparse-vectors.debug.scm

(module (sparse-vectors debug)

(;export
  sparse-vector-info
  sparse-vector-value-kind
  sparse-vector-tree-fold)

(import
  scheme
  (chicken base)
  (chicken type)
  (chicken bitwise)
  (chicken fixnum)
  record-variants
  sparse-vectors (sparse-vectors hof))

(include-relative "sparse-vectors.types")

(: sparse-vector-info (sparse-vector --> fixnum fixnum fixnum))
(: sparse-vector-value-kind (* --> symbol))
(: sparse-vector-tree-fold (sparse-vector ('a sparse-vector-node fixnum (or false sparse-vector-node) (or false fixnum) -> 'a) 'a --> 'a))

;;

(include-relative "sparse-vectors-inlines")

(define (hilbert-node-fold node siz fun acc)
  (let loop ((i 0) (a acc))
    (if (fx= i siz) a
        (loop (fx+ i 1) (fun i a (node-ref node i))) ) ) )

;;

(define (sparse-vector-info hilbert)
  (check-sparse-vector 'sparse-vector-info hilbert)
  (values (hilbert-capacity hilbert)
          (hilbert-height hilbert)
          (hilbert-node-size hilbert)) )

(define (sparse-vector-value-kind val)
  (cond ((node? val) 'node)
        ((hilbert-def? val) 'unset!)
        (else 'set!)) )

(define (sparse-vector-tree-fold hilbert fun acc)
  (let ((siz (hilbert-node-size hilbert)))
    (let recur ((node (hilbert-root hilbert)) (height (hilbert-height hilbert)) (acc acc) (parent #f) (index #f))
      (if (not (node? node)) acc
          (let ((height-1 (fx- height 1))
                (acc (fun acc node height parent index)) )
            (if (fx= 0 height-1) acc
                (hilbert-node-fold node siz
                                   (lambda (i a v) (recur v height-1 a node i))
                                   acc) ) ) ) ) ) )

) ;module (sparse-vectors debug)