path: root/tools/lib/sxpr.c

/*
 *
 * This library is free software; you can redistribute it and/or modify
 * it under the terms of the GNU Lesser General Public License as
 * published by the Free Software Foundation; either version 2.1 of the
 * License, or  (at your option) any later version. This library is 
 * distributed in the  hope that it will be useful, but WITHOUT ANY
 * WARRANTY; without even the implied warranty of MERCHANTABILITY or
 * FITNESS FOR A PARTICULAR PURPOSE.
 * See the GNU Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public License
 * along with this library; if not, write to the Free Software Foundation,
 * Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
 */

#include <stdarg.h>
#include "sys_string.h"
#include "lexis.h"
#include "sys_net.h"
#include "hash_table.h"
#include "sxpr.h"

#include <errno.h>
#undef free

/** @file
 * General representation of sxprs.
 * Includes print, equal, and free functions for the sxpr types.
 *
 * Zero memory containing an Sxpr will have the value ONONE - this is intentional.
 * When a function returning an sxpr cannot allocate memory we return ONOMEM.
 *
 */

static int atom_print(IOStream *io, Sxpr obj, unsigned flags);
static int atom_equal(Sxpr x, Sxpr y);
static void atom_free(Sxpr obj);

static int string_print(IOStream *io, Sxpr obj, unsigned flags);
static int string_equal(Sxpr x, Sxpr y);
static void string_free(Sxpr obj);

static int cons_print(IOStream *io, Sxpr obj, unsigned flags);
static int cons_equal(Sxpr x, Sxpr y);
static void cons_free(Sxpr obj);

static int null_print(IOStream *io, Sxpr obj, unsigned flags);
static int none_print(IOStream *io, Sxpr obj, unsigned flags);
static int int_print(IOStream *io, Sxpr obj, unsigned flags);
static int bool_print(IOStream *io, Sxpr obj, unsigned flags);

/** Type definitions. */
static SxprType types[1024] = {
    [T_NONE]     { type:    T_NONE,     name: "none",       print: none_print      },
    [T_NULL]     { type:    T_NULL,     name: "null",       print: null_print      },
    [T_UINT]     { type:    T_UINT,     name: "int",        print: int_print,      },
    [T_BOOL]     { type:    T_BOOL,     name: "bool",       print: bool_print,     },
    [T_ATOM]     { type:    T_ATOM,     name: "atom",       print: atom_print,
		   pointer: TRUE,
		   free:    atom_free,
		   equal:   atom_equal,
		 },
    [T_STRING]   { type:    T_STRING,   name: "string",     print: string_print,
		   pointer: TRUE,
		   free:    string_free,
		   equal:   string_equal,
		 },
    [T_CONS]     { type:    T_CONS,     name: "cons",       print: cons_print,
		   pointer: TRUE,
		   free:    cons_free,
		   equal:   cons_equal,
		 },
};

/** Number of entries in the types array. */
static int type_sup = sizeof(types)/sizeof(types[0]);

/** Get the type definition for a given type code.
 *
 * @param ty type code
 * @return type definition or null
 */
SxprType *get_sxpr_type(int ty){
    if(0 <= ty && ty < type_sup){
        return types+ty;
    }
    return NULL;
}

/** The default print function.
 *
 * @param io stream to print to
 * @param x sxpr to print
 * @param flags print flags
 * @return number of bytes written on success
 */
int default_print(IOStream *io, Sxpr x, unsigned flags){
    return IOStream_print(io, "#<%u %lu>\n", get_type(x), get_ul(x));
}

/** The default equal function.
 * Uses eq().
 *
 * @param x sxpr to compare
 * @param y sxpr to compare
 * @return 1 if equal, 0 otherwise
 */
int default_equal(Sxpr x, Sxpr y){
    return eq(x, y);
}

/** General sxpr print function.
 * Prints an sxpr on a stream using the print function for the sxpr type.
 * Printing is controlled by flags from the PrintFlags enum.
 * If PRINT_TYPE is in the flags the sxpr type is printed before the sxpr
 * (for debugging).
 *
 * @param io stream to print to
 * @param x sxpr to print
 * @param flags print flags
 * @return number of bytes written
 */
int objprint(IOStream *io, Sxpr x, unsigned flags){
    SxprType *def = get_sxpr_type(get_type(x));
    ObjPrintFn *print_fn = (def && def->print ? def->print : default_print);
    int k = 0;
    if(!io) return k;
    if(flags & PRINT_TYPE){
	k += IOStream_print(io, "%s:", def->name);
    }
    k += print_fn(io, x, flags);
    return k;
}

