(lambda (program)
(let* ((interpreter (lambda (interpret program env)
(let* ((cadr (lambda (the-list)
(car (cdr the-list))))
(null? (lambda (the-expr)
(equal? the-expr (quote ()))))
(find (lambda (self elem alist)
(cond
((null? alist)
(quote nothing))
(else
(let* ((find-entry (car alist))
(key (car find-entry))
(find-rest (cdr alist)))
(cond
((equal? elem key)
find-entry)
(else
(self self elem find-rest))))))))
(interpret-args (lambda (ia ia-args ia-env)
(cond
((null? ia-args)
ia-args)
(else
(let* ((arg (car ia-args))
(ia-rest (cdr ia-args)))
(cons (interpret interpret arg env) (ia ia ia-rest ia-env)))))))
(expand-args (lambda (ea ea-formals argvals)
(cond
((null? ea-formals)
ea-formals)
(else
(let* ((formal (car ea-formals))
(rest-formals (cdr ea-formals))
(argval (car argvals))
(rest-argvals (cdr argvals)))
(cons (cons formal (cons argval (quote ()))) (ea ea rest-formals rest-argvals)))))))
(concat-envs (lambda (ce ce-new-env ce-old-env)
(cond
((null? ce-new-env)
ce-old-env)
(else
(let* ((ce-entry (car ce-new-env))
(ce-rest (cdr ce-new-env)))
(cons ce-entry (ce ce ce-rest ce-old-env)))))))
(call-lambda (lambda (func cl-args cl-env)
(let* ((cl-arg-vals (interpret-args interpret-args cl-args cl-env)))
(func cl-arg-vals)))))
(cond
((null? program)
program)
((list? program)
(let* ((tag (car program))
(args (cdr program))
(entry (find find tag env)))
(cond
((list? entry)
(call-lambda (cadr entry) args env))
((equal? tag (quote lambda))
(let* ((formals (car args))
(body (cadr args)))
(lambda (arg-vals)
(let* ((arg-env (expand-args expand-args formals arg-vals))
(new-env (concat-envs concat-envs arg-env env)))
(interpret interpret body new-env)))))
((equal? tag (quote cond))
(cond
((null? args)
args)
(else
(let* ((branch (car args))
(test (car branch))
(branch-expr (cadr branch)))
(cond
((equal? test (quote else))
(interpret interpret branch-expr env))
((interpret interpret test env)
(interpret interpret branch-expr env))
(else
(let* ((branches (cdr args))
(newprog (cons (quote cond) branches)))
(interpret interpret newprog env))))))))
((equal? tag (quote let*))
(let* ((bindings (car args))
(let-body (cadr args)))
(cond
((null? bindings)
(interpret interpret let-body env))
(else
(let* ((binding (car bindings))
(rest (cdr bindings))
(ident (car binding))
(expr (cadr binding))
(value (interpret interpret expr env))
(new-bi (cons ident (cons value (quote ()))))
(l-new-env (cons new-bi env))
(l-newprog (cons (quote let*) (cons rest (cons let-body (quote ()))))))
(interpret interpret l-newprog l-new-env))))))
((equal? tag (quote list?))
(list? (interpret interpret (car args) env)))
((equal? tag (quote quote))
(car args))
((equal? tag (quote car))
(car (interpret interpret (car args) env)))
((equal? tag (quote cdr))
(cdr (interpret interpret (car args) env)))
((equal? tag (quote cons))
(cons (interpret interpret (car args) env) (interpret interpret (cadr args) env)))
((equal? tag (quote equal?))
(equal? (interpret interpret (car args) env) (interpret interpret (cadr args) env)))
((null? tag)
tag)
((list? tag)
(call-lambda (interpret interpret tag env) args env))
(else
(call-lambda tag args env)))))
(else
(let* ((ident-entry (find find program env)))
(cond
((list? ident-entry)
(cadr ident-entry))
(else
(quote illegal-program-error))))))))))
(interpreter interpreter program (quote ()))))