picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

commit 33bb3c56c72f0459e650299bd1e77d6021ddad89
parent c4cecbcea99f49b7c06e5532033ea8172c3b0916
Author: Alexander Burger <abu@software-lab.de>
Date:   Sat,  9 Jul 2011 09:40:00 +0200

'hash' function
Diffstat:
MCHANGES | 1+
Mdoc/refC.html | 4++--
Mdoc/refH.html | 16++++++++++++++++
Mdoc/refI.html | 1+
Mdoc/refS.html | 3++-
Mersatz/fun.src | 32++++++++++++++++++++++----------
Mersatz/picolisp.jar | 0
Mersatz/sys.src | 6+++---
Mlib/tags | 3++-
Mmisc/fibo.l | 4++--
Msrc/big.c | 16+++++++++++++++-
Msrc/pico.h | 3++-
Msrc/tab.c | 3++-
Msrc64/big.l | 29++++++++++++++++++++++++++++-
Msrc64/glob.l | 3++-
Mtest/src/big.l | 18+++++++++++-------
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