2
* Copyright (C) 2001 - 2004 Mike Wray <mike.wray@hp.com>
4
* This library is free software; you can redistribute it and/or modify
5
* it under the terms of the GNU Lesser General Public License as
6
* published by the Free Software Foundation; either version 2.1 of the
7
* License, or (at your option) any later version. This library is
8
* distributed in the hope that it will be useful, but WITHOUT ANY
9
* WARRANTY; without even the implied warranty of MERCHANTABILITY or
10
* FITNESS FOR A PARTICULAR PURPOSE.
11
* See the GNU Lesser General Public License for more details.
13
* You should have received a copy of the GNU Lesser General Public License
14
* along with this library; if not, write to the Free Software Foundation,
15
* Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
19
#include "sys_string.h"
22
#include "hash_table.h"
26
#include <linux/errno.h>
32
#include <linux/random.h>
36
get_random_bytes(&v, sizeof(v));
47
* General representation of sxprs.
48
* Includes print, equal, and free functions for the sxpr types.
50
* Zero memory containing an Sxpr will have the value ONONE - this is intentional.
51
* When a function returning an sxpr cannot allocate memory we return ONOMEM.
55
static int atom_print(IOStream *io, Sxpr obj, unsigned flags);
56
static int atom_equal(Sxpr x, Sxpr y);
57
static void atom_free(Sxpr obj);
58
static Sxpr atom_copy(Sxpr obj);
60
static int string_print(IOStream *io, Sxpr obj, unsigned flags);
61
static int string_equal(Sxpr x, Sxpr y);
62
static void string_free(Sxpr obj);
63
static Sxpr string_copy(Sxpr obj);
65
static int cons_print(IOStream *io, Sxpr obj, unsigned flags);
66
static int cons_equal(Sxpr x, Sxpr y);
67
static void cons_free(Sxpr obj);
68
static Sxpr cons_copy(Sxpr obj);
70
static int null_print(IOStream *io, Sxpr obj, unsigned flags);
71
static int none_print(IOStream *io, Sxpr obj, unsigned flags);
72
static int int_print(IOStream *io, Sxpr obj, unsigned flags);
73
static int bool_print(IOStream *io, Sxpr obj, unsigned flags);
74
static int err_print(IOStream *io, Sxpr obj, unsigned flags);
75
static int nomem_print(IOStream *io, Sxpr obj, unsigned flags);
77
/** Type definitions. */
78
static SxprType types[1024] = {
79
[T_NONE] { .type= T_NONE, .name= "none", .print= none_print },
80
[T_NULL] { .type= T_NULL, .name= "null", .print= null_print },
81
[T_UINT] { .type= T_UINT, .name= "int", .print= int_print, },
82
[T_BOOL] { .type= T_BOOL, .name= "bool", .print= bool_print, },
83
[T_ERR] { .type= T_ERR, .name= "err", .print= err_print, },
84
[T_NOMEM] { .type= T_ERR, .name= "nomem", .print= nomem_print, },
85
[T_ATOM] { .type= T_ATOM, .name= "atom", .print= atom_print,
91
[T_STRING] { .type= T_STRING, .name= "string", .print= string_print,
97
[T_CONS] { .type= T_CONS, .name= "cons", .print= cons_print,
105
/** Number of entries in the types array. */
106
static int type_sup = sizeof(types)/sizeof(types[0]);
109
* The tydef must have a non-zero type code.
110
* It is an error if the type code is out of range or already defined.
112
* @param tydef type definition
113
* @return 0 on success, error code otherwise
115
int def_sxpr_type(SxprType *tydef){
117
int ty = tydef->type;
118
if(ty < 0 || ty >= type_sup){
132
/** Get the type definition for a given type code.
134
* @param ty type code
135
* @return type definition or null
137
SxprType *get_sxpr_type(int ty){
138
if(0 <= ty && ty < type_sup){
144
/** The default print function.
146
* @param io stream to print to
147
* @param x sxpr to print
148
* @param flags print flags
149
* @return number of bytes written on success
151
int default_print(IOStream *io, Sxpr x, unsigned flags){
152
return IOStream_print(io, "#<%u %lu>\n", get_type(x), get_ul(x));
155
/** The default equal function.
158
* @param x sxpr to compare
159
* @param y sxpr to compare
160
* @return 1 if equal, 0 otherwise
162
int default_equal(Sxpr x, Sxpr y){
166
/** General sxpr print function.
167
* Prints an sxpr on a stream using the print function for the sxpr type.
168
* Printing is controlled by flags from the PrintFlags enum.
169
* If PRINT_TYPE is in the flags the sxpr type is printed before the sxpr
172
* @param io stream to print to
173
* @param x sxpr to print
174
* @param flags print flags
175
* @return number of bytes written
177
int objprint(IOStream *io, Sxpr x, unsigned flags){
178
SxprType *def = get_sxpr_type(get_type(x));
179
ObjPrintFn *print_fn = (def && def->print ? def->print : default_print);
182
if(flags & PRINT_TYPE){
183
k += IOStream_print(io, "%s:", def->name);
185
if(def->pointer && (flags & PRINT_ADDR)){
186
k += IOStream_print(io, "<%p>", get_ptr(x));
188
k += print_fn(io, x, flags);
192
Sxpr objcopy(Sxpr x){
193
SxprType *def = get_sxpr_type(get_type(x));
194
ObjCopyFn *copy_fn = (def ? def->copy : NULL);
198
} else if(def->pointer){
206
/** General sxpr free function.
207
* Frees an sxpr using the free function for its type.
208
* Free functions must recursively free any subsxprs.
209
* If no function is defined then the default is to
210
* free sxprs whose type has pointer true.
211
* Sxprs must not be used after freeing.
213
* @param x sxpr to free
215
void objfree(Sxpr x){
216
SxprType *def = get_sxpr_type(get_type(x));
221
} else if (def->pointer){
227
/** General sxpr equality function.
228
* Compares x and y using the equal function for x.
229
* Uses default_equal() if x has no equal function.
231
* @param x sxpr to compare
232
* @param y sxpr to compare
233
* @return 1 if equal, 0 otherwise
235
int objequal(Sxpr x, Sxpr y){
236
SxprType *def = get_sxpr_type(get_type(x));
237
ObjEqualFn *equal_fn = (def && def->equal ? def->equal : default_equal);
238
return equal_fn(x, y);
241
/** Search for a key in an alist.
242
* An alist is a list of conses, where the cars
243
* of the conses are the keys. Compares keys using equality.
246
* @param l alist to search
247
* @return first element of l with car k, or ONULL
249
Sxpr assoc(Sxpr k, Sxpr l){
250
for( ; CONSP(l) ; l = CDR(l)){
252
if(CONSP(x) && objequal(k, CAR(x))){
259
/** Search for a key in an alist.
260
* An alist is a list of conses, where the cars
261
* of the conses are the keys. Compares keys using eq.
264
* @param l alist to search
265
* @return first element of l with car k, or ONULL
267
Sxpr assocq(Sxpr k, Sxpr l){
268
for( ; CONSP(l); l = CDR(l)){
270
if(CONSP(x) && eq(k, CAR(x))){
277
/** Add a new key and value to an alist.
282
* @return l with the new cell added to the front
284
Sxpr acons(Sxpr k, Sxpr v, Sxpr l){
287
if(NOMEMP(x)) return x;
289
if(NOMEMP(y)) cons_free_cells(x);
293
/** Test if a list contains an element.
294
* Uses sxpr equality.
297
* @param x element to look for
298
* @return a tail of l with x as car, or ONULL
300
Sxpr cons_member(Sxpr l, Sxpr x){
301
for( ; CONSP(l) && !eq(x, CAR(l)); l = CDR(l)){}
305
/** Test if a list contains an element satisfying a test.
306
* The test function is called with v and an element of the list.
309
* @param test_fn test function to use
310
* @param v value for first argument to the test
311
* @return a tail of l with car satisfying the test, or 0
313
Sxpr cons_member_if(Sxpr l, ObjEqualFn *test_fn, Sxpr v){
314
for( ; CONSP(l) && !test_fn(v, CAR(l)); l = CDR(l)){ }
318
/** Test if the elements of list 't' are a subset of the elements
319
* of list 's'. Element order is not significant.
321
* @param s element list to check subset of
322
* @param t element list to check if is a subset
323
* @return 1 if is a subset, 0 otherwise
325
int cons_subset(Sxpr s, Sxpr t){
326
for( ; CONSP(t); t = CDR(t)){
327
if(!CONSP(cons_member(s, CAR(t)))){
334
/** Test if two lists have equal sets of elements.
335
* Element order is not significant.
337
* @param s list to check
338
* @param t list to check
339
* @return 1 if equal, 0 otherwise
341
int cons_set_equal(Sxpr s, Sxpr t){
342
return cons_subset(s, t) && cons_subset(t, s);
346
/*============================================================================*/
347
/* The functions inside this ifdef are only safe if GC is used.
348
* Otherwise they may leak memory.
351
/** Remove an element from a list (GC only).
352
* Uses sxpr equality and removes all instances, even
353
* if there are more than one.
355
* @param l list to remove elements from
356
* @param x element to remove
357
* @return modified input list
359
Sxpr cons_remove(Sxpr l, Sxpr x){
360
return cons_remove_if(l, eq, x);
363
/** Remove elements satisfying a test (GC only).
364
* The test function is called with v and an element of the set.
366
* @param l list to remove elements from
367
* @param test_fn function to use to decide if an element should be removed
368
* @return modified input list
370
Sxpr cons_remove_if(Sxpr l, ObjEqualFn *test_fn, Sxpr v){
371
Sxpr prev = ONULL, elt, next;
373
for(elt = l; CONSP(elt); elt = next){
375
if(test_fn(v, CAR(elt))){
386
/** Set the value for a key in an alist (GC only).
387
* If the key is present, changes the value, otherwise
393
* @return modified or extended list
395
Sxpr setf(Sxpr k, Sxpr v, Sxpr l){
396
Sxpr e = assoc(k, l);
404
/*============================================================================*/
407
/** Create a new atom with the given name.
409
* @param name the name
412
Sxpr atom_new(char *name){
413
Sxpr n, obj = ONOMEM;
416
// Don't always want to do this.
417
if(0 && convert_atol(name, &v) == 0){
420
n = string_new(name);
421
if(NOMEMP(n)) goto exit;
422
obj = HALLOC(ObjAtom, T_ATOM);
427
OBJ_ATOM(obj)->name = n;
437
void atom_free(Sxpr obj){
438
// Interned atoms are shared, so do not free.
439
if(OBJ_ATOM(obj)->interned) return;
440
objfree(OBJ_ATOM(obj)->name);
448
Sxpr atom_copy(Sxpr obj){
450
if(OBJ_ATOM(obj)->interned){
453
v = atom_new(atom_name(obj));
458
/** Print an atom. Prints the atom name.
460
* @param io stream to print to
461
* @param obj to print
462
* @param flags print flags
463
* @return number of bytes printed
465
int atom_print(IOStream *io, Sxpr obj, unsigned flags){
466
return objprint(io, OBJ_ATOM(obj)->name, flags);
471
* @param x to compare
472
* @param y to compare
473
* @return 1 if equal, 0 otherwise
475
int atom_equal(Sxpr x, Sxpr y){
479
ok = ATOMP(y) && string_equal(OBJ_ATOM(x)->name, OBJ_ATOM(y)->name);
481
ok = STRINGP(y) && string_equal(OBJ_ATOM(x)->name, y);
486
/** Get the name of an atom.
491
char * atom_name(Sxpr obj){
492
return string_string(OBJ_ATOM(obj)->name);
495
int atom_length(Sxpr obj){
496
return string_length(OBJ_ATOM(obj)->name);
499
/** Get the C string from a string sxpr.
501
* @param obj string sxpr
504
char * string_string(Sxpr obj){
505
return OBJ_STRING(obj)->data;
508
/** Get the length of a string.
513
int string_length(Sxpr obj){
514
return OBJ_STRING(obj)->len;
517
/** Create a new string. The input string is copied,
518
* and must be null-terminated.
520
* @param s characters to put in the string
523
Sxpr string_new(char *s){
524
int n = (s ? strlen(s) : 0);
525
return string_new_n(s, n);
528
/** Create a new string. The input string is copied,
529
* and need not be null-terminated.
531
* @param s characters to put in the string (may be null)
532
* @param n string length
535
Sxpr string_new_n(char *s, int n){
537
obj = halloc(sizeof(ObjString) + n + 1, T_STRING);
539
char *str = OBJ_STRING(obj)->data;
540
OBJ_STRING(obj)->len = n;
545
memset(str, 0, n + 1);
555
void string_free(Sxpr obj){
563
Sxpr string_copy(Sxpr obj){
564
return string_new_n(string_string(obj), string_length(obj));
567
/** Determine if a string needs escapes when printed
568
* using the given flags.
570
* @param str string to check
571
* @param n string length
572
* @param flags print flags
573
* @return 1 if needs escapes, 0 otherwise
575
int needs_escapes(char *str, int n, unsigned flags){
581
for(i=0, c=str; i<n; i++, c++){
582
if(in_alpha_class(*c)) continue;
583
if(in_decimal_digit_class(*c)) continue;
584
if(in_class(*c, "/._+:@~-")) continue;
597
c = (r >> 16) & 0xff;
598
if('a' <= c && c <= 'z') break;
603
int string_contains(char *s, int s_n, char *k, int k_n){
604
int i, n = s_n - k_n;
605
for(i=0; i < n; i++){
606
if(!memcmp(s+i, k, k_n)) return 1;
611
int string_delim(char *s, int s_n, char *d, int d_n){
613
if(d_n < 4) return -1;
618
for( ; i < d_n; i++){
619
if(!string_contains(s, s_n, d, i)){
627
/** Print the bytes in a string as-is.
632
* @return bytes written or error code
634
int _string_print_raw(IOStream *io, char *str, int n){
636
k = IOStream_write(io, str, n);
640
/** Print a string in counted data format.
645
* @return bytes written or error code
647
int _string_print_counted(IOStream *io, char *str, int n){
649
k += IOStream_print(io, "%c%c%d%c",
650
c_data_open, c_data_count, n, c_data_count);
651
k += IOStream_write(io, str, n);
655
/** Print a string in quoted data format.
660
* @return bytes written or error code
662
int _string_print_quoted(IOStream *io, char *str, int n){
666
d_n = string_delim(str, n, d, sizeof(d) - 1);
667
k += IOStream_print(io, "%c%c%s%c",
668
c_data_open, c_data_quote, d, c_data_quote);
669
k += IOStream_write(io, str, n);
670
k += IOStream_print(io, "%c%s%c", c_data_quote, d, c_data_quote);
674
/** Print a string as a quoted string.
679
* @return bytes written or error code
681
int _string_print_string(IOStream *io, char *str, int n){
684
k += IOStream_print(io, "\"");
687
for(s = str, t = str + n; s < t; s++){
688
if(*s < ' ' || *s >= 127 ){
690
case '\a': k += IOStream_print(io, "\\a"); break;
691
case '\b': k += IOStream_print(io, "\\b"); break;
692
case '\f': k += IOStream_print(io, "\\f"); break;
693
case '\n': k += IOStream_print(io, "\\n"); break;
694
case '\r': k += IOStream_print(io, "\\r"); break;
695
case '\t': k += IOStream_print(io, "\\t"); break;
696
case '\v': k += IOStream_print(io, "\\v"); break;
699
k += IOStream_print(io, "\\%o", *s);
702
} else if(*s == c_double_quote ||
703
*s == c_single_quote ||
705
k += IOStream_print(io, "\\%c", *s);
707
k+= IOStream_print(io, "%c", *s);
711
k += IOStream_print(io, "\"");
715
/** Print a string to a stream, with escapes if necessary.
717
* @param io stream to print to
719
* @param n string length
720
* @param flags print flags
721
* @return number of bytes written
723
int _string_print(IOStream *io, char *str, int n, unsigned flags){
725
if((flags & PRINT_COUNTED)){
726
k = _string_print_counted(io, str, n);
727
} else if((flags & PRINT_RAW) || !needs_escapes(str, n, flags)){
728
k = _string_print_raw(io, str, n);
730
k = _string_print_quoted(io, str, n);
732
k = _string_print_string(io, str, n);
737
/** Print a string to a stream, with escapes if necessary.
739
* @param io stream to print to
741
* @param flags print flags
742
* @return number of bytes written
744
int string_print(IOStream *io, Sxpr obj, unsigned flags){
745
return _string_print(io,
746
OBJ_STRING(obj)->data,
747
OBJ_STRING(obj)->len,
751
int string_eq(char *s, int s_n, char *t, int t_n){
752
return (s_n == t_n) && (memcmp(s, t, s_n) == 0);
755
/** Compare an sxpr with a string for equality.
757
* @param x string to compare with
758
* @param y sxpr to compare
759
* @return 1 if equal, 0 otherwise
761
int string_equal(Sxpr x, Sxpr y){
765
ok = has_type(y, T_STRING) &&
766
string_eq(OBJ_STRING(x)->data, OBJ_STRING(x)->len,
767
OBJ_STRING(y)->data, OBJ_STRING(y)->len);
769
ok = has_type(y, T_ATOM) &&
770
string_eq(OBJ_STRING(x)->data, OBJ_STRING(x)->len,
771
atom_name(y), atom_length(y));
776
/** Create a new cons cell.
777
* The cell is ONOMEM if either argument is.
779
* @param car sxpr for the car
780
* @param cdr sxpr for the cdr
783
Sxpr cons_new(Sxpr car, Sxpr cdr){
785
if(NOMEMP(car) || NOMEMP(cdr)){
788
obj = HALLOC(ObjCons, T_CONS);
790
ObjCons *z = OBJ_CONS(obj);
798
/** Push a new element onto a list.
800
* @param list list to add to
801
* @param elt element to add
802
* @return 0 if successful, error code otherwise
804
int cons_push(Sxpr *list, Sxpr elt){
806
l = cons_new(elt, *list);
807
if(NOMEMP(l)) return -ENOMEM;
812
/** Free a cons. Recursively frees the car and cdr.
816
void cons_free(Sxpr obj){
818
for(; CONSP(obj); obj = next){
828
/** Copy a cons. Recursively copies the car and cdr.
832
Sxpr cons_copy(Sxpr obj){
834
Sxpr l = ONULL, x = ONONE;
835
for(l = obj; CONSP(l); l = CDR(l)){
837
if(NOMEMP(x)) goto exit;
839
if(NOMEMP(x)) goto exit;
851
/** Free a cons and its cdr cells, but not the car sxprs.
852
* Does nothing if called on something that is not a cons.
856
void cons_free_cells(Sxpr obj){
858
for(; CONSP(obj); obj = next){
865
* Prints the cons in list format if the cdrs are conses.
866
* uses pair (dot) format if the last cdr is not a cons (or null).
868
* @param io stream to print to
869
* @param obj to print
870
* @param flags print flags
871
* @return number of bytes written
873
int cons_print(IOStream *io, Sxpr obj, unsigned flags){
876
k += IOStream_print(io, "(");
877
for( ; CONSP(obj) ; obj = CDR(obj)){
881
k += IOStream_print(io, " ");
883
k += objprint(io, CAR(obj), flags);
886
k += IOStream_print(io, " . ");
887
k += objprint(io, obj, flags);
889
k += IOStream_print(io, ")");
890
return (IOStream_error(io) ? -1 : k);
893
/** Compare a cons with another sxpr for equality.
894
* If y is a cons, compares the cars and cdrs recursively.
896
* @param x cons to compare
897
* @param y sxpr to compare
898
* @return 1 if equal, 0 otherwise
900
int cons_equal(Sxpr x, Sxpr y){
902
objequal(CAR(x), CAR(y)) &&
903
objequal(CDR(x), CDR(y));
906
/** Return the length of a cons list.
911
int cons_length(Sxpr obj){
913
for( ; CONSP(obj); obj = CDR(obj)){
919
/** Destructively reverse a cons list in-place.
920
* If the argument is not a cons it is returned unchanged.
922
* @param l to reverse
923
* @return reversed list
927
// Iterate down the cells in the list making the cdr of
928
// each cell point to the previous cell. The last cell
929
// is the head of the reversed list.
937
if(!CONSP(next)) break;
946
/** Print the null sxpr.
948
* @param io stream to print to
949
* @param obj to print
950
* @param flags print flags
951
* @return number of bytes written
953
static int null_print(IOStream *io, Sxpr obj, unsigned flags){
954
return IOStream_print(io, "()");
957
/** Print the `unspecified' sxpr none.
959
* @param io stream to print to
960
* @param obj to print
961
* @param flags print flags
962
* @return number of bytes written
964
static int none_print(IOStream *io, Sxpr obj, unsigned flags){
965
return IOStream_print(io, "<none>");
968
/** Print an integer.
970
* @param io stream to print to
971
* @param obj to print
972
* @param flags print flags
973
* @return number of bytes written
975
static int int_print(IOStream *io, Sxpr obj, unsigned flags){
976
return IOStream_print(io, "%d", OBJ_INT(obj));
981
* @param io stream to print to
982
* @param obj to print
983
* @param flags print flags
984
* @return number of bytes written
986
static int bool_print(IOStream *io, Sxpr obj, unsigned flags){
987
return IOStream_print(io, (OBJ_UINT(obj) ? k_true : k_false));
992
* @param io stream to print to
993
* @param obj to print
994
* @param flags print flags
995
* @return number of bytes written
997
static int err_print(IOStream *io, Sxpr obj, unsigned flags){
998
int err = OBJ_INT(obj);
999
if(err < 0) err = -err;
1000
return IOStream_print(io, "[error:%d:%s]", err, strerror(err));
1003
/** Print the 'nomem' sxpr.
1005
* @param io stream to print to
1006
* @param obj to print
1007
* @param flags print flags
1008
* @return number of bytes written
1010
static int nomem_print(IOStream *io, Sxpr obj, unsigned flags){
1011
return IOStream_print(io, "[ENOMEM]");
1014
int sxprp(Sxpr obj, Sxpr name){
1015
return CONSP(obj) && objequal(CAR(obj), name);
1018
/** Get the name of an element.
1020
* @param obj element
1023
Sxpr sxpr_name(Sxpr obj){
1027
} else if(STRINGP(obj) || ATOMP(obj)){
1033
int sxpr_is(Sxpr obj, char *s){
1034
if(ATOMP(obj)) return string_eq(atom_name(obj), atom_length(obj), s, strlen(s));
1035
if(STRINGP(obj)) return string_eq(string_string(obj), string_length(obj), s, strlen(s));
1039
int sxpr_elementp(Sxpr obj, Sxpr name){
1041
ok = CONSP(obj) && objequal(CAR(obj), name);
1045
/** Get the attributes of an sxpr.
1048
* @return attributes
1050
Sxpr sxpr_attributes(Sxpr obj){
1056
if(sxprp(obj, intern("@"))){
1064
Sxpr sxpr_attribute(Sxpr obj, Sxpr key, Sxpr def){
1066
val = assoc(sxpr_attributes(obj), key);
1067
if(CONSP(val) && CONSP(CDR(val))){
1075
/** Get the children of an sxpr.
1080
Sxpr sxpr_children(Sxpr obj){
1084
if(CONSP(val) && sxprp(CAR(val), intern("@"))){
1091
Sxpr sxpr_child(Sxpr obj, Sxpr name, Sxpr def){
1094
for(l = sxpr_children(obj); CONSP(l); l = CDR(l)){
1095
if(sxprp(CAR(l), name)){
1100
if(NONEP(val)) val = def;
1104
Sxpr sxpr_child0(Sxpr obj, Sxpr def){
1106
Sxpr l = sxpr_children(obj);
1115
Sxpr sxpr_childN(Sxpr obj, int n, Sxpr def){
1119
for (i = 0, l = sxpr_children(obj); CONSP(l); i++, l = CDR(l)){
1128
Sxpr sxpr_child_value(Sxpr obj, Sxpr name, Sxpr def){
1130
val = sxpr_child(obj, name, ONONE);
1134
val = sxpr_child0(val, def);
1139
/** Table of interned symbols. Indexed by symbol name. */
1140
static HashTable *symbols = NULL;
1142
/** Hash function for entries in the symbol table.
1144
* @param key to hash
1147
static Hashcode sym_hash_fn(void *key){
1148
return hash_string((char*)key);
1151
/** Key equality function for the symbol table.
1153
* @param x to compare
1154
* @param y to compare
1155
* @return 1 if equal, 0 otherwise
1157
static int sym_equal_fn(void *x, void *y){
1158
return !strcmp((char*)x, (char*)y);
1161
/** Entry free function for the symbol table.
1163
* @param table the entry is in
1164
* @param entry being freed
1166
static void sym_free_fn(HashTable *table, HTEntry *entry){
1168
objfree(((ObjAtom*)entry->value)->name);
1169
HTEntry_free(entry);
1173
/** Initialize the symbol table.
1175
* @return 0 on sucess, error code otherwise
1177
static int init_symbols(void){
1178
symbols = HashTable_new(100);
1180
symbols->key_hash_fn = sym_hash_fn;
1181
symbols->key_equal_fn = sym_equal_fn;
1182
symbols->entry_free_fn = sym_free_fn;
1188
/** Cleanup the symbol table. Frees the table and all its symbols.
1190
void cleanup_symbols(void){
1191
HashTable_free(symbols);
1195
/** Get the interned symbol with the given name.
1196
* No new symbol is created.
1198
* @return symbol or null
1200
Sxpr get_symbol(char *sym){
1203
if(init_symbols()) return ONOMEM;
1206
entry = HashTable_get_entry(symbols, sym);
1208
return OBJP(T_ATOM, entry->value);
1214
/** Get the interned symbol with the given name.
1215
* Creates a new symbol if necessary.
1219
Sxpr intern(char *sym){
1220
Sxpr symbol = get_symbol(sym);
1222
if(!symbols) return ONOMEM;
1223
symbol = atom_new(sym);
1224
if(!NOMEMP(symbol)){
1225
OBJ_ATOM(symbol)->interned = TRUE;
1226
HashTable_add(symbols, atom_name(symbol), get_ptr(symbol));