例子

(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)))

 

;;;;文件头注释

;;;段落

;;下句

;行内尾部注释

通过 Wiz 发布

转载于:https://www.cnblogs.com/aczhanghua/archive/2012/04/10/2440977.html