Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2009-08-29

XCLでSBCLをビルドしよう!

| 21:00 | XCLでSBCLをビルドしよう! - わだばLisperになる を含むブックマーク はてなブックマーク - XCLでSBCLをビルドしよう! - わだばLisperになる

XCL (by Peter Graves) now publicly available.(And complies enough to ANSI to build SBCL and run CL-PPCRE). : lisp

によるとXCLでSBCLがビルドできるようになったようです。

XCLでSBCLがビルドできる(ようになる)らしいというのは、以前に

404 - Page not found

を観ていてなんとなく知っていたのですが、なんの苦労もなしに試せるらしいので早速試してみました。

XCLをビルド

Armed Bear

にリンクがあるのでここからダウンロードします。

対応しているプラットフォームならuntarしてmakeで終了です。

SBCLをXCLでビルド

SBCLのソースをuntarしてXCLの実行ファイルを指定してXCLでビルドさせます。

sh make.sh "/usr/local/xcl/0.0.0.274/x/x"

のような感じ。

結果

XCL 0.0.0.274
//build started:  Sat Aug 29 18:15:27 JST 2009
//build finished: Sat Aug 29 19:10:36 JST 2009
SBCL 1.0.16
//build started:  Sat Aug 29 19:50:56 JST 2009
//build finished: Sat Aug 29 19:58:06 JST 2009

XCLだと 55分、SBCLだと、8分ということになりました。

頑張れXCL!

しかし、ビルドにつかう処理系でビルドの時間って結構変わるんですね。

今迄、知りませんでした。

2009-08-26

第6回Smiley Hackathon(仮)に参加してきました!

| 23:07 | 第6回Smiley Hackathon(仮)に参加してきました! - わだばLisperになる を含むブックマーク はてなブックマーク - 第6回Smiley Hackathon(仮)に参加してきました! - わだばLisperになる

先日の8/22(土)にSmiley Hackathon(仮)またまた参加させて頂きました。

今回も主催の d:id:acotie さん 会場提供のドワンゴさんありがとうございます。

やってたこと

今回は、Ruby on RailsならぬLisp on Linesをインストールしてみて、できたら何か簡単なものを作れたら良いなあと思っていたのですが、大体1.5〜2時間費したものの関連してインストールするパッケージがインストールできなかったり、インストールされても上手く動いてるのかどうか良く分からないという感じでつまづきまくり、起動さえできませんでした。

この辺り(404 Not Found)を参照しつつの挑戦だったのですが、どなたか挑戦してみませんか!

clbuildだと簡単らしいのですが…[clbuild-devel] UCW and LISP-ON-LINES

ということでLoLには挫折してしまったので、職場のエンジニア用のウェブページをAllegroServeからHunchentootに置き換える作業をしてみていました。

AllegroServeも良いのですが、(SBCLの場合)Hunchentootの方が素直に日本語を使えたりして楽そうなので、Hunchentootにしたらどうかと思い…。しかし、これもそんなに簡単ではなさそうです…。

どうして職場のエンジニア用のウェブページがCLなのかというと、CLで書いたらlisp好きの人が求人に応募して来たりするかなという発想だったのですが、今のところLisper/Lisp好きの方には応募してもらえてないようです。時給が安いのが厳しいのかもしれませんw。もし職場にLisp好きが来たら自分もできるうる限り書けるものはLispで書く努力をしたいと思いますw

ちなみにこちらで求人しています→モテカワ愛されスイーツ系エンジニア/デザイナー募集 - komagataのブログ & アクトインディ開発者ブログ

いろいろ

  • 今回WEB+DB Pressの最新号のVim特集[]を書いたVim神のkanaさんが参加されるということで、サインを貰うため最新号を買って行きサインを貰いました!
  • 懇親会では、ドワンゴの方にドワンゴ社の自由な社風について伺いました。ドワンゴ凄い!、素晴らしい!

マクロの使い方を筆頭に大分駄目なコード/構成で恥しいんですが、とりあえず、適当に作業途中のコードを貼ってみます。

