;; -*-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: error
;;   (erroneous definitions of variable lists2)


(define-proper-program (tests test18)


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


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


  (define-param-proc my-map-car (%types)
    (((lists (type-loop %type1 %types (:uniform-list %type1))))
     %types
     pure)
    (if (null? lists)
	null
	(let ((lists2 (type-loop %type2 %types
				 (:nonempty-uniform-list %type2))))
	  (cons (car (car lists2))
		(my-map-car (cdr lists2))))))


  (define-param-proc my-map-cdr (%types)
    (((lists (type-loop %type1 %types (:uniform-list %type1))))
     (type-loop %type2 %types (:uniform-list %type2))
     pure)
    (if (null? lists)
	null
	(let ((lists2 (type-loop %type %types
				 (:nonempty-uniform-list %type))))
	  (cons (cdr (car lists2))
		(my-map-cdr (cdr lists2))))))


  (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 %type %arglist
					(:nonempty-uniform-list %type))
			     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 "a" "b" "c"))
	     (result (my-map cons lst1 lst2)))
	(console-display result))
      0)))
