貼っとく。 649 と同じくシンボルは gensym で。

(define (extract-pattern x y)
(let loop ((x x)
(y y)
(vars '()))
(cond ((and (pair? x) (pair? y))
(let*-values (((res vs) (loop (car x) (car y) vars))
((res* vs*) (loop (cdr x) (cdr y) vs)))
(values (cons res res*) vs*)))
((eqv? x y)
(values x vars))
(else
(let ((g (gensym)))
(values g (cons g vars)))))))

(extract-pattern '(1 2 3) '(2 3 4))
=> (#:G37 #:G38 #:G39)
(#:G39 #:G38 #:G37)

(extract-pattern '((1) 2 3) '((1 4) 2))
=> ((1 . #:G40) 2 . #:G41)
(#:G41 #:G40)