This repository has been archived by the owner on Dec 29, 2018. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 19
/
runtime.lisp
54 lines (48 loc) · 1.7 KB
/
runtime.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
(in-package :optima)
(defun %equal (a b)
"Equality function for comparing patten 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 %passoc (item plist)
"Safe plist assoc."
(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 plist))
(setq plist (cdr cons)))))