sxpr.c

来自「xen虚拟机源代码安装包」· C语言 代码 · 共 1,231 行 · 第 1/2 页

    }
    for( ; i < d_n; i++){
        if(!string_contains(s, s_n, d, i)){
            return i;
        }
        d[i] = randchar();
    }
    return -1;
}

/** Print the bytes in a string as-is.
 *
 * @param io stream
 * @param str string
 * @param n length
 * @return bytes written or error code
 */
int _string_print_raw(IOStream *io, char *str, int n){
    int k = 0;
    k = IOStream_write(io, str, n);
    return k;
}

/** Print a string in counted data format.
 *
 * @param io stream
 * @param str string
 * @param n length
 * @return bytes written or error code
 */
int _string_print_counted(IOStream *io, char *str, int n){
    int k = 0;
    k += IOStream_print(io, "%c%c%d%c",
                        c_data_open, c_data_count, n, c_data_count);
    k += IOStream_write(io, str, n);
    return k;
}
  
/** Print a string in quoted data format.
 *
 * @param io stream
 * @param str string
 * @param n length
 * @return bytes written or error code
 */
int _string_print_quoted(IOStream *io, char *str, int n){
    int k = 0;
    char d[10];
    int d_n;
    d_n = string_delim(str, n, d, sizeof(d) - 1);
    k += IOStream_print(io, "%c%c%s%c",
                        c_data_open, c_data_quote, d, c_data_quote);
    k += IOStream_write(io, str, n);
    k += IOStream_print(io, "%c%s%c", c_data_quote, d, c_data_quote);
    return k;
}

/** Print a string as a quoted string.
 *
 * @param io stream
 * @param str string
 * @param n length
 * @return bytes written or error code
 */
int _string_print_string(IOStream *io, char *str, int n){
    int k = 0;
    
    k += IOStream_print(io, "\"");
    if(str){
        char *s, *t;
        for(s = str, t = str + n; s < t; 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 str string
 * @param n string length
 * @param flags print flags
 * @return number of bytes written
 */
int _string_print(IOStream *io, char *str, int n, unsigned flags){
    int k = 0;
    if((flags & PRINT_COUNTED)){
        k = _string_print_counted(io, str, n);
    } else if((flags & PRINT_RAW) || !needs_escapes(str, n, flags)){
        k = _string_print_raw(io, str, n);
    } else if(n > 50){
        k = _string_print_quoted(io, str, n);
    } else {
        k = _string_print_string(io, str, n);
    }
    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)->data,
                         OBJ_STRING(obj)->len,
                         flags);
}

int string_eq(char *s, int s_n, char *t, int t_n){
    return (s_n == t_n) && (memcmp(s, t, s_n) == 0);
}

/** 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) &&
        string_eq(OBJ_STRING(x)->data, OBJ_STRING(x)->len,
                  OBJ_STRING(y)->data, OBJ_STRING(y)->len);
    if(ok) goto exit;
    ok = has_type(y, T_ATOM) &&
        string_eq(OBJ_STRING(x)->data, OBJ_STRING(x)->len,
                  atom_name(y), atom_length(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);
    }
}

/** Copy a cons. Recursively copies the car and cdr.
 *
 * @param obj to copy
 */
Sxpr cons_copy(Sxpr obj){
    Sxpr v = ONULL;
    Sxpr l = ONULL, x = ONONE;
    for(l = obj; CONSP(l); l = CDR(l)){
        x = objcopy(CAR(l));
        if(NOMEMP(x)) goto exit;
        x = cons_new(x, v);
        if(NOMEMP(x)) goto exit;
        v = x;
    }
    v = nrev(v);
  exit:
    if(NOMEMP(x)){
        objfree(v);
        v = ONOMEM;
    }
    return v;
}

/** 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));
}

/** Print an error.
 *
 * @param io stream to print to
 * @param obj to print
 * @param flags print flags
 * @return number of bytes written
 */
static int err_print(IOStream *io, Sxpr obj, unsigned flags){
    int err = OBJ_INT(obj);
    if(err < 0) err = -err;
    return IOStream_print(io, "[error:%d:%s]", err, strerror(err));
}

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

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 string_eq(atom_name(obj), atom_length(obj), s, strlen(s));
    if(STRINGP(obj)) return string_eq(string_string(obj), string_length(obj), s, strlen(s));
    return 0;
}

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

/** 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_childN(Sxpr obj, int n, Sxpr def){
    Sxpr val = def;
    Sxpr l;
    int i;
    for (i = 0, l = sxpr_children(obj); CONSP(l); i++, l = CDR(l)){
        if(i == n){
            val = CAR(l);
            break;
        }
    }
    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;
}