例子
(defvar *db* nil)
(defun make-cd (title artist rating ripped)
(list :title title :artist artist :rating rating :ripped ripped))
(defun add-record (cd)
(push cd *db*))
(defun dump-db ()
(dolist (cd *db*)
(format t "~{~a:~10t~a~%~}~%" cd)))
(defun prompt-read (prompt)
(format *query-io* "~a:" prompt)
(force-output *query-io*)
(read-line *query-io*))
(defun prompt-for-cd ()
(make-cd
(prompt-read "Title")
(prompt-read "Aritist")
(or (parse-integer (prompt-read "Rating") :junk-allowed t) 0)
(y-or-n-p "Ripped(y/n)")))
(defun add-cds ()
(loop
(add-record (prompt-for-cd))
(if (not (y-or-n-p "add another(y/n)?"))
(return))))
(defun save-db (filename)
(with-open-file (out filename
:direction :output
:if-exists :supersede)
(with-standard-io-syntax
(print *db* out))))
(defun load-db (filename)
(with-open-file (in filename)
(with-standard-io-syntax
(setf *db* (read in)))))
(defun clear-db () (setf *db* nil))
;;;-------------------------------------------------------
(defun select-by-artist (artist)
(remove-if-not
#'(lambda (cd) (equal (getf cd :artist) artist))
*db*))
(defun select (select-fn) (remove-if-not select-fn *db*))
(defun artist-selector (artist)
#'(lambda (cd) (equal (getf cd :artist) artist)))
;;;关键字参数&key
;;;没传的默认nil,可以设置默认值,supplied-p传值了为t否则nil
(defun foo (&key a (b 10) (c 30 c-p))
(list a b c c-p))
;;;通用选择器函数
; (defun where (&key title artist rating (ripped nil ripped-p))
; #'(lambda (cd)
; (and
; (if title (equal (getf cd :title) title) t)
; (if artist (equal (getf cd :artist) artist) t)
; (if rating (equal (getf cd :rating) rating) t)
; (if ripped-p (equal (getf cd :ripped) ripped) t))))
; ;;;-------------------------------------------------------
; (defun update (select-fn &key title artist rating (ripped nil ripped-p))
; (setf *db*
; (mapcar
; #'(lambda (row)
; (when (funcall select-fn row)
; (if title (setf (getf row :title) title))
; (if artist (setf (getf row :artist) artist))
; (if rating (setf (getf row :rating) rating))
; (if ripped-p (setf (getf row :ripped) ripped)))
; row) *db*)))
; ;不要评价别人容貌,因为他不靠你吃饭;不要评价别人德行,因为你未必有他高尚;不要评价别人家庭,因为那和你无关。记住不要评价任何人。不要乱花钱,因为明天你就可能失业;不要趾高气扬,因为明天你就可能失势;不要吹嘘爱情,因为明天你就可能失恋;不要委屈自己,因为明天会更美好。
; (defun delete-rows (select-fn)
; (setf *db* (remove-if (select-fn) *db*)))
; ;;;;
; (defmacro backwards (expr) (reverse expr))
; (defun make-comparison-expr (field value)
; (list 'equal (list 'getf 'cd field) value))
; '(1 2 3)
; `(1 2 3 (+ 1 2))
; `(1 2 3 ,(+ 1 2))
; `(and ,(list 1 2 3))
; `(and ,@(list 1 2 3))
(defun make-comparison-expr (field value)
`(equal (getf cd ,field) ,value))
(defun make-comparison-list (fields)
(loop while fields
collecting (make-comparison-expr (pop fields) (pop fields))))
(defmacro where (&rest clauses)
`#'(lambda (cd) (and ,@(make-comparison-list clauses))))
(select (where :title "a" :artist "a"))
;自身求值(原子(字符串 数值) 关键字符号 ) 列表求值(函数 宏 特殊形式)
;函数求值(+ 1 2)
;1自身求值 2自身求值 把结果传给+求值
;特殊操作符求值 25个
;(if x (format t "yes") (format t "no"))
;(quote (+ 1 2)) ==========='(+ 1 2)
;宏 是一个以s表达式为参数的函数,返回一个lisp形式,编译时展开编译成FASL文件
; 宏形式的元素不经过求值传递到宏函数里,宏函数展开求值。
; 符号nil是唯一的假值,其他都是真值,符合t是标准的真值
; nil还可以表示空列表() nil () 'nil '() 求值相同 t 't求值也相同。
; 等价谓词
; =比较数字
; char=比较字符
; EQ EQL EQUAL EQUALP
; EQL 相同类型的相同对象 1 1.0 就不同
; 更加通用的是EQUAL EQUALP,可以操作在所有类型的对象上
; 允许不同的对象是等价的。
; EQUAL认为相同字符的字符串是等价的,而EQL就不这样
; EQUALP 更加宽松,相同字符窜忽略大小写等价,数字在数学意义上等价
; 格式化
; (some-function arg-with-a-long-name
; anoter-arg-with-a-long-name)
; 实现控制结构的宏和特殊形式在缩进上不同主体空两格
; (defun print-list (list)
; (dolist (i list)
; (format t "item:~a~%" i)))
;;;;文件头注释
;;;段落
;;下句
;行内尾部注释