La traducción de la Q y la función P de la pequeña Schemer en Common Lisp?

Question

En el capítulo 9 de la Pequeña Schemer, el autor presenta las siguientes dos funciones

(define Q 
  (lambda (str n) 
    (cond 
      ((zero? (remainder (first$ str ) n)) 
        (Q (second$ str ) n)) 
      (t (build (first$ str ) 
        (lambda ( ) 
          (Q (second$ str ) n))))))) 

(define P
  (lambda (str)
    (build (first$ str)(lambda () (P (Q str (first$ str)))))))

y propone que se evalúan con la siguiente ejecución:

(frontier (P (second$ (second$ int)))  10)

¿Cómo escribir las funciones P y Q en Common Lisp?

(He traducido la Y-Combinator mí - pero me estoy encontrando éste desafiante)

- funciones auxiliares -

(define frontier
  (lambda (str n)
    (cond
      ((zero? n) (quote ()))
        (t (cons (first$ str) (frontier (second$ str) (sub1 n)))))))

(define str-maker
  (lambda (next n)
    (build n (lambda () (str-maker next (next n))))))

(define int (str-maker add1 0))

(define second$
  (lambda (str)
    ((second str))))

(define first$ first)

(define build
  (lambda (a1 a2)
    (cond
      (t (cons a1
        (cons a2 (quote ())))))))))

(define first
  (lambda (p)
    (cond
       (t (car p)))))

(define second
  (lambda (p)
    (cond
      (t (car (cdr p))))))

(define add1 
  (lambda (n)
    (+ 1 n)))

(define remainder 
  (lambda  (n m)
    (cond
      (t (- n (* m (/ n m ))))))

(Descargo de responsabilidad - Esto no es una cuestión de Tareas - es para mi la comprensión y el aprendizaje)

Answer 1

Supuse:

• En la definición de P, con "(Q (str (primera $ str)))" que quería decir: "(str Q (primera $ str))", como Q es una función de dos argumentos
• creación es un auxiliar que hace crea algo en lo primero y el segundo $ $ de trabajo:

Con esto en mente, la traducción directa del Esquema en Common Lisp da:

(defun first$ (list) (first list))
(defun second$ (list) (funcall (second list)))
(defun build (a b) (list a b))

(defun frontier (str n)
  (if (zerop N)
    ()
    (cons (first$ str) (frontier (second$ str) (1- n)))))

(defun str-maker (next n)
  (list n (lambda () (str-maker next (funcall next n)))))

(setq int-maker (str-maker #'1+ 0))

(defun Q (str n)
  (if (zerop (rem (first$ str) n))
    (Q (second$ str) n)
    (list (first$ str) (lambda () (Q (second$ str) n)))))

(defun P (str)
  (list (first$ str) (lambda () (P (Q str (first$ str))))))

(frontier (P (second$ (second$ int-maker))) 10)

De quién última línea muestra:

(2 3 5 7 11 13 17 19 23 29)

que es una serie muy conocida, así que supongo que la traducción es correcta: -)