/** General sxpr free function.
 * Frees an sxpr using the free function for its type.
 * Free functions must recursively free any subsxprs.
 * If no function is defined then the default is to
 * free sxprs whose type has pointer true.
 * Sxprs must not be used after freeing.
 *
 * @param x sxpr to free
 */
void objfree(Sxpr x){
    SxprType *def = get_sxpr_type(get_type(x));

    if(def){
	if(def->free){
	    def->free(x);
	} else if (def->pointer){
	    hfree(x);
	}
    }
}

/** General sxpr equality function.
 * Compares x and y using the equal function for x.
 * Uses default_equal() if x has no equal function.
 *
 * @param x sxpr to compare
 * @param y sxpr to compare
 * @return 1 if equal, 0 otherwise
 */
int objequal(Sxpr x, Sxpr y){
    SxprType *def = get_sxpr_type(get_type(x));
    ObjEqualFn *equal_fn = (def && def->equal ? def->equal : default_equal);
    return equal_fn(x, y);
}

/** Search for a key in an alist.
 * An alist is a list of conses, where the cars
 * of the conses are the keys. Compares keys using equality.
 *
 * @param k key
 * @param l alist to search
 * @return first element of l with car k, or ONULL
 */
Sxpr assoc(Sxpr k, Sxpr l){
    for( ; CONSP(l) ; l = CDR(l)){
        Sxpr x = CAR(l);
        if(CONSP(x) && objequal(k, CAR(x))){
            return x;   
        }
    }
    return ONULL;
}

/** Search for a key in an alist.
 * An alist is a list of conses, where the cars
 * of the conses are the keys. Compares keys using eq.
 *
 * @param k key
 * @param l alist to search
 * @return first element of l with car k, or ONULL
 */
Sxpr assocq(Sxpr k, Sxpr l){
    for( ; CONSP(l); l = CDR(l)){
        Sxpr x = CAR(l);
        if(CONSP(x) && eq(k, CAR(x))){
            return x;
        }
    }
    return ONULL;
}

/** Add a new key and value to an alist.
 *
 * @param k key
 * @param l value
 * @param l alist
 * @return l with the new cell added to the front
 */
Sxpr acons(Sxpr k, Sxpr v, Sxpr l){
    Sxpr x, y;
    x = cons_new(k, v);
    if(NOMEMP(x)) return x;
    y = cons_new(x, l);
    if(NOMEMP(y)) cons_free_cells(x);
    return y;
}

/** Test if a list contains an element.
 * Uses sxpr equality.
 *
 * @param l list
 * @param x element to look for
 * @return a tail of l with x as car, or ONULL
 */
Sxpr cons_member(Sxpr l, Sxpr x){
    for( ; CONSP(l) && !eq(x, CAR(l)); l = CDR(l)){}
    return l;
}

/** Test if a list contains an element satisfying a test.
 * The test function is called with v and an element of the list.
 *
 * @param l list
 * @param test_fn test function to use
 * @param v value for first argument to the test
 * @return a tail of l with car satisfying the test, or 0
 */
Sxpr cons_member_if(Sxpr l, ObjEqualFn *test_fn, Sxpr v){
    for( ; CONSP(l) && !test_fn(v, CAR(l)); l = CDR(l)){ }
    return l;
}

/** Test if the elements of list 't' are a subset of the elements
 * of list 's'. Element order is not significant.
 *
 * @param s element list to check subset of
 * @param t element list to check if is a subset
 * @return 1 if is a subset, 0 otherwise
 */
int cons_subset(Sxpr s, Sxpr t){
    for( ; CONSP(t); t = CDR(t)){
	if(!CONSP(cons_member(s, CAR(t)))){
	    return 0;
	}
    }
    return 1;
}

/** Test if two lists have equal sets of elements.
 * Element order is not significant.
 *
 * @param s list to check
 * @param t list to check
 * @return 1 if equal, 0 otherwise
 */
int cons_set_equal(Sxpr s, Sxpr t){
    return cons_subset(s, t) && cons_subset(t, s);
}

#ifdef USE_GC
/*============================================================================*/
/* The functions inside this ifdef are only safe if GC is used.
 * Otherwise they may leak memory.
 */

