---

;; Задание 1. Макрос trace
(define-syntax trace
  (syntax-rules ()
    ((_ expr)
     (let ((v expr))
       (display 'expr)
       (display " => ")
       (write v)
       (newline)
       v))))

(define (zip . xss)
  (if (or (null? xss)
          (null? (car xss)))
      '()
      (cons (map car xss)
            (apply zip (map cdr xss)))))

(zip '(1 2 3) '(one two three))

(newline)

(define counter
  (let ((n 0))
    (lambda ()
      (set! n (+ n 1))
      n)))

(+ (trace (counter))
   (trace (counter)))

(newline)
(newline)

;; Задание 2. Каркас модульного тестирования
(define-syntax test
  (syntax-rules ()
    ((_ expr expected)
     (list 'test
           'expr
           (lambda () expr)
           (lambda () expected)))))

(define (run-test t)
  (if (not (and (pair? t) (eq? (car t) 'test)))
      (begin (display "<некорректный тест>") (newline) #f)
      (let ((src      (cadr  t))
            (get-act  (caddr t))
            (get-exp  (cadddr t)))
        (write src)
        (and (procedure? get-act)
             (let ((actual   (get-act))
                   (expected (get-exp)))
               (if (equal? actual expected)
                   (begin (display " ok") (newline) #t)
                   (begin
                     (display " FAIL") (newline)
                     (display "  Expected: ") (write expected) (newline)
                     (display "  Returned: ") (write actual)   (newline)
                     #f)))))))

(define (run-tests tests)
  (let loop ((ts tests) (ok? #t))
    (if (null? ts)
        ok?
        (loop (cdr ts)
              (and ok? (run-test (car ts)))))))

;; Задание 3. Деструктивное обращение
(define (reverse! seq . maybe-dest)
  (let ((dest (if (null? maybe-dest) seq (car maybe-dest))))
    (cond
      ((null? seq)   '())
      ((pair? seq)   (rev-list! seq dest))
      ((vector? seq) (rev-vector! seq dest))
      ((string? seq) (rev-string! seq dest))
      (else (error "неизвестный тип последовательности")))))

(define (rev-list! src dst)
  (if (eq? src dst)
      (rev-list-in-place! src)
      (rev-list-copy! src dst)))

(define (rev-list-in-place! lst)
  (define (len l) (if (null? l) 0 (+ 1 (len (cdr l)))))
  (let ((n (len lst)) (front lst) (k 0))
    (define (walk cur)
      (if (null? cur)
          'done
          (begin
            (walk (cdr cur))
            (if (< k (quotient n 2))
                (begin
                  (let ((tmp (car front)))
                    (set-car! front (car cur))
                    (set-car! cur tmp))
                  (set! front (cdr front))
                  (set! k (+ k 1))))
            'done)))
    (walk lst)))

(define (rev-list-copy! src dst)
  (let ((k 0))
    (define (walk cur)
      (if (null? cur)
          'done
          (begin
            (walk (cdr cur))
            (put-elem! dst k (car cur))
            (set! k (+ k 1)))))
    (walk src)))

(define (rev-vector! src dst)
  (let ((n (vector-length src)))
    (if (eq? src dst)
        (do ((i 0 (+ i 1)) (j (- n 1) (- j 1))) ((>= i j))
          (let ((tmp (vector-ref src i)))
            (vector-set! src i (vector-ref src j))
            (vector-set! src j tmp)))
        (do ((i 0 (+ i 1))) ((= i n))
          (put-elem! dst i (vector-ref src (- n 1 i)))))))

(define (rev-string! src dst)
  (let ((n (string-length src)))
    (if (eq? src dst)
        (do ((i 0 (+ i 1)) (j (- n 1) (- j 1))) ((>= i j))
          (let ((c (string-ref src i)))
            (string-set! src i (string-ref src j))
            (string-set! src j c)))
        (do ((i 0 (+ i 1))) ((= i n))
          (put-elem! dst i (string-ref src (- n 1 i)))))))

(define (put-elem! container i val)
  (cond
    ((vector? container) (vector-set! container i val))
    ((string?  container)
     (if (char? val)
         (string-set! container i val)
         (error "в строку можно писать только символы")))
    ((pair? container)
     (let loop ((c container) (k i))
       (if (= k 0)
           (set-car! c val)
           (loop (cdr c) (- k 1)))))
    (else (error "неподходящий приемник"))))

;; Задание 4. Разложение на множители
(define (exppt b e) (expt b e))

(define (length= l n)
  (let loop ((x l) (k n))
    (cond ((zero? k) (null? x))
          ((null? x) #f)
          (else (loop (cdr x) (- k 1))))))

(define (binop? e op)
  (and (pair? e) (eq? (car e) op) (length= e 3)))

(define (exppt? e)
  (and (pair? e) (eq? (car e) 'exppt) (length= e 3)))

(define (ebase e) (cadr  e))
(define (eexp  e) (caddr e))

(define (part-exppt-k? part k)
  (and (exppt? part) (= (eexp part) k)))

(define (mk op a b) (list op a b))

(define (fac-sq-diff a b)
  (list '* (mk '- a b) (mk '+ a b)))

(define (fac-cube-diff a b)
  (list '* (mk '- a b)
            (list '+ (list 'exppt a 2) (mk '* a b) (list 'exppt b 2))))

(define (fac-cube-sum a b)
  (list '* (mk '+ a b)
            (list '+ (list 'exppt a 2)
                     (mk '- (list 'exppt b 2) (mk '* a b)))))

(define (factorize e)
  (cond
    ((and (binop? e '-)
          (part-exppt-k? (cadr e) 2)
          (part-exppt-k? (caddr e) 2))
     (fac-sq-diff (ebase (cadr e)) (ebase (caddr e))))
    ((and (binop? e '-)
          (part-exppt-k? (cadr e) 3)
          (part-exppt-k? (caddr e) 3))
     (fac-cube-diff (ebase (cadr e)) (ebase (caddr e))))
    ((and (binop? e '+)
          (part-exppt-k? (cadr e) 3)
          (part-exppt-k? (caddr e) 3))
     (fac-cube-sum (ebase (cadr e)) (ebase (caddr e))))
    (else e)))


;;Тесты reverse!
(define rev-tests
  (list
   (test (let ((xs '(a b c d e))) (reverse! xs) xs) '(e d c b a))
   (test (let ((ys (vector 1 2 3 4 5))) (reverse! ys) ys) #(5 4 3 2 1))
   (test (let ((zs (string #\h #\e #\l #\l #\o))) (reverse! zs) zs) "olleh")
   (test (let ((xs '())) (reverse! xs) xs) '())
   (test (let ((xs '(9))) (reverse! xs) xs) '(9))
   (test (let ((xs '(1 2 3 4))) (reverse! xs) xs) '(4 3 2 1))
   (test (let ((xs '(a b c d e)) (ys '(0 0 0 0 0)))
           (reverse! xs ys) ys)
         '(e d c b a))
   (test (let ((xs '(1 2 3)) (yv (vector 0 0 0)))
           (reverse! xs yv) yv)
         #(3 2 1))
   (test (let ((zs (string #\a #\b #\c)) (ls (list #\z #\z #\z)))
           (reverse! zs ls) ls)
         '(#\c #\b #\a))
   (test (let* ((as '(a b c)) (bs (append '(x y z) as)))
           (set-car! as 1) (reverse! bs) (list bs as))
         '((c b 1 z y x) (z y x)))
   (test (let* ((as '(a b c)) (bs (append '(x y z) as)))
           (set-car! as 1) (reverse! bs) (reverse! (cdr bs)) (list bs as))
         '((c x y z 1 b) (z 1 b)))))

(display (run-tests rev-tests))
(newline)

;;Тесты factorize
(define fact-tests
  (list
   (test (factorize '(- (exppt x 2) (exppt y 2)))
         '(* (- x y) (+ x y)))
   (test (factorize '(- (exppt (+ first 1) 2) (exppt (- second 1) 2)))
         '(* (- (+ first 1) (- second 1))
             (+ (+ first 1) (- second 1))))
   (test (factorize '(- (exppt a 3) (exppt b 3)))
         '(* (- a b) (+ (exppt a 2) (* a b) (exppt b 2))))
   (test (factorize '(+ (exppt a 3) (exppt b 3)))
         '(* (+ a b) (+ (exppt a 2) (- (exppt b 2) (* a b)))))
   (test (factorize '(- (exppt x 4) (exppt y 2)))
         '(- (exppt x 4) (exppt y 2)))
   (test (factorize '(+ x y)) '(+ x y))
   (test (eval (list (list 'lambda '(x y)
                           (factorize '(- (exppt x 2) (exppt y 2))))
                     3 5)
               (interaction-environment))
         -16)
   (test (eval (list (list 'lambda '(a b)
                           (factorize '(+ (exppt a 3) (exppt b 3))))
                     2 3)
               (interaction-environment))
         35)
   (test (eval (list (list 'lambda '(a b)
                           (factorize '(- (exppt a 3) (exppt b 3))))
                     4 1)
               (interaction-environment))
         63)))

(display (run-tests fact-tests))
(newline)