Traduire la fonction Q et P du Petit 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 voulez-vous écrire le P et Q fonctionne en Common Lisp?

(j'ai traduit moi-même Y-Combinator - mais je trouve ce un défi)

--helper Functions--

(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 (first $ str))) "vous vouliez dire:" (Q str (first $ str)) ", comme Q est une fonction à deux arguments.
• build est une aide qui ne crée quelque chose qui a d'abord $ et le deuxième travail $: liste

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 la dernière ligne retourne:

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