;; -*-theme-d-*-

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

;; Expected results: compilation error


(define-body (tests test364)


  (import (standard-library list-utilities)
	  (standard-library string-utilities))

  
  (define-param-proc make-assoc-list (%key %value)
		     (()
		      (:assoc-list %key %value)
		      pure)
    (make (:assoc-list %key %value) null))


  (define-param-method gen-assoc (%key %value)
		       (((al (:assoc-list %key %value)) (obj-key %key))
			(:maybe %value)
			pure)
    (let ((obj-assoc (assoc-general obj-key (field-ref al 'l-contents)
				    null equal?)))
      (if (not-null? (string-ref 1 2))
	  (let ((obj1 (cast (:pair %key (:singleton %value)) obj-assoc)))
	    (singleton-get-element (cdr obj1)))
	  null)))


  (define-param-method gen-assoc-set! (%key %value)
		       (((al (:assoc-list %key %value))
			 (obj-key %key)
			 (obj-value %value))
			<none>
			nonpure)
    (let ((obj-assoc (gen-assoc al obj-key)))
      (if (not-null? obj-assoc)
	  (let ((obj1 (cast (:pair %key (:singleton %value)) obj-assoc)))
	    (singleton-set-element! (cdr obj1) obj-value))
	  (let* ((sgt (make-singleton obj-value))
		 (binding (cons obj-key sgt)))
	    (field-set! al 'l-contents
			(cons binding (field-ref al 'l-contents)))))))
			
  )
