lisp-0

Table of Contents

План работ

Начнем с реализации лисп-системы, которая позволит вычислять списковые формы. Поскольку любую программу можно представить в виде дерева, а его, в свою очередь, в виде списка списков (любой глубины) - этого будет достаточно, чтобы получить работающий вычислитель.

Важнейшая часть интерпретатора Лисп - функция, называемая eval, принимает на вход список, представляющий собой программу, а на выходе возвращает результат её исполнения.

Вторая важная часть, без которой невозможно обойтись, называется repl. Эта функция, реализующая цикл read-eval-print-loop, который позволяет нам вводить формы в вычислитель и получать результат в интерактивном режиме.

Так как мы пишем интерпретатор Lisp, используя в качестве хост-языка Common Lisp, то, чтобы избежать пересечения имен, наша функция будет называться myeval.

Для того, чтобы писать минимально осмысленные лисп-программмы мы должны реализовать базовый набор примитивов (называемый pure lisp):

  • cons
  • car
  • cdr
  • null
  • consp
  • define
  • lambda
  • functionp
  • numberp
  • eq
  • сравнение чисел (=)
  • if (или cond)

Имея функцию сравнения на равенство чисел и функции car и cdr можно определить функцию, которая сравнивает списки, состоящие из чисел. Поэтому база сравнений это:

  • eq (сравнение символов)
  • = (сравнение чисел)

В целях тренировки (на первом этапе) мы реализуем несколько отличающийся набор:

  • вычисление самовычисляемых форм, таких как числа, истина (Т) и ложь (nil)
  • арифметические вычисления: + (add) и * (mul)
  • quote
  • car
  • cdr
  • cons
  • null
  • if
  • cond
  • progn
  • print
  • list
  • and
  • or

Можно построить myeval с помощью cond, тогда его структура будет такой:

