Как реализовать условные конструкции в языке Форт?

Question

[Filipp42]

Здравствуйте!
Пишу реализацию Форта на Лиспе.
Вот код:

spoiler

(defstruct forth-word
  name
  definition)

(defun list-to-word (list)
    (make-forth-word :name       (first list)
                     :definition (rest list)))

(defun make-forth-dictionary (&rest lists)
    (loop for lst in lists
               collect (make-forth-word :name (first lst)
                                        :definition (second lst))))

(defun add-word-to-dictionary (the-word dictionary)
    (cons the-word dictionary))

(defvar *data-stack* nil)

(defparameter *dictionary*
  (make-forth-dictionary
      (list '+ #'(lambda (stack)
                     (let ((a (pop stack))
                           (b (pop stack)))
                         (cons (+ a b)
                               stack))))
      
      (list '- #'(lambda (stack)
                     (let ((a (pop stack))
                           (b (pop stack)))
                         (cons (- b a)
                               stack))))
      
      (list '* #'(lambda (stack)
                     (let ((a (pop stack))
                           (b (pop stack)))
                         (cons (* a b)
                               stack))))
      
      (list '/ #'(lambda (stack)
                     (let ((a (pop stack))
                           (b (pop stack)))
                         (cons (/ a b)
                               stack))))
      
      (list '\. #'(lambda (stack)
                     (print (car stack))
                     (cdr stack)))
      
      (list 'dup #'(lambda (stack)
                       (cons (car stack)
                             stack)))
      (list 'swap #'(lambda (stack)
                        (let ((a (pop stack))
                              (b (pop stack)))
                            (push a stack)
                            (push b stack))))
      (list 'inc   '(1 +))
      ))

(defmacro aif (test then &optional else)
    `(let ((it ,test))
         (if it
             ,then
             ,else)))

(defun find-word-in-dictionary (word-symbol dictionary)
    (loop for w in dictionary
          do (when (equal word-symbol
                          (forth-word-name w))
                 (return w))))

(defun find-word-definition-in-dictionary (word-symbol dictionary)
    (aif (find-word-in-dictionary word-symbol dictionary)
         (forth-word-definition it)))


(defun eval-forth-word (word-symbol stack dictionary)
    (block nil
        (aif (find-word-definition-in-dictionary word-symbol dictionary)
             (cond
               ((functionp it)
                (return (funcall it stack)))
               ((listp it)
                (eval-forth-program it
                                    stack
                                    *dictionary*
                                    'eval)))
             (error "Ошибка. Неизвестное слово: ~A" word-symbol))))

(defun define-word (program stack dictionary state definition)
    (let ((current-word (first program)))
        (if (eql current-word 'end-define)
            (eval-forth-program (rest program)
                             stack
                             (cons dictionary (list-to-word (nreverse definition)))
                             state)
            (define-word
                (rest program)
                stack
                dictionary
                state
                (cons current-word definition)))))

(defun eval-forth-program (program &optional (stack nil) (dictionary *dictionary*) (state 'eval))
;    (print stack)
    (let ((current-word (first program)))
        (case state
          ((eval)
           (cond
             ((null program)
              (return-from eval-forth-program stack))
             
             ((eql current-word 'define)
              (define-word
                  (rest program)
                  stack
                  dictionary
                  state
                  nil))

             ((eql current-word 'if)
              (if (not (zerop (first stack)))
                  (eval-forth-program (rest program)
                                      (rest stack)
                                      dictionary
                                      'then-eval)
                  (eval-forth-program (rest program)
                                      (rest stack)
                                      dictionary
                                      'then-skip)
                  ))
             
             ((numberp current-word)
              (eval-forth-program (rest program)
                                  (cons current-word stack)
                                  dictionary
                                  'eval))
             
             ((symbolp current-word)
              (eval-forth-program (rest program)
                                  (eval-forth-word current-word stack dictionary)
                                  dictionary
                                  'eval))))
          ((then-eval) ; АХТУНГ Функция слишком большая. Оператор ветвления не поддерживает вложенности. И вообще я ничего ещё не дописал.
           (cond
             ((null program)
              (return-from eval-forth-program stack))
             
             ((eql current-word 'define)
              (eval-forth-program (rest program)
                                  stack
                                  dictionary
                                  'defining))

             ((eql current-word 'if)
              (if (not (zerop (first stack)))
                  (eval-forth-program (rest program)
                                      (rest stack)
                                      dictionary
                                      'then-eval)
                  (eval-forth-program (rest program)
                                      (rest stack)
                                      dictionary
                                      'then-skip)
                  ))
             
             ((numberp current-word)
              (eval-forth-program (rest program)
                                  (cons current-word stack)
                                  dictionary
                                  'eval))
             
             ((symbolp current-word)
              (eval-forth-program (rest program)
                                  (eval-forth-word current-word stack dictionary)
                                  dictionary
                                  'eval))))

          )))

Как мне реализовать оператор ветвления так, чтобы он поддерживал вложенность. На данный момент я использую конечный автомат, а он не позволяет реализовать вложенное ветвление. Вопрос адресую в первую очередь VoidVolker

И ещё, не подскажите ли, как разбить код на функции? А то функция eval-forth-program слишком большая и сложная.
Заранее спасибо!

Answer 1

[VoidVolker]

Как мне реализовать оператор ветвления так, чтобы он поддерживал вложенность.

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

И ещё, не подскажите ли, как разбить код на функции? А то функция eval-forth-program слишком большая и сложная.

Традиционно форт реализуется с использованием т.н. шитого кода. Так же есть и вариации шитого кода и другие механизмы. В целом логика такая: есть список - это словарь слов. Логика интерпретатора крайне проста:

1. Получить следующий символ из входного потока
   
2. Если ноль или конец строки - выход
   
3. Если не разделитель - перейти к следующему символу
   
4. Если разделитель - искать слово в словаре
   
5. Если слово найдено - выполнить его
   
6. Не найдено - сообщить об ошибке
   

Далее, организовываем два стека - основной, возврата, переменную STATE (интепретация/компиляция), основной словарь или список словарей, минимальный набор слов для компиляции - двоеточие, точка с запятой и далее по мере надобности все остальное. Главное запустить интерпретатор, от него компилятор, а далее уже можно средствами самого форта реализовать остальной минимальный набор слов, затем учим форт компилировать и собирать самого себя и получаем самодостаточную систему. Рекомендую книги Лео Броуди к прочтению и регистрацию на форт-форуме - там тоже очень много материалов по теме реализации форта )

Comments

[Filipp42]

Спасибо!

Answer 2

[pharo]

Может пригодится такие проекты с Github.
forth in lisp

P.S. В выдаче и Forth на Lisp, и Lisp на Forth. :)

Zillions of Games
(базовый язык программы Lisp,
но есть и расширение Game: Axiom Development Kit на Форт языке)