146,000

2012-07-15 · 146,000

XML
CL-WHO
htout
CL-WHO
CL-WHO
WRITE-STRING
CL-WHO
CL-WHO
CL-WHO
Common Lisp
CL-WHO
*HTTP-STREAM*
CL-WHO
HTML
CL-WHO
WITH-HTML-OUTPUT
body
transformation rules
"foo" => (write-string "foo" s)
(:br) => (write-string "<br />" s)
HTML-MODE
:SGML
(:br) => (write-string "<br>" s)
NIL
(:td :bgcolor "red") => (write-string "<td bgcolor='red' />" s)
T
HTML-MODE
:XML
(:td :nowrap t) => (write-string "<td nowrap='nowrap' />" s)
HTML-MODE
:SGML
(:td :nowrap t) => (write-string "<td nowrap>" s)
NIL
(:td :nowrap nil) => (write-string "<td />" s)
"~A"
(:table :border 3) => (write-string "<table border='3' />" s)
princ
T
NIL
;; simplified example, see function CHECKBOX below
;; note that this form is not necessarily CONSTANTP in all Lisps

(:table :border (+ 1 2)) => (write-string "<table border='" s)
                              (princ (+ 1 2) s)
                              (write-string "' />" s)
(:table :border 0 :cellpadding 5 :cellspacing 5)
      => (write-string "<table border='0' cellpadding='5' cellspacing='5' />" s)
transformation rules
(:p "Paragraph") => (write-string "<p>Paragraph</p>" s)
(:p :class "foo" "Paragraph") => (write-string "<p class='foo'>Paragraph</p>" s)
(:p :class "foo" "One" " " "long" " " "sentence")
    => (write-string "<p class='foo'>One long sentence</p>" s)
(:p :class "foo" "Visit " (:a :href "http://www.cliki.net/" "CLiki"))
    => (write-string "<p class='foo'>Visit <a href='http://www.cliki.net/'>CLiki</a></p>" s)
LHTML
((:p) "Paragraph") => (write-string "<p>Paragraph</p>" s)
((:p :class "foo") "Paragraph") => (write-string "<p class='foo'>Paragraph</p>" s)
((:p :class "foo" :name "humpty-dumpty") "One" " " "long" " " "sentence")
    => (write-string "<p class='foo' name='humpty-dumpty'>One long sentence</p>" s)
((:p :class "foo") "Visit " ((:a :href "http://www.cliki.net/") "CLiki"))
    => (write-string "<p class='foo'>Visit <a href='http://www.cliki.net/'>CLiki</a></p>" s)
* (defun checkbox (stream name checked &optional value)
    (with-html-output (stream)
      (:input :type "checkbox" :name name :checked checked :value value)))

CHECKBOX
* (with-output-to-string (s) (checkbox s "foo" t))

 "<input type='checkbox' name='foo' checked='checked' />"
* (with-output-to-string (s) (checkbox s "foo" nil))

"<input type='checkbox' name='foo' />"
* (with-output-to-string (s) (checkbox s "foo" nil "bar"))

"<input type='checkbox' name='foo' value='bar' />"
* (with-output-to-string (s) (checkbox s "foo" t "bar"))

