fork download
  1. (defun lisp-interpreter (expression)
  2. "Простейший интерпретатор Lisp."
  3. (labels (
  4. (evaluate (expr env)
  5. (cond
  6. ((numberp expr) expr)
  7. ((symbolp expr) (let ((value (cdr (assoc expr env))))
  8. (if value
  9. value
  10. (error "Неопределенная переменная: ~A" expr)))) ; Ищем значение переменной
  11. ((listp expr)
  12. (let ((function (car expr))
  13. (arguments (cdr expr)))
  14. (apply-function function arguments env)))
  15. (t (error "Неизвестный тип выражения: ~A" expr))))
  16.  
  17. (apply-function (function arguments env)
  18. (cond
  19. ((eql function 'quote) (car arguments))
  20. ((eql function 'car) (car (evaluate (car arguments) env)))
  21. ((eql function 'cdr) (cdr (evaluate (car arguments) env)))
  22. ((eql function 'cons) (cons (evaluate (car arguments) env) (evaluate (cadr arguments) env)))
  23. ((eql function '+) (apply '+ (mapcar #'(lambda (arg) (evaluate arg env)) arguments)))
  24. ((eql function '-) (apply '- (mapcar #'(lambda (arg) (evaluate arg env)) arguments)))
  25. ((eql function '*) (apply '* (mapcar #'(lambda (arg) (evaluate arg env)) arguments)))
  26. ((eql function '/) (apply '/ (mapcar #'(lambda (arg) (evaluate arg env)) arguments)))
  27. ((eql function '=) (= (evaluate (car arguments) env) (evaluate (cadr arguments) env)))
  28. ((eql function '<) (< (evaluate (car arguments) env) (evaluate (cadr arguments) env)))
  29. ((eql function '>) (> (evaluate (car arguments) env) (evaluate (cadr arguments) env)))
  30. ((eql function 'list) (mapcar #'(lambda (arg) (evaluate arg env)) arguments)) ; Реализация list
  31. ((eql function 'expt) (expt (evaluate (car arguments) env) (evaluate (cadr arguments) env))) ; Power function
  32. ((eql function 'sqrtn) ; Корень n-й степени: (sqrtn x n)
  33. (let ((x (evaluate (car arguments) env))
  34. (n (evaluate (cadr arguments) env)))
  35. (expt x (/ 1.0 n)))) ; Используем экспоненту для вычисления корня
  36. ((eql function 'lambda) ; Лямбда-выражение
  37. (let ((params (cadr function))
  38. (body (caddr function))
  39. (evaluated-args (mapcar #'(lambda (arg) (evaluate arg env)) arguments)))
  40. (evaluate body (append (mapcar #'cons params evaluated-args) env))))
  41. ((eql function 'if)
  42. (if (evaluate (car arguments) env)
  43. (evaluate (cadr arguments) env)
  44. (evaluate (caddr arguments) env))) ; if
  45. ((eql function 'let)
  46. (let ((bindings (car arguments))
  47. (body (cadr arguments)))
  48. (let ((new-env (append (mapcar #'(lambda (binding)
  49. (cons (car binding) (evaluate (cadr binding) env)))
  50. bindings)
  51. env)))
  52. (evaluate body new-env))))
  53. ((eql function 'defun) (error "defun не поддерживается: используйте lambda и let для локальных определений"))
  54. ((eql function 'setq) (error "setq не поддерживается: используйте let для локальных определений"))
  55.  
  56. (t ; Пользовательская функция (теперь ищем только в локальном окружении)
  57. (let ((func (cdr (assoc function env))))
  58. (if func
  59. (apply-function (car func) arguments env) ; Прямой вызов lambda, а не eval
  60. (error "Неизвестная функция: ~A" function))))
  61. )))
  62.  
  63. (evaluate expression '()))) ; Начинаем с пустого окружения
  64.  
  65. ;; Примеры использования
  66. (format t "Результат: ~A~%" (lisp-interpreter '(cons (car (cdr (quote (e r t w)))) (cons (cdr (quote (g h 6))) (quote ())))))
  67. (format t "Результат: ~A~%" (lisp-interpreter '(+ 2 (* 3 4))))
  68. (format t "Результат: ~A~%" (lisp-interpreter '(- 10 (/ 6 2))))
  69. (format t "Результат: ~A~%" (lisp-interpreter '(if (> 5 3) 10 20)))
  70. (format t "Результат: ~A~%" (lisp-interpreter '(if (= 5 3) 10 20)))
  71. (format t "Результат: ~A~%" (lisp-interpreter '(car (list 1 2 3))))
  72. (format t "Результат: ~A~%" (lisp-interpreter '(sqrtn 16 2))) ; Корень квадратный из 16
  73. (format t "Результат: ~A~%" (lisp-interpreter '(sqrtn 27 3))) ; Корень кубический из 27
  74. (format t "Результат: ~A~%" (lisp-interpreter '(expt 2 3))) ; 2 в степени 3
  75. ;; Примеры использования let (локальные определения)
  76. (format t "Результат: ~A~%" (lisp-interpreter '(let ((x 10) (y 20)) (+ x y))))
  77. (format t "Результат: ~A~%" (lisp-interpreter '(let ((x 5)) (let ((y (+ x 3))) (* x y)))))
  78.  
  79.  
  80.  
Success #stdin #stdout #stderr 0.02s 9624KB
stdin
Standard input is empty
stdout
Результат: (R (H 6))
Результат: 14
Результат: 7
Результат: 10
Результат: 20
Результат: 1
Результат: 4.0
Результат: 3.0
Результат: 8
Результат: 30
Результат: 40
stderr
Warning: reserving address range 0x80000c0000...0x1fffffffffff that contains memory mappings. clisp might crash later!
Memory dump:
  0x8000000000 - 0x80000bffff
  0x14d6f4000000 - 0x14d6f42e4fff
  0x14d6f4415000 - 0x14d6f4439fff
  0x14d6f443a000 - 0x14d6f45acfff
  0x14d6f45ad000 - 0x14d6f45f5fff
  0x14d6f45f6000 - 0x14d6f45f8fff
  0x14d6f45f9000 - 0x14d6f45fbfff
  0x14d6f45fc000 - 0x14d6f45fffff
  0x14d6f4600000 - 0x14d6f4602fff
  0x14d6f4603000 - 0x14d6f4801fff
  0x14d6f4802000 - 0x14d6f4802fff
  0x14d6f4803000 - 0x14d6f4803fff
  0x14d6f4880000 - 0x14d6f488ffff
  0x14d6f4890000 - 0x14d6f48c3fff
  0x14d6f48c4000 - 0x14d6f49fafff
  0x14d6f49fb000 - 0x14d6f49fbfff
  0x14d6f49fc000 - 0x14d6f49fefff
  0x14d6f49ff000 - 0x14d6f49fffff
  0x14d6f4a00000 - 0x14d6f4a03fff
  0x14d6f4a04000 - 0x14d6f4c03fff
  0x14d6f4c04000 - 0x14d6f4c04fff
  0x14d6f4c05000 - 0x14d6f4c05fff
  0x14d6f4ca6000 - 0x14d6f4ca9fff
  0x14d6f4caa000 - 0x14d6f4caafff
  0x14d6f4cab000 - 0x14d6f4cacfff
  0x14d6f4cad000 - 0x14d6f4cadfff
  0x14d6f4cae000 - 0x14d6f4caefff
  0x14d6f4caf000 - 0x14d6f4caffff
  0x14d6f4cb0000 - 0x14d6f4cbdfff
  0x14d6f4cbe000 - 0x14d6f4ccbfff
  0x14d6f4ccc000 - 0x14d6f4cd8fff
  0x14d6f4cd9000 - 0x14d6f4cdcfff
  0x14d6f4cdd000 - 0x14d6f4cddfff
  0x14d6f4cde000 - 0x14d6f4cdefff
  0x14d6f4cdf000 - 0x14d6f4ce4fff
  0x14d6f4ce5000 - 0x14d6f4ce6fff
  0x14d6f4ce7000 - 0x14d6f4ce7fff
  0x14d6f4ce8000 - 0x14d6f4ce8fff
  0x14d6f4ce9000 - 0x14d6f4ce9fff
  0x14d6f4cea000 - 0x14d6f4d17fff
  0x14d6f4d18000 - 0x14d6f4d26fff
  0x14d6f4d27000 - 0x14d6f4dccfff
  0x14d6f4dcd000 - 0x14d6f4e63fff
  0x14d6f4e64000 - 0x14d6f4e64fff
  0x14d6f4e65000 - 0x14d6f4e65fff
  0x14d6f4e66000 - 0x14d6f4e79fff
  0x14d6f4e7a000 - 0x14d6f4ea1fff
  0x14d6f4ea2000 - 0x14d6f4eabfff
  0x14d6f4eac000 - 0x14d6f4eadfff
  0x14d6f4eae000 - 0x14d6f4eb3fff
  0x14d6f4eb4000 - 0x14d6f4eb6fff
  0x14d6f4eb9000 - 0x14d6f4eb9fff
  0x14d6f4eba000 - 0x14d6f4ebafff
  0x14d6f4ebb000 - 0x14d6f4ebbfff
  0x14d6f4ebc000 - 0x14d6f4ebcfff
  0x14d6f4ebd000 - 0x14d6f4ebdfff
  0x14d6f4ebe000 - 0x14d6f4ec4fff
  0x14d6f4ec5000 - 0x14d6f4ec7fff
  0x14d6f4ec8000 - 0x14d6f4ec8fff
  0x14d6f4ec9000 - 0x14d6f4ee9fff
  0x14d6f4eea000 - 0x14d6f4ef1fff
  0x14d6f4ef2000 - 0x14d6f4ef2fff
  0x14d6f4ef3000 - 0x14d6f4ef3fff
  0x14d6f4ef4000 - 0x14d6f4ef4fff
  0x558d6cade000 - 0x558d6cbcefff
  0x558d6cbcf000 - 0x558d6ccd8fff
  0x558d6ccd9000 - 0x558d6cd38fff
  0x558d6cd3a000 - 0x558d6cd68fff
  0x558d6cd69000 - 0x558d6cd99fff
  0x558d6cd9a000 - 0x558d6cd9dfff
  0x558d6e662000 - 0x558d6e682fff
  0x7ffc8a0ff000 - 0x7ffc8a11ffff
  0x7ffc8a141000 - 0x7ffc8a144fff
  0x7ffc8a145000 - 0x7ffc8a146fff