picolisp

commit 55923ba80ac6e005cddd8003020da7874a7e075f
parent 6d9df9609714361ac06ec688c31c434426059ade
Author: Alexander Burger <abu@software-lab.de>
Date:   Wed,  9 Mar 2011 18:11:29 +0100

Added 'genStrKey' function
Diffstat:
M
doc/refG.html
 | 
13
++++++++++++-
M
lib/db.l
 | 
12
+++++++-----

2 files changed, 19 insertions(+), 6 deletions(-)
diff --git a/doc/refG.html b/doc/refG.html
@@ -50,7 +50,8 @@ and <code><a href="refN.html#n0">n0</a></code>.
 <dd>Generates a key for a database tree. If a minimal key <code>num1</code>
 and/or a maximal key <code>num2</code> is given, the next free number in that
 range is returned. Otherwise, the current maximal key plus one is returned. See
-also <code><a href="refU.html#useKey">useKey</a></code> and <code><a
+also <code><a href="refU.html#useKey">useKey</a></code>, <code><a
+href="refG.html#genStrKey">genStrKey</a></code> and <code><a
 href="refM.html#maxKey">maxKey</a></code>.
 
 <pre><code>
@@ -60,6 +61,16 @@ href="refM.html#maxKey">maxKey</a></code>.
 -> 9
 </code></pre>
 
+<dt><a name="genStrKey"><code>(genStrKey 'sym 'var 'cls ['hook]) -> sym</code></a>
+<dd>Generates a unique string for a database tree, by prepending as many "# "
+sequences as necessary. See also <code><a
+href="refG.html#genKey">genKey</a></code>.
+
+<pre><code>
+: (genStrKey "ben" 'nm '+User)
+-> "# ben"
+</code></pre>
+
 <dt><a name="get"><code>(get 'sym1|lst ['sym2|cnt ..]) -> any</code></a>
 <dd>Fetches a value <code>any</code> from the properties of a symbol, or from a
 list. From the first argument <code>sym1|lst</code>, values are retrieved in
diff --git a/lib/db.l b/lib/db.l
@@ -1,4 +1,4 @@
-# 14jun10abu
+# 09mar11abu
 # (c) Software Lab. Alexander Burger
 
 # *Dbs *Jnl *Blob upd
@@ -121,6 +121,11 @@
       (while (fetch Tree (setq N (rand 1 Max))))
       N ) )
 
+(de genStrKey (Str Var Cls Hook)
+   (while (fetch (tree Var Cls Hook) Str)
+      (setq Str (pack "# " Str)) )
+   Str )
+
 
 ### Relations ###
 (class +relation)
@@ -1080,10 +1085,7 @@
       ((isa '+Number Rel)
          (genKey Var (get Rel 'cls) Hook) )
       ((isa '+String Rel)
-         (let S (pack "# " Val)
-            (while (fetch (tree Var (get Rel 'cls) Hook) S)
-               (setq S (pack "# " S)) )
-            S ) ) ) )
+         (genStrKey (pack "# " Val) Var (get Rel 'cls) Hook) ) ) )
 
 (dm clone!> ()
    (prog2