/** Remove an element from a list (GC only).
 * Uses sxpr equality and removes all instances, even
 * if there are more than one.
 *
 * @param l list to remove elements from
 * @param x element to remove
 * @return modified input list
 */
Sxpr cons_remove(Sxpr l, Sxpr x){
    return cons_remove_if(l, eq, x);
}

/** Remove elements satisfying a test (GC only).
 * The test function is called with v and an element of the set.
 *
 * @param l list to remove elements from
 * @param test_fn function to use to decide if an element should be removed
 * @return modified input list
 */
Sxpr cons_remove_if(Sxpr l, ObjEqualFn *test_fn, Sxpr v){
    Sxpr prev = ONULL, elt, next;

    for(elt = l; CONSP(elt); elt = next){
        next = CDR(elt);
        if(test_fn(v, CAR(elt))){
            if(NULLP(prev)){
                l = next;
            } else {
                CDR(prev) = next;
            }
        }
    }
    return l;
}

/** Set the value for a key in an alist (GC only).
 * If the key is present, changes the value, otherwise
 * adds a new cell.
 *
 * @param k key
 * @param v value
 * @param l alist
 * @return modified or extended list
 */
Sxpr setf(Sxpr k, Sxpr v, Sxpr l){
    Sxpr e = assoc(k, l);
    if(NULLP(e)){
        l = acons(k, v, l);
    } else {
        CAR(CDR(e)) = v;
    }
    return l;
}
/*============================================================================*/
#endif /* USE_GC */

/** Create a new atom with the given name.
 *
 * @param name the name
 * @return new atom
 */
Sxpr atom_new(char *name){
    Sxpr n, obj = ONOMEM;

    n = string_new(name);
    if(NOMEMP(n)) goto exit;
    obj = HALLOC(ObjAtom, T_ATOM);
    if(NOMEMP(obj)) goto exit;
    OBJ_ATOM(obj)->name = n;
  exit:
    return obj;
}

/** Free an atom.
 *
 * @param obj to free
 */
void atom_free(Sxpr obj){
    // Interned atoms are shared, so do not free.
    if(OBJ_ATOM(obj)->interned) return;
    objfree(OBJ_ATOM(obj)->name);
    hfree(obj);
}

/** Print an atom. Prints the atom name.
 *
 * @param io stream to print to
 * @param obj to print
 * @param flags print flags
 * @return number of bytes printed
 */
int atom_print(IOStream *io, Sxpr obj, unsigned flags){
    //return string_print(io, OBJ_ATOM(obj)->name, (flags | PRINT_RAW));
    return string_print(io, OBJ_ATOM(obj)->name, flags);
}

/** Atom equality.
 *
 * @param x to compare
 * @param y to compare
 * @return 1 if equal, 0 otherwise
 */
int atom_equal(Sxpr x, Sxpr y){
    int ok;
    ok = eq(x, y);
    if(ok) goto exit;
    ok = ATOMP(y) && string_equal(OBJ_ATOM(x)->name, OBJ_ATOM(y)->name);
    if(ok) goto exit;
    ok = STRINGP(y) && string_equal(OBJ_ATOM(x)->name, y);
  exit:
    return ok;
}

/** Get the name of an atom.
 *
 * @param obj atom
 * @return name
 */
char * atom_name(Sxpr obj){
    return string_string(OBJ_ATOM(obj)->name);
}

/** Get the C string from a string sxpr.
 *
 * @param obj string sxpr
 * @return string
 */
char * string_string(Sxpr obj){
    return OBJ_STRING(obj);
}

/** Get the length of a string.
 *
 * @param obj string
 * @return length
 */
int string_length(Sxpr obj){
    return strlen(OBJ_STRING(obj));
}

/** Create a new string. The input string is copied,
 * and must be null-terminated.
 *
 * @param s characters to put in the string
 * @return new sxpr
 */
Sxpr string_new(char *s){
    int n = (s ? strlen(s) : 0);
    Sxpr obj;
    obj = halloc(n+1, T_STRING);
    if(!NOMEMP(obj)){
        char *str = OBJ_STRING(obj);
        strncpy(str, s, n);
        str[n] = '\0';
    }
    return obj;
}

/** Free a string.
 *
 * @param obj to free
 */
void string_free(Sxpr obj){
    hfree(obj);
}

/** Determine if a string needs escapes when printed
 * using the given flags.
 *
 * @param str string to check
 * @param flags print flags
 * @return 1 if needs escapes, 0 otherwise
 */
