-
Notifications
You must be signed in to change notification settings - Fork 3
/
Copy pathsequence.lisp
147 lines (132 loc) · 6.18 KB
/
sequence.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
;;; Copyright 2020 Google LLC
;;;
;;; Use of this source code is governed by an MIT-style
;;; license that can be found in the LICENSE file or at
;;; https://opensource.org/licenses/MIT.
;;; Utilities related to general sequences.
;;;
(ace.core:defpackage* #:ace.core.sequence
(:use #:common-lisp)
(:export
;; TODO(czak): Those may be interesting when defined for generic sequences.
;; #:length=
;; #:partition
;; #:npartition
;; #:appendf
;; #:nconcf
;; #:nreversef
;; #:unionf
;; #:intersectionf
#:removef
#:removef-if
#:removef-if-not
#:deletef
#:deletef-if
#:deletef-if-not))
(in-package #:ace.core.sequence)
(defmacro removef (item sequence &rest rest
&key from-end test test-not start end count key
&environment env)
"Remove all elements from the SEQUENCE that match the ITEM.
SEQUENCE needs to be a place and is assigned the new returned SEQUENCE.
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 sequence,
TEST-NOT - the complement of the TEST,
START - the START index (default 0),
END - the END index (default is NIL, the end of sequence),
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 sequence env)
`(let* (,@(mapcar #'list vars vals)
(,(first places) (remove ,item ,getter ,@rest))
,@(rest places))
,setter)))
(defmacro removef-if (predicate sequence &rest rest
&key from-end start end count key
&environment env)
"Remove all elements from the SEQUENCE that match the PREDICATE.
SEQUENCE needs to be a place and is assigned the new returned SEQUENCE.
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 sequence),
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 sequence env)
`(let* (,@(mapcar #'list vars vals)
(,(first places) (remove-if ,predicate ,getter ,@rest))
,@(rest places))
,setter)))
(defmacro removef-if-not (predicate sequence &rest rest
&key from-end start end count key
&environment env)
"Remove all elements from the SEQUENCE that does NOT match the PREDICATE.
SEQUENCE needs to be a place and is assigned the new returned SEQUENCE.
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 sequence),
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 sequence env)
`(let* (,@(mapcar #'list vars vals)
(,(first places) (remove-if-not ,predicate ,getter ,@rest))
,@(rest places))
,setter)))
(defmacro deletef (item sequence &rest rest
&key from-end test test-not start end count key
&environment env)
"Destructively delete all elements from the SEQUENCE that match the ITEM.
SEQUENCE needs to be a place and is assigned the returned modified SEQUENCE.
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 sequence,
TEST-NOT - the complement of the TEST,
START - the START index (default 0),
END - the END index (default is NIL, the end of sequence),
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 sequence env)
`(let* (,@(mapcar #'list vars vals)
(,(first places) (delete ,item ,getter ,@rest))
,@(rest places))
,setter)))
(defmacro deletef-if (predicate sequence &rest rest
&key from-end start end count key
&environment env)
"Destructively delete all elements from the SEQUENCE that match the PREDICATE.
SEQUENCE needs to be a place and is assigned the returned modified SEQUENCE.
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 sequence),
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 sequence env)
`(let* (,@(mapcar #'list vars vals)
(,(first places) (delete-if ,predicate ,getter ,@rest))
,@(rest places))
,setter)))
(defmacro deletef-if-not (predicate sequence &rest rest
&key from-end start end count key
&environment env)
"Destructively delete all elements from the SEQUENCE that does NOT match the PREDICATE.
SEQUENCE needs to be a place and is assigned the returned modified SEQUENCE.
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 sequence),
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 sequence env)
`(let* (,@(mapcar #'list vars vals)
(,(first places) (delete-if-not ,predicate ,getter ,@rest))
,@(rest places))
,setter)))