"<input type='checkbox' name='foo' checked='checked' value='bar' />"
:hr => (write-string "<hr />" s)
(str form1 form*)
(let ((result form1)) (when result (princ result s)))
form1
        (loop for i below 10 do (str i)) => 
        (loop for i below 10 do
           (let ((#:result i))
             (when <a href='#:result (princ '>:result (princ </a>:result *standard-output*))))
(fmt form*)
<||
というフォームは、
>||
(format s form*)
<||
というフォームに置換される。
>||
(loop for i below 10 do (fmt "~R" i)) => (loop for i below 10 do (format s "~R" i))
(esc form1 form*)
(let ((result form1)) (when result (write-string (escape-string result s))))
(htm form*)
transformation rules
(loop for i below 100 do (htm (:b "foo") :br))
    => (loop for i below 100 do (progn (write-string "<b>foo</b><br />" s)))
CL-WHO
HTML
XHTML
CL-WHO
:hr
:foobar
CL-WHO
CL-WHO
body
Syntax and Semantics
transformation rules
var
stream
stream
NIL
var
var
stream
prologue
NIL
prologue
T
prologue
*PROLOGUE*
CL-WHO
indent
indent
HTML
PRE
TEXTAREA
result*
forms
prologue
indent
    * (with-html-output (*standard-output* nil :prologue t)
        (:html (:body "Not much there"))
        (values))
    <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"><html><body>Not much there</body></html>
    * (with-html-output (*standard-output*)
        (:html (:body :bgcolor "white"
             "Not much there"))
        (values))
    <html><body bgcolor='white'>Not much there</body></html>
    * (with-html-output (*standard-output* nil :prologue t :indent t)
        (:html (:body :bgcolor "white"
                 "Not much there"))
        (values))
    <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
    <html>
      <body bgcolor='white'>
        Not much there
      </body>
    </html>
WITH-HTML-OUTPUT
(defmacro with-html-output-to-string ((var &optional string-form
                                           &key (element-type 'character)
                                                prologue
                                                indent)
                                      &body body)
  "Transform the enclosed BODY consisting of HTML as s-expressions
into Lisp code which creates the corresponding HTML as a string."
  `(with-output-to-string (,var ,string-form :elementy-type ,element-type)
    (with-html-output (,var nil :prologue ,prologue :indent ,indent)
      ,@body)))
WITH-OUTPUT-TO-STRING
*STANDARD-OUTPUT*
WITH-HTML-OUTPUT
* (show-html-expansion (s)
    (:html
     (:body :bgcolor "white"
      (:table
       (:tr
        (dotimes (i 5)
          (htm (:td :align "left"
                (str i)))))))))
(LET ((S S))
  (PROGN
    (WRITE-STRING
      "<html><body bgcolor='white'><table><tr>" S)
    (DOTIMES (I 5)
      (PROGN
        (WRITE-STRING "<td align='left'>" S)
        (PRINC I S)
        (WRITE-STRING "</td>" S)))
    (WRITE-STRING "</tr></table></body></html>" S)))
#\'
#\"
WITH-HTML-OUTPUT
prologue
T
    "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"
strict
XML
CL-WHO
NIL
CL-WHO
*HTML-EMPTY-TAGS*

T
HTML
*HTML-EMPTY-TAG-AWARE-P*
    (:area :atop :audioscope :base :basefont :br :choose :col :frame
     :hr :img :input :isindex :keygen :left :limittext :link :meta
     :nextid :of :over :param :range :right :spacer :spot :tab :wbr)
NIL
XML
T
Syntax and Semantics
HTML-MODE
HTML
XHTML
:XML
(SETF (HTML-MODE) :SGML)
XML
HTML
SGML HTML
*prologue*
doctype string
HTML 4.01 transitional
    <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
SGML HTML
XHTML
string
test
HTML-MODE
:SGML
test
generalized boolean
*ESCAPE-CHAR-P*
Syntax and Semantics
ESC
    * (escape-string "<H&#252;hner> 'na&#239;ve'")
    "&lt;H&#xFC;hner&gt; &#x27;na&#xEF;ve&#x27;"
    * (with-html-output-to-string (s)
        (:b (esc "<H&#252;hner> 'na&#239;ve'")))
    "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\"<b>&lt;H&#xFC;hner&gt; &#x27;na&#xEF;ve&#x27;</b>"
ESCAPED-STRING
ESCAPE-CHAR
test
    #'(lambda (char)
        (or (find char "<>&'\"")
            (> (char-code char) 127)))
ESCAPE-STRING
ESCAPE-CHAR
    (defun escape-string-minimal (string)
      "Escape only #\<, #\>, and #\& in STRING."
      (escape-string string :test #'(lambda (char) (find char "<>&"))))

    (defun escape-string-minimal-plus-quotes (string)
      "Like ESCAPE-STRING-MINIMAL but also escapes quotes."
      (escape-string string :test #'(lambda (char) (find char "<>&'\""))))

    (defun escape-string-iso-8859-1 (string)
      "Escapes all characters in STRING which aren't defined in ISO-8859-1."
      (escape-string string :test #'(lambda (char)
                                      (or (find char "<>&'\"")
                                          (> (char-code char) 255)))))

    (defun escape-string-iso-8859 (string)
      "Identical to ESCAPE-STRING-ISO-8859-1.  Kept for backward compatibility."
      (escape-string-iso-8859-1 string))

    (defun escape-string-all (string)
      "Escapes all characters in STRING which aren't in the 7-bit ASCII
    character set."
      (escape-string string :test #'(lambda (char)
                                      (or (find char "<>&'\"")
                                          (> (char-code char) 127)))))

    * (conc "This" " " "is" " " "a" " " "sentence")
    "This is a sentence"
    * (with-html-output-to-string (s)
        (:div :style (conc "padding:"
                           (format nil "~A" (+ 3 2)))
         "Foobar"))
    "<div style='padding:5'>Foobar</div>"
CL-WHO
LISP
tag
attr-list
body
body-fn
body-fn
    * (defmethod convert-tag-to-string-list ((tag (eql :red)) attr-list body body-fn)
        (declare (ignore attr-list))
        (nconc (cons "<font color='red'>" (funcall body-fn body)) (list "</font>"))) 
    ; Compiling LAMBDA (PCL::.PV-CELL. PCL::.NEXT-METHOD-CALL. TAG ATTR-LIST BODY BODY-FN): 
    ; Compiling Top-Level Form: 

    #<STANDARD-METHOD CONVERT-TAG-TO-STRING-LIST ((EQL :RED) T T T) {582B268D}>
    * (with-html-output (*standard-output*)
        (:red (:b "Bold and red")) 
        (values))
    <font color='red'><b>Bold and red</b></font>
    * (show-html-expansion (s)
        (:red :style "spiffy" (if (foo) (htm "Attributes are ignored")))) 

    (LET ((S S))
      (PROGN
       NIL
       (WRITE-STRING "<font color='red'>" S)
       (IF (FOO) (PROGN (WRITE-STRING "Attributes are ignored" S)))
       (WRITE-STRING "</font>" S)))
    * (defmethod convert-tag-to-string-list ((tag (eql :table)) attr-list body body-fn)
        (cond ((cdr (assoc :simple attr-list))
               (nconc (cons "<table"
                            (convert-attributes (remove :simple attr-list :key #'car)))
                      (list ">")
                      (loop for row in body
                            collect "<tr>"
                            nconc (loop for col in row
                                        collect "<td>"
                                        when (constantp col)
                                          collect (format nil "~A" col)
                                        else 
                                          collect col
                                        collect "</td>")
                            collect "</tr>")
                      (list "</table>")))
              (t 
gethash
cl:identity
maphash
maphash
eql
defconstant
warning
destructuring-case
-ccase
-ecase
case
destructuring-bind
            ((CASE-KEYS . DESTRUCTURING-LAMBDA-LIST) FORM*)
car
case
ccase
ecase
destructuring-lambda-list
           (defun dcase (x)
             (destructuring-case x
               ((:foo a b)
                (format nil "foo: ~S, ~S" a b))
               ((:bar &key a b)
                (format nil "bar, ~S, ~S" a b))
               (((:alt1 :alt2) a)
                (format nil "alt: ~S" a))
               ((t &rest rest)
                (format nil "unknown: ~S" rest))))

            (dcase (list :foo 1 2))        ; => "foo: 1, 2"
            (dcase (list :bar :a 1 :b 2))  ; => "bar: 1, 2"
            (dcase (list :alt1 1))         ; => "alt: 1"
            (dcase (list :alt2 2))         ; => "alt: 2"
            (dcase (list :quux 1 2 3))     ; => "unknown: 1, 2, 3"

           (defun decase (x)
             (destructuring-case x
               ((:foo a b)
                (format nil "foo: ~S, ~S" a b))
               ((:bar &key a b)
                (format nil "bar, ~S, ~S" a b))
               (((:alt1 :alt2) a)
                (format nil "alt: ~S" a))))

            (decase (list :foo 1 2))        ; => "foo: 1, 2"
            (decase (list :bar :a 1 :b 2))  ; => "bar: 1, 2"
            (decase (list :alt1 1))         ; => "alt: 1"
            (decase (list :alt2 2))         ; => "alt: 2"
            (decase (list :quux 1 2 3))     ; =| error
prog2
prog
prog
prog
let
block
tagbody
progn
prog1
prog2
progn
multiple-value-prog1
prog1
lambda
labels
OR
nil
or
or
nil
           (variable initial-form)
           ((variable-1 initial-form-1)
            (variable-2 initial-form-2)
            ...
            (variable-n initial-form-n))
           (variable initial-form)
           ((variable-1 initial-form-1)
            (variable-2 initial-form-2)
            ...
            (variable-n initial-form-n))
progn
           (variable initial-form)
           ((variable-1 initial-form-1)
            (variable-2 initial-form-2)
            ...
            (variable-n initial-form-n))
when-let*
when-let*
nil
progn
switch
switch
nil
nil
t
nil
nil
t
nil
nil
fdefinition
function-designator
car
setf
fdefinition
symbol-definition
compose
mutiple-value-call
satisfies
type-error
expected
type
satisfies
type-error
expected
type
append
nconc
remove-from-plist
delete-from-plist
reverse
nreverse
union
nunion
tagbody
return
return
nil
nil
length
clisp
CLtL2
append
           (map-product 'list '(1 2) '(3 4) '(5 6))
            => ((1 3 5) (1 3 6) (1 4 5) (1 4 6)
                (2 3 5) (2 3 6) (2 4 5) (2 4 6))
EQ
remove-from-plist
nil
delete
remove
delete
remove
remove
remove
(let ((str (list 'a 'b 'c)))
  (alexandria:shuffle str)
  str)
t
EQL
nil
t
EQL
nil
length
EQUAL
EQ
            (symbol initform)
            (symbol symbol)
            (defmacro cons1 (x) (once-only (x) `(cons ,x ,x)))
            (let ((y 0)) (cons1 (incf y))) => (1 . 1)
           (symbol string-designator)
           (symbol symbol)
gensym
with-gensyms
*features*
t
nil
intern
            (ensure-symbol :cons :cl) => cl:cons, :external
format
nil
t
gensym
gensym
make-gensym
array-dimension-limit
array-dimension-limit
adjust-array
max
min
subfactorial
subfactorial
            (iota 4)                      => (0 1 2 3 4)
            (iota 3 :start 1 :step 1.0)   => (1.0 2.0 3.0)
            (iota 3 :start -1 :step -1/2) => (-1 -3/2 -2)
            (map-iota #'print 3 :start 1 :step 1.0) => 3
              ;;; 1.0
              ;;; 2.0
              ;;; 3.0
　　　　 /: : : : : __: :/: : ::/: : :／/: : :/l::|: : :i: :l: : :ヽ: : :丶: : 丶ヾ　　　　＿＿＿
 　　 　 /;,, : : : //::/: : 7l,;:≠-::/: : / .l::|: : :l: :|;,,;!: : :!l: : :i: : : :|: : ::､　 ／　　　　 ヽ
 　　　 /ヽヽ: ://: :!:,X~::|: /;,,;,/: :／　 ﾘ!: ::/ﾉ　 l｀ヽl !: : |: : : :l: :l: ﾘ /　そ　そ　お　＼
 　　　/: : ヽヾ/: : l/::l |／|||llllヾ,､　　/ |: :/ , -==､　l＼:::|: : : :|i: |　/ 　 う　う　 前　　|
 .　　 /: : : //ヾ ; :|!: ｲ､||ll|||||::||　　　 ﾉノ　 ｲ|||||||ヾ､ |: ::|!: : ｲ: ::|/　 　な　思　が
 　　 /: : ://: : :ヽｿ::ヽl |{ i||ll"ﾝ　　　 ´　　　i| l|||l"l　｀|: /|: : /'!/l 　 　 ん　う
 　∠: : : ~: : : : : : : :丶ゝ-―-　　　　　 , 　ｰ=z_ｿ　　 |/ ﾊﾒ;, :: ::|.　　　だ　ん
 　　 i|::ﾊ: : : : : : : : : : : ､ﾍﾍﾍﾍ　　　　 ､　　ﾍﾍﾍﾍﾍ /: : : : : ＼,|.　　　ろ　な
 　　 |!l　|: : : : : : : : :､: ::＼　　　　､-―-,　　　　　　/ : : :丶;,,;,:ミヽ　　 う　 ら
 　　　　　丶: :ﾊ､lヽ: :ヽ: : ::＼__　　｀~　"　　　　　 /: : ﾄ; lヽ）　　　ゝ
 　　　　　　 ﾚ　｀|　｀､l｀､＞=ﾆ´　　　　　　　 ,　　_´ : :}　｀　　　／
 　　　　　　　　 ,,､r"^~´"''''"t-｀r､ _　　-､　´ヽノ　＼ﾉ　　　／　　　　お ・
 　　　　　　　,;'~　　_r-- ､__　　　　　~f､_>'､_　　　　　　　　 |　　で　　前 ・
 　　　　　　f~　　,;"　　　　　~"t___　　　　ﾐ､ ^'t　 　 　 　 　|　　は　　ん ・
 　　　　　 ,"　　,~　　　　　　　　　ヾ~'-､__　ﾐ_ξ丶　　　　　|　　な　　中 ・
 　　　　　;'　　,ｲ　.. 　　　　　　　　　ヽ_　　 ヾ､0ヽ丶　　　　l　　　　　　　　　/
 　　　　 （　;":: |:　:: ..　　　　　　　　　 .｀,　　 ヾ　丶 !　　　　＼＿＿＿＿／
 　　　　　;;;; :: 入:: :: :: 　 　　　l｀ｰ-､　　 ）l　　 ヾ　丶
 　　　　　"~､ｿ:: :い:: :　　　　　＼_　　ノ　,　　　 ヾ　丶
class Moge
  def hoge()
    @hoge
  end

  def hoge=(v)
    @hoge=v
  end
end

#!/usr/bin/ruby
# -*- encoding: utf-8 -*-

# 1行ごとに順に処理していく。
while line = ARGF.gets do
  line.chomp!

  unless /^#gen_accessor (.*$)/
    # パターンに合致しなければそのまま出力する。
    puts line
  else
    # 合致した場合はどうするか
    # 解析器で記法を解析し、生成器でコードを生成する
    # ...というほど大した感じでもないが

    $1.splite(/\s+/).each do |property| # ここがコードの解析器。単にsplitするだけ
      if property =~ /[a-z]\w*/ then
        # ここがコード生成器。文字列に変数を埋め込むだけ。簡単だ。
        puts <<-EOS
          # 生成されるゲッターメソッド
          def #{property}()
            @#{property}
          end

          # 生成されるセッターメソッド
          def #{property}=(v)
            @#{property}=v
          end
        EOS
      end
    end
  end
end

class Class
  # メソッドの定義をするのはクラス内。
  # 自動定義するためには、オブジェクトとしてのクラスにメソッドを定義してやればいい
  # 複数の文字列を受け取るメソッドにしよう
  def define_accessor *plist
    plist.each do |property|
      self.class_eval do
        # ゲッターメソッドの動的定義
        define_method property do
          return instance_variable_get("@#{property}")
        end

        # セッターメソッドの動的定義
        define_method "#{property}=" do |v|
          return instance_variable_set("@#{property}", v)
        end
      end
    end
  end
end

class SampleClass
  # 使ってみる
  define_accessor 'hoge', 'fuga', 'piyo'
end

s = SampleClass.new

s.hoge = 'hoge'
puts s.hoge
#=> hoge
#=> nil

　　 ／￣￣＼
 　／　ノ　　＼ ＼
 　|　 （●）（●）　|
 .　|　　（__人__）　 |　　　ごめんね
 　 |　　 ｀ ⌒´　　ﾉ
 .　 |　　　　　　 　 }
 .　 ヽ　　　　　 　 }
 　　 ヽ　　　　　ノ　　　　　　　　＼
 　　　/　　　 く　　＼　　　　　　　 ＼
 　　　|　　　　 ＼ 　 ＼ 　 　　　　　　＼
 　 　 |　　　　|ヽ、二⌒)､　 　 　　　　　 ＼
[ :format, :t, "Hello World!" ]

# puts(1, 2, sum(3, 4)) に相当
source = <
def reader source
  eval(source)
end

def evaluate sexp
  self.send( sexp.map{|exp|
               if exp.is_a?(Array) then
                 evaluate(exp)
               else exp
               end
             })
end

def sum(*args)
  args.inject(:+)
end

def expand_macro(sexp)
  if sexp[0] == :say
    return [:print, *sexp[1..-2], "\n"]
  else
    return sexp
  end
end

def evaluate sexp
  # 新たに追加されたマクロ展開のステップ
  expanded_sexp = expand_macro(sexp)

  self.send( *expanded_sexp.map{|exp|
               if exp.is_a?(Array) then
                 evaluate(exp)
               else exp
               end
             })
end

# puts(1, 2, sum(3, 4)) に相当
source = <
def sum(*args)
  args.inject(:+)
end

def expand_macro(sexp)
  if sexp[0] == :say
    return [:print, *sexp[1..-2], "\n"]
  else
    return sexp
  end
end

source = <

注意

Abstract

Contents

Example usage

Download and installation

Support and mailing lists

Syntax and Semantics

The CL-WHO dictionary

注意

Contents

Hash Tables（ハッシュテーブル）

Data and Control Flow（データと制御構造）

訳注： prog 族

Conses（コンス）

Sequences（シーケンス）

Macro Writing（マクロを書く）

Symbols（シンボル）

Arrays（配列）

Types（型）

Numbers（数）

おおきな訳注：パスネーム、ディレクトリ形式、真の名前について

ここから翻訳

Abstract

Contents

Download and installation

Supported Lisp implementations

The CL-FAD dictionary

Acknowledgements

きっかけ

メタ度が足りねーなと一瞬思った

メタプログラミング＝コード生成

だよね？

その発想で考えるとどういうことになるかというと。

じゃあ、まずはパーサを作ろう（おもむろにlexとyaccを取り出して）

もっとRubyのコードに

これってattr_accessorじゃないですかー！ やだー！

何が言いたいかというと

所感

ところでメタプログラミングといえばLISP

最後に

なんで勉強するんですか？

将来のためとかわかんねーし

お前がそう言うなら美しいんだろう、おまえの世界はな

勉強したい時

その他

これは『実践 Common LISP』読んだ上でのわかりづらかったポイントの個人的なメモ

括弧

シンボル

そしてこれは今もってLISPわけわかんねえ……ぱねえ……と思うこと

処理系依存の仕様

汎用言語であること

Hyperspecの日本語訳がないこと

LISPerの存在

文法知識だけあっても結局実装したい対象への理解がなければよいものは作れないこと

思いついた

ソースの表現

読取器と評価器

マクロ

ソースの全体

やってみた感想

訳注： `prog` 族

これってattr_accessorじゃないですかー！　やだー！