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


  (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-strong 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 l consumer end-iter)))


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


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


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


  (define-param-proc iter-every1 (%source)
		     (((proc (:procedure (%source) <boolean> pure))
		       (iter (:iterator %source)))
		      <boolean> pure)
    (let ((%target <boolean>))
      (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)
			  (or eof1?
			      (and
			       (proc (cast %source x1))
			       (my-loop (cast (:iterator-inst %source %target)
					      iter)))))))))
	(my-loop (param-proc-instance iter %target)))))


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