Ev Arşiv Hakkında

CL-Mustache, Common Lisp için Mustache renderer

2-2-2012, 7:46 ö.s. // yorum // lisp

Biraz eski bir olay ama yarım kalan yazı arşivimde kaybolmuş, şimdi ekleyeyim(tamamlanmayı bekleyen bir sürü yazı var, sıkı durun).

Mustache, "logic-less templates" diye bahsedilen bir template motoru(bu arada ben hala "logic-less" ne demek bilmiyorum ehehe). Şuradan örneklere bakabilirsiniz.

Common Lisp için Mustache kütüphanesi, en azındaın Google ile aratıp bulunabilecek bir yerde, yoktu. Ben de henüz öğrenme aşamasındaydım ve belki camiaya da bir katkım olur diye girişmiştim bu işe.

Github deposundan edinebilirsiniz. Arayüz olarak sadece tek bir fonksiyon sunuyor, mustache-render. Herhangi bir input stream'ı ve Common Lisp veri yapılarına dönüştürülmüş JSON verisi ile çağırdığınızda render edilmiş halini elde ediyorsunuz. Şu anda Mustache speclerinden çok satırlı yorumlar hariç hepsini geçiyor. comp.lang.lisp'e attığım maile de şuradan bakabilirsiniz.

Lambda desteği için speclerde yapmamız gereken değişiklikleri üşendiğim için bir türlü yapamamıştım, comp.lang.lisp'deki mailime cevap yazanlardan birisi ekleyip pull request yollamış. Eklenip JSON hali hazırlandığında lambda desteği de ekleyeceğim(bu arada Common Lisp için YAML parser'ı da yok şu anda, bu projeyi bitirene kadar ne kadar çok şey öğrendiğimi düşünüyoru da, o işe de girişebilirim aslında).

Şimdi hazır lafa girmişken teknik detaylardan bahsetmezsem ölürüm. Öncelikle kodu iyileştirmek için(ilk Common Lisp kütüphanem sonuçta), IRC'de comp.lang.lisp'de yardım istedim, ama pek bir cevap alamadım. Birkaç ihtimal var, ya Common Lisp camiasının pek umurunda değil, ya sayıca az olduğumuzdan ilgilenecke kimseye denk gelmedim(zaten kaç kişiyiz şurda), ya da kütüphane aslında iyi durumda.

Toplamda 291 satır. Mustache sayfasından diğer diller ile yapılmış implementasyonlar ile karşılaştırdığınızda gayet iyi olduğunu görebilirsiniz. Kodun küçük olması çok birşey ifade etmiyor olabilir tabii ama bir dilde binlerce satırda yaptığınız bir işi başka bir dilde 300 satırda yapabiliyorsanız, benim gözümde bu dil ifade gücü açısından daha güçlüdür(ya da diğer dil çok kötü hehe). En azından gündüz enterprise ortamında Java, gece Common Lisp yazan biri olarak ben böyle düşünüyorum hehe.

Neyse, kodda hala TODO yorumları duruyor. Düzenlenecek birkaç yer var. Onun dışında iyi bir durumda olduğunu düşünüyorum. Şu anda performans olarak aklımdaki bir iyileştirme şu:

Input stream'den girdiyi satır satır okuyorum ve okuduğum her satırı tokenlere ayırıp bir listeye kaydediyorum. Daha sonra renderer JSON verisini alıp gerekli etiketleri gerekli veriyle değiştiriyor.

Burda aslında tüm template'i tokenlara ayırıp bir listeye kaydetmek yerine, Common Lisp'de listeleri bir şekilde lazy bir şekilde oluşturabilseydim, kodda birkaç kelimelik değişiklik yaparak, hesaplamayı(yani tokenlere ayırma işlemini) render edilmiş metni okumanın gerektiği ana kadar erteleyebilirdim ve tüm tokenları bellekte tutmama gerek kalmazdı, sadece okumak istediğim yeri bellekte tutmuş olurdum.

Clojure bu açında iyi mesela. Lazy bir dil değil aslında ama listeleri lazy bir şekilde oluşturabiliyoruz lazy-seq ile. Tam olarak benim ihtiyacım olan şey.

Aslında Common Lisp gibi okuyucusunun(Lisp konseptini yapancı olanlar için, derleyicinin bir kısmı diyebiliriz sanırım) kolayca değiştirilebildiği bir dilde bu çok zor bir olay değil. Hatta aslında Lisp'in temelini düşündüğünüzde, sadece CONS, CAR ve CDRı lazy bir hale getirdiğinizde tüm listelerin lazy olmasını bekleyebilirsiniz(bekleyebilirsiniz diyorum çünkü muhtemelen bugün aktif olarak kullanılan Common Lisp implementasyonlarında tüm listeler CONS ile üretilmiyordur, performans vb. sebeplerden). Ama tabii böyle bir proje için bu tarz macrolar falan bana biraz abartı geldi, kodda da ciddi değişiklikler yapmak istemiyorum şu anda. Bir yolunu bulacağım artık.

