diff options
| -rw-r--r-- | eval.c | 1 | ||||
| -rw-r--r-- | lib.c | 12 | ||||
| -rw-r--r-- | lib.h | 1 | ||||
| -rw-r--r-- | stdlib/place.tl | 72 | ||||
| -rw-r--r-- | tests/012/seq.tl | 85 | ||||
| -rw-r--r-- | txr.1 | 137 |
6 files changed, 308 insertions, 0 deletions
@@ -7749,6 +7749,7 @@ void eval_init(void) reg_fun(intern(lit("replace"), user_package), func_n4o(replace, 2)); reg_fun(intern(lit("dwim-set"), system_package), func_n2v(dwim_set)); reg_fun(intern(lit("dwim-del"), system_package), func_n3(dwim_del)); + reg_fun(intern(lit("mref"), user_package), func_n1v(mref)); reg_fun(intern(lit("update"), user_package), func_n2(update)); reg_fun(intern(lit("search"), user_package), func_n4o(search, 2)); reg_fun(intern(lit("rsearch"), user_package), func_n4o(rsearch, 2)); @@ -13476,6 +13476,18 @@ val dwim_del(val place_p, val seq, val ind_range) } } +val mref(val obj, varg args) +{ + cnum index = 0; + + while (args_more(args, index)) { + val idx = args_get(args, &index); + obj = funcall1(obj, idx); + } + + return obj; +} + val butlast(val seq, val idx) { if (listp(seq)) { @@ -1394,6 +1394,7 @@ val ref(val seq, val ind); val refset(val seq, val ind, val newval); val dwim_set(val place_p, val seq, varg); val dwim_del(val place_p, val seq, val ind_range); +val mref(val obj, varg args); val butlast(val seq, val idx); val replace(val seq, val items, val from, val to); val update(val seq, val fun); diff --git a/stdlib/place.tl b/stdlib/place.tl index 3b3e011d..62316fd6 100644 --- a/stdlib/place.tl +++ b/stdlib/place.tl @@ -766,6 +766,67 @@ ,',oldval-sym))))) ,body)))))) +(defplace (mref1 seq index) body + (getter setter + (with-gensyms (obj-sym ind-sym val-sym) + (if (place-form-p seq sys:*pl-env*) + (with-update-expander (seq-getter seq-setter) seq sys:*pl-env* + ^(alet ((,obj-sym (,seq-getter)) + (,ind-sym ,index)) + (macrolet ((,getter () ^(mref ,',obj-sym ,',ind-sym)) + (,setter (val) + ^(alet ((,',val-sym ,val)) + (,',seq-setter (sys:dwim-set t + ,',obj-sym + ,',ind-sym + ,',val-sym)) + ,',val-sym))) + ,body))) + ^(rlet ((,obj-sym ,seq) + (,ind-sym ,index)) + (macrolet ((,getter () '(mref ,obj-sym ,ind-sym)) + (,setter (val) + ^(alet ((,',val-sym ,val)) + (sys:dwim-set nil + ,',obj-sym + ,',ind-sym + ,',val-sym) + ,',val-sym))) + ,body))))) + (ssetter + (with-gensyms (val-sym) + (if (place-form-p seq sys:*pl-env*) + (with-update-expander (seq-getter seq-setter) seq sys:*pl-env* + ^(macrolet ((,ssetter (val) + ^(alet ((,',val-sym ,val)) + (,',seq-setter + (sys:dwim-set t + (,',seq-getter) + ,',index + ,',val-sym)) + ,',val-sym))) + ,body)) + ^(macrolet ((,ssetter (val) + ^(alet ((,',val-sym ,val)) + (sys:dwim-set nil + ,',seq + ,',index + ,',val-sym) + ,',val-sym))) + ,body)))) + (deleter + (with-gensyms (obj-sym ind-sym) + (with-update-expander (seq-getter seq-setter) seq sys:*pl-env* + ^(alet ((,obj-sym (,seq-getter)) + (,ind-sym ,index)) + (macrolet ((,deleter () + ^(prog1 (mref ,',obj-sym ,',ind-sym) + (,',seq-setter + (sys:dwim-del ,',(place-form-p seq sys:*pl-env*) + ,',obj-sym + ,',index))))) + ,body)))))) + (defplace (force promise) body (getter setter (with-gensyms (promise-sym) @@ -1011,3 +1072,14 @@ (define-place-macro nth (index obj) ^(car (nthcdr ,index ,obj))) + +(define-place-macro mref (obj . indices) + (tree-case indices + (() obj) + ((x) ^(mref1 ,obj ,x)) + ((x y) ^(mref1 (ref ,obj ,x) ,y)) + (t (let* ((l2 (nthlast 2 indices)) + (bl (ldiff indices l2)) + (x (car l2)) + (y (cadr l2))) + ^(mref1 (ref (mref ,obj ,*bl) ,x) ,y))))) diff --git a/tests/012/seq.tl b/tests/012/seq.tl index 28186dbb..407af84a 100644 --- a/tests/012/seq.tl +++ b/tests/012/seq.tl @@ -671,3 +671,88 @@ (test l (1 3 4)) (del (second l)) (test l (1 4))) + +(let ((nl (list (list (list 1 2) + (list 3 4) + (list 5 6)) + (list (list 7 8) + (list 9 10) + (list 11 12))))) + (mtest + (mref nl 0 0 0) 1 + (mref nl 0 0 1) 2 + (mref nl 0 1 0) 3 + (mref nl 0 1 1) 4 + (mref nl 0 2 0) 5 + (mref nl 0 2 1) 6 + (mref nl 1 0 0) 7 + (mref nl 1 0 1) 8 + (mref nl 1 1 0) 9 + (mref nl 1 1 1) 10 + (mref nl 1 2 0) 11 + (mref nl 0 2 1) 6) + + (mtest + (set (mref nl 0 0 0) 101) 101 + (mref nl 0 0 0) 101 + + (del (mref nl 0 0 0..:)) (101 2) + nl ((nil (3 4) (5 6)) ((7 8) (9 10) (11 12))) + + (set (mref nl 1 0..2) '(4)) (4) + nl ((nil (3 4) (5 6)) (4 (11 12))) + + (del (mref nl 1)) (4 (11 12)) + nl ((nil (3 4) (5 6))) + + (set (mref nl 1..:) '(a b c)) (a b c) + nl ((nil (3 4) (5 6)) a b c) + + (set (mref nl 1..3) '(e f)) (e f) + nl ((nil (3 4) (5 6)) e f c))) + +(flet ((get-vec () (vec 1 2 3)) + (get-list () (list 1 2 3))) + (mtest + (inc (mref (get-vec) 0)) 2 + (set (mref (get-vec) 0) 10) 10 + (inc (mref (get-list) 0)) 2 + (set (mref (get-list) 0) 10) 10 + (push 3 (mref (get-vec) 1..2)) (3 . #(2)) + (set (mref (get-vec) 1..2) '(30)) (30) + (push 3 (mref (get-list) 1..2)) :error + (set (mref (get-list) 1..2) '(30)) :error)) + + +(let ((nv (nested-vec 4 4 4))) + (let ((x 0)) + (each-prod ((i 0..4) + (j 0..4) + (k 0..4)) + (vtest (set (mref nv i j k) (inc x)) (succ x)))) + (mtest + nv #(#(#( 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))) + (set (mref nv 0 0 1..3) #(20 30)) #(20 30) + nv #(#(#( 1 20 30 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))) + (set (mref nv 1 1..3) "AB") "AB" + nv #(#(#( 1 20 30 4) #( 5 6 7 8) #( 9 10 11 12) #(13 14 15 16)) + #(#(17 18 19 20) #\A #\B #(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))) + (set (mref nv 1..3) '(B C)) (B C) + nv #(#(#( 1 20 30 4) #( 5 6 7 8) #( 9 10 11 12) #(13 14 15 16)) + B + C + #(#(49 50 51 52) #(53 54 55 56) #(57 58 59 60) #(61 62 63 64))))) + +(let ((cf (lambda (x) + (lambda (y) + (lambda (z) + (+ x y z)))))) + (test [mref cf 1 2 3] 6)) @@ -35465,6 +35465,143 @@ including lists. In the case of hashes, a .code refset of a nonexistent key creates the key. +.coNP Accessor @ mref +.synb +.mets (mref < sequence << index *) +.mets (set (mref < sequence << index +) new-value) +.syne +.desc +The +.code mref +accessor provides a mechanism for invoking a curried function. Its name +reflects its usefulness for multi-dimensional indexing into nested sequences. + +The associated +.code mref +place which makes the operator an accessor provides in-place replacement of +values in multi-dimensional sequences. There are some restrictions on the +.meta index +arguments when +.code mref +is used as a place. + +The +.meta sequence +argument is not necessarily a sequence, but may be object that can be called as +a function with one argument. Except that +.code call +isn't a place, the expression +.code "(mref x i)" +is equivalent to +.codn "(call x i)" : +invoke the function/object +.code x +with argument +.codn i . + +When multiple +.meta index +arguments are present, the return value of each previous application +is expected to be another callable object, to which the next +.meta index +argument is applied. Thus +.code "(mref x i j k)" +is equivalent to +.codn "(call (call (call x i) j) k)" . +This is also equivalent to +.codn "[[[x i] j] k]" , +provided that under the Lisp-1-style name resolution semantics of the DWIM +brackets, the symbols +.codn x , +.codn i , +.code j +and +.code k +all resolve to bindings in the variable namespace. + +The expression +.code "(mref x)" +is not equivalent to +.codn "(call x)" ; +rather, it is equivalent to +.codn x : +there are no +.meta index +arguments and so the +.code x +object is taken as-is, not being applied to any index. + +In more detail, the +.code mref +function begins by taking +.meta sequence +as its an accumulator object. Then if there are +.meta index +arguments, it iterates over them. At each iteration step, it +replaces the accumulator by treating the accumulator as a callable object +and applying it to +.meta index +value and taking the resulting value as the new accumulator. +After the iteration, the accumulator becomes the return value of +the function. + +When +.code mref +is used as a place, only the rightmost +.meta index +argument may be a range. If any other argument is a range object, +the behavior is unspecified. + +When +.code mref +is used as a place, and there is only one +.meta index +which is a range object, then the +.meta sequence +expression is also required to be a place, if it denotes a list or +range object. If there are no +.meta index +augments then +.meta sequence +is unconditionally required to be a place. + +Note: the functions +.code nested-vec +and +.code nested-vec-of +may be used to create nested vectors which simulate multi-dimensional arrays. + +.TP* Examples: + +.verb + ;; Indexing: + (let ((ar '((1 2 3) + (4 5 6) + (7 8 9)))) + (mref ar 1 1)) + --> 5 + + ;; Updating value in nested sequence: + (let ((ar (vec (vec (vec 0 1 2 3) + (vec 4 5 6 7)) + (vec (vec 8 9 10 11) + (vec 12 13 14 15))))) + (set (mref ar 0 0 1..3) "AB") + ar) + --> #(#(#( 0 #\eA #\eB 3) + #( 4 5 6 7)) + #(#( 8 9 10 11) + #(12 13 14 15))) + + ;; Invoking curried function: + (let ((cf (lambda (x) + (lambda (y) + (lambda (z) + (+ x y z)))))) + [mref cf 1 2 3]) + --> 6 +.brev + .coNP Function @ update .synb .mets (update < sequence << function ) |