; http://cap-lore.com/MathPhys/Field/finite
; This program relies on case sensitive symbols.
(let* ((Dog (fileVal "Do")) (Do (Dog 'Do)) (DoV (Dog 'DoV))
  (vr vector-ref)(mv make-vector)(vs! vector-set!)(vl vector-length))
(lambda (p)
(ylppa ((fileVal "GFp") p) (lambda (m+ m- m* m/)
(let ((p+ (lambda (a b) (let* ((la (vl a))(lb (vl b))(pl (lambda (la a lb b)
          (DoV lb (lambda (j) (if (< j la) (m+ (vr a j) (vr b j)) (vr b j)))))))
        (if (< la lb) (pl la a lb b) (pl lb b la a)))))
      (p- (lambda (a) (DoV (vl a) (lambda (j) (m- (vr a j))))))
      (trim (lambda (a) (let m ((n (vl a))) (if (zero? n) '#()
       (if (zero? (vr a (- n 1))) (if (= 1 n) '#() (m (- n 1)))
         (DoV n (lambda (j) (vr a j)))))))))
(let ((pqr (lambda (N d) (let* ((n (trim N)) (ln (vl n)) (ldm (- (vl d) 1)))
        (if (< ln ldm) (cons '#() n) (let ((ht (vr d ldm)))
           (if (zero? ht) (ex "divide check") '())
             (let* ((htr (m/ ht)) (nd (DoV ldm (lambda (i) (m* htr (vr d i)))))
                    (q (mv (- ln ldm))))
               (Do (- ln ldm) (lambda (j) (let ((t (vr n (+ j ldm))))
                 (vs! q j (m* htr t))
                 (Do ldm (lambda (i) (vs! n (+ i j) (m+ (vr n (+ i j))
                   (m- (m* t (vr nd i))))))))))
               (cons q (DoV ldm (lambda (j) (vr n j))))))))))
      (p* (lambda (a b) (let* ((la (vl a))(lb (vl b)))
        (if (= (+ la lb) 0) '#() (let ((p (mv (+ la lb -1) 0)))
           (Do la (lambda (i) (Do lb (lambda (j) (vs! p (+ i j) (m+ (vr p (+ i j))
                 (m* (vr a i) (vr b j)))))))) p))))))
(let* ((pegcd (lambda (a b) (let pg ((a a)(b (trim b)))
           (let* ((qr (pqr a b))(q (car qr))(r (trim (cdr qr))))
             (if (zero? (vl r)) (cons '#() (vector (m/ (vr b (- (vl b) 1)))))
               (let ((c (pg b r))) (cons (cdr c) (p+ (car c) (p- (p* (cdr c) q))))))))))
     (pgcmd (lambda (a b) (let* ((A (trim a))(B (trim b))(la (vl A))(lb (vl B)))
           (letrec ((d (lambda (l s) (if (zero? (vl s)) l (d s (trim (cdr (pqr l s))))))))
              (let* ((a (if (< la lb) (d B A) (d A B))) (l (vl a)))
                 (let ((f (vr a (- l 1)))) (if (> f 1) (let ((r (m/ f)))
                    (Do l (lambda (j) (vs! a j (m* r (vr a j))))))) a))))))
     (mexpt (lambda (u p f) ; compute u^p mod f
       (let ((l (vl f))) (let pl ((u u)(p p))
          (if (zero? p) (let ((a (mv (- l 1) 0))) (vs! a 0 1) a)
          (if (even? p) (pl (cdr (pqr (p* u u) f)) (/ p 2))
          (if (= p 1) u (cdr (pqr (p* u (pl u (- p 1))) f)))))))))
     (tip (lambda (f)  ; f is vector polynomial, list of coefficients, constant first.
        ;Testing a Polynomial for Irreducibility
        ; From Algorithm 4.69 of HB. of App. Cryptog.
        (let tr ((u '#(0 1)) (m (vl f))) (or (< m 3)
           (let* ((up (mexpt u p f)) (d (pgcmd f (p+ up (vector 0 (- p 1))))))
             (and (= 1 (vl d)) (tr up (- m 2))))))))
     (p->i (lambda (P) (let ((w (vl P))) (let m ((n 0))
        (if (= w n) 0 (+ (vr P n) (* p (m (+ n 1)))))))))
     (i->p (lambda (n) (let r ((k n)(s 0)) (if (zero? k) (mv s)
         (let ((x (r (quotient k p)(+ s 1)))) (vs! x s (remainder k p)) x)))))
     (gap (lambda (m) (let ((N (let P ((z m)) (if (zero? z) 1 (* p (P (- z 1)))))))
        (lambda () (let ((n 0)) (lambda () (and (< n N)
           (let ((x (i->p n))) (set! n (+ n 1)) x))))))))
     (gip (lambda (m) (let ((g ((gap m)))(m (i->p (expt p m))))
        (let r ((l '())) (let ((x (g))) (if x (let ((tp (p+ m x)))
          (if (and (positive? (vr tp 0))(tip tp)) (r (cons tp l)) (r l))) l))))))
     (gfip (lambda (m) (let ((g ((gap m)))(m (i->p (expt p m))))
        (let r () (let ((x (g))) (if x (let ((tp (p+ m x)))
          (if (and (> (vr tp 0) 0)(tip tp)) tp (r)))))))))
     (gsip (lambda (m) (let* ((pq (expt p m))(m20 (* m 20))
        (tp (lambda (k) (let ((x (i->p (+ pq k))))(and (tip x) x))))) (or
            (let seek ((n 1)) (and (< n m20) (or (tp n) (seek (+ n 1)))))
            (let seek ((n 1)) (or (tp (+ p n)) (seek (+ n 1))))))))
     (fops (lambda (f) (lambda (sy) (let ((aw (assq sy (list
       (cons 'f* (lambda (a b) (cdr (pqr (p* a b) f))))
       (cons 'f/ (lambda (a) (trim (cdr (pegcd f a)))))
       (cons 'fexpt (lambda (a p)(mexpt a p f)))))))
       (if aw (cdr aw) (begin (write (list 'Nonesuch sy)) (newline))))))))
(let ((veq (lambda (a b)(let ((la (vl a))(lb (vl b))
    (rc (lambda (la a lb b) (and (let w ((c la))(let ((C (- c 1))) (or (= c 0)
          (and (= (vr a C)(vr b C)) (w C)))))
       (let w ((c (- lb la))(d la)) (or (= c 0) (and (zero? (vr b d))(w (- c 1)(+ d 1)))))))))
    (if (< la lb) (rc la a lb b) (rc lb b la a))))))
(let ((pl (map cons 
     '(pqr p->i i->p gap gip gfip gsip veq m+ m- m* m/ p+ p- p* mexpt trim pgcmd tip pegcd fops p)
 (list pqr p->i i->p gap gip gfip gsip veq m+ m- m* m/ p+ p- p* mexpt trim pgcmd tip pegcd fops p))))
  (lambda (sy) (let ((a (assq sy pl))) (if a (cdr a)
       (begin (write (list 'Nonesuch2 sy)) (newline))))))))))))))

; Demo: => (() ())
(let ((Do ((fileVal "Do") 'Do))(gg (((fileVal "RC4") "SedStuff") 'rbi)))
    (let ((r40 (gg 40))(S (fileVal "finiteField")))
(map (lambda (b) (let* ((T (S b))(fops (T 'fops))(gsip (T 'gsip)) (i->p (T 'i->p)))
  (Do 15 (lambda (n) (let* ((pw (+ 2 (r40))) (rpw (gg (- (expt b pw) 1)))
         (U (fops (gsip pw))) (/ (U 'f/)) (* (U 'f*)) (p->i (T 'p->i)))
  (Do 20 (lambda (j) (let* ((k (+ (rpw) 1))(x (i->p k))(i (/ x))(p (* i x)))
  (if (= (p->i p) 1) 'good (write (list 'bad k x p))))))))))) (list 2 3))))

(let* ((n 19) (m 58) (T ((fileVal "finiteField") n))
      (rb ((((fileVal "RC4") "Sead Stuff") 'rbi) n)))
   ((((T 'fops) ((T 'gsip) m)) 'fexpt)
        (((fileVal "Do") 'DoV) m (λ (_) (rb))) (- (expt n m) 1))) ; => #58(1 0)