構文木が文法的に正しく出力されるようにする1

内部リンク
以下の変更を加えます。
1. ifの次にlist?かeq?かが来るようにする。
2. defineは使わない
3. quoteは使わない
4. 終端記号(ここではアルファベット小文字)を文字型とする。
1は難しそう。
とりあえず掲載。
ifの構文はまだ変。
listとatomを区別して配置する
という作業がはっせいするかも？
(use math.mt-random)

(define mt (make <mersenne-twister> :seed (sys-time)))

(define terminal
  (lambda ()
    (let ((rdm (mt-random-integer mt 26) ))
          (string-ref "abcdefghijklmnopqrstuvwxyz" rdm))))

(define non-terminal
  (lambda ()
    (let ((rdm (mt-random-integer mt 5) ))
      (cond ((eq? rdm 0) 'car)
            ((eq? rdm 1) 'cdr)
            ((eq? rdm 2) 'cons)
            (else 'if)))))

(define argument-map
  (lambda ()
    (list (cons 'car 1)
          (cons 'cdr 1)
          (cons 'cons 2)
          (cons 'eq? 2)
          (cons 'list? 1))))

(define allowable-depth 5) ;const
(define full-p #t) ;const
(define top-node-p #f) ;const

;  指定された関数および終端記号を再帰的に使用して、プログラムを
;  作成します。argument-mapは、関数セットにおける各関数が
;  いくつの引数を持つべきかを決定するのに使用されます。
;  allowable-depthさは私たちが作成することができる木の残りの
;  深さであり、0がヒットした時は、単体の終端記号を選択します。
;  私たちが木のトップのノードとして呼ばれている場合に限り、
;  top-node-pは真です。これは、常に木の一番上に関数を置いた
;  ことを私たちが確かめることを可能にします。
;  full-pは、最高に枝が多い個体かどうかを示します。
(define create-individual-program
  (lambda (allowable-depth
           top-node-p
           full-p)
    (cond ((<= allowable-depth 0)
           ;; 最深に到達。よって終端記号を選択する。
           (terminal))
          ((or full-p top-node-p)
           ;; top-node-p か full-p を満たした。
           ;; よって非終端記号(関数)だけを選択する。
           (let ((choice (non-terminal)))
             ; if が選択されたら eq? か list? を cons し
             ; choice を eq? か list? に変換する。
             (cond ((eq? 'if choice)
                    (let ((eq-or-list (mt-random-integer mt 2) ))
                      (define choice (cond ((eq? eq-or-list 0) 'eq?)
                                           ((eq? eq-or-list 1) 'list?)))
                      (let ((number-of-arguments (cdr (assq choice (argument-map)))))
                        (cons 'if (cons choice
                                        (create-arguments-for-function
                                          number-of-arguments
                                          (- allowable-depth 1)
                                          full-p))))))
                   ; choiceがif以外の場合。
                   (else
                     (let ((number-of-arguments (cdr (assq choice (argument-map)))))
                       (cons choice
                             (create-arguments-for-function
                               number-of-arguments
                               (- allowable-depth 1)
                               full-p)))))))
          (else
           ;; 非終端記号(関数)か終端記号から1つ選ぶ。
           ;0 or 1 でまず2択にしてから関数を呼ぶ
           (let ((set (mt-random-integer mt 2) ))
             (let ((choice (cond ((eq? set 0) (terminal))
                                 ((eq? set 1) (non-terminal)) ) ))
               (cond ((eq? set 1)
                   ;; 非終端記号(関数)を選び、ここから下へ木を作成し続ける。
                   (let ((function choice)
                         (number-of-arguments (cdr (assq choice (argument-map)))))
                     (cons function
                           (create-arguments-for-function
                             number-of-arguments
                             (- allowable-depth 1)
                             full-p))))
                   ;; atomを選ぶ
                   (else
                     (terminal)) ) ))))))


;  ツリーのノード用の引数のリストを作成します。
;  引数の数は、今から作成される残りの引数の数です。
;  各引数は、create-individual-programを
;  使用することで正常な方法で作成されます。
(define create-arguments-for-function
  (lambda (number-of-arguments
           allowable-depth
           full-p)
    (cond ((eq? number-of-arguments 0)
           ())
          (else
            (cons (create-individual-program
                    allowable-depth
                    ()
                    full-p)
                  (create-arguments-for-function
                    (- number-of-arguments 1)
                    allowable-depth
                    full-p))))))