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.03s 9700KB
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
  0x14c1bdc00000 - 0x14c1bdee4fff
  0x14c1be015000 - 0x14c1be039fff
  0x14c1be03a000 - 0x14c1be1acfff
  0x14c1be1ad000 - 0x14c1be1f5fff
  0x14c1be1f6000 - 0x14c1be1f8fff
  0x14c1be1f9000 - 0x14c1be1fbfff
  0x14c1be1fc000 - 0x14c1be1fffff
  0x14c1be200000 - 0x14c1be202fff
  0x14c1be203000 - 0x14c1be401fff
  0x14c1be402000 - 0x14c1be402fff
  0x14c1be403000 - 0x14c1be403fff
  0x14c1be480000 - 0x14c1be48ffff
  0x14c1be490000 - 0x14c1be4c3fff
  0x14c1be4c4000 - 0x14c1be5fafff
  0x14c1be5fb000 - 0x14c1be5fbfff
  0x14c1be5fc000 - 0x14c1be5fefff
  0x14c1be5ff000 - 0x14c1be5fffff
  0x14c1be600000 - 0x14c1be603fff
  0x14c1be604000 - 0x14c1be803fff
  0x14c1be804000 - 0x14c1be804fff
  0x14c1be805000 - 0x14c1be805fff
  0x14c1be901000 - 0x14c1be904fff
  0x14c1be905000 - 0x14c1be905fff
  0x14c1be906000 - 0x14c1be907fff
  0x14c1be908000 - 0x14c1be908fff
  0x14c1be909000 - 0x14c1be909fff
  0x14c1be90a000 - 0x14c1be90afff
  0x14c1be90b000 - 0x14c1be918fff
  0x14c1be919000 - 0x14c1be926fff
  0x14c1be927000 - 0x14c1be933fff
  0x14c1be934000 - 0x14c1be937fff
  0x14c1be938000 - 0x14c1be938fff
  0x14c1be939000 - 0x14c1be939fff
  0x14c1be93a000 - 0x14c1be93ffff
  0x14c1be940000 - 0x14c1be941fff
  0x14c1be942000 - 0x14c1be942fff
  0x14c1be943000 - 0x14c1be943fff
  0x14c1be944000 - 0x14c1be944fff
  0x14c1be945000 - 0x14c1be972fff
  0x14c1be973000 - 0x14c1be981fff
  0x14c1be982000 - 0x14c1bea27fff
  0x14c1bea28000 - 0x14c1beabefff
  0x14c1beabf000 - 0x14c1beabffff
  0x14c1beac0000 - 0x14c1beac0fff
  0x14c1beac1000 - 0x14c1bead4fff
  0x14c1bead5000 - 0x14c1beafcfff
  0x14c1beafd000 - 0x14c1beb06fff
  0x14c1beb07000 - 0x14c1beb08fff
  0x14c1beb09000 - 0x14c1beb0efff
  0x14c1beb0f000 - 0x14c1beb11fff
  0x14c1beb14000 - 0x14c1beb14fff
  0x14c1beb15000 - 0x14c1beb15fff
  0x14c1beb16000 - 0x14c1beb16fff
  0x14c1beb17000 - 0x14c1beb17fff
  0x14c1beb18000 - 0x14c1beb18fff
  0x14c1beb19000 - 0x14c1beb1ffff
  0x14c1beb20000 - 0x14c1beb22fff
  0x14c1beb23000 - 0x14c1beb23fff
  0x14c1beb24000 - 0x14c1beb44fff
  0x14c1beb45000 - 0x14c1beb4cfff
  0x14c1beb4d000 - 0x14c1beb4dfff
  0x14c1beb4e000 - 0x14c1beb4efff
  0x14c1beb4f000 - 0x14c1beb4ffff
  0x55dacd614000 - 0x55dacd704fff
  0x55dacd705000 - 0x55dacd80efff
  0x55dacd80f000 - 0x55dacd86efff
  0x55dacd870000 - 0x55dacd89efff
  0x55dacd89f000 - 0x55dacd8cffff
  0x55dacd8d0000 - 0x55dacd8d3fff
  0x55daceac8000 - 0x55daceae8fff
  0x7ffe1fecb000 - 0x7ffe1feebfff
  0x7ffe1ffe0000 - 0x7ffe1ffe3fff
  0x7ffe1ffe4000 - 0x7ffe1ffe5fff