Parrot で eval もできる

http://docs.parrot.org/parrot/latest/html/docs/book/pir/ch06_subroutines.pod.html

Evaluating a Code String

.sub main
        .local pmc compiler, generated1, generated2
        .local string source1, source2
        compiler = compreg "PIR"
        source1 = ".sub foo\n$S1 = 'in eval 1'\nsay $S1\n.end"
        source2 = ".sub foo\n$S1 = 'in eval 2'\nsay $S1\n.end"
        generated1 = compiler(source1)
        generated2 = compiler(source2)
        generated1()            # in eval 1
        generated2()            # in eval 2
        foo()                   # in eval 2
        $P1 = generated1
        $P1()                   # in eval 1
.end

Parrot はとことん言語実装のための VM だな。

Parrot をさわってみた

http://www.parrot.org/

PIR

PIR(Parrot Intermediate Representation)は Parrot の中間レベルのアセンブリ言語。

使える機能としては

• ガーベッジ・コレクション
• コンティニュエーション
• レキシカルバインディング
• オブジェクト指向
• 例外
• テイルコール
• UTF-8 UTF-16 のサポート

などがある。とんでもなく高機能。もっとずっと低レベルの機能しかないと思っていたから意外だった。さらに、いろいろとライブラリも充実してるみたい。 Hash もあったりする。

hello.pir

.sub hello
        .local pmc en, jp
        $P0 = newclass "EnHello"
        $P1 = newclass "JpHello"
        en = new "EnHello"
        jp = new "JpHello"
        en.'hello'("Parrot")
        jp.'hello'(utf8:unicode:"おーむちゃん")
.end

.namespace [ "EnHello" ]

.sub 'hello' :method
        .param string name
        $S0 = "Hello, "
        $S0 .= name
        $S0 .=  "!"
        say $S0
.end

.namespace [ "JpHello" ]

.sub 'hello' :method
        .param string name
        $S0 = utf8:unicode:"こんにちは、"
        $S0 .= name
        $S0 .= utf8:unicode:"♪"
        say $S0
.end

parrot ./hello.pir として実行できる。

習字

娘と習字で遊んだ。習字で遊ぶってのはちょっとへんだな。毛筆で遊んだか。

最初は練習らしきものをしたが、あとはひらがなで二文字ほど書いて、その下に絵を描く遊びになった。なにはともあれ、上手にばくが書けました。

lambda

今日の Shibuya.lisp の Shiro さんの話にもでてきたけど lambda の表記。慣れの問題かもしれないが、lambda と素直に書くのが一番読みやすい気がする。うぅむ。

