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


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


  (define <data-structure> (:uniform-list <integer>))

  (define <source> <integer>)

  (define <target> (:uniform-list (:pair <integer> <integer>)))

  (declare <consumer> :procedure)

  (define <iterator> (:procedure (<consumer>) <target> pure))

  (define <consumer> (:procedure
		      ((:maybe <source>) <boolean> (:maybe <iterator>))
		      <target> pure))

  (define-simple-proc my-end (((consumer <consumer>)) <target> pure)
    (consumer null #t null))

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

  (define-simple-proc my-map1 (((proc (:procedure (<source>)
						  (:pair <source> <source>)
						  pure))
				(x1 <data-structure>))
			       <target> pure)
    (letrec ((my-loop
	      (:procedure (<iterator>) <target> pure)
	      (lambda (((x1g <iterator>)) <target> pure)
		(x1g (lambda (((x1 (:maybe <source>)) (eof1? <boolean>)
			       (x1g (:maybe <iterator>)))
			      <target> pure)
		       (if eof1?
			   null
			   (cons
			    (proc (cast <source> x1))
			    (my-loop (cast <iterator> x1g)))))))))
      (my-loop (lambda (((consumer <consumer>)) <target> pure)
		 (gen-list x1 consumer my-end)))))


  (define-simple-proc my-map2 (((proc (:procedure (<source> <source>)
						  (:pair <source> <source>)
						  pure))
				(x1 <data-structure>)
				(x2 <data-structure>))
			       <target> pure)
    (letrec ((my-loop
	      (:procedure (<iterator> <iterator>) <target> pure)
	      (lambda (((x1g <iterator>) (x2g <iterator>)) <target> pure)
		(x1g (lambda (((x1 (:maybe <source>)) (eof1? <boolean>)
			       (x1g (:maybe <iterator>)))
			      <target> pure)
		       (x2g (lambda (((x2 (:maybe <source>)) (eof2? <boolean>)
				      (x2g (:maybe <iterator>)))
				     <target> pure)
			      (if (or eof1? eof2?)
				  null
				  (cons
				   (proc (cast <source> x1)
					 (cast <source> x2))
				   (my-loop (cast <iterator> x1g)
					    (cast <iterator> x2g)))))))))))
      (my-loop (lambda (((consumer <consumer>)) <target> pure)
		 (gen-list x1 consumer my-end))
	       (lambda (((consumer <consumer>)) <target> pure)
		 (gen-list x2 consumer my-end)))))


  (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 20 -30 40 50))
	   (l3 (my-map1 my-proc1 l1))
	   (l4 (my-map2 cons l1 l2)))
      (console-display-line l3)
      (console-display-line l4))))
