; Lisp-in-Lisp: a tiny meta-interpreter that evaluates a Lisp expression.
; Same program runs across all three host tiers.
;
; Demonstrates: closures, recursion, symbol equality, list manipulation.
; The host tier interprets THIS interpreter, which then interprets the
; nested program — two layers of evaluation.

(define (assoc k env)
  (cond ((null? env) #f)
        ((eq? (car (car env)) k) (car env))
        (else (assoc k (cdr env)))))

(define (lookup k env)
  (let ((b (assoc k env)))
    (if b (cdr b)
        (cond ((eq? k (quote +))    (quote +))
              ((eq? k (quote -))    (quote -))
              ((eq? k (quote *))    (quote *))
              ((eq? k (quote =))    (quote =))
              ((eq? k (quote <))    (quote <))
              ((eq? k (quote cons)) (quote cons))
              ((eq? k (quote car))  (quote car))
              ((eq? k (quote cdr))  (quote cdr))
              ; Numbers and other self-evaluating atoms fall through here.
              ; No number? primitive in the asm tier — we just return e.
              (else k)))))

(define (extend env params args)
  (cond ((null? params) env)
        (else (extend
                (cons (cons (car params) (car args)) env)
                (cdr params)
                (cdr args)))))

(define (eval-args xs env)
  (cond ((null? xs) (quote ()))
        (else (cons (m-eval (car xs) env)
                     (eval-args (cdr xs) env)))))

(define (apply-prim op args)
  (cond ((eq? op (quote +))    (+ (car args) (car (cdr args))))
        ((eq? op (quote -))    (- (car args) (car (cdr args))))
        ((eq? op (quote *))    (* (car args) (car (cdr args))))
        ((eq? op (quote =))    (= (car args) (car (cdr args))))
        ((eq? op (quote <))    (< (car args) (car (cdr args))))
        ((eq? op (quote cons)) (cons (car args) (car (cdr args))))
        ((eq? op (quote car))  (car (car args)))
        ((eq? op (quote cdr))  (cdr (car args)))
        (else (quote unknown-prim))))

; Note: we deliberately drop explicit (eq? e #t) / (eq? e #f) clauses
; because Python tier's eq? has (eq? 1 #t) → #t. Boolean literals reach
; the else branch and lookup returns them unchanged (no eq? clause in
; lookup matches a boolean against any symbol).
(define (m-eval e env)
  (cond
    ((pair? e)
      (let ((h (car e)))
        (cond
          ((eq? h (quote quote)) (car (cdr e)))
          ((eq? h (quote if))
            (if (m-eval (car (cdr e)) env)
                (m-eval (car (cdr (cdr e))) env)
                (m-eval (car (cdr (cdr (cdr e)))) env)))
          ((eq? h (quote lambda))
            (cons (quote closure) (cons (car (cdr e)) (cons (car (cdr (cdr e))) env))))
          (else
            (let ((op (m-eval h env)) (args (eval-args (cdr e) env)))
              (cond
                ((pair? op)
                  (m-eval (car (cdr (cdr op)))
                          (extend (cdr (cdr (cdr op))) (car (cdr op)) args)))
                (else (apply-prim op args))))))))
    ((null? e) (quote ()))
    (else
      (let ((b (assoc e env)))
        (if b (cdr b) (lookup e env))))))

(define (m-run e) (m-eval e (quote ())))

(display "meta (+ 2 3)        → ") (print (m-run (quote (+ 2 3))))
(display "meta (* 6 7)        → ") (print (m-run (quote (* 6 7))))
(display "meta cons/car/cdr   → ") (print (m-run (quote (car (cons 1 (cons 2 (quote ())))))))
(display "meta lambda apply   → ") (print (m-run (quote ((lambda (x) (* x x)) 9))))
(display "meta if-recursion   → ")
(print (m-run (quote ((lambda (f n) (f f n))
                      (lambda (f n) (if (< n 2) n (+ (f f (- n 1)) (f f (- n 2)))))
                      8))))
(print "done")