Öyle işte, forklarınızı veya en azından yorumlarınızı bekliyorum(buralarda pek Lisper yok ama olsun ben şansımı deneyeyim hehe).

Binary dosyaları okumak için basit bir DSL

31-1-2012, 8:55 ö.s. // yorum // lisp

Hiçbir motivasyonum olmaksızın Common Lisp ile uğraştığım şu günlerde(şu ana kadar kullandığım diller arasında bariz bir şekilde kullanması en zevkli olanı, bu konu hakkında bir yazı yazdım birkaç düzenlemeye hazır olur), staj projem için yaptığım çalışmalar sırasında öğrendiğim bazı şeyleri Common Lisp ile uyguluyorum. Bunlardan birisi de JVM yapısı. Common Lisp ile basit bir JVM işine giriştim. Şimdilik epey iyi gidiyorum, amacım birkaç JVM komutu(instructuion, opcode, artık ne derseniz) çalıştırabilen bir altyapı. Tüm native kütüphaneleriyle beraber Java programlarını çalıştırabilecek bir JVM yapmıyorum tabii ki.

İlk adım olarak bir Java class dosyasını okuyup, istediğim kısımlarına kolayla ulaşabileceğim bir şekilde yüklemekti. class dosyalarının yapısını şuradan inceleyebilirsiniz.

Bunu yaparken bazı kod parçalarının çok tekrar ettiğini farkettim, örneğin n byte'lık bir kısmı, bir sonraki kısımdan(bu 1 byte'lık bir veri de olabilir, tamamen farklı bir yapı da olabilir, örneğin bir interface referansı) kaç tane olduğunu bilmek için okumak. Şu şekilde birşeyler yani:

(let* ((constant-count (read-bytes 2 stream))
       (constants (make-array constant-count)))
  (loop for i from 0 to (1- constant-count) do
    (setf (elt constants i) (read-constant stream))))

Burda yaptığım, 2 byte okuyarak constant pool'da kaç tane sabit olduğunu öğrenmek. Buna göre kaç byte daha okuyacağıma karar vereceğim çünkü.

Tabii bir de class dosyasının istediğim kısımlarına kolayca ulaşabilmek için dosyayı farklı parçaları için structlara bölmem gerekti. Bir yerden sonra her bir struct için farklı bir okuma fonksiyonu oluşturmuştum. Ve bu okuma fonksiyonlarında da bir sürü ortak kısım vardı. Bir DSL'e çevirmeye karar verdim.

Aslında DSL ile API'ın arasındaki fark tam belli değil. Benim DSL'den kastettiğim arayüzü sunarken kendisine özel bir syntax ile sunmak. Bu yaptığım biraz da yeni birşey öğrenince hemen uygulamaya çalışma merakı aslında.

Önce nasıl kullanıldığını göstereyim, sonra macrolardan bahsedeceğim. Tüm kodu görmek isteyenler için, şu class dosyasını ayrıştıran kod, şu da DSL macroları. Tüm class dosyasını tanımladığım yapı şöyle birşey:

(defbinstruct class-file
  (magic 4)
  (minor-version 2)
  (major-version 2)
  (constant-pool (:struct constant-pool))
  (access-flags 2)
  (this-class 2)
  (super-class 2)
  (:temp (interfaces-count 2))
  (interfaces (:list 2 interfaces-count))
  (:temp (fields-count 2))
  (fields (:list (:struct field) fields-count))
  (:temp (jmethods-count 2))
  (methods (:list (:struct jmethod) jmethods-count))
  (:temp (attributes-count 2))
  (attributes (:list (:struct attribute) attributes-count)))

Tanımın yukarıda linkini verdiğim class dosyası yapısına ne kadar benzediğine dikkat edin. Şöyle çalışıyor, her defbinstruct için bir struct oluşturuluyor, içindeki her bir liste için gerekiyorsa(:temp olup olmadığına göre) struct'a slot ekleniyor. :temp değişkenler farklı amaçlar için gerekebilir. Örneğin dosyadaki boşluklar(padding diye geçer genelde) için, veya dosyada bir yapıdan kaç tane olduğunu okumanız gerektiğinde, ama bu değeri okuduyup oluşturduğunuz yapıya dahil etmek istemiyorsanız. Her bir defbinstruct için bir de okuma fonksiyonu oluşturuluyor, yapının adına "read" eklenerek(burdaki örnek için read-class-file yani).

Değişken isminden sonra gelen kısım eğer tamsayı ise, o tamsayı kadar byte okunup bu slota atanıyor, eğer (:list a b) veya (:vector a b) şeklinde birşeyse, adan b kere okunup, liste veya vector olarak atanıyor. Eğer tamsayı kısmına (:struct a) gibi birşey gelmişse, anın bir defbinstruct ile oluşturulmuş yapı olması gerekiyor(yani read-a diye bir fonksiyon olmalı). Bu tanımlamaların recursive bir formda olabileceğine dikkat. Şöyle birşey olabilir mesela: (field-1 (:list (:list (:struct sub-field) sub-field-count) field-count)).

