[ Эх, обогнали меня
Вчера накалякал пример, хоть и башка
была весь день какая-то мутная — странно, не пил вроде. Запостить
вчера моральных сил не хватило ]
Попробую привести решение в духе Лиспа
Если я правильно понимаю, то для публики может представлять
интерес несколько более общее решение задачи. В связи с этим
я хотел бы привести пример с использованием AST. Преимущества
такого подхода, думаю, известны — на основе этой инфраструктуры
можно легко создавать другие, более сложные и полезные генераторы
кода (см R#). Кроме того, мы фактически можем применять подобие
lisp macros к C#.
Если коллег интересует более компактное решение, я могу привести
и сокращённый вариант без деревьев. Также могу сказать, что для Лиспа
есть готовые либы для работы с text templates, например, CL-EMB
(в добавок я ещё свою достаточно удобную примочку как-то написал
для темплейтенья сырцов, я её использовал для VB.NET).
Я буду использовать стандартный Common Lisp Pretty Printer.
Это cразу исключает CLisp, т.к. AFAIK в нём эта часть не доделана.
Код работает с SBCL, Allegro, LispWorks; должен работать с CMUCL.
Данный pretty printer представляет из себя специфическое чудо техники
и конфигурируем в такой степени, что в идеале можно на входе давать
Lisp (списочные структуры), а на выходе получать C#. В силу природной
лени (и, возможно, опыта программирования на Perl
) я воспользовался
в паре мест не особо читабельными строками формата, за что прошу меня
извинить (можно было бы обойтись и без них).
Сразу забегу вперёд и приведу ссылку на решение. Оно может
показаться длинным, на самом деле кода там 70 строк, не
считая данных-примеров, докстрингов функций и комментариев.
Объём, конечно, чудовищный, ничего не скажешь.
Обработанный colorize'ом вариант — тут:
http://depni.sinp.msu.ru/~ivan_iv/lisp/sharpclass.html
Сам исходник — тут:
http://depni.sinp.msu.ru/~ivan_iv/lisp/sharpclass.lisp
Для пущей интересности задачу немного расширим — пусть
для пропертей генерятся не только getter'ы, но и setter'ы,
плюс генерится конструктор без аргументов (в добавок к
конструктору с аргументами) и все классы заворачиваются
в общий namespace
В качестве исходных данных вместо
<objects>
<object name="Obj1">
<property name="prop1" type="int"/>
<property name="prop2" type="string"/>
</object>
</objects>
мы будем использовать
(namespace "MyNS"
(object "Obj1"
(property "prop1" "int")
(property "prop2" "string")
(property "dblprop" "double"))
(object "Obj2"
(property "someprop" "object[]")))
Следует учесть, что символы namespace, object и property
данным генератором не используются и добавлены здесь для
читабельности.
Вводим промежуточное представление — AST.
Идея заключается в следующем — у нас есть дерево, в
виде символьного выражения записываемое, например, так:
(:namespace "MyTestNS"
(:class "MyTestClass"
(:field "int" "_someprop")
(:constructor "MyTestClass" ((:arg "int" "someprop"))
(:comment "This is a test")
(:setf (:id "_someprop") (:id "someprop")))
(:property "int" "SomeProp"
(:get (:return (:id "_someprop")))
(:set (:setf (:id "_someprop") (:id "value"))))
(:property "int" "AnotherProp"
(:get (:return 0)))))
В виде XML его можно было бы записать, например, следующим образом:
<namespace name="MyTestNS">
<class name="MyTestClass">
<field name="_someprop" type="int"/>
<constructor name="MyTestClass">
<args>
<arg name="someprop" type="int"/>
</args>
<body>
<set>
<lvalue>
<identifier name="_someprop">
</lvalue>
<rvalue>
<identifier name="someprop">
</rvalue>
</set>
</body>
</constructor>
<property name="SomeProp" type="int">
...
</property>
...
</namespace>
Данный AST является достаточно упрощённым, но для наших целей этого
хватит.
Далее, нам надо настроить pretty-printer. Мы определяем способы печати
различных узлов дерева (data-driven approach). Для этого нам нужен следующий framework:
;;; AST printer, much more concise than your CodeDOM and perhaps R# :-P
;;; Can be easily extended to support other language constructs &
;;; several languages simultaneously
;; pretty-print dispatch table: type -> printing func correspondence
(defvar *dispatch* (copy-pprint-dispatch))
(defun ast-print (x &optional (stream *standard-output*))
"Print the expression x using AST dispatch rules"
(write x :pretty t :pprint-dispatch *dispatch* :stream stream))
(defun ast-print-form (stream form)
"Print the AST node (form)"
(if (and (symbolp (first form))
(get (first form) 'ast-form))
(funcall (get (first form) 'ast-form) stream form)
(error "unknown form: ~S" form)))
;; set dispatch function for cons type in our pretty-print dispatch table
(set-pprint-dispatch 'cons #'ast-print-form 0 *dispatch*)
(defmacro defprinter (name args &body body)
"Define a printer for specified AST node type"
(let ((func-name (intern (format nil "PRINT-FORM-~A" name)))
(item (gensym)))
`(progn
(defun ,func-name (stream ,item)
(destructuring-bind ,args (rest ,item)
,@body))
(setf (get ',name 'ast-form) ',func-name))))
Функция (ast-print ...) печатает AST с использованием созданной
конфигурации. Макрос defprinter позволяет задавать обработчики
узлов дерева с указанием структуры. Функция ast-print-form является
обработчиком, печатающим значения типа cons — он, собственно,
вызывает нужный хендлер.
Прежде, чем приводить обработчики узлов, давайте посмотрим,
что они дают.
;; определяем простую функцию для печати - чтобы возвращаемое
;; значение не мешало обзору
CL-USER> (defun p (x) (ast-print x) nil)
P
;; играемся
CL-USER> (p '(:id "qwerty"))
qwerty
NIL
CL-USER> (p '(:return (:id "qwerty")))
return qwerty;
NIL
CL-USER> (p '(:property "int" "Qwerty" (:get (:return (:id "qwerty")))))
public int Qwerty
{
get
{
return qwerty;
}
}
NIL
CL-USER> (p '(:property "int" "Qwerty"
(:get (:return (:id "qwerty")))
(:set (:setf (:id "qwerty") (:id "value")))))
public int Qwerty
{
get
{
return qwerty;
}
set
{
qwerty = value;
}
}
NIL
Вроде как полезненно. Способствует. Посмотим, что внутрях.
Там есть одна утилитная функция с кривой строкой формата, которая
печатает ... { ... } с новыми строками и индентацией, плюс обработчики.
;;; AST printing specs for C#
;;; (write other specs, get VB.NET, Java, C++, Fortran, etc.)
;; please note that the following function could be writen in a more
;; clear way using pprint-* funcs, but now I'm just too lazy
(defun print-statement-with-body (stream body two-newlines fmt &rest args)
"Print the statement with brace-enclosed body"
(format stream
(if two-newlines
"~?~:@_~@<{~4i~{~:@_~w~^~:@_~}~i~:@_}~:>"
"~?~:@_~@<{~4i~{~:@_~w~}~i~:@_}~:>")
fmt args body))
;; identifier - printed literally
(defprinter :id (id)
(write-string id stream))
;; private int x;
(defprinter :field (type name)
(format stream "private ~a ~a;" type name))
;; public int SomeProp { ... }
(defprinter :property (type name &rest body)
(print-statement-with-body stream body nil "public ~a ~a" type name))
;; get { ... }
(defprinter :get (&rest body)
(print-statement-with-body stream body nil "get"))
;; set { ... }
(defprinter :set (&rest body)
(print-statement-with-body stream body nil "set"))
;; return x;
(defprinter :return (expr)
(format stream "return ~w;" expr))
;; argument
(defprinter :arg (type name)
(format stream "~a ~a" type name))
;; constructor
(defprinter :constructor (name args &rest body)
(print-statement-with-body stream body nil "~a(~@<~{~w~^, ~_~}~:>)" name args))
;; a = b;
(defprinter :setf (lvalue rvalue)
(format stream "~w = ~w;" lvalue rvalue))
;; public class SomeClass { ... }
(defprinter :class (name &rest body)
(print-statement-with-body stream body t "public class ~a" name))
;; namespace SomeNS { ... }
(defprinter :namespace (name &rest body)
(print-statement-with-body stream body t "namespace ~a" name))
;; comment
(defprinter :comment (text)
(format stream "// ~a" text))
Может быть, интересно взглянуть, во что разворачивается defprinter.
Ставим курсор в емаксе на последнюю закрывающуюся скобку и давим Ctrl-C Enter.
(PROGN (DEFUN PRINT-FORM-COMMENT (STREAM #:G288)
(DESTRUCTURING-BIND (TEXT) (REST #:G288)
(FORMAT STREAM "// ~a" TEXT)))
(SETF (GET ':COMMENT 'AST-FORM) 'PRINT-FORM-COMMENT))
Тут мы видим определение функции для разборки и печати узла
(комментария) и прицепление её к символу :comment (:comment, а не comment —
чтобы это был keyword, не привязанный к пакету — лисповому namespace'у)
через пропертю AST-FORM (здесь пропертя значит именованное значение,
привязанное к символу). #:G288 — сгенерированный (gensym) символ, гарантированно
не конфликтующий с другими именами из environment'а. Вместо
функции можно было бы использовать lambda, но это затруднило бы
отладку — функцию можно отTRACE'ить — после (trace print-form-comment)
в REPL будут выводиться все её вызовы с аргументами и возвращаемыми
значениями.
Следует отметить, что лисповские символы по умолчанию к регистру
не чувствительны (в связи с этим для простоты я решил использовать
строки вместо символов для названий C# пропертей и типов — хотя
проблема решается несложно). Большими буквами обычно выводится ответ Lisp'а.
Давайте ещё раз попробуем:
CL-USER> (p '(:namespace "MyTestNS"
(:class "MyTestClass"
(:field "int" "_someprop")
(:constructor "MyTestClass" ((:arg "int" "someprop"))
(:comment "This is a test")
(:setf (:id "_someprop") (:id "someprop")))
(:property "int" "SomeProp"
(:get (:return (:id "_someprop")))
(:set (:setf (:id "_someprop") (:id "value"))))
(:property "int" "AnotherProp"
(:get (:return 0))))))
namespace MyTestNS
{
public class MyTestClass
{
private int _someprop;
MyTestClass(int someprop)
{
// This is a test
_someprop = someprop;
}
public int SomeProp
{
get
{
return _someprop;
}
set
{
_someprop = value;
}
}
public int AnotherProp
{
get
{
return 0;
}
}
}
}
NIL
Ну вот, теперь мы кажись могём из символьных выражений генерить C#.
И вроде как даже существенно удобоваримей того же CodeDOM всё выходит.
Ну, теперь дело за малым — делаем функцию-генератор AST на основе
декларативного описания:
;;; Data class generation
(defun generate-csharp-class (object)
"Generate a C# class from DSL spec"
(destructuring-bind (class-name . properties) (rest object)
(loop for (nil prop-name prop-type) in properties
for sharp-prop-name = (format nil "~:(~a~)" prop-name) ; C# property name
for field-name = (concatenate 'string "_" prop-name) ; C# field name
collect `(:arg ,prop-type ,prop-name) into init-args
collect `(:setf (:id ,field-name) (:id ,prop-name)) into init
nconc `((:field ,prop-type ,field-name)
(:property ,prop-type ,sharp-prop-name
(:get (:return (:id ,field-name)))
(:set (:setf (:id ,field-name) (:id "value"))))) into props
finally (return
`(:class ,class-name
(:constructor ,class-name ()
(:comment "NOOP"))
(:constructor ,class-name ,init-args
,@init)
,@props)))))
(defun generate-csharp-classes (data)
"Generate C# classes from DSL spec"
(destructuring-bind (ns-name . classes) (rest data)
`(:namespace ,ns-name
,@(mapcar #'generate-csharp-class classes))))
generate-csharp-class генерит AST класса на основе
(object "Obj1" ...), а generate-csharp-classes генерит
всё вместе на основе (namespace "MyNS" ...):
;; глянем-ка на AST, интересно всё-таки
CL-USER> (generate-csharp-classes
'(namespace "MyNS"
(object "Obj1"
(property "prop1" "int")
(property "prop2" "string")
(property "dblprop" "double"))
(object "Obj2"
(property "someprop" "object[]"))))
(:NAMESPACE "MyNS"
(:CLASS "Obj1" (:CONSTRUCTOR "Obj1" NIL (:COMMENT "NOOP"))
(:CONSTRUCTOR "Obj1"
((:ARG "int" "prop1") (:ARG "string" "prop2") (:ARG "double" "dblprop"))
(:SETF (:ID "_prop1") (:ID "prop1")) (:SETF (:ID "_prop2") (:ID "prop2"))
(:SETF (:ID "_dblprop") (:ID "dblprop")))
(:FIELD "int" "_prop1")
(:PROPERTY "int" "Prop1" (:GET (:RETURN (:ID "_prop1")))
(:SET (:SETF (:ID "_prop1") (:ID "value"))))
(:FIELD "string" "_prop2")
(:PROPERTY "string" "Prop2" (:GET (:RETURN (:ID "_prop2")))
(:SET (:SETF (:ID "_prop2") (:ID "value"))))
(:FIELD "double" "_dblprop")
(:PROPERTY "double" "Dblprop" (:GET (:RETURN (:ID "_dblprop")))
(:SET (:SETF (:ID "_dblprop") (:ID "value")))))
(:CLASS "Obj2" (:CONSTRUCTOR "Obj2" NIL (:COMMENT "NOOP"))
(:CONSTRUCTOR "Obj2" ((:ARG "object[]" "someprop"))
(:SETF (:ID "_someprop") (:ID "someprop")))
(:FIELD "object[]" "_someprop")
(:PROPERTY "object[]" "Someprop" (:GET (:RETURN (:ID "_someprop")))
(:SET (:SETF (:ID "_someprop") (:ID "value"))))))
;; ну а теперь на шарп (* - последнее вёрнутое значение)
CL-USER> (p *)
namespace MyNS
{
public class Obj1
{
Obj1()
{
// NOOP
}
Obj1(int prop1, string prop2, double dblprop)
{
_prop1 = prop1;
_prop2 = prop2;
_dblprop = dblprop;
}
private int _prop1;
public int Prop1
{
get
{
return _prop1;
}
set
{
_prop1 = value;
}
}
private string _prop2;
public string Prop2
{
get
{
return _prop2;
}
set
{
_prop2 = value;
}
}
private double _dblprop;
public double Dblprop
{
get
{
return _dblprop;
}
set
{
_dblprop = value;
}
}
}
public class Obj2
{
Obj2()
{
// NOOP
}
Obj2(object[] someprop)
{
_someprop = someprop;
}
private object[] _someprop;
public object[] Someprop
{
get
{
return _someprop;
}
set
{
_someprop = value;
}
}
}
}
NIL
;; вуаля, блин!
У этого, понятное дело, может быть ещё куча применений —
можно генерить разные прокси классы, врапперы к базе/хранимкам и пр., в качестве источника
можно использовать .NET reflection напрямую через RDNZL, DBMS, можно парсить сырцы
через cl-yacc (в отличие от Yacc, препроцессинга он не требует, т.к. грамматика транслируется
макросами — отличный пример их применения, и отлаживается проще, т.к. есть TRACE) и т.д.
Короче говоря, R# на Лиспе написать куда как проще, чем на C#. Можно сделать мегакостыль для .NET.
Оговорка лишь одна — если можете писать на Лиспе, лучше пишите на Лиспе, это проще, чем
на C# с костылями, на чём бы эти костыли написаны не были. В общем и целом — ещё одно
замечательное применение Лиспа — dev tools.
Да, в исходнике я привёл ссылки на "вдохновителей", дублирую. Peter Norvig крут —
на таких, как он, Google держится
PAIP читать ВСЕМ — хоть его в нашем краю
и достать не очень легко, оно того стоит —
http://www.norvig.com/paip.html
;;;; Inspired by DPP (Dylan Pretty-Printer, a part of Peter Norvig's
;;;; Lisp to Dylan Converter —
http://www.norvig.com/ltd/doc/ltd.html)
;;;; and by Dick Waters' paper "Some Useful Lisp Algorithms: Part 2"
;;;; (
http://www.merl.com/publications/TR1993-017/)
;;;; See also: XP pretty-printer documentation in XP distribution
;;;;
http://www-2.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/lang/lisp/code/io/xp/xp.tgz
