summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Andreas Benkard <matthias@benkard.de>2008-07-30 11:58:40 +0200
committerMatthias Andreas Benkard <matthias@benkard.de>2008-07-30 11:58:40 +0200
commit8f974b6dc2b0e73ab7486dcec52a0fc6656d9441 (patch)
tree41970c4f9d32febd82c88b213303c781e1ccf05c
parent78f516d6fb58405cb234ba22e8bebd44d4d2bdf1 (diff)
TYPEP: Treat NIL as an atom, not as a cons.
-rw-r--r--types.lisp21
-rw-r--r--util.lisp19
2 files changed, 24 insertions, 16 deletions
diff --git a/types.lisp b/types.lisp
index 917e9f4..6904b7c 100644
--- a/types.lisp
+++ b/types.lisp
@@ -46,7 +46,7 @@
(dict (send-by-name (find-objc-class "NSMutableDictionary")
"dictionary")))
(dolist (pair relationship-alist dict)
- (send-by-name dict "setObject:forKey:" (cdr pair) (car pair)))))
+ (send-by-name dict "setObject:forKey:" (cdr pair) (nullify (car pair))))))
(setq most-positive-fixnum 32767)
@@ -76,16 +76,6 @@
(otherwise t)))) ;FIXME: classes and struct types, DEFTYPE
-(defun mapcar1 (function list)
- (when list
- (cons (funcall function (first list))
- (mapcar1 function (rest list)))))
-
-
-(defun mapcan1 (function list)
- (%append (mapcar1 function list)))
-
-
(defun some1 (function list)
(and (not (null list))
(or (funcall function (first list))
@@ -107,7 +97,7 @@
(let ((type (type-of thing))
(typespec (expand-type typespec environment)))
(cond ((eq typespec t) t)
- ((listp typespec)
+ ((consp typespec)
(case (first typespec)
(and (every1 (lambda (x) (typep thing x environment)) (rest typespec)))
(or (some1 (lambda (x) (typep thing x environment)) (rest typespec)))
@@ -123,7 +113,7 @@
(type2 (expand-type type2 environment)))
(cond ((eq type2 t) t)
((eq type1 nil) t)
- ((listp type1)
+ ((consp type1)
(case (first type1)
(and (some1 (lambda (x) (subtypep x type2 environment)) (rest type1)))
(or (every1 (lambda (x) (subtypep x type2 environment)) (rest type1)))
@@ -132,7 +122,7 @@
(otherwise
;;FIXME!!
(subtypep (first type1) type2 environment))))
- ((listp type2)
+ ((consp type2)
(case (first type2)
(and (every1 (lambda (x) (subtypep type1 x environment)) (rest type2)))
(or (some1 (lambda (x) (subtypep type1 x environment)) (rest type2)))
@@ -144,5 +134,6 @@
(t (or (eq type1 type2)
(let ((supertypes (send-by-name *subtype-supertypes-dict*
"objectForKey:"
- type1)))
+ type1))) ;strictly, this should be (nullify type1),
+ ;but type1 can't be NIL here
(some1 (lambda (x) (subtypep x type2 environment)) supertypes)))))))
diff --git a/util.lisp b/util.lisp
index c06305f..2bde209 100644
--- a/util.lisp
+++ b/util.lisp
@@ -1,5 +1,5 @@
(export '(and or not let* list* case cond append reverse macroexpand
- otherwise unless when eq))
+ otherwise unless when eq boundp))
(%defmacro %defun args
@@ -207,3 +207,20 @@
(%shadowing-export eq)
(%defun* eq (x y)
(sys::eq x y))
+
+(%defun* boundp (symbol)
+ (send-by-name (send-by-name (find-objc-class "MLKDynamicContext")
+ "currentContext")
+ "boundp:"
+ symbol))
+
+(unless (boundp '+nil+)
+ (setq +nil+ (gensym)))
+
+(%defun* denullify (x)
+ (if (eq x +nil+)
+ nil
+ x))
+
+(%defun* nullify (x)
+ (or x +nil+))