Archives / Projects / Lambda Calculus Interpreter in Scheme
Lambda Calculus Interpreter in Scheme
April 2012 to April 2012

So this was a cool class project that I worked on where we were to implement a lambda calculus interpreter in any language of our choice. It just seemed too natural to do this in Scheme. :)

It attempts to implement both alpha and beta reductions.

The following code for the interpreter is also available as a gist, with test cases: https://gist.github.com/VijayKrishna/5180292.js

;;UCI Class Project - INF212 Analysis of Programming Languages
;;Nicholas DiGiuseppe and Vijay Krishna Palepu
;;1.interpreter is not case sensitive.
;;2.interpreter lives in the world of symbols and lists.
;;3.interpreter requires proper parenthesis.
;;4.does not work with numbers such as 1 2 3...
;;reference: http://matt.might.net/articles/implementing-a-programming-language/

;;original 7 lines
; eval takes an expression and an environment to a value
(define (eval e env)
  (display "evaluating ") (display e) (display " with ") (display env) (newline)
  (cond
    ((symbol? e)       
     (begin 
       (display "option 1 ") 
       (display (if (boolean? (assq e env)) e (cadr (assq e env)))) 
       (newline) 
       (if (boolean? (assq e env)) e (cadr (assq e env)))
       )
     )
    ((= 1 (length e))
     (begin
       (display "option 2 ") 
       (display (cons e env)) 
       (newline)
       (eval (car e) env)
       )
     )
    ((eq? (car e) 'λ)  
     (begin 
       (display "option 3 ") 
       (display (cons e env)) 
       (newline) 
       (cons e env)
       )
     )
    (else 
     (begin 
       (display "option 4 ")
       (display e)
       (newline) 
       ;(iterApply e env)
       (apply (eval (car e) env) (eval (cadr e) env))
       )
     )
    )
  )

; apply takes a function and an argument to a value
(define (apply f x)
  (display "applying ") (display x) (display " to ") (display f) (newline)
  (if (symbol? f) ;if it is not pair
      (begin (list f x))
      (let ((chek (lambdaCheck f 0)))
        (cond
          ((= 0 chek) (list (list f x)))
          ((< 0 chek) (list (list (car f) x)))
          (else (eval (cddr (car f)) (cons (list (cadr (car f)) (find f x)) (cdr f))))
          )
        )
      )
  )

;;additions
(define (interpret e env)
  (display " e(interpret): ") (display e) (newline)
  (if (pair? e)
      (let ((e (eval e env)))
        (cond
          ((symbol? e) e) ;consider doing a (not (pair? e)) instead of (symbol? e)
          ((= 1 (length e)) (car e))
          ((and (= 2 (length e)) (symbol? (car e))) e)
          ((= 2 (length e))
           (let ((env (list (cadr e))) (e (car e)))
             (itrate e '() env)
             )
           )
          ((< 2 (length e))
           (let ((env (cdr e)) (e (car e)))
             (itrate e '() env)
             ))
          )
        )
      e
      )
  )

(define (itrate l nl env)
  (if (null? l)
      nl
      (begin 
        (itrate 
         (cdr l) 
         (append 
          nl 
          (list (interpret (car l) env))
          )
         env
         )
        )
      )
  )

;begin alpha reduction
(define (flatten l nl)
  (if (null? l)
      nl
      (begin
        (cond
          ((symbol? (car l)) (flatten (cdr l) (append nl (list (car l)))))
          ((pair? (car l)) (flatten (cdr l) (append nl (flatten (car l) '()))))
          )
        )
      )
  )

(define (find l al)
  (let ((nl (flatten l '())))
    (cond
      ((null? nl) al)
      ((eq? (car nl) 'λ)
       (begin 
         (find (cddr nl) (replace al (cadr nl) '()))
         )
       )
      (else (find (cdr nl) al))   
      )
    )
  )

(define (replace l var nl)
  (if (null? l)
      nl
      (begin
        (if (symbol? l)
            (cond
              ((eq? l var) (string->symbol (string-append (symbol->string var) "1")))
              ((not (eq? l var)) l)
              )
            
            (replace (cdr l) var 
                     (append nl
                             (cond 
                               ((and (symbol? (car l)) (eq? (car l) var)) (list (string->symbol (string-append (symbol->string var) "1"))))
                               ((and (symbol? (car l)) (not (eq? (car l) var))) (list (car l)))
                               ((pair? (car l)) (list (replace (car l) var '())))
                               )
                             )
                     )
            )
        )
      )
  )
;end alpha reduction

(define (lambdaCheck l count)
  (cond
    ((null? l) count)
    ((and (symbol? (car l)) (and (= count 1) (eq? (car l) 'λ)) -1))
    ((and (symbol? (car l)) (not (eq? (car l) 'λ))) count)
    (else (lambdaCheck (car l) (+ 1 count)))
    )
  )
TL;DR - Lamba Calculus interpreter in Scheme.

Tags: scheme lambda-calculus interpreter

Related Posts