Raymond Toy pushed to branch master at cmucl / cmucl Commits: afaeb420 by Raymond Toy at 2023-08-22T14:00:25+00:00 Fix #253: Block-compile list-to-hashtable and callers - - - - - a5b2c0f8 by Raymond Toy at 2023-08-22T14:02:24+00:00 Merge branch 'issue-253-block-compile-list-to-hashtable' into 'master' Fix #253: Block-compile list-to-hashtable and callers Closes #253 See merge request cmucl/cmucl!166 - - - - - 2 changed files: - src/code/list.lisp - src/i18n/locale/cmucl.pot Changes: ===================================== src/code/list.lisp ===================================== @@ -749,6 +749,7 @@ (defparameter *min-list-length-for-hashtable* 15) +(declaim (start-block list-to-hashtable union intersection set-difference)) ;; Convert a list to a hashtable. The hashtable does not handle ;; duplicated values in the list. Returns the hashtable. (defun list-to-hashtable (list key test test-not) @@ -802,29 +803,6 @@ (push item res))))) res)) -;;; Destination and source are setf-able and many-evaluable. Sets the source -;;; to the cdr, and "conses" the 1st elt of source to destination. -;;; -(defmacro steve-splice (source destination) - `(let ((temp ,source)) - (setf ,source (cdr ,source) - (cdr temp) ,destination - ,destination temp))) - -(defun nunion (list1 list2 &key key (test #'eql testp) (test-not nil notp)) - "Destructively returns the union list1 and list2." - (declare (inline member)) - (if (and testp notp) - (error "Test and test-not both supplied.")) - (let ((res list2) - (list1 list1)) - (do () - ((endp list1)) - (if (not (with-set-keys (member (apply-key key (car list1)) list2))) - (steve-splice list1 res) - (setf list1 (cdr list1)))) - res)) - (defun intersection (list1 list2 &key key (test #'eql testp) (test-not nil notp)) @@ -847,20 +825,6 @@ (push elt res))) res))))) -(defun nintersection (list1 list2 &key key - (test #'eql testp) (test-not nil notp)) - "Destructively returns the intersection of list1 and list2." - (declare (inline member)) - (if (and testp notp) - (error "Test and test-not both supplied.")) - (let ((res nil) - (list1 list1)) - (do () ((endp list1)) - (if (with-set-keys (member (apply-key key (car list1)) list2)) - (steve-splice list1 res) - (setq list1 (Cdr list1)))) - res)) - (defun set-difference (list1 list2 &key key (test #'eql testp) (test-not nil notp)) "Returns the elements of list1 which are not in list2." (declare (inline member)) @@ -888,6 +852,45 @@ (push item res))) res))))) +(declaim (end-block)) + +;;; Destination and source are setf-able and many-evaluable. Sets the source +;;; to the cdr, and "conses" the 1st elt of source to destination. +;;; +(defmacro steve-splice (source destination) + `(let ((temp ,source)) + (setf ,source (cdr ,source) + (cdr temp) ,destination + ,destination temp))) + +(defun nunion (list1 list2 &key key (test #'eql testp) (test-not nil notp)) + "Destructively returns the union list1 and list2." + (declare (inline member)) + (if (and testp notp) + (error "Test and test-not both supplied.")) + (let ((res list2) + (list1 list1)) + (do () + ((endp list1)) + (if (not (with-set-keys (member (apply-key key (car list1)) list2))) + (steve-splice list1 res) + (setf list1 (cdr list1)))) + res)) + +(defun nintersection (list1 list2 &key key + (test #'eql testp) (test-not nil notp)) + "Destructively returns the intersection of list1 and list2." + (declare (inline member)) + (if (and testp notp) + (error "Test and test-not both supplied.")) + (let ((res nil) + (list1 list1)) + (do () ((endp list1)) + (if (with-set-keys (member (apply-key key (car list1)) list2)) + (steve-splice list1 res) + (setq list1 (Cdr list1)))) + res)) + (defun nset-difference (list1 list2 &key key (test #'eql testp) (test-not nil notp)) "Destructively returns the elements of list1 which are not in list2." ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -3216,19 +3216,19 @@ msgid "Test and test-not both supplied." msgstr "" #: src/code/list.lisp -msgid "Destructively returns the union list1 and list2." +msgid "Returns the intersection of list1 and list2." msgstr "" #: src/code/list.lisp -msgid "Returns the intersection of list1 and list2." +msgid "Returns the elements of list1 which are not in list2." msgstr "" #: src/code/list.lisp -msgid "Destructively returns the intersection of list1 and list2." +msgid "Destructively returns the union list1 and list2." msgstr "" #: src/code/list.lisp -msgid "Returns the elements of list1 which are not in list2." +msgid "Destructively returns the intersection of list1 and list2." msgstr "" #: src/code/list.lisp View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/bfae1626b04fcf606a4a2df... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/bfae1626b04fcf606a4a2df... You're receiving this email because of your account on gitlab.common-lisp.net.