sbcl stuff
This commit is contained in:
Ian Keane
parent
1d1dbc34df
commit
5d91dbb667
335 changed files with 119806 additions and 1 deletions
|
|
@ -0,0 +1,410 @@
|
|||
;;; cl-lib.el --- Properly prefixed CL functions and macros -*- coding: utf-8 -*-
|
||||
|
||||
;; Copyright (C) 2012, 2013, 2014 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
;; vcomment: Emacs-24.3's version is 1.0 so this has to stay below.
|
||||
;; Version: 0.5
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This is a forward compatibility package, which provides (a subset of) the
|
||||
;; features of the cl-lib package introduced in Emacs-24.3, for use on
|
||||
;; previous emacsen.
|
||||
|
||||
;; Make sure this is installed *late* in your `load-path`, i.e. after Emacs's
|
||||
;; built-in .../lisp/emacs-lisp directory, so that if/when you upgrade to
|
||||
;; Emacs-24.3, the built-in version of the file will take precedence, otherwise
|
||||
;; you could get into trouble (although we try to hack our way around the
|
||||
;; problem in case it happens).
|
||||
|
||||
;; This code is largely copied from Emacs-24.3's cl.el, with the alias bindings
|
||||
;; simply reversed.
|
||||
|
||||
;;; Code:
|
||||
|
||||
;; We need to handle the situation where this package is used with an Emacs
|
||||
;; that comes with a real cl-lib (i.e. ≥24.3).
|
||||
|
||||
;; First line of defense: try to make sure the built-in cl-lib comes earlier in
|
||||
;; load-path so we never get loaded:
|
||||
;;;###autoload (let ((d (file-name-directory #$)))
|
||||
;;;###autoload (when (member d load-path)
|
||||
;;;###autoload (setq load-path (append (remove d load-path) (list d)))))
|
||||
|
||||
(when (functionp 'macroexp--compiler-macro)
|
||||
;; `macroexp--compiler-macro' was introduced as part of the big CL
|
||||
;; reorganization which moved/reimplemented some of CL into core (mostly the
|
||||
;; setf and compiler-macro support), so its presence indicates we're running
|
||||
;; in an Emacs that comes with the new cl-lib.el, where this file should
|
||||
;; never be loaded!
|
||||
(message "Real cl-lib shadowed by compatibility cl-lib? (%s)" load-file-name)
|
||||
(when load-file-name
|
||||
;; (message "Let's try to patch things up")
|
||||
(let ((loaddir (file-name-directory load-file-name))
|
||||
load-path-dir)
|
||||
;; Find the problematic directory from load-path.
|
||||
(dolist (dir load-path)
|
||||
(if (equal loaddir (expand-file-name (file-name-as-directory dir)))
|
||||
(setq load-path-dir dir)))
|
||||
(when load-path-dir
|
||||
;; (message "Let's move the offending dir to the end")
|
||||
(setq load-path (append (remove load-path-dir load-path)
|
||||
(list load-path-dir)))
|
||||
;; Here we could manually load cl-lib and then return immediately.
|
||||
;; But Emacs currently doesn't provide any way for a file to "return
|
||||
;; immediately", so instead we make sure the rest of the file does not
|
||||
;; throw away any pre-existing definition.
|
||||
))))
|
||||
|
||||
(require 'cl)
|
||||
|
||||
;; Some of Emacs-24.3's cl.el definition are not just aliases, because either
|
||||
;; the feature was dropped from cl-lib.el or because the cl-lib version is
|
||||
;; not fully compatible.
|
||||
;; Let's just not include them here, since it is very important that if code
|
||||
;; works with this cl-lib.el it should also work with Emacs-24.3's cl-lib.el,
|
||||
;; whereas the reverse is much less important.
|
||||
|
||||
(dolist (var '(
|
||||
;; loop-result-var
|
||||
;; loop-result
|
||||
;; loop-initially
|
||||
;; loop-finally
|
||||
;; loop-bindings
|
||||
;; loop-args
|
||||
;; bind-inits
|
||||
;; bind-block
|
||||
;; lambda-list-keywords
|
||||
float-negative-epsilon
|
||||
float-epsilon
|
||||
least-negative-normalized-float
|
||||
least-positive-normalized-float
|
||||
least-negative-float
|
||||
least-positive-float
|
||||
most-negative-float
|
||||
most-positive-float
|
||||
;; custom-print-functions
|
||||
))
|
||||
(let ((new (intern (format "cl-%s" var))))
|
||||
(unless (boundp new) (defvaralias new var))))
|
||||
|
||||
;; The following cl-lib functions were already defined in the old cl.el,
|
||||
;; with a different meaning:
|
||||
;; - cl-position and cl-delete-duplicates
|
||||
;; the two meanings are clearly different, but we can distinguish which was
|
||||
;; meant by looking at the arguments.
|
||||
;; - cl-member
|
||||
;; the old meaning hasn't been used for a long time and is a subset of the
|
||||
;; new, so we can simply override it.
|
||||
;; - cl-adjoin
|
||||
;; the old meaning is actually the same as the new except for optimizations.
|
||||
|
||||
(dolist (fun '(
|
||||
(get* . cl-get)
|
||||
(random* . cl-random)
|
||||
(rem* . cl-rem)
|
||||
(mod* . cl-mod)
|
||||
(round* . cl-round)
|
||||
(truncate* . cl-truncate)
|
||||
(ceiling* . cl-ceiling)
|
||||
(floor* . cl-floor)
|
||||
(rassoc* . cl-rassoc)
|
||||
(assoc* . cl-assoc)
|
||||
;; (member* . cl-member) ;Handle specially below.
|
||||
(delete* . cl-delete)
|
||||
(remove* . cl-remove)
|
||||
(defsubst* . cl-defsubst)
|
||||
(sort* . cl-sort)
|
||||
(function* . cl-function)
|
||||
(defmacro* . cl-defmacro)
|
||||
(defun* . cl-defun)
|
||||
(mapcar* . cl-mapcar)
|
||||
|
||||
remprop
|
||||
getf
|
||||
tailp
|
||||
list-length
|
||||
nreconc
|
||||
revappend
|
||||
concatenate
|
||||
subseq
|
||||
random-state-p
|
||||
make-random-state
|
||||
signum
|
||||
isqrt
|
||||
lcm
|
||||
gcd
|
||||
notevery
|
||||
notany
|
||||
every
|
||||
some
|
||||
mapcon
|
||||
mapcan
|
||||
mapl
|
||||
maplist
|
||||
map
|
||||
equalp
|
||||
coerce
|
||||
tree-equal
|
||||
nsublis
|
||||
sublis
|
||||
nsubst-if-not
|
||||
nsubst-if
|
||||
nsubst
|
||||
subst-if-not
|
||||
subst-if
|
||||
subsetp
|
||||
nset-exclusive-or
|
||||
set-exclusive-or
|
||||
nset-difference
|
||||
set-difference
|
||||
nintersection
|
||||
intersection
|
||||
nunion
|
||||
union
|
||||
rassoc-if-not
|
||||
rassoc-if
|
||||
assoc-if-not
|
||||
assoc-if
|
||||
member-if-not
|
||||
member-if
|
||||
merge
|
||||
stable-sort
|
||||
search
|
||||
mismatch
|
||||
count-if-not
|
||||
count-if
|
||||
count
|
||||
position-if-not
|
||||
position-if
|
||||
;; position ;Handle specially via defadvice below.
|
||||
find-if-not
|
||||
find-if
|
||||
find
|
||||
nsubstitute-if-not
|
||||
nsubstitute-if
|
||||
nsubstitute
|
||||
substitute-if-not
|
||||
substitute-if
|
||||
substitute
|
||||
;; delete-duplicates ;Handle specially via defadvice below.
|
||||
remove-duplicates
|
||||
delete-if-not
|
||||
delete-if
|
||||
remove-if-not
|
||||
remove-if
|
||||
replace
|
||||
fill
|
||||
reduce
|
||||
compiler-macroexpand
|
||||
define-compiler-macro
|
||||
assert
|
||||
check-type
|
||||
typep
|
||||
deftype
|
||||
defstruct
|
||||
callf2
|
||||
callf
|
||||
letf*
|
||||
letf
|
||||
rotatef
|
||||
shiftf
|
||||
remf
|
||||
psetf
|
||||
declare
|
||||
the
|
||||
locally
|
||||
multiple-value-setq
|
||||
multiple-value-bind
|
||||
symbol-macrolet
|
||||
macrolet
|
||||
progv
|
||||
psetq
|
||||
do-all-symbols
|
||||
do-symbols
|
||||
dotimes
|
||||
dolist
|
||||
do*
|
||||
do
|
||||
loop
|
||||
return-from
|
||||
return
|
||||
block
|
||||
etypecase
|
||||
typecase
|
||||
ecase
|
||||
case
|
||||
load-time-value
|
||||
eval-when
|
||||
destructuring-bind
|
||||
gentemp
|
||||
gensym
|
||||
pairlis
|
||||
acons
|
||||
subst
|
||||
;; adjoin ;It's already defined.
|
||||
copy-list
|
||||
ldiff
|
||||
list*
|
||||
cddddr
|
||||
cdddar
|
||||
cddadr
|
||||
cddaar
|
||||
cdaddr
|
||||
cdadar
|
||||
cdaadr
|
||||
cdaaar
|
||||
cadddr
|
||||
caddar
|
||||
cadadr
|
||||
cadaar
|
||||
caaddr
|
||||
caadar
|
||||
caaadr
|
||||
caaaar
|
||||
cdddr
|
||||
cddar
|
||||
cdadr
|
||||
cdaar
|
||||
caddr
|
||||
cadar
|
||||
caadr
|
||||
caaar
|
||||
tenth
|
||||
ninth
|
||||
eighth
|
||||
seventh
|
||||
sixth
|
||||
fifth
|
||||
fourth
|
||||
third
|
||||
endp
|
||||
rest
|
||||
second
|
||||
first
|
||||
svref
|
||||
copy-seq
|
||||
evenp
|
||||
oddp
|
||||
minusp
|
||||
plusp
|
||||
floatp-safe
|
||||
declaim
|
||||
proclaim
|
||||
nth-value
|
||||
multiple-value-call
|
||||
multiple-value-apply
|
||||
multiple-value-list
|
||||
values-list
|
||||
values
|
||||
pushnew
|
||||
decf
|
||||
incf
|
||||
|
||||
dolist
|
||||
dotimes
|
||||
))
|
||||
(let ((new (if (consp fun) (prog1 (cdr fun) (setq fun (car fun)))
|
||||
(intern (format "cl-%s" fun)))))
|
||||
(if (fboundp new)
|
||||
(unless (or (eq (symbol-function new) fun)
|
||||
(eq new (and (symbolp fun) (fboundp fun)
|
||||
(symbol-function fun))))
|
||||
(message "%S already defined, not rebinding" new))
|
||||
(defalias new fun))))
|
||||
|
||||
(unless (symbolp (symbol-function 'position))
|
||||
(autoload 'cl-position "cl-seq")
|
||||
(defadvice cl-position (around cl-lib (cl-item cl-seq &rest cl-keys) activate)
|
||||
(let ((argk (ad-get-args 2)))
|
||||
(if (or (null argk) (keywordp (car argk)))
|
||||
;; This is a call to cl-lib's `cl-position'.
|
||||
(setq ad-return-value
|
||||
(apply #'position (ad-get-arg 0) (ad-get-arg 1) argk))
|
||||
;; Must be a call to cl's old `cl-position'.
|
||||
ad-do-it))))
|
||||
|
||||
(unless (symbolp (symbol-function 'delete-duplicates))
|
||||
(autoload 'cl-delete-duplicates "cl-seq")
|
||||
(defadvice cl-delete-duplicates (around cl-lib (cl-seq &rest cl-keys) activate)
|
||||
(let ((argk (ad-get-args 1)))
|
||||
(if (or (null argk) (keywordp (car argk)))
|
||||
;; This is a call to cl-lib's `cl-delete-duplicates'.
|
||||
(setq ad-return-value
|
||||
(apply #'delete-duplicates (ad-get-arg 0) argk))
|
||||
;; Must be a call to cl's old `cl-delete-duplicates'.
|
||||
ad-do-it))))
|
||||
|
||||
(when (or (not (fboundp 'cl-member))
|
||||
(eq (symbol-function 'cl-member) #'memq))
|
||||
(defalias 'cl-member #'member*))
|
||||
|
||||
;; `cl-labels' is not 100% compatible with `labels' when using dynamic scoping
|
||||
;; (mostly because it does not turn lambdas that refer to those functions into
|
||||
;; closures). OTOH it is compatible when using lexical scoping.
|
||||
|
||||
(unless (fboundp 'cl-labels)
|
||||
(defmacro cl-labels (&rest args)
|
||||
(unless (and (boundp 'lexical-binding) lexical-binding)
|
||||
;; We used to signal an error rather than a message, but in many uses of
|
||||
;; cl-labels, the value of lexical-binding doesn't actually matter.
|
||||
;; More importantly, the value of `lexical-binding' here is unreliable
|
||||
;; (it does not necessarily reflect faithfully whether the output of this
|
||||
;; macro will be interpreted as lexically bound code or not).
|
||||
(message "This `cl-labels' requires `lexical-binding' to be non-nil"))
|
||||
`(labels ,@args)))
|
||||
|
||||
;;;; ChangeLog:
|
||||
|
||||
;; 2014-02-25 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
;;
|
||||
;; Fixes: debbugs:16671
|
||||
;;
|
||||
;; * cl-lib.el (cl-position, cl-delete-duplicate): Don't advise if >=24.3.
|
||||
;; (load-path): Try to make sure we're at the end.
|
||||
;;
|
||||
;; 2014-01-25 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
;;
|
||||
;; * cl-lib.el: Resolve conflicts with old internal definitions
|
||||
;; (bug#16353).
|
||||
;; (dolist fun): Don't skip definitions silently.
|
||||
;; (define-setf-expander): Remove, not in cl-lib.
|
||||
;; (cl-position, cl-delete-duplicates): Add advice to distinguish the use
|
||||
;; case.
|
||||
;; (cl-member): Override old definition.
|
||||
;;
|
||||
;; 2013-05-22 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
;;
|
||||
;; * cl-lib.el (cl-labels): Demote error to message and improve it.
|
||||
;;
|
||||
;; 2012-11-30 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
;;
|
||||
;; * cl-lib.el: Try and patch things up in case we're hiding the real
|
||||
;; cl-lib.
|
||||
;;
|
||||
;; 2012-11-22 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
;;
|
||||
;; Add cl-letf and cl-labels.
|
||||
;;
|
||||
;; 2012-11-16 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
;;
|
||||
;; * packages/cl-lib: New package.
|
||||
;;
|
||||
|
||||
|
||||
(provide 'cl-lib)
|
||||
;;; cl-lib.el ends here
|
||||
Loading…
Add table
Add a link
Reference in a new issue