(defun lisp-interpreter (expression)
"Простейший интерпретатор Lisp."
(labels (
(evaluate (expr env)
(cond
((numberp expr) expr)
((symbolp expr) (let ((value (cdr (assoc expr env))))
(if value
value
(error "Неопределенная переменная: ~A" expr)))) ; Ищем значение переменной
((listp expr)
(let ((function (car expr))
(arguments (cdr expr)))
(apply-function function arguments env)))
(t (error "Неизвестный тип выражения: ~A" expr))))
(apply-function (function arguments env)
(cond
((eql function 'quote) (car arguments))
((eql function 'car) (car (evaluate (car arguments) env)))
((eql function 'cdr) (cdr (evaluate (car arguments) env)))
((eql function 'cons) (cons (evaluate (car arguments) env) (evaluate (cadr arguments) env)))
((eql function '+) (apply '+ (mapcar #'(lambda (arg) (evaluate arg env)) arguments)))
((eql function '-) (apply '- (mapcar #'(lambda (arg) (evaluate arg env)) arguments)))
((eql function '*) (apply '* (mapcar #'(lambda (arg) (evaluate arg env)) arguments)))
((eql function '/) (apply '/ (mapcar #'(lambda (arg) (evaluate arg env)) arguments)))
((eql function '=) (= (evaluate (car arguments) env) (evaluate (cadr arguments) env)))
((eql function '<) (< (evaluate (car arguments) env) (evaluate (cadr arguments) env)))
((eql function '>) (> (evaluate (car arguments) env) (evaluate (cadr arguments) env)))
((eql function 'list) (mapcar #'(lambda (arg) (evaluate arg env)) arguments)) ; Реализация list
((eql function 'expt) (expt (evaluate (car arguments) env) (evaluate (cadr arguments) env))) ; Power function
((eql function 'sqrtn) ; Корень n-й степени: (sqrtn x n)
(let ((x (evaluate (car arguments) env))
(n (evaluate (cadr arguments) env)))
(expt x (/ 1.0 n)))) ; Используем экспоненту для вычисления корня
((eql function 'lambda) ; Лямбда-выражение
(let ((params (cadr function))
(body (caddr function))
(evaluated-args (mapcar #'(lambda (arg) (evaluate arg env)) arguments)))
(evaluate body (append (mapcar #'cons params evaluated-args) env))))
((eql function 'if)
(if (evaluate (car arguments) env)
(evaluate (cadr arguments) env)
(evaluate (caddr arguments) env))) ; if
((eql function 'let)
(let ((bindings (car arguments))
(body (cadr arguments)))
(let ((new-env (append (mapcar #'(lambda (binding)
(cons (car binding) (evaluate (cadr binding) env)))
bindings)
env)))
(evaluate body new-env))))
((eql function 'defun) (error "defun не поддерживается: используйте lambda и let для локальных определений"))
((eql function 'setq) (error "setq не поддерживается: используйте let для локальных определений"))
(t ; Пользовательская функция (теперь ищем только в локальном окружении)
(let ((func (cdr (assoc function env))))
(if func
(apply-function (car func) arguments env) ; Прямой вызов lambda, а не eval
(error "Неизвестная функция: ~A" function))))
)))
(evaluate expression '()))) ; Начинаем с пустого окружения
;; Примеры использования
(format t "Результат: ~A~%" (lisp-interpreter '(cons (car (cdr (quote (e r t w)))) (cons (cdr (quote (g h 6))) (quote ())))))
(format t "Результат: ~A~%" (lisp-interpreter '(+ 2 (* 3 4))))
(format t "Результат: ~A~%" (lisp-interpreter '(- 10 (/ 6 2))))
(format t "Результат: ~A~%" (lisp-interpreter '(if (> 5 3) 10 20)))
(format t "Результат: ~A~%" (lisp-interpreter '(if (= 5 3) 10 20)))
(format t "Результат: ~A~%" (lisp-interpreter '(car (list 1 2 3))))
(format t "Результат: ~A~%" (lisp-interpreter '(sqrtn 16 2))) ; Корень квадратный из 16
(format t "Результат: ~A~%" (lisp-interpreter '(sqrtn 27 3))) ; Корень кубический из 27
(format t "Результат: ~A~%" (lisp-interpreter '(expt 2 3))) ; 2 в степени 3
;; Примеры использования let (локальные определения)
(format t "Результат: ~A~%" (lisp-interpreter '(let ((x 10) (y 20)) (+ x y))))
(format t "Результат: ~A~%" (lisp-interpreter '(let ((x 5)) (let ((y (+ x 3))) (* x y)))))