LINUX.ORG.RU

[lisp][sql]немного похвастаюсь


0

1
BUDDEN> (let1 *firebird-trace* t 
               (fse user_group.* from user_group M_INNER_JOIN(user_group,app_user);
                    ))
select  user_group.* from user_group  inner join   app_user as app_user  on app_user.Id = user_group.REF_USER 
NIL
#("REF_USER" "REF_GROUP" "RANK")

> (float (/ (length "user_group.* from user_group  inner join   app_user as app_user  on app_user.Id = user_group.REF_USER")
                       (length "user_group.* from user_group M_INNER_JOIN(user_group,app_user);")))
1.6031746031746033

Общая идея: M_INNER_JOIN берёт из словаря данные о ссылках между таблицами и строит соответствующий фрагмент inner join. Про fse я уже писал раньше - это symbol-readmacro (в отличие от обычно используемого в лиспе readmacro-character), который читает лексемы SQL (в данном случае файрбёрда, а другие мне пока не нужны) до точки с запятой и выполняет считанное. В данном примере код ужался в 1.6 раза. Эту штуку я недавно написал, ещё не уверен в её совершенстве, но, видимо, буду пользоваться ежедневно и интенсивно. Давно замышлял такое сделать.

Вот исходники:

(def-firebird-macro-1 M_INNER_JOIN (from to &optional to-alias)
  "to может быть именем таблицы или ref_alias-ом"
  (proga
    (let from-src (expand-m-alias from))
    (multiple-value-bind (fld dst dst-alias) (find-field-ref from-src to))
    (assert fld () "M_INNER_JOIN: can't find reference ~A in (~A as ~A)" to from-src from)
    (let dst-alias-2 (or to-alias dst-alias dst)) 
    (let dst-alias-introduction 
      (if (db-identifier-equal dst dst-alias) dst (fbody M_AS(~~dst,~~dst-alias-2)^)))
    (fbody inner join ~~dst-alias-introduction on ~~(FB-поле dst-alias-2 "Id") = ~~(FB-поле from fld) ^) 
    ))

Исходник FSEL приводить не буду, т.к. слишком сложно. Чтобы была ясна идея symbol-readmacro, вот более простой пример:

(defun here-document-readmacro-reader (stream symbol)
  (declare (ignore symbol))
  (budden-tools:it-is-a-car-symbol-readmacro
   (let1 terminator (string (read-preserving-whitespace stream))
     (read-char stream)
     (text-up-to-terminator-lexer stream terminator)
     )))

