Raymond Toy pushed to branch issue-240-add-hashtable-for-destructive-set-ops at cmucl / cmucl
Commits:
-
6b3621ac
by Raymond Toy at 2023-08-22T15:13:03-07:00
1 changed file:
Changes:
| ... | ... | @@ -863,15 +863,34 @@ |
| 863 | 863 | (cdr temp) ,destination
|
| 864 | 864 | ,destination temp)))
|
| 865 | 865 | |
| 866 | +;;; Main processing for destructive set operations. Like PROCESS-SET with same args,
|
|
| 867 | +;;; but for destructive operations.
|
|
| 868 | +(defmacro nprocess-set (init-res test-form)
|
|
| 869 | + `(let ((res ,init-res)
|
|
| 870 | + (list1 list1))
|
|
| 871 | + (do ()
|
|
| 872 | + ((endp list1))
|
|
| 873 | + (if ,test-form
|
|
| 874 | + (steve-splice list1 res)
|
|
| 875 | + (setq list1 (cdr list1))))
|
|
| 876 | + res))
|
|
| 877 | + |
|
| 878 | + |
|
| 866 | 879 | (defun nunion (list1 list2 &key key (test #'eql testp) (test-not nil notp))
|
| 867 | 880 | "Destructively returns the union list1 and list2."
|
| 868 | 881 | (declare (inline member))
|
| 869 | 882 | (if (and testp notp)
|
| 870 | 883 | (error "Test and test-not both supplied."))
|
| 871 | 884 |
|
| 872 | - (let ((res list2)
|
|
| 885 | + (let (#+nil
|
|
| 886 | + (res list2)
|
|
| 873 | 887 | (hashtable (list-to-hashtable list2 key test test-not))
|
| 888 | + #+nil
|
|
| 874 | 889 | (list1 list1))
|
| 890 | + (if hashtable
|
|
| 891 | + (nprocess-set list2 (not (nth-value 1 (gethash (apply-key key (car list1)) hashtable))))
|
|
| 892 | + (nprocess-set list2 (not (with-set-keys (member (apply-key key (car list1)) list2)))))
|
|
| 893 | + #+nil
|
|
| 875 | 894 | (macrolet
|
| 876 | 895 | ((process (test-form)
|
| 877 | 896 | `(do ()
|
| ... | ... | @@ -892,9 +911,15 @@ |
| 892 | 911 | (declare (inline member))
|
| 893 | 912 | (if (and testp notp)
|
| 894 | 913 | (error "Test and test-not both supplied."))
|
| 895 | - (let ((res nil)
|
|
| 914 | + (let (#+nil
|
|
| 915 | + (res nil)
|
|
| 896 | 916 | (hashtable (list-to-hashtable list2 key test test-not))
|
| 897 | - (list1 list1))
|
|
| 917 | + #+nil
|
|
| 918 | + (list1 list1))
|
|
| 919 | + (if hashtable
|
|
| 920 | + (nprocess-set nil (nth-value 1 (gethash (apply-key key (car list1)) hashtable)))
|
|
| 921 | + (nprocess-set nil (with-set-keys (member (apply-key key (car list1)) list2))))
|
|
| 922 | + #+nil
|
|
| 898 | 923 | (macrolet
|
| 899 | 924 | ((process (test-form)
|
| 900 | 925 | `(do () ((endp list1))
|
| ... | ... | @@ -913,9 +938,15 @@ |
| 913 | 938 | (declare (inline member))
|
| 914 | 939 | (if (and testp notp)
|
| 915 | 940 | (error "Test and test-not both supplied."))
|
| 916 | - (let ((res nil)
|
|
| 941 | + (let (#+nil
|
|
| 942 | + (res nil)
|
|
| 917 | 943 | (hashtable (list-to-hashtable list2 key test test-not))
|
| 918 | - (list1 list1))
|
|
| 944 | + #+nil
|
|
| 945 | + (list1 list1))
|
|
| 946 | + (if hashtable
|
|
| 947 | + (nprocess-set nil (not (nth-value 1 (gethash (apply-key key (car list1)) hashtable))))
|
|
| 948 | + (nprocess-set nil (not (with-set-keys (member (apply-key key (car list1)) list2)))))
|
|
| 949 | + #+nil
|
|
| 919 | 950 | (macrolet
|
| 920 | 951 | ((process (test-form)
|
| 921 | 952 | `(do () ((endp list1))
|