klisp

an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

commit 26f6e0730e24921a4f462215dd02816d9a7eeae8
parent 13815696f641e7d0742b3de7c21ff2ed8adaaa6c
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Wed, 20 Apr 2011 00:24:52 -0300

Changed table code to simplify setting and getting of symbols. Also used hash of symbols directly instead of the pointer address. Bugfix: only immutable strings use strhash, mutable strings are compared by pointer.

Diffstat:
Msrc/Makefile | 4++--
Msrc/ktable.c | 51++++++++++++++++++++++++++++++++++++++++++++-------
Msrc/ktable.h | 2++
3 files changed, 48 insertions(+), 9 deletions(-)

diff --git a/src/Makefile b/src/Makefile @@ -64,7 +64,7 @@ kmem.o: kmem.c kmem.h klisp.h kerror.h klisp.h kstate.h kgc.h klispconf.h kerror.o: kerror.c kerror.h klisp.h kstate.h klisp.h kmem.h kstring.h kpair.h kauxlib.o: kauxlib.c kauxlib.h klisp.h kstate.h klisp.h kenvironment.o: kenvironment.c kenvironment.h kpair.h kobject.h kerror.h \ - kmem.h kstate.h klisp.h kgc.h + kmem.h kstate.h klisp.h kgc.h ktable.h kcontinuation.o: kcontinuation.c kcontinuation.h kmem.h kstate.h kobject.h \ klisp.h kgc.h koperative.o: koperative.c koperative.h kmem.h kstate.h kobject.h \ @@ -78,7 +78,7 @@ kpromise.o: kpromise.c kpromise.h kmem.h kstate.h kobject.h \ kport.o: kport.c kport.h kmem.h kstate.h kobject.h klisp.h kerror.h kstring.h \ kgc.h ktable.o: ktable.c ktable.h kobject.h kstate.h kmem.h klisp.h kgc.h \ - kapplicative.h kgeqp.h + kapplicative.h kgeqp.h kstring.h keval.o: keval.c keval.h kcontinuation.h kenvironment.h kstate.h kobject.h \ kpair.h kerror.h klisp.h krepl.o: krepl.c krepl.h kcontinuation.h kstate.h kobject.h keval.h klisp.h \ diff --git a/src/ktable.c b/src/ktable.c @@ -5,6 +5,11 @@ */ /* +** XXX/TODO: allow KNIL values and keys. Use other value +** to indicate missing entries (also in kgc.c) +*/ + +/* ** SOURCE NOTE: This is almost textually from lua. ** Parts that don't apply, or don't apply yet to klisp are in comments. ** In klisp arrays are indexed from 0, (while in Lua they are indexed from @@ -13,7 +18,6 @@ ** that's bad, should probably use a sentinel value that is unavailable ** to the program, and throw an error on get of an unsetted value... ** for now however stick to the "Lua way" -** GC: check all of this for possible unrooted objects */ /* @@ -40,7 +44,7 @@ #include "ktable.h" #include "kapplicative.h" #include "kgeqp.h" - +#include "kstring.h" /* ** max size of array part is 2^MAXBITS @@ -52,6 +56,7 @@ #define hashpow2(t,n) (gnode(t, lmod((n), sizenode(t)))) #define hashstr(t,str) hashpow2(t, (str)->hash) +#define hashsym(t,sym) hashpow2(t, (sym)->hash) #define hashboolean(t,p) hashpow2(t, p? 1 : 0) @@ -113,9 +118,12 @@ static Node *mainposition (const Table *t, TValue key) { case K_TBOOLEAN: return hashboolean(t, bvalue(key)); case K_TSTRING: - return hashstr(t, tv2str(key)); + if (kstring_immutablep(key)) + return hashstr(t, tv2str(key)); + else /* mutable strings are eq iff they are the same object */ + return hashpointer(t, gcvalue(key)); case K_TSYMBOL: - return hashstr(t, tv2str(tv2sym(key)->str)); + return hashsym(t, tv2sym(key)); case K_TUSER: return hashpointer(t, pvalue(key)); case K_TAPPLICATIVE: @@ -485,10 +493,10 @@ const TValue *klispH_getfixint (Table *t, int32_t key) /* -** search function for strings -** (TODO check mutability) +** search function for immutable strings */ const TValue *klispH_getstr (Table *t, String *key) { + klisp_assert(kstring_immutablep(gc2str(key))); Node *n = hashstr(t, key); do { /* check whether `key' is somewhere in the chain */ if (ttisstring(gkey(n)->this) && tv2str(gkey(n)->this) == key) @@ -498,6 +506,19 @@ const TValue *klispH_getstr (Table *t, String *key) { return &knil; } +/* +** search function for symbol +*/ +const TValue *klispH_getsym (Table *t, Symbol *key) { + Node *n = hashsym(t, key); + do { /* check whether `key' is somewhere in the chain */ + if (ttissymbol(gkey(n)->this) && tv2sym(gkey(n)->this) == key) + return &gval(n); /* that's it */ + else n = gnext(n); + } while (n); + return &knil; +} + /* ** main search function @@ -506,8 +527,12 @@ const TValue *klispH_get (Table *t, TValue key) { switch (ttype(key)) { case K_TNIL: return &knil; - case K_TSTRING: return klispH_getstr(t, tv2str(key)); + case K_TSYMBOL: return klispH_getsym(t, tv2sym(key)); case K_TFIXINT: return klispH_getfixint(t, ivalue(key)); + case K_TSTRING: + if (kstring_immutablep(key)) + return klispH_getstr(t, tv2str(key)); + /* else fall through */ default: { Node *n = mainposition(t, key); do { /* check whether `key' is somewhere in the chain */ @@ -552,6 +577,7 @@ TValue *klispH_setfixint (klisp_State *K, Table *t, int32_t key) TValue *klispH_setstr (klisp_State *K, Table *t, String *key) { + klisp_assert(kstring_immutablep(gc2str(key))); const TValue *p = klispH_getstr(t, key); if (p != &knil) return cast(TValue *, p); @@ -561,6 +587,17 @@ TValue *klispH_setstr (klisp_State *K, Table *t, String *key) } +TValue *klispH_setsym (klisp_State *K, Table *t, Symbol *key) +{ + const TValue *p = klispH_getsym(t, key); + if (p != &knil) + return cast(TValue *, p); + else { + return newkey(K, t, gc2sym(key)); + } +} + + /* klisp: Untested, may have off by one errors, check before using */ static int32_t unbound_search (Table *t, int32_t j) { int32_t i = j; /* i -1 or a present index */ diff --git a/src/ktable.h b/src/ktable.h @@ -26,6 +26,8 @@ const TValue *klispH_getfixint (Table *t, int32_t key); TValue *klispH_setfixint (klisp_State *K, Table *t, int32_t key); const TValue *klispH_getstr (Table *t, String *key); TValue *klispH_setstr (klisp_State *K, Table *t, String *key); +const TValue *klispH_getsym (Table *t, Symbol *key); +TValue *klispH_setsym (klisp_State *K, Table *t, Symbol *key); const TValue *klispH_get (Table *t, TValue key); TValue *klispH_set (klisp_State *K, Table *t, TValue key); TValue klispH_new (klisp_State *K, int32_t narray, int32_t nhash,