Internal change

PiperOrigin-RevId: 313584484

etc.lisp

@@ -14,6 +14,7 @@
         #:ace.core.once-only)
   (:import-from #:ace.core.type #:variable-information)
   (:export
+   #:one-of
    #:orf #:andf
    #:define-constant
    #:define-numerals
@@ -121,6 +122,14 @@
              :collect
              `(defconstant ,n (%set-constant-value ',n ,o #'%numeral-eq)))))
 
+;;;
+;;; one-of shortcut
+
+(defmacro one-of (e &rest members)
+  "True if element E compares EQL with at least one of the MEMBERS."
+  (once-only (e)
+    `(or ,@(lmap (m members) `(eql ,e ,m)))))
+
 ;;;
 ;;; SETF forms for OR and AND.
 ;;; TODO(czak): Move to an own module.
@@ -186,15 +195,22 @@ This is different from a potential DEFINE-MODIFY-MACRO operator which
 would always set the place even in the case where its first value is non-NIL."
   (multiple-value-bind (vars vals places setter getter)
       (get-setf-expansion place env)
-    (let* ((place (if (cdr places) `(values ,@places) (car places)))
-           (setfs (lmap (form rest) `(setf ,place ,form))))
-      `(let* (,@(mapcar #'list vars vals)
-              ,@places)
-         (cond ((setf ,place ,getter)
-                ,place)
-               (,@(and (cdr places) '(t))
-                (or ,@setfs)
-                ,setter))))))
+    `(let* (,@(mapcar #'list vars vals)
+            ,@places)
+       ,(if (cdr places)
+            ;; multiple value places
+            (let ((store-vars `(values ,@places)))
+              `(cond ((setf ,store-vars ,getter)
+                      ,store-vars)
+                     (t
+                      (or ,@(lmap (form rest) `(setf ,store-vars ,form)))
+                      ,setter)))
+            ;; single value place
+            (let* ((place (car places)))
+              `(or ,getter
+                   (progn
+                     (setf ,place (or ,@rest))
+                     ,setter)))))))
 
 (defmacro andf (place &rest rest &environment env)
   "The ANDF modifying macro has a similar short-cut semantics as AND.

list.lisp

@@ -45,6 +45,14 @@
    #:remove #:remove-if #:remove-if-not
    #:delete #:delete-if #:delete-if-not
    #:delete-adjacent
+
+   #:removef
+   #:removef-if
+   #:removef-if-not
+   #:deletef
+   #:deletef-if
+   #:deletef-if-not
+
    #:partition
    #:npartition
    #:dolist*
@@ -970,6 +978,128 @@ Parameters:
 (define-compiler-macro copy-if-not (&whole whole &rest args)
   (apply #'%remove-if-form whole args))
 
+;;;
+;;; Modifying macros.
+;;;
+
+(defmacro removef (item list &rest rest
+                   &key from-end test test-not start end count key
+                   &environment env)
+  "Remove all elements from the LIST that match the ITEM.
+LIST needs to be a place and is assigned the new returned LIST.
+
+The REST parameters are:
+ FROM-END - if true, will start deleting from the end,
+ TEST - the equality test used to compare ITEM with the elements in the list,
+ TEST-NOT - the complement of the TEST,
+ START - the START index (default 0),
+ END - the END index (default is NIL, the end of list),
+ COUNT - the maximum count of elements to be deleted,
+ KEY - a function that derives values to be compared with the ITEM."
+  (declare (ignore from-end test test-not start end count key))
+  (multiple-value-bind (vars vals places setter getter) (get-setf-expansion list env)
+    `(let* (,@(mapcar #'list vars vals)
+            (,(first places) (remove ,item ,getter ,@rest))
+            ,@(rest places))
+       ,setter)))
+
+(defmacro removef-if (predicate list &rest rest
+                      &key from-end start end count key
+                      &environment env)
+  "Remove all elements from the LIST that match the PREDICATE.
+LIST needs to be a place and is assigned the new returned LIST.
+
+The REST parameters are:
+ FROM-END - if true, will start deleting from the end,
+ START - the START index (default 0),
+ END - the END index (default is NIL, the end of list),
+ COUNT - the maximum count of elements to be deleted,
+ KEY - a function that derives values to be tested by the predicate."
+  (declare (ignore from-end start end count key))
+  (multiple-value-bind (vars vals places setter getter) (get-setf-expansion list env)
+    `(let* (,@(mapcar #'list vars vals)
+            (,(first places) (remove-if ,predicate ,getter ,@rest))
+            ,@(rest places))
+       ,setter)))
+
+(defmacro removef-if-not (predicate list &rest rest
+                          &key from-end start end count key
+                          &environment env)
+  "Remove all elements from the LIST that does NOT match the PREDICATE.
+LIST needs to be a place and is assigned the new returned LIST.
+
+The REST parameters are:
+ FROM-END - if true, will start deleting from the end,
+ START - the START index (default 0),
+ END - the END index (default is NIL, the end of list),
+ COUNT - the maximum count of elements to be deleted,
+ KEY - a function that derives values to be tested by the predicate."
+  (declare (ignore from-end start end count key))
+  (multiple-value-bind (vars vals places setter getter) (get-setf-expansion list env)
+    `(let* (,@(mapcar #'list vars vals)
+            (,(first places) (remove-if-not ,predicate ,getter ,@rest))
+            ,@(rest places))
+       ,setter)))
+
+(defmacro deletef (item list &rest rest
+                   &key from-end test test-not start end count key
+                   &environment env)
+  "Destructively delete all elements from the LIST that match the ITEM.
+LIST needs to be a place and is assigned the returned modified LIST.
+
+The REST parameters are:
+ FROM-END - if true, will start deleting from the end,
+ TEST - the equality test used to compare ITEM with the elements in the list,
+ TEST-NOT - the complement of the TEST,
+ START - the START index (default 0),
+ END - the END index (default is NIL, the end of list),
+ COUNT - the maximum count of elements to be deleted,
+ KEY - a function that derives values to be compared with the ITEM."
+  (declare (ignore from-end test test-not start end count key))
+  (multiple-value-bind (vars vals places setter getter) (get-setf-expansion list env)
+    `(let* (,@(mapcar #'list vars vals)
+            (,(first places) (delete ,item ,getter ,@rest))
+            ,@(rest places))
+       ,setter)))
+
+(defmacro deletef-if (predicate list &rest rest
+                      &key from-end start end count key
+                      &environment env)
+  "Destructively delete all elements from the LIST that match the PREDICATE.
+LIST needs to be a place and is assigned the returned modified LIST.
+
+The REST parameters are:
+ FROM-END - if true, will start deleting from the end,
+ START - the START index (default 0),
+ END - the END index (default is NIL, the end of list),
+ COUNT - the maximum count of elements to be deleted,
+ KEY - a function that derives values to be tested by the predicate."
+  (declare (ignore from-end start end count key))
+  (multiple-value-bind (vars vals places setter getter) (get-setf-expansion list env)
+    `(let* (,@(mapcar #'list vars vals)
+            (,(first places) (delete-if ,predicate ,getter ,@rest))
+            ,@(rest places))
+       ,setter)))
+
+(defmacro deletef-if-not (predicate list &rest rest
+                          &key from-end start end count key
+                          &environment env)
+  "Destructively delete all elements from the LIST that does NOT match the PREDICATE.
+LIST needs to be a place and is assigned the returned modified LIST.
+
+The REST parameters are:
+ FROM-END - if true, will start deleting from the end,
+ START - the START index (default 0),
+ END - the END index (default is NIL, the end of list),
+ COUNT - the maximum count of elements to be deleted,
+ KEY - a function that derives values to be tested by the predicate."
+  (declare (ignore from-end start end count key))
+  (multiple-value-bind (vars vals places setter getter) (get-setf-expansion list env)
+    `(let* (,@(mapcar #'list vars vals)
+            (,(first places) (delete-if-not ,predicate ,getter ,@rest))
+            ,@(rest places))
+       ,setter)))
+
 ;;;
 ;;; etc ...
 ;;;