(setf (symbol-readmacro (intern "HERE-DOCUMENT" :budden)) #'here-document-readmacro-reader)

> (here-document $$ eqasdfdsf " ' $$)
"eqasdfdsf \" ' "

★★★★★

А зачем делать какие-то symbol-readmacro если они не отличаются от обычных макросов (по крайней мере в контексте приведенных примеров)?

anonymous ()

Реализацию symbol-readmacro в студию! А лучше общую идею (реализации, с использованием понятно).

anonymous ()
Ответ на: комментарий от anonymous

Общая идея - перекрыты macro-character-ами все constituent characters (ну, unicode не весь перекрыт). Когда видим constituent character, тошним его обратно в поток чтения, меняем пакет на :xlam-package, меняем readtable на стандартную, читаем по новой. Смотрим, что за имя символа прочиталось. Дальше делаем что угодно, в т.ч. можем вызвать ассоциированную с этим символом функцию-лексер, которая уже будет читать свой кусок из входного потока. Это всё совсем не так просто, как на словах, т.к. в реальности нам нужно ещё прочитать package qualifier и есть аномалии, такие, как #\. и #\: И ещё есть разные тонкости. Подмена пакета для symbol-readmacro в принципе, не нужна,но зато она нужна, чтобы сделать вот такую штуку:

(defpackage-autoimport-2 :извлечь-холдинги 
                       (:use :cl :budden-tools :budden)
                       (:always t)
                       (:local-nicknames :b :budden)
                       (:print-defpackage-form t))
; и теперь
извлечь-холдинги>(eq 'b::foo 'budden::foo)
; хотя пакета b вовсе не существует

Или вот такую:

> (let1 s "asdf" s^UPCASE)
"ASDF"

или вот такую:

> (type-of dat1:2011-01-15)
TIMESTAMP

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

den73 ★★★★★ ()
Ответ на: комментарий от anonymous

Я имею в виду, что (fse '«' from dual;) не имеет закрывающей скобки, зато содержит незаконченный строковый литерал. Ты вообще лисп-то знаешь?

den73 ★★★★★ ()
Ответ на: комментарий от den73

здесь плохо видно, что '«' - это

(concatenate 'string '(#\' #\" #\'))

den73 ★★★★★ ()
Ответ на: комментарий от anonymous

А также то, что

(fse user_group.* from user_group M_INNER_JOIN(user_group,app_user);
                    ) 
- это ошибка чтения, т.к. #\, находится вне #\` .

den73 ★★★★★ ()
Ответ на: комментарий от den73

Ты так и не объяснил, что мешает вместо (fse '«' from dual;) писать (fse '»' from dual), где fse - обычный макрос. Чтобы не ругалось на запятые и проч., можно их внутри fse зашадофить.

anonymous ()
Ответ на: комментарий от anonymous

(den73)

> зашадофить Ась? Код в студию.

anonymous ()
Ответ на: комментарий от den73

> Общая идея - перекрыты macro-character-ами все constituent characters (ну, unicode не весь перекрыт).

Оужас, я так и думал. Не, мне такой подход не нравится. Если уж извращаться, то я бы написал свой парсер, в котором бы, к примеру, задал возможность в readtable вносить комбинации символов, а не символы по отдельности. После чего перегрузить repl чтобы он работал через этот парсер. У sbcl небольшим хаком можно и дебаггер через него завернуть, другие компиляторы не смотрел. Я недавно возился с подобным парсером, но в контексте той задачи, что я рассматривал, возникли некоторые проблемы. Кстати, может кто-нибудь знает готовые или статьи о расширяемых парсерах? Чтобы можно было легко добавлять и удалять куски грамматики в BNF|EBNF? Правда, я ещё и сам толком не знаю что мне надо...

anonymous ()
Ответ на: комментарий от anonymous

(den73)

> Не, мне такой подход не нравится. Если уж извращаться, то я бы >написал свой парсер, в котором бы, к примеру, задал возможность в >readtable вносить комбинации символов, а не символы по отдельности. Ну, я же всё же пишу на лиспе, значит, парсер должен понимать лисп, чего мне и удалось достичь. А сделать свой язык - это уже другая история.

anonymous ()

Криворукий чванливый имбецил.

anonymous ()

Собственно, похвастаться я хотел не столько symbol-readmacro (им уже раньше хвастался), а M_INNER_JOIN - он не зависит от изменений, внесённых мной в таблицу чтения. Идея написать какой-нибудь «более выразительный» слой поверх SQL не приходит в голову только самому ленивому, и плодят люди всякие там ORMы. И я тоже пытался это сделать. Однако, по ходу дела выясняется, что SQL - это уже весьма выразительный язык, и при попытке добавить какой-то ещё слой мы можем потерять не только в производительности, но даже и в выразительности.

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

Ещё несколько примеров макросов из жизни:

(def-firebird-macro-1 M_MAX (x y) (fbody case when (:~x) > (:~y) then (:~x) else (:~y) end^))

(def-firebird-macro-1 M_начало_месяца (date-expr) 
  (fbody dateadd(day,1-extract(day from :~date-expr),:~date-expr)^))

(def-firebird-macro-1 M_PREFIX_WITH_DELIM (prefix delim str)
  "Если задан префикс str1, выводит его перед str2 через разделитель"
  (fbody M_IIF(c(trim(~~prefix))='',trim(~~str),trim(~~prefix)||(~~delim)||trim(~~str))^)
  )

den73 ★★★★★ ()
Вы не можете добавлять комментарии в эту тему. Тема перемещена в архив.