昨日のやつをもすこし修正した

• 相互再帰を導入した。
• ((式1=>SとかKとか) (式2) ...) のような式に対応した。

(use srfi-11)
 
(define (cutlist size car_l result_size l)
  (if (or (= size 0) (null? l)) (values (reverse car_l) l result_size) (cutlist (- size 1) (cons (car l) car_l) (+ 1 result_size)(cdr l))))
 
(define (construct-S p1 p2 p3 rest)
  (let ((p1dash  (if (pair? p1) p1 (list p1)))
        (p2dash  (if (pair? p2) p2 (list p2))))
  `(,@p1dash ,p3 (,@p2dash ,p3) ,@rest)))
 
(define (construct-K p1 p2 rest)
  (if (not (pair? p1))
    `(,p1 ,@rest)
    `(,@p1 ,@rest)))
 
(define (custum-apply max-args constructor l)
  (let-values (((args rest args_num) (cutlist max-args '() 0 (cdr l))))
  (let ((evaled_args (map beta-red-itr args))
        (prefix (car l)))
    (if (= args_num max-args)
    (beta-red-itr (apply constructor `(,@evaled_args ,rest)))
    (cons prefix evaled_args)))))
 
(define (apply-S l)
  (custum-apply 3 construct-S l))
 
(define (apply-K l)
  (custum-apply 2 construct-K l))
 
(define beta-red-itr
  (lambda (seq)
    (begin (display "---   ") (display seq) (newline)
  (cond
    ((not (pair? seq)) seq)
    ((and (not (pair? (car seq))) (null? (cdr seq))) (car seq))
    ((eq? 'S (car seq)) (apply-S seq))
    ((eq? 'K (car seq)) (apply-K seq))
    ((eq? 'I (car seq)) (beta-red-itr (cdr seq)))
    ((and (null? (cdr seq)) (symbol? (car seq))) (car seq))
    ((symbol? (car seq)) (map beta-red-itr seq))
    (else
    (let ((op (beta-red-itr (car seq))))
      (let ((evaled_op (if (pair? op) op (list op))))
        (beta-red-itr `(,@evaled_op ,@(map beta-red-itr (cdr seq))))))))
    )
))
(define (beta-reduction l)
  (let ((result (beta-red-itr l)))
  (if (and (pair? result) (null? (cdr result))) (car result) result)))
 

なんでか自分は多値が好きなようだ。
最近の言語ではそうめずらしくもないのかな。C#とか。使ったことないけど。

確かPHPでも似たようなことが出来た

list($x, $y) = hoge();

function hoge() {
  return array(1, 2);
}

こんな感じだった。
rubyでも昔使った気がしないでもない。