阅读Maxima的源代码时记下的一些笔记, 仅此而已.
while宏的功能恰如其名.
(defmacro while (cond &rest body)
`(do ()
((not ,cond))
,@body))maxima-getenv是平台无关的获取环境变量的值的函数.
(defun maxima-getenv (envvar)
#+gcl (si::getenv envvar)
#+ecl (si::getenv envvar)
#+allegro (system:getenv envvar)
#+(or cmu scl) (cdr (assoc envvar ext:*environment-list* :test #'string=))
#+sbcl (sb-ext:posix-getenv envvar)
#+clisp (ext:getenv envvar)
#+(or openmcl mcl) (ccl::getenv envvar)
#+lispworks (hcl:getenv envvar)
#+abcl (ext:getenv envvar)
)bye是平台无关的退出过程.
(defun bye (&optional (exit-code 0))
(declare (ignorable exit-code))
#+scl (ext:quit)
#+clisp (ext:quit exit-code)
#+sbcl (sb-ext:quit :unix-status exit-code)
#+allegro (excl:exit exit-code :quiet t)
#+(or mcl openmcl) (ccl:quit exit-code)
#+gcl (system::quit exit-code)
#+ecl (si:quit exit-code)
#+lispworks (lispworks:quit)
#+abcl (cl-user::quit)
#+gcl (lisp::bye)
#+cmucl
(handler-case (ext:quit nil exit-code)
;; Only the most recent versions of cmucl support an exit code.
;; If it doesn't, we get a program error (wrong number of args),
;; so catch that and just call quit without the arg.
(program-error ()
(ext:quit)))
)map2c的参数f应该是一个接受两个参数的函数, 而l应该是一个长度为偶数的列表. 其与mapcar有类似的地方, 但是一次连续从列表中吃下两个元素, 并且最终积累结果的列表顺序是颠倒的. 对于性质列表上的迭代有用.
(defun map2c (f l)
(do ((llt l (cddr llt)) (lans))
((null llt) lans)
(push (funcall f (car llt) (cadr llt)) lans)))> (map2c #'+ '(1 2 3 4 5 6))
(11 7 3)andmapcar类似于mapcar, 但是若从左到右依次应用f途中返回nil, 则整个函数立即返回nil. (对于我这个Schemer而言, 大概需要注意不要将其与许多Scheme实现提供的andmap混淆.)
(defun andmapcar (f l &aux d answer)
(do ((l l (cdr l)))
((null l) (nreverse answer))
(setq d (funcall f (car l)))
(if d (push d answer) (return nil))))xor即不可兼或.
(defun xor (a b)
(or (and (not a) b) (and (not b) a)))among在功能上类似于memq, 但是其在整个列表结构中寻找对象, 而不是一个扁平的列表中. (注意, memq不是Common Lisp标准中的过程, 但是Scheme标准和Emacs Lisp包含这个过程, 也有Common Lisp实现包含这个过程.)
(defun among (x l)
(cond ((null l) nil)
((atom l) (eq x l))
(t (or (among x (car l)) (among x (cdr l))))))amongl类似于among, 但是此时x是一列需要寻找的对象, 找到其中一个即可.
(defun amongl (x l)
(cond ((null l) nil)
((atom l) (member l x :test #'eq))
(t (or (amongl x (car l)) (amongl x (cdr l))))))subtree-p判断一个树是否是另一个的子树. 默认情况下使用eql作为相等谓词, 但用户也可提供自己的谓词.
(defun subtree-p (branch tree &key (test #'eql))
(or (funcall test branch tree)
(and (not (atom tree))
(member branch tree
:test (lambda (x y) (subtree-p x y :test test))))))dot2l将关联列表转换为性质列表.
(defun dot2l (l)
(cond ((null l) nil)
(t (list* (caar l) (cdar l) (dot2l (cdr l))))))> (dot2l '((a . b) (c . d)))
(A B C D)cput类似于putprop, 但是读者需要注意一下, Maxima的putprop里的参数顺序和一般情况不太一样. 另外就是putprop并不在Common Lisp标准之中, 但是有的Common Lisp实现会提供. 如果不提供的话, 可以使用setf和get达成同样的目的. 其他Lisp方言及其实现有的也提供putprop或者类似的函数. cput和putprop的区别在于, 若val为nil, 则从与符号相关联的性质列表中删去这个性质, 可能这会使其看上去更紧凑. 至于若val为nil时返回nil, 是因为这可以让人区别两种不同的情况 (当然, 这也是为了与putprop保持一致), 而zl-remprop是根据性质的有无返回t或者nil.
(defun cput (bas val sel)
(cond ((null val)
(zl-remprop bas sel)
nil)
(t
(putprop bas val sel))))William Schelter (Maxima最终能够成功开源离不开他的努力) 编写的迭代设施, 但现已被Common Lisp提供的loop宏取代.
(defmacro sloop (&rest body)
(warn (intl:gettext "Using deprecated macro 'sloop'. Use 'loop' instead."))
`(loop ,@body))$assoc类似于assoc,
(defmfun $assoc (key ielist &optional default)
(let ((elist (if (listp ielist)
(margs ielist)
(merror
(intl:gettext
"assoc: second argument must be a nonatomic expression; found: ~:M")
ielist))))
(if (every #'(lambda (x) (and (listp x) (= 3 (length x)))) elist)
(let ((found (find key elist :test #'alike1 :key #'second)))
(if found (third found) default))
(merror
(intl:gettext
"assoc: every argument must be an expression of two parts; found: ~:M")
ielist))))assol类似于assoc, 但是使用alike1作为相等谓词. assolike不是返回序对, 而是直接返回对应的值.
(defun assol (item alist)
(dolist (pair alist)
(if (alike1 item (car pair)) (return pair))))
(defun assolike (item alist)
(cdr (assol item alist)))memalike类似于member, 但是使用alike1比较相等性.
(defun memalike (x l)
(do ((l l (cdr l)))
((null l))
(when (alike1 x (car l)) (return l))))find-duplicate寻找列表中的重复元素, 默认使用eql进行比较. 如果提供了key函数, 那就是比较键值. find-duplicate会返回第一个发现的重复元素, 更准确地说, 是自左往右依次数, 直到碰到重复的情况.
(defun find-duplicate (list &key (test #'eql) key)
(declare (optimize (speed 3)))
(declare (type (or function null) key)
(type function test))
(let ((seen nil))
(dolist (e list)
(let ((i (if key (funcall key e) e)))
(when (member i seen :test test)
(return-from find-duplicate e))
(push i seen)))))(defmfun $gensym (&optional x)
(typecase x
(null
(intern (symbol-name (gensym "$G")) :maxima))
(string
(intern
(symbol-name (gensym (format nil "$~a" (maybe-invert-string-case x))))
:maxima))
((integer 0)
(let ((*gensym-counter* x))
(intern (symbol-name (gensym "$G")) :maxima)))
(t
(merror
(intl:gettext
"gensym: Argument must be a nonnegative integer or a string. Found: ~M") x))))(defun is-short-option (arg)
(and (>= (length arg) 2)
(char= #\- (schar arg 0))
(char/= #\- (schar arg 1))))
(defun is-option-terminator (arg)
(and (= 2 (length arg))
(char= #\- (schar arg 0))
(char= #\- (schar arg 1))))
(defun is-long-option (arg)
(and (> (length arg) 2)
(char= #\- (schar arg 0))
(char= #\- (schar arg 1))
(char/= #\- (schar arg 2))))(defun analyze-arg (arg)
"Analyzes an argument. Returns option-type,base-name,argument"
(let* ((option-type (cond ((is-short-option arg) :short)
((is-long-option arg) :long)
(t :arg))))
(if (or (eq option-type :short) (eq option-type :long))
(multiple-value-bind (base arg) (decompose-arg arg option-type)
(values option-type base arg))
(values :arg arg nil))))类似于PUSH, 但是列表的另一端操作. ncons实际上来源于MACLISP, (ncons x)就相当于(list x)或者(cons x nil). 一般的Common Lisp实现不会提供ncons这个过程.
(defmacro tuchus (list object)
`(setf ,list (nconc ,list (ncons ,object))))> (defvar l0 '())
L0
> (tuchus l0 'foo)
(FOO)
> (tuchus l0 'bar)
(FOO BAR)
> (tuchus l0 'baz)
(FOO BAR BAZ)(defun margs (form)
(if (eq (caar form) 'mqapply)
(cddr form)
(cdr form)))