int needs_escapes(char *str, unsigned flags){
    char *c;
    int val = 0;

    if(str){
	for(c=str; *c; c++){
	    if(in_alpha_class(*c)) continue;
	    if(in_decimal_digit_class(*c)) continue;
	    if(in_class(*c, "/._+:@~-")) continue;
	    val = 1;
	    break;
	}
    }
    //printf("\n> val=%d str=|%s|\n", val, str);
    return val;
}

/** Print a string to a stream, with escapes if necessary.
 *
 * @param io stream to print to
 * @param str string
 * @param flags print flags
 * @return number of bytes written
 */
int _string_print(IOStream *io, char *str, unsigned flags){
    int k = 0;
    if((flags & PRINT_RAW) || !needs_escapes(str, flags)){
        k += IOStream_print(io, str);
    } else {
	k += IOStream_print(io, "\"");
	if(str){
            char *s;
            for(s = str; *s; s++){
                if(*s < ' ' || *s >= 127 ){
                    switch(*s){
                    case '\a': k += IOStream_print(io, "\\a");  break;
                    case '\b': k += IOStream_print(io, "\\b");  break;
                    case '\f': k += IOStream_print(io, "\\f");  break;
                    case '\n': k += IOStream_print(io, "\\n");  break;
                    case '\r': k += IOStream_print(io, "\\r");  break;
                    case '\t': k += IOStream_print(io, "\\t");  break;
                    case '\v': k += IOStream_print(io, "\\v");  break;
                    default:
                        // Octal escape;
                        k += IOStream_print(io, "\\%o", *s);
                        break;
                    }
                } else if(*s == c_double_quote ||
                          *s == c_single_quote ||
                          *s == c_escape){
                    k += IOStream_print(io, "\\%c", *s);
                } else {
                    k+= IOStream_print(io, "%c", *s);
                }
            }
	}
	k += IOStream_print(io, "\"");
    }
    return k;
}

/** Print a string to a stream, with escapes if necessary.
 *
 * @param io stream to print to
 * @param obj string
 * @param flags print flags
 * @return number of bytes written
 */
int string_print(IOStream *io, Sxpr obj, unsigned flags){
    return _string_print(io, OBJ_STRING(obj), flags);
}

/** Compare an sxpr with a string for equality.
 *
 * @param x string to compare with
 * @param y sxpr to compare
 * @return 1 if equal, 0 otherwise
 */
int string_equal(Sxpr x, Sxpr y){
    int ok = 0;
    ok = eq(x,y);
    if(ok) goto exit;
    ok = has_type(y, T_STRING) && !strcmp(OBJ_STRING(x), OBJ_STRING(y));
    if(ok) goto exit;
    ok = has_type(y, T_ATOM) && !strcmp(OBJ_STRING(x), atom_name(y));
  exit:
    return ok;
}

/** Create a new cons cell.
 * The cell is ONOMEM if either argument is.
 *
 * @param car sxpr for the car
 * @param cdr sxpr for the cdr
 * @return new cons
 */
Sxpr cons_new(Sxpr car, Sxpr cdr){
    Sxpr obj;
    if(NOMEMP(car) || NOMEMP(cdr)){
        obj = ONOMEM;
    } else {
        obj = HALLOC(ObjCons, T_CONS);
        if(!NOMEMP(obj)){
            ObjCons *z = OBJ_CONS(obj);
            z->car = car;
            z->cdr = cdr;
        }
    }
    return obj;
}

/** Push a new element onto a list.
 *
 * @param list list to add to
 * @param elt element to add
 * @return 0 if successful, error code otherwise
 */
int cons_push(Sxpr *list, Sxpr elt){
    Sxpr l;
    l = cons_new(elt, *list);
    if(NOMEMP(l)) return -ENOMEM;
    *list = l;
    return 0;
}

/** Free a cons. Recursively frees the car and cdr.
 *
 * @param obj to free
 */
void cons_free(Sxpr obj){
    Sxpr next;
    for(; CONSP(obj); obj = next){
	next = CDR(obj);
	objfree(CAR(obj));
	hfree(obj);
    }
    if(!NULLP(obj)){
	objfree(obj);
    }
}

/** Free a cons and its cdr cells, but not the car sxprs.
 * Does nothing if called on something that is not a cons.
 *
 * @param obj to free
 */
