Создание расширенной версии оператора case с помощью макросов Lisp

Доброго времени суток, случайные и не случайные читатели.

Сегодня хочу рассказать о модификации конструкции case в Scheme для того, чтобы она использовала переданный пользователем предикат для сравнения. Решение основано на макросах... но обо всём по-порядку.

Описание работы case

Во-первых, как работает case ? Несложно догадаться, case является одной из управляющих конструкций, которые выполняют работу по принятию решений (англ. case analysis), выбирая "путь", по которому должна пойти программа, в зависимости от переданного им выражения.

В общем виде, синтаксис case выглядит так:

case ключевое-выражение условие-1 условие-2 ...

Каждое из условий должно содержать список из одного или нескольких элементов данных, за которым должно быть одно или несколько выражений для исполнения:

(case ключевое-выражение
  ((элемент-данных ...) выражение-1 выражение-2 ...)
  ...)

Используя специальный оператор =>, можно вызвать выражение (процедуру) в условии со значением ключевого выражения:

(case ключевое-выражение
  ((элемент-данных ...) => выражение))

В этом случае, значение ключевого выражения будет передано в выражение в качестве параметра:

((lambda (параметр)
   ...)
 значение-ключевого-выражения)

Так же case позволяет использовать else в конце списка условий, для случаев, когда ни одно из условий не было удовлетворено:

(else выражение-1 выражение-2 ...)

Конструкция с => также допустима:

(else => выражение)

Пример использования case:

(case (+ 2 3)
  ((5)
   (display "Привет мир!")
   (newline))
  (else
   (display "С миром что-то пошло не так.")
   (newline)))

Как всё это работает? Сначала case вычисляет первый аргумент (выражение; в данном случае, (+ 2 3)), после этого сравнивает полученный результат с каждым условием. Условие состоит из списка значений для сравнения и выражения (последовательности выражений) к выполнению при совпадении результата с одним из элементов данных. Сравнение производится через предикат eqv?.

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

(case (+ 2 3)
  ((5)
   (display "Привет мир!")
   (newline))
  (else
   (display "С миром что-то пошло не так.")
   (newline)))
-| Привет мир!

Как и ожидалось, выводится строка "Привет мир!". Но что делать, если нам нужно сравнить результат вычисления ключевого выражения со, скажем, списоком строк? Попробуем это сделать обычным case.

Использование case для перебора строк

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

(case *цвет*
  (("оранжевый")
   (display "апельсин")
   (newline))
  (("красный" "зелёный")
   (display "яблоко")
   (newline))
  (else
   (display "банан")
   (newline)))

Разумеется, компьютеры (пока) не умеют удивляться, когда им подсовывают для исполнения подобный код, однако в остальном мы уловили суть. Переменная *цвет* может быть задана до выполнения case следующим образом:

(define *цвет* "оранжевый")

Но возникает проблема -- мы всегда получаем "банан", поскольку предикат eqv? возвращает "неожиданный" результат:

(eqv? "яблоко" "яблоко")
=> #f

