ro89m7 - Online Common Lisp Interpreter & Debugging Tool

(defun lisp-interpreter (expression)
  "Простейший интерпретатор Lisp."
  (let ((global-environment '()))

    (labels (
      (evaluate (expr env)
        (cond
          ((numberp expr) expr)
          ((symbolp expr) (or (lookup expr env) expr)) ; Ищем значение переменной
          ((listp expr)
           (let ((function (car expr))
                 (arguments (cdr expr)))
             (apply-function function arguments env)))
          (t (error "Неизвестный тип выражения: ~A" expr))))

      (lookup (symbol env)
        (assoc symbol env))

      (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 '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 'defun)
           (let ((name (car arguments))
                 (params (cadr arguments))
                 (body (caddr arguments)))
             (setf global-environment (acons name `(lambda ,params ,body) global-environment))
             name))
          ((eql function 'setq)
           (let ((symbol (car arguments))
                 (value (evaluate (cadr arguments) env)))
               (setf global-environment (acons symbol value global-environment))
               value))
          (t  ; Пользовательская функция (из глобального окружения)
           (let ((func (lookup function global-environment)))
             (if func
                  (apply-function (eval (cdr func)) arguments env); eval убран
                 (error "Неизвестная функция: ~A" function))))
          )))

      (evaluate expression global-environment))))

;; Примеры использования
(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))))