(require 'stdlib)

(define (map fn first #!rest lists)
  (if rest
      (apply map2+ fn first lists)
    (apply map1 fn first)))

(define (map1 fn xs)
  (cond ((null xs) nil)
        (t (cons (fn (first xs)) (map1 fn (rest xs))))))

(define (map2+ fn #!rest lists)
  (cond ((memq nil lists) nil)
        (t (cons (apply fn (map1 car lists))
                 (apply map2+ fn (map1 cdr lists))))))

(define (assert #!rest forms)
  "TODO rewrite to a macro so we can print uneval'ed forms"
  (when (first forms)
    (printf "%s - " (list (first forms) (second forms)))
    (if (equal (first forms) (second forms))
        (puts "ok")
      (puts "* FAILED *"))
    (apply assert (cddr forms))))

(assert
 '(1 2 3) (map car '((1 a) (2 b) (3 c)))
 '(3 4 2 5 6) (map abs '(3 -4 2 -5 -6))
 '((A . 1) (B . 2) (C . 3)) (map cons '(A B C) '(1 2 3)))

(define assertion-list
 '((1 2 3) (map car '((1 a) (2 b) (3 c)))
   (3 4 2 5 6) (map abs '(3 -4 2 -5 -6))
   ((A . 1) (B . 2) (C . 3)) (map cons '(A B C) '(1 2 3))))

;; IDEA assert macro using map:
;; first transpose, using unzip2:
;;   ((exp1 act1)
;;    (exp2 act2))
;; to
;;   ((exp1 exp2)
;;    (act1 act2))
;; then
;;   (map (lambda (exp act) (assert (equal exp act))) '(exps) '(acts))


;; logic, e.g.
;; (map + '(1 2 3) '(4 5 6)) => (5 7 9)
;; (cons (+ 1 4) (map fn (rest list1) (rest list2) ...))
;;                       (mapcar cdr lists)
;; (cons (apply fn (mapcar car lists)) (map fn (mapcar cdr lists)))
;; terminate as soon as one of the lists becomes nil

;; from the hyperspec:
;; (mapcar #'car '((1 a) (2 b) (3 c))) =>  (1 2 3) 
;; (mapcar #'abs '(3 -4 2 -5 -6)) =>  (3 4 2 5 6)
;; (mapcar #'cons '(a b c) '(1 2 3)) =>  ((A . 1) (B . 2) (C . 3))

;; TODO dolist-m: (dolist (a b '((1 2) (3 4))) fn)

;; from scheme48::rts/base.scm
;;(define (map proc first . rest)
;;  (if (null? rest)
;;      (map1 proc first)
;;      (map2+ proc first rest)))

;;(define (map1 proc l)
;;  ;; (reduce (lambda (x l) (cons (proc x) l)) '() l)
;;  (if (null? l)
;;      '()
;;      (cons (proc (car l)) (map1 proc (cdr l)))))

;;(define (map2+ proc first rest)
;;  (if (or (null? first)
;;	  (any null? rest))
;;      '()
;;      (cons (apply proc (cons (car first) (map1 car rest)))
;;	    (map2+ proc (cdr first) (map1 cdr rest)))))

;;(define (for-each proc first . rest)
;;  (if (null? rest)
;;      (for-each1 proc first)
;;      (for-each2+ proc first rest)))

;;(define (for-each1 proc first)
;;  (let loop ((first first))
;;    (if (null? first)
;;	(unspecific)
;;	(begin (proc (car first))
;;	       (loop (cdr first))))))

;;(define (for-each2+ proc first rest)
;;  (let loop ((first first) (rest rest))
;;    (if (or (null? first)
;;	    (any null? rest))
;;	(unspecific)
;;	(begin (apply proc (cons (car first) (map car rest)))
;;	       (loop (cdr first) (map cdr rest))))))