;; -*-theme-d-*-

;; Copyright (C) 2008-2013 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 test29)


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


  (define-param-proc my-and-map1? (%type1)
    (((proc (:procedure (%type1) <boolean> pure))
      (lst (:uniform-list %type1)))
     <boolean>
     pure)
    (if (null? lst)
	#t
	(let* ((lst2 (cast (:nonempty-uniform-list %type1) lst))
	       (hd (car lst2))
	       (tl (cdr lst2)))
	  (and (proc hd)
	       (my-and-map1? proc tl)))))


  (define-simple-proc my-map-car0
    (((lists (:uniform-list <nonempty-list>)))
     <list>
     pure)
    (if (null? lists)
	null
	;; If we enter here 'lists' is nonempty.
	(let ((lists2 (cast (:nonempty-uniform-list <nonempty-list>) lists)))
	  (cons (car (car lists2))
		(my-map-car0 (cdr lists2))))))


  (define-param-proc my-map-car (%types)
    (((lists (type-loop %type2 %types (:nonempty-uniform-list %type2))))
     %types
     pure)
    (cast %types (my-map-car0 lists)))


  (define-simple-proc my-map-cdr0
    (((lists (:uniform-list <nonempty-list>)))
     (:uniform-list <list>)
     pure)
    (if (null? lists)
	null
	;; If we enter here 'lists' is nonempty.
	(let ((lists2 (cast (:nonempty-uniform-list <nonempty-list>) lists)))
	  (cons (cdr (car lists2))
		(my-map-cdr0 (cdr lists2))))))


  (define-param-proc my-map-cdr (%types)
    (((lists (type-loop %type4 %types (:nonempty-uniform-list %type4))))
     (type-loop %type5 %types (:uniform-list %type5))
     pure)
    (cast (type-loop %type6 %types (:uniform-list %type6))
	  (my-map-cdr0 lists)))


  (define-param-proc my-map (%arglist %result)
    (((proc (:procedure ((splice %arglist)) %result pure))
      (lists (splice (type-loop %type %arglist (:uniform-list %type)))))
     (:uniform-list %result)
     pure)
    (if (my-and-map1? not-null? lists)
	(let* ((lists2 (cast (type-loop %type7 %arglist
					(:nonempty-uniform-list %type7))
			     lists))
	       (cars (my-map-car lists2))
	       (cdrs (my-map-cdr lists2)))
	  (cons
	   (apply proc cars)
	   (apply my-map (cons proc cdrs))))
	null))


  (define main
    (lambda (() <integer> nonpure)
      (let* ((lst1 (list 1 2 3))
	     (lst2 (list 4 5 6))
	     (result (my-map + lst1 lst2)))
	(console-display result)
	(console-newline))
      0)))
