(defun cpd-gcd (n m)
  (if (zerop (mod n m))
      m
      (cpd-gcd m (mod n m))))

(defun remove-common-prime-divisors (n m)
  (loop while (/= n 1)
        do (let ((d (cpd-gcd n m)))
             (when (= d 1)
               (return-from remove-common-prime-divisors n))
             (setf n (/ n d))))
  n)

(defun common-prime-divisors (a b)
  (let ((counter 0))
    (loop for x in a
          for y in b
          do (let* ((d (cpd-gcd x y))
                     (rx (remove-common-prime-divisors x d)))
               (when (= rx 1)
                 (let ((ry (remove-common-prime-divisors y d)))
                   (when (= ry 1)
                     (incf counter))))))
    counter))