;; -*-theme-d-*-

;; Copyright (C) 2019  Tommi Höynälänmaa

(define-interface (standard-library hash-table2)

  (import (standard-library core))

  (define-param-logical-type :hash-proc (%key)
    (:procedure (%key <integer>) <integer> pure))

  (define-param-logical-type :assoc-proc (%key %value)
    (:procedure (%key (:alist %key %value)) (:alt-maybe (:pair %key %value))
		pure))

  (define-param-logical-type :alist-delete-proc (%key %value)
    (:procedure (%key (:alist %key %value)) (:alist %key %value)
		pure))

  (define-param-class :hash-table (%key %value) <object> #t #f #f public ()
    ((v-al-contents (:mutable-vector (:alist %key %value)) public module)
     (proc-hash (:hash-proc %key) public module)
     (proc-assoc (:assoc-proc %key %value) public module)
     (proc-delete (:alist-delete-proc %key %value) public module)))

  (define-param-logical-type :object-hash-table (%value)
    (:hash-table <object> %value))

  (define-param-logical-type :string-hash-table (%value)
    (:hash-table <string> %value))

  (define-param-logical-type :symbol-hash-table (%value)
    (:hash-table <symbol> %value))

  (declare make-hash-table
	   (:param-proc (%key %value)
			((:hash-proc %key)
			 (:assoc-proc %key %value)
			 (:alist-delete-proc %key %value))
			(:hash-table %key %value) pure))

  (declare make-hash-table-with-size
	   (:param-proc (%key %value)
			((:hash-proc %key)
			 (:assoc-proc %key %value)
			 (:alist-delete-proc %key %value)
			 <integer>)
			(:hash-table %key %value) pure))

  (declare make-object-hash-table
	   (:param-proc (%value) () (:object-hash-table %value) pure))

  (declare make-object-hash-table-with-size
	   (:param-proc (%value) (<integer>) (:object-hash-table %value)
			pure))

  (declare make-string-hash-table
	   (:param-proc (%value) () (:string-hash-table %value) pure))

  (declare make-string-hash-table-with-size
	   (:param-proc (%value) (<integer>) (:string-hash-table %value)
			pure))

  (declare make-symbol-hash-table
	   (:param-proc (%value) () (:symbol-hash-table %value) pure))

  (declare make-symbol-hash-table-with-size
	   (:param-proc (%value) (<integer>) (:symbol-hash-table %value)
			pure))

  (declare hash-ref
	   (:param-proc (%key %value %default)
			((:hash-table %key %value) %key %default)
			(:union %value %default) pure))

  (declare hash-exists?
	   (:param-proc (%key %value) ((:hash-table %key %value) %key)
			<boolean> pure))

  (declare hash-set!
	   (:param-proc (%key %value) ((:hash-table %key %value) %key %value)
			<none> nonpure))

  (declare hash-remove!
	   (:param-proc (%key %value) ((:hash-table %key %value) %key)
			<none> nonpure))

  (declare hash-count
	   (:param-proc (%key %value)
			((:binary-predicate %key %value)
			 (:hash-table %key %value))
			<integer>
			pure))

  (declare hash-count-elements
	   (:param-proc (%key %value) ((:hash-table %key %value)) <integer>
				       pure))

  (declare hashq (:hash-proc <object>))
  
  (declare hashv (:hash-proc <object>))

  (declare hash-contents (:hash-proc <object>))

  (declare object-hash (:hash-proc <object>))

  (declare string-hash (:hash-proc <string>))

  (declare hash-for-each
	   (:param-proc (%key %value)
			((:procedure (%key %value) <none> nonpure)
			 (:hash-table %key %value))
			<none>
			nonpure))

  (declare hash-search-first
	   (:param-proc (%key %value %default)
			((:binary-predicate %key %value)
			 (:hash-table %key %value)
			 %default)
			(:union %value %default)
			pure))

  (declare hash-clear!
	   (:param-proc (%key %value)
			((:hash-table %key %value))
			<none>
			nonpure))

  (declare assoc1
	   (:param-proc (%type1 %type2)
			(%type1 (:alist %type1 %type2))
			(:union (:pair %type1 %type2) <boolean>)
			pure))

  (declare assoc-values1
	   (:param-proc (%type1 %type2)
			(%type1 (:alist %type1 %type2))
			(:union (:pair %type1 %type2) <boolean>)
			pure))

  (declare assoc-objects1
	   (:param-proc (%type1 %type2)
			(%type1 (:alist %type1 %type2))
			(:union (:pair %type1 %type2) <boolean>)
			pure))

  (declare assoc-contents1
	   (:param-proc (%type1 %type2)
			(%type1 (:alist %type1 %type2))
			(:union (:pair %type1 %type2) <boolean>)
			pure)))
