;; -*-theme-d-*-

;; Copyright (C) 2014 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 test289)

  (import (standard-library core)
	  (standard-library console-io))


  (define-class <my-object> <object> #t #f #f public ()
    ((id <string> public public)))


  (define-class <my-record> <object> #t #f #f public ()
    ((name <string> public public)
     (address <string> public public)))


  (define-param-class :my-stack (%type) <my-object> #t #f #f public ()
    ((contents (:uniform-list %type) module module null)))

  
  (define-param-proc-alt my-push (%type)
    (lambda (((stack (:my-stack %type)) (element %type)) <none> nonpure)
      (field-set! stack 'contents (cons element (field-ref stack 'contents)))))

  (define-param-proc-alt my-pop (%type)
    (lambda (((stack (:my-stack %type))) (:maybe %type) nonpure)
      (let ((contents (field-ref stack 'contents)))
	(if (equal? contents null)
	    null
	    (let* ((contents1 (cast (:nonempty-uniform-list %type)
				    contents))
		   (result (car contents1)))
	      (field-set! stack 'contents
			  (cdr contents1))
	      result)))))


  (define-class <my-app> <object> #f #f #f public ()
    ((stack (:my-stack <my-record>) public public)))


  (define main
    (lambda (() <integer> nonpure)
      (let* ((my-app <my-app>
		     (make <my-app>
			   ((constructor (:my-stack <my-record>)) "my-stack")))
	     (my-stack (field-ref my-app 'stack)))
	(my-push my-stack ((constructor <my-record>) "Tommi" "PL 0"))
	(my-push my-stack ((constructor <my-record>) "Jukka" "PL 1"))
	(my-push my-stack ((constructor <my-record>) "Janne" "PL 2"))
	(let-mutable ((cur (:maybe <my-record>) (my-pop my-stack)))
	  (until ((equal? cur null))
	    (if (not (equal? cur null))
		(let ((cur1 (cast <my-record> cur)))
		  (console-display
		   (field-ref cur1 'name))
		  (console-display " ")
		  (console-display
		   (field-ref cur1 'address))
		  (console-newline)
		  (set! cur (my-pop my-stack)))))))
      0)))
