例子

(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)))
 
;;;;文件头注释
;;;段落
;;下句
;行内尾部注释




posted @ 2012-04-10 17:37  舜耕山翁  阅读(175)  评论(0编辑  收藏  举报