;;; -*- Mode: Scheme -*-

;;;; Hash Tries: Persistent Trie-Structured Hash Tables

;;; Copyright (c) 2009, Taylor R. Campbell
;see "hash-trie.incl.scm"

(module hash-trie

(;export
bit-count
  make-hash-trie-type
  hash-trie-type?
  hash-trie-type/key-equality-predicate
  hash-trie-type/key-hash-function
  make-hash-trie
  hash-trie?
  hash-trie/type
  hash-trie/count
  hash-trie/empty?
  hash-trie/search
  hash-trie/lookup
  hash-trie/member?
  hash-trie/update
  hash-trie/insert
  hash-trie/modify
  hash-trie/intern
  hash-trie/delete
  hash-trie/fold
  hash-trie->alist
  hash-trie/key-list
  hash-trie/datum-list
  alist->hash-trie
  string-hash
  symbol-hash
  exact-integer-hash
  real-number-hash
  complex-number-hash
  hash-trie-type:complex-number
  hash-trie-type:real-number
  hash-trie-type:exact-integer
  hash-trie-type:symbol
  hash-trie-type:string)

(import scheme)
(import (chicken base))
(import (chicken type))
(import (chicken foreign))
(import (chicken bitwise))

;;

#>
/* Number of 1 bits */
static C_uword
C_uword_bits( C_uword n )
{
# define TWO( c )       ( ((C_uword) 1u) << (c))
# define MASK( c )      (((C_uword) -1) / (TWO( TWO( c ) ) + 1u))
# define COUNT( x, c )  ((x) & MASK( c )) + (((x) >> (TWO( c ))) & MASK( c ))

  if (0 == n) return 0;

	n = COUNT( n, 0 );
	n = COUNT( n, 1 );
	n = COUNT( n, 2 );
	n = COUNT( n, 3 );
	n = COUNT( n, 4 );
# ifdef C_SIXTY_FOUR
	n = COUNT( n, 5 );
# endif

	return n;

# undef COUNT
# undef MASK
# undef TWO
}
<#

;;

(cond-expand
  (32bit
    (define bit-count/fixnum
      (foreign-lambda* integer32 ((integer32 n))
        "return( C_uword_bits( (C_uword) n ) );")) )
  (64bit
    (define bit-count/fixnum
      (foreign-lambda* integer64 ((integer64 n))
        "return( C_uword_bits( (C_uword) n ) );")) ) )


(: bit-count (number --> fixnum))
;FIXME handle negative bignums (split into uword chunks
;#ints = (modulo (integer-length (- i)) (sizeof uword))
;repeat for #ints: mask low uword bits, count low uword bits, i >> (sizeof uword)
(define (bit-count i)
  ;Brian Kernighan’s Algorithm
  (let count ((i i) (c 0))
    (if (positive? i)
      (if (fixnum? i)
        (+ c (bit-count/fixnum i))
        (count (bitwise-and i (sub1 i)) (add1 c)) )
      c ) ) )

;;

(define-type alist (list-of pair))

(define-type <hash-trie-type> (struct <hash-trie-type>))
(define-type <hash-trie> (struct <hash-trie>))

(: make-hash-trie-type (procedure procedure -> <hash-trie-type>))
(: hash-trie-type? (* -> boolean : <hash-trie-type>))
(: hash-trie-type/key-equality-predicate (<hash-trie-type> -> procedure))
(: hash-trie-type/key-hash-function (<hash-trie-type> -> procedure))

(: make-hash-trie (<hash-trie-type> -> <hash-trie>))
(: hash-trie? (* -> boolean : <hash-trie>))
(: hash-trie/type (<hash-trie> -> <hash-trie-type>))

(: hash-trie/count (<hash-trie> -> fixnum))
(: hash-trie/empty? (<hash-trie> -> boolean))

(: hash-trie/search (<hash-trie> * procedure procedure -> void))
(: hash-trie/lookup (<hash-trie> * * -> *))
(: hash-trie/member? (<hash-trie> * -> boolean))

(: hash-trie/update (<hash-trie> * procedure procedure  -> void))
(: hash-trie/insert (<hash-trie> * * -> <hash-trie>))
(: hash-trie/modify (<hash-trie> * * procedure -> <hash-trie>))

(: hash-trie/intern (<hash-trie> * procedure -> * <hash-trie>))

(: hash-trie/delete (<hash-trie> * -> <hash-trie>))

#; ;i feel violated
(: hash-trie/fold (forall (e) (<hash-trie> e (* * e -> e) -> e)))
(: hash-trie/fold (<hash-trie> * (* * * -> *) -> *))

(: hash-trie->alist (<hash-trie> -> alist))
(: hash-trie/key-list (<hash-trie> -> alist))
(: hash-trie/datum-list (<hash-trie> -> alist))

(: alist->hash-trie (alist <hash-trie-type> -> <hash-trie>))

(: string-hash (string -> fixnum))
(: symbol-hash (symbol -> fixnum))
(: exact-integer-hash (fixnum -> fixnum))
(: real-number-hash (float -> fixnum))
(: complex-number-hash (cplxnum -> fixnum))

;;

(include "hash-trie.incl")

); hash-trie