self-evaluating functional Lisp / Scheme interpreter without define, letrec, let, set etc

lambda3.rkt

#lang racket
;
; A self-evaluating Lisp interpreter implemented without define, letrec, let
;
; Copyright (C) 2017  A. Carl Douglas
;

; without current-namespace, this racket error occurred:
;   ?: function application is not allowed;
;   no #%app syntax transformer is bound in: 
(current-namespace (make-base-namespace))

((lambda (interpreter environment)                                                   
   ;                                                                                 
   ; Note that the evaluator evaluates arguments, which is why the quote is necessary:
   ; The outer interpreter is evaluating the inner interpreter                       
   ; as well as the arguments to the inner interpreter                               
   ; so to ensure the inner interpreter gets it's arguments unevaluated we must quote.
   ;                                                                                 
   ; Also note that the evaluator does not support multi statement lambdas (like begin)
   ; which means adding debugging like printf causes incorrect behavior              
   ;                                                                                 
   ((eval interpreter) `(,interpreter (quote (+ 1 2)) (quote ((+ ,+)))) environment))
 
 `(lambda (e env)
    ((lambda (eval apply)
       (eval eval apply e env)) ; call eval
     (lambda (eval^ apply^ e env) ; define eval
       (if (symbol? e)
           (car (cdr (assq e env)))
           (if (pair? e)
               (if (eq? (car e) 'lambda)
                   (list 'closure e env)
                   (if (eq? (car e) 'if)
                       (if (eval^ eval^ apply^ (car (cdr e)) env)
                           (eval^ eval^ apply^ (car (cdr (cdr e))) env)
                           (eval^ eval^ apply^ (car (cdr (cdr (cdr e)))) env))
                       (if (eq? (car e) 'quote)
                           (car (cdr e))
                           (apply^ apply^ eval^ (eval^ eval^ apply^ (car e) env)
                                   ; inline evlist
                                   ((lambda (e1 env1)
                                      ((lambda (evlist)
                                         (evlist evlist e1 env1))  ; call evlist
                                       (lambda (evlist^ e1 env1)  ; define evlist
                                         (if (null? e1)
                                             '()
                                             (cons (eval^ eval^ apply^ (car e1) env1) (evlist^ evlist^ (cdr e1) env1))))))
                                    (cdr e) env)))))
               e)))
     (lambda (apply^ eval^ f x) ; define apply
       (if (procedure? f)
           (apply f x)
           (eval^ eval^ apply^ (car (cdr (cdr (car (cdr f)))))
                  ; inline newenv - extends the environment
                  ((lambda (names values env)
                     ((lambda (newenv)
                        (newenv newenv names values env)) ; call newenv
                      (lambda (newenv^ names values env) ; define newenv
                        (if (null? names)
                            env
                            (cons (list (car names) (car values))
                                  (newenv^ newenv^ (cdr names) (cdr values) env))))))
                   (car (cdr (car (cdr f)))) x (car (cdr (cdr f)))))))))
 
 ; environment containing built-in primitives required by the eval implementation
 `((cons    ,cons)
   (car     ,car)
   (cdr     ,cdr)
   (list    ,list)
   (eq?     ,eq?)
   (symbol? ,symbol?)
   (null?   ,null?)
   (pair?   ,pair?)
   (procedure? ,procedure?)
   (assq    ,assq)
   (printf  ,printf)
   (read    ,read)
   (print   ,display)
   (apply   ,apply)))