(deftest test-^ ()
  (is (equal '((2) (3) (4)) (mapcar (^ list (1+ _)) '(1 2 3))))
  (is (equal '(1 4 9) (mapcar (^ * _ _) '(1 2 3))))
  (is (equal '((1 a "A") (2 b "B"))
             (mapcar (^ list _z _y _x) '("A" "B") '(a b) '(1 2))))
  (is (equal '(1 2 3)
             (funcall (^ identity _rest) 1 2 3)))
  (is (equal '(2 1 3 4)
             (funcall (^ apply #'list _b _a _rest) 1 2 3 4)))
  (is (equal "a"
             (with-output-to-string (*standard-output*)
               (funcall (^ princ _) #\a))))
  (is (equal "cba"
             (with-output-to-string (*standard-output*)
               (funcall (^ (princ _z) (princ _y) (princ _x)) #\a #\b #\c)))))

(deftest |test-{}| ()
  (is (equal '((2) (3) (4)) (mapcar {list (1+ _)} '(1 2 3))))
  (is (equal '(1 4 9) (mapcar {* _ _} '(1 2 3))))
  (is (equal '((1 a "A") (2 b "B"))
             (mapcar {list _z _y _x} '("A" "B") '(a b) '(1 2))))
  (is (equal '(1 2 3)
             (funcall {identity _rest} 1 2 3)))
  (is (equal '(2 1 3 4)
             (funcall {apply #'list _b _a _rest} 1 2 3 4)))
  (is (equal "a"
             (with-output-to-string (*standard-output*)
               (funcall {princ _} #\a))))
  (is (equal "abc"
             (with-output-to-string (*standard-output*)
               (funcall {(princ _x) (princ _y) (princ _z)} #\a #\b #\c)))))

(deftest test-lambda ()
  (is (equal '((2) (3) (4)) (mapcar (lambda (x) (list (1+ x))) '(1 2 3))))
  (is (equal '(1 4 9) (mapcar (lambda (x) (* x x)) '(1 2 3))))
  (is (equal '((1 a "A") (2 b "B"))
             (mapcar (lambda (x y z) (list z y x)) '("A" "B") '(a b) '(1 2))))
  (is (equal '(1 2 3)
             (funcall (lambda (&rest rest) (identity rest)) 1 2 3)))
  (is (equal '(2 1 3 4)
             (funcall (lambda (a b &rest rest)
                        (apply #'list b a rest)) 1 2 3 4)))
  (is (equal "a"
             (with-output-to-string (*standard-output*)
               (funcall (lambda (x) (princ x)) #\a))))
  (is (equal "cba"
             (with-output-to-string (*standard-output*)
               (funcall (lambda (x y z)
                          (princ z) (princ y) (princ x)) #\a #\b #\c)))))

Linux 環境での Clozure CL で日本語パス名

Linux 環境での Clozure CL で日本語パス名を扱うには次のコードが必要みたい。 Mac と Win はデフォルトで大丈夫そう。

(ccl::set-pathname-encoding-name :utf-8)

いまさらだけど Clozure CL は Windows でもスレッドが使える

Clozure CL(CCL)なの。いや、以前からそんな話はきいてたんだけど何故かあまり気にしていなかった。いまさらながら、いじってみると確かにスレッドが使える。 Hunchentoot もすんなり動いた。これで簡単に Windows 上で Web サーバがたてられるw

あとは CP932 だけですね♪

おさらいをかねて初期化ファイルを。 c:/Users/ancient/ccl-init.lisp

;;;; -*- lisp -*-

;;; 最適化
#+nil
(declaim (optimize (debug 3) (safety 3) (speed 0) (space 0)
                   (compilation-speed 3)))
#+nil
(declaim (optimize (debug 0) (safety 0) (speed 3) (space 0)
                   (compilation-speed 0)))


;;; 文字コード
(setf ccl:*default-external-format*
      (ccl:make-external-format :character-encoding :utf-8
                                :line-termination :dos)
      ccl:*default-file-character-encoding* :utf-8
      ccl:*default-socket-character-encoding* :utf-8)


;;; asdf
(require :asdf)

;; ~/letter/lib 以下の asd を登録する。
(loop for path in (directory (translate-logical-pathname
                                       "home:letter;lisp;lib;**;*.asd"))
      do (let ((pd (pathname-directory path)))
           (unless (member "_darcs" pd :test #'equal)
             (pushnew (make-pathname :directory pd)
                      asdf:*central-registry*
                      :test #'equal))))

;; clbuild
;;(pushnew (translate-logical-pathname "home:letter;lisp;clbuild;systems;")
;; asdf:*central-registry*)
;; ~/letter/lib 以下の asd を登録する。
(loop for path in (directory (translate-logical-pathname
                                       "home:letter;lisp;clbuild;source;**;*.asd"))
      do (let ((pd (pathname-directory path)))
           (unless (member "_darcs" pd :test #'equal)
             (pushnew (make-pathname :directory pd)
                      asdf:*central-registry*
                      :test #'equal))))


;; require で asdf:oos する
(defun asdf-module-provider-function (module)
  (when (asdf:find-system module nil)
    (asdf:oos 'asdf:load-op module)
    t))
(pushnew 'asdf-module-provider-function
         ccl::*module-provider-functions*)

(defmethod asdf:perform :around ((o asdf:load-op) (c asdf:cl-source-file))
  (handler-case (call-next-method o c)
    (#+sbcl sb-ext:invalid-fasl
      #+allegro excl::file-incompatible-fasl-error
      #+lispworks conditions:fasl-error
      #+cmu ext:invalid-fasl
      #-(or sbcl allegro lispworks cmu) error ()
      (asdf:perform (make-instance 'asdf:compile-op) c)
      (call-next-method))))
 

Clozure CL 本体の他に、clbuid が使いたいので cygwin とか darcs とか git とか svn とかも必要。

./clbuild install hunchentoot

して、

CL-USER> (require :hunchentoot)
CL-USER> (hunchentoot:start (make-instance 'hunchentoot:acceptor :port 1234))

http://localhost:1234/ にアクセス♪

もちろん Meadow と

./clbuild install slime

も必要。ついでに ~/.emacs の SLIME まわりの設定。

(require 'path-util) ; add-path用

(add-path "~/letter/lisp/clbuild/source/slime")
(add-path "~/letter/lisp/clbuild/source/slime/contrib")
(setq slime-lisp-implementations
      `((ccl ("/Users/ancient/local/opt/ccl/wx86cl.exe")
             :coding-system utf-8-unix)
        (sbcl ("sbcl")
              :coding-system utf-8-unix)
        (clisp ("clisp") :coding-system utf-8-unix)))
(require 'slime-autoloads)
(add-hook 'lisp-mode-hook
          (lambda ()
            (cond ((not (featurep 'slime))
                   (require 'slime)
                   (normal-mode)))))
(setq slime-truncate-lines nil)
(setq slime-enable-evaluate-in-emacs t)
(add-hook
 'slime-mode-hook
 (lambda ()
   (global-set-key [(control ?\;)] 'slime-selector)
   (loop for (key command) in
         '(("\C-m" newline-and-indent)
           ("\C-i" slime-indent-and-complete-symbol))
         do (define-key slime-mode-map key command))))
(add-to-list 'auto-mode-alist '("\\.asd$" . common-lisp-mode))
(eval-after-load "slime"
  '(progn
    (slime-setup '(slime-repl slime-asdf slime-fancy slime-banner))
    (setq slime-complete-symbol*-fancy t)
    (setq slime-complete-symbol-function 'slime-fuzzy-complete-symbol)))

cl-openid

ふと OpenID を使ってみようと思った。 Common Lisp にもちゃんと OpenID のライブラリがあった。 CL-OpenID

サンプルがついているのだけど、最近の Hunchentoot では次のように修正する必要があった。 get-parameters と request-uri に hunchetoot::*request* を渡してあげる。

in directory ./examples:
              Modified                relying-party.lisp
41
-        (alist-to-lol (get-parameters))
+        (alist-to-lol (get-parameters hunchentoot:*request*))
52
-        (alist-to-lol (get-parameters))
+        (alist-to-lol (get-parameters hunchentoot:*request*))
65
-                (alist-to-lol (get-parameters))
+                (alist-to-lol (get-parameters hunchentoot:*request*))
85
-                          *relying-party* (get-parameters) ; The incoming message alist consists of GET parameters.
-                          (merge-uris (request-uri) (root-uri *relying-party*))))) ; Figuring out actual request URI may be more complicated with proxies
+                          *relying-party* (get-parameters hunchentoot:*request*) ; The incoming message alist consists of GET parameters.
+                          (merge-uris (request-uri hunchentoot:*request*) (root-uri *relying-party*))))) ; Figuring out actual request URI may be more complicated with proxies

あとは、こんな感じで動かして http://xxx.xxxx.xx:1234/cl-openid/ にアクセスする。

(require :cl-openid)
(require :cl-openid.examples)

(cl-openid.example-rp::init-relying-party
 "http://xxx.xxxx.xx:1234/" "/cl-openid/")

(setq hunchentoot:*show-lisp-errors-p* t)
(hunchentoot:start (make-instance 'hunchentoot:acceptor :port 1234))

examples/relying-party.lisp を見る。 relying-party のインスタンスを作っておく。 handle-openid-request では cond で場合わけ。ふむ、使うぶんには簡単そうだ。