传说中的DSL
lisp中的dsl
什么是dsl,为什么要dsl
显然对于特定的领域,特定的程序是更好的解决方案,这个程序就是DSL[1].lisp非常方便来实现DSL。在land of lisp一书中进行了两种dsl,一种是生成xml或html,另一种是对我们之前wizard游戏的中的游戏命令进行dsl。
生成svg文件
关于svg文件不加以详述,读者可以参考这里 。这非常重要,只有理解了xml文件的格式才能继续我们的dsl。svg采用xml格式,顺便我们也说说生成网页的dsl。
首先写一个辅助函数,
;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 #\>))
可以试试
(print-tag 'mytag '((color . blue) (height . 9)) nil)
然后创造生成标签的宏,宏能在以下几个方面提供不可替代的改善:
- 标签总是成对的,如果想要嵌套标签,函数办不到。因为它要求我们在嵌套标签被求值之前和之后执行代码。这在宏中是可能的,函数却做不到。
- 标签名和属性名通常不必通过动态方式改变。因此,把标签名通过单引号引用是多余的。换句话说,标签名应该默认被对待为想数据模式一样。
- 不像标签名,属性值则应该动态生成。我们的宏将拥有这么一个语法去把属性值放到代码模式,让我们可以执行lisp代码去生成这些值。
总之我们想让我们的宏看上去这样:
(tag mytag (color 'blue height (+ 4 5))) <mytag color="BLUE" height="9"><mytag>
我们这么做:
(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)))
很好的实现了以上要求,可以展开看看:
(macroexpand '(tag mytag (color 'blue height (+ 4 5))))
可以看看如何实现嵌套的:
(tag mytag (color 'blue size 'big) (tag first_inner_tag ()) (tag second_inner_tag ()))
我们还可以用来生成html
(tag html ();比之前我们生成html的版本好看多了…… (tag body () (princ "Hello World!")))
html的标签是特定的,我们还能为特定的html标签编写宏:
(defmacro html (&body body) `(tag html () ,@body)) (defmacro body (&body body) `(tag body () ,@body)) (html (body (princ "Hi boys")))
好了,不跑题了,开始写生成svg的宏
;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))
写一个函数专门加深色彩,方便我们绘图
(defun brightness (col amt) (mapcar (lambda (x) (min 255 (max 0 (+ x amt)))) col)) (brightness '(255 0 0) -100)
使用一个svg样式函数生成颜色属性,边比内部颜色深.注意~{和~}可以起遍历的作用。
(defun svg-style (color) (format nil "~{fill:rgb(~a,~a,~a);stroke:rgb(~a,~a,~a)~}" (append color;边界比内部颜色更深 (brightness color -100))))
于是得到生成圆的一个函数
(defun circle (center radius color) (tag circle (cx (car center) cy (cdr center) r radius style (svg-style color))))
最后可以简单的得到svg文件
(svg (circle '(50 .50) 50 '(255 0 0)) (circle '(100 . 100) 50 '(0 0 255)))
还可以写些更复杂的svg例子,比如一个多边形
;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函数,我想读者应该知道是干什么的
(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);测试
写进一个文件
(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
首先别忘了加载那个游戏
;Creating Custom Game Commands for Wizard's Adventure Game (load "wizards_game")
添加两个命令,一个把链条和篮子焊接在一起,另一个用焊好的篮子从井里打水。
;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,把水泼到巫师脸上……
;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.))))
试试我们的新游戏,很棒不是?
(game-repl)
小结
- 当你需要一些特定领域的古怪的程序,宏是很棒的方案。通过它们,你可以创建自己的dsl。
- 通常,首先为宏写一个辅助函数,然后写宏来提供宏能提供的提升。这些提高通常关乎能更清晰更安全地语法来使用代码。
- 你可以混合DSL和常规Lisp 程序。lisp程序可以更方便你调试。
- DSL非常有用,当你需要写下非常特定代码-–—无论是生成网页,代码,或是画图,或是建立特殊的游戏命令的代码。
照例的废话
寝室的室友在看dota比赛,不要这么激情好么,吵死了。晚上试着跑了将近一个小时步,感觉不错。