(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))))
(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))))
Standard output is empty
Warning: reserving address range 0x80000c0000...0x1fffffffffff that contains memory mappings. clisp might crash later! Memory dump: 0x8000000000 - 0x80000bffff 0x14bd70400000 - 0x14bd706e4fff 0x14bd70815000 - 0x14bd70839fff 0x14bd7083a000 - 0x14bd709acfff 0x14bd709ad000 - 0x14bd709f5fff 0x14bd709f6000 - 0x14bd709f8fff 0x14bd709f9000 - 0x14bd709fbfff 0x14bd709fc000 - 0x14bd709fffff 0x14bd70a00000 - 0x14bd70a02fff 0x14bd70a03000 - 0x14bd70c01fff 0x14bd70c02000 - 0x14bd70c02fff 0x14bd70c03000 - 0x14bd70c03fff 0x14bd70c80000 - 0x14bd70c8ffff 0x14bd70c90000 - 0x14bd70cc3fff 0x14bd70cc4000 - 0x14bd70dfafff 0x14bd70dfb000 - 0x14bd70dfbfff 0x14bd70dfc000 - 0x14bd70dfefff 0x14bd70dff000 - 0x14bd70dfffff 0x14bd70e00000 - 0x14bd70e03fff 0x14bd70e04000 - 0x14bd71003fff 0x14bd71004000 - 0x14bd71004fff 0x14bd71005000 - 0x14bd71005fff 0x14bd71050000 - 0x14bd71053fff 0x14bd71054000 - 0x14bd71054fff 0x14bd71055000 - 0x14bd71056fff 0x14bd71057000 - 0x14bd71057fff 0x14bd71058000 - 0x14bd71058fff 0x14bd71059000 - 0x14bd71059fff 0x14bd7105a000 - 0x14bd71067fff 0x14bd71068000 - 0x14bd71075fff 0x14bd71076000 - 0x14bd71082fff 0x14bd71083000 - 0x14bd71086fff 0x14bd71087000 - 0x14bd71087fff 0x14bd71088000 - 0x14bd71088fff 0x14bd71089000 - 0x14bd7108efff 0x14bd7108f000 - 0x14bd71090fff 0x14bd71091000 - 0x14bd71091fff 0x14bd71092000 - 0x14bd71092fff 0x14bd71093000 - 0x14bd71093fff 0x14bd71094000 - 0x14bd710c1fff 0x14bd710c2000 - 0x14bd710d0fff 0x14bd710d1000 - 0x14bd71176fff 0x14bd71177000 - 0x14bd7120dfff 0x14bd7120e000 - 0x14bd7120efff 0x14bd7120f000 - 0x14bd7120ffff 0x14bd71210000 - 0x14bd71223fff 0x14bd71224000 - 0x14bd7124bfff 0x14bd7124c000 - 0x14bd71255fff 0x14bd71256000 - 0x14bd71257fff 0x14bd71258000 - 0x14bd7125dfff 0x14bd7125e000 - 0x14bd71260fff 0x14bd71263000 - 0x14bd71263fff 0x14bd71264000 - 0x14bd71264fff 0x14bd71265000 - 0x14bd71265fff 0x14bd71266000 - 0x14bd71266fff 0x14bd71267000 - 0x14bd71267fff 0x14bd71268000 - 0x14bd7126efff 0x14bd7126f000 - 0x14bd71271fff 0x14bd71272000 - 0x14bd71272fff 0x14bd71273000 - 0x14bd71293fff 0x14bd71294000 - 0x14bd7129bfff 0x14bd7129c000 - 0x14bd7129cfff 0x14bd7129d000 - 0x14bd7129dfff 0x14bd7129e000 - 0x14bd7129efff 0x55a60c56b000 - 0x55a60c65bfff 0x55a60c65c000 - 0x55a60c765fff 0x55a60c766000 - 0x55a60c7c5fff 0x55a60c7c7000 - 0x55a60c7f5fff 0x55a60c7f6000 - 0x55a60c826fff 0x55a60c827000 - 0x55a60c82afff 0x55a60e388000 - 0x55a60e3a8fff 0x7ffe147ed000 - 0x7ffe1480dfff 0x7ffe1495e000 - 0x7ffe14961fff 0x7ffe14962000 - 0x7ffe14963fff