;; -*-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 test468)


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


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

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

  (define-param-logical-type :consumer (%source %target)
    (:procedure ((:maybe %source) <boolean>
		 (:maybe (:iterator %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 %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-iterator0 (%source %target)
		     (((l (:uniform-list %source)))
		      (:iterator %source %target)
		      pure)
    (lambda (((consumer (:consumer %source %target))) %target pure)
      (gen-list l consumer end-iter)))

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


  (define-param-proc my-map2 (%source1 %source2 %target %component)
		     (((proc (:procedure (%source1 %source2) %component pure))
		       (iter1 (:iterator %source1 %target))
		       (iter2 (:iterator %source2 %target)))
		      %target pure)
    (letrec ((my-loop
	      (:procedure ((:iterator %source1 %target)
			   (:iterator %source2 %target))
			  %target pure)
	      (lambda (((iter1 (:iterator %source1 %target))
			(iter2 (:iterator %source2 %target))) %target pure)
		(iter1 (lambda (((x1 (:maybe %source1))
				 (eof1? <boolean>)
				 (iter1 (:maybe (:iterator %source1 %target))))
			      %target pure)
			 (iter2 (lambda (((x2 (:maybe %source2))
					  (eof2? <boolean>)
					  (iter2 (:maybe (:iterator
							  %source2 %target))))
					 %target pure)
				  (if (or eof1? eof2?)
				      null
				      (cons
				       (proc (cast %source1 x1)
					     (cast %source2 x2))
				       (my-loop (cast
						 (:iterator %source1 %target)
						 iter1)
						(cast
						 (:iterator %source2 %target)
						 iter2)))))))))))
      (my-loop iter1 iter2)))

  (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))
	   (l2 '(10.5 20.5 -30.5 40.5 50.5))
	   (iter-proc1 (param-lambda (%target)
			   (((l (:uniform-list <integer>)))
			    (:iterator <integer> %target)
			    pure)
			 ((param-proc-instance get-list-iterator0 
					       <integer> %target)
			  l)))
	   (iter-inst1
	    ((param-proc-instance iter-proc1 (:uniform-list (:pair <integer> <integer>)))
	     l1))
	   (l3 (my-map1 my-proc1 iter-inst1)))
	   ;; (iter1-2 ((param-proc-instance get-list-iterator
	   ;; 				  <integer>
	   ;; 				  (:uniform-list
	   ;; 				   (:pair <integer> <real>)))
	   ;; 	     l1))
	   ;; (iter2 ((param-proc-instance get-list-iterator
	   ;; 				<real>
	   ;; 				(:uniform-list
	   ;; 				 (:pair <integer> <real>)))
	   ;; 	     l2))
	   ;; (l4 (my-map2 cons iter1-2 iter2)))
      (console-display-line l3))))
;;      (console-display-line l4))))
