Scheme手習い(23) eval、またはvalue、またはmeaning(4)

でも、(define ...)はどうなのでしょう。

再帰はYコンビネータによって得られるので、必要はありません。

Yコンビネータによる変形を行うと、インタプリタ上でインタプリタを走らせることが可能であるということですか。

はい。でもそんなに悩まないでください。

やれっていってるんでしょうか。

むしゃくしゃしてやった
反省はしていない

defineなし版のvalueです

;value
((lambda (meaning) (lambda (e) ((meaning e) (quote ()))))
 ;meaning
 ((lambda (first second third build Y)
    ((lambda (text-of
              cond-lines-of question-of answer-of
              function-of arguments-of
              table-of formals-of body-of new-entry extend-table
              lookup-in-table)
       ;meaningの本体
       (Y (lambda (meaning)
            (lambda (e)
              (lambda (table)
                ((lambda (*const *quote *cond *identifier *lambda *application)
                   ((lambda (expression-to-action)
                      ((expression-to-action e) e table))
                    ;expression-to-action
                    ((lambda (atom-to-action list-to-action)
                       (lambda (e)
                         (cond ((atom? e) (atom-to-action e))
                               (else (list-to-action e)))))
                     ;atom-to-action
                     (lambda (e)
                       (cond ((number? e) *const)
                             ((eq? e #t) *const)
                             ((eq? e #f) *const)
                             ((eq? e (quote cons)) *const)
                             ((eq? e (quote car)) *const)
                             ((eq? e (quote cdr)) *const)
                             ((eq? e (quote null?)) *const)
                             ((eq? e (quote eq?)) *const)
                             ((eq? e (quote atom?)) *const)
                             ((eq? e (quote zero?)) *const)
                             ((eq? e (quote add1)) *const)
                             ((eq? e (quote sub1)) *const)
                             ((eq? e (quote number?)) *const)
                             (else *identifier)))
                     ;list-to-action
                     (lambda (e)
                       (cond ((atom? (car e))
                              (cond ((eq? (car e) (quote quote)) *quote)
                                    ((eq? (car e) (quote lambda)) *lambda)
                                    ((eq? (car e) (quote cond)) *cond)
                                    (else *application)))
                             (else *application))))))
                 ;*const
                 (lambda (e table)
                   (cond ((number? e) e)
                         ((eq? e #t) #t)
                         ((eq? e #f) #f)
                         (else (build (quote primitive) e))))
                 ;*quote
                 (lambda (e table) (text-of e))
                 
                 ;*cond
                 ((lambda (else?)
                    ((lambda (evcon)
                       (lambda (e table)
                         ((evcon (cond-lines-of e)) table)))
                     ;evcon
                     (Y (lambda (evcon)
                          (lambda (lines)
                            (lambda (table)
                              (cond
                                ((else? (question-of (car lines)))
                                 ((meaning (answer-of (car lines))) table))
                                (((meaning (question-of (car lines))) table)
                                 ((meaning (answer-of (car lines))) table))
                                (else ((evcon (cdr lines)) table)))))))))
                  ;else?
                  (lambda (x)
                    (cond ((atom? x) (eq? x (quote else)))
                          (else #f))))
                 
                 ;*identifier
                 ((lambda (initial-table)
                    (lambda (e table)
                      (lookup-in-table e table initial-table)))
                  (lambda (name) (car (quote ()))))
                 
                 ;*lambda
                 (lambda (e table)
                   (build (quote non-primitive) (cons table (cdr e))))
                 
                 ;*application
                 ((lambda (evlis ls-apply)
                    (lambda (e table)
                      (ls-apply ((meaning (function-of e)) table)
                                ((evlis (arguments-of e)) table))))
                  ;evlis
                  (Y (lambda (evlis)
                       (lambda (args)
                         (lambda (table)
                           (cond ((null? args) (quote ()))
                                 (else (cons ((meaning (car args)) table) 
                                             ((evlis (cdr args)) table))))))))
                  ;ls-apply
                  ((lambda (primitive? non-primitive? apply-primitive apply-closure)
                     (lambda (fun vals)
                       (cond ((primitive? fun) (apply-primitive (second fun) vals))
                             ((non-primitive? fun) (apply-closure (second fun) vals)))))
                   ;primitive? non-primitive?
                   (lambda (l) (eq? (first l) (quote primitive)))
                   (lambda (l) (eq? (first l) (quote non-primitive)))
                   ;apply-primitive
                   ((lambda (:atom?)
                      (lambda (name vals)
                        (cond ((eq? name (quote cons)) (cons (first vals) (second vals)))
                              ((eq? name (quote car)) (car (first vals)))
                              ((eq? name (quote cdr)) (cdr (first vals)))
                              ((eq? name (quote null?)) (null? (first vals)))
                              ((eq? name (quote eq?)) (eq? (first vals) (second vals)))
                              ((eq? name (quote atom?)) (:atom? (first vals)))
                              ((eq? name (quote zero?)) (zero? (first vals)))
                              ((eq? name (quote add1)) (add1 (first vals)))
                              ((eq? name (quote sub1)) (sub1 (first vals)))
                              ((eq? name (quote number?)) (number? (first vals))))))
                    ;:atom?
                    (lambda (x)
                      (cond
                        ((atom? x) #t)
                        ((null? x) #f)
                        ((eq? (car x) (quote primitive)) #t)
                        ((eq? (car x) (quote non-primitive)) #f)
                        (else #f))))
                   ;apply-closure
                   (lambda (closure vals)
                     ((meaning (body-of closure))
                      (extend-table (new-entry (formals-of closure) vals)
                                    (table-of closure))))))))))))
     ;text-of
     second
     
     ;cond-lines-of question-of answer-of
     cdr first second
     
     ;function-of arguments-of
     car cdr
     
     ;table-of formals-of body-of new-entry extend-table
     first second third build cons
     ;lookup-in-table
     ((lambda (lookup-in-entry-help)
        ((lambda (lookup-in-entry)
           ((lambda (lookup-in-table)
              (lambda (name table table-f) ((lookup-in-table name) table table-f)))
            ;lookup-in-table
            (Y (lambda (lookup-in-table)
                 (lambda (name)
                   (lambda (table table-f)
                     (cond ((null? table) (table-f name))
                           (else (lookup-in-entry 
                                  name (car table) 
                                  (lambda (name) 
                                    ((lookup-in-table name) (cdr table) table-f)))))))))))
         ;lookup-in-entry
         (lambda (name entry entry-f)
           ((lookup-in-entry-help name) (first entry) (second entry) entry-f))))
      ;lookup-in-entry-help
      (Y (lambda (lookup-in-entry-help)
           (lambda (name)
             (lambda (names values entry-f)
               (cond ((null? names) (entry-f name))
                     ((eq? (car names) name) (car values))
                     (else ((lookup-in-entry-help name) (cdr names) (cdr values) entry-f))))))))))
  
  ;first second third build
  (lambda (p) (car p))
  (lambda (p) (car (cdr p)))
  (lambda (p) (car (cdr (cdr p))))
  (lambda (a1 a2) (cons a1 (cons a2 (quote ()))))
  
  ;Y
  (lambda (le)
    ((lambda (f) (f f))
     (lambda (f) (le (lambda (x) ((f f) x))))))))

何度も書くのは長すぎるのでこの文字列をVALUE-NO-DEFINEと書くことにします
defineしたという意味ではなくて単なる文字列の置き換えです
実際動かすときには、長々と元のコードを書いています
まずは普通に動かします

(VALUE-NO-DEFINE
 ;(length '(a b c)
 (quote (((lambda (le)
           ((lambda (f) (f f))
            (lambda (f) (le (lambda (x) ((f f) x))))))
         (lambda (length)
           (lambda (l)
             (cond ((null? l) 0)
                   (else (add1 (length (cdr l))))))))
        (quote (a b c)))))
⇛ 3

動きました

次はVALUE-NO-DEFINEをvalue上で動かします
quoteの中に入ってますがVALUE-NO-DEFINEは上のコードに置き換えられるものと思ってください

(value
 (quote 
  (VALUE-NO-DEFINE
   ;(length '(a b c)
   (quote (((lambda (le)
              ((lambda (f) (f f))
               (lambda (f) (le (lambda (x) ((f f) x))))))
            (lambda (length)
              (lambda (l)
                (cond ((null? l) 0)
                      (else (add1 (length (cdr l))))))))
           (quote (a b c)))))))
⇛ 3

これも動きました

最後に、VALUE-NO-DEFINEの上でVALUE-NO-DEFINEを動かします
(valueの上で)

(value
 (quote 
  (VALUE-NO-DEFINE
   (quote 
    (VALUE-NO-DEFINE
     ;(length '(a b c)
     (quote (((lambda (le)
                ((lambda (f) (f f))
                 (lambda (f) (le (lambda (x) ((f f) x))))))
              (lambda (length)
                (lambda (l)
                  (cond ((null? l) 0)
                        (else (add1 (length (cdr l))))))))
             (quote (a b c)))))))))
⇛ 3

動きましたー

※ VALUE-NO-DEFINEが使ってあるコードは、実際に動くコードからココに書く用に
※ 手で修正したものなのでどこか間違ってるかもしれません

ほんとは「単なる文字列の置き換え」じゃなくて
quoteの代わりにバッククォートを使えば動くコードにできる気もしたんですけど
うまくいきませんでした
VALUE-NO-RETURNにバッククォートの処理が入ってないとダメかな？

バッククォートがよくわかってないのと
動かせただけでびっくりしてるくらいでデバッグとか不可能なレベルなんで
ちょっとあきらめ気味です