Lambda Calculus Interpreter

lc.scm

; Constructors
(define (lambda-expr? e)
  (and (pair? e)
       (equal? (car e) 'λ)
       (equal? (caddr e) '→)))

(define (make-lambda argn argv) (list 'λ argn '→ argv))
(define (lambda-param e) (cadr e))
(define (lambda-body e) (cadddr e))

; Substitution procedures
(define (lambda-subst e src dst)
  (cond ((equal? e src) dst)
        ((lambda-expr? e) (if (eq? (lambda-param e) src)
                              e ; If this lambda expression has a param name same as src, do not substitute
                              ; Otherwise, construct a new lambda with this param and substitute src to dst in the lambda body
                              (make-lambda (lambda-param e) (lambda-subst (lambda-body e) src dst))))
        ; If it's a list of expressions recursively substitute them
        ((pair? e) (cons (lambda-subst (car e) src dst)
                         (lambda-subst (cdr e) src dst)))
        (else e)))

; Evaluation procedures
(define (can-beta-reduce? e)
  (and (pair? e)
       ; If the first parameter in the list is a lambda expression, or the first parameter can also be reduced
       ;(or (lambda-expr? (car e)) (can-beta-reduce? (car e)))
       (lambda-expr? (car e))
       ; And there is a second value in the list (to apply to the lambda expr)
       (pair? (cdr e))))

(define (beta-reduce e . vs)
  (if (and (pair? vs) (lambda-expr? e))
      ; Substitute current value in lambda-body and recursively reduce the remaining values
      (apply beta-reduce
             (lambda-subst (lambda-body e) (lambda-param e) (car vs))
             (cdr vs))
      ; No values, so just return the expression
      e))

(define (lambda-eval e)
  (cond ((can-beta-reduce? e) (lambda-eval (apply beta-reduce e)))
        ((pair? e) (let ([new-e (cons (lambda-eval (car e))
                                      (lambda-eval (cdr e)))])
                     (if (can-beta-reduce? new-e)
                         (lambda-eval new-e)
                         new-e)))
        (else e)))

Test for pairs:

(define one (make-lambda 'f (make-lambda 'x '(f x))))
(define two (make-lambda 'f (make-lambda 'x '(f (f x)))))

(define true (make-lambda 'x (make-lambda 'y 'x)))
(define false (make-lambda 'x (make-lambda 'y 'y)))

(define pair (make-lambda 'x (make-lambda 'y (make-lambda 'f '(f x y)))))
(define first (make-lambda 'p (list 'p true)))
(define second (make-lambda 'p (list 'p false)))

(define test-pair (lambda-eval (list pair 1 2)))

(and
 (equal? (lambda-eval (list first test-pair)) 1)
 (equal? (lambda-eval (list second test-pair)) 2))