void cons_free_cells(Sxpr obj){
    Sxpr next;
    for(; CONSP(obj); obj = next){
	next = CDR(obj);
	hfree(obj);
    }
}

/** Print a cons.
 * Prints the cons in list format if the cdrs are conses.
 * uses pair (dot) format if the last cdr is not a cons (or null).
 *
 * @param io stream to print to
 * @param obj to print
 * @param flags print flags
 * @return number of bytes written
 */
int cons_print(IOStream *io, Sxpr obj, unsigned flags){
    int first = 1;
    int k = 0;
    k += IOStream_print(io, "(");
    for( ; CONSP(obj) ; obj = CDR(obj)){
        if(first){ 
            first = 0;
        } else {
            k += IOStream_print(io, " ");
        }
        k += objprint(io, CAR(obj), flags);
    }
    if(!NULLP(obj)){
        k += IOStream_print(io, " . ");
        k += objprint(io, obj, flags);
    }
    k += IOStream_print(io, ")");
    return (IOStream_error(io) ? -1 : k);
}

/** Compare a cons with another sxpr for equality.
 * If y is a cons, compares the cars and cdrs recursively.
 *
 * @param x cons to compare
 * @param y sxpr to compare
 * @return 1 if equal, 0 otherwise
 */
int cons_equal(Sxpr x, Sxpr y){
    return CONSP(y) &&
        objequal(CAR(x), CAR(y)) &&
        objequal(CDR(x), CDR(y));
}

/** Return the length of a cons list.
 *
 * @param obj list
 * @return length
 */
int cons_length(Sxpr obj){
    int count = 0;
    for( ; CONSP(obj); obj = CDR(obj)){
        count++;
    }
    return count;
}

/** Destructively reverse a cons list in-place.
 * If the argument is not a cons it is returned unchanged.
 * 
 * @param l to reverse
 * @return reversed list
 */
Sxpr nrev(Sxpr l){
    if(CONSP(l)){
	// Iterate down the cells in the list making the cdr of
	// each cell point to the previous cell. The last cell 
	// is the head of the reversed list.
	Sxpr prev = ONULL;
	Sxpr cell = l;
	Sxpr next;

	while(1){
	    next = CDR(cell);
	    CDR(cell) = prev;
	    if(!CONSP(next)) break;
	    prev = cell;
	    cell = next;
	}
	l = cell;
    }
    return l;
}

/** Print the null sxpr.	
 *
 * @param io stream to print to
 * @param obj to print
 * @param flags print flags
 * @return number of bytes written
 */
static int null_print(IOStream *io, Sxpr obj, unsigned flags){
    return IOStream_print(io, "()");
}

/** Print the `unspecified' sxpr none.
 *
 * @param io stream to print to
 * @param obj to print
 * @param flags print flags
 * @return number of bytes written
 */
static int none_print(IOStream *io, Sxpr obj, unsigned flags){
    return IOStream_print(io, "<none>");
}

/** Print an integer.
 *
 * @param io stream to print to
 * @param obj to print
 * @param flags print flags
 * @return number of bytes written
 */
static int int_print(IOStream *io, Sxpr obj, unsigned flags){
    return IOStream_print(io, "%d", OBJ_INT(obj));
}

/** Print a boolean.
 *
 * @param io stream to print to
 * @param obj to print
 * @param flags print flags
 * @return number of bytes written
 */
static int bool_print(IOStream *io, Sxpr obj, unsigned flags){
    return IOStream_print(io, (OBJ_UINT(obj) ? k_true : k_false));
}

int sxprp(Sxpr obj, Sxpr name){
    return CONSP(obj) && objequal(CAR(obj), name);
}

/** Get the name of an element.
 * 
 * @param obj element
 * @return name
 */
Sxpr sxpr_name(Sxpr obj){
    Sxpr val = ONONE;
    if(CONSP(obj)){
        val = CAR(obj);
    } else if(STRINGP(obj) || ATOMP(obj)){
        val = obj;
    }
    return val;
}

int sxpr_is(Sxpr obj, char *s){
    if(ATOMP(obj)) return !strcmp(atom_name(obj), s);
    if(STRINGP(obj)) return !strcmp(string_string(obj), s);
    return 0;
}

int sxpr_elementp(Sxpr obj, Sxpr name){
    return CONSP(obj) && objequal(CAR(obj), name);
}

/** Get the attributes of an sxpr.
 * 
 * @param obj sxpr
 * @return attributes
 */
