More bug fixes
This commit is contained in:
+5
-5
@@ -177,7 +177,7 @@ Spec is of the form (VARIABLE LIST &optional RETURN-FORM)."
|
||||
(pred (get name 'type-predicate))
|
||||
(args (and (consp type) (cdr type))))
|
||||
(unless pred
|
||||
(throw 'type-error))
|
||||
(throw 'type-error (list obj 'type)))
|
||||
(apply pred obj args)))
|
||||
|
||||
(define-type-predicate t (obj) t)
|
||||
@@ -201,7 +201,7 @@ Spec is of the form (VARIABLE LIST &optional RETURN-FORM)."
|
||||
(define-type-predicate symbol symbolp)
|
||||
(define-type-predicate cons consp)
|
||||
(define-type-predicate list listp)
|
||||
(define-type-predicate integer (obj &opt min max)
|
||||
(define-type-predicate integer (obj &optional min max)
|
||||
(and (integerp obj)
|
||||
(or (not min) (>= obj min))
|
||||
(or (not max) (<= obj max))))
|
||||
@@ -210,7 +210,7 @@ Spec is of the form (VARIABLE LIST &optional RETURN-FORM)."
|
||||
(define-type-predicate byte alias (integer -128 127))
|
||||
(define-type-predicate signed-byte alias byte)
|
||||
(define-type-predicate unsigned-byte alias (integer 0 255))
|
||||
(define-type-predicate float (obj &opt min max)
|
||||
(define-type-predicate float (obj &optional min max)
|
||||
(and (floatp obj)
|
||||
(or (not min) (>= obj min))
|
||||
(or (not max) (<= obj max))))
|
||||
@@ -220,8 +220,8 @@ Spec is of the form (VARIABLE LIST &optional RETURN-FORM)."
|
||||
(define-type-predicate hash-table hash-table-p)
|
||||
(define-type-predicate user-pointer user-pointer-p)
|
||||
(define-type-predicate record recordp)
|
||||
(define-type-predicate number (obj &opt min max)
|
||||
(define-type-predicate number (obj &optional min max)
|
||||
(typep obj (list 'or (list 'float min max)
|
||||
(list 'integer min max))))
|
||||
|
||||
(princln (typep [] '(or vector list)))
|
||||
(princln (typep 21 'number))
|
||||
|
||||
+10
-7
@@ -250,25 +250,28 @@ DEFUN(member_if, "member-if", (LispVal * pred, LispVal *list), "(pred list)",
|
||||
|
||||
DEFUN(plist_put, "plist-put", (LispVal * plist, LispVal *prop, LispVal *value),
|
||||
"(plist prop value)", "") {
|
||||
CHECK_LISTP(plist);
|
||||
DOTAILS(rest, plist) {
|
||||
LispVal *rest = plist;
|
||||
while (!NILP(rest)) {
|
||||
CHECK_LISTP(rest);
|
||||
CHECK_TYPE(XCDR(rest), TYPE_CONS);
|
||||
if (EQ(XCAR(rest), prop)) {
|
||||
CHECK_TYPE(XCDR(rest), TYPE_CONS);
|
||||
RPLACA(XCDR(rest), value);
|
||||
return plist;
|
||||
}
|
||||
rest = XCDR(XCDR(rest));
|
||||
}
|
||||
return CONS(prop, CONS(value, plist));
|
||||
}
|
||||
|
||||
DEFUN(plist_get, "plist-get", (LispVal * plist, LispVal *prop, LispVal *def),
|
||||
"(plist prop &optional default)", "") {
|
||||
CHECK_LISTP(plist);
|
||||
DOTAILS(rest, plist) {
|
||||
if (EQ(XCAR(rest), prop)) {
|
||||
return SECOND(rest);
|
||||
while (!NILP(plist)) {
|
||||
CHECK_LISTP(plist);
|
||||
CHECK_TYPE(XCDR(plist), TYPE_CONS);
|
||||
if (EQ(XCAR(plist), prop)) {
|
||||
return SECOND(plist);
|
||||
}
|
||||
plist = XCDR(XCDR(plist));
|
||||
}
|
||||
return def;
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user