Давайте попробуем написать на Лиспе… транслятор простого императивного языка. Нет-нет, я не ошибся – именно транслятор. Транслировать он будет в Лисп-код. А дальше этот код может быть выполнен Лисп-системой.

Здесь бесценную услугу нам окажет то обстоятельство, что в Лиспе нет барьера между кодом и данными (это редкое свойство некоторых языков программирования называется “гомоиконность”). Но и изобразительные возможности Лиспа тоже сыграют не последнюю роль.

В качестве реализации я буду использовать HomeLisp. Желающие смогут адаптировать этот проект под Common Lisp. Скажу сразу – применительно к рассматриваемой задаче существенная разница между Common Lisp и HomeLisp состоит только в обработке строк и файлов.

Скачать портабельную версию HomeLisp можно по ссылке. На этом же сайте расположена и документация. Желающие могут копировать код из статьи и сразу проверять работоспособность.

Предлагаемая вашему вниманию тема послужила основой для моей мастерской на знаменитой Новосибирской ЛШЮП-2018. С результатами мастерской можно ознакомиться здесь. А далее я излагаю свой подход. Предполагаю, что читатель знаком с языком Лисп.

Приступаем

Начнем с “простого императивного языка”, который мы будем транслировать в Лисп.
Язык будет обрабатывать только числовые данные. Код на этом языке состоит из функций (процедур, возвращающих значения). Среди этих функций одна должна называться main. Именно с этой функции начинается выполнение кода. Хотя зачем так себя связывать? Пишем функции на императивном языке, они транслируются в Лисп и могут использоваться вместе с лисповскими функциями. Но не будем забегать вперед...

Набор операторов языка обычен: присвоение, ветвление, арифметический цикл, досрочный выход из цикла, ввод, вывод и вызов функции. Впрочем, синтаксически вызов функции оформляется как присвоение (результата вызова). Комментарии пусть содержат звездочку в первой позиции строки. Язык, разумеется, должен обеспечивать возможность создания рекурсивных функций. Чтобы стало понятнее, приведу примеры кода – печать последовательных нечетных чисел и вычисление их суммы:

proc main()
  local s,n,k
  input n
  for i=1 to n
      k=2*i-1
      print k
      s=s+k
  end_for
  print s  
end_proc

По своему духу – это бэйсик-подобный язык. Я буду называть его “мини-бэйсик”. Наш транслятор должен преобразовать приведенный код в следующую Лисп-функцию:

(defun main nil
   (let ((s 0) (n 0) (k 0))
     (setq n (read))
     (iter (for i from 1 to n)
       (setq k (- (* 2 i) 1))
       (printline k)
       (setq s (+ s k)))
   (printline s)))

Мне очень нравится пакет iterate, который в профессиональных пакетах Common Lisp реализован в виде макро. В HomeLisp функция iter (реализующая значительную часть возможностей макро iterate) включена в ядро языка. Мое пристрастие к iter и послужило причиной того, что циклы нашего “мини-бэйсика” будут транслироваться в вызовы iter.

С чего начать реализацию? Давайте начнем ее с выбора файла, подлежащего трансляции и с построчного чтения и печати этого файла. Запускать транслятор нам придется множество раз, так пусть этот запуск с самого начала будет удобным. Вот как может выглядеть эта функция:

