picolisp

commit 13b167db1d2c2388365fe1efad1a949a772d2eef
parent ed03efde96a4cc693ae3b8ecce1c56c36f7099dc
Author: Commit-Bot <unknown>
Date:   Mon, 14 Jun 2010 19:31:54 +0000

Automatic commit from picoLisp.tgz, From: Mon, 14 Jun 2010 19:31:54 GMT
Diffstat:
M
doc/index.html
 | 
0

M
lib/db.l
 | 
4
++--
M
lib/too.l
 | 
66
++++++++++++++++++++++++++++++++----------------------------------
M
src64/version.l
 | 
4
++--

4 files changed, 36 insertions(+), 38 deletions(-)
diff --git a/doc/index.html b/doc/index.html
diff --git a/lib/db.l b/lib/db.l
@@ -1,4 +1,4 @@
-# 08mar10abu
+# 14jun10abu
 # (c) Software Lab. Alexander Burger
 
 # *Dbs *Jnl *Blob upd
@@ -196,7 +196,7 @@
    (and Val
       (or
          (super Val X)
-         (car (member Val X)) ) ) )
+         (pick 'has> (: bag) (circ Val) X) ) ) )
 
 (dm put> (Obj Old New)
    (trim
diff --git a/lib/too.l b/lib/too.l
@@ -1,4 +1,4 @@
-# 16apr10abu
+# 14jun10abu
 # (c) Software Lab. Alexander Burger
 
 ### DB Garbage Collection ###
@@ -178,42 +178,40 @@
                                  (<> Obj (fetch Tree (cons V Aux)))
                                  (link X) ) ) ) )
                      (T
-                        (for B (: bag)
+                        (for (N . B) (: bag)
                            (cond
                               ((isa '+Key B)
-                                 (let N (index B (: bag))
-                                    (with B
-                                       (when
-                                          (find
-                                             '((L)
-                                                (and
-                                                   (get L N)
-                                                   (<> Obj
-                                                      (fetch
-                                                         (tree (: var) (: cls)
-                                                            (get
-                                                               (if (sym? (: hook)) Obj L)
-                                                               (: hook) ) )
-                                                         (get L N) ) ) ) )
-                                                V )
-                                             (link X) ) ) ) )
+                                 (with B
+                                    (when
+                                       (find
+                                          '((L)
+                                             (let? Val (get L N)
+                                                (<> Obj
+                                                   (fetch
+                                                      (tree (: var) (: cls)
+                                                         (get
+                                                            (if (sym? (: hook)) Obj L)
+                                                            (: hook) ) )
+                                                      Val ) ) ) )
+                                             V )
+                                          (link X) ) ) )
                               ((isa '+Ref B)
-                                 (let N (index B (: bag))
-                                    (with B
-                                       (when
-                                          (find
-                                             '((L)
-                                                (and
-                                                   (get L N)
-                                                   (<> Obj
-                                                      (fetch
-                                                         (tree (: var) (: cls)
-                                                            (get
-                                                               (if (sym? (: hook)) Obj L)
-                                                               (: hook) ) )
-                                                         (cons (get L N) Obj) ) ) ) )
-                                                V )
-                                             (link X) ) ) ) ) ) ) ) ) ) ) ) )
+                                 (with B
+                                    (when
+                                       (find
+                                          '((L)
+                                             (let? Val (get L N)
+                                                (when (isa '+Fold This)
+                                                   (setq Val (fold Val)) )
+                                                (<> Obj
+                                                   (fetch
+                                                      (tree (: var) (: cls)
+                                                         (get
+                                                            (if (sym? (: hook)) Obj L)
+                                                            (: hook) ) )
+                                                      (cons Val Obj) ) ) ) )
+                                             V )
+                                          (link X) ) ) ) ) ) ) ) ) ) ) )
       (cons Obj @) ) )
 
 
diff --git a/src64/version.l b/src64/version.l
@@ -1,6 +1,6 @@
-# 11jun10abu
+# 14jun10abu
 # (c) Software Lab. Alexander Burger
 
-(de *Version 3 0 2 28)
+(de *Version 3 0 2 29)
 
 # vi:et:ts=3:sw=3