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