diff --git a/scheme/ikarus.boot.4.prebuilt b/scheme/ikarus.boot.4.prebuilt index a534189..968ce98 100644 Binary files a/scheme/ikarus.boot.4.prebuilt and b/scheme/ikarus.boot.4.prebuilt differ diff --git a/scheme/ikarus.boot.8.prebuilt b/scheme/ikarus.boot.8.prebuilt index 1477441..9fa89f2 100644 Binary files a/scheme/ikarus.boot.8.prebuilt and b/scheme/ikarus.boot.8.prebuilt differ diff --git a/scheme/ikarus.symbols.ss b/scheme/ikarus.symbols.ss index 593f752..50792f4 100644 --- a/scheme/ikarus.symbols.ss +++ b/scheme/ikarus.symbols.ss @@ -20,6 +20,7 @@ getprop putprop remprop property-list top-level-value top-level-bound? set-top-level-value! symbol-value symbol-bound? set-symbol-value! + $unintern-gensym reset-symbol-proc! system-value system-value-gensym) (import (ikarus system $symbols) @@ -27,7 +28,7 @@ (ikarus system $fx) (except (ikarus) gensym gensym? gensym->unique-string gensym-prefix gensym-count print-gensym system-value - string->symbol symbol->string + $unintern-gensym string->symbol symbol->string getprop putprop remprop property-list top-level-value top-level-bound? set-top-level-value! symbol-value symbol-bound? set-symbol-value! reset-symbol-proc!)) @@ -44,10 +45,15 @@ (define gensym? (lambda (x) - (and (symbol? x) + (and (symbol? x) (let ([s ($symbol-unique-string x)]) (and s #t))))) + (define ($unintern-gensym x) + (if (symbol? x) + (begin (foreign-call "ikrt_unintern_gensym" x) (void)) + (die 'unintern-gensym "not a symbol" x))) + (define top-level-value (lambda (x) (unless (symbol? x) diff --git a/scheme/last-revision b/scheme/last-revision index 7fb595a..9190a7f 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1669 +1670 diff --git a/scheme/makefile.ss b/scheme/makefile.ss index a319e70..66c87ef 100755 --- a/scheme/makefile.ss +++ b/scheme/makefile.ss @@ -522,6 +522,7 @@ [$set-symbol-string! $symbols] [$set-symbol-unique-string! $symbols] [$set-symbol-plist! $symbols] + [$unintern-gensym $symbols] [$init-symbol-value! ] [$unbound-object? $symbols] ;;; diff --git a/src/ikarus-symbol-table.c b/src/ikarus-symbol-table.c index eeea5b6..438a3d2 100644 --- a/src/ikarus-symbol-table.c +++ b/src/ikarus-symbol-table.c @@ -68,22 +68,6 @@ static int strings_eqp(ikptr str1, ikptr str2){ return 0; } -#if 0 -static ikptr -ik_make_symbol(ikptr str, ikptr ustr, ikpcb* pcb){ - ikptr sym = ik_unsafe_alloc(pcb, symbol_size) + symbol_tag; - ref(sym, off_symbol_string) = str; - ref(sym, off_symbol_ustring) = ustr; - ref(sym, off_symbol_value) = unbound_object; - ref(sym, off_symbol_plist) = null_object; - ref(sym, off_symbol_system_value) = str; - ref(sym, off_symbol_code) = 0; - ref(sym, off_symbol_errcode) = 0; - ref(sym, off_symbol_unused) = 0; - return sym; -} -#endif - static ikptr ik_make_symbol(ikptr str, ikptr ustr, ikpcb* pcb){ ikptr sym = ik_unsafe_alloc(pcb, symbol_record_size) + record_tag; @@ -96,8 +80,6 @@ ik_make_symbol(ikptr str, ikptr ustr, ikpcb* pcb){ return sym; } - - static ikptr intern_string(ikptr str, ikptr st, ikpcb* pcb){ int h = compute_hash(str); @@ -173,6 +155,34 @@ ikrt_intern_gensym(ikptr sym, ikpcb* pcb){ } +ikptr +ikrt_unintern_gensym(ikptr sym, ikpcb* pcb){ + ikptr st = pcb->gensym_table; + if(st == 0){ + /* no symbol table */ + return false_object; + } + ikptr ustr = ref(sym, off_symbol_record_ustring); + if (tagof(ustr) != string_tag) { + return false_object; + } + int h = compute_hash(ustr); + int idx = h & (unfix(ref(st, off_vector_length)) - 1); + ikptr loc = (ikptr)(st+off_vector_data+idx*wordsize); + ikptr bckt = ref(loc, 0); + while(bckt){ + if (ref(bckt, off_car) == sym) { + /* found it */ + ref(loc, 0) = ref(bckt, off_cdr); + return true_object; + } else { + loc = (ikptr)(bckt + off_cdr); + bckt = ref(loc, 0); + } + } + return false_object; +} + ikptr @@ -201,15 +211,3 @@ ikrt_strings_to_gensym(ikptr str, ikptr ustr, ikpcb* pcb){ } -#if 0 -ikptr -ik_cstring_to_symbol(char* str, ikpcb* pcb){ - int n = strlen(str); - int size = n + disp_string_data + 1; - ikptr s = ik_unsafe_alloc(pcb, align(size)) + string_tag; - ref(s, off_string_length) = fix(n); - memcpy(s+off_string_data, str, n+1); - ikptr sym = ikrt_string_to_symbol(s, pcb); - return sym; -} -#endif