Traduzindo a função Q e P de A Pequena Schemer em Common Lisp?

Question

No capítulo 9 da Pequena Schemer, o autor apresenta as duas funções seguintes

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

e propõe que eles são avaliados com o seguinte execução:

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

Como você escrever as funções P e Q em Common Lisp?

(Eu traduzi o Y-Combinator mim - mas eu estou achando este desafio)

- Funções 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 ))))))

(Disclaimer - Esta não é uma Homework Pergunta - é para o meu entendimento e aprendizado)

Answer 1

Eu assumi:

• definição Em P, com "(Q (str (primeira $ str)))" você quis dizer:. "(Str Q (primeira $ str))", como Q é uma função com dois argumentos
• construção é um auxiliar que faz cria algo sobre o qual primeiro $ e segunda $ trabalho: lista

Com isto em mente, a tradução direta do Esquema para Lisp Comum dá:

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

Whose Line retornos última:

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

que é uma série bem conhecidos, assim que eu supor a tradução é bem sucedida: -)