なんとなくCLでHTMLを書くこともあったりするんだなあ位に見てもらえると嬉しいです。

(defpackage :example.com
  (:use :cl 
        :hunchentoot
        :cl-who
        :parenscript
        :xyzzy-compat))

(in-package :example.com)

;; doukaku から拝借
(defun number-to-kanji (num)
  (let ((digit   #("零" "一" "二" "三" "四" "五" "六" "七" "八" "九"))
        (subunit #("" "十" "百" "千"))
        (unit    #("" "万" "億" "兆")))
    (loop for i from 0
          initially (if (= num 0) (return (aref digit 0)))
          for (n m) = (multiple-value-list (floor num 10000)) ; 4 桁ずつ区切る
          until (and (= n 0) (= m 0))
          for value = (loop for j from 0 to 3 ; 位
                            for x = (mod (floor m (expt 10 j)) 10) ; 数字
                            when (/= x 0) ; 零千 零百 零十 対策
                            collect (format nil "~A~A" 
                                            ; 一千 一百 一十 対策
                                            (if (and (= x 1) (> j 0)) "" (aref digit x)) 
                                            (aref subunit j)))
           when value appending (cons (aref unit i) value) into result
           do (setf num n)
           finally (return (apply #'concatenate (cons 'string (reverse result)))))))

;; exec
(progn
  (setq hunchentoot:*hunchentoot-default-external-format*
        (flex:make-external-format :utf-8 :eol-style :lf))
  (setq hunchentoot:*default-content-type* "text/html; charset=utf-8")

  ;; *acceptor* 
  (defparameter *server* 
    (make-instance 'hunchentoot:acceptor :port 8888))
  (start *server*))

;(stop *server*)
(defvar *counter* 0)

(defvar *all-entries* () )

(defstruct (entry (:type list))
  path
  title
  body
  author
  date
  category
  )

;; メンバー一覧
(defparameter *top-member*
  (with-html-output-to-string (out nil :indent T)
    ((:div :id "member") 
     ((:h2 :class "design") "メンバー一覧") 
      ((:p :class "title")
       "某社技師部隊員名簿") 
     (:ul
      (:li ((:a :href "/g000001") "g000001")))
     ((:p :class "to_example.com")
      ((:a :href "http://www.example.com") 
       "某社へ"))))))

;; お知らせ
(defparameter *block-news*
  (with-html-output-to-string (out nil :indent T)
    ((:div :id "news")
     (:h2 "技師部隊からの" :br
          "お知らせ")
     (:p "只今某社株式会社技師部隊ではウェッブデザイナー/エンジニアを募集しています。<br />HTMLがわかる、CSSがわかる、Adobe Photoshopが使える、デザインが好き、ウェッブが好き、Ada、Ruby、CL、Haskell、Scheme、Prolog、Smalltalkが好き…な方、メールでご応募ください。"
         :br
         ((:a :href "mailto:recruit@example.com")
           "Mail: recruit@example.com"))))))

;; テンプレ
(defmacro define-example.com-template ((name path) (&rest args) contents)
  `(define-easy-handler (,name :uri ,path) ,args
     (with-html-output-to-string (out nil :indent T :prologue T)
       ((:html :xmlns "http://www.w3.org/1999/xhtml")
        (:head ((:meta :http-equiv "Content-Type" :content "text/html; charset=utf-8"))
               (:title "某社技術部隊報告書")
               ((:link :href "/stylesheets/reset.css" :rel "stylesheet" :type "text/css"))
               ((:link :href "/stylesheets/basic.css" :rel "stylesheet" :type "text/css"))
               ((:link :href "/rss.xml" :rel "alternate" :type "application/rss+xml" :title "Example.com blog")))
        (:body 
         ((:div :id "header") 
          ((:div :class "inner")
           ((:div :class "twitter")
            ((:h2 :class "design") "twitter")
            (:p "こんにちは!!、こんにちは!!、こんにちは!!"))
           ((:h1 :class "design_a")
            ((:a :href "" :title "") "タイトル"))
           ((:ol :id "bread_crumbs")
            (:li ((:a :href "/") "home")))))
         ((:div :class "inner")
          ((:div :id "columns")
           ((:div :id "cotents")
            ;; content
            ,contents
         ((:div :class "footer")))
        ((:div :id "local_nav")
         ;; news
         (princ *block-news* out)
         ((:div :id "counter")
          (:dl
           (:dt "本頁の来客数")
           (:dd (format out
                        "~A名"
                        (number-to-kanji (incf *counter*))))))
         (princ *top-member* out)))
       ;; ads
       ((:div :id "foo_ads")
        ((:div :id "categories")
         ((:h2 :class "design") "カテゴリー") 
         (:ul 
          (mapc (lambda (x)
                  (with-html-output (out nil :indent T)
                    (:li ((:a :href (entry-path x))
                          (princ (entry-title x) out)))))
                *all-entries*))
         ((:p :class "to_example.com") 
          ((:a :href "" :title "") "某社")))
        ((:div :class "poster") 
         ((:img :src "images/poster_01.jpg" :alt "aaaa")))
        ((:script :type "text/javascript")
         "//<![CDATA["
         "(function() {
		var links = document.getElementsByTagName('a');
		var query = '?';
		for(var i = 0; i < links.length; i++) {
			if(links[i].href.indexOf('#disqus_thread') >= 0) {
				query += 'url' + i + '=' + encodeURIComponent(links[i].href) + '&';
			}
		}
		document.write('<script charset=\"utf-8\" type=\"text/javascript\" src=\"http://disqus.com/forums/example.com/get_num_replies.js' + query + '\"></' + 'script>');
	})();"
         "//]]>"))))
        ((:div :id "footer")
         ((:p :class "center") "Copyright &copy; 2009 某社 All rights reserved."))))))


;; ページの定義
(defvar *default-directory* "/home/mc/lisp/Work/example.com.hunchentoot/")

;; 初期化 reset
(progn
  (setq *all-entries* () )
  (load "/home/mc/lisp/Work/blog.lisp")
  (setq *all-entries*
        (sort *all-entries*
              #'> :key #'entry-date)))

;; CSS
(define-easy-handler (reset.css :uri "/stylesheets/reset.css") ()
  (setf (content-type*) "text/css")
  (kmrcl:read-file-to-string 
   (merge-pathnames "reset.css" *default-directory*)))

(define-easy-handler (basic.css :uri "/stylesheets/basic.css") ()
  (setf (content-type*) "text/css")
  (kmrcl:read-file-to-string 
   (merge-pathnames "basic.css" *default-directory*)))

;; RSS
(define-easy-handler (|/rss.xml| :uri "/rss.xml") ()
  (setf (content-type*) "text/html; charset=utf-8")
  (with-html-output-to-string (out nil :indent T)
  (format out "<?xml version=\"1.0\" encoding=\"utf-8\"?>")
  ((:rss :version "2.0")
   (:channel
    (:title "某社技術部隊報告書")
    (:link "http://tech.example.com")
    (:description "某社技術部隊報告書")
    (format-date out "<lastBuildDate>%a, %d %b %Y %H:%M:%S +0900</lastBuildDate>")
    (:language "ja")
    (mapc (lambda (x)
            (with-html-output (out nil :indent T)
              (:item
               (:title (princ (entry-title x) out)) 
               (:link (format out "http://tech.example.com~A" (entry-path x)))
               (:description
                "<![CDATA[" (princ (entry-body x) out) "]]>")
               (format-date out "<pubDate>%a, %d %b %Y %H:%M:%S +0900</pubDate>" (entry-date x)))))
          *all-entries*)))))

;; images/gif
(mapc (lambda (x)
        (pushnew (create-prefix-dispatcher (symbol-name x) x)
                 *dispatch-table*))
      (mapcar (lambda (path)
                (let ((var-name (intern (format nil "*~A*" (file-namestring path)))))
                  (eval 
                   `(progn
                      (defparameter ,var-name
                        (with-open-file (in ,(merge-pathnames (format nil "images/~A" (file-namestring path)) *default-directory*)
                                            :element-type 'flex:octet)
                          (let ((image-data (make-array (file-length in)
                                                        :element-type 'flex:octet)))
                            (read-sequence image-data in)
                            image-data)))
                      (defun ,(intern (format nil "/images/~A" (file-namestring path))) ()
                        (setf (content-type*) "image/gif")
                        ,var-name)))))
              (directory (merge-pathnames "images/*.gif" *default-directory*))))


;; gif
(mapc (lambda (x)
        (pushnew (create-prefix-dispatcher (symbol-name x) x)
                 *dispatch-table*))
      (mapcar (lambda (path)
                (let ((var-name (intern (format nil "*~A*" (file-namestring path)))))
                  (eval 
                   `(progn
                      (defparameter ,var-name
                        (with-open-file (in ,(merge-pathnames (format nil "images/~A" (file-namestring path)) *default-directory*)
                                            :element-type 'flex:octet)
                          (let ((image-data (make-array (file-length in)
                                                        :element-type 'flex:octet)))
                            (read-sequence image-data in)
                            image-data)))
                      (defun ,(intern (format nil "/images/~A" (file-namestring path))) ()
                        (setf (content-type*) "image/jpeg")
                        ,var-name)))))
              (directory (merge-pathnames "images/*.jpg" *default-directory*))))

;; トップページ
(define-example.com-template (root "/") (page)
  (mapc (lambda (x)
          (with-html-output (out nil :indent 2)
            ((:div :class "content")
             (:h2
              ((:a :href (entry-path x))
               (princ (entry-title x) out))
              )
             ((:dl :class "date")
              (:dd (format-date out "%g%#e年%#m月%#d日(%v) %H時%M分%S秒"
                                (entry-date x)))
              (:dt "区分") 
              (:dd (princ (entry-category x) out))
              (:dt "報告者: ")
              (:dd (princ (entry-author x) out))
              )
             #|(:p (princ (with-output-to-string (*standard-output*)
                          (describe page))
                        out))|#
             (:p (princ (entry-body x) out))
             ((:p :class "to_top")
              ((:a :href (format nil "~A#disqus_thread" (entry-path x))) 
               ">View Comments")
              "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;"
              ((:a :href "" :title "") "このページの上へ戻る")))))
        (nth 0 (metatilities:group *all-entries* 10))))

(defun make-member-page (name)
  (eval
   `(define-example.com-template 
        ,(intern name)
        ,(format nil "/~A" name)
      (mapc (lambda (x)
              (with-html-output (out nil :indent T)
                ((:div :class "content")
                 (:h2
                  ((:a :href (entry-path x))
                   (princ (entry-title x) out))
                  )
                 ((:dl :class "date")
                  (:dd (format-date out "%g%#e年%#m月%#d日(%v) %H時%M分%S秒"
                                    (entry-date x)))
                  (:dt "区分") 
                  (:dd (princ (entry-category x) out))
                  (:dt "報告者: ")
                  (:dd (princ (entry-author x) out))
                  )
                 (:p (princ (entry-body x) out))
                 ((:p :class "to_top")
                  ((:a :href (format nil "~A#disqus_thread" (entry-path x))) 
                   ">View Comments")
                  "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;"
                  ((:a :href "" :title "") "このページの上へ戻る")))))
            (remove-if-not (lambda (x) 
                             (string= ,name (entry-author x)))
                           *all-entries*)))))

(mapc (lambda (n)
        (make-member-page n))
      '("k" "m" "y" "m" "c"))

2009-08-17

Algolの引数の名前渡し

| 00:40 | Algolの引数の名前渡し - わだばLisperになる を含むブックマーク はてなブックマーク - Algolの引数の名前渡し - わだばLisperになる

引数 - Wikipedia

を眺めていて、Algolの引数の名前渡しが面白いなと思ったので、マクロで書くとどんな感じになるのか試してみることにしました。

swap(x,y) {
 tmp = x;
 x = y;
 y = tmp;
}
この例に対し、x=i, y=a[i]という"式"を渡すとする。仮にi=2だったとすると、
tmp = x;
    x=i=2 なのでtmpは2になる。
x = y;
    xはiを渡されているのでiがyの値になる。yはa[i]だから、iはaの2番目の値になる。
y = tmp;
    yはaのi番目の値だが、前手順によりiはa[2]になっている。従ってy=a[a[2]]になる。
このような複雑さもあって、ALGOL以外で名前渡しが採用された事例はほとんどない。

というような解説が載っているのですが、マクロで書くと、

(defmacro swap (x y)
  (let ((tmp (gensym)))
    `(let (,tmp)
       (setf ,tmp ,x)
       (setf ,x ,y)
       (setf ,y ,tmp))))

こんな感じになるのでしょうか?

y=a[i]という式を渡すというのがどう解釈されるのか分からないのですが、とりあえず、setf的にしてみました。

(let ((i 2)
      (x (list 1 2 3 4)))
 (swap i (elt x i))
  x)
;=> (1 2 3 2)

マクロ展開

(LET ((I 2) (X (LIST 1 2 3 4)))
  (LET (#:G2488)
    (SETQ #:G2488 I)
    (SETQ I (ELT X I))
    (SB-KERNEL:%SETELT X I #:G2488))    
  X)
;=> (1 2 3 2)

なにか解釈を間違えてる気がしてならないですが、実際にこういう動作だったとすると、随分複雑ですねー('-'*)

それとも、この例が複雑なのかな?…

(let ((x 10)
      (y 20))
  (swap x y)
  (list x y))
;=> (20 10)

…こういう使い方を想定しているとすると、解説の例が複雑すぎるのかもしれませんね(笑)

2009-08-02

StumpWMの日々 (2)

| 03:21 | StumpWMの日々 (2) - わだばLisperになる を含むブックマーク はてなブックマーク - StumpWMの日々 (2) - わだばLisperになる

前回の設定からあまり変化なしなのですが、適当にウェブアプリ用のユーティリティをつくったりしてみています。

といっても単にURLを含んだdefine-stumpwm-commandを書くのが面倒だったのでマクロに纏めただけです。

ウェブアプリをコマンドで呼び出す

(defmacro define-webapp-command (name args url)
  `(define-stumpwm-command ,name (,@args)
     (run-shell-command ,(format nil "/usr/bin/firefox \"~A\"" url))))

(progn ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;,
  ;; 
  ;; web apps
  ;; 
  (define-webapp-command "ff" () 
    "http://friendfeed.com/")
  (define-webapp-command "chaton-cl" () 
    "http://practical-scheme.net/chaton/common-lisp-jp/")
  (define-webapp-command "chaton-gauche" ()
    "http://practical-scheme.net/chaton/gauche/")
  (define-webapp-command "twitter" ()
    "http://twitter.com/home")
  (define-webapp-command "gmail" ()
    "http://mail.google.com/mail")
  (define-webapp-command "ldr" ()
    "http://reader.livedoor.com/reader/"))

この場合、名前が文字列だったりするので、マクロにする必要はないのですが、なんとなくdefine-〜の習慣でマクロにしています。

firefoxとの連携

自分は、Firefoxのフォームの入力に任意のエディタを呼び出す、It's All Textというアドオンを利用しているのですが、

emacsが呼び出されて、入力が終った後は、再びFirefoxにフォーカスが戻ってきて欲しいので、

#!/bin/sh

stumpish emacs #emacsにフォーカス
emacsclient $*
stumpish firefox #firefoxにフォーカスを戻す

exit 0

のようなものを定義して利用していますが地味に便利です。(ちなみに、2年前くらいのエントリーに書いた内容と同じです)

stumpishというのは、stumpwmのコマンドをシェルから実行できるコマンドなのですが、これで外部と連携することができます。