diff options
| -rw-r--r-- | autoload.c | 2 | ||||
| -rw-r--r-- | stdlib/build.tl | 15 | ||||
| -rw-r--r-- | stdlib/doc-syms.tl | 1 | ||||
| -rw-r--r-- | tests/012/seq.tl | 5 | ||||
| -rw-r--r-- | txr.1 | 53 |
5 files changed, 70 insertions, 6 deletions
@@ -373,7 +373,7 @@ static val build_set_entries(val fun) val name_noload[] = { lit("head"), lit("tail"), lit("add"), lit("add*"), lit("pend"), lit("pend*"), lit("ncon"), lit("ncon*"), lit("get"), - lit("del"), lit("del*"), + lit("del"), lit("del*"), lit("oust"), nil }; autoload_set(al_struct, sname, fun); diff --git a/stdlib/build.tl b/stdlib/build.tl index 3837f43f..e5cba268 100644 --- a/stdlib/build.tl +++ b/stdlib/build.tl @@ -28,9 +28,16 @@ (defstruct list-builder () head tail - (:postinit (bc) - (set bc.head (cons nil bc.head) - bc.tail bc.head)) + (:postinit (self) + (set self.head (cons nil self.head) + self.tail self.head)) + + (:method oust (self . lists) + (if lists + (let ((nl [apply append lists])) + (set self.tail (usr:rplacd self.head nl))) + (set self.tail (usr:rplacd self.head nil))) + self) (:method add (self . items) (let ((st self.tail)) @@ -112,7 +119,7 @@ (defun sys:list-builder-flets (lb-form) (nconc - (collect-each ((op '(add add* pend pend* ncon ncon*))) + (collect-each ((op '(add add* pend pend* ncon ncon* oust))) ^(,op (. args) (qref ,lb-form (,op . args)) nil)) diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl index 7a9348ee..95092836 100644 --- a/stdlib/doc-syms.tl +++ b/stdlib/doc-syms.tl @@ -1391,6 +1391,7 @@ ("orec" "N-0003ED2C") ("orf" "N-01E7D2AD") ("ors" "N-02D33A3D") + ("oust" "N-0126D3FF") ("output" "N-0159EBE7") ("package-alist" "N-017F684C") ("package-fallback-list" "N-027A535C") diff --git a/tests/012/seq.tl b/tests/012/seq.tl index 1706e6df..ae42a13e 100644 --- a/tests/012/seq.tl +++ b/tests/012/seq.tl @@ -13,6 +13,11 @@ (test (build (add 1) (add 2) (pend (get) (get))) (1 2 1 2 1 2)) (test (build (add 1) (add 2) (pend* (get) (get))) (1 2 1 2 1 2)) +(mtest + (build (add 1 2) (oust)) nil + (build (add 1 2) (oust '(3 4)) (add 5)) (3 4 5) + (build (add 1 2) (oust '(3 4) '(5)) (add 6)) (3 4 5 6)) + (set *print-circle* t) (stest (build (add 1) (add 2) (ncon (get))) "#1=(1 2 . #1#)") @@ -38037,7 +38037,7 @@ methods extend the list being constructed by a object by adding lists to it. The .code pend method catenates the -.code list +.meta list arguments together as if by the .code append function, then appends the resulting list to @@ -38146,6 +38146,56 @@ object. -> (1 2 3 4 . 5) .brev +.coNP Method @ oust +.synb +.mets << list-builder .(oust << list *) +.syne +.desc +The +.code oust +method discards the list constructed so far, optionally +replacing it with new material. + +The +.code oust +method catenates the +.meta list +arguments together as if by the +.code append +function. The resulting list, which is empty +if there are no +.meta list +arguments, then replaces the object's +list constructed so far. + +The +.code oust +method returns the +.meta list-builder +object. + +.TP* Examples: + +.verb + ;; Build the list (3 4) by first building (1 2), + ;; then discarding that and adding 3 and 4: + + (let ((lb (build-list))) + lb.(add 1 2) + lb.(oust) + lb.(add 3 4) + lb.(get)) + -> (3 4) + + ;; Build the list (3 4 5 6) by first building (1 2), + ;; then replacing with catenation of (3 4) and (5 6): + (let ((lb (build-list))) + lb.(pend '(1 2)) + lb.(oust '(3 4) '(5 6)) + lb.(get)) + -> (3 4 5 6) +.brev + .coNP Method @ get .synb .mets << list-builder .(get) @@ -38238,6 +38288,7 @@ This lexical environment also provides local functions named .codn pend* , .codn ncon , .codn ncon* , +.codn oust , .codn get , .code del and |