commit 33bb3c56c72f0459e650299bd1e77d6021ddad89
parent c4cecbcea99f49b7c06e5532033ea8172c3b0916
Author: Alexander Burger <abu@software-lab.de>
Date: Sat, 9 Jul 2011 09:40:00 +0200
'hash' function
Diffstat:
16 files changed, 111 insertions(+), 31 deletions(-)
diff --git a/CHANGES b/CHANGES
@@ -1,4 +1,5 @@
* XXsep11 picoLisp-3.0.8
+ 'hash' function
Bug in 'dbFetchEX' for db extensions
* 30jun11 picoLisp-3.0.7
diff --git a/doc/refC.html b/doc/refC.html
@@ -32,11 +32,11 @@ href="refR.html#rel">rel</a></code>.
<code><a href="refI.html#idx">idx</a></code> tree structure. Such an
optimization is sometimes called "memoization". <code>sym</code> must be a
transient symbol representing a unique key for the argument(s) to the
-calculation.
+calculation. See also <code><a href="refH.html#hash">hash</a></code>.
<pre><code>
: (de fibonacci (N)
- (cache '*Fibonacci (format N)
+ (cache '*Fibo (pack (char (hash N)) N)
(if (> 2 N)
1
(+
diff --git a/doc/refH.html b/doc/refH.html
@@ -36,6 +36,22 @@ href="ref.html#dbase">Database</a></code>.
(rel dsc (+Ref +String) Sup) # Item description, indexed per supplier
</code></pre>
+<dt><a name="hash"><code>(hash 'any) -> cnt</code></a>
+<dd>Generates a 16-bit number (1-65536) from <code>any</code>, suitable as a
+hash value for various purposes, like randomly balanced <code><a
+href="refI.html#idx">idx</a></code> structures. See also <code><a
+href="refC.html#cache">cache</a></code> and <code><a
+href="refS.html#seed">seed</a></code>.
+
+<pre><code>
+: (hash 0)
+-> 1
+: (hash 1)
+-> 55682
+: (hash "abc")
+-> 45454
+</code></pre>
+
<dt><a name="hax"><code>(hax 'num) -> sym</code></a>
<dt><code>(hax 'sym) -> num</code>
<dd>Converts a number <code>num</code> to a string in hexadecimal/alpha
diff --git a/doc/refI.html b/doc/refI.html
@@ -68,6 +68,7 @@ the third form (when called with a single <code>var</code> argument) the
contents of the tree are returned as a sorted list. If all elements are inserted
in sorted order, the tree degenerates into a linear list. See also <code><a
href="refL.html#lup">lup</a></code>, <code><a
+href="refH.html#hash">hash</a></code>, <code><a
href="refD.html#depth">depth</a></code>, <code><a
href="refS.html#sort">sort</a></code>, <code><a
href="refB.html#balance">balance</a></code> and <code><a
diff --git a/doc/refS.html b/doc/refS.html
@@ -215,7 +215,8 @@ $ pil +
<dt><a name="seed"><code>(seed 'any) -> cnt</code></a>
<dd>Initializes the random generator's seed, and returns a pseudo random number
in the range -2147483648 .. +2147483647. See also <code><a
-href="refR.html#rand">rand</a></code>.
+href="refR.html#rand">rand</a></code> and <code><a
+href="refH.html#hash">hash</a></code>.
<pre><code>
: (seed "init string")
diff --git a/ersatz/fun.src b/ersatz/fun.src
@@ -1,4 +1,4 @@
-# 08jul11abu
+# 09jul11abu
# (c) Software Lab. Alexander Burger
# Ersatz PicoLisp Functions
@@ -3168,6 +3168,18 @@ seed (n)
n = initSeed(ex.Cdr.Car.eval()) * 6364136223846793005L;
return new Number(Seed = n);
+# (hash 'any) -> cnt
+hash (i j n)
+ n = initSeed(ex.Cdr.Car.eval());
+ i = 64;
+ j = 0;
+ do {
+ if ((((int)n ^ j) & 1) != 0)
+ j ^= 0x14002; /* CRC Polynom x**16 + x**15 + x**2 + 1 */
+ n >>>= 1; j >>= 1;
+ } while (--i != 0);
+ return new Number(j + 1);
+
# (rand ['cnt1 'cnt2] | ['T]) -> cnt | flg
rand (x)
Seed = Seed * 6364136223846793005L + 1;
@@ -3225,7 +3237,7 @@ poll (i x)
peek ()
if (InFile.Chr == 0)
InFile.get();
- return InFile.Chr<0? Nil : mkChar((char)InFile.Chr);
+ return InFile.Chr<0? Nil : mkChar(InFile.Chr);
# (char) -> sym
# (char 'cnt) -> sym
@@ -3235,17 +3247,17 @@ char (x)
if (!((ex = ex.Cdr) instanceof Cell)) {
if (InFile.Chr == 0)
InFile.get();
- x = InFile.Chr < 0? Nil : mkChar((char)InFile.Chr);
+ x = InFile.Chr < 0? Nil : mkChar(InFile.Chr);
InFile.get();
return x;
}
if ((x = ex.Car.eval()) instanceof Number)
- return x.equal(Zero)? Nil : mkChar((char)((Number)x).Cnt);
- return x == T? mkChar((char)0xFFFF) : new Number(firstChar(x));
+ return x.equal(Zero)? Nil : mkChar(((Number)x).Cnt);
+ return x == T? mkChar(0x10000) : new Number(firstChar(x));
# (skip ['any]) -> sym
skip (c)
- return InFile.skip(firstChar(ex.Cdr.Car.eval())) < 0? Nil : mkChar((char)InFile.Chr);
+ return InFile.skip(firstChar(ex.Cdr.Car.eval())) < 0? Nil : mkChar(InFile.Chr);
# (eol) -> flg
eol ()
@@ -3299,9 +3311,9 @@ till (x y str sb)
if (InFile.Chr < 0 || str.indexOf((char)InFile.Chr) >= 0)
return Nil;
if (x.Cdr.Car.eval() == Nil) {
- y = x = new Cell(mkChar((char)InFile.Chr), Nil);
+ y = x = new Cell(mkChar(InFile.Chr), Nil);
while (InFile.get() > 0 && str.indexOf((char)InFile.Chr) < 0)
- x = x.Cdr = new Cell(mkChar((char)InFile.Chr), Nil);
+ x = x.Cdr = new Cell(mkChar(InFile.Chr), Nil);
return y;
}
sb = new StringBuilder();
@@ -3324,11 +3336,11 @@ line (i x y z sb)
} while (!InFile.eol());
return mkStr(sb);
}
- for (x = y = new Cell(mkChar((char)InFile.Chr), Nil);;) {
+ for (x = y = new Cell(mkChar(InFile.Chr), Nil);;) {
InFile.get();
if (InFile.eol())
return x;
- y = y.Cdr = new Cell(mkChar((char)InFile.Chr), Nil);
+ y = y.Cdr = new Cell(mkChar(InFile.Chr), Nil);
}
# (any 'sym) -> any
diff --git a/ersatz/picolisp.jar b/ersatz/picolisp.jar
Binary files differ.
diff --git a/ersatz/sys.src b/ersatz/sys.src
@@ -1,4 +1,4 @@
-// 01mar11abu
+// 09jul11abu
// (c) Software Lab. Alexander Burger
import java.util.*;
@@ -243,7 +243,7 @@ public class PicoLisp {
n += b[i];
}
}
- return n;
+ return n>=0? n*2 : -n*2+1;
}
final static Any date(int y, int m, int d) {
@@ -574,7 +574,7 @@ public class PicoLisp {
return null;
}
- final static Any mkChar(char c) {return new Symbol(null, "" + c);}
+ final static Any mkChar(int c) {return new Symbol(null, "" + (char)(c >= 0x10000? 0xFFFF : c));}
final static Any mkStr(String nm) {return nm == null || nm.length() == 0? Nil : new Symbol(null, nm);}
final static Any mkStr(StringBuilder sb) {return mkStr(sb.toString());}
final static Symbol mkSymbol(Any val) {return new Symbol(val, null);}
diff --git a/lib/tags b/lib/tags
@@ -153,6 +153,7 @@ getd (740 . "@src64/sym.l")
getl (3030 . "@src64/sym.l")
glue (1232 . "@src64/sym.l")
gt0 (2716 . "@src64/big.l")
+hash (2974 . "@src64/big.l")
head (1820 . "@src64/subr.l")
heap (527 . "@src64/main.l")
hear (3196 . "@src64/io.l")
@@ -275,7 +276,7 @@ pwd (2675 . "@src64/main.l")
queue (1918 . "@src64/sym.l")
quit (1090 . "@src64/main.l")
quote (139 . "@src64/flow.l")
-rand (2974 . "@src64/big.l")
+rand (3001 . "@src64/big.l")
range (997 . "@src64/subr.l")
rank (3033 . "@src64/subr.l")
raw (450 . "@src64/main.l")
diff --git a/misc/fibo.l b/misc/fibo.l
@@ -1,4 +1,4 @@
-# 25may11abu
+# 09jul11abu
# (c) Software Lab. Alexander Burger
# Standard version
@@ -26,7 +26,7 @@
# Using a cache (fastest)
(de cachedFibo (N)
- (cache '*Fibo (format (seed N))
+ (cache '*Fibo (pack (char (hash N)) N)
(if (> 2 N)
1
(+ (cachedFibo (dec N)) (cachedFibo (- N 2))) ) ) )
diff --git a/src/big.c b/src/big.c
@@ -1,4 +1,4 @@
-/* 08jul11abu
+/* 09jul11abu
* (c) Software Lab. Alexander Burger
*/
@@ -1140,6 +1140,20 @@ any doSeed(any ex) {
return box(hi(Seed = initSeed(EVAL(cadr(ex))) * 6364136223846793005LL));
}
+// (hash 'any) -> cnt
+any doHash(any ex) {
+ word2 n = initSeed(EVAL(cadr(ex)));
+ int i = 64;
+ int j = 0;
+
+ do {
+ if (((int)n ^ j) & 1)
+ j ^= 0x14002; /* CRC Polynom x**16 + x**15 + x**2 + 1 */
+ n >>= 1, j >>= 1;
+ } while (--i);
+ return box(2 * (j + 1));
+}
+
// (rand ['cnt1 'cnt2] | ['T]) -> cnt | flg
any doRand(any ex) {
any x;
diff --git a/src/pico.h b/src/pico.h
@@ -1,4 +1,4 @@
-/* 10jun11abu
+/* 09jul11abu
* (c) Software Lab. Alexander Burger
*/
@@ -544,6 +544,7 @@ any doGetl(any);
any doGlue(any);
any doGt(any);
any doGt0(any);
+any doHash(any);
any doHead(any);
any doHeap(any);
any doHear(any);
diff --git a/src/tab.c b/src/tab.c
@@ -1,4 +1,4 @@
-/* 09mar11abu
+/* 09jul11abu
* (c) Software Lab. Alexander Burger
*/
@@ -149,6 +149,7 @@ static symInit Symbols[] = {
{doGlue, "glue"},
{doGt, ">"},
{doGt0, "gt0"},
+ {doHash, "hash"},
{doHead, "head"},
{doHeap, "heap"},
{doHear, "hear"},
diff --git a/src64/big.l b/src64/big.l
@@ -1,4 +1,4 @@
-# 08jul11abu
+# 09jul11abu
# (c) Software Lab. Alexander Burger
### Destructive primitives ###
@@ -2970,6 +2970,33 @@
or E CNT # Make short number
ret
+# (hash 'any) -> cnt
+(code 'doHash 2)
+ push X
+ ld E (E CDR) # Get arg
+ ld E (E)
+ eval # Eval it
+ call initSeedE_E # Initialize
+ ld X E # Value in X
+ ld C 64 # Counter
+ ld E 0 # Result
+ do
+ ld A X # Value XOR Result
+ xor A E
+ test A 1 # LSB set?
+ if nz # Yes
+ xor E (hex "14002") # CRC Polynom x**16 + x**15 + x**2 + 1
+ end
+ shr X 1 # Shift value
+ shr E 1 # and result
+ dec C # Done?
+ until z # Yes
+ inc E # Plus 1
+ shl E 4 # Make short number
+ or E CNT # Make short number
+ pop X
+ ret
+
# (rand ['cnt1 'cnt2] | ['T]) -> cnt | flg
(code 'doRand 2)
push X
diff --git a/src64/glob.l b/src64/glob.l
@@ -1,4 +1,4 @@
-# 20apr11abu
+# 09jul11abu
# (c) Software Lab. Alexander Burger
(data 'Data)
@@ -481,6 +481,7 @@
initFun NIL "|" doBitOr
initFun NIL "x|" doBitXor
initFun NIL "seed" doSeed
+ initFun NIL "hash" doHash
initFun NIL "rand" doRand
# Input/Output
diff --git a/test/src/big.l b/test/src/big.l
@@ -1,4 +1,4 @@
-# 23jan11abu
+# 09jul11abu
# (c) Software Lab. Alexander Burger
### format ###
@@ -157,11 +157,15 @@
(test NIL (sqrt NIL))
-### seed rand ###
-(test (if (== 64 64) 963569716595329593 2015582081) (seed "init string"))
-(test (if (== 64 64) 881495644906500132 -706917003) (rand))
-(test (if (== 64 64) -510782208671386616 1224196082) (rand))
-(test (if (== 64 64) 4 8) (rand 3 9))
-(test (if (== 64 64) 5 5) (rand 3 9))
+### seed rand hash ###
+(test (if (== 64 64) -1883594281 -1007791040) (seed "init string"))
+(test (if (== 64 64) 1699219178 -1053142179) (rand))
+(test (if (== 64 64) 494771840 1884033960) (rand))
+(test (if (== 64 64) 3 3) (rand 3 9))
+(test (if (== 64 64) 3 6) (rand 3 9))
+(test 1 (hash 0))
+(test 55682 (hash 1))
+(test 35970 (hash 7))
+(test 29691 (hash 1234567))
# vi:et:ts=3:sw=3
