;; -*-theme-d-*-

;; Copyright (C) 2016 Tommi Höynälänmaa
;; Distributed under GNU General Public License version 3,
;; see file doc/GPL-3.

;; Expected results: translation and running OK

(define-proper-program (tests test390)

  (import (standard-library core)
	  (standard-library basic-math)
	  (standard-library list-utilities)
	  (standard-library hash-table)
	  (standard-library console-io))

  (define <my-tuple> (:tuple <symbol> <string>))

  (define-simple-proc my-hash
      (((tup <my-tuple>) (i-size <integer>)) <integer> pure)
    (remainder (+ (object-hash (car tup) i-size)
		  (string-hash (car (cdr tup)) i-size))
	       i-size))

  (define-simple-proc my-eq?
      (((tup1 <my-tuple>) (tup2 <my-tuple>))
       <boolean>
       pure)
    (and
     (equal? (tuple-ref tup1 0) (tuple-ref tup2 0))
     (equal? (tuple-ref tup1 1) (tuple-ref tup2 1))))

  (define-simple-proc my-assoc
      (((tup-key <my-tuple>) (al (:alist <my-tuple> <integer>)))
       (:alt-maybe (:pair <my-tuple> <integer>))
       pure)
    (assoc-general tup-key al #f my-eq?))

  (define-simple-proc main (() <none> nonpure)
    (let ((ht1 ((param-proc-instance make-object-hash-table <integer>)))
	  (ht2 ((param-proc-instance make-string-hash-table <integer>)))
	  (ht3 ((param-proc-instance make-symbol-hash-table <integer>)))
	  (ht4 (make-hash-table my-hash my-assoc)))
      (hash-set! ht1 'apple 100)
      (hash-set! ht1 'orange 50)
      (hash-set! ht1 'banana 200)
      (hash-set! ht2 "apple" 100)
      (hash-set! ht2 "orange" 50)
      (hash-set! ht2 "banana" 200)
      (hash-set! ht3 'apple 100)
      (hash-set! ht3 'orange 50)
      (hash-set! ht3 'banana 200)
      (hash-set! ht4 (list 'apple "Finland") 100)
      (hash-set! ht4 (list 'orange "Italy") 20)
      (hash-set! ht4 (list 'cherry "Germany") 50)
      (console-display-line (hash-ref ht1 'banana null))
      (console-display-line (hash-ref ht1 'cherry null))
      (console-display-line (hash-ref ht2 "orange" null))
      (console-display-line (hash-ref ht2 "strawberry" null))
      (console-display-line (hash-ref ht3 'banana null))
      (console-display-line (hash-ref ht3 'cherry null))
      (console-display-line (hash-ref ht4 (list 'cherry "Germany") #f))
      (console-display-line (hash-ref ht4 (list 'strawberry "Italy") #f)))))


