Что будут стоить тысячи слов,
Когда важна будет крепость руки?
И вот ты стоишь на берегу
И думаешь: плыть или не плыть?

В.Цой

(defmacro defun-declare-type (name (&rest params) &body body)
  `(defun ,name ,(mapcar #'cadr params)
    (declare ,@params)
    ,@body))

(defun test (b a)
  (declare (string b) (integer a))
  (format t "~a have ~d apples." b a))

(defun-declare-type test ((string b) (integer a))
  (format t "~a have ~d apples." b a))

(defun-declare-type test2 ((string a) )
  (test "ABC" a))

In: DEFUN-DECLARE-TYPE TEST2

;   (TEST "AA" A)
; ==>
;   A
; Warning: Result is a BASE-STRING, not a (VALUES &OPTIONAL INTEGER &REST T).
; 

; Compilation unit finished.
;   1 warning

(define-binary-class id3v2.3-tag (id3-tag)
  ((extended-header-size (optional :type 'u4 :if (extended-p flags)))
   (extra-flags          (optional :type 'u2 :if (extended-p flags)))
   (padding-size         (optional :type 'u4 :if (extended-p flags)))
   (crc                  (optional :type 'u4 :if (crc-p flags extra-flags)))
   (frames               (id3-frames :tag-size size :frame-type 'id3v2.3-frame))))

(define-generic-binary-class id3v2.3-tag
    (id3-tag)
  ((extended-header-size 
    (optional :type 'u4 :if (extended-p flags)))
   (extra-flags 
    (optional :type 'u2 :if (extended-p flags)))
   (padding-size 
    (optional :type 'u4 :if (extended-p flags)))
   (crc 
    (optional :type 'u4 :if (crc-p flags extra-flags)))
   (frames 
    (id3-frames :tag-size size :frame-type 'id3v2.3-frame)))
  (defmethod com.gigamonkeys.binary-data::read-object progn
    ((#:objectvar id3v2.3-tag) #:streamvar) 
    (declare (ignorable #:streamvar))
    (with-slots (identifier major-version revision flags size extended-header-size
                extra-flags padding-size crc frames)
    #:objectvar
      (setf extended-header-size
        (read-value 'optional #:streamvar :type 'u4 :if (extended-p flags)))
      (setf extra-flags
        (read-value 'optional #:streamvar :type 'u2 :if (extended-p flags)))
      (setf padding-size
        (read-value 'optional #:streamvar :type 'u4 :if (extended-p flags)))
      (setf crc
        (read-value 'optional #:streamvar :type 'u4 :if (crc-p flags extra-flags)))
      (setf frames
        (read-value 'id3-frames #:streamvar :tag-size size :frame-type 'id3v2.3-frame)))))

(defmacro define-generic-binary-class (name (&rest superclasses) slots read-method)
  (with-gensyms (objectvar streamvar)
    `(progn
       (eval-when (:compile-toplevel :load-toplevel :execute)
         (setf (get ',name 'slots) ',(mapcar #'first slots))
         (setf (get ',name 'superclasses) ',superclasses))

       (defclass ,name ,superclasses
         ,(mapcar #'slot->defclass-slot slots))

       ,read-method

       (defmethod write-object progn ((,objectvar ,name) ,streamvar)
         (declare (ignorable ,streamvar))
         (with-slots ,(new-class-all-slots slots superclasses) ,objectvar
           ,@(mapcar #'(lambda (x) (slot->write-value x streamvar)) slots))))))

(defmacro define-binary-class (name (&rest superclasses) slots)
  (with-gensyms (objectvar streamvar)
    `(define-generic-binary-class ,name ,superclasses ,slots
       (defmethod read-object progn ((,objectvar ,name) ,streamvar)
         (declare (ignorable ,streamvar))
         (with-slots ,(new-class-all-slots slots superclasses) ,objectvar
           ,@(mapcar #'(lambda (x) (slot->read-value x streamvar)) slots))))))

(defun slot->defclass-slot (spec)
  (let ((name (first spec)))
    `(,name :initarg ,(as-keyword name) :accessor ,name)))

(defun new-class-all-slots (slots superclasses)
  (nconc (mapcan #'all-slots superclasses) (mapcar #'first slots)))

(defun slot->write-value (spec stream)
  (destructuring-bind (name (type &rest args)) (normalize-slot-spec spec)
    `(write-value ',type ,stream ,name ,@args)))

(defun slot->read-value (spec stream)
  (destructuring-bind (name (type &rest args)) (normalize-slot-spec spec)
    `(setf ,name (read-value ',type ,stream ,@args))))

(defun foo (bar baz)
  (+ (* baz 2)
     (expt bar (* baz 2)^)))

(defun foo (bar baz)
  ((+ (* baz 2)
     (expt bar (* baz 2)))))

event_queue "airspace" do
  generate_event_every 5.minutes + 26.seconds
  collision_radius 197.feet + 6.inches
end

builder = SimpleBuilder.new
builder.entry { |x|
  x.name me.name
  x.email me.email
}

<entry><name>Jim</name><email>jim@fakemail.com</email></entry>

route "Problems" do
  step "Problem Resolution"
end

route "EMail Order" do
  step "Validate Customer"
  step "Assemble Order"
  step "Charge Credit Card" do
    on "invalid", :route => "Problems", :step => "Problem Resolution"
  end
  step "Ship"
end
  
generate_sql

INSERT INTO queues(id, name) VALUES (1, 'Validate Customer');
INSERT INTO queues(id, name) VALUES (2, 'Validate Books');
INSERT INTO queues(id, name) VALUES (3, 'Charge Credit Card');
INSERT INTO queues(id, name) VALUES (4, 'Ship Order');
INSERT INTO queues(id, name) VALUES (5, 'Problem Resolution');

INSERT INTO routes(id, name) VALUES (1, 'EMail Book Orders');
INSERT INTO routes(id, name) VALUES (2, 'Problems');

INSERT INTO steps(id, route_id, queue_id) VALUES(1, 1, 1);
INSERT INTO steps(id, route_id, queue_id) VALUES(2, 1, 2);
INSERT INTO steps(id, route_id, queue_id) VALUES(3, 1, 3);
INSERT INTO steps(id, route_id, queue_id) VALUES(4, 1, 4);
INSERT INTO steps(id, route_id, queue_id) VALUES(5, 2, 5);

INSERT INTO alternatives(id, step_id, code, next_step_id)
  VALUES (1, 3, 'invalid', 5);

E>event_queue "airspace" do
E>  generate_event_every 5.minutes + 26.seconds
E>  collision_radius 197.feet + 6.inches
E>end
E>

(2 * #orange) + (3 * #apple) "= 2orange+3apple"
0.65s * #US * 100 "= 65.00US"

4 ~> 'kg'    "makes 4 kilograms"
5 as: 'cd.m/hr2'    "makes 5 meter-candelas per hour squared"
1 ~> 'm' ~> 'cm'    "makes 1 meter, and converts it into 100 centimeters"
4 mL "makes 4 milliliters"

E>builder = SimpleBuilder.new
E>builder.entry { |x|
E>  x.name me.name
E>  x.email me.email
E>}
E>

E><entry><name>Jim</name><email>jim@fakemail.com</email></entry>
E>

aBuilder entry: [:entry |
    entry name: self name.
    entry email: [:email |
        item title: 'This is my email'.
        item description: 'This is the description of the e-mail']].

E>route "Problems" do
E>  step "Problem Resolution"
E>end

E>route "EMail Order" do
E>  step "Validate Customer"
E>  step "Assemble Order"
E>  step "Charge Credit Card" do
E>    on "invalid", :route => "Problems", :step => "Problem Resolution"
E>  end
E>  step "Ship"
E>end
  
E>generate_sql
E>

E>INSERT INTO queues(id, name) VALUES (1, 'Validate Customer');
E>INSERT INTO queues(id, name) VALUES (2, 'Validate Books');
E>INSERT INTO queues(id, name) VALUES (3, 'Charge Credit Card');
E>INSERT INTO queues(id, name) VALUES (4, 'Ship Order');
E>INSERT INTO queues(id, name) VALUES (5, 'Problem Resolution');

E>INSERT INTO routes(id, name) VALUES (1, 'EMail Book Orders');
E>INSERT INTO routes(id, name) VALUES (2, 'Problems');

E>INSERT INTO steps(id, route_id, queue_id) VALUES(1, 1, 1);
E>INSERT INTO steps(id, route_id, queue_id) VALUES(2, 1, 2);
E>INSERT INTO steps(id, route_id, queue_id) VALUES(3, 1, 3);
E>INSERT INTO steps(id, route_id, queue_id) VALUES(4, 1, 4);
E>INSERT INTO steps(id, route_id, queue_id) VALUES(5, 2, 5);

E>INSERT INTO alternatives(id, step_id, code, next_step_id)
E>  VALUES (1, 3, 'invalid', 5);
E>

courseTitlesForProfessorNamed: aString
  |courses|
  courses := (professors * courses
       select: [[:ea | (ea lastName = aString) & (ea id = ea professorID)].
  ^ (courses project: #title) copyFrom: 1 to: 10.

SELECT title 
    FROM Professor, Course 
    WHERE Professor.lastName = 'Foo' AND Professor.id = Course.professorID LIMIT 10

Помимо списков и символов, в Лисп есть отдельные типы данных для строк, массивов, хеш-таблиц, записей (структур), потоков ввода-вывода. Кроме того, стандарт Common Lisp включает в себя систему объектно-ориентированного программирования CLOS, далеко превосходящую по выразительным возможностям систему программирования C++. Для доказательства этого превосходства достаточно отметить, что есть возможность выбирать вызываемое тело метода, руководствуясь типами нескольких параметров, а не одного, как в C++. Например, пусть у нас определены классы screen и paper, а также классы sentence и picture. Тогда для функции draw можно определить четыре метода

(defmethod draw ((x sentence) (y screen)) (message-box x y)) ; для отображения сообщения на экране

(defmethod draw ((x sentence) (y paper)) (write x y)) ; нужно просто написать слова на бумаге

(defmethod draw ((x picture) (y screen)) (show-picture-in-a-box x y)) ; показываем картинку на экране

(defmethod draw ((x picture) (y screen)) (paint-picture-on-a-paper x y)) ; рисуем картинку на бумаге.

При вызове

>(draw my-data my-device)

выбор одного из четырех определенных методов будет динамически осуществляться в момент вызова. Это невозможно в C++, где пришлось бы делать draw либо методом общего предка объектов screen и paper, либо методом общего предка sentence и picture, а выбор кода по типу второго аргумента осуществлять с помощью анализа этого типа в конструкции if.

Например, легко ошибиться, написав (i==j || k==l) вместо ((i==j) || (k==l)), а в Лисп такая ошибка просто невозможна, потому что нужно будет написать (or (= i j) (= k l))

Например, оператор if в C не возвращает значения, и, чтобы это обойти, была придумана операция ( ? : ). Было бы удобно, если бы оператор switch в C мог также возвращать значение, которое можно присвоить переменной после завершения его выполнения. В Паскале и Бейсике даже присваивание является оператором и не возвращает значения, поэтому нельзя написать a=b=с. В Лиспе в этом плане все гораздо удобнее. if возвращает значение. Одну и ту же конструкцию if можно использовать для ветвления алгоритма и для выбора значения по условию. Также возвращает значение и cond (аналог switch), и setf (аналог присваивания). Да и вообще, в Лиспе значение возвращается всегда, где это имеет смысл.

void do_something()
    {
        int * params = new int[ 10 ];
        ....
    }
    
class    connection_info_t
    {
    private :
        std::string &    m_data_source;
        ...
    public :
        ...
        std::string    data_source() { return m_data_source; }
        ...
    };
    
connection_t *
connect( connection_info_t * info );

connection_t *
establish_connection( std::string data_source, std::string user, std::string password )
    {
        ...
        connection_t * c = connect( new connection_info_t( data_source, user, password ) );
        ...
        return c;
    }

VD>С понтами скорее те кто считает С++-ников высшей кастой. Понимать здесь точно нечего.

struct  shape            {...};
struct  square   : shape {...};
struct  triangle : shape {...};
struct  options          {...};

// объявление мультиметода

bool    overlap( virtual shape& a, virtual shape& b, options const& );

// реализации

bool    overlap( static square&   a, static triangle& b) {...}
bool    overlap( static triangle& a, static square&   b) {...}

// Объявление "мультиметода" в одном из заголовочных файлов:

MM_METHOD(
    overlap,
    bool ( MM_VIRTUAL(shape)&, MM_VIRTUAL(shape)&, options const& )
    );

// Реализация, потенциально в разных .cpp-файлах:

MM_METHOD_IMPL(
    overlap,
    bool, ( square& sq, triangle& tr, options const& o ),
    {
        // use 'sq', 'tr', and 'o' to implement
    }
    );

MM_METHOD_IMPL(
    overlap,
    bool, ( triangle& tr, square& sq, options const& o ),
    {
        // use 'sq', 'tr', and 'o' to implement
    }
    );

// объявление в заголовке
extern
mm::method<
    bool ( mm::virtual_<shape>&, mm::virtual_<shape>&, options const& )
    >
    overlap;

// определение в .cpp
mm::method<
    bool ( mm::virtual_<shape>&, mm::virtual_<shape>&, options const& )
    >
    overlap;

// Реализация, потенциально в разных .cpp-файлах:

bool overlap_sq_tr( square& sq, triangle& tr, options const& o )
{
    // use 'sq', 'tr', and 'o' to implement
}
mm::method_impl overlap_sq_tr_( overlap, overlap_sq_tr );

bool overlap_tr_sq( triangle& tr, square& sq, options const& o )
{
    // use 'sq', 'tr', and 'o' to implement
}
mm::method_impl overlap_tr_sq_( overlap, overlap_sq_tr );

// объявление в заголовке
MM_METHOD(
    bool ( mm::virtual_<shape>&, mm::virtual_<shape>&, options const& )
    overlap
 ;

// Реализация, потенциально в разных .cpp-файлах:

bool overlap_sq_tr( square& sq, triangle& tr, options const& o )
{
    // use 'sq', 'tr', and 'o' to implement
}
MM_METHOD_IMPL( overlap, overlap_sq_tr );

bool overlap_tr_sq( triangle& tr, square& sq, options const& o )
{
    // use 'sq', 'tr', and 'o' to implement
}
MM_METHOD_IMPL( overlap, overlap_sq_tr );

СТ>Пытался подружить парочку emacs + slim. Максимум, что мне удалось, это вызов консоли Аллегро по M-x slime. Но, думаю, эффект должен быть немного другой. Не поделишься ли опытом настройки?

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  LISP ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;; Functions ;;;;;;;;;;

(defun se:move-past-close-and-just-one-space ()
  "Move past next `)' and ensure just one space after it."
  (interactive)
  (up-list)
  (just-one-space))


(defun mb:unwrap-next-sexp (&optional kill-n-sexps)
  "Convert (x ...) to ..."
  (interactive "P")
  (forward-sexp)
  (backward-delete-char 1)
  (backward-up-list)
  (delete-char 1)
  (let ((start-region-to-kill (point)))
    (kill-sexp kill-n-sexps)
    (down-list)
    (delete-region start-region-to-kill (1- (point)))
    (backward-up-list))
  (lisp-indent-line))

;;;;;;;;;; Common Lisp ;;;;;;;;;;
(add-to-list 'load-path "/home/cp/arc/lisp/slime-cvs/slime")
(require 'slime)

;;;;; Functions ;;;;;
(defun cliki:start-slime ()
  (unless (slime-connected-p)
    (save-excursion (slime))))


;;;;; SLIME Setup ;;;;;



(slime-setup)
(slime-setup :autodoc t)
(set-variable 'slime-net-coding-system 'iso-latin-1-unix)


;(set-variable inferior-lisp-program "/home/cp/arc/lisp/acl62_trial/alisp")
;(set-variable inferior-lisp-program "clisp")
(setf inferior-lisp-program "lisp")


;;;;; Documentaion ;;;;;
(load "/usr/share/emacs/21.4/site-lisp/ilisp/extra/cltl2.el" )
(setf common-lisp-hyperspec-root "file:/usr/share/doc/hyperspec/")
(setf cltl2-root-url "file:///usr/share/doc/cltl/")

;;;;; Key bindings ;;;;;

(global-set-key "\C-cs" 'slime-selector)

(add-hook 'slime-connected-hook 'slime-ensure-typeout-frame)

(add-hook 'slime-mode-hook
      (lambda ()
        (define-key slime-mode-map  "^C^D^C" 'cltl2-lookup)
        (define-key slime-mode-map "^C^R" 'slime-compile-region)
        (define-key slime-mode-map  "^C^Dc"  'cltl2-lookup)
        (define-key slime-mode-map "\333" 'slime-arglist)
        (define-key slime-mode-map [(?\()] 'insert-parentheses)
        (define-key slime-mode-map [(?\))] 'se:move-past-close-and-just-one-space)
        (define-key slime-mode-map [(return)] 'newline-and-indent)
        (define-key slime-mode-map "\335" 'move-past-close-and-reindent)        
        (define-key slime-mode-map [(control ?\=)] (lambda () (interactive) (insert "(")))
        (define-key slime-mode-map [(control ?\\)] (lambda () (interactive) (insert ")")))
        
        ))

Lisp
• Metaprogramming seems to have originated in Lisp.
Lisp is a programmable programming language.
—John Foderaro
In Lisp, you don’t just write your program down toward the language, you also build the language up toward your program.
—Paul Graham
• Lisp isn’t the only programmable language.

Ruby
• Rubyists have been rediscovering metaprogramming.
• Ruby style and idioms are still changing and adapting.
• Rails leverages metaprogramming heavily.
• To great effect!
• Ruby is a natural for metaprogramming.

How To Think About Metaprogramming
• Defining new constructs for your programming language.
• OK, but … constructs to do what?
• Whatever your domain-specific language (DSL) needs to do.

Another Way To Think About Metaprogramming
• A new set of conceptual tools for eliminating duplication (and other smells) from your code.

Domain Specific Language for Builds

All my three build languages share another characteristic — they are all examples of a Domain Specific Language (DSL). However they are different kinds of DSL. In the terminology I've used before:
* make is an external DSL using a custom syntax
* ant (and nant) is an external DSL using an XML based syntax
* rake is an internal DSL using Ruby.

The fact that rake is an internal DSL for a general purpose language is a very important difference between it and the other two. It essentially allows me to use the full power of ruby any time I need it, at the cost of having to do a few odd looking things to ensure the rake scripts are valid ruby. Since ruby is a unobtrusive language, there's not much in the way of syntactic oddities. Furthermore since ruby is a full blown language, I don't need to drop out of the DSL to do interesting things — which has been a regular frustration using make and ant. Indeed I've come to view that a build language is really ideally suited to an internal DSL because you do need that full language power just often enough to make it worthwhile — and you don't get many non-programmers writing build scripts.

SLOC for the Symbolics Genera Lisp Machine (an OS that was arguably
far superior to Linux)

> (a) The reason they rewrote it was entirely that the
> current engineers didn't understand Lisp and were too
> afraid to learn it.
>
> (b) The resulting program is a new world's record case
> of Greenspun's Tenth Rule. The Yahoo Store Editor called
> compile at runtime on s-expressions made on the fly.
> To translate this into C++ they literally had to write a
> Lisp interpreter.
>

This is an interesting state of affairs. We have engineers that are afraid
to learn lisp, but are not afraid to use a mock-lisp interpreter written in
C++. I'm not sure whether to laugh or to cry.

struct Sync {
    void Lock();
    void Release();
};

struct Locker {
    Locker(Sync& obj_) : obj(obj_) { obj.Lock(); }
    ~Locker() { obj.Release(); }
    Sync& obj;
};

#define LOCK(x)\
Locker locker_##__FILE__##__LINE__(x);

{
    LOCK(s);
    std::out << s.SayHelloWorld();
}

do_it(object);

stdхзч << i;

print(i);

P>А какая суть? А то контекст, в котором было упоминание Spirit, что-то затерялся.

P>(defmacro (my-transform code) .......)

P>(my-transform 
P>  (if (= x y)
P>      (- x y)
P>      666
P>      )
P>  )
P>

(defmacro defun-print-name (name args &body body)
  `(defun ,name ,args
    (princ ',name)
    ,@body))

(defun-print-name summ-2 (a b)
  (+ a b))

(defun summ-2 (a b)
  (princ 'summ-2) (+ a b))

CL-USER> (summ-2 1 2)
SUMM-2
3

Windows Registry Editor Version 5.00

[HKEY_CURRENT_USER\Software\GNU\Emacs]
"HOME"="f:\\piranha\\home\\"

В отличие от ЛИСПа, основу РЕФАЛа составляет сопоставление с образцом.
Благодаря этому типовая программа на РЕФАЛе вдвое-втрое короче по
объему, чем аналогичная программа на языке ЛИСП, и гораздо более
читаема. От ПРОЛОГа РЕФАЛ отличает концептуальная простота. Его
сопоставление с образцом работает в прямом направлении, а не в обратном
(начиная от цели), как в ПРОЛОГе. Это более естественный подход к
написанию алгоритмов, что делает их более легкими для тестирования и
отладки.

Далее, имеется существенное различие между структурами данных в РЕФАЛе и
в большинстве других языков высокого уровня. Основные структуры данных в
ЛИСПе и ПРОЛОГе — это */списки/*, которые могут читаться только в одном
направлении. РЕФАЛ использует более общие структуры. Вы можете строить
и читать их слева-направо и справа-налево и, конечно же, прыгать внутрь
и наружу по скобочным структурам. Это очень удобно для программиста.
РЕФАЛ дает свободу и удобство в создании структур данных наряду с
использованием лишь математически простых механизмов управления —
/*сопоставления с образцом и подстановки. */Это именно то, что нужно для
символьной обработки и для искусственного интеллекта.

M> А что такое, например, параметризуемые модули, как не шаблоны?

'a list                    <=> template <class T> list
('a * 'b * 'c)             <=> template <class T1, class T2, class T3> tuple
('a->'a)                   <=> template <class TR, class T1> function <TR(*)(T1)>
('a->'b)->('c->'a)->'c->'b <=> template < ... > JAW_DROPPINGLY_BIG_BUNCH_OF_CODE