fork download
  1. ; fenderbecker's square reckoner
  2.  
  3. (define bitwise-and logand)
  4.  
  5. (define (isqrt n)
  6. (if (not (and (positive? n) (integer? n)))
  7. (error 'isqrt "must be positive integer")
  8. (let loop ((x n))
  9. (let ((y (quotient (+ x (quotient n x)) 2)))
  10. (if (< y x) (loop y) x)))))
  11.  
  12. (define (square? n)
  13. (let ((m (modulo n 128)))
  14. (if (positive? (bitwise-and (* m #x8bc40d7d) (* m #xa1e2f5d1) #x14020a)) #f
  15. (let ((large-mod (modulo n 3989930175))) ; (* 63 25 11 17 19 23 31)
  16. (and (let ((m (modulo large-mod 63)))
  17. (zero? (bitwise-and (* m #x3d491df7) (* m #xc824a9f9) #x10f14008)))
  18. (let ((m (modulo large-mod 25)))
  19. (zero? (bitwise-and (* m #x1929fc1b) (* m #x4c9ea3b2) #x51001005)))
  20. (let ((m (* #xd10d829a (modulo large-mod 31))))
  21. (zero? (bitwise-and m (+ m #x672a5354) #x21025115)))
  22. (let ((m (modulo large-mod 23)))
  23. (zero? (bitwise-and (* m #x7bd28629) (* m #xe7180889) #xf8300)))
  24. (let ((m (modulo large-mod 19)))
  25. (zero? (bitwise-and (* m #x1b8bead3) (* m #x4d75a124) #x4280082b)))
  26. (let ((m (modulo large-mod 17)))
  27. (zero? (bitwise-and (* m #x6736f323) (* m #x9b1d499) #xc0000300)))
  28. (let ((m (modulo large-mod 11)))
  29. (zero? (bitwise-and (* m #xabf1a3a7) (* m #x2612bf93) #x45854000)))
  30. (let ((root (isqrt n))) (if (= (* root root) n) root #f)))))))
  31.  
  32. (display (let ((p (- (expt 2 89) 1)) (q (- (expt 2 89) 21))) (square? (* p q))))
  33. (newline)
  34. (display (let ((p (- (expt 2 89) 1))) (square? (* p p))))
  35. (newline)
Success #stdin #stdout 0.01s 8800KB
stdin
Standard input is empty
stdout
#f
618970019642690137449562111