;; -*-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: error
;;  The purpose of this test is to test runtime errors.

(define-proper-program (tests test472)


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


  (declare :consumer <param-logical-type>)

  (define-param-logical-type :iterator-inst (%source %target)
    (:procedure ((:consumer %source %target)) %target pure))

  (define-param-logical-type :iterator (%source)
    (:param-proc (%target) ((:consumer %source %target)) %target pure))

  (define-param-logical-type :consumer (%source %target)
    (:procedure ((:maybe %source) <boolean>
		 (:maybe (:iterator-inst %source %target)))
		%target pure))

  (define-param-proc end-iter (%source %target)
		     (((consumer (:consumer %source %target))) %target pure)
    (consumer null #t null))

  (define-param-proc gen-list (%source %target)
		     (((l (:uniform-list %source))
		       (consumer (:consumer %source %target))
		       (genrest (:iterator-inst %source %target)))
		      %target pure)
    (match-type l
      ((<null>) (genrest consumer))
      ((l2 (:nonempty-uniform-list %source))
       (consumer (car l2) #f
		 (lambda (((consumer (:consumer %source %target)))
			  %target pure)
		   (gen-list (cdr l2) consumer genrest))))))

  (define-param-proc get-list-iterator (%source)
		     (((l (:uniform-list %source)))
		      (:iterator %source)
		      pure)
    (param-lambda (%target)
	(((consumer (:consumer %source %target))) %target pure)
      (gen-list '(1 2 3.0) consumer end-iter)))

  (define-param-proc my-map1 (%source %component)
		     (((proc (:procedure (%source) %component pure))
		       (iter (:iterator %source)))
		      (:uniform-list %component) pure)
    (let ((%target (:uniform-list %component)))
      (letrec ((my-loop
		(:procedure ((:iterator-inst %source %target)) %target pure)
		(lambda (((iter (:iterator-inst %source %target))) %target pure)
		  (iter (lambda (((x1 (:maybe %source))
				  (eof1? <boolean>)
				  (iter (:maybe (:iterator-inst %source %target))))
				 %target pure)
			  (if eof1?
			      null
			      (cons
			       (proc (cast %source x1))
			       (my-loop (cast (:iterator-inst %source %target)
					      iter)))))))))
	(my-loop (param-proc-instance iter %target)))))


  (define-simple-proc my-proc1 (((i <integer>)) (:pair <integer> <integer>)
				pure)
    (cons i i))


  (define-simple-proc main (() <none> nonpure)
    (let* ((l1 '(1 2 3 4 5))
	   (iter1 (get-list-iterator l1))
	   (l2 (my-map1 my-proc1 iter1)))
      (console-display-line l2))))
