diff --git a/src/kernel.sl b/src/kernel.sl index c0a6c65..46dfc5c 100644 --- a/src/kernel.sl +++ b/src/kernel.sl @@ -142,3 +142,44 @@ (defmacro return (&opt value) (list 'return-from nil value)) + +(defun put (symbol key value) + (setplist symbol (plist-set (symbol-plist symbol) key value))) + +(defun get (symbol key &opt default) + (plist-get (symbol-plist symbol) key default)) + +(defun remprop (symbol key) + (setplist symbol (plist-rem (symbol-plist symbol) key))) + +(defmacro dotails (vars &rest body) + (let ((cur (make-symbol "cur"))) + (list 'let (list (list cur (second vars))) + (list 'while (list 'pairp cur) + (apply 'list 'let (list (list (first vars) cur)) + body) + (list 'setq cur (list 'tail cur)))))) + +(defun member (elt list &opt (pred 'equal)) + (dotails (cur list) + (when (funcall pred elt (head cur)) + (return-from member cur)))) + +(defun member-if (pred list &opt negate) + (dotails (cur list) + (when (or (and (not negate) (funcall pred (head cur))) + (and negate (not (funcall pred (head cur))))) + (return-from member-if cur)))) + +(defun find (elt list &opt default (pred 'equal)) + (dolist (cur list) + (when (funcall pred cur elt) + (return-from find cur))) + default) + +(defun find-if (pred list &opt default negate) + (dolist (cur list) + (when (or (and (not negate) (funcall pred cur)) + (and negate (not (funcall pred cur)))) + (return-from find-if cur))) + default) diff --git a/src/lisp.c b/src/lisp.c index a6c97fd..8f875b8 100644 --- a/src/lisp.c +++ b/src/lisp.c @@ -2594,8 +2594,8 @@ DEFUN(plist_rem, "plist-rem", (LispVal * plist, LispVal *key, LispVal *pred)) { return refcount_ref(TAIL(TAIL(plist))); } else { Fsettail(TAIL(prev), TAIL(TAIL(cur))); + return refcount_ref(plist); } - return Qnil; } } return refcount_ref(plist);