盒子
盒子
文章目录
  1. lisp中的dsl
    1. 什么是dsl，为什么要dsl
    2. 生成svg文件
    3. 对先前的游戏进行dsl
    4. 小结
    5. 照例的废话

传说中的DSL

2012-06-16 | Liu Yuyang | lisp

lisp中的dsl

什么是dsl，为什么要dsl

显然对于特定的领域，特定的程序是更好的解决方案，这个程序就是DSL[1].lisp非常方便来实现DSL。在land of lisp一书中进行了两种dsl，一种是生成xml或html，另一种是对我们之前wizard游戏的中的游戏命令进行dsl。

生成svg文件

关于svg文件不加以详述，读者可以参考这里 。这非常重要，只有理解了xml文件的格式才能继续我们的dsl。svg采用xml格式，顺便我们也说说生成网页的dsl。

首先写一个辅助函数，

1
;Creating XML and HTML with the tag Macro
;Writing a Macro Helper Function
(defun print-tag (name alst closingp)
  (princ #\<)
  (when closingp
    (princ #\/))
  (princ (string-downcase name))
  (mapc (lambda (att);使用mapc是为了副作用。它总返回第一个参数
          (format t " ~a=\"~a\"" (string-downcase (car att)) (cdr att)))
        alst)
  (princ #\>))

可以试试

1
(print-tag 'mytag '((color . blue) (height . 9)) nil)

然后创造生成标签的宏，宏能在以下几个方面提供不可替代的改善：

  • 标签总是成对的，如果想要嵌套标签，函数办不到。因为它要求我们在嵌套标签被求值之前和之后执行代码。这在宏中是可能的，函数却做不到。
  • 标签名和属性名通常不必通过动态方式改变。因此，把标签名通过单引号引用是多余的。换句话说，标签名应该默认被对待为想数据模式一样。
  • 不像标签名，属性值则应该动态生成。我们的宏将拥有这么一个语法去把属性值放到代码模式，让我们可以执行lisp代码去生成这些值。

总之我们想让我们的宏看上去这样：

1
(tag mytag (color 'blue height (+ 4 5)))
<mytag color="BLUE" height="9"><mytag>

我们这么做：

1
(defmacro tag (name atts &body body)
  `(progn (print-tag ',name
                     (list ,@(mapcar (lambda (x)
                                       `(cons ',(car x) ,(cdr x)))
                                     (pairs atts)))
                     nil)
          ,@body
          (print-tag ',name nil t)))

很好的实现了以上要求，可以展开看看：

1
(macroexpand '(tag mytag (color 'blue height (+ 4 5))))

可以看看如何实现嵌套的：

1
(tag mytag (color 'blue size 'big)
  (tag first_inner_tag ())
  (tag second_inner_tag ()))

我们还可以用来生成html

1
(tag html ();比之前我们生成html的版本好看多了……
  (tag body ()
    (princ "Hello World!")))

html的标签是特定的，我们还能为特定的html标签编写宏：

1
(defmacro html (&body body)
  `(tag html ()
     ,@body))
(defmacro body (&body body)
  `(tag body ()
     ,@body))
(html (body (princ "Hi boys")))

好了，不跑题了，开始写生成svg的宏

1
;Creating SVG-Specific Macros and Functions 
(defmacro svg (&body body)
  `(tag svg (xmlns "http://www.w3.org/2000/svg";声明标准在哪里
             "xmlns:xlink" "http://www.w3.org/1999/xlink");链接
        ,@body))

写一个函数专门加深色彩，方便我们绘图

1
(defun brightness (col amt)
  (mapcar (lambda (x)
            (min 255 (max 0 (+ x amt))))
          col))
(brightness '(255 0 0) -100)

使用一个svg样式函数生成颜色属性，边比内部颜色深.注意～{和～}可以起遍历的作用。

1
(defun svg-style (color)
  (format nil
          "~{fill:rgb(~a,~a,~a);stroke:rgb(~a,~a,~a)~}"
          (append color;边界比内部颜色更深
                  (brightness color -100))))

于是得到生成圆的一个函数

1
(defun circle (center radius color)
  (tag circle (cx (car center)
                  cy (cdr center)
                  r radius
                  style (svg-style color))))

最后可以简单的得到svg文件

1
(svg (circle '(50 .50) 50 '(255 0 0))
     (circle '(100 . 100) 50 '(0 0 255)))

还可以写些更复杂的svg例子，比如一个多边形

1
;Building a More Complicated SVG Example
(defun polygon (points color)
  (tag polygon (points (format nil
                               "~{~a,~a ~}";~{允许我们迭代
                               (mapcan (lambda (tp)
                                         (list (car tp) (cdr tp)));mapcan是有append的mapcar
                                       points))
                       style (svg-style color))))

写个random-walk函数，我想读者应该知道是干什么的

1
(defun random-walk (value length)
  (unless (zerop length)
    (cons value
          (random-walk (if (zerop (random 2))
                         (1- value)
                         (1+ value))
                       (1- length)))))
(random-walk 100 10);测试

写进一个文件

1
(with-open-file (*standard-output* "random_walk.svg"
                                   :direction :output
                                   :if-exists :supersede)
  (svg (loop repeat 10
             do (polygon (append '((0 . 200))
                                 (loop for x;又是这种风格，sbcl识别不了啊
                                       for y in (random-walk 100 400)
                                       collect (cons x y))
                                 '((400 . 200)))
                         (loop repeat 3
                               collect (random 256))))))

用你的浏览器打开random_walk.svg看看吧，生成大概这样的图像:
“random_walk”:/images/random_walk.svg

对先前的游戏进行dsl

首先别忘了加载那个游戏

1
;Creating Custom Game Commands for Wizard's Adventure Game
(load "wizards_game")

添加两个命令，一个把链条和篮子焊接在一起，另一个用焊好的篮子从井里打水。

1
;Creating New Game Commands by Hand
;A Command for Welding
(defun have (object)
  (member object (inventory)))
(defparameter *chain-welded* nil)
(defun weld (subject object)
  (if (and (eq *location* 'attic)
           (eq subject 'chain)
           (eq obejct 'bucket)
           (have 'chain)
           (have 'bucket)
           (not *chain-welded*))
    (progn (setf *chain-welded* t)
           '(the chain is now securely welded to the bucket.))
    '(you cannot weld like that)))
(weld 'chain 'bucket)
;(game-repl)
(pushnew 'weld *allowed-commands*);这很关键，不是吗？
;A Command for Dunking
(setf *bucket-filled* nil)

(defun dunk (subject object)
  (if (and (eq *location* 'garden)
           (eq subject 'bucket)
           (eq object 'well)
           (have 'bucket)
           *chain-welded*)
    (progn (setf *bucket-filled* 't)
           '(the bucket is now full of water))
    '(you cannot dunk like that.)))
(pushnew 'dunk *allowed-commands*)

发现没？这两种命令很相似，我们来dsl,重新用我们的宏来重新添加上两个命令，另为我们还添加了一个更复杂的命令splash，把水泼到巫师脸上……

1
;The game-action Macro
(defmacro game-action (command subj obj place &body body)
  (let1 subject (gensym) (let1 object (gensym) 
  `(progn (defun ,command (,subject ,object)
            (if (and (eq *location* ',place)
                     (eq ,subject ',subj)
                     (eq ,object ',obj)
                     (have ',subj))
            ,@body 
            '(i cant ,command like that.)))
  (pushnew ',command *allowed-commands*)))))
;rewrite
(defparameter *chain-welded* nil)
(game-action weld chain bucket attic
  (if (and (have 'bucket) (not *chain-welded*))
    (progn (setf *chain-welded* 't)
           '(the chain is now securely welded to the bucket.))
    '(you do not have a bucket.)))
(setf *bucket-filled* nil)
(game-action dunk bucket well garden
  (if *chain-welded*
    (progn (setf *bucket-filled* 't)
           '(the bucket is now full of water))
    '(the water level is too low to reach.)))
(game-action splash bucket wizard living-room
  (cond ((not *bucket-filled*) '(the bucket has nothing in it.))
        ((have 'frog) '(the wizard awakens and sees that you stole his frog.
                            he is so upset he banishes you to the
                            netherworlds- you lose! the end.))
        (t '(the wizard awakens from his slumber and greets you warmly.
                 he hands you the magic low-carb donut- you win! the end.))))

试试我们的新游戏，很棒不是？

1
(game-repl)

小结

  • 当你需要一些特定领域的古怪的程序，宏是很棒的方案。通过它们，你可以创建自己的dsl。
  • 通常，首先为宏写一个辅助函数，然后写宏来提供宏能提供的提升。这些提高通常关乎能更清晰更安全地语法来使用代码。
  • 你可以混合DSL和常规Lisp 程序。lisp程序可以更方便你调试。
  • DSL非常有用，当你需要写下非常特定代码——无论是生成网页，代码，或是画图，或是建立特殊的游戏命令的代码。

照例的废话

寝室的室友在看dota比赛，不要这么激情好么，吵死了。晚上试着跑了将近一个小时步，感觉不错。

[^1]: domian-specific language