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


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


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

  (define <source> <integer>)

  (define <target> <boolean>)

  (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)
    (force-pure-expr (console-display-line "my-end HEP"))
    (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-every1 (((proc (:procedure (<source>) <boolean> pure))
				  (x1 <data-structure>))
				<boolean> pure)
    (letrec ((my-loop
	      (:procedure (<iterator>) <target> pure)
	      (lambda (((x1g <iterator>)) <target> pure)
		(x1g (lambda (((x1 (:maybe <source>)) (eof1? <boolean>)
			       (x1g (:maybe <iterator>)))
			      <boolean> pure)
		       (or eof1?
			   (and
			    (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-every2 (((proc (:procedure (<source> <source>)
						    <boolean> pure))
				  (x1 <data-structure>)
				  (x2 <data-structure>))
				<boolean> 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>)))
			      <boolean> pure)
		       (x2g (lambda (((x2 (:maybe <source>)) (eof2? <boolean>)
				      (x2g (:maybe <iterator>)))
				     <boolean> pure)
			      (or (and eof1? eof2?)
				  (and
				   (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 positive? (((i <integer>)) <boolean> pure)
    (> i 0))


  (define-simple-proc main (() <none> nonpure)
    (let* ((l1 '(1 2 3 4 5))
	   (l2 '(1 2 -3 4 5))
	   (tmp1 (begin (console-display-line "*1*") 0))
	   (b1 (my-every1 positive? l1))
	   (tmp2 (begin (console-display-line "*2*") 0))
	   (b2 (my-every1 positive? l2))
	   (tmp3 (begin (console-display-line "*3*") 0))
	   (b3 (my-every2 = l1 l2))
	   (tmp4 (begin (console-display-line "*4*") 0))
	   (b4 (my-every2 = l1 l1)))
      (console-display-line b1)
      (console-display-line b2)
      (console-display-line b3)
      (console-display-line b4))))
