From c69db04f03fb1d04338c9ff0a10e4f2df528bafd Mon Sep 17 00:00:00 2001 From: andrzejwalczak Date: Thu, 28 May 2020 07:42:10 -0700 Subject: [PATCH] Internal change PiperOrigin-RevId: 313584484 --- etc.lisp | 34 ++++++++++---- list.lisp | 130 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 155 insertions(+), 9 deletions(-) diff --git a/etc.lisp b/etc.lisp index 49c2bf6..03ad0ee 100644 --- a/etc.lisp +++ b/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. diff --git a/list.lisp b/list.lisp index ffcd420..db304fd 100644 --- a/list.lisp +++ b/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 ... ;;;