Zander671/glisp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

More bug fixes

Browse Source
This commit is contained in:
Zander671
2026-09-08 11:27:11 -07:00
parent 0c6956c9c9
commit d472a02abc
2 changed files with 15 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files
lisp/kernel.gl
+5 -5
View File
@@ -177,7 +177,7 @@ Spec is of the form (VARIABLE LIST &optional RETURN-FORM)."
(pred (get name 'type-predicate)) (pred (get name 'type-predicate))
(args (and (consp type) (cdr type)))) (args (and (consp type) (cdr type))))
(unless pred (unless pred
(throw 'type-error)) (throw 'type-error (list obj 'type)))
(apply pred obj args))) (apply pred obj args)))
(define-type-predicate t (obj) t) (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 symbol symbolp)
(define-type-predicate cons consp) (define-type-predicate cons consp)
(define-type-predicate list listp) (define-type-predicate list listp)
(define-type-predicate integer (obj &opt min max) (define-type-predicate integer (obj &optional min max)
(and (integerp obj) (and (integerp obj)
(or (not min) (>= obj min)) (or (not min) (>= obj min))
(or (not max) (<= obj max)))) (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 byte alias (integer -128 127))
(define-type-predicate signed-byte alias byte) (define-type-predicate signed-byte alias byte)
(define-type-predicate unsigned-byte alias (integer 0 255)) (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) (and (floatp obj)
(or (not min) (>= obj min)) (or (not min) (>= obj min))
(or (not max) (<= obj max)))) (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 hash-table hash-table-p)
(define-type-predicate user-pointer user-pointer-p) (define-type-predicate user-pointer user-pointer-p)
(define-type-predicate record recordp) (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) (typep obj (list 'or (list 'float min max)
(list 'integer min max)))) (list 'integer min max))))
(princln (typep [] '(or vector list))) (princln (typep 21 'number))
src/list.c
+10 -7
View File
@@ -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), DEFUN(plist_put, "plist-put", (LispVal * plist, LispVal *prop, LispVal *value),
"(plist prop value)", "") { "(plist prop value)", "") {
CHECK_LISTP(plist); LispVal *rest = plist;
DOTAILS(rest, plist) { while (!NILP(rest)) {
CHECK_LISTP(rest); CHECK_LISTP(rest);
CHECK_TYPE(XCDR(rest), TYPE_CONS);
if (EQ(XCAR(rest), prop)) { if (EQ(XCAR(rest), prop)) {
CHECK_TYPE(XCDR(rest), TYPE_CONS);
RPLACA(XCDR(rest), value); RPLACA(XCDR(rest), value);
return plist; return plist;
} }
rest = XCDR(XCDR(rest));
} }
return CONS(prop, CONS(value, plist)); return CONS(prop, CONS(value, plist));
} }
DEFUN(plist_get, "plist-get", (LispVal * plist, LispVal *prop, LispVal *def), DEFUN(plist_get, "plist-get", (LispVal * plist, LispVal *prop, LispVal *def),
"(plist prop &optional default)", "") { "(plist prop &optional default)", "") {
CHECK_LISTP(plist); while (!NILP(plist)) {
DOTAILS(rest, plist) { CHECK_LISTP(plist);
if (EQ(XCAR(rest), prop)) { CHECK_TYPE(XCDR(plist), TYPE_CONS);
return SECOND(rest); if (EQ(XCAR(plist), prop)) {
return SECOND(plist);
} }
plist = XCDR(XCDR(plist));
} }
return def; return def;
} }