(defun start (&optional (fname nil))
   (setq *numline* 0)
   (setq *flagerr* nil)
   (when (null fname)
         (setq fname (sysGetOpenName (sysHome) "Мини-бэйсик|*.mbs")))
   (let ((fi (gensym 'fi)))
        (when fname          
          (filOpen fi fname _INPUT)
          (loop
              (getLine fi) 
              (when (or *flagerr* (filEOF fi)) (return t)))
          (filClose fi)
          (when *flagerr* (printsline "**** Были найдены ошибки"))))
   (unset '*numline*)
   (unset '*flagerr*))

Функция имеет необязательный параметр fname – имя файла, содержимое которого будет транслироваться. При входе в функцию создаются две глобальные переменные numLine номер строки исходного файла и flagerr — флаг состояния ошибки. Перед завершением функции эти переменные уничтожаются (функция HomeLisp-а unset уничтожает глобальные переменные).

Если имя входного файла опущено – то вызывается стандартный windows-диалог выбора файла (sysGetOpenName). В качестве стартовой директории используется текущая директория (sysHome). Далее создается уникальный символ для файлового манипулятора и файл открывается для текстового чтения. Затем в бесконечном цикле производится чтение файла строка за строкой (функция getLine). После каждой операции проверятся, не возникла ли ошибка, и не достигнут ли конец файла. Если возникла ошибка или зафиксирован конец файла – цикл разрывается, файл закрывается, и, если были ошибки – выводится итоговое сообщение.
Собственно чтение из файла выполняет функция getLine:

(defun getLine (fil)
  (let ((stri ""))
    (loop
      (when (filEof fil) (return ""))
      (setq *numline* (add1 *numline*)) 
      (setq stri (filGetline fil))
      (printsline (strCat (format *numline* "0000") " " 
                  (strRTrim stri)))
      (setq stri (strATrim stri)) 
      (unless (or (eq "" stri) (eq "*" (strLeft stri 1))) 
      (return stri)))))

Эта функция принимает идентификатор открытого файла и в бесконечном цикле выполняет следующие действия:

• проверяет состояние “конец файла”. В этом случае цикл разрывается и функция возвращает пустую строку;
• увеличивается на единицу счетчик прочитанных строк;
• читается очередная строка файла;
• прочитанная строка печатается с удалением возможных пробелов справа;
• если прочитанная строка непуста и не содержит звездочку в первой позиции, то она
  возвращается из функции;

Таким образом, в выходной листинг попадают все строки файла в их исходном виде.

Разбиваем на процедуры

А теперь давайте научим наш код разбивать входной поток на отдельные процедуры. Сначала введенную строку потребуется разбить на лексемы (неделимые входные лексические единицы). Этот процесс называется парсингом; нам предстоит создать парсер. Написание парсеров — классическая тема, существуют библиотеки готовых парсеров и специальные средства, позволяющие сгенерировать нужный парсер… Мы пойдем своим путем.

Прежде, чем описывать алгоритм парсера, обратим внимание на то, что все символы входной строки можно поделить на два класса:

• Обычные символы;
• Символы-разделители.

Так, в операторе присвоения “x = 15 + y^2” символы x,1,5,y и 2 – есть обычные символы, а символы “пробел”, +,^ — разделители. Чем обычный символ отличается от разделителя? Разделитель – всегда отделяет одну лексему от другой. Наш оператор присвоения, будучи разбит на лексемы, выглядит так: “x”, “=”, ”15”, “y”, “^”, “2”.

Как можно заметить, не все разделители попадают в результат парсинга (пробелы, в частности, не попадают). Будем называть разделители, которые не попадают в результат, разделителями первого типа. Остальные разделители будут называться разделителями второго типа.

Входом парсера будет строка, выходом – список строковых лексем. В качестве накопителя будет использоваться локальная переменная – аккумулятор. Первоначально аккумулятор содержит пустую строку.

Алгоритм парсинга может быть таким: читаем символ за символом входную строку. Если встретился обычный символ, конкатенируем его с аккумулятором. Если встречается разделитель, то:

• Для разделителя первого типа сбрасываем значение аккумулятора (если он непуст) в выходной список, очищаем аккумулятор и переходим к чтению следующего символа;
• Для разделителя второго типа также сбрасываем в выходной список значение непустого аккумулятора, а вслед за ним заносим в выходной список принятый разделитель второго типа (как самостоятельную лексему), очищаем аккумулятор и переходим к чтению следующего символа.

Вот код парсера:

(defun parser (txt &optional (d1 " ,") (d2 "()+-*/\^=<>%"))
  (let ((res nil)
        (lex "") )
   (iter (for s in-string (strCat txt (strLeft d1 1)))
     (cond ((plusp (strInd d1 s))
            (when (> (strLen lex) 0) (collecting lex into res))
                  (setq lex ""))
           ((plusp (strInd d2 s)) 
            (when (> (strLen lex) 0) (collecting lex into res))
                  (collecting s into res)  
                  (setq lex ""))
           (t (setq lex (strCat lex s))))) res))

У функции кроме обязательного параметра имеется два необязательных: d1 содержит строку, каждый символ которой есть разделитель первого типа, а строка d2 содержит разделители второго типа.

Программная логика функции parser описана выше. Следует только отметить, что перед началом работы к концу входной строки присоединяется разделитель. Это сделано для того, чтобы последняя обработанная лексема на “зависла” в аккумуляторе (роль аккумулятора играет локальная переменная lex).

Проверим наш парсер “в деле”:

(parser "x = 15 + y^2")
==> ("x" "=" "15" "+" "y" "^" "2")

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

(defun mk-intf (txt)
  (let ((lex (parser txt " ," "()+-*/\^=<>%"))
        (intf ""))
   (iter (for a in lex) (setq intf (strCat intf a " ")))
   (input (strCat "(" intf ")"))))

Теперь, если подать на вход функции mk-intf наш оператор присвоения, то получим:

(mk-intf "x = 15 + y^2")
==> (X = 15 + Y ^ 2)

Что, согласитесь, гораздо приятнее.

Теперь немного изменим функцию start: эта функция должна будет читать и обрабатывать целые процедуры:

(defun start (&optional (fname nil))
   (setq *numline* 0)
   (setq *flagerr* nil)
   (when (null fname)
         (setq fname (sysGetOpenName (sysHome) "Мини-бэйсик|*.mbs")))
   (when fname      
      (let ((fi (gensym 'fi)))
           (filOpen fi fname _INPUT)
           (loop
               (let ((curr-proc (action-proc fi)))
                    (when (or *flagerr* (filEOF fi)) (return t))
                    (eval curr-proc)))
           (filClose fi))
           (when *flagerr* (printsline "**** Были найдены ошибки")))
   (unset '*numline*)
   (unset '*flagerr*))

В теле цикла вызывается функция action-proc (обработать процедуру), которая будет формировать тело принятой процедуры уже на Лиспе. Тело процедуры, сохраненное как S-выражение в переменной curr-proc, передается затем на вход eval. И принятая функция “реинкарнируется” в среде Лисп!

Что должна делать action-proc? Эта функция получает в качестве параметра идентификатор открытого файла. Функция читает из файла строку за строкой, пропускает пустые строки и комментарии, остальные строки парсит, переводит в форму списка, и генерирует тело процедуры.

Мы будем постепенно “учить” action-proc генерации. И начнем с того, что научим нашу функцию распознавать начало и конец процедуры. В мини-бэйсике начало процедуры имеет вид:

proc name(p1,p2,p3)

попробуем распарсить такую строку:

(mk-intf "proc name(p1,p2,p3)")
==> (PROC NAME (P1 P2 P3))

Как же должна реагировать на этот ввод функция action-proc? Вполне естественно: убедившись, что голова списка есть атом PROC, нужно взять второй элемент списка как имя функции, а третий элемент – как список параметров. Имя и список параметров следует сохранить в локальных переменных. Когда же прочитывается оператор end_proc, то нужно из имени функции и списка параметров сформировать форму defun с пустым (пока) телом, и вернуть эту форму как результат. Вот как это выглядит:

(defun action-proc (fi)
   (let ((stmt nil)
         (proc-name nil)
         (proc-parm nil))
    (loop
         (setq stmt (mk-intf (getLine fi))) 
         (when (null stmt) (return t))
         (cond ((eq (car stmt) 'proc) 
                    (setq proc-name (nth 1 stmt))
                    (setq proc-parm (nth 2 stmt)))                    
               ((eq (car stmt) 'end_proc) (return t))
               (t (printsline (strCat "**** Оператор " 
                              (output stmt) 
                              " не распознан")) 
                  (setq *flagerr* t))))
    `(defun ,proc-name ,proc-parm (quote OK))))

Для окончательного формирования предложения defun используется обратная блокировка. Обратите внимание на то, что в качестве результата сгенерированная процедура будет выдавать атом OK.

Теперь мы можем проверить наш код в действии. Занесем в файл 0000.mbs следующий код:

proc f1(x,y)
end_proc 
proc f2(x)
end_proc

Запустим процедуру start, выберем 0000.mbs и увидим на консоли:

0001 proc f1(x,y)
0002 end_proc
0003 proc f2(x)
0004 end_proc

При желании можно убедиться, что Лисп-машине теперь доступны две (пока бесполезные) функции f1 и f2:

(getd 'f1)
==> (EXPR (X Y) (QUOTE OK))
(getd 'f2)
==> (EXPR (X) (QUOTE OK))

Более того! Их уже можно и запустить:

(f1 1 2)
==> OK
(f2 2)
==> OK

Наш транслятор сделал первый вдох…

Ввод, вывод и локальные переменные

А сейчас самое время научить наш новорожденный транслятор обрабатывать операторы input, print и local.

Проще всего обработаем ввод и печать. Оба оператора имеют одинаковую синтаксическую структуру: ключевое слово и переменная. Оператор input x должен превратиться в такую Лисп-форму (setq x (read)). Соответственно, оператор print x превращается в форму (printline x). Для хранения этих форм необходимо в функции action-proc предусмотреть локальную переменную body. В этой переменной будут накапливаться формы, осуществляющие вычисления будущей функции. Дальше все довольно просто:

(defun action-proc (fi)
   (let ((stmt nil)
         (proc-name nil)
         (proc-parm nil)
         (loc-var nil)
         (body nil))
    (loop
         (setq stmt (mk-intf (getLine fi))) 
         (when (null stmt) (return t))
         (cond ((eq (car stmt) 'proc) 
                    (setq proc-name (nth 1 stmt))
                    (setq proc-parm (nth 2 stmt)))                    
               ((eq (car stmt) 'end_proc) (return t))
               ((eq (car stmt) 'print) 
                    (setq body (append body 
                               (list (cons 'printline (cdr stmt))))))
               ((eq (car stmt) 'input) 
                    (setq body (append body 
                      (list (list 'setq (cadr stmt) (list 'read) )))))
               (t (printsline (strCat "**** Оператор " 
                              (output stmt) 
                              " не распознан"))
                              (setq *flagerr* t))))
    `(defun ,proc-name ,proc-parm ,@body)))

Давайте теперь подготовим вот такой исходник на мини-бэйсике:

proc f1(x,y)
 print x
 print y
end_proc 
proc f2(x)
 input x
 print x
end_proc

и попробуем его протранслировать… У нас появятся две лисповские функции f1 и f2. Посмотрим на их определяющие выражения и убедимся, что они сгенерированы верно:

(getd 'f1)
==> (EXPR (X Y) (PRINTLINE X) (PRINTLINE Y))
(getd 'f2)
==> (EXPR (X) (SETQ X (READ)) (PRINTLINE X))

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

Оператор local может находиться в любом месте процедуры и встречаться более одного раза. Если в процессе обработки процедуры встретился оператор local, то необходимо взять список переменных и сохранить его в локальной переменной. После встречи оператора end_proc необходимо сгенерировать форму let и “заключить в нее” все выполняемые операторы (пока – только input и print). Вот как теперь будет выглядеть action-proc:

(defun action-proc (fi)
   (let ((stmt nil)
         (proc-name nil)
         (proc-parm nil)
         (loc-var   nil)
         (lv        nil)
         (body      nil))
    (loop
         (setq stmt (mk-intf (getLine fi))) 
         (when (null stmt) (return t))
         (cond ((eq (car stmt) 'proc) 
                    (setq proc-name (nth 1 stmt))
                    (setq proc-parm (nth 2 stmt)))                    
               ((eq (car stmt) 'end_proc) (return t))
               ((eq (car stmt) 'print) 
                    (setq body (append body 
                               (list (cons 'printline (cdr stmt))))))
               ((eq (car stmt) 'input) 
                    (setq body (append body 
                               (list (list 'setq (cadr stmt) 
                                     (list 'read) )))))
               ((eq (car stmt) 'local) 
                    (setq loc-var (append loc-var (cdr stmt))))
               (t (printsline (strCat "**** Оператор " 
                              (output stmt) " не распознан")) 
                              (setq *flagerr* t))))
    (iter (for a in (setof loc-var)) (collecting (list a 0) into lv))           
    `(defun ,proc-name ,proc-parm (let ,lv ,@body))))

Список локальных переменных накапливается в переменной loc-var. После завершения обработки процедуры из этого списка строится список пар вида (имя 0). При этом нежелательно повторение одинаковых имен… Как его предотвратить? Конечно, можно на каждой обработке оператора local проверять, нет ли повторения имен (если есть – выдавать сообщение об ошибке). Но, мне кажется, лучше просто устранить повторения, что и делает вызов setof. Теперь давайте протранслируем и запустим вот эту программу:

proc f1(x,y)
 local a,b,c
 print x
 print y
 input a
 print a
end_proc

Убеждаемся, что она работает именно так, как и предполагает алгоритм. Но все самое интересное впереди!

Отсюда можно скачать окончательный вариант того, что мы с вами нашкодили...

Продолжение следует!