Что же это? Результатом булева выражения оказалась "ложь" (#f), несмотря на то, что с нашей точки зрения строки идентичны! Посмотрим, в чём дело.

С точки зрения реального мира подобный ответ корректен, так как переданные eqv? яблоки (то есть, строки) являются разными объектами (хранятся в разных областях памяти), хотя и выглядят одинаково. В реальном мире два яблока, как бы они не были внешне похожи, являются разными объектами.

Если же мы объявим переменную, в которую сохраним яблоко (то есть, строку "яблоко", конечно же), и объявим ещё одну переменную, присвоив ей значение первой переменной, то при сравнении этих переменных мы получим истину (#t):

(define *фрукт1* "яблоко")
(define *фрукт2* *фрукт1*)
(eqv? *фрукт1* *фрукт2*)
=> #t

Та-да! Эти переменные равны, так как ссылаются на один и тот же фрукт (одну и ту же область памяти, которая хранит строку "яблоко").

Поиск правильного инструмента сравнения

Очевидно, что eqv? не подходит в данном случае для сравнения строк, поскольку по мнению eqv? две строки различаются, если являются разными объектами, даже если они состоят из одинакового набора символов. Мы должны использовать правильный способ сравнения объектов, чтобы получить желаемый результат. В данном случае, строки должны сравниваться лексикографическим способом, тогда две строки одинаковой длины, с одинаковым набором символов, расположенных в одинаковом порядке, будут идентичны. Это может сделать предикат string=?:

(string=? "яблоко" "яблоко")
=> #t

Как раз то, что нужно. Осталось научить case использовать string=? для сравнения. Это можно сделать, добавив в язык программирования новую конструкцию -- назовём её case-pred. Сложно, разве нет? Оказывается, что не так уж и сложно, когда знаешь лисповые макросы.

Пишем код, который пишет код, который пишет код, который ...

Для реализации case-pred можно использовать другую управляющую конструкцию, cond. То есть, мы объявим наш case-pred таким образом, что после развёртки макроса он будет превращаться в корректную конструкцию cond, которая и будет выполнять всю работу.

Конструкция cond, так же, как и case, состоит из набора условий, но не привязана к конкретному ключевому выражению. В общем виде синтаксис выглядит так:

cond условие-1 условие-2 ...

где каждое из условий представляет собой:

(тест выражение-1 выражение-2 ...)

Выражения вычисляются тогда, когда тест возвращает не-ложь (не #f). Наш "фруктовый" пример кода, переписанный вручную с использованием cond:

(cond
  ((string=? *цвет* "оранжевый")
   (display "апельсин")
   (newline))
  ((or (string=? *цвет* "красный")
       (string=? *цвет* "зелёный"))
   (display "яблоко")
   (newline))
  (else
   (display "банан")
   (newline)))

Теперь осталось написать код, который будет писать код, который будет делать то, что нам нужно.

Что мы хотим получить в итоге, так это макрос case-pred, который принимает первым аргументом предикат, который используется для сравнения результата ключевого выражения со списком условий. В остальном, макрос должен работать так же, как и обычный case.

Макросы во всей красе

Наш первый вариант макроса case-pred использует классический лисповый макрос, объявляемый через define-macro:

(define-macro (case-pred pred key . clauses)
  `(cond
    ,@(map
       (lambda (clause)
         (let ((datum (car clause))
               (exp   (cadr clause)))
           (cond
            ((and (not (list? datum)) (not (eq? datum 'else)))
             (error "Syntax error: expected a list" datum))
            ((eq? datum 'else)
             `(else ,exp))
            ((= (length datum) 1)
             `((,pred ,key ,(car datum)) ,exp))
            (else
             `((or ,@(map (lambda (o) `(,pred ,key ,o))
                          datum)) ,exp)))))
       clauses)))

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

`(cond ,@(map ...)) как раз возвращает нужный список. Как можно прочитать в документации, оператор quasiquote, в краткой форме обозначаемый знаком грависа ("`"), позволяет создать цитированный (англ. quoted) список, части которого могут быть вычислены. Те части, которые должны быть вычислены, помечаются с помощью операторов unquote (в краткой форме -- ",") и unquote-splicing (в краткой форме -- ",@"). unquote вычисляет выражение и вставляет результат в список. unquote-splicing также вычисляет выражение, но подставляет в список элементы того списка, который был получен в результате вычисления "разкавыченного" выражения. Таким образом, ,@(map ...) возвращает список, элементы которого подставляются в другой список -- как тело cond.

Данный макрос не лишён недостатков -- к примеру, не описан оператор =>. Однако в остальном данная версия case-pred работает неплохо.

Но можем ли мы сделать эту запись короче и яснее? Ответ -- можем, используя define-syntax:

(define-syntax case-pred
  (syntax-rules (else)
    ((_ pred key ((datum ...) exp) ...)
     (cond
      ((or (pred key datum) ...) exp) ...))
    ((_ pred key ((datum ...) exp) ... (else else-exp))
     (cond
      ((or (pred key datum) ...) exp) ...
      (else else-exp)))))

В этой версии используется стиль макросов, предоставляемый GNU Guile. syntax-rules создаёт преобразователь синтаксиса, основанный на сопоставлении выражения с шаблоном, и переписывании данного выражения согласно шаблону преобразования.

К примеру, шаблон

    ((_ pred key ((datum ...) exp) ...)
     (cond
      ((or (pred key datum) ...) exp) ...))

совпадает с выражением следующего вида:

(case-pred string=? *цвет*
  (("оранжевый")
   (display "апельсин")
   (newline)))  

А шаблон

    ((_ pred key ((datum ...) exp) ... (else else-exp))
     (cond
      ((or (pred key datum) ...) exp) ...
      (else else-exp)))))

совпадает с

(case-pred string=? *цвет*
  (("оранжевый")
   (display "апельсин")
   (newline))
  (else
   (display "банан")
   (newline)))

где используется ключевое слово else. После того, как "разворачиватель" синтаксиса натыкается на использование нашего макроса в коде, он начинает смотреть -- а с каким шаблоном совпадает данный вызов макроса? Как только подходящий шаблон найден, он разворачивается согласно шаблону преобразования.

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

(case-pred string=? *цвет*
  (("оранжевый")
   (display "апельсин")
   (newline))
  (("красный" "зелёный")
   (display "яблоко")
   (newline))
  (else
   (display "банан")
   (newline)))

После развёртки макроса мы получим примерно следующий код (который мы уже видели ранее):

(cond
  ((string=? *цвет* "оранжевый")
   (display "апельсин")
   (newline))
  ((or (string=? *цвет* "красный")
       (string=? *цвет* "зелёный"))
   (display "яблоко")
   (newline))
  (else
   (display "банан")
   (newline)))

Думаю, данная версия макроса в дальнейшем будет претерпевать изменения -- к примеру, можно добавить поддержку => выражений. Но это уже другая история.

- Артём

Guile-SSH

Доброго времени суток, случайные и не случайные читатели этого блога.

Занимаюсь сейчас разработкой библиотеки Guile-SSH, которая призвана обеспечить возможность работы с протоколом SSH из программ, написанных на языке Scheme (с использованием интерпретатора GNU Guile).

Презентация по проекту: odp pdf (CC-BY-SA 3.0)

Guile-SSH является обёрткой над libssh и находится на начальной стадии разработки. На данный момент библиотека предоставляет API для создания простого SSH-клиента (пример клиента можно посмотреть здесь). API для создания SSH-сервера планируется.

Для сборки текущей версии библиотеки вам нужны GNU Guile 1.8 и libssh 0.5.3 или новее. Инструкции по сборке и установке можно найти здесь. Последняя версия Guile-SSH на данный момент -- 0.2, но если надумаете собирать, то лучше берите последний коммит с master'а. Код относительно стабилен (по крайней мере, стараюсь ничего не ломать в коммитах).

- Артём

Макрос define-method* для использования ключевых слов совместно с GOOPS

Сегодня загрузил в репозиторий LazyCat коммит, который добавляет макрос, расширяющий стандартный набор функций GOOPS для создания методов. Макрос используется для реализации метода host-list-add-host в классе <host-list> и позволяет использовать ключевые слова (англ. keywords) для задания аргументов, передаваемых в метод. То есть, вместо создания методов с большим количеством параметров, или выдёргивания аргументов из списка по индексу, можно просто указывать каждый из аргументов по ключевому слову.

Текущая версия макроса выглядит так:

;; Needed modules
(use-modules (ice-9 optargs)
             (ice-9 syncase)
             (oop goops))

;; Macro definition
(define-syntax define-method*
  (syntax-rules ()
    ((_ (m (o <class>) (var defval) ...) body ...)
     (define-method (m (o <class>) . args)
       (let-keywords args #t ((var defval) ...)
                     body ...)))))

Пример использования макроса:

(define-class <talking-machine> ())

(define-method* (hey (obj <talking-machine>)
                     (say  "Hello, ") 
                     (name "J. Random Programmer"))
  (display (string-append say name "!\n")))

(define talking-machine (make <talking-machine>))

Результат вызова метода hey с разными аргументами:

(hey talking-machine)
=> Hello, J. Random Programmer!

(hey talking-machine #:say "Goodbye, ")
=> Goodbye, J. Random Programmer!

(hey talking-machine #:name "John Doe")
=> Hello, John Doe!

Данный макрос написан в процессе изучения макросов в GNU Guile -- может быть, данную задачу можно решить гораздо более простым и элегантным способом?

- Артём

Удаление элемента списка в Scheme

Доброго времени суток, случайные и неслучайные читатели этого блога.

Сейчас довольно много пишу на Scheme, в связи с работой над проектом LazyCat. В проекте используется Scheme для GUI и для высокоуровневой логики. Подробнее о проекте на русском языке можно узнать здесь. В данной же заметке я хочу рассказать о проблеме удаления элемента из списка.

Если вы сталкивались с Lisp'ом в жизни (например, настраивая GNU Emacs), то должны знать, что список является едва ли не основным представлением как данных, так и собственно программы, их обрабатывающей. Даже название языка -- Lisp -- произошло от "List Processing", т.е. "обработка списков". Scheme, как диалект Lisp, не представляет исключение в этом плане. И работая с Scheme, вы постоянно работаете со списками.

Так вот, в LazyCat список управляемых хостов хранится, как Lisp-список. Пример:

 
'((#f host1 host2) ("ssh-hosts" host2 host4))

В данном примере есть две группы:

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

В каждой группе -- по два хоста. Первый элемент группы -- который можно получить через операцию car -- имя группы.

(car '("ssh-hosts" host2 host4)) => "ssh-hosts"

Оставшаяся часть списка -- получаемая через cdr -- это члены группы.

(cdr '("ssh-hosts" host2 host4)) => '(host2 host4)

При работе с этим списком требуется добавлять и удалять его элементы. С добавлением нового элемента в список проблем нет, а вот удаление элемента из списка представляет собой не вполне тривиальную задачу. По крайней мере, я не нашёл простого спосба сделать это. Что и привело к созданию собственного "велосипеда" для выполнения этой операции.

Итак, нужно удалить хост из группы. Если подумать, то можно найти предельно простое по идее, но не такое простое в реализации решение (как раз тот самый "велосипед"). Идея заключается в том, что хост можно "вырезать" из списка путём следующих действий:

1. Нужно взять часть списка, чей car -- элемент, который необходимо удалить. Эту часть можно найти путём простого перебора элементов.
2. После этого нужно получить cdr списка.
3. Склеить с помощью операции append две части списка -- часть списка до текущего car и часть списка, получаемая по cdr относительно текущей части с удаляемым элементом в car.

На практике же это превратилось в довольно громоздкую конструкцию:

 

(let ((new-cdr '())) 
  (let f ((group-members (cdr group)))

    ;; Are there elements in the given list?
    (if (not (null? group-members))

        (if (eq? (car group-members) host)

             ;; We found the host which should be removed from the list.
             ;; Cut out the car of the list and concatenate two lists
             (set-cdr! group (append new-cdr (cdr group-members)))

             ;; Host is not found. Check the next group member.
             (begin 
               ;; Add the current car to the new cdr of the group
               (new-cdr (append new-cdr (car group-members))) 
               ;; Try the next group member 
               (f (cdr group-members)))))))

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

В целом, этот код выглядит не слишком хорошо. Но, насколько помню, он свою задачу выполнял. Тем не менее, я был уверен, что есть более простые и элегантные способы работы со списками. И в конце-концов ответ был найден.

Благодаря использованию модуля (ice-9 common-list) вышеприведённый кусок кода был заменён на следующую строчку:

 

(set-cdr! group (remove-if (lambda (element) (eq? element host)) 
                           (cdr group)))

Функция remove-if применяет предикат (фукнцию, возвращающую #t (true) или #f (false)) переданный, как первый параметр, ко всем элементам списка (второй параметр функции). Если предикат возвращает #t -- то элемент удаляется из списка. По завершению remove-if возвращает список, из которого удалены требуемые элементы.

В представленном выше примере remove-if сравнивает два объекта -- элемент списка и хост. Если элемент списка и хост -- один и тот же объект, то он удаляется из списка. После этого происходит замена cdr группы новым списком хостов.

Пример использования remove-if взят из файла host-list.scm, являющегося частью LazyCat.

- Артём