dkvndY - 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 argenv)) arguments)))
          ((eql function '-) (apply '- (mapcar #'(lambda (arg) (evaluate argenv)) arguments)))
          ((eql function '*) (apply '* (mapcar #'(lambda (arg) (evaluate argenv)) arguments)))
          ((eql function '/) (apply '/ (mapcar #'(lambda (arg) (evaluate argenv)) 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 argenv)) 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)))
              (iffunc-def
                (let ((func (cdrfunc-def))
                      (params (cadrfunc))
                      (body (caddrfunc))
                      (evaluated-args (mapcar #'(lambda (arg) (evaluate argenv)) arguments)))
                    (evaluate body (append (mapcar #'cons params evaluated-args) env)))
                (let ((func-def-global (lookup function global-environment)))
                  (iffunc-def-global
                      (let ((func (cdrfunc-def-global))
                            (params (cadrfunc))
                            (body (caddrfunc))
                            (evaluated-args (mapcar #'(lambda (arg) (evaluate argenv)) arguments)))
                        (evaluate body (append (mapcar #'cons params evaluated-args) env)))
(error "Неизвестная функция: ~A" function))))))
)))

      (evaluate expression global-environment))))