Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

55 lines (48 sloc) 1.752 kB
(in-package :optima)
(defun %equal (a b)
"Equality function for comparing pattern constants."
(declare (optimize (speed 3) (safety 0) (space 0)))
(or (equal a b)
(cond ((and (stringp a) (stringp b))
(string= a b))
((and (consp a) (consp b))
(and (%equal (car a) (car b))
(%equal (cdr a) (cdr b)))))))
(defmacro %equals (var value)
"Equality macro for comparing pattern constants. This specializes
the comparison form to some specific form as follows:
(equals x nil) => (null x)
(equals x 'foo) => (eq x 'foo)
(equals x 123) => (eql x 123)
(equals x '(a b)) => (%equals x '(a b))"
(typecase value
(null `(null ,var))
(symbol `(eq ,var ',value))
((or number character) `(eql ,var ,value))
(cons `(%equal ,var ',value))
(t `(%equal ,var ,value))))
(defun %svref (simple-vector index)
"Safe SVREF."
(declare (optimize (speed 3) (safety 0) (space 0)))
(when (< index (length simple-vector))
(svref simple-vector index)))
(defun %assoc (item alist &key (test #'eql))
"Safe ASSOC."
(declare (optimize (speed 3) (safety 0) (space 0)))
(loop
(unless (consp alist) (return))
(let ((cons (car alist)))
(when (and (consp cons)
(funcall test item (car cons)))
(return cons)))
(setq alist (cdr alist))))
(defun %get-property (item plist)
"Safe GETF."
(declare (optimize (speed 3) (safety 0) (space 0)))
(loop
(unless (consp plist) (return))
(let ((cons (cdr plist)))
(unless (consp cons) (return))
(when (eql item (car plist))
(return (cdr plist)))
(setq plist (cdr cons)))))
Jump to Line
Something went wrong with that request. Please try again.