(set i0  nil
     i1  '(t)
     i2  '(t t)
     i10 '(t t t t t t t t t t)
     i16 '(t t t t t t t t t t t t t t t t))

(set i< udrop)

(def i+ args
  (apply append args))

(def i- (x y)
  (if (no x) (list '- y)
      (no y) (list '+ x)
             (i- (cdr x) (cdr y))))

(def i* args
  (foldr (fn (x y) (fuse (con x) y))
         i1
         args))

(def i/ (x y (o q))
  (if (no x)   (list q nil)
      (i< x y) (list q x)
               (i/ (udrop y x) y (i+ q i1))))

(def i^ (x y)
  (foldr i* i1 (map (con x) y)))

(def r+ ((xn xd) (yn yd))
  (list (i+ (i* xn yd) (i* yn xd))
        (i* xd yd)))

(def r- ((xn xd) (yn yd))
  (let (s n) (i- (i* xn yd) (i* yn xd))
    (list s n (i* xd yd))))

(def r* ((xn xd) (yn yd))
  (list (i* xn yn) (i* xd yd)))

(def r/ ((xn xd) (yn yd))
  (list (i* xn yd) (i* xd yn)))

(set srzero (list '+ i0 i1)
     srone  (list '+ i1 i1))

(def sr+ ((xs . xr) (ys . yr))
  (if (= xs '-)
      (if (= ys '-)
          (cons '- (r+ xr yr))
          (r- yr xr))
      (if (= ys '-)
          (r- xr yr)
          (cons '+ (r+ xr yr)))))

(def sr- (x y)
  (sr+ x (srinv y)))

(def srinv ((s n d))
  (list (if (and (= s '+) (~= n i0)) '- '+)
        n
        d))

(def sr* ((xs . xr) (ys . yr))
  (cons (if (= xs '-)
            (case ys - '+ '-)
            ys)
        (r* xr yr)))

(def sr/ (x y)
  (sr* x (srrecip y)))

(def srrecip ((s (t n [~= _ i0]) d))
  (list s d n))

(def sr< ((xs xn xd) (ys yn yd))
  (if (= xs '+)
      (if (= ys '+)
          (i< (i* xn yd) (i* yn xd))
          nil)
      (if (= ys '+)
          (~= xn yn i0)
          (i< (i* yn xd) (i* xn yd)))))

(set srnum cadr
     srden caddr)

(def c+ ((xr xi) (yr yi))
  (list (sr+ xr yr) (sr+ xi yi)))

(def c* ((xr xi) (yr yi))
  (list (sr- (sr* xr yr) (sr* xi yi))
        (sr+ (sr* xi yr) (sr* xr yi))))