diff options
| -rw-r--r-- | list-functions-2.lisp | 20 | ||||
| -rw-r--r-- | types.lisp | 14 |
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))) @@ -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))))) |