Traduire la fonction Q et P de The Little Schemer en Common Lisp?

Question

Dans le chapitre 9 de la Petite Schemer, l'auteur présente les deux fonctions suivantes

(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)))))))

et propose qu'ils sont évalués à l'exécution suivante:

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

Comment écririez-vous les fonctions P et Q en Common Lisp?

(je traduis moi-même Y-Combinator - mais je trouve ce un défi)

- Fonctions Helper -

(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 ))))))

(Avertissement - Ce n'est pas une question de devoirs - il est pour ma compréhension et l'apprentissage)

Answer 1

Je supposais:

• Dans la définition de P, avec "(Q (str (première $ str)))" vous vouliez dire. "(Q str (première $ str))", comme Q est une fonction de deux arguments
• construire est une aide qui ne crée quelque chose qui a d'abord $ et le deuxième travail de $:

Dans cet esprit, la traduction directe du schéma en Common Lisp donne:

(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)

dont le dernier retourne la ligne:

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

qui est une série bien connue, donc je suppose que la traduction est réussie: -)