4KOKnr - 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 '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  ; Пользовательская функция или lambda (ищем в окружении)
             (let ((func-def (lookup function env)))
              (if func-def
                (let ((func (cdr func-def))
                      (params (cadr func))
                      (body (caddr func))
                      (evaluated-args (mapcar #'(lambda (arg) (evaluate arg env)) arguments)))
                    (evaluate body (append (mapcar #'cons params evaluated-args) env)))
                (let ((func-def-global (lookup function global-environment)))
                  (if func-def-global
                      (let ((func (cdr func-def-global))
                            (params (cadr func))
                            (body (caddr func))
                            (evaluated-args (mapcar #'(lambda (arg) (evaluate arg env)) arguments)))
                        (evaluate body (append (mapcar #'cons params evaluated-args) env)))
                    (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))))