picolisp

commit f8248bfccf11d055fcd4d47e956e0be5d89b5c9e
parent 6b26ca7c0a5653bb80308c90ceb308dc42ab4c1e
Author: Alexander Burger <abu@software-lab.de>
Date:   Mon, 12 Dec 2011 15:44:25 +0100

Simplified '+Dep' and (set> . +Entity)
Diffstat:
M
doc/refA.html
 | 
4
++--
M
doc/refD.html
 | 
5
++---
M
ersatz/picolisp.jar
 | 
0

M
lib/db.l
 | 
87
+++++++++++++++++++++++++++++++++----------------------------------------------
M
src/vers.h
 | 
2
+-
M
src64/version.l
 | 
4
++--

6 files changed, 43 insertions(+), 59 deletions(-)
diff --git a/doc/refA.html b/doc/refA.html
@@ -619,8 +619,8 @@ href="refA.html#+Aux">+Aux</a></code>.
 
 <pre><code>
 (class +PS +Entity)
-(rel par    (+Dep +Joint) (sup) ps (+Part))     # Part
-(rel sup    (+Aux +Ref +Link) (par) NIL (+Supp))# Supplier
+(rel par (+Dep +Joint) (sup) ps (+Part))        # Part
+(rel sup (+Aux +Ref +Link) (par) NIL (+Supp))   # Supplier
 ...
    (aux 'sup '+PS                               # Access PS object
       (db 'nr '+Supp 1234)
diff --git a/doc/refD.html b/doc/refD.html
@@ -89,9 +89,8 @@ href="ref.html#dbase">Database</a></code>.
 <dd>Prefix class for maintaining depenencies between <code><a
 href="refR.html#+relation">+relation</a></code>s. Expects a list of (symbolic)
 attributes that depend on this relation. Whenever this relations is cleared
-(receives a value of <code>NIL</code>, or the whole entity is deleted with
-<code>lose&gt;</code>), the dependent relations will also be cleared, triggering
-all required side-effects. See also <code><a
+(receives a value of <code>NIL</code>), the dependent relations will also be
+cleared, triggering all required side-effects. See also <code><a
 href="ref.html#dbase">Database</a></code>.
 
 <p>In the following example, the index entry for the item pointing to the
diff --git a/ersatz/picolisp.jar b/ersatz/picolisp.jar
Binary files differ.
diff --git a/lib/db.l b/lib/db.l
@@ -1,4 +1,4 @@
-# 21nov11abu
+# 12dec11abu
 # (c) Software Lab. Alexander Burger
 
 # *Dbs *Jnl *Blob upd
@@ -715,14 +715,11 @@
 (dm rel> (Obj Old New Hook)
    (unless New
       (for Var (: dep)
-         (del> Obj Var (get Obj Var)) ) )
+         (let? V (get Obj Var)
+            (rel> (meta Obj Var) Obj V
+               (put> (meta Obj Var) Obj V NIL) ) ) ) )
    (extra Obj Old New Hook) )
 
-(dm lose> (Obj Val Hook)
-   (for Var (: dep)
-      (del> Obj Var (get Obj Var)) )
-   (extra Obj Val Hook) )
-
 
 (class +List)
 
@@ -1020,58 +1017,46 @@
 
 (dm set> (Val)
    (unless (= Val (val This))
-      (let
-         (L
-            (extract
-               '((X)
-                  (pop 'X)
-                  (unless (== (meta Val X) (meta (val This) X))
-                     X ) )
-               (getl This) )
-            V (mapcar
-               '((X)
-                  (prog1
-                     (get This X)
-                     (if (meta This X)
-                        (put> This X)
-                        (put This X) ) ) )
-               L ) )
+      (let L
+         (extract
+            '((X)
+               (pop 'X)
+               (and
+                  (meta Val X)
+                  (n== @ (meta (val This) X))
+                  X ) )
+            (getl This) )
+         (for Var L
+            (let V (get This Var)
+               (rel> (meta This Var) This V
+                  (put> (meta This Var) This V NIL) ) ) )
          (xchg This 'Val)
-         (mapc
-            '((X V)
-               (if (meta This X)
-                  (put> This X V)
-                  (put This X V) ) )
-            L V ) )
+         (for Var L
+            (rel> (meta This Var) This NIL
+               (put> (meta This Var) This NIL (get This Var)) ) ) )
       (upd> This (val This) Val) )
    (val This) )
 
 (dm set!> (Val)
    (unless (= Val (val This))
       (dbSync)
-      (let
-         (L
-            (extract
-               '((X)
-                  (pop 'X)
-                  (unless (== (meta Val X) (meta (val This) X))
-                     X ) )
-               (getl This) )
-            V (mapcar
-               '((X)
-                  (prog1
-                     (get This X)
-                     (if (meta This X)
-                        (put> This X)
-                        (put This X) ) ) )
-               L ) )
+      (let L
+         (extract
+            '((X)
+               (pop 'X)
+               (and
+                  (meta Val X)
+                  (n== @ (meta (val This) X))
+                  X ) )
+            (getl This) )
+         (for Var L
+            (let V (get This Var)
+               (rel> (meta This Var) This V
+                  (put> (meta This Var) This V NIL) ) ) )
          (xchg This 'Val)
-         (mapc
-            '((X V)
-               (if (meta This X)
-                  (put> This X V)
-                  (put This X V) ) )
-            L V ) )
+         (for Var L
+            (rel> (meta This Var) This NIL
+               (put> (meta This Var) This NIL (get This Var)) ) ) )
       (upd> This (val This) Val)
       (commit 'upd) )
    (val This) )
diff --git a/src/vers.h b/src/vers.h
@@ -1 +1 @@
-static byte Version[4] = {3,0,8,9};
+static byte Version[4] = {3,0,8,10};
diff --git a/src64/version.l b/src64/version.l
@@ -1,6 +1,6 @@
-# 26nov11abu
+# 12dec11abu
 # (c) Software Lab. Alexander Burger
 
-(de *Version 3 0 8 9)
+(de *Version 3 0 8 10)
 
 # vi:et:ts=3:sw=3