#lang typed-scheme
(provide bind empty? get hash-list HashList)
(require (prefix-in ra: "skewbinaryrandomaccesslist.ss"))
(define-struct: (A) Base ([prevbase : (Block A)]
[prevoffset : Integer]
[key-value-pairs : (ra:List (Pair A A))]
[size : Integer]))
(define-struct: Mt ())
(define-type-alias (Block A) (U Mt (Base A)))
(define-struct: (A) List ([offset : Integer]
[base : (Base A)]
[size : Integer]))
(define-type-alias HashList (All (A) (List A)))
(define empty-vlist (make-List 0 (make-Base (make-Mt) 0 ra:empty 1) 0))
(: empty? : (All (A) ((HashList A) -> Boolean)))
(define (empty? vlist)
(zero? (List-size vlist)))
(: bind : (All (A) (A A (HashList A) -> (HashList A))))
(define (bind key value vlst)
(if (with-handlers ([exn:fail? (lambda (error?) #t)])
(get key vlst)
#f)
(add-elem key value vlst)
(error
(format "Duplicate key: ~a already exists in the hash-list :" key)
'add-elem)))
(: add-elem : (All (A) (A A (HashList A) -> (HashList A))))
(define (add-elem key value vlst)
(let* ([offset (List-offset vlst)]
[size (List-size vlst)]
[base (List-base vlst)]
[prevbase (Base-prevbase base)]
[prevoffset (Base-prevoffset base)]
[keys (Base-key-value-pairs base)]
[basesize (Base-size base)]
[newoffset (add1 offset)]
[pair (cons key value)])
(if (< offset basesize)
(make-List newoffset
(make-Base prevbase
prevoffset
(ra:cons pair keys)
basesize)
(add1 size))
(make-List 1
(make-Base base
offset
(ra:cons pair ra:empty)
(* basesize 2))
(add1 size)))))
(: first : (All (A) ((HashList A) -> (Pair A A))))
(define (first vlst)
(let ([offset (List-offset vlst)]
[size (List-size vlst)]
[base (List-base vlst)])
(if (< (sub1 offset) size)
(ra:head (Base-key-value-pairs base))
(error "List is empty :" 'first))))
(: rest : (All (A) ((HashList A) -> (HashList A))))
(define (rest vlst)
(let* ([offset (List-offset vlst)]
[size (List-size vlst)]
[base (List-base vlst)]
[len (Base-size base)]
[prev (Base-prevbase base)])
(cond
[(and (zero? len) (zero? offset)) (error "List is empty :" 'rest)]
[(> offset 1) (make-List (sub1 offset)
(make-Base (Base-prevbase base)
(Base-prevoffset base)
(ra:tail (Base-key-value-pairs base))
(Base-size base))
(sub1 size))]
[(Base? prev) (make-List (Base-prevoffset base) prev (sub1 size))]
[else empty-vlist])))
(: size : (All (A) ((HashList A) -> Integer)))
(define (size vlst)
(List-size vlst))
(: get : (All (A) (A (HashList A) -> A)))
(define (get key vlist)
(if (zero? (List-size vlist))
(error (format "Key ~a not found in hash list :" key) 'get)
(get-helper key vlist)))
(: get-helper : (All (A) (A (HashList A) -> A)))
(define (get-helper key vlist)
(let ([fst (first vlist)])
(if (eq? key (car fst))
(cdr fst)
(get key (rest vlist)))))
(: hash-list : (All (A) ((Listof A) (Listof A) -> (HashList A))))
(define (hash-list keys values)
(foldr (inst bind A) empty-vlist keys values))