Dönüş değeri de tanımladığınız yapıdan oluşturulmuş bir struct. Örnekteki kodda class-file-interfaces ile interfaces alanına ulaşabilirsiniz mesela.

Okunan değerlere göre daha kompleks işler yapmanız gerektiğinde :custom keywordu ile read fonksiyonunu kendiniz tanımlayabilirsiniz. :custom keywordunden sonraki kısım da yapıda olacak slotların listesi. Örneğin constant-poolu okumak biraz daha zor(mesela double ve long sabitler constant-pool'da 2 slot kaplıyor), şöyle:

(defbinstruct constant-pool
  :custom
  (constants)
  (let* ((constant-pool-count (1- (read-bytes 2 stream)))
         (constants (make-array constant-pool-count)))
    (loop for i from 0 to (1- constant-pool-count) do
      (let ((tag (read-bytes 1 stream)))
        (if (or (= tag 5) (= tag 6))
            (let ((constant (if (= tag 5)
                                (read-jlong stream)
                                (read-jdouble stream))))
              (setf (elt constants i) constant
                    (elt constants (1+ i)) constant)
              (incf i))
            (setf (elt constants i)
                  (funcall
                   (case tag
                     (1 #'read-utf-8)
                     (8 #'read-string-ref)
                     (3 #'read-jinteger)
                     (4 #'read-jfloat)
                     (7 #'read-class-ref)
                     (9 #'read-field-ref)
                     (10 #'read-method-ref)
                     (11 #'read-interface-method-ref)
                     (12 #'read-descriptor))
                   stream)))))
    (make-constant-pool :constants constants)))

Bu tanımladığımız read fonksiyonuna stream diye bir parametre aktarıldığını varsayıyoruz(macro tarafından oluşturulmuş kodda aktarılıyor). Burda aslında stream yerine lexical scope ile *standard-input*a bu stream atanabilir. Yine de çaktırmadan *standard-input* ile oynamak bana çok iyi bir yolmuş gibi gelmedi.

Bir başka örnek olarak da yine constant-pooldaki string sabitlerini nasıl okuduğumu göstereyim:

(defbinstruct utf-8
  (:temp (length 2))
  (value (:vector 1 length)))

İlk 2 byte, string'in uzunluğunu veriyor. Daha sonra bu uzunluk kadar 1 byte okuyup bir vector olarak kaydediyorum.

Şimdi macrolara bakalım. İlk önce defbinstruct kodundaki keywordleri(:vector, :list, :struct) recursive olarak silip yerine gerekli Lisp kodunu ekleyen remove-keywords macrosu:

(defmacro remove-keywords (form)
  (cond ((null form) '())
        ((integerp form)
         `(read-bytes ,form stream))
        ((and (consp form) (keywordp (first form)))
         (case (first form)
           ((:list)
            `(loop for s from 0 to (1- ,(third form))
                   collect (remove-keywords ,(second form))))
           ((:vector)
            `(coerce (loop for s from 0 to (1- ,(third form))
                           collect (remove-keywords ,(second form)))
                     'vector))
           ((:struct)
            `(,(intern (concatenate 'string "READ-" (string (second form)))) stream))))
        (t form)))

Yaptığı şey çok basit, her :struct keywordu gördüğü yere (read-x) fonksiyonunu ekliyor, :list veya :vector gördüğü yerde de gereken loop kodunu. İkinci olarak olarak defbinstruct:

(defmacro defbinstruct (name &body attributes)
  (labels ((make-reader-name (name-symbol)
             (intern (concatenate 'string "READ-" (string name-symbol)))))
    (if (and (keywordp (first attributes))
             (eql (first attributes) :custom))
        (let ((attributes (second attributes))
              (body (cddr attributes)))
          `(progn
             (defstruct ,name
               ,@attributes)

             (defun ,(make-reader-name name) (stream)
               ,@body)))
        (let ((attr-struct-names (remove-if-not #'identity
                                                (mapcar (lambda (attr)
                                                          (unless (keywordp (first attr))
                                                            (first attr)))
                                                        attributes))))
          `(progn
             (defstruct ,name
               ,@attr-struct-names)

             (defun ,(make-reader-name name) (stream)
               (let* (,@(mapcar (lambda (attr)
                                  (destructuring-bind (attr-name . bytes)
                                      (if (keywordp (first attr))
                                          (cons (caadr attr) (cadadr attr))
                                          (cons (first attr) (second attr)))
                                    `(,attr-name ,(if (integerp bytes)
                                                      `(read-bytes ,bytes stream)
                                                      `(remove-keywords ,bytes)))))
                                attributes))

                 (,(intern (concatenate 'string "MAKE-" (string name)))
                  ,@(mapcan (lambda (name) (list (intern (string name) "KEYWORD") name))
                            attr-struct-names)))))))))

Burda da defbinstruct altındaki listeleri gezip, oluşturulacak olan structa gerekli slotları ekliyorum ve read fonksiyonunu oluşturuyorum. Her bir defbinstruct için bir struct bir de fonksiyon tanımlıyorum yani.

Kütüphane toplam 52 satır. İkinci bir örnek olarak da ID3 etiketlerini okuyacaktım ama çok kompleks geldi. Dikkat edilmesi gereken çok fazla istisna var. Aklıma daha basit bir örnek gelirse ekleyeceğim(ara ara kütüphaneyi de güncelliyorum, gistlerden takip edebilirsiniz).

Common Lisp için Clojure usulü multimethodlar

8-1-2012, 1:32 ö.s. // yorum // lisp

Bir önceki yazımda biraz bahsetmiştim Clojure ve Common Lisp multimethodları arasındaki farklardan. Bugün Common Lisp için olabilecek en basit Clojure usulü multimethod implementasyonu yaptım. 2 macro ve toplamda 14 satır sürdü. Örnek olarak Joy of Clojure kitabındaki bir kod parçasını Common Lisp ile yazacağım. Clojure hali şöyle:

(defmulti compiler :os)
(defmethod compiler ::unix [m] (get m :c-compiler))
(defmethod compiler ::osx  [m] (get m :c-compiler))

Burda yapılan şey şu, compiler adlı bir multimethod oluşturuluyor ve dispatch fonksiyonunu seçmek için kullanılacak fonksiyon olarak :os keywordu olarak belirleniyor[1]. Daha sonra iki tane method tanımlanıyor, ilkinde test fonksiyonumuz(yani :os fonksiyonu) :unix keywordünü dönerse çalıştırılacak fonksiyon, ikincisinde de :osx keywordünü dönerse çalıştırılacak fonksiyonu belirleniyor. Test fonksiyonuna da m parametresinin aktarıldığına dikkat. Yani m önce test fonksiyonu tarafından kullanılıyor, sonra da dönüş değerine göre dispatch fonksiyonlarından biri tarafından.

Kullanımı şöyle:

(def unix {:os ::unix, :c-compiler "cc"})
(def osx  {:os ::osx,  :c-compiler "gcc"})

(compiler unix)
=> "cc"
(compiler osx)
=> "gcc"

multimethodların test fonksiyonunu ve bunun dönüş değerlerine karşılık gelen dispatch fonksiyonlarını tutmaları lazım. dönüş değeri-dispatch fonksiyonu ikililerini bir hash-table'da tuttum. Her bir multimethod için 2 tane closure oluşturdum, bir tanesi yeni methodlar eklemek istediğimizde çağırılık dönüş değeri-dispatch fonksiyonları ikililerini tutan hash-table'ı güncelleyecek, diğeri de testi yapıp hash-table'dan fonksiyonu çekip çağıracak.

(defmacro defmulti (name (&rest args) dispatch-fn)
  (let ((dispatch-table (gensym)))
    `(let ((,dispatch-table (make-hash-table :test #'equal)))
       (defun ,name (,@args)
         (funcall (gethash (funcall ,dispatch-fn ,@args) ,dispatch-table)
                  ,@args))
       (defun ,(intern (concatenate 'string (string name) "-ADD-METHOD"))
           (dispatch-fn-return-val method)
         (setf (gethash dispatch-fn-return-val ,dispatch-table) method)))))

Görüldüğü gibi multimethodlar aslında normal fonksiyonlar(aslında closure, dispatch-tableı tutuyor). Bu sayede herhangi bir fonksiyona aktarılabilirler. Özel bir yapı yok yani ortada. Bir de aslında çaktırmadan tanımladığımız multimethod'a -add-method eki getirerek bir fonksiyon daha oluşturuyoyruz. Bunu kullanıcının çağırmasına hiç gerek yok, sadece yeni method ekleme işlemini kolaylaştırmak için.

(defmacro defmulmethod (name dispatch-fn-return-val method)
  `(,(intern (concatenate 'string (string name) "-ADD-METHOD"))
    ,dispatch-fn-return-val
    ,method))

defmethod adı Common Lisp'e ait olduğundan adını defmulmethod yaptım. Önceki macroda oluşturulan -add-method fonksiyonu yardımıyla dispatch-tablea yeni fonksiyonu ekliyor. Bundan sonra aynı örneği Common Lisp ile şöyle yapabiliriz.

(defmulti compiler (x) (lambda (x) (gethash :os x)))
(defmulmethod compiler :unix (lambda (x) (gethash :c-compiler x)))
(defmulmethod compiler :osx (lambda (x) (gethash :c-compiler x)))

(setf unix (make-hash-table))
(setf (gethash :os unix) :unix)
(setf (gethash :c-compiler unix) :cc)

(setf osx (make-hash-table))
(setf (gethash :os osx) :osx)
(setf (gethash :c-compiler osx) :gcc)

CL-USER> (compiler unix)
:CC

CL-USER> (compiler osx)
:GCC

Common Lisp halinin çok daha uzun olmasının birkaç sebebi var: Birincisi, Common Lisp hash-tablelarının başlangıç değerlerini belirlemenin bir yolu yok. hash-table'ların özel bir syntax'ı da yok. make-hash-table ile oluşturup teker teker elemanları koymamız gerekiyor. İkincisi, [1]. notta yazdığım şey.


[1]: Clojure hakkında sevdiğim bir özellik, keywordler aynı zamanda fonksiyon, çağırıldıklarında parametre olarak bir map alıyorlar ve anahtar görevi görerek değeri dönüyorlar.

Common Lisp ile IRC botu ve web arayüzü

6-1-2012, 3:11 ö.s. // yorum // lisp

Tamamen Common Lisp ile basit bir IRC botu ve web arayüzünün nasıl yazılabileceğinden bahsedeceğim biraz. Web kısmında web server dahil herşey yine Common Lisp ile yazılmış olacak.

http://osa1.net/media/made-with-lisp-logo.jpg

Gistler: arayüz bot

Öncelikle botun ne yapacağına karar verelim, benim amacım çalışan en minimal botu yazmak. Daha sonra üzerine istediğimiz özelliği ekleyebiliriz. Bu yüzden şimdilik sadece bağlandığı kanalları ve kendisine atılan özel mesajları kaydedip, bir web sayfasında yayınlayacak.

http://osa1.net/media/bot-web-ui.png

Öncelikle IRC sunucusuna bağlanabilmemiz için bir socket kütüphanesine ihtiyacımız var(evet Common Lisp standardı socket içermiyor). Bu iş için usocket'i seçtim(uğraşacak olan varsa bir diğer alternatif de iolib, fakat ikisi için de işe yarar dökümantasyon yok dolayısıyla her türlü yolumuzu kendimiz bulmamız gerek).

Programımızın ana döngüsü gayet basit:

(defun run ()
  (let* ((socket (socket-connect "irc.freenode.org" 8001))
         (socket-stream (socket-stream socket))
         (start-time (get-universal-time)))
    (loop
      (let ((msg (read-line socket-stream)))
        (format t "~A~%" msg) ;; debug ve gozetleme amacli
        (multiple-value-bind (prefix command params) (parse-msg msg)
          (handle-command prefix (intern (string-upcase command)) params socket-stream)))
      (let ((time-passed (- (get-universal-time) start-time)))
        (when (> time-passed (* 1 30))
          (update-html)
          (setf start-time (get-universal-time)))))))

Bir socket oluşturup Freenode sunucularına bağlanıyoruz. Socket'e yazma ve socket'den okuma işlemlerini socket'in stream'ine yapacağız[1]. read-line ile sunucudan her seferinde bir tam satır okuyoruz ve parse-msga gönderiyoruz. parse-msg gelen mesajı IRC RFC'de belirtilen mesaj formatında göre prefix, command ve params olarak 3 parçaya bölüyor ve Common Lisp'in values özel formu ile bunları dönüyor[2]. Daha sonra bu parçaları handle-command generic fonksiyonuna gönderiyoruz. handle-command command parametresine göre gerekli dispatch fonksiyonunu çağırıyor[3]. Daha basit olamazdı. Son olarak yeterli vakit geçtiyse(ben 30 saniyede bir güncelliyordum sık sık debug ile uğraştığımdan), static html sayfalarını güncelleyecek olan update-htmli çağırıyoruz. Burda zamanı çok da düzgün tutmadığımıza dikkat. Eğer socket'den 10 dakika yanıt gelmezse 30 saniyede bir de güncelliyor olsak 10 dakika beklemek zorundayız[4].

Mesajları parçalara ayıran fonksiyonumuz şöyle:

(defun parse-msg (msg)
  "Parse irc message to prefix, command and params.
http://www.irchelp.org/irchelp/rfc/chapter2.html#c2_3_1
<message> ::=
    [':' <prefix> <SPACE> ] <command> <params> <crlf>
<prefix> ::=
    <servername> | <nick> [ '!' <user> ] [ '@' <host> ]
<command> ::=
    <letter> { <letter> } | <number> <number> <number>
<params> ::=
    <SPACE> [ ':' <trailing> | <middle> <params> ]
"
  (let* ((first-space (position #\space msg))
         (first (subseq msg 0 first-space))
         (rest (subseq msg (1+ first-space)))
         (prefix (if (eq (elt first 0) #\:)
                     (subseq first 1)
                     nil))
         (second-space (position #\space rest)))
    (if prefix
        (let ((command (subseq rest 0 second-space))
              (params (subseq rest (1+ second-space))))
          (values prefix command params))
        (let ((command (subseq first 0 first-space))
              (params rest))
          (values nil command params)))))

Ben burda ciddi bir şekilde parse etmektense, önek, komut ve parametreleri birbirlerinden ayıran boşluklar olduğunu farkettim ve basitçe bu boşluklara göre ayırdım. Saatlerdir log tutuyor henüz bir problem yaşamadım.

Mesajları parçaladıktan sonra şu generic fonksiyona gönderiyoruz:

(defgeneric handle-command (prefix command params socket-stream))

Bu fonksiyonu çağırırken command parametresinin her zaman bir sembol olması lazım. Başka türlü command parametresine göre dispatch fonksiyonuna karar veremiyoruz[5]. Ana döngüde string'i sembole çevirdiğim hacky kısım bu yüzden.

Şu aşamada ilgimizi çeken 3 komut var. PRIVMSG, NOTICE, ve PING. PING komutunu sunucu bize, uzun süre yanıt vermediğimiz için gönderecek(sürekli dinlemede olacağımızdan) ve hemen PONG cevabını vermemiz lazım. PRIVMSG herhangi bir kanala veya bize bir mesaj gönderildiğinde gelecek. NOTICEde ne zaman login olmak için komut göndermemiz gerektiğine karar vermemiz için. Burda en kritik olanı PRIVMSG, diğerlerine gist'den bakabilirsiniz:

(defmethod handle-command (prefix (command (eql 'privmsg)) params socket-stream)
  (let ((channel-or-nick (subseq params 0 (position #\space params)))
        (sender (subseq prefix 0 (position #\! prefix)))
        (msg (subseq params (+ 2 (position #\space params)))))
    (multiple-value-bind (channel-message-queue channel-exists)
        (gethash channel-or-nick *channels*)
      (unless channel-exists
        (setf (gethash channel-or-nick *channels*) '()))
      (setf (gethash channel-or-nick *channels*)
            (cons (make-message :msg msg
                                :sender sender) channel-message-queue)))))

*channels*, tüm kanallar için bir liste tuttuğumuz hash tablomuz. Burda static web sayfalarını güncelleme vaktimiz gelene kadar gelen mesajları tutuyoruz(gelen mesajı yine IRC RFC'nin şu bölümüne göre parçalıyorum). Mesajları tuttuğumuz yapımız basitçe sadece mesajın içeriğini ve göndereni tutuyor:

(defstruct message msg sender)

Son olarak static sayfaları güncellemek için çağırdığımız update-html:

(defun update-html ()
  (loop for channel-or-nick being the hash-keys of *channels* do
    (let ((msgs (reverse (gethash channel-or-nick *channels*))))
      (with-open-file (file-stream (concat "/home/sinan/Desktop/cl/logs/"
                                           (if (equal #\# (elt channel-or-nick 0))
                                               (subseq channel-or-nick 1)
                                               "direct-messages")
                                           ".html") ;; remove # from channel name
                                   :direction :output
                                   :if-exists :append
                                   :if-does-not-exist :create)
        (with-html-output (file-stream)
          (dolist (msg msgs)
            (let ((message-text (concat (message-sender msg)
                                        "> "
                                        (message-msg msg))))
              (htm (:p :class "msg" (str message-text)))))))
      (setf (gethash channel-or-nick *channels*) '()))))

Burda html çıktısını üretmek için cl-who kütüphanesini kullanıyoruz[6]. with-open-file ile kanal adına ait dosyayı açıp(yoksa oluşturup, varsa sonuna ekleyerek) with-html-output ile html elementlerini Lisp formları ve keywordler ile yazarak html kodunu dosyaya yazıyoruz ve hash tablomuzdaki mesaj listesini boşaltıyoruz(henüz tüm sayfayı oluşturmuyoruz, sadece mesajları html formatında kaydettik).

Şu anda sunucuda istediğiniz kanalları dinleyip kaydeden bir botumuz var(kod hakkında eksik olan birkaç tanımlama için en başta verdiğim gistlere bakabilirsiniz).

İkinci adım olarak web arayüzü. Static sayfaları sunmak için Hunchentoot kullanacağız. Bu gibi basit işler için inanılmaz rahat bir kütüphane.

(defvar server (make-instance 'easy-acceptor :port 4242
                                             :document-root "/home/sinan/Desktop/cl/static"))
(start server)

Hunchentoot ile 4242. portu dinleyen bir sunucu oluşturduk ve başlattık. document-root, static dosyaların(css dosyaları, resimler vs.) tutulduğu klasör. Hunchentoot sayfa yönlendirmelerini *dispatch-table* listesinden yapıyor. Yönlendirme işlemi birkaç farklı dispatcher ile yapılabiliyor ama biz şu anki basit sayfamız için sadece kanal adlarını yönlendirmekle ilgileneceğiz. Bu yüzden kullanacağımız dispatcher prefix-dispatcher olacak.

(defmacro define-url-fn ((name) &body body)
  `(progn
     (defun ,name ()
       ,@body)
     (push (create-prefix-dispatcher ,(format nil "/~(~a~).html" name) ',name) *dispatch-table*)))

Genel olarak sayfa oluşturma yapımız bu. (define-url-fn (sayfa-adi) icerik) şeklinde çağırdığımızda, localhost:4242/sayfa-adi adresinde iceriki gösterek şekilde ayarlıyor. Bu kadar basit. Şimdi sayfa içeriğimizi oluşturmadan önce her sayfada olacak kısımları ayıralım:

(defmacro standard-page ((&key title) &body body)
  `(with-html-output-to-string (*standard-output* nil :prologue t :indent t)
     (:html
      (:meta :charset "utf-8")
      (:head
       (:title ,title)
       (:link :type "text/css"
              :rel "stylesheet"
              :href "/static/reset.css")
       (:link :type "text/css"
              :rel "stylesheet"
              :href "/static/main.css"))
      (:body
       (:div :class "main"
             ,@body)))))

Bu şekilde sadece bir sayfayı diğer sayfadan ayıracak kısımlarla ilgileneceğiz ve standard-page macrosuna göndereceğiz. Web arayüzümüz tamamen ayrı bir program olduğundan, önce logların tutulduğu klasöre bakıp kanal listesini çıkaralım:

(defun list-file-names (&optional (folder *log-folder*))
  (mapcar (lambda (pathname)
            (let ((filename (file-namestring pathname)))
              (pathname-name filename)))
          (directory (make-pathname :directory folder :name :wild :type "html"))))

Burda yapılan bariz gibi. Bir klasördeki html dosyalarının adlarını listeliyoruz. Bu kadar. Bu aşamadan sonra ana menü(kanal listesinin bulunduğu) ve kanal loglarının görüntüleneceği sayfaları oluşturmak kalıyor.

;; ana menu
(define-url-fn (log-list)
  (standard-page (:title "log list")
    (:div :class "header" "Channel List:")
    (loop for log in (list-file-names)
          collect (htm (:div :class "menulink"
                             (:a :href (concat log ".html") (str log)))))))

Kanal log sayfalarını oluşturmak biraz zor oldu ve aslında yukarıda hazırladığım hiçbir macroyu kullanmadım. Benim gibi herhangi bir Lisp diline yeni başlayanlara bir not(gerçi Scheme macroları epey farklıymış, pattern matching yapabiliyorlarmış ve hijyeniklermiş): Bir macroya parametre olarak macro alan bir macro gönderiyorsanız ve macrolara tam olarak hakim değilseniz, debug etmek yerine elle yazmak daha pratik olabilir ehehe:

;; kanal loglari
(dolist (page-name (list-file-names))
  (let* ((in (open (merge-pathnames *log-folder*
                                    (make-pathname :name page-name
                                                   :type "html"))))
         (text (car (loop for line = (read-line in nil)
                          while line collect line))))
    (push
     (create-prefix-dispatcher
      (concat "/" page-name ".html")
      (lambda ()
        (standard-page (:title "Channel logs")
          (:div :class "header" (str (concat "Chat logs for #" page-name)))
          (str text))))
     *dispatch-table*)))

Ve bu kadar. Bot + web arayüzü toplamda 207 satır. Yorumlar dahil.

Eklenebilecekler:

  • Common Lisp HyperSpec Lookup: Kendisine atılan bir mesajla CLHS'den istenilen sembolle alakalı döküman linkini getirebilir.
  • Link başlıkları: Kanala atılan linklere girip başlığı kanala yazabilir.
  • Çok sorulan sorular için cevaplar: Yetki verilen bazı kullanıcılar belirli komutlar için yazılacak cevabı belirleyebilir. Birisi bir soru sorduğunda bota ona istenilen cevabı vermesi söylenebilir.
  • Hata/durum(exception/condition) kontrolü. Bağlantı bir şekilde kesildiğinde yeniden bağlanabilir vs.

[1]: Common Lisp'in bir güzel yanı, lexical scope veya direkt olarak parametre olarak aktararak, kullanıcıya yazdırıp kullanıcıdan okuduğumuz fonksiyonların hepsini dosya, socket vs. için çok rahat kullanabiliyoruz

[2]: Common Lisp'de bir fonksiyon birden fazla değer dönebiliyor, epey ilginç bir özellik, gerekliliği tartışılır tabii, sonuçta bir tuple/list/vs. dönmekten pek bir farkı yok, yanlızca eğer özel olarak belirtilmezse çağırana sadece otomatik olarak ilk değer dönüyor böylece her fonkisyon için "acaba kaç değer dönüyor?" diye düşünmüyoruz.

[3]: Burada Clojure'dan bahsetmem lazım. Clojure multimethod'ları isteğe bağlı dispatch fonksiyonları ile çalışıyorken Common Lisp bu konuda daha kısıtlı. Clojure multimethodları hakkında şuraya bakabilirsiniz. Pascal usta buna benzer bir yapıyı Common Lisp için implement etmiş. Şurda biryerlerdeydi ama bulamadım şimdi.

[4]: Socket'ler konusunda çok bilgili değilim. usocket ve iolib kütüphaneleri direkt olarak unix socketlerini(posix socketleri mi oluyor?) implement etmişler, api olarak çok benzerler. Yine de ben non-blocking io yapmayı bir türlü beceremedim. Thread'lerden de bir süredir nefret ediyorum. Common Lisp'de çok kullanılan Bordeaux Threads kütüphanesinde(Common Lisp standardının thread de içermediğini söylemiş miydim?) de timer yok.

[5]: Common Lisp'in karşılaştırmayı eql fonksiyoinu ile yapmasıyla alakalı. Daha önce bahsettiğim kısıtlama.

[6]: Lisp dillerinin bir başka güzel yanı: kendi syntaxları ile kolaylıkla herhangi bir markup dilini ifade edebilirsiniz(şansınızı zorlarsanız JavaScript'i bile ifade edebilirsiniz ama bana delilik gibi geliyor açıkçası, bkz. parenscript).

ctpop ve bitmapler

31-12-2011, 10:38 ö.ö. // yorum // python , java , lisp

Bugün çok fantastik birşey gördüm, anlatmazsam ölürüm(uygun bir başlık düşünmem tüm yazıyı yazmamdan daha uzun sürdü o yüzden idare edin hehe).

Diyelim ki bir veri yapısı tasarlıyoruz, bir nodedan bir sürü başka nodea veya elemana pointerlar olacak. Bir yandan da bellek kullanımını minimum tutmak istiyoruz. Pointerları tutan arrayimizde hiç boş yer olmamalı.

Bir bitmap tutuyoruz. Büyük ihtimalle integer oluyor(Java primitive int tipi 32bit olmak zorunda mesela). Diyelim ki bu node'un n. indexine bir eleman/pointer ekleyeceksiniz. Bitmap ilk başta 0 tabii. Şu şekilde bitmap'de ilgili elemanı 1 yapıyoruz:

bmp = bmp | 1 << n

Buraya kadar herşey çok basit. Bu noktadan sonra bu bitmape göre 30. elemanın arrayde nereye denk geldiğini bulmamız lazım. Bunun için şu formülü kullanıyoruz:

ctpop(bmp & ((1<<n)-1))

ctpop, population count fonksiyonu, yani bir sayının iki tabanında gösterilişindeki 1 bitleri sayıyor. Bu Java'da Integer.bitCount fonksiyonu(öhm, static methodu) ile bulunabilir.

Birkaç deneme yaparak nasıl yaptığını anlayabilir ve kendimizi ikna edebiliriz:

In [2]: bmp = 0

In [3]: bmp |= 1 << 15

In [4]: ctpop(bmp & ((1<<15)-1))
Out[4]: 0

In [5]: bmp |= 1 << 21

In [6]: bmp |= 1 << 10

In [7]: ctpop(bmp & ((1<<10)-1))
Out[7]: 0

In [8]: ctpop(bmp & ((1<<15)-1))
Out[8]: 1

In [9]: ctpop(bmp & ((1<<21)-1))
Out[9]: 2

Eğer arraydeki n. yere bir eleman ekliyorsak, n'den itibaren arrayi bir kaydırmamız lazım. En büyük index her zaman arrayde de daha sonda oluyor.

Ne yaptığına bakalım. 25. elemanın arraydeki yerine bakarken, 1 << 25i hesaplıyorum ki bu aslında (2 tabanında) 1 ve yanına 25 tane 0 koymak demek. Daha sonra bu sayıdan 1 çıkararak, en sağdan itibaren(en anlamsız bitten itibaren) tüm 0ları 1 yapıyorum, ilk gördüğüm 1'i 0 yapıyorum, gerisine dokunmuyorum(bu şartlar altında geriye kalan tüm bitler 0 oluyor). Daha sonra bu sayı ile bitmap'i logical and(bazı yerlerde bitwise and diyor, aynı şeyler sanırım?) işlemine sokup ctpop yaptığımda, bitmap'de (1 << n)'den itibaren kaç tane 1 olduğunu saymış oluyorum ve bu da bana array'deki indeximi veriyor. Çok mantıklı.

Bu arada kullandığınız dile göre bu işlemi daha kolay bir şekilde yapabilirsiniz. Bazı diller(Java'da Integer.bitcount, Common Lisp'de logcount gibi) direkt olarak bitCount gibi fonksiyonlar sunuyor. Bir de ben Common Lisp'de hiç kaydır 1 çıkart falan demeden direkt "şu bitle şu bit arasında kaç 1 olduğunu say" şeklinde bir fonksiyon yazdım, bitwise trickler yapmadan, şöyle:

(defun ctpop (bitmap &key (start 0) (end 32))
  (logcount (ldb (byte (- end start) start) bitmap)))
0 , 1 , 2