;; -*-theme-d-*-

;; Copyright (C) 2016 Tommi Höynälänmaa
;; Distributed under GNU Lesser General Public License version 3,
;; see file doc/LGPL-3.

(define-body (standard-library nonpure-iterator)


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


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


  (define-param-proc get-list-nonpure-iterator (%source)
		     (((l (:uniform-list %source)))
		      (:nonpure-iterator %source)
		      nonpure)
    (param-lambda (%target)
	(((consumer (:nonpure-consumer %source %target))) %target nonpure)
      (gen-list-nonpure l consumer nonpure-end-iter)))


  (define-param-proc gen-mutable-vector-nonpure (%source %target)
		     (((v (:mutable-vector %source))
		       (consumer (:nonpure-consumer %source %target))
		       (genrest (:nonpure-iterator-inst %source %target)))
		      %target nonpure)
    (letrec ((my-loop (:procedure (<integer>
				   (:nonpure-consumer %source %target))
				  %target pure)
		      (lambda (((i <integer>)
				(consumer (:nonpure-consumer %source %target)))
			       %target pure)
			(if (equal? i (mutable-vector-length v))
			    (genrest consumer)
			    (consumer
			     (mutable-vector-ref v i)
			     #f
			     (lambda (((consumer
					(:nonpure-consumer %source %target)))
				      %target pure)
			       (my-loop (+ i 1) consumer)))))))
      (my-loop 0 consumer)))


  (define-param-proc get-mutable-vector-nonpure-iterator (%source)
		     (((v (:mutable-vector %source)))
		      (:nonpure-iterator %source)
		      nonpure)
    (param-lambda (%target)
	(((consumer (:nonpure-consumer %source %target))) %target nonpure)
      (gen-mutable-vector-nonpure v consumer nonpure-end-iter)))


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


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


  (define-param-proc nonpure-iter-every1 (%source)
		     (((proc (:procedure (%source) <boolean> nonpure))
		       (iter (:nonpure-iterator %source)))
		      <boolean> nonpure)
    (let ((%target <boolean>))
      (letrec ((my-loop
		(:procedure ((:nonpure-iterator-inst %source %target))
			    %target nonpure)
		(lambda (((iter (:nonpure-iterator-inst %source %target)))
			 %target nonpure)
		  (iter (lambda (((x1 (:maybe %source))
				  (eof1? <boolean>)
				  (iter (:maybe
					 (:nonpure-iterator-inst
					  %source %target))))
				 %target nonpure)
			  (or eof1?
			      (and
			       (proc (cast %source x1))
			       (my-loop
				(cast (:nonpure-iterator-inst %source %target)
				      iter)))))))))
	(my-loop (param-proc-instance iter %target)))))


  (define-param-proc nonpure-iter-every2 (%source1 %source2)
		     (((proc (:procedure (%source1 %source2) <boolean>
					 nonpure))
		       (iter1 (:nonpure-iterator %source1))
		       (iter2 (:nonpure-iterator %source2)))
		      <boolean>
		      nonpure)
    (let ((%target <boolean>))
      (letrec ((my-loop
		(:procedure ((:nonpure-iterator-inst %source1 %target)
			     (:nonpure-iterator-inst %source2 %target))
			    %target nonpure)
		(lambda (((iter1 (:nonpure-iterator-inst %source1 %target))
			  (iter2 (:nonpure-iterator-inst %source2 %target)))
			 %target
			 nonpure)
		  (iter1 (lambda (((x1 (:maybe %source1))
				   (eof1? <boolean>)
				   (iter1 (:maybe
					   (:nonpure-iterator-inst
					    %source1 %target))))
				  %target nonpure)
			   (iter2 (lambda (((x2 (:maybe %source2))
					    (eof2? <boolean>)
					    (iter2
					     (:maybe (:nonpure-iterator-inst
						      %source2 %target))))
					   %target nonpure)
				    (or (or eof1? eof2?)
					(and
					 (proc (cast %source1 x1)
					       (cast %source2 x2))
					 (my-loop (cast
						   (:nonpure-iterator-inst
						    %source1
						    %target)
						   iter1)
						  (cast
						   (:nonpure-iterator-inst
						    %source2 %target)
						   iter2)))))))))))
	(my-loop (param-proc-instance iter1 %target)
		 (param-proc-instance iter2 %target)))))


  (define-param-proc nonpure-iter-for-each1 (%source)
		     (((proc (:procedure (%source) <none> nonpure))
		       (iter (:nonpure-iterator %source)))
		      <none> nonpure)
    (let ((%target <none>))
      (letrec ((my-loop
		(:procedure ((:nonpure-iterator-inst %source %target))
			    %target nonpure)
		(lambda (((iter (:nonpure-iterator-inst %source %target)))
			 %target nonpure)
		  (iter (lambda (((x1 (:maybe %source))
				  (eof1? <boolean>)
				  (iter
				   (:maybe
				    (:nonpure-iterator-inst %source %target))))
				 %target nonpure)
			  (if eof1?
			      null
			      (begin
			       (proc (cast %source x1))
			       (my-loop
				(cast (:nonpure-iterator-inst %source %target)
				      iter)))))))))
	(my-loop (param-proc-instance iter %target)))))


  (define-param-proc nonpure-iter-for-each2 (%source1 %source2)
		     (((proc (:procedure (%source1 %source2) <none>
					 nonpure))
		       (iter1 (:nonpure-iterator %source1))
		       (iter2 (:nonpure-iterator %source2)))
		      <none>
		      nonpure)
    (let ((%target <none>))
      (letrec ((my-loop
		(:procedure ((:nonpure-iterator-inst %source1 %target)
			     (:nonpure-iterator-inst %source2 %target))
			    %target nonpure)
		(lambda (((iter1 (:nonpure-iterator-inst %source1 %target))
			  (iter2 (:nonpure-iterator-inst %source2 %target)))
			 %target nonpure)
		  (iter1 (lambda (((x1 (:maybe %source1))
				   (eof1? <boolean>)
				   (iter1
				    (:maybe
				     (:nonpure-iterator-inst
				      %source1 %target))))
				  %target nonpure)
			   (iter2 (lambda (((x2 (:maybe %source2))
					    (eof2? <boolean>)
					    (iter2
					     (:maybe (:nonpure-iterator-inst
						      %source2 %target))))
					   %target nonpure)
				    (if (or eof1? eof2?)
					null
					(begin
					 (proc (cast %source1 x1)
					       (cast %source2 x2))
					 (my-loop (cast
						   (:nonpure-iterator-inst
						    %source1 %target)
						   iter1)
						  (cast
						   (:nonpure-iterator-inst
						    %source2 %target)
						   iter2)))))))))))
	(my-loop (param-proc-instance iter1 %target)
		 (param-proc-instance iter2 %target)))))


  (define-param-proc gen-generator (%source %target)
		     (((proc (:procedure () %source nonpure))
		       (terminate? (:procedure (%source) <boolean> pure))
		       (consumer (:nonpure-consumer %source %target))
		       (genrest (:nonpure-iterator-inst %source %target)))
		      %target nonpure)
    (let ((x (proc)))
      (if (terminate? x)
	  (genrest consumer)
	  (consumer x #f
		    (lambda (((consumer (:nonpure-consumer %source %target)))
			     %target pure)
		      (gen-generator proc terminate? consumer genrest))))))


  (define-param-proc generator->iterator (%source)
		     (((proc (:procedure () %source nonpure))
		       (terminate? (:procedure (%source) <boolean> pure)))
		      (:nonpure-iterator %source)
		      nonpure)
    (param-lambda (%target)
	(((consumer (:nonpure-consumer %source %target))) %target nonpure)
      (gen-generator proc terminate? consumer nonpure-end-iter))))


