在FreeBSD及ArchLinux中, 我常使用SBCL。
启动脚本:
>cat ~/bin/sb
breakchars="(){}[],^%$#@\"\";:''|\\"
cd /media/E/work
exec rlwrap --remember -c -b "$breakchars" -f "$HOME"/.sbcl_completions -S 'λ> ' sbcl --noinform "$@"
其中,~/.sbcl_completions由以下代码产生:
(let (symbols)
(do-all-symbols (sym)
(let ((package (symbol-package sym)))
(cond
((not (fboundp sym)))
((or (eql #.(find-package :cl) package)
(eql #.(find-package :cl-user) package))
(pushnew (symbol-name sym) symbols))
((eql #.(find-package :keyword) package)
(pushnew (concatenate 'string ":" (symbol-name sym)) symbols))
(package
(pushnew (concatenate 'string (package-name package) ":" (symbol-name sym symbols)))))
(with-open-file (output (merge-pathnames ".sbcl_completions" (user-homedir-pathname))
:direction :output :if-exists :overwrite
:if-does-not-exist :create)
(format output "~{~(~A~)~%~}" (sort symbols #'string<))))
运行控制文件:
>cat ~/.sbclrc
;;; The following lines added by ql:add-to-init-file:
#-quicklisp
(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname))))
(when (probe-file quicklisp-init)
(load quicklisp-init)))
(defun setup-registry (directory-path)
;(format t "; adding components under ~A to asdf registry~%" directory-path)
(mapc (lambda (asd-pathname)
(pushnew (make-pathname :name nil :type nil :version nil :defaults asd-pathname) asdf:*central-registry*))
(directory (merge-pathnames #p"*/*.asd" directory-path))))
(setup-registry #p"/media/E/myapp/")
(setup-registry #p"/media/E/www/qachina/")
;(asdf:operate 'asdf:load-op :myapp)
;(myapp:start-myapp)
; disable dubugger same as '--disable-debugger' commmand line option
;(defun debug-ignore (c h) (declare (ignore h)) (print c) (abort))
;(setf*debugger-hook* #'debug-ignore)
;(setf *invoke-debugger-hook*
; (lambda (condition hook)
; (declare (ignore hook))
; Uncomment to get backtraces on errors
; (sb-debug:backtrace 20)
; (format *error-output* "Error: ~A~%" condition)) (abort))
(load "util")
一些常用函数放在util.lisp中:
>cat /media/E/work/util.lisp
;(sys-src-dir "hunchentoot" => #P"/home/sw2wolf/quicklisp/dists/quicklisp/software/hunchentoot-1.2.6/"
defun pkg-src-dir (name)
(asdf:system-source-directory name))
;(pkg-ver "hunchentoot") => 1.2.6
(defun pkg-ver (system-designator)
(let ((system (asdf:find-system system-designator nil)))
(when (and system (slot-boundp system 'asdf:version))
(asdf:component-version system))))
;在QuickLisp中查找软件包
(defun find-pkg (name)
(ql:system-apropos name))
(defun leap-year-p (year)
(destructuring-bind (fh h f)
(mapcar #'(lambda (n) (zerop (mod year n))) '(400 100 4))
(or fh (and (not h) f))))
(defun now ()
(multiple-value-bind (second minute hour day month year) (get-decoded-time)
(format t "~4,'0D-~2,'0D-~2,'0D ~2,'0D:~2,'0D:~2,'0D" year month day hour minute second)))
(defun my-getenv (name &optional default)
#+CMU
(let ((x (assoc name ext:*environment-list* :test #'string=)))
(if x (cdr x) default))
#-CMU
(or
#+Allegro (sys:getenv name)
#+CLISP (ext:getenv name)
#+ECL (si:getenv name)
#+SBCL (sb-unix::posix-getenv name)
#+LISPWORKS (lispworks:environment-variable name)
default))
(defun sh (cmd)
#+clisp
(let ((str (ext:run-shell-command cmd :output:stream)))
(loop for line = (read-line str nil)
until (null line)
do (print line)))
#+ecl (si:system cmd)
#+sbcl (sb-ext:run-program "/bin/sh" (list "-c" cmd) :input nil :output *standard-output*)
#+clozure (ccl:run-program "/bin/sh" (list "-c" cmd) :input nil :output *standard-output*)))
(defun sys-info ()
(formatt"Machine: ~S ~S ~S~%OS: ~S ~S~%Lisp: ~S ~S~%"
(machine-type) (machine-version)(machine-instance)
(software-type) (software-version)
(lisp-implementation-type) (lisp-implementation-version )))
;根据关键字类型以不同方式查找关联表
(defgeneric assoc* (thing alist)
(:method ((thing symbol) alist)
(assoc thing alist :test #'eq))
(:method ((thing string) alist)
(assoc thing alist :test #'string-equal))
(:method (thing alist)
(assoc thing alist :test #'eql)))
;阶乘
(defun fac (n)(reduce#'* (loopfor ifrom 1to ncollect i)))
(defun fab (n)
"菲波纳契数列。不用递归,直接加在列表尾部,极高的性能"
(let ((res (list 1 1)))
(loop for i from 2to n do
(nconc res (list (+ (nth (- i 2) res) (nth (- i 1) res)))))
res))
;返回整数的二进制表示
(defun bits (n) (format t "~b" n))
;完美数
(defun perfectp (n) (= n (loop for ifrom 1below nwhen (= 0 (mod n i))sum i)))
(defun perfect-number (s e)
(loop for ifrom sto e when (perfectp i)collect i))
...
编译及运行lisp程序的脚本文件:
>cat ~/bin/sbcl.compile
#!/bin/bash
sbcl --noinform --eval "(compile-file \"$1\")" --eval "(quit)" > /dev/null
使用方法
>sbcl.compile hello.lisp
将生成hello.fasl文件
>cat ~/bin/sbcl.run
#!/bin/bash
sbcl --noinform --load --quit $1 --end-toplevel-options "$@"
使用方法
# sbcl.run hello.fasl
BTW, now it is VERY simple to build the newest SBCL from your current sbcl:
$git clone git://git.code.sf.net/p/sbcl/sbcl && cd sbcl
$sh make.sh --prefix=/home/***/sbcl/ --xc-host="sbcl --disable-debugger --no-sysinit --no-userinit"