(defun myeval (lst)
  (cond
    ;; Какие-то действия в зависимости от того какая форма
    ;; ...
    (t (error 'unknown-form))))

Самовычисляемые формы

Первые случаи, которые мы можем реализовать - это самовычисляемые формы, такие, например, как NIL, T и числа, которые вычисляются сами в себя:

((null lst)                  nil)
((equal t lst)               t)
((numberp lst)               lst)

Протестируем:

;; Тесты для самовычисляемых форм
(assert (equal T (myeval 'T)))
(assert (equal NIL (myeval 'NIL)))
(assert (equal 999 (myeval 999)))

Цитирование

Следующая важная вещь - специальный оператор quote. Он возвращает свое содержимое без вычисления:

((equal (car lst) 'quote)    (cadr lst))

Протестируем:

;; Тесты для QUOTE
(assert (equal '(+ 1 2) (myeval '(quote (+ 1 2)))))

Работа с CONS-ячейками

Теперь определим car и cdr:

((equal (car lst) 'car)      (car (myeval (cadr lst))))
((equal (car lst) 'cdr)      (cdr (myeval (cadr lst))))

Мы пока не можем протестировать их работу, потому что у нас нет cons. Исправим это:

((equal (car lst) 'cons)     (cons (myeval (cadr lst))
                                   (myeval (caddr lst))))

Теперь можно протестировать создание cons-ячеек и получение правой и левой части ячейки:

;; Тесты для cons-ячеек
(assert (equal '(1 . 2) (myeval '(cons 1 2))))
(assert (equal '((1 . 2) 3 . 4) (myeval '(cons (cons 1 2) (cons 3 4)))))
(assert (equal 2 (myeval '(car (cons 2 3)))))
(assert (equal 3 (myeval '(cdr (cons 2 3)))))
(assert (equal '(1 . 2) (myeval '(car (cons (cons 1 2) (cons 3 4))))))
(assert (equal '(3 . 4) (myeval '(cdr (cons (cons 1 2) (cons 3 4))))))

NULL-предикат

Следующий этап - функция проверки на пустой список:

((equal (car lst) 'null)     (null (myeval (cadr lst))))

Тест:

;; Тесты для NULL
(assert (equal T (myeval '(null ()))))

Условное выполнение (IF)

Теперь мы можем создать IF. Он принимает три аргумента и в зависимости от результата вычисления первого аргумента вычисляет второй или третий аргумент:

((equal (car lst) 'if)       (if (myeval (cadr lst))
                                 (myeval (caddr lst))
                                 (myeval (cadddr lst))))

Проверим, правильно ли вычисляется IF:

;; Тесты для IF
(assert (equal 2 (myeval '(if () 1 2))))
(assert (equal 1 (myeval '(if (null ()) 1 2))))

COND

Определив IF, мы можем заняться и более сложной управляющей формой - COND. Для ее реализации потребуется вспомогательная функция, которая будет рекурсивно исполнять аргументы COND. Назовем ее EVCOND:

(defun evcond (lst)
  (cond ((null lst)               nil)
        ((myeval (caar lst))      (myeval (cadar lst)))
        (t                        (evcond (cdr lst)))))

Она вычисляет левую часть первого из переданных clauses и если оценка вернула T - то выполняет соответствующую правую часть и возвращается. В противном случае она рекурсивно вызывает себя, передавая остаток списка clauses

Протестируем EVCOND:

;; Тесты для ENVCOND
(assert (equal 2   (evcond '((t 2)   (t 1)))))
(assert (equal 1   (evcond '((nil 2) (t 1)))))
(assert (equal nil (evcond '((nil 2) (nil 1)))))

С использованием EVCOND определить COND довольно просто:

((equal (car lst) 'cond)     (evcond (cdr lst)))

Протестируем правильность работы COND:

;; Тесты для COND
(assert (equal 2 (myeval '(cond
                           (() 1)
                           (1 2)))))

PROGN

Далее нам понадобится progn. Снова будем использовать вспомогательную функцию, которую назовем evprogn:

(defun evprogn (lst)
  (cond ((null lst)        nil)
        ((null (cdr lst))  (myeval (car lst)))
        (t                 (myeval (car lst))
                           (evprogn (cdr lst)))))

Эта функция завершается с возвращением результата выполнения первого элемента переданного списка, когда ей передан список из одного элемента. Иначе она вычисляет первый элемент и рекурсивно вызывает себя от остатка списка.

Тест для evprogn:

;; Тест для EVPROGN
(assert (equal 2 (evprogn '(1 2))))

с ее помощью определим PROGN:

((equal (car lst) 'progn)    (evprogn (cdr lst)))

И проверим:

;; Тесты для PROGN
(assert (equal 3 (myeval '(progn 1 2 3))))

PRINT

Для того, чтобы иметь возможность отладочной печати, определим PRINT:

Чтобы протестировать print воспользуемся перехватом standatd-output

LIST

List - это функция, которая вычисляет свои аргументы и формирует из результатов вычисления список. Для ее определения нам понадобится вспомогательная функция evlis. Она рекурсивно исполняет список, полученный в первом аргументе, применяя к результатам исполнения CONS, чтобы получить список результатов:

(defun evlis (lst)
  (cond ((null lst)  nil)
        (t           (cons (myeval (car lst))
                           (evlis (cdr lst))))))

Протестируем evlis:

;; Тесты для EVLIS
(assert (equal '(3 6 42)
               (evlis '((+ 1 2) (* 2 3) 42))))

Теперь мы можем определить list:

((equal (car lst) 'list)     (evlis (cdr lst)))

Протестируем list

;; Тесты для LIST
(assert (equal '(3 6 42)
               (myeval '(list (+ 1 2) (* 2 3) 42))))

AND

Возможны три ситуации:

  • при передаче пустого списка аргументов and возвращает T
  • при передаче списка из одного элемента and возвращает результат оценки этого элемента
  • в ином случае and оценивает первый аргумент
    • если он равен nil - возвращает nil
    • иначе возвращает результат рекурсивного вызова от остатка списка аргументов

возвращаемое значение вычисляется как результат операции and над оценкой первого элемента и возвратом рекурсивного вызова

(defun evand (args)
  (cond ((null args)        T)
        ((null (cdr args))  (myeval (car args)))
        (t                  (let ((tmp (myeval (car args))))
                              (if (null tmp)
                                  nil
                                  (evand (cdr args)))))))

Протестируем evand:

;; Тесты для EVAND
(assert (equal (and)           (evand '())))
(assert (equal (and 1)         (evand '(1))))
(assert (equal (and nil)       (evand '(nil))))
(assert (equal (and 1 nil)     (evand '(1 nil ))))
(assert (equal (and 1 2 nil)   (evand '(1 2 nil))))
(assert (equal (and 1 2 3)     (evand '(1 2 3))))
(assert (equal (and 1 2 nil 3) (evand '(1 2 nil 3))))

Теперь мы можем определить and:

((equal (car lst) 'and)      (evand (cdr lst)))

Протестируем and:

;; Тесты для AND
(assert (equal (and)                  (myeval '(and))))
(assert (equal (and 1)                (myeval '(and 1))))
(assert (equal (and nil)              (myeval '(and nil))))
(assert (equal (and 1 nil)            (myeval '(and 1 nil))))
(assert (equal (and 1 2 nil)          (myeval '(and 1 2 nil))))
(assert (equal (and 1 2 3)            (myeval '(and 1 2 3))))
(assert (equal (and 1 2 nil 3)        (myeval '(and 1 2 nil 3))))
(assert (equal (and 1 (and 1 2) 3)    (myeval '(and 1 (and 1 2) 3))))
(assert (equal (and 1 (and 1 nil) 3)  (myeval '(and 1 (and 1 nil) 3))))

OR

Возможны три ситуации:

  • при передаче пустого списка аргументов or возвращает nil
  • при передаче списка из одного элемента or возвращает результат оценки этого элемента
  • в ином случае or оценивает первый аргумент
    • если он НЕ равен nil - возвращает его
    • иначе возвращает результат рекурсивного вызова от остатка списка аргументов
(defun evor (args)
  (cond ((null args)        nil)
        ((null (cdr args))  (myeval (car args)))
        (t                  (let ((tmp (myeval (car args))))
                              (if (not (null tmp))
                                  tmp
                                  (evor (cdr args)))))))

Тесты

;; Тесты для EVOR
(assert (equal (or)                   (evor '())))
(assert (equal (or nil 1)             (evor '(nil 1))))
(assert (equal (or nil nil 1)         (evor '(nil nil 1))))
(assert (equal (or nil 1 2)           (evor '(nil 1 2))))
(assert (equal (or 1 2 3)             (evor '(1 2 3))))
(assert (equal (or nil nil 3 nil)     (evor '(nil nil 3 nil))))

Теперь мы можем определить or:

((equal (car lst) 'or)       (evor  (cdr lst)))

Протестируем or:

;; Тесты для OR
(assert (equal (or)                      (myeval '(or))))
(assert (equal (or nil 1)                (myeval '(or nil 1))))
(assert (equal (or nil nil 1)            (myeval '(or nil nil 1))))
(assert (equal (or nil 1 2)              (myeval '(or nil 1 2))))
(assert (equal (or nil (or 3 2) 2)       (myeval '(or nil (or 3 2) 2))))
(assert (equal (or nil (or nil nil) 2)   (myeval '(or nil (or nil nil) 2))))

Встроенные функции арифметики

Теперь мы можем сделать функции сложения и умножения. Для того, чтобы они могли принимать любое количество аргументов, необходимо сделать их рекурсивными.

Они будут получать список, брать из него первый элемент и оценивать его, а потом рекурсивно вызывать себя от остатка списка.

(defun evadd (lst)
  (cond ((null lst)        0)
        ((null (cdr lst))  (+ (myeval (car lst))))
        (t                 (+ (myeval (car lst))
                              (evadd (cdr lst))))))
(defun evmul (lst)
  (cond ((null lst)        1)
        ((null (cdr lst))  (* (myeval (car lst))))
        (t                 (* (myeval (car lst))
                              (evmul (cdr lst))))))

Протестируем evadd и evmul:

;; Тесты для EVADD
(assert (equal 0                (evadd '())))
(assert (equal 2                (evadd '(2))))
(assert (equal 5                (evadd '(2 3))))
(assert (equal (+ 2 3 4)        (evadd '(2 3 4))))
(assert (equal (+ 2 (+ 3 4))    (evadd '(2 (+ 3 4)))))
(assert (equal (+ 2 (+ 3 4) 5)  (evadd '(2 (+ 3 4) 5))))
;; Тесты для EVMUL
(assert (equal 1                (evmul '())))
(assert (equal 2                (evmul '(2))))
(assert (equal 6                (evmul '(2 3))))
(assert (equal (* 2 3 4)        (evmul '(2 3 4))))
(assert (equal (* 2 (* 3 4))    (evmul '(2 (* 3 4)))))
(assert (equal (* 2 (* 3 4) 5)  (evmul '(2 (* 3 4) 5))))

Теперь мы можем определить сложение и умножение внутри myeval

((equal (car lst) '+)        (evadd (cdr lst)))
((equal (car lst) '*)        (evmul (cdr lst)))

Теперь мы можем протестировать то, что у нас получилось:

;; Тесты для сложения
(assert (equal 0                (myeval '(+))))
(assert (equal (+ 2)            (myeval '(+ 2))))
(assert (equal (+ 2 3)          (myeval '(+ 2 3))))
(assert (equal (+ 2 3 4)        (myeval '(+ 2 3 4))))
(assert (equal (+ 2 (+ 3 4))    (myeval '(+ 2 (+ 3 4)))))
(assert (equal (+ 2 (+ 3 4) 5)  (myeval '(+ 2 (+ 3 4) 5))))
;; Тесты для умножения
(assert (equal 1                (myeval '(*))))
(assert (equal (* 2)            (myeval '(* 2))))
(assert (equal (* 2 3)          (myeval '(* 2 3))))
(assert (equal (* 2 3 4)        (myeval '(* 2 3 4))))
(assert (equal (* 2 (* 3 4))    (myeval '(* 2 (* 3 4)))))
(assert (equal (* 2 (* 3 4) 5)  (myeval '(* 2 (* 3 4) 5))))

MyEval

Теперь мы можем собрать из вышеперечисленных кусочков myeval, предварив его всеми впомогательными функциями.

<<evcond_0>>
<<evprogn_0>>
<<evlis_0>>
<<evand_0>>
<<evor_0>>
<<evaddmul_0>>
(defun myeval (lst)
  (cond
    <<number_0>>
    <<quote_0>>
    <<car_cdr_0>>
    <<cons_0>>
    <<null_0>>
    <<if_0>>
    <<cond_0>>
    <<progn_0>>
    <<print_0>>
    <<list_0>>
    <<and_0>>
    <<or_0>>
    <<ariph_0>>
    (t (error 'unknown-form))))

И также собрать все тесты:

<<number_0_test>>
<<quote_0_test>>
<<car_cdr_cons_0_test>>
<<null_0_test>>
<<if_0_test>>
<<evcond_0_test>>
<<cond_0_test>>
<<evprogn_0_test>>
<<progn_0_test>>
<<print_0_test>>
<<evlis_0_test>>
<<list_0_test>>
<<evand_0_test>>
<<and_0_test>>
<<evor_0_test>>
<<or_0_test>>
<<evaddmul_0_test>>
<<ariph_0_test>>

REPL

Read-Eval-Print-Loop - визитная карточка лиспа. Определим его:

(defun repl ()
  (princ "microlisp>")
  (finish-output)
  (princ (myeval (read)))
  (terpri)
  (finish-output)
  (repl))

Итоги

Соберем простой интерпретатор из myeval, вспомогательных функций и repl и запишем его файл:

<<myeval_0>>
<<repl_0>>
<<myeval_0_test>>

Мы должны получить следующий результат:

(defun evcond (lst)
  (cond ((null lst)               nil)
        ((myeval (caar lst))      (myeval (cadar lst)))
        (t                        (evcond (cdr lst)))))
(defun evprogn (lst)
  (cond ((null lst)        nil)
        ((null (cdr lst))  (myeval (car lst)))
        (t                 (myeval (car lst))
                           (evprogn (cdr lst)))))
(defun evlis (lst)
  (cond ((null lst)  nil)
        (t           (cons (myeval (car lst))
                           (evlis (cdr lst))))))
(defun evand (lst)
  (cond ((null lst)        (and))
        ((null (cdr lst))  (and (myeval (car lst))))
        (t                 (and (myeval (car lst))
                                (evand (cdr lst))))))
(defun evor (lst)
  (cond ((null lst)        (or))
        ((null (cdr lst))  (or (myeval (car lst))))
        (t                 (or (myeval (car lst))
                               (evor (cdr lst))))))
(defun evadd (lst)
  (cond ((null lst)        0)
        ((null (cdr lst))  (+ (myeval (car lst))))
        (t                 (+ (myeval (car lst))
                              (evadd (cdr lst))))))
(defun evmul (lst)
  (cond ((null lst)        1)
        ((null (cdr lst))  (* (myeval (car lst))))
        (t                 (* (myeval (car lst))
                              (evmul (cdr lst))))))
(defun myeval (lst)
  (cond
    ((null lst)                  nil)
    ((equal t lst)               t)
    ((numberp lst)               lst)
    ((equal (car lst) 'quote)    (cadr lst))
    ((equal (car lst) 'car)      (car (myeval (cadr lst))))
    ((equal (car lst) 'cdr)      (cdr (myeval (cadr lst))))
    ((equal (car lst) 'cons)     (cons (myeval (cadr lst))
                                       (myeval (caddr lst))))
    ((equal (car lst) 'null)     (null (myeval (cadr lst))))
    ((equal (car lst) 'if)       (if (myeval (cadr lst))
                                     (myeval (caddr lst))
                                     (myeval (cadddr lst))))
    ((equal (car lst) 'cond)     (evcond (cdr lst)))
    ((equal (car lst) 'progn)    (evprogn (cdr lst)))
    ((equal (car lst) 'print)    (print (myeval (cadr lst))))
    ((equal (car lst) 'list)     (evlis (cdr lst)))
    ((equal (car lst) 'and)      (evand (cdr lst)))
    ((equal (car lst) 'or)       (evor  (cdr lst)))
    ((equal (car lst) '+)        (evadd (cdr lst)))
    ((equal (car lst) '*)        (evmul (cdr lst)))
    (t (error 'unknown-form))))
(defun repl ()
  (princ "microlisp>")
  (finish-output)
  (princ (myeval (read)))
  (terpri)
  (finish-output)
  (repl))
;; Тесты для самовычисляемых форм
(assert (equal T (myeval 'T)))
(assert (equal NIL (myeval 'NIL)))
(assert (equal 999 (myeval 999)))
;; Тесты для QUOTE
(assert (equal '(+ 1 2) (myeval '(quote (+ 1 2)))))
;; Тесты для cons-ячеек
(assert (equal '(1 . 2) (myeval '(cons 1 2))))
(assert (equal '((1 . 2) 3 . 4) (myeval '(cons (cons 1 2) (cons 3 4)))))
(assert (equal 2 (myeval '(car (cons 2 3)))))
(assert (equal 3 (myeval '(cdr (cons 2 3)))))
(assert (equal '(1 . 2) (myeval '(car (cons (cons 1 2) (cons 3 4))))))
(assert (equal '(3 . 4) (myeval '(cdr (cons (cons 1 2) (cons 3 4))))))
;; Тесты для NULL
(assert (equal T (myeval '(null ()))))
;; Тесты для IF
(assert (equal 2 (myeval '(if () 1 2))))
(assert (equal 1 (myeval '(if (null ()) 1 2))))
;; Тесты для ENVCOND
(assert (equal 2   (evcond '((t 2)   (t 1)))))
(assert (equal 1   (evcond '((nil 2) (t 1)))))
(assert (equal nil (evcond '((nil 2) (nil 1)))))
;; Тесты для COND
(assert (equal 2 (myeval '(cond
                           (() 1)
                           (1 2)))))
;; Тест для EVPROGN
(assert (equal 2 (evprogn '(1 2))))
;; Тесты для PROGN
(assert (equal 3 (myeval '(progn 1 2 3))))
;; Тесты для PRINT
(assert (equal (with-output-to-string (*standard-output*)
                 (print 12))
               (with-output-to-string (*standard-output*)
                 (myeval '(print 12)))))
(assert (equal (print 12)
               (myeval '(print 12))))
;; Тесты для EVLIS
(assert (equal '(3 6 42)
               (evlis '((+ 1 2) (* 2 3) 42))))
;; Тесты для LIST
(assert (equal '(3 6 42)
               (myeval '(list (+ 1 2) (* 2 3) 42))))
;; Тесты для EVAND
(assert (equal (and)           (evand '())))
(assert (equal (and 1)         (evand '(1))))
(assert (equal (and nil)       (evand '(nil))))
(assert (equal (and 1 nil)     (evand '(1 nil ))))
(assert (equal (and 1 2 nil)   (evand '(1 2 nil))))
(assert (equal (and 1 2 3)     (evand '(1 2 3))))
;; Тесты для AND
(assert (equal (and)                (myeval '(and))))
(assert (equal (and 1)              (myeval '(and 1))))
(assert (equal (and nil)            (myeval '(and nil))))
(assert (equal (and 1 nil)          (myeval '(and 1 nil))))
(assert (equal (and 1 2 nil)        (myeval '(and 1 2 nil))))
(assert (equal (and 1 2 3)          (myeval '(and 1 2 3))))
(assert (equal (and 1 (and 1 2) 3)  (myeval '(and 1 (and 1 2) 3))))
;; Тесты для EVOR
(assert (equal (or)           (evor '())))
(assert (equal (or nil 1)     (evor '(nil 1))))
(assert (equal (or nil nil 1) (evor '(nil nil 1))))
(assert (equal (or nil 1 2)   (evor '(nil 1 2))))
(assert (equal (or 1 2 3)     (evor '(1 2 3))))
;; Тесты для OR
(assert (equal (or)                  (myeval '(or))))
(assert (equal (or nil 1)            (myeval '(or nil 1))))
(assert (equal (or nil nil 1)        (myeval '(or nil nil 1))))
(assert (equal (or nil 1 2)          (myeval '(or nil 1 2))))
(assert (equal (or nil (or 3 2) 2)   (myeval '(or nil (or 3 2) 2))))
;; Тесты для EVADD
(assert (equal 0                (evadd '())))
(assert (equal 2                (evadd '(2))))
(assert (equal 5                (evadd '(2 3))))
(assert (equal (+ 2 3 4)        (evadd '(2 3 4))))
(assert (equal (+ 2 (+ 3 4))    (evadd '(2 (+ 3 4)))))
(assert (equal (+ 2 (+ 3 4) 5)  (evadd '(2 (+ 3 4) 5))))
;; Тесты для EVMUL
(assert (equal 1                (evmul '())))
(assert (equal 2                (evmul '(2))))
(assert (equal 6                (evmul '(2 3))))
(assert (equal (* 2 3 4)        (evmul '(2 3 4))))
(assert (equal (* 2 (* 3 4))    (evmul '(2 (* 3 4)))))
(assert (equal (* 2 (* 3 4) 5)  (evmul '(2 (* 3 4) 5))))
;; Тесты для сложения
(assert (equal 0                (myeval '(+))))
(assert (equal (+ 2)            (myeval '(+ 2))))
(assert (equal (+ 2 3)          (myeval '(+ 2 3))))
(assert (equal (+ 2 3 4)        (myeval '(+ 2 3 4))))
(assert (equal (+ 2 (+ 3 4))    (myeval '(+ 2 (+ 3 4)))))
(assert (equal (+ 2 (+ 3 4) 5)  (myeval '(+ 2 (+ 3 4) 5))))
;; Тесты для умножения
(assert (equal 1                (myeval '(*))))
(assert (equal (* 2)            (myeval '(* 2))))
(assert (equal (* 2 3)          (myeval '(* 2 3))))
(assert (equal (* 2 3 4)        (myeval '(* 2 3 4))))
(assert (equal (* 2 (* 3 4))    (myeval '(* 2 (* 3 4)))))
(assert (equal (* 2 (* 3 4) 5)  (myeval '(* 2 (* 3 4) 5))))
Яндекс.Метрика
Home