fork download
  1. (defun lisp-interpreter (expression)
  2. "Простейший интерпретатор Lisp."
  3. (let ((global-environment '()))
  4.  
  5. (labels (
  6. (evaluate (expr env)
  7. (cond
  8. ((numberp expr) expr)
  9. ((symbolp expr) (or (lookup expr env) expr)) ; Ищем значение переменной
  10. ((listp expr)
  11. (let ((function (car expr))
  12. (arguments (cdr expr)))
  13. (apply-function function arguments env)))
  14. (t (error "Неизвестный тип выражения: ~A" expr))))
  15.  
  16. (lookup (symbol env)
  17. (assoc symbol env))
  18.  
  19. (apply-function (function arguments env)
  20. (cond
  21. ((eql function 'quote) (car arguments))
  22. ((eql function 'car) (car (evaluate (car arguments) env)))
  23. ((eql function 'cdr) (cdr (evaluate (car arguments) env)))
  24. ((eql function 'cons) (cons (evaluate (car arguments) env) (evaluate (cadr arguments) env)))
  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 '*) (apply '* (mapcar #'(lambda (arg) (evaluate arg env)) arguments)))
  28. ((eql function '/) (apply '/ (mapcar #'(lambda (arg) (evaluate arg env)) arguments)))
  29. ((eql function '=) (= (evaluate (car arguments) env) (evaluate (cadr arguments) env)))
  30. ((eql function '<) (< (evaluate (car arguments) env) (evaluate (cadr arguments) env)))
  31. ((eql function '>) (> (evaluate (car arguments) env) (evaluate (cadr arguments) env)))
  32. ((eql function 'list) (mapcar #'(lambda (arg) (evaluate arg env)) arguments)) ; Реализация list
  33. ((eql function 'if)
  34. (if (evaluate (car arguments) env)
  35. (evaluate (cadr arguments) env)
  36. (evaluate (caddr arguments) env))) ; if
  37. ((eql function 'defun)
  38. (let ((name (car arguments))
  39. (params (cadr arguments))
  40. (body (caddr arguments)))
  41. (setf global-environment (acons name `(lambda ,params ,body) global-environment))
  42. name))
  43. ((eql function 'setq)
  44. (let ((symbol (car arguments))
  45. (value (evaluate (cadr arguments) env)))
  46. (setf global-environment (acons symbol value global-environment))
  47. value))
  48. (t ; Пользовательская функция или lambda (ищем в окружении)
  49. (let ((func-def (lookup function env)))
  50. (if func-def
  51. (let ((func (cdr func-def))
  52. (params (cadr func))
  53. (body (caddr func))
  54. (evaluated-args (mapcar #'(lambda (arg) (evaluate arg env)) arguments)))
  55. (evaluate body (append (mapcar #'cons params evaluated-args) env)))
  56. (let ((func-def-global (lookup function global-environment)))
  57. (if func-def-global
  58. (let ((func (cdr func-def-global))
  59. (params (cadr func))
  60. (body (caddr func))
  61. (evaluated-args (mapcar #'(lambda (arg) (evaluate arg env)) arguments)))
  62. (evaluate body (append (mapcar #'cons params evaluated-args) env)))
  63. (error "Неизвестная функция: ~A" function))))))
  64. )))
  65.  
  66. (evaluate expression global-environment))))
  67.  
  68. ;; Примеры использования
  69. (format t "Результат: ~A~%" (lisp-interpreter '(cons (car (cdr (quote (e r t w)))) (cons (cdr (quote (g h 6))) (quote ())))))
  70. (format t "Результат: ~A~%" (lisp-interpreter '(+ 2 (* 3 4))))
  71. (format t "Результат: ~A~%" (lisp-interpreter '(- 10 (/ 6 2))))
  72. (format t "Результат: ~A~%" (lisp-interpreter '(if (> 5 3) 10 20)))
  73. (format t "Результат: ~A~%" (lisp-interpreter '(if (= 5 3) 10 20)))
  74. (format t "Результат: ~A~%" (lisp-interpreter '(car (list 1 2 3))))
  75.  
Success #stdin #stdout #stderr 0.02s 9664KB
stdin
Standard input is empty
stdout
Результат: (R (H 6))
Результат: 14
Результат: 7
Результат: 10
Результат: 20
Результат: 1
stderr
Warning: reserving address range 0x80000c0000...0x1fffffffffff that contains memory mappings. clisp might crash later!
Memory dump:
  0x8000000000 - 0x80000bffff
  0x14d43b600000 - 0x14d43b8e4fff
  0x14d43ba00000 - 0x14d43ba02fff
  0x14d43ba03000 - 0x14d43bc01fff
  0x14d43bc02000 - 0x14d43bc02fff
  0x14d43bc03000 - 0x14d43bc03fff
  0x14d43bc15000 - 0x14d43bc39fff
  0x14d43bc3a000 - 0x14d43bdacfff
  0x14d43bdad000 - 0x14d43bdf5fff
  0x14d43bdf6000 - 0x14d43bdf8fff
  0x14d43bdf9000 - 0x14d43bdfbfff
  0x14d43bdfc000 - 0x14d43bdfffff
  0x14d43be00000 - 0x14d43be03fff
  0x14d43be04000 - 0x14d43c003fff
  0x14d43c004000 - 0x14d43c004fff
  0x14d43c005000 - 0x14d43c005fff
  0x14d43c03f000 - 0x14d43c040fff
  0x14d43c041000 - 0x14d43c050fff
  0x14d43c051000 - 0x14d43c084fff
  0x14d43c085000 - 0x14d43c1bbfff
  0x14d43c1bc000 - 0x14d43c1bcfff
  0x14d43c1bd000 - 0x14d43c1bffff
  0x14d43c1c0000 - 0x14d43c1c0fff
  0x14d43c1c1000 - 0x14d43c1c2fff
  0x14d43c1c3000 - 0x14d43c1c3fff
  0x14d43c1c4000 - 0x14d43c1c5fff
  0x14d43c1c6000 - 0x14d43c1c6fff
  0x14d43c1c7000 - 0x14d43c1c7fff
  0x14d43c1c8000 - 0x14d43c1c8fff
  0x14d43c1c9000 - 0x14d43c1d6fff
  0x14d43c1d7000 - 0x14d43c1e4fff
  0x14d43c1e5000 - 0x14d43c1f1fff
  0x14d43c1f2000 - 0x14d43c1f5fff
  0x14d43c1f6000 - 0x14d43c1f6fff
  0x14d43c1f7000 - 0x14d43c1f7fff
  0x14d43c1f8000 - 0x14d43c1fdfff
  0x14d43c1fe000 - 0x14d43c1fffff
  0x14d43c200000 - 0x14d43c200fff
  0x14d43c201000 - 0x14d43c201fff
  0x14d43c202000 - 0x14d43c202fff
  0x14d43c203000 - 0x14d43c230fff
  0x14d43c231000 - 0x14d43c23ffff
  0x14d43c240000 - 0x14d43c2e5fff
  0x14d43c2e6000 - 0x14d43c37cfff
  0x14d43c37d000 - 0x14d43c37dfff
  0x14d43c37e000 - 0x14d43c37efff
  0x14d43c37f000 - 0x14d43c392fff
  0x14d43c393000 - 0x14d43c3bafff
  0x14d43c3bb000 - 0x14d43c3c4fff
  0x14d43c3c5000 - 0x14d43c3c6fff
  0x14d43c3c7000 - 0x14d43c3ccfff
  0x14d43c3cd000 - 0x14d43c3cffff
  0x14d43c3d2000 - 0x14d43c3d2fff
  0x14d43c3d3000 - 0x14d43c3d3fff
  0x14d43c3d4000 - 0x14d43c3d4fff
  0x14d43c3d5000 - 0x14d43c3d5fff
  0x14d43c3d6000 - 0x14d43c3d6fff
  0x14d43c3d7000 - 0x14d43c3ddfff
  0x14d43c3de000 - 0x14d43c3e0fff
  0x14d43c3e1000 - 0x14d43c3e1fff
  0x14d43c3e2000 - 0x14d43c402fff
  0x14d43c403000 - 0x14d43c40afff
  0x14d43c40b000 - 0x14d43c40bfff
  0x14d43c40c000 - 0x14d43c40cfff
  0x14d43c40d000 - 0x14d43c40dfff
  0x55ee7adb4000 - 0x55ee7aea4fff
  0x55ee7aea5000 - 0x55ee7afaefff
  0x55ee7afaf000 - 0x55ee7b00efff
  0x55ee7b010000 - 0x55ee7b03efff
  0x55ee7b03f000 - 0x55ee7b06ffff
  0x55ee7b070000 - 0x55ee7b073fff
  0x55ee7cd9b000 - 0x55ee7cdbbfff
  0x7fffa0d8a000 - 0x7fffa0daafff
  0x7fffa0dbe000 - 0x7fffa0dc1fff
  0x7fffa0dc2000 - 0x7fffa0dc3fff