;; -*-theme-d-*-

;; Copyright (C) 2008-2013 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 test349)

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


  (declare :my-tree <param-logical-type>)


  (define-param-logical-type :my-tree (%element)
    (:tuple %element (:uniform-list (:my-tree %element))))


  (define my-string-append
    (prim-proc string-append (<string> <string>) <string> pure))


  (define-simple-proc get-prefix (((level <integer>)) <string> force-pure)
    (if (<= level 0)
	""
	(my-string-append "  " (get-prefix (- level 1)))))


  (define-param-proc do-display-my-tree (%element2)
    (((tree (:my-tree %element2)) (level <integer>)) <none> nonpure)
    (let ((prefix <string> (get-prefix level)))
      (console-display-string prefix)
      (console-display (car tree))
      (console-newline)
      (let-mutable ((cur-subtrees (:uniform-list (:my-tree %element2))
				  (car (cdr tree))))
		   (until ((equal? cur-subtrees null))
			  (let ((cur-subtrees1
				 (cast (:nonempty-uniform-list (:my-tree %element2))
				       cur-subtrees)))
			    (do-display-my-tree (car cur-subtrees1)
						(+ level 1))
			    (set! cur-subtrees (cdr cur-subtrees1)))))))


  (define-param-proc display-my-tree (%element3)
    (((tree (:my-tree %element3))) <none> nonpure)
    (do-display-my-tree tree 0))


  (define main
    (lambda (() <integer> nonpure)
      (let ((my-tree
	     (list 1 null)))
	(display-my-tree my-tree))
      0)))
