New accessor: mref.

* eval.c (eval_init): Register mref intrinsic.

* lib.[ch] (mref): New function.

* stdlib/place.tl (sys:mref1): New place.
(mref): New place macro, defined in terms
of sys:merf1, ref place and mref function.

* tests/012/seq.tl: New tests.

* txr.1: Documented.

1 files changed, 85 insertions, 0 deletions

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))