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.  
Success #stdin #stdout #stderr 0.02s 9716KB
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
  0x149768200000 - 0x1497684e4fff
  0x149768600000 - 0x149768602fff
  0x149768603000 - 0x149768801fff
  0x149768802000 - 0x149768802fff
  0x149768803000 - 0x149768803fff
  0x149768815000 - 0x149768839fff
  0x14976883a000 - 0x1497689acfff
  0x1497689ad000 - 0x1497689f5fff
  0x1497689f6000 - 0x1497689f8fff
  0x1497689f9000 - 0x1497689fbfff
  0x1497689fc000 - 0x1497689fffff
  0x149768a00000 - 0x149768a03fff
  0x149768a04000 - 0x149768c03fff
  0x149768c04000 - 0x149768c04fff
  0x149768c05000 - 0x149768c05fff
  0x149768c35000 - 0x149768c36fff
  0x149768c37000 - 0x149768c46fff
  0x149768c47000 - 0x149768c7afff
  0x149768c7b000 - 0x149768db1fff
  0x149768db2000 - 0x149768db2fff
  0x149768db3000 - 0x149768db5fff
  0x149768db6000 - 0x149768db6fff
  0x149768db7000 - 0x149768db8fff
  0x149768db9000 - 0x149768db9fff
  0x149768dba000 - 0x149768dbbfff
  0x149768dbc000 - 0x149768dbcfff
  0x149768dbd000 - 0x149768dbdfff
  0x149768dbe000 - 0x149768dbefff
  0x149768dbf000 - 0x149768dccfff
  0x149768dcd000 - 0x149768ddafff
  0x149768ddb000 - 0x149768de7fff
  0x149768de8000 - 0x149768debfff
  0x149768dec000 - 0x149768decfff
  0x149768ded000 - 0x149768dedfff
  0x149768dee000 - 0x149768df3fff
  0x149768df4000 - 0x149768df5fff
  0x149768df6000 - 0x149768df6fff
  0x149768df7000 - 0x149768df7fff
  0x149768df8000 - 0x149768df8fff
  0x149768df9000 - 0x149768e26fff
  0x149768e27000 - 0x149768e35fff
  0x149768e36000 - 0x149768edbfff
  0x149768edc000 - 0x149768f72fff
  0x149768f73000 - 0x149768f73fff
  0x149768f74000 - 0x149768f74fff
  0x149768f75000 - 0x149768f88fff
  0x149768f89000 - 0x149768fb0fff
  0x149768fb1000 - 0x149768fbafff
  0x149768fbb000 - 0x149768fbcfff
  0x149768fbd000 - 0x149768fc2fff
  0x149768fc3000 - 0x149768fc5fff
  0x149768fc8000 - 0x149768fc8fff
  0x149768fc9000 - 0x149768fc9fff
  0x149768fca000 - 0x149768fcafff
  0x149768fcb000 - 0x149768fcbfff
  0x149768fcc000 - 0x149768fccfff
  0x149768fcd000 - 0x149768fd3fff
  0x149768fd4000 - 0x149768fd6fff
  0x149768fd7000 - 0x149768fd7fff
  0x149768fd8000 - 0x149768ff8fff
  0x149768ff9000 - 0x149769000fff
  0x149769001000 - 0x149769001fff
  0x149769002000 - 0x149769002fff
  0x149769003000 - 0x149769003fff
  0x563e60f3a000 - 0x563e6102afff
  0x563e6102b000 - 0x563e61134fff
  0x563e61135000 - 0x563e61194fff
  0x563e61196000 - 0x563e611c4fff
  0x563e611c5000 - 0x563e611f5fff
  0x563e611f6000 - 0x563e611f9fff
  0x563e6298e000 - 0x563e629aefff
  0x7ffdada73000 - 0x7ffdada93fff
  0x7ffdadaab000 - 0x7ffdadaaefff
  0x7ffdadaaf000 - 0x7ffdadab0fff