summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--list-functions-2.lisp20
-rw-r--r--types.lisp14
2 files changed, 32 insertions, 2 deletions
diff --git a/list-functions-2.lisp b/list-functions-2.lisp
index caa5a58..57e3976 100644
--- a/list-functions-2.lisp
+++ b/list-functions-2.lisp
@@ -20,7 +20,7 @@
(export '(copy-tree assoc assoc-if assoc-if-not rassoc rassoc-if
rassoc-if-not sublis nsublis mapcar mapcan mapcon acons
- reverse nreverse maplist))
+ reverse nreverse maplist nthcdr last nth))
(defun copy-tree (tree)
@@ -128,7 +128,25 @@
(sys::cons (sys::car objects) (sys::cdr objects))
nil))
+(defun dotted-length (list)
+ (if (consp list)
+ (1+ (dotted-length (cdr list)))
+ 0))
+
(defun length (list)
(if list
(%1+ (length (cdr list)))
0))
+
+(defun last (list &optional (n 1))
+ (let ((l (dotted-length list)))
+ (nthcdr (- l n))))
+
+(defun nthcdr (n list)
+ (check-type n (integer 0))
+ (if (zerop n)
+ list
+ (nthcdr (1- n) (cdr list))))
+
+(defun nth (n list)
+ (car (nthcdr n list)))
diff --git a/types.lisp b/types.lisp
index c1bf8c7..e99c188 100644
--- a/types.lisp
+++ b/types.lisp
@@ -26,7 +26,7 @@
array simple-array simple-vector simple-string
simple-bit-vector sequence two-way-stream stream echo-stream
broadcast-stream file-stream synonym-stream string-stream
- concatenated-stream deftype typecase etypecase))
+ concatenated-stream deftype typecase etypecase char= eql))
(setq *subtype-supertypes-dict*
@@ -200,3 +200,15 @@
`(typecase ,expression
,@cases
(otherwise (error "~A fell through ETYPECASE expression" expression))))
+
+
+(defun char= (x y)
+ (send-by-name x "isEqual:" y))
+
+(defun eql (x y)
+ (typecase x
+ (number (and (numberp y)
+ (= x y))
+ (character (and (characterp y)
+ (char= x y)))
+ (t (eq x y)))))