(define list-fold-left fold-left)

(define (list-for-each-with-index proc ls)
  (list-fold-left (lambda (i elt)
                    (proc i elt)
                    (+ i 1))
                  0
                  ls))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define size vector-length)

(define ref vector-ref)

(define put! vector-set!)

(define new-of-size make-vector)

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-syntax fold-left
  (lambda (stx)
    (syntax-case stx ()
      ((fold-left ?proc ?init ?seq ?rest ...)
       (with-syntax (((rest ...) (generate-temporaries #'(?rest ...))))
         #'(let ((proc ?proc) (init ?init) (seq ?seq) (rest ?rest) ...)
             (let ((n (size seq)))
               (let loop ((i 0) (val init))
                 (if (>= i n)
                     val
                     (loop (+ i 1)
                           (proc val
                                 (ref seq i)
                                 (ref rest i)
                                 ...))))) ))))))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-syntax for-each
  (lambda (stx)
    (syntax-case stx ()
      ((for-each ?proc ?seq ?rest ...)
       (with-syntax (((param ...) (generate-temporaries #'(?seq ?rest ...)))
                     ((rest ...) (generate-temporaries #'(?rest ...))))
         #'(let ((proc ?proc) (seq ?seq) (rest ?rest) ...)
             (fold-left (lambda (val param ...)
                          (proc param ...))
                        #f
                        seq
                        rest
                        ...)))))))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-syntax for-each-with-index
  (lambda (stx)
    (syntax-case stx ()
      ((for-each-with-index ?proc ?seq ?rest ...)
       (with-syntax (((param ...) (generate-temporaries #'(?seq ?rest ...)))
                     ((rest ...) (generate-temporaries #'(?rest ...))))
         #'(let ((proc ?proc) (seq ?seq) (rest ?rest) ...)
             (fold-left (lambda (i param ...)
                          (proc i param ...)
                          (+ i 1))
                        0
                        seq
                        rest
                        ...)))))))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (copy seq)
  (let ((new (new-of-size (size seq))))
    (for-each-with-index (lambda (i elt)
                               (put! new i elt))
                         seq)
    new))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (from-reverse-list ls n)
  (let ((seq (new-of-size n)))
    (list-for-each-with-index (lambda (i elt)
                                (put! seq (- (- n 1) i) elt))
                              ls)
    seq))

(define-syntax map-to-reverse-list
  (lambda (stx)
    (syntax-case stx ()
      ((map-to-reverse-list ?proc ?seq ?rest ...)
       (with-syntax (((elt ...) (generate-temporaries #'(?seq ?rest ...)))
                     ((rest ...) (generate-temporaries #'(?rest ...))))
         #'(let ((proc ?proc)
                 (seq  ?seq)
                 (rest ?rest)
                 ...)
             (fold-left (lambda (ls elt ...)
                          (cons (proc elt ...) ls))
                        '()
                        seq
                        rest
                        ...)))))))

(define-syntax map
  (lambda (stx)
    (syntax-case stx ()
      ((map ?proc ?seq ?rest ...)
       (with-syntax (((rest ...) (generate-temporaries #'(?rest ...))))
         #'(let ((proc ?proc)
                 (seq  ?seq)
                 (rest ?rest)
                 ...)
             (from-reverse-list (map-to-reverse-list proc seq rest ...)
                                (size seq))))))))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(assert
 (equal?
  (fold-left (lambda (ls a)
               (cons (list a) ls))
             '()
             '#(1 2 3))
  '((3) (2) (1))))

(assert
 (equal?
  (fold-left (lambda (ls a b)
               (cons (list a b) ls))
             '()
             '#(1 2 3)
             '#(4 5 6))
  '((3 6) (2 5) (1 4))))

(assert
 (equal?
  (fold-left (lambda (ls a b c)
               (cons (list a b c) ls))
             '()
             '#(1 2 3)
             '#(4 5 6)
             '#(7 8 9))
  '((3 6 9) (2 5 8) (1 4 7))))

(assert
 (null?
  (let ((elts '(10 20 30)))
    (for-each (lambda (elt)
                (set! elts (remove elt elts)))
              '#(10 20 30))
    elts)))

(assert
 (null?
  (let ((elts '((1 4) (2 5) (3 6))))
    (for-each (lambda (a b)
                (set! elts (remove (list a b) elts)))
              '#(1 2 3)
              '#(4 5 6))
    elts)))

;; (for-each-with-index (lambda (i a) (display (list i a)) (newline))
;;                      '#(10 20 30))

;; (for-each-with-index (lambda (i a b) (display (list i a b)) (newline))
;;                      '#(10 20 30)
;;                      '#(40 50 60))

;; (for-each-with-index (lambda (i a b c) (display (list i a b c)) (newline))
;;                      '#(10 20 30)
;;                      '#(40 50 60)
;;                      '#(70 80 90))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(let ((a '#(10 20 30)))
  (let ((b (copy a)))
    (assert (equal? a b))
    (vector-set! a 0 100)
    (assert (not (equal? a b)))
    (list a b)))


;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(assert
 (equal?
  (map sqrt '#(4 9 16))
  '#(2 3 4)))

(assert
 (equal?
  (map list
       '#(a b c)
       '#(d e f))
  '#((a d) (b e) (c f))))

(assert
 (equal?
  (map list
       '#(a b c)
       '#(d e f)
       '#(g h i))
  '#((a d g) (b e h) (c f i))))