Sxpr sxpr_attributes(Sxpr obj){
    Sxpr val = ONULL;
    if(CONSP(obj)){
        obj = CDR(obj);
        if(CONSP(obj)){
            obj = CAR(obj);
            if(sxprp(obj, intern("@"))){
                val = CDR(obj);
            }
        }
    }
    return val;
}

Sxpr sxpr_attribute(Sxpr obj, Sxpr key, Sxpr def){
    Sxpr val = ONONE;
    val = assoc(sxpr_attributes(obj), key);
    if(CONSP(val) && CONSP(CDR(val))){
        val = CADR(def);
    } else {
        val = def;
    }
    return val;
}

/** Get the children of an sxpr.
 * 
 * @param obj sxpr
 * @return children
 */
Sxpr sxpr_children(Sxpr obj){
    Sxpr val = ONULL;
    if(CONSP(obj)){
        val = CDR(obj);
        if(CONSP(val) && sxprp(CAR(val), intern("@"))){
            val = CDR(val);
        }
    }
    return val;
}

Sxpr sxpr_child(Sxpr obj, Sxpr name, Sxpr def){
    Sxpr val = ONONE;
    Sxpr l;
    for(l = sxpr_children(obj); CONSP(l); l = CDR(l)){
        if(sxprp(CAR(l), name)){
            val = CAR(l);
            break;
        }
    }
    if(NONEP(val)) val = def;
    return val;
}

Sxpr sxpr_child0(Sxpr obj, Sxpr def){
    Sxpr val = ONONE;
    Sxpr l = sxpr_children(obj);
    if(CONSP(l)){
        val = CAR(l);
    } else {
        val = def;
    }
    return val;
}

Sxpr sxpr_child_value(Sxpr obj, Sxpr name, Sxpr def){
    Sxpr val = ONONE;
    val = sxpr_child(obj, name, ONONE);
    if(NONEP(val)){
        val = def;
    } else {
        val = sxpr_child0(val, def);
    }
    return val;
}

/** Table of interned symbols. Indexed by symbol name. */
static HashTable *symbols = NULL;

/** Hash function for entries in the symbol table.
 *
 * @param key to hash
 * @return hashcode
 */
static Hashcode sym_hash_fn(void *key){
    return hash_string((char*)key);
}

/** Key equality function for the symbol table.
 *
 * @param x to compare
 * @param y to compare
 * @return 1 if equal, 0 otherwise
 */
static int sym_equal_fn(void *x, void *y){
    return !strcmp((char*)x, (char*)y);
}

/** Entry free function for the symbol table.
 *
 * @param table the entry is in
 * @param entry being freed
 */
static void sym_free_fn(HashTable *table, HTEntry *entry){
    if(entry){
	objfree(((ObjAtom*)entry->value)->name);
	HTEntry_free(entry);
    }
}
	
/** Initialize the symbol table.
 *
 * @return 0 on sucess, error code otherwise
 */
static int init_symbols(void){
    symbols = HashTable_new(100);
    if(symbols){
        symbols->key_hash_fn = sym_hash_fn;
        symbols->key_equal_fn = sym_equal_fn;
	symbols->entry_free_fn = sym_free_fn;
        return 0;
    }
    return -1;
}

/** Cleanup the symbol table. Frees the table and all its symbols.
 */
void cleanup_symbols(void){
    HashTable_free(symbols);
    symbols = NULL;
}

/** Get the interned symbol with the given name.
 * No new symbol is created.
 *
 * @return symbol or null
 */
Sxpr get_symbol(char *sym){
    HTEntry *entry;
    if(!symbols){
	if(init_symbols()) return ONOMEM;
	return ONULL;
    }
    entry = HashTable_get_entry(symbols, sym);
    if(entry){
        return OBJP(T_ATOM, entry->value);
    } else {
        return ONULL;
    }
}

/** Get the interned symbol with the given name.
 * Creates a new symbol if necessary.
 *
 * @return symbol
 */
Sxpr intern(char *sym){
    Sxpr symbol = get_symbol(sym);
    if(NULLP(symbol)){
	if(!symbols) return ONOMEM;
        symbol = atom_new(sym);
        if(!NOMEMP(symbol)){
	    OBJ_ATOM(symbol)->interned = TRUE;
            HashTable_add(symbols, atom_name(symbol), get_ptr(symbol));
        }
    }
    return symbol;
}