Simple Lambda Interpreter

lambda.ss

;;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)))
    )
  )

test.ss

;;Test Cases::
;;(ref:https://files.nyu.edu/cb125/public/Lambda/)

(interpret '((λ n λ f λ x f ((n f) x)) (λ f λ x f (f (f x)))) '())
(λ f λ x f (f (f (f x))))
(passed)

(λ m λ n λ f λ x ((m f) ((n f) x)))

(interpret '((((λ a (λ b (λ c ((a b) c)))) (λ x (λ y x))) (λ b b)) (λ c c)) '())
(λ b1 b1)
;passed

(interpret '((λ x (it x)) works) '())
(it works)
;passed

(interpret '((λ var ((fn1 var) & (fn2 var))) argument) '())
((fn1 argument) &)
;passed

(interpret '((λ var ((((fn1 var) &) (fn2 var)))) argument) '())
(((fn1 argument) &) (fn2 argument))
;passed

(interpret '((λ x (λ y1 (x y1))) z) '())
(λ y1 (z y1))
;passed

(interpret '((λ x (λ y (x y))) y) '())
(λ y (y1 y))
;passed

(interpret '((λ x (x x))(λ x (λ y (x y)))) '())
(λ y (λ y1 (y y1)))
;passed

(interpret '((λ x x) two) '())
two
;passed

(interpret '(λ x (x x) two) '())
((λ x (x x) two))
;passed

(interpret '((λ x (x x)) two) '())
(two two)
;passed

(interpret '((λ x ((x y) z)) z) '())
((z y) z)
;passed

(interpret '((λ x (w y)) z) '())
(w y)
;passed

(interpret '((λ x (P x)) j) '())
(p j)
;passed

(interpret '((λ x (P y)) j) '())
(p y)
;passed

(interpret '(((λ x (λ y (P y))) j) m) '())
(p m)
;passed

(interpret '(((λ x (λ y (P x))) j) m) '())
(p j)
;passed

(interpret '((λ P (P j)) (λ x (Q x))) '())
(q j)
;passed

(interpret '(((λ x (λ y ((K x) y))) j) m) '())
((k j) m)
;failed: (k j)

(interpret '(P j) '())
(p j)
;passed

(interpret '((((λ GQ  (λ L (λ x ((GQ L) x)))) (λ Q (λ x (Q x)))) P) j) '())
(p j)
;passed

(interpret '((λ x ((A x) ((K x) j))) m) '())
((a m) (((k m) j)))
;passed

(interpret '(((λ x (λ y (x y))) two) three) '())
(two three)
;passed

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. :)