src/package.c @@ -68,7 +68,7 @@ EXTRA_DIST = scm/morse.scm tests/scm-test.sh tests/interp-test.scm scm/struct.sc doc/dfsch-repl.1 src/udata-gen.c src/UnicodeData.txt doc/dfsch.doc scm/docgen.scm libdfsch_la_SOURCES = src/dfsch.c dfsch/dfsch.h src/internal.h\ - src/types.c src/types.h dfsch/types.h \ + src/types.c src/types.h dfsch/types.h src/package.c\ src/parse.c dfsch/parse.h \ src/native.c src/native_cxr.c \ src/control.c src/system.c \ Makefile.am @@ -569,7 +569,6 @@ static void symbol_write(object_t* o, dfsch_writer_state_t* state){ dfsch_write_string(state, dfsch_saprintf("#<gensym %p>", o)); } } -#define SYMBOL DFSCH_SYMBOL_TYPE dfsch_type_t dfsch_tagged_types[4] = { @@ -870,9 +869,6 @@ int dfsch_list_p(dfsch_object_t* obj){ int dfsch_atom_p(dfsch_object_t* obj){ return !DFSCH_PAIR_P(obj); } -int dfsch_symbol_p(dfsch_object_t* obj){ - return DFSCH_TYPE_OF(obj) == SYMBOL; -} int dfsch_primitive_p(dfsch_object_t* obj){ return DFSCH_TYPE_OF(obj) == PRIMITIVE; @@ -1613,280 +1609,6 @@ dfsch_object_t* dfsch_assv(dfsch_object_t *key, -// Symbols - -#define HASH_BITS 10 -#define HASH_SIZE (1 << HASH_BITS) - -typedef struct hash_entry_t hash_entry_t; -struct hash_entry_t { - symbol_t* entry; - size_t hash; - hash_entry_t* next; -}; - - -static size_t string_hash(char* string){ - size_t tmp=0; - - while (*string){ - char c = *string; - tmp ^= c ^ (tmp << 7); - tmp ^= ((size_t)c << 17) ^ (tmp >> 11); - ++string; - } - - return tmp & (HASH_SIZE - 1); -} - -struct dfsch_package_t { - dfsch_type_t* type; -}; - -dfsch_package_t dfsch_dfsch_package = { - .type = DFSCH_PACKAGE_TYPE -}; -dfsch_package_t dfsch_dfsch_user_package = { - .type = DFSCH_PACKAGE_TYPE -}; - -dfsch_type_t dfsch_package_type = { - .type = DFSCH_STANDARD_TYPE -}; - -static hash_entry_t* global_symbol_hash[HASH_SIZE]; -static unsigned int gsh_init = 0; -static pthread_mutex_t symbol_lock = PTHREAD_MUTEX_INITIALIZER; -dfsch__symbol_t dfsch__static_symbols[] = { - {DFSCH_DFSCH_PACKAGE, "true"}, - {DFSCH_DFSCH_PACKAGE, "quote"}, - {DFSCH_DFSCH_PACKAGE, "quasiquote"}, - {DFSCH_DFSCH_PACKAGE, "unquote"}, - {DFSCH_DFSCH_PACKAGE, "unquote-splicing"}, - {DFSCH_DFSCH_PACKAGE, "else"}, - {DFSCH_DFSCH_PACKAGE, "=>"}, - {DFSCH_DFSCH_PACKAGE, "&optional"}, - {DFSCH_DFSCH_PACKAGE, "&key"}, - {DFSCH_DFSCH_PACKAGE, "&rest"}, - {DFSCH_DFSCH_PACKAGE, "&body"}, - {DFSCH_DFSCH_PACKAGE, "&allow-other-keys"}, - {DFSCH_DFSCH_PACKAGE, "&environment"}, - {DFSCH_DFSCH_PACKAGE, "&whole"}, - {DFSCH_DFSCH_PACKAGE, "&aux"}, - {DFSCH_DFSCH_PACKAGE, "before"}, - {DFSCH_DFSCH_PACKAGE, "after"}, - {DFSCH_DFSCH_PACKAGE, "around"}, -}; - -/* - * It's possible to use rwlock here (althought such solution is not so - * straightforward), but it seem unnecessary - most symbol creations are - * done when reading source and in such case there will be probably only - * one thread doing such things. - */ - -static void register_static_symbol(symbol_t* s){ - hash_entry_t *e = malloc(sizeof(hash_entry_t)); - - e->entry = s; - e->hash = string_hash(s->name); - - e->next = global_symbol_hash[e->hash]; - global_symbol_hash[e->hash] = e; -} - -static void gsh_check_init(){ - int i; - if (gsh_init){ - return; - } - - memset(global_symbol_hash, 0, sizeof(hash_entry_t*)*HASH_SIZE); - for (i = 0; i < sizeof(dfsch__static_symbols)/sizeof(symbol_t); i++){ - register_static_symbol(dfsch__static_symbols + i); - } - gsh_init = 1; -} - -static symbol_t* lookup_symbol(char *symbol){ - - size_t hash = string_hash(symbol); - hash_entry_t *i = global_symbol_hash[hash]; - - while (i){ - if (i->hash == hash && strcmp(i->entry->name, symbol)==0){ - return i->entry; - } - i = i->next; - } - - return NULL; -} - -static void free_symbol(symbol_t* s){ - hash_entry_t *i; - hash_entry_t *j; - - pthread_mutex_lock(&symbol_lock); - - i = global_symbol_hash[string_hash(s->name)]; - j = NULL; - - while (i){ - if (i->entry == s){ - if (j){ - j->next = i->next; - } else { - global_symbol_hash[string_hash(s->name)] = i->next; - } - free(i); - break; - } - j = i; - i = i->next; - } - - pthread_mutex_unlock(&symbol_lock); - - s->name = NULL; -} - -static void symbol_finalizer(symbol_t* symbol, void* cd){ - free_symbol(symbol); -} - -static symbol_t* make_symbol(char *symbol){ - symbol_t *s; - symbol_t *f; - - s = GC_NEW(symbol_t); /* !!! free_symbol could be called by this */ - if (*symbol == ':'){ - s->name = stracpy(symbol+1); - s->package = NULL; - } else { - s->name = stracpy(symbol); - s->package = DFSCH_DFSCH_PACKAGE; - } - - pthread_mutex_lock(&symbol_lock); - - f = lookup_symbol(symbol); - if (f){ - GC_FREE(s->name); - GC_FREE(s); - pthread_mutex_unlock(&symbol_lock); - return f; - } - - - GC_REGISTER_FINALIZER(s, - (GC_finalization_proc)symbol_finalizer, NULL, - NULL, NULL); - - hash_entry_t *e = malloc(sizeof(hash_entry_t)); - - e->entry = s; - e->hash = string_hash(symbol); - - e->next = global_symbol_hash[e->hash]; - global_symbol_hash[e->hash] = e; - - pthread_mutex_unlock(&symbol_lock); - - return s; -} - -dfsch_object_t* dfsch_gensym(){ - symbol_t *s = GC_NEW(symbol_t); - - s->package = DFSCH_DFSCH_USER_PACKAGE; - s->name = NULL; - - return DFSCH_TAG_ENCODE(s, 2); -} - -dfsch_object_t* dfsch_make_symbol(char* symbol){ - - symbol_t *s; - - if (!symbol){ - return dfsch_gensym(); - } - - pthread_mutex_lock(&symbol_lock); - - gsh_check_init(); - // This code is slow already, so this check does not matter (too much) - - s = lookup_symbol(symbol); - - pthread_mutex_unlock(&symbol_lock); - - if (!s) - s = make_symbol(symbol); - - return DFSCH_TAG_ENCODE(s, 2); - -} -char* dfsch_symbol(dfsch_object_t* symbol){ - return ((symbol_t*)DFSCH_TAG_REF(DFSCH_ASSERT_TYPE(symbol, SYMBOL)))->name; -} - -char* dfsch_symbol_2_typename(dfsch_object_t* symbol){ - char *name; - char *flt; - - name = dfsch_symbol(symbol); - - if (name[strlen(name)-1] == '>'){ - flt = strchr(name, '<'); - if (flt){ - if (flt == name){ - return strancpy(name+1, strlen(name) - 2); - } else { - return strancat(name, flt - name, flt+1, strlen(flt+1)-1); - } - } - } - - return name; -} - - - -int dfsch_compare_symbol(dfsch_object_t* symbol, - char* string){ - return (ascii_strcasecmp(string, dfsch_symbol(symbol)) == 0); -} - -dfsch_object_t* dfsch_bool(int bool){ - return bool ? DFSCH_SYM_TRUE : NULL; -} - -struct dfsch_symbol_iter_t{ - hash_entry_t* item; - size_t bucket; -}; - -char* dfsch_get_next_symbol(dfsch_symbol_iter_t **iter){ // deep magic - if (*iter == NULL){ - *iter = GC_MALLOC(sizeof(dfsch_symbol_iter_t)); - (*iter)->bucket = 0; - (*iter)->item = global_symbol_hash[(*iter)->bucket]; - } - while ((*iter)->bucket < HASH_SIZE){ - if (!(*iter)->item){ - (*iter)->bucket ++; - (*iter)->item = global_symbol_hash[(*iter)->bucket]; - }else{ - hash_entry_t *i = (*iter)->item; - (*iter)->item = (*iter)->item->next; - return i->entry->name; - } - } - return NULL; -} - // closures src/types.c eb6fc8e338607929cb208b1425a5e2b98db67184 Ales Hakl ales@hakl.net http://github.com/adh/dfsch/commit/c6664fc0646812f4e01c4f9f76bbce9b4dd70cc3 c6664fc0646812f4e01c4f9f76bbce9b4dd70cc3 2009-11-15T19:25:35-08:00 2009-11-15T19:25:35-08:00 split package and symbol related code into separate file 31587bc1a5bb594f94976b1e5680b566362f5800 Ales Hakl ales@hakl.net