Длинная арифметика

(define (l->s l)
  l)
(define (s->l s)
  s)

(define (string->cifra S k)
  (- (char->integer (string-ref S (- (string-length S) k))) (char->integer #\0)))

(define (s->0 s1 s2)
   (define (iter S)
     (if (>= (string-length S) (string-length s2)) S (iter (string-append "0" S))))
  (iter s1))

(define (l++ s1 s2)
   (let ((s1 (s->0 s1 s2))
        (s2 (s->0 s2 s1)))
   (define (iter S i o)
     (if (> i (string-length s1))
         (if (= o 1) (string-append "1" S) S)
         (let ((k1 (string->cifra s1 i))
               (k2 (string->cifra s2 i)))
              (iter (string-append (number->string (remainder (+ k1 k2 o) 10)) S)
                    (+ i 1) (quotient (+ k1 k2 o) 10)))))
  (iter "" 1 0)))

(define (delete0 S)
  (if (equal? S "0") "0"
      (if (equal? (string-ref S 0) #\0) (delete0 (substring S 1)) S)))

(define (inverse S)
  (if (> (string-length S) 0)
    (string-append (number->string (- 9 (string->cifra S (string-length S)))) (inverse (substring S 1)))
    ""))

(define (l-- s1 s2)
   (define (iter S i o s1 s2)
     (if (> i (string-length s1))
         (if (= o 1)
            (string-append "9" S)
            S)
         (let ((k1 (string->cifra s1 i))
               (k2 (string->cifra s2 i)))
              (iter (string-append (number->string (remainder (- (+ k1 10) k2 o) 10)) S) (+ i 1) (- 1 (quotient (- (+ k1 10) k2 o) 10)) s1 s2) )))
  (let ((k(iter "" 1 0 (s->0 s1 s2) (s->0 s2 s1))))
       (if (> (string-length k) (string-length s1))
           (string-append "-" (l++ (delete0 (inverse k)) "1"))
           (delete0 k)))  )

(define (my-even? S)
  (even? (string->cifra S 1)))

(define (delenie2 x)
  (number->string (/ (string->number x) 2)))

(define (l** x y)
  (if (or (equal? y "0") (equal? x "0"))
      "0"
      (if (equal? y "1")
          x
          (if (my-even? y)
             (l** (l++ x x) (delenie2 y))
             (l++ x (l** x (l-- y "1")))))))

(define (>? x y)
  (not (or  (equal? (string-ref (l-- x y) 0) #\-) (equal? (l-- x y)  "0"))))

(define (=? x y)
 (equal? (l-- x y)  "0"))

(define (l// x y)
   (define (del x y S)
     (if (or (=? x y) (>? x y))
         (del (l-- x y) y (+ S 1))
         (list (number->string S) x)))
   (define (iter x S o)
     (if (equal? x "")
         S
         (let ((d (del (string-append o (substring x 0 1)) y 0)))
           (iter (substring x 1) (string-append S (car d)) (cadr d)))))
   (if (or (>? x y) (equal? x y) (equal? x "0"))
       (delete0 (iter x "" "0"))
       "0"))

(define (l+ . args)
  (define (iter l S)
    (if (zero? (length l)) S (iter (cdr l) (l++ (car l) S))))
  (iter args "0"))

(define (l- . args)
  (define (iter l S)
    (if (zero? (length l)) S (iter (cdr l) (l-- S (car l)))))
  (iter (cdr args) (car args)))

(define (l* . args)
  (define (iter l S)
    (if (zero? (length l)) S (iter (cdr l) (l** (car l) S))))
  (iter args "1"))

(define (l-quotient . args)
  (define (iter l S)
    (if (zero? (length l)) S (iter (cdr l) (l//  S (car l)))))
  (iter (cdr args) (car args)))

(define (l-remainder lx ly)
  (l-- lx (l** (l// lx ly) ly)))

(define (l-factorial x)
  (define (iter i S)
    (if (>? i x) S (iter (l++ i "1") (l** S i))))
  (iter "1" "1"))

(define (l= . args)
  (define (iter l )
    (if (zero? (length l))
        #t
        (if (equal? (car l) (car args))
          (iter (cdr l))
          #f)))
  (iter (cdr args)))