diff options
-rw-r--r-- | ChangeLog | 16 | ||||
-rw-r--r-- | gc.c | 58 | ||||
-rw-r--r-- | gc.h | 16 | ||||
-rw-r--r-- | hash.c | 92 | ||||
-rw-r--r-- | hash.h | 10 | ||||
-rw-r--r-- | lib.c | 496 | ||||
-rw-r--r-- | lib.h | 386 | ||||
-rw-r--r-- | match.c | 456 | ||||
-rw-r--r-- | match.h | 2 | ||||
-rw-r--r-- | parser.h | 8 | ||||
-rw-r--r-- | parser.l | 8 | ||||
-rw-r--r-- | parser.y | 44 | ||||
-rw-r--r-- | regex.c | 44 | ||||
-rw-r--r-- | regex.h | 13 | ||||
-rw-r--r-- | stream.c | 172 | ||||
-rw-r--r-- | stream.h | 34 | ||||
-rw-r--r-- | txr.c | 48 | ||||
-rw-r--r-- | unwind.c | 46 | ||||
-rw-r--r-- | unwind.h | 34 |
19 files changed, 991 insertions, 992 deletions
@@ -1,3 +1,19 @@ +2009-11-20 Kaz Kylheku <kkylheku@gmail.com> + + Changing ``obj_t *'' occurences to a ``val'' typedef. (Ideally, + we wouldn't have to declare object variables at all, so why + use an obtuse syntax to do so?) + + * lib.h (val): New typedef name. Used throughout. + + * gc.c, gc.h, hash.c, hash.h, lib.c, match.c, match.h, parser.h, + parser.l, parser.y, regex.c, regex.h stream.c,, stream.h, txr.c, + unwind.c, unwind.h: Replace obj_t * with val almost everywhere. + Low-level gc functinos that work with arrays of obj_t use + obj_t *. Seeing pointer arithmetic on a val doesn't make sense. + In macros we use obj_t *, to reduce the chances of clashing + with some local variable called val. + 2009-11-19 Kaz Kylheku <kkylheku@gmail.com> * txr.1: Fixed mangled formatting of exception handling example. @@ -48,54 +48,54 @@ typedef struct heap { } heap_t; int opt_gc_debug; -static obj_t **gc_stack_bottom; +static val *gc_stack_bottom; -static obj_t **prot_stack[PROT_STACK_SIZE]; -static obj_t ***prot_stack_limit = prot_stack + PROT_STACK_SIZE; -static obj_t ***top = prot_stack; +static val *prot_stack[PROT_STACK_SIZE]; +static val **prot_stack_limit = prot_stack + PROT_STACK_SIZE; +static val **top = prot_stack; -static obj_t *free_list, **free_tail = &free_list; +static val free_list, *free_tail = &free_list; static heap_t *heap_list; int gc_enabled = 1; -obj_t *prot1(obj_t **loc) +val prot1(val *loc) { assert (top < prot_stack_limit); *top++ = loc; return nil; /* for use in macros */ } -void rel1(obj_t **loc) +void rel1(val *loc) { /* protect and release calls must nest. */ if (*--top != loc) abort(); } -void protect(obj_t **first, ...) +void protect(val *first, ...) { - obj_t **next = first; + val *next = first; va_list vl; va_start (vl, first); while (next) { prot1(next); - next = va_arg(vl, obj_t **); + next = va_arg(vl, val *); } va_end (vl); } -void release(obj_t **last, ...) +void release(val *last, ...) { - obj_t **next = last; + val *next = last; va_list vl; va_start (vl, last); while (next) { rel1(next); - next = va_arg(vl, obj_t **); + next = va_arg(vl, val *); } va_end (vl); @@ -120,7 +120,7 @@ static void more() heap_list = heap; } -obj_t *make_obj(void) +val make_obj(void) { int try; @@ -129,7 +129,7 @@ obj_t *make_obj(void) for (try = 0; try < 3; try++) { if (free_list) { - obj_t *ret = free_list; + val ret = free_list; free_list = free_list->t.next; return ret; } @@ -145,7 +145,7 @@ obj_t *make_obj(void) return 0; } -static void finalize(obj_t *obj) +static void finalize(val obj) { switch (obj->t.type) { case CONS: @@ -180,7 +180,7 @@ static void finalize(obj_t *obj) assert (0 && "corrupt type field"); } -static void mark_obj(obj_t *obj) +static void mark_obj(val obj) { type_t t; @@ -224,8 +224,8 @@ tail_call: return; case VEC: { - obj_t *alloc_size = obj->v.vec[-2]; - obj_t *fill_ptr = obj->v.vec[-1]; + val alloc_size = obj->v.vec[-2]; + val fill_ptr = obj->v.vec[-1]; long i, fp = c_num(fill_ptr); mark_obj(alloc_size); @@ -252,7 +252,7 @@ tail_call: assert (0 && "corrupt type field"); } -static int in_heap(obj_t *ptr) +static int in_heap(val ptr) { heap_t *heap; @@ -265,16 +265,16 @@ static int in_heap(obj_t *ptr) return 0; } -static void mark_mem_region(obj_t **low, obj_t **high) +static void mark_mem_region(val *low, val *high) { if (low > high) { - obj_t **tmp = high; + val *tmp = high; high = low; low = tmp; } while (low < high) { - obj_t *maybe_obj = *low; + val maybe_obj = *low; if (in_heap(maybe_obj)) { type_t t = maybe_obj->t.type; if ((t & FREE) == 0) @@ -286,8 +286,8 @@ static void mark_mem_region(obj_t **low, obj_t **high) static void mark(void) { - obj_t *gc_stack_top; - obj_t ***rootloc; + val gc_stack_top; + val **rootloc; /* * First, scan the officially registered locations. @@ -369,17 +369,17 @@ int gc_state(int enabled) return old; } -void gc_init(obj_t **stack_bottom) +void gc_init(val *stack_bottom) { gc_stack_bottom = stack_bottom; } -void gc_mark(obj_t *obj) +void gc_mark(val obj) { mark_obj(obj); } -int gc_is_reachable(obj_t *obj) +int gc_is_reachable(val obj) { type_t t; @@ -399,7 +399,7 @@ void unmark(void) heap_t *heap; for (heap = heap_list; heap != 0; heap = heap->next) { - obj_t *block, *end; + val block, end; for (block = heap->block, end = heap->block + HEAP_SIZE; block < end; block++) @@ -23,13 +23,13 @@ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. */ -void gc_init(obj_t **stack_bottom); -obj_t *prot1(obj_t **loc); -void rel1(obj_t **loc); -void protect(obj_t **, ...); -void release(obj_t **, ...); -obj_t *make_obj(void); +void gc_init(val *stack_bottom); +val prot1(val *loc); +void rel1(val *loc); +void protect(val *, ...); +void release(val *, ...); +val make_obj(void); void gc(void); int gc_state(int); -void gc_mark(obj_t *); -int gc_is_reachable(obj_t *); +void gc_mark(val); +int gc_is_reachable(val); @@ -47,7 +47,7 @@ typedef enum hash_flags { struct hash { hash_flags_t flags; struct hash *next; - obj_t *table; + val table; long modulus; long count; }; @@ -76,7 +76,7 @@ static long hash_c_str(const wchar_t *str) return h; } -static long ll_hash(obj_t *obj) +static long ll_hash(val obj) { if (obj == nil) return NUM_MAX; @@ -98,7 +98,7 @@ static long ll_hash(obj_t *obj) return ((long) obj->f.f.interp_fun + ll_hash(obj->f.env)) & NUM_MAX; case VEC: { - obj_t *fill = obj->v.vec[vec_fill]; + val fill = obj->v.vec[vec_fill]; long i, h = ll_hash(obj->v.vec[vec_fill]); long len = c_num(fill); @@ -121,22 +121,22 @@ static long ll_hash(obj_t *obj) internal_error("unhandled case in equal function"); } -obj_t *hash_obj(obj_t *obj) +val hash_obj(val obj) { return num(ll_hash(obj)); } -obj_t *hash_equal(obj_t *self, obj_t *other) +val hash_equal(val self, val other) { return self == other ? t : nil; } -void hash_destroy(obj_t *hash) +void hash_destroy(val hash) { free(hash->co.handle); } -void hash_mark(obj_t *hash) +void hash_mark(val hash) { struct hash *h = (struct hash *) hash->co.handle; long i; @@ -150,12 +150,12 @@ void hash_mark(obj_t *hash) case hash_weak_keys: /* Keys are weak: mark the values only. */ for (i = 0; i < h->modulus; i++) { - obj_t *ind = num(i); - obj_t **pchain = vecref_l(h->table, ind); - obj_t *iter; + val ind = num(i); + val *pchain = vecref_l(h->table, ind); + val iter; for (iter = *pchain; iter != nil; iter = cdr(iter)) { - obj_t *entry = car(iter); + val entry = car(iter); gc_mark(cdr(entry)); } } @@ -166,12 +166,12 @@ void hash_mark(obj_t *hash) /* Values are weak: mark the keys only. */ for (i = 0; i < h->modulus; i++) { - obj_t *ind = num(i); - obj_t **pchain = vecref_l(h->table, ind); - obj_t *iter; + val ind = num(i); + val *pchain = vecref_l(h->table, ind); + val iter; for (iter = *pchain; iter != nil; iter = cdr(iter)) { - obj_t *entry = car(iter); + val entry = car(iter); gc_mark(car(entry)); } } @@ -196,20 +196,20 @@ void hash_grow(struct hash *h) { long i; long new_modulus = 2 * h->modulus; - obj_t *new_table = vector(num(new_modulus)); + val new_table = vector(num(new_modulus)); bug_unless (new_modulus > h->modulus); vec_set_fill(new_table, num(new_modulus)); for (i = 0; i < h->modulus; i++) { - obj_t *conses = *vecref_l(h->table, num(i)); + val conses = *vecref_l(h->table, num(i)); while (conses) { - obj_t *entry = car(conses); - obj_t *next = cdr(conses); - obj_t *key = car(entry); - obj_t **pchain = vecref_l(new_table, + val entry = car(conses); + val next = cdr(conses); + val key = car(entry); + val *pchain = vecref_l(new_table, num(ll_hash(key) % new_modulus)); *cdr_l(conses) = *pchain; *pchain = conses; @@ -221,13 +221,13 @@ void hash_grow(struct hash *h) h->table = new_table; } -obj_t *make_hash(obj_t *weak_keys, obj_t *weak_vals) +val make_hash(val weak_keys, val weak_vals) { int flags = ((weak_vals != nil) << 1) | (weak_keys != nil); struct hash *h = (struct hash *) chk_malloc(sizeof *h); - obj_t *mod = num(256); - obj_t *table = vector(mod); - obj_t *hash = cobj((void *) h, hash_t, &hash_ops); + val mod = num(256); + val table = vector(mod); + val hash = cobj((void *) h, hash_t, &hash_ops); vec_set_fill(table, mod); @@ -238,29 +238,29 @@ obj_t *make_hash(obj_t *weak_keys, obj_t *weak_vals) return hash; } -obj_t **gethash_l(obj_t *hash, obj_t *key) +val *gethash_l(val hash, val key) { struct hash *h = (struct hash *) hash->co.handle; - obj_t **pchain = vecref_l(h->table, num(ll_hash(key) % h->modulus)); - obj_t *old = *pchain; - obj_t **place = acons_new_l(pchain, key); + val *pchain = vecref_l(h->table, num(ll_hash(key) % h->modulus)); + val old = *pchain; + val *place = acons_new_l(pchain, key); if (old != *pchain && ++h->count > 2 * h->modulus) hash_grow(h); return place; } -obj_t *gethash(obj_t *hash, obj_t *key) +val gethash(val hash, val key) { struct hash *h = (struct hash *) hash->co.handle; - obj_t *chain = *vecref_l(h->table, num(ll_hash(key) % h->modulus)); - obj_t *found = assoc(chain, key); + val chain = *vecref_l(h->table, num(ll_hash(key) % h->modulus)); + val found = assoc(chain, key); return cdr(found); } -obj_t *remhash(obj_t *hash, obj_t *key) +val remhash(val hash, val key) { struct hash *h = (struct hash *) hash->co.handle; - obj_t **pchain = vecref_l(h->table, num(ll_hash(key) % h->modulus)); + val *pchain = vecref_l(h->table, num(ll_hash(key) % h->modulus)); *pchain = alist_remove1(*pchain, key); h->count--; bug_unless (h->count >= 0); @@ -286,12 +286,12 @@ void hash_process_weak(void) /* Sweep through all entries. Delete any which have keys that are garbage. */ for (i = 0; i < h->modulus; i++) { - obj_t *ind = num(i); - obj_t **pchain = vecref_l(h->table, ind); - obj_t **iter; + val ind = num(i); + val *pchain = vecref_l(h->table, ind); + val *iter; for (iter = pchain; *iter != nil; ) { - obj_t *entry = car(*iter); + val entry = car(*iter); if (!gc_is_reachable(car(entry))) *iter = cdr(*iter); else @@ -305,12 +305,12 @@ void hash_process_weak(void) /* Sweep through all entries. Delete any which have values that are garbage. */ for (i = 0; i < h->modulus; i++) { - obj_t *ind = num(i); - obj_t **pchain = vecref_l(h->table, ind); - obj_t **iter; + val ind = num(i); + val *pchain = vecref_l(h->table, ind); + val *iter; for (iter = pchain; *iter != nil; ) { - obj_t *entry = car(*iter); + val entry = car(*iter); if (!gc_is_reachable(cdr(entry))) *iter = cdr(*iter); else @@ -324,12 +324,12 @@ void hash_process_weak(void) /* Sweep through all entries. Delete any which have keys or values that are garbage. */ for (i = 0; i < h->modulus; i++) { - obj_t *ind = num(i); - obj_t **pchain = vecref_l(h->table, ind); - obj_t **iter; + val ind = num(i); + val *pchain = vecref_l(h->table, ind); + val *iter; for (iter = pchain; *iter != nil; ) { - obj_t *entry = car(*iter); + val entry = car(*iter); if (!gc_is_reachable(car(entry)) || !gc_is_reachable(cdr(entry))) *iter = cdr(*iter); else @@ -24,11 +24,11 @@ * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. */ -obj_t *hash_obj(obj_t *); -obj_t *make_hash(obj_t *weak_keys, obj_t *weak_vals); -obj_t **gethash_l(obj_t *hash, obj_t *key); -obj_t *gethash(obj_t *hash, obj_t *key); -obj_t *remhash(obj_t *hash, obj_t *key); +val hash_obj(val); +val make_hash(val weak_keys, val weak_vals); +val *gethash_l(val hash, val key); +val gethash(val hash, val key); +val remhash(val hash, val key); void hash_process_weak(void); void hash_init(void); @@ -43,47 +43,47 @@ #define max(a, b) ((a) > (b) ? (a) : (b)) #define min(a, b) ((a) < (b) ? (a) : (b)) -obj_t *interned_syms; - -obj_t *null, *t, *cons_t, *str_t, *chr_t, *num_t, *sym_t, *fun_t, *vec_t; -obj_t *stream_t, *hash_t, *lcons_t, *lstr_t, *cobj_t; -obj_t *var, *regex, *set, *cset, *wild, *oneplus; -obj_t *zeroplus, *optional, *compound, *or, *quasi; -obj_t *skip, *trailer, *block, *next, *freeform, *fail, *accept; -obj_t *all, *some, *none, *maybe, *cases, *collect, *until, *coll; -obj_t *define, *output, *single, *frst, *lst, *empty, *repeat, *rep; -obj_t *flattn, *forget, *local, *mrge, *bind, *cat, *args; -obj_t *try, *catch, *finally, *nothrow, *throw, *defex; -obj_t *error, *type_error, *internal_err, *numeric_err, *range_err; -obj_t *query_error, *file_error, *process_error; - -obj_t *zero, *one, *two, *negone, *maxint, *minint; -obj_t *null_string; -obj_t *nil_string; -obj_t *null_list; - -obj_t *identity_f; -obj_t *equal_f; - -obj_t *prog_string; +val interned_syms; + +val null, t, cons_t, str_t, chr_t, num_t, sym_t, fun_t, vec_t; +val stream_t, hash_t, lcons_t, lstr_t, cobj_t; +val var, regex, set, cset, wild, oneplus; +val zeroplus, optional, compound, or, quasi; +val skip, trailer, block, next, freeform, fail, accept; +val all, some, none, maybe, cases, collect, until, coll; +val define, output, single, frst, lst, empty, repeat, rep; +val flattn, forget, local, mrge, bind, cat, args; +val try, catch, finally, nothrow, throw, defex; +val error, type_error, internal_err, numeric_err, range_err; +val query_error, file_error, process_error; + +val zero, one, two, negone, maxint, minint; +val null_string; +val nil_string; +val null_list; + +val identity_f; +val equal_f; + +val prog_string; void *(*oom_realloc)(void *, size_t); -obj_t *identity(obj_t *obj) +val identity(val obj) { return obj; } -static obj_t *identity_tramp(obj_t *env, obj_t *obj) +static val identity_tramp(val env, val obj) { (void) env; return identity(obj); } -static obj_t *equal_tramp(obj_t *env, obj_t *, obj_t *); +static val equal_tramp(val env, val , val ); -static obj_t *code2type(int code) +static val code2type(int code) { switch ((type_t) code) { case CONS: return cons_t; @@ -101,7 +101,7 @@ static obj_t *code2type(int code) return nil; } -obj_t *typeof(obj_t *obj) +val typeof(val obj) { switch (tag(obj)) { case TAG_NUM: @@ -114,7 +114,7 @@ obj_t *typeof(obj_t *obj) } else if (obj->t.type == COBJ) { return obj->co.cls; } else { - obj_t *type = code2type(obj->t.type); + val type = code2type(obj->t.type); if (!type) internal_error("corrupt type field"); return type; @@ -124,14 +124,14 @@ obj_t *typeof(obj_t *obj) } } -obj_t *type_check(obj_t *obj, int type) +val type_check(val obj, int type) { if (!is_ptr(obj) || obj->t.type != type) type_mismatch(lit("~s is not of type ~s"), obj, code2type(type), nao); return t; } -obj_t *type_check2(obj_t *obj, int t1, int t2) +val type_check2(val obj, int t1, int t2) { if (!is_ptr(obj) || (obj->t.type != t1 && obj->t.type != t2)) type_mismatch(lit("~s is not of type ~s or ~s"), obj, @@ -139,7 +139,7 @@ obj_t *type_check2(obj_t *obj, int t1, int t2) return t; } -obj_t *type_check3(obj_t *obj, int t1, int t2, int t3) +val type_check3(val obj, int t1, int t2, int t3) { if (!is_ptr(obj) || (obj->t.type != t1 && obj->t.type != t2 && obj->t.type != t3)) @@ -148,7 +148,7 @@ obj_t *type_check3(obj_t *obj, int t1, int t2, int t3) return t; } -obj_t *car(obj_t *cons) +val car(val cons) { if (cons == nil) return nil; @@ -168,7 +168,7 @@ obj_t *car(obj_t *cons) } } -obj_t *cdr(obj_t *cons) +val cdr(val cons) { if (cons == nil) return nil; @@ -188,7 +188,7 @@ obj_t *cdr(obj_t *cons) } } -obj_t **car_l(obj_t *cons) +val *car_l(val cons) { switch (type(cons)) { case CONS: @@ -201,7 +201,7 @@ obj_t **car_l(obj_t *cons) } } -obj_t **cdr_l(obj_t *cons) +val *cdr_l(val cons) { switch (type(cons)) { case CONS: @@ -214,61 +214,61 @@ obj_t **cdr_l(obj_t *cons) } } -obj_t *first(obj_t *cons) +val first(val cons) { return car(cons); } -obj_t *rest(obj_t *cons) +val rest(val cons) { return cdr(cons); } -obj_t *second(obj_t *cons) +val second(val cons) { return car(cdr(cons)); } -obj_t *third(obj_t *cons) +val third(val cons) { return car(cdr(cdr(cons))); } -obj_t *fourth(obj_t *cons) +val fourth(val cons) { return car(cdr(cdr(cdr(cons)))); } -obj_t *fifth(obj_t *cons) +val fifth(val cons) { return car(cdr(cdr(cdr(cdr(cons))))); } -obj_t *sixth(obj_t *cons) +val sixth(val cons) { return car(cdr(cdr(cdr(cdr(cdr(cons)))))); } -obj_t **tail(obj_t *cons) +val *tail(val cons) { while (cdr(cons)) cons = cdr(cons); return cdr_l(cons); } -obj_t *pop(obj_t **plist) +val pop(val *plist) { - obj_t *ret = car(*plist); + val ret = car(*plist); *plist = cdr(*plist); return ret; } -obj_t *push(obj_t *val, obj_t **plist) +val push(val value, val *plist) { - return *plist = cons(val, *plist); + return *plist = cons(value, *plist); } -obj_t *copy_list(obj_t *list) +val copy_list(val list) { list_collect_decl (out, tail); @@ -282,12 +282,12 @@ obj_t *copy_list(obj_t *list) return out; } -obj_t *nreverse(obj_t *in) +val nreverse(val in) { - obj_t *rev = nil; + val rev = nil; while (in) { - obj_t *temp = cdr(in); + val temp = cdr(in); *cdr_l(in) = rev; rev = in; in = temp; @@ -296,9 +296,9 @@ obj_t *nreverse(obj_t *in) return rev; } -obj_t *reverse(obj_t *in) +val reverse(val in) { - obj_t *rev = nil; + val rev = nil; while (in) { rev = cons(car(in), rev); @@ -308,7 +308,7 @@ obj_t *reverse(obj_t *in) return rev; } -obj_t *append2(obj_t *list1, obj_t *list2) +val append2(val list1, val list2) { list_collect_decl (out, tail); @@ -321,9 +321,9 @@ obj_t *append2(obj_t *list1, obj_t *list2) return out; } -obj_t *nappend2(obj_t *list1, obj_t *list2) +val nappend2(val list1, val list2) { - obj_t *temp, *iter; + val temp, iter; if (list1 == nil) return list2; @@ -335,19 +335,19 @@ obj_t *nappend2(obj_t *list1, obj_t *list2) return list1; } -obj_t *flatten_helper(obj_t *env, obj_t *item) +val flatten_helper(val env, val item) { return flatten(item); } -obj_t *memq(obj_t *obj, obj_t *list) +val memq(val obj, val list) { while (list && car(list) != obj) list = cdr(list); return list; } -obj_t *tree_find(obj_t *obj, obj_t *tree) +val tree_find(val obj, val tree) { if (equal(obj, tree)) return t; @@ -356,7 +356,7 @@ obj_t *tree_find(obj_t *obj, obj_t *tree) return nil; } -obj_t *some_satisfy(obj_t *list, obj_t *pred, obj_t *key) +val some_satisfy(val list, val pred, val key) { if (!key) key = identity_f; @@ -369,7 +369,7 @@ obj_t *some_satisfy(obj_t *list, obj_t *pred, obj_t *key) return nil; } -obj_t *all_satisfy(obj_t *list, obj_t *pred, obj_t *key) +val all_satisfy(val list, val pred, val key) { if (!key) key = identity_f; @@ -382,7 +382,7 @@ obj_t *all_satisfy(obj_t *list, obj_t *pred, obj_t *key) return t; } -obj_t *none_satisfy(obj_t *list, obj_t *pred, obj_t *key) +val none_satisfy(val list, val pred, val key) { if (!key) key = identity_f; @@ -395,7 +395,7 @@ obj_t *none_satisfy(obj_t *list, obj_t *pred, obj_t *key) return t; } -obj_t *flatten(obj_t *list) +val flatten(val list) { if (atom(list)) return cons(list, nil); @@ -403,9 +403,9 @@ obj_t *flatten(obj_t *list) return mappend(func_f1(nil, flatten_helper), list); } -long c_num(obj_t *num); +long c_num(val num); -obj_t *equal(obj_t *left, obj_t *right) +val equal(val left, val right) { /* Bitwise equality is equality, period. */ if (left == right) @@ -512,7 +512,7 @@ obj_t *equal(obj_t *left, obj_t *right) internal_error("unhandled case in equal function"); } -static obj_t *equal_tramp(obj_t *env, obj_t *left, obj_t *right) +static val equal_tramp(val env, val left, val right) { (void) env; return equal(left, right); @@ -543,23 +543,23 @@ wchar_t *chk_strdup(const wchar_t *str) } -obj_t *cons(obj_t *car, obj_t *cdr) +val cons(val car, val cdr) { - obj_t *obj = make_obj(); + val obj = make_obj(); obj->c.type = CONS; obj->c.car = car; obj->c.cdr = cdr; return obj; } -obj_t *list(obj_t *first, ...) +val list(val first, ...) { va_list vl; - obj_t *list = nil; - obj_t *array[32], **ptr = array; + val list = nil; + val array[32], *ptr = array; if (first != nao) { - obj_t *next = first; + val next = first; va_start (vl, first); @@ -567,7 +567,7 @@ obj_t *list(obj_t *first, ...) *ptr++ = next; if (ptr == array + 32) internal_error("runaway arguments in list function"); - next = va_arg(vl, obj_t *); + next = va_arg(vl, val); } while (next != nao); while (ptr > array) @@ -577,7 +577,7 @@ obj_t *list(obj_t *first, ...) return list; } -obj_t *consp(obj_t *obj) +val consp(val obj) { if (!obj) { return nil; @@ -587,22 +587,22 @@ obj_t *consp(obj_t *obj) } } -obj_t *nullp(obj_t *obj) +val nullp(val obj) { return obj == 0 ? t : nil; } -obj_t *atom(obj_t *obj) +val atom(val obj) { return if3(consp(obj), nil, t); } -obj_t *listp(obj_t *obj) +val listp(val obj) { return if2(obj == nil || consp(obj), t); } -obj_t *proper_listp(obj_t *obj) +val proper_listp(val obj) { while (consp(obj)) obj = cdr(obj); @@ -610,7 +610,7 @@ obj_t *proper_listp(obj_t *obj) return (obj == nil) ? t : nil; } -obj_t *length(obj_t *list) +val length(val list) { long len = 0; while (consp(list)) { @@ -620,25 +620,25 @@ obj_t *length(obj_t *list) return num(len); } -obj_t *num(long val) +val num(long n) { - numeric_assert (val >= NUM_MIN && val <= NUM_MAX); - return (obj_t *) ((val << TAG_SHIFT) | TAG_NUM); + numeric_assert (n >= NUM_MIN && n <= NUM_MAX); + return (val) ((n << TAG_SHIFT) | TAG_NUM); } -long c_num(obj_t *num) +long c_num(val num) { if (!is_num(num)) type_mismatch(lit("~s is not a number"), num, nao); return ((long) num) >> TAG_SHIFT; } -obj_t *nump(obj_t *num) +val nump(val num) { return (is_num(num)) ? t : nil; } -obj_t *plus(obj_t *anum, obj_t *bnum) +val plus(val anum, val bnum) { long a = c_num(anum); long b = c_num(bnum); @@ -649,7 +649,7 @@ obj_t *plus(obj_t *anum, obj_t *bnum) return num(a + b); } -obj_t *minus(obj_t *anum, obj_t *bnum) +val minus(val anum, val bnum) { long a = c_num(anum); long b = c_num(bnum); @@ -661,109 +661,109 @@ obj_t *minus(obj_t *anum, obj_t *bnum) return num(a - b); } -obj_t *neg(obj_t *anum) +val neg(val anum) { long n = c_num(anum); return num(-n); } -obj_t *zerop(obj_t *num) +val zerop(val num) { return c_num(num) == 0 ? t : nil; } -obj_t *gt(obj_t *anum, obj_t *bnum) +val gt(val anum, val bnum) { return c_num(anum) > c_num(bnum) ? t : nil; } -obj_t *lt(obj_t *anum, obj_t *bnum) +val lt(val anum, val bnum) { return c_num(anum) < c_num(bnum) ? t : nil; } -obj_t *ge(obj_t *anum, obj_t *bnum) +val ge(val anum, val bnum) { return c_num(anum) >= c_num(bnum) ? t : nil; } -obj_t *le(obj_t *anum, obj_t *bnum) +val le(val anum, val bnum) { return c_num(anum) <= c_num(bnum) ? t : nil; } -obj_t *numeq(obj_t *anum, obj_t *bnum) +val numeq(val anum, val bnum) { return c_num(anum) == c_num(bnum) ? t : nil; } -obj_t *max2(obj_t *anum, obj_t *bnum) +val max2(val anum, val bnum) { return c_num(anum) > c_num(bnum) ? anum : bnum; } -obj_t *min2(obj_t *anum, obj_t *bnum) +val min2(val anum, val bnum) { return c_num(anum) < c_num(bnum) ? anum : bnum; } -obj_t *string_own(wchar_t *str) +val string_own(wchar_t *str) { - obj_t *obj = make_obj(); + val obj = make_obj(); obj->st.type = STR; obj->st.str = str; obj->st.len = nil; return obj; } -obj_t *string(const wchar_t *str) +val string(const wchar_t *str) { - obj_t *obj = make_obj(); + val obj = make_obj(); obj->st.type = STR; obj->st.str = (wchar_t *) chk_strdup(str); obj->st.len = nil; return obj; } -obj_t *string_utf8(const char *str) +val string_utf8(const char *str) { - obj_t *obj = make_obj(); + val obj = make_obj(); obj->st.type = STR; obj->st.str = utf8_dup_from(str); obj->st.len = nil; return obj; } -obj_t *mkstring(obj_t *len, obj_t *ch) +val mkstring(val len, val ch) { size_t nchar = c_num(len) + 1; wchar_t *str = (wchar_t *) chk_malloc(nchar * sizeof *str); - obj_t *s = string_own(str); + val s = string_own(str); wmemset(str, c_chr(ch), nchar); s->st.len = len; return s; } -obj_t *mkustring(obj_t *len) +val mkustring(val len) { wchar_t *str = (wchar_t *) chk_malloc((c_num(len) + 1) * sizeof *str); - obj_t *s = string_own(str); + val s = string_own(str); s->st.len = len; return s; } -obj_t *init_str(obj_t *str, const wchar_t *data) +val init_str(val str, const wchar_t *data) { wmemcpy(str->st.str, data, c_num(str->st.len) + 1); return str; } -obj_t *copy_str(obj_t *str) +val copy_str(val str) { return string(c_str(str)); } -obj_t *stringp(obj_t *str) +val stringp(val str) { switch (tag(str)) { case TAG_LIT: @@ -781,12 +781,12 @@ obj_t *stringp(obj_t *str) return nil; } -obj_t *lazy_stringp(obj_t *str) +val lazy_stringp(val str) { return (is_ptr(str) && (type(str) == LSTR)) ? t : nil; } -obj_t *length_str(obj_t *str) +val length_str(val str) { if (tag(str) == TAG_LIT) { return num(wcslen(c_str(str))); @@ -804,7 +804,7 @@ obj_t *length_str(obj_t *str) } } -const wchar_t *c_str(obj_t *obj) +const wchar_t *c_str(val obj) { if (tag(obj) == TAG_LIT) return litptr(obj); @@ -824,13 +824,12 @@ const wchar_t *c_str(obj_t *obj) } } -obj_t *search_str(obj_t *haystack, obj_t *needle, obj_t *start_num, - obj_t *from_end) +val search_str(val haystack, val needle, val start_num, val from_end) { if (length_str_lt(haystack, start_num)) { return nil; } else { - obj_t *h_is_lazy = lazy_stringp(haystack); + val h_is_lazy = lazy_stringp(haystack); long start = c_num(start_num); long good = -1, pos = -1; const wchar_t *n = c_str(needle), *h; @@ -862,16 +861,15 @@ obj_t *search_str(obj_t *haystack, obj_t *needle, obj_t *start_num, } } -obj_t *search_str_tree(obj_t *haystack, obj_t *tree, obj_t *start_num, - obj_t *from_end) +val search_str_tree(val haystack, val tree, val start_num, val from_end) { if (stringp(tree)) { - obj_t *result = search_str(haystack, tree, start_num, from_end); + val result = search_str(haystack, tree, start_num, from_end); if (result) return cons(result, length_str(tree)); } else if (consp(tree)) { while (tree) { - obj_t *result = search_str_tree(haystack, car(tree), start_num, from_end); + val result = search_str_tree(haystack, car(tree), start_num, from_end); if (result) return result; tree = cdr(tree); @@ -881,7 +879,7 @@ obj_t *search_str_tree(obj_t *haystack, obj_t *tree, obj_t *start_num, return nil; } -obj_t *sub_str(obj_t *str_in, obj_t *from, obj_t *to) +val sub_str(val str_in, val from, val to) { if (from == nil || lt(from, zero)) from = zero; @@ -907,15 +905,15 @@ obj_t *sub_str(obj_t *str_in, obj_t *from, obj_t *to) } } -obj_t *cat_str(obj_t *list, obj_t *sep) +val cat_str(val list, val sep) { long total = 0; - obj_t *iter; + val iter; wchar_t *str, *ptr; long len_sep = sep ? c_num(length_str(sep)) : 0; for (iter = list; iter != nil; iter = cdr(iter)) { - obj_t *item = car(iter); + val item = car(iter); if (!item) continue; if (stringp(item)) { @@ -936,7 +934,7 @@ obj_t *cat_str(obj_t *list, obj_t *sep) str = (wchar_t *) chk_malloc((total + 1) * sizeof *str); for (ptr = str, iter = list; iter != nil; iter = cdr(iter)) { - obj_t *item = car(iter); + val item = car(iter); long len; if (!item) continue; @@ -958,7 +956,7 @@ obj_t *cat_str(obj_t *list, obj_t *sep) return string_own(str); } -obj_t *split_str(obj_t *str, obj_t *sep) +val split_str(val str, val sep) { const wchar_t *cstr = c_str(str); const wchar_t *csep = c_str(sep); @@ -966,7 +964,7 @@ obj_t *split_str(obj_t *str, obj_t *sep) for (;;) { size_t span = wcscspn(cstr, csep); - obj_t *piece = mkustring(num(span)); + val piece = mkustring(num(span)); init_str(piece, cstr); list_collect (iter, piece); cstr += span; @@ -978,7 +976,7 @@ obj_t *split_str(obj_t *str, obj_t *sep) return out; } -obj_t *trim_str(obj_t *str) +val trim_str(val str) { const wchar_t *start = c_str(str); const wchar_t *end = start + c_num(length_str(str)); @@ -1000,30 +998,30 @@ obj_t *trim_str(obj_t *str) } } -obj_t *string_lt(obj_t *astr, obj_t *bstr) +val string_lt(val astr, val bstr) { int cmp = wcscmp(c_str(astr), c_str(bstr)); return cmp == -1 ? t : nil; } -obj_t *chr(wchar_t ch) +val chr(wchar_t ch) { - return (obj_t *) ((ch << TAG_SHIFT) | TAG_CHR); + return (val) ((ch << TAG_SHIFT) | TAG_CHR); } -obj_t *chrp(obj_t *chr) +val chrp(val chr) { return (is_chr(chr)) ? t : nil; } -wchar_t c_chr(obj_t *chr) +wchar_t c_chr(val chr) { if (!is_chr(chr)) type_mismatch(lit("~s is not a character"), chr, nao); return ((wchar_t) chr) >> TAG_SHIFT; } -obj_t *chr_str(obj_t *str, obj_t *index) +val chr_str(val str, val index) { bug_unless (length_str_gt(str, index)); @@ -1035,7 +1033,7 @@ obj_t *chr_str(obj_t *str, obj_t *index) } } -obj_t *chr_str_set(obj_t *str, obj_t *index, obj_t *chr) +val chr_str_set(val str, val index, val chr) { bug_unless (length_str_gt(str, index)); @@ -1049,28 +1047,28 @@ obj_t *chr_str_set(obj_t *str, obj_t *index, obj_t *chr) return chr; } -obj_t *symbol_name(obj_t *sym) +val symbol_name(val sym) { if (sym) type_check(sym, SYM); return sym ? sym->s.name : nil_string; } -obj_t *make_sym(obj_t *name) +val make_sym(val name) { - obj_t *obj = make_obj(); + val obj = make_obj(); obj->s.type = SYM; obj->s.name = name; obj->s.val = nil; return obj; } -obj_t *intern(obj_t *str) +val intern(val str) { - obj_t *iter; + val iter; for (iter = interned_syms; iter != nil; iter = cdr(iter)) { - obj_t *sym = car(iter); + val sym = car(iter); if (equal(symbol_name(sym), str)) return sym; } @@ -1079,14 +1077,14 @@ obj_t *intern(obj_t *str) return car(interned_syms); } -obj_t *symbolp(obj_t *sym) +val symbolp(val sym) { return (sym == nil || (is_ptr(sym) && sym->s.type == SYM)) ? t : nil; } -obj_t *func_f0(obj_t *env, obj_t *(*fun)(obj_t *)) +val func_f0(val env, val (*fun)(val)) { - obj_t *obj = make_obj(); + val obj = make_obj(); obj->f.type = FUN; obj->f.functype = F0; obj->f.env = env; @@ -1094,9 +1092,9 @@ obj_t *func_f0(obj_t *env, obj_t *(*fun)(obj_t *)) return obj; } -obj_t *func_f1(obj_t *env, obj_t *(*fun)(obj_t *, obj_t *)) +val func_f1(val env, val (*fun)(val, val)) { - obj_t *obj = make_obj(); + val obj = make_obj(); obj->f.type = FUN; obj->f.functype = F1; obj->f.env = env; @@ -1104,9 +1102,9 @@ obj_t *func_f1(obj_t *env, obj_t *(*fun)(obj_t *, obj_t *)) return obj; } -obj_t *func_f2(obj_t *env, obj_t *(*fun)(obj_t *, obj_t *, obj_t *)) +val func_f2(val env, val (*fun)(val, val, val)) { - obj_t *obj = make_obj(); + val obj = make_obj(); obj->f.type = FUN; obj->f.functype = F2; obj->f.env = env; @@ -1114,9 +1112,9 @@ obj_t *func_f2(obj_t *env, obj_t *(*fun)(obj_t *, obj_t *, obj_t *)) return obj; } -obj_t *func_f3(obj_t *env, obj_t *(*fun)(obj_t *, obj_t *, obj_t *, obj_t *)) +val func_f3(val env, val (*fun)(val, val, val, val)) { - obj_t *obj = make_obj(); + val obj = make_obj(); obj->f.type = FUN; obj->f.functype = F3; obj->f.env = env; @@ -1124,10 +1122,9 @@ obj_t *func_f3(obj_t *env, obj_t *(*fun)(obj_t *, obj_t *, obj_t *, obj_t *)) return obj; } -obj_t *func_f4(obj_t *env, obj_t *(*fun)(obj_t *, obj_t *, obj_t *, obj_t *, - obj_t *)) +val func_f4(val env, val (*fun)(val, val, val, val, val)) { - obj_t *obj = make_obj(); + val obj = make_obj(); obj->f.type = FUN; obj->f.functype = F4; obj->f.env = env; @@ -1135,9 +1132,9 @@ obj_t *func_f4(obj_t *env, obj_t *(*fun)(obj_t *, obj_t *, obj_t *, obj_t *, return obj; } -obj_t *func_n0(obj_t *(*fun)(void)) +val func_n0(val (*fun)(void)) { - obj_t *obj = make_obj(); + val obj = make_obj(); obj->f.type = FUN; obj->f.functype = N0; obj->f.env = nil; @@ -1145,9 +1142,9 @@ obj_t *func_n0(obj_t *(*fun)(void)) return obj; } -obj_t *func_n1(obj_t *(*fun)(obj_t *)) +val func_n1(val (*fun)(val)) { - obj_t *obj = make_obj(); + val obj = make_obj(); obj->f.type = FUN; obj->f.functype = N1; obj->f.env = nil; @@ -1155,9 +1152,9 @@ obj_t *func_n1(obj_t *(*fun)(obj_t *)) return obj; } -obj_t *func_n2(obj_t *(*fun)(obj_t *, obj_t *)) +val func_n2(val (*fun)(val, val)) { - obj_t *obj = make_obj(); + val obj = make_obj(); obj->f.type = FUN; obj->f.functype = N2; obj->f.env = nil; @@ -1165,18 +1162,18 @@ obj_t *func_n2(obj_t *(*fun)(obj_t *, obj_t *)) return obj; } -obj_t *func_n3(obj_t *(*fun)(obj_t *, obj_t *, obj_t *)) +val func_n3(val (*fun)(val, val, val)) { - obj_t *obj = make_obj(); + val obj = make_obj(); obj->f.type = FUN; obj->f.functype = N3; obj->f.f.n3 = fun; return obj; } -obj_t *func_n4(obj_t *(*fun)(obj_t *, obj_t *, obj_t *, obj_t *)) +val func_n4(val (*fun)(val, val, val, val)) { - obj_t *obj = make_obj(); + val obj = make_obj(); obj->f.type = FUN; obj->f.functype = N4; obj->f.f.n4 = fun; @@ -1184,9 +1181,9 @@ obj_t *func_n4(obj_t *(*fun)(obj_t *, obj_t *, obj_t *, obj_t *)) } -obj_t *apply(obj_t *fun, obj_t *arglist) +val apply(val fun, val arglist) { - obj_t *arg[4], **p = arg; + val arg[4], *p = arg; type_check (fun, FUN); @@ -1226,7 +1223,7 @@ obj_t *apply(obj_t *fun, obj_t *arglist) internal_error("corrupt function type field"); } -obj_t *funcall(obj_t *fun) +val funcall(val fun) { type_check(fun, FUN); @@ -1240,7 +1237,7 @@ obj_t *funcall(obj_t *fun) } } -obj_t *funcall1(obj_t *fun, obj_t *arg) +val funcall1(val fun, val arg) { type_check(fun, FUN); @@ -1254,7 +1251,7 @@ obj_t *funcall1(obj_t *fun, obj_t *arg) } } -obj_t *funcall2(obj_t *fun, obj_t *arg1, obj_t *arg2) +val funcall2(val fun, val arg1, val arg2) { type_check(fun, FUN); @@ -1268,7 +1265,7 @@ obj_t *funcall2(obj_t *fun, obj_t *arg1, obj_t *arg2) } } -obj_t *reduce_left(obj_t *fun, obj_t *list, obj_t *init, obj_t *key) +val reduce_left(val fun, val list, val init, val key) { if (!key) key = identity_f; @@ -1279,28 +1276,28 @@ obj_t *reduce_left(obj_t *fun, obj_t *list, obj_t *init, obj_t *key) return init; } -obj_t *do_bind2(obj_t *fcons, obj_t *arg2) +val do_bind2(val fcons, val arg2) { return funcall2(car(fcons), cdr(fcons), arg2); } -obj_t *bind2(obj_t *fun2, obj_t *arg) +val bind2(val fun2, val arg) { return func_f1(cons(fun2, arg), do_bind2); } -obj_t *do_bind2other(obj_t *fcons, obj_t *arg1) +val do_bind2other(val fcons, val arg1) { return funcall2(car(fcons), arg1, cdr(fcons)); } -obj_t *bind2other(obj_t *fun2, obj_t *arg2) +val bind2other(val fun2, val arg2) { return func_f1(cons(fun2, arg2), do_bind2other); } -static obj_t *do_chain(obj_t *fun1_list, obj_t *arg) +static val do_chain(val fun1_list, val arg) { for (; fun1_list; fun1_list = cdr(fun1_list)) arg = funcall1(car(fun1_list), arg); @@ -1308,16 +1305,16 @@ static obj_t *do_chain(obj_t *fun1_list, obj_t *arg) return arg; } -obj_t *chain(obj_t *fun1_list) +val chain(val fun1_list) { return func_f1(fun1_list, do_chain); } -obj_t *vector(obj_t *alloc) +val vector(val alloc) { long alloc_plus = c_num(alloc) + 2; - obj_t *vec = make_obj(); - obj_t **v = (obj_t **) chk_malloc(alloc_plus * sizeof *v); + val vec = make_obj(); + val *v = (val *) chk_malloc(alloc_plus * sizeof *v); vec->v.type = VEC; vec->v.vec = v + 2; v[0] = alloc; @@ -1325,13 +1322,13 @@ obj_t *vector(obj_t *alloc) return vec; } -obj_t *vec_get_fill(obj_t *vec) +val vec_get_fill(val vec) { type_check(vec, VEC); return vec->v.vec[vec_fill]; } -obj_t *vec_set_fill(obj_t *vec, obj_t *fill) +val vec_set_fill(val vec, val fill) { type_check(vec, VEC); @@ -1344,8 +1341,8 @@ obj_t *vec_set_fill(obj_t *vec, obj_t *fill) if (alloc_delta > 0) { long new_alloc = max(new_fill, 2*old_alloc); - obj_t **newvec = (obj_t **) chk_realloc(vec->v.vec - 2, - (new_alloc + 2)*sizeof *newvec); + val *newvec = (val *) chk_realloc(vec->v.vec - 2, + (new_alloc + 2)*sizeof *newvec); vec->v.vec = newvec + 2; vec->v.vec[vec_alloc] = num(new_alloc); } @@ -1363,35 +1360,35 @@ obj_t *vec_set_fill(obj_t *vec, obj_t *fill) } -obj_t **vecref_l(obj_t *vec, obj_t *ind) +val *vecref_l(val vec, val ind) { type_check(vec, VEC); range_bug_unless (c_num(ind) < c_num(vec->v.vec[vec_fill])); return vec->v.vec + c_num(ind); } -obj_t *vec_push(obj_t *vec, obj_t *item) +val vec_push(val vec, val item) { - obj_t *fill = vec_get_fill(vec); + val fill = vec_get_fill(vec); vec_set_fill(vec, plus(fill, one)); *vecref_l(vec, fill) = item; return fill; } -static obj_t *make_lazycons(obj_t *func) +static val make_lazycons(val func) { - obj_t *obj = make_obj(); + val obj = make_obj(); obj->lc.type = LCONS; obj->lc.car = obj->lc.cdr = nil; obj->lc.func = func; return obj; } -static obj_t *lazy_stream_func(obj_t *env, obj_t *lcons) +static val lazy_stream_func(val env, val lcons) { - obj_t *stream = car(env); - obj_t *next = cdr(env) ? pop(cdr_l(env)) : get_line(stream); - obj_t *ahead = get_line(stream); + val stream = car(env); + val next = cdr(env) ? pop(cdr_l(env)) : get_line(stream); + val ahead = get_line(stream); lcons->lc.car = next; lcons->lc.cdr = if2(ahead, make_lazycons(lcons->lc.func)); @@ -1406,9 +1403,9 @@ static obj_t *lazy_stream_func(obj_t *env, obj_t *lcons) return next; } -obj_t *lazy_stream_cons(obj_t *stream) +val lazy_stream_cons(val stream) { - obj_t *first = get_line(stream); + val first = get_line(stream); if (!first) { close_stream(stream, t); @@ -1419,9 +1416,9 @@ obj_t *lazy_stream_cons(obj_t *stream) lazy_stream_func)); } -obj_t *lazy_str(obj_t *lst, obj_t *term, obj_t *limit) +val lazy_str(val lst, val term, val limit) { - obj_t *obj = make_obj(); + val obj = make_obj(); obj->ls.type = LSTR; obj->ls.opts = nil; /* Must init before calling something that can gc! */ @@ -1441,15 +1438,15 @@ obj_t *lazy_str(obj_t *lst, obj_t *term, obj_t *limit) return obj; } -obj_t *lazy_str_force(obj_t *lstr) +val lazy_str_force(val lstr) { - obj_t *lim; + val lim; type_check(lstr, LSTR); lim = cdr(lstr->ls.opts); while ((!lim || gt(lim, zero)) && lstr->ls.list) { - obj_t *next = pop(&lstr->ls.list); - obj_t *term = car(lstr->ls.opts); + val next = pop(&lstr->ls.list); + val term = car(lstr->ls.opts); lstr->ls.prefix = cat_str(list(lstr->ls.prefix, next, term, nao), nil); if (lim) lim = minus(lim, one); @@ -1461,17 +1458,17 @@ obj_t *lazy_str_force(obj_t *lstr) return lstr->ls.prefix; } -obj_t *lazy_str_force_upto(obj_t *lstr, obj_t *index) +val lazy_str_force_upto(val lstr, val index) { - obj_t *lim; + val lim; type_check(lstr, LSTR); lim = cdr(lstr->ls.opts); while (ge(index, length_str(lstr->ls.prefix)) && lstr->ls.list && or2(nullp(lim),gt(lim,zero))) { - obj_t *next = pop(&lstr->ls.list); - obj_t *term = car(lstr->ls.opts); + val next = pop(&lstr->ls.list); + val term = car(lstr->ls.opts); lstr->ls.prefix = cat_str(list(lstr->ls.prefix, next, term, nao), nil); if (lim) lim = minus(lim, one); @@ -1482,7 +1479,7 @@ obj_t *lazy_str_force_upto(obj_t *lstr, obj_t *index) return lt(index, length_str(lstr->ls.prefix)); } -obj_t *length_str_gt(obj_t *str, obj_t *len) +val length_str_gt(val str, val len) { type_check2 (str, STR, LSTR); @@ -1497,7 +1494,7 @@ obj_t *length_str_gt(obj_t *str, obj_t *len) } } -obj_t *length_str_ge(obj_t *str, obj_t *len) +val length_str_ge(val str, val len) { type_check2 (str, STR, LSTR); @@ -1512,7 +1509,7 @@ obj_t *length_str_ge(obj_t *str, obj_t *len) } } -obj_t *length_str_lt(obj_t *str, obj_t *len) +val length_str_lt(val str, val len) { type_check2 (str, STR, LSTR); @@ -1527,7 +1524,7 @@ obj_t *length_str_lt(obj_t *str, obj_t *len) } } -obj_t *length_str_le(obj_t *str, obj_t *len) +val length_str_le(val str, val len) { type_check2 (str, STR, LSTR); @@ -1542,7 +1539,7 @@ obj_t *length_str_le(obj_t *str, obj_t *len) } } -obj_t *lazy_str_get_trailing_list(obj_t *lstr, obj_t *index) +val lazy_str_get_trailing_list(val lstr, val index) { type_check(lstr, LSTR); @@ -1551,16 +1548,16 @@ obj_t *lazy_str_get_trailing_list(obj_t *lstr, obj_t *index) lazy_str_force_upto(lstr, index); { - obj_t *split_suffix = split_str(sub_str(lstr->ls.prefix, index, nil), + val split_suffix = split_str(sub_str(lstr->ls.prefix, index, nil), or2(car(lstr->ls.opts), string(L"\n"))); return nappend2(split_suffix, lstr->ls.list); } } -obj_t *cobj(void *handle, obj_t *cls_sym, struct cobj_ops *ops) +val cobj(void *handle, val cls_sym, struct cobj_ops *ops) { - obj_t *obj = make_obj(); + val obj = make_obj(); obj->co.type = COBJ; obj->co.handle = handle; obj->co.ops = ops; @@ -1568,17 +1565,17 @@ obj_t *cobj(void *handle, obj_t *cls_sym, struct cobj_ops *ops) return obj; } -void cobj_print_op(obj_t *obj, obj_t *out) +void cobj_print_op(val obj, val out) { put_string(out, lit("#<")); obj_print(obj->co.cls, out); format(out, lit(": ~p>"), obj->co.handle, nao); } -obj_t *assoc(obj_t *list, obj_t *key) +val assoc(val list, val key) { while (list) { - obj_t *elem = car(list); + val elem = car(list); if (equal(car(elem), key)) return elem; list = cdr(list); @@ -1587,9 +1584,9 @@ obj_t *assoc(obj_t *list, obj_t *key) return nil; } -obj_t *acons_new(obj_t *list, obj_t *key, obj_t *value) +val acons_new(val list, val key, val value) { - obj_t *existing = assoc(list, key); + val existing = assoc(list, key); if (existing) { *cdr_l(existing) = value; @@ -1599,22 +1596,22 @@ obj_t *acons_new(obj_t *list, obj_t *key, obj_t *value) } } -obj_t **acons_new_l(obj_t **list, obj_t *key) +val *acons_new_l(val *list, val key) { - obj_t *existing = assoc(*list, key); + val existing = assoc(*list, key); if (existing) { return cdr_l(existing); } else { - obj_t *new = cons(key, nil); + val new = cons(key, nil); *list = cons(new, *list); return cdr_l(new); } } -obj_t *alist_remove(obj_t *list, obj_t *keys) +val alist_remove(val list, val keys) { - obj_t **plist = &list; + val *plist = &list; while (*plist) { if (memq(car(car(*plist)), keys)) @@ -1626,9 +1623,9 @@ obj_t *alist_remove(obj_t *list, obj_t *keys) return list; } -obj_t *alist_remove1(obj_t *list, obj_t *key) +val alist_remove1(val list, val key) { - obj_t **plist = &list; + val *plist = &list; while (*plist) { if (eq(car(car(*plist)), key)) @@ -1640,17 +1637,17 @@ obj_t *alist_remove1(obj_t *list, obj_t *key) return list; } -obj_t *copy_cons(obj_t *c) +val copy_cons(val c) { return cons(car(c), cdr(c)); } -obj_t *copy_alist(obj_t *list) +val copy_alist(val list) { return mapcar(func_n1(copy_cons), list); } -obj_t *mapcar(obj_t *fun, obj_t *list) +val mapcar(val fun, val list) { list_collect_decl (out, iter); @@ -1660,7 +1657,7 @@ obj_t *mapcar(obj_t *fun, obj_t *list) return out; } -obj_t *mappend(obj_t *fun, obj_t *list) +val mappend(val fun, val list) { list_collect_decl (out, iter); @@ -1670,21 +1667,21 @@ obj_t *mappend(obj_t *fun, obj_t *list) return out; } -obj_t *merge(obj_t *list1, obj_t *list2, obj_t *lessfun, obj_t *keyfun) +val merge(val list1, val list2, val lessfun, val keyfun) { list_collect_decl (out, ptail); while (list1 && list2) { - obj_t *el1 = funcall1(keyfun, first(list1)); - obj_t *el2 = funcall1(keyfun, first(list2)); + val el1 = funcall1(keyfun, first(list1)); + val el2 = funcall1(keyfun, first(list2)); if (funcall2(lessfun, el1, el2)) { - obj_t *next = cdr(list1); + val next = cdr(list1); *cdr_l(list1) = nil; list_collect_append(ptail, list1); list1 = next; } else { - obj_t *next = cdr(list2); + val next = cdr(list2); *cdr_l(list2) = nil; list_collect_append(ptail, list2); list2 = next; @@ -1699,7 +1696,7 @@ obj_t *merge(obj_t *list1, obj_t *list2, obj_t *lessfun, obj_t *keyfun) return out; } -static obj_t *do_sort(obj_t *list, obj_t *lessfun, obj_t *keyfun) +static val do_sort(val list, val lessfun, val keyfun) { if (list == nil) return nil; @@ -1711,7 +1708,7 @@ static obj_t *do_sort(obj_t *list, obj_t *lessfun, obj_t *keyfun) { return list; } else { - obj_t *cons2 = cdr(list); + val cons2 = cdr(list); *cdr_l(cons2) = list; *cdr_l(list) = nil; return cons2; @@ -1719,8 +1716,8 @@ static obj_t *do_sort(obj_t *list, obj_t *lessfun, obj_t *keyfun) } { - obj_t *bisect, *iter; - obj_t *list2; + val bisect, iter; + val list2; for (iter = cdr(cdr(list)), bisect = list; iter; bisect = cdr(bisect), iter = cdr(cdr(iter))) @@ -1735,7 +1732,7 @@ static obj_t *do_sort(obj_t *list, obj_t *lessfun, obj_t *keyfun) } } -obj_t *sort(obj_t *list, obj_t *lessfun, obj_t *keyfun) +val sort(val list, val lessfun, val keyfun) { if (!keyfun) keyfun = identity_f; @@ -1756,7 +1753,7 @@ static void obj_init(void) &null_string, &nil_string, &null_list, &equal_f, &identity_f, &prog_string, - (obj_t **) 0); + (val *) 0); nil_string = lit("nil"); @@ -1848,7 +1845,7 @@ static void obj_init(void) prog_string = string(progname); } -void obj_print(obj_t *obj, obj_t *out) +void obj_print(val obj, val out) { if (obj == nil) { put_string(out, lit("nil")); @@ -1859,7 +1856,7 @@ void obj_print(obj_t *obj, obj_t *out) case CONS: case LCONS: { - obj_t *iter; + val iter; put_char(out, chr('(')); for (iter = obj; consp(iter); iter = cdr(iter)) { obj_print(car(iter), out); @@ -1960,7 +1957,7 @@ void obj_print(obj_t *obj, obj_t *out) format(out, lit("#<garbage: ~p>"), (void *) obj, nao); } -void obj_pprint(obj_t *obj, obj_t *out) +void obj_pprint(val obj, val out) { if (obj == nil) { put_string(out, lit("nil")); @@ -1971,7 +1968,7 @@ void obj_pprint(obj_t *obj, obj_t *out) case CONS: case LCONS: { - obj_t *iter; + val iter; put_char(out, chr('(')); for (iter = obj; consp(iter); iter = cdr(iter)) { obj_pprint(car(iter), out); @@ -2028,7 +2025,7 @@ void obj_pprint(obj_t *obj, obj_t *out) } void init(const wchar_t *pn, void *(*oom)(void *, size_t), - obj_t **stack_bottom) + val *stack_bottom) { int gc_save; progname = pn; @@ -2043,7 +2040,7 @@ void init(const wchar_t *pn, void *(*oom)(void *, size_t), gc_state(gc_save); } -void dump(obj_t *obj, obj_t *out) +void dump(val obj, val out) { obj_print(obj, out); put_char(out, chr('\n')); @@ -2054,18 +2051,7 @@ void dump(obj_t *obj, obj_t *out) * so we don't have to keep typing: * (gdb) p dump(something, stdout) */ -void d(obj_t *obj) +void d(val obj) { dump(obj, std_output); } - -obj_t *snarf(obj_t *in) -{ - list_collect_decl (list, iter); - obj_t *str; - - while ((str = get_line(in)) != 0) - list_collect (iter, str); - - return list; -} @@ -47,45 +47,47 @@ typedef enum functype typedef union obj obj_t; +typedef obj_t *val; + struct any { type_t type; void *dummy[2]; - obj_t *next; /* GC free list */ + val next; /* GC free list */ }; struct cons { type_t type; - obj_t *car, *cdr; + val car, cdr; }; struct string { type_t type; wchar_t *str; - obj_t *len; + val len; }; struct sym { type_t type; - obj_t *name; - obj_t *val; + val name; + val val; }; struct func { type_t type; functype_t functype; - obj_t *env; + val env; union { - obj_t *interp_fun; - obj_t *(*f0)(obj_t *); - obj_t *(*f1)(obj_t *, obj_t *); - obj_t *(*f2)(obj_t *, obj_t *, obj_t *); - obj_t *(*f3)(obj_t *, obj_t *, obj_t *, obj_t *); - obj_t *(*f4)(obj_t *, obj_t *, obj_t *, obj_t *, obj_t *); - obj_t *(*n0)(void); - obj_t *(*n1)(obj_t *); - obj_t *(*n2)(obj_t *, obj_t *); - obj_t *(*n3)(obj_t *, obj_t *, obj_t *); - obj_t *(*n4)(obj_t *, obj_t *, obj_t *, obj_t *); + val interp_fun; + val (*f0)(val); + val (*f1)(val, val); + val (*f2)(val, val, val); + val (*f3)(val, val, val, val); + val (*f4)(val, val, val, val, val); + val (*n0)(void); + val (*n1)(val); + val (*n2)(val, val); + val (*n3)(val, val, val); + val (*n4)(val, val, val, val); } f; }; @@ -96,7 +98,7 @@ struct vec { /* vec points two elements down */ /* vec[-2] is allocated size */ /* vec[-1] is fill pointer */ - obj_t **vec; + val *vec; }; /* @@ -109,8 +111,8 @@ struct vec { struct lazy_cons { type_t type; - obj_t *car, *cdr; - obj_t *func; /* when nil, car and cdr are valid */ + val car, cdr; + val func; /* when nil, car and cdr are valid */ }; /* @@ -119,24 +121,24 @@ struct lazy_cons { */ struct lazy_string { type_t type; - obj_t *prefix; /* actual string part */ - obj_t *list; /* remaining list */ - obj_t *opts; /* ( limit . sepstring ) */ + val prefix; /* actual string part */ + val list; /* remaining list */ + val opts; /* ( limit . sepstring ) */ }; struct cobj { type_t type; void *handle; struct cobj_ops *ops; - obj_t *cls; + val cls; }; struct cobj_ops { - obj_t *(*equal)(obj_t *self, obj_t *other); - void (*print)(obj_t *self, obj_t *stream); - void (*destroy)(obj_t *self); - void (*mark)(obj_t *self); - long (*hash)(obj_t *self); + val (*equal)(val self, val other); + void (*print)(val self, val stream); + void (*destroy)(val self); + void (*mark)(val self); + long (*hash)(val self); }; union obj { @@ -151,28 +153,28 @@ union obj { struct cobj co; }; -inline long tag(obj_t *obj) { return ((long) obj) & TAG_MASK; } -inline int is_ptr(obj_t *obj) { return obj && tag(obj) == TAG_PTR; } -inline int is_num(obj_t *obj) { return tag(obj) == TAG_NUM; } -inline int is_chr(obj_t *obj) { return tag(obj) == TAG_CHR; } -inline int is_lit(obj_t *obj) { return tag(obj) == TAG_LIT; } +inline long tag(val obj) { return ((long) obj) & TAG_MASK; } +inline int is_ptr(val obj) { return obj && tag(obj) == TAG_PTR; } +inline int is_num(val obj) { return tag(obj) == TAG_NUM; } +inline int is_chr(val obj) { return tag(obj) == TAG_CHR; } +inline int is_lit(val obj) { return tag(obj) == TAG_LIT; } -inline type_t type(obj_t *obj) +inline type_t type(val obj) { return tag(obj) ? (type_t) tag(obj) : obj->t.type; } -inline obj_t *auto_str(const wchar_t *str) +inline val auto_str(const wchar_t *str) { - return (obj_t *) ((long) (str) | TAG_LIT); + return (val) ((long) (str) | TAG_LIT); } -inline obj_t *static_str(const wchar_t *str) +inline val static_str(const wchar_t *str) { - return (obj_t *) ((long) (str) | TAG_LIT); + return (val) ((long) (str) | TAG_LIT); } -inline wchar_t *litptr(obj_t *obj) +inline wchar_t *litptr(val obj) { return (wchar_t *) ((long) obj & ~TAG_MASK); } @@ -180,172 +182,168 @@ inline wchar_t *litptr(obj_t *obj) #define lit_noex(strlit) ((obj_t *) ((long) (L ## strlit) | TAG_LIT)) #define lit(strlit) lit_noex(strlit) -extern obj_t *interned_syms; +extern val interned_syms; -extern obj_t *t, *cons_t, *str_t, *chr_t, *num_t, *sym_t, *fun_t, *vec_t; -extern obj_t *stream_t, *hash_t, *lcons_t, *lstr_t, *cobj_t; -extern obj_t *var, *regex, *set, *cset, *wild, *oneplus; -extern obj_t *zeroplus, *optional, *compound, *or, *quasi; -extern obj_t *skip, *trailer, *block, *next, *freeform, *fail, *accept; -extern obj_t *all, *some, *none, *maybe, *cases, *collect, *until, *coll; -extern obj_t *define, *output, *single, *frst, *lst, *empty, *repeat, *rep; -extern obj_t *flattn, *forget, *local, *mrge, *bind, *cat, *args; -extern obj_t *try, *catch, *finally, *nothrow, *throw, *defex; -extern obj_t *error, *type_error, *internal_err, *numeric_err, *range_err; -extern obj_t *query_error, *file_error, *process_error; +extern val t, cons_t, str_t, chr_t, num_t, sym_t, fun_t, vec_t; +extern val stream_t, hash_t, lcons_t, lstr_t, cobj_t; +extern val var, regex, set, cset, wild, oneplus; +extern val zeroplus, optional, compound, or, quasi; +extern val skip, trailer, block, next, freeform, fail, accept; +extern val all, some, none, maybe, cases, collect, until, coll; +extern val define, output, single, frst, lst, empty, repeat, rep; +extern val flattn, forget, local, mrge, bind, cat, args; +extern val try, catch, finally, nothrow, throw, defex; +extern val error, type_error, internal_err, numeric_err, range_err; +extern val query_error, file_error, process_error; -extern obj_t *zero, *one, *two, *negone, *maxint, *minint; -extern obj_t *null_string; -extern obj_t *null_list; /* (nil) */ +extern val zero, one, two, negone, maxint, minint; +extern val null_string; +extern val null_list; /* (nil) */ -extern obj_t *identity_f; -extern obj_t *equal_f; +extern val identity_f; +extern val equal_f; extern const wchar_t *progname; -extern obj_t *prog_string; +extern val prog_string; extern void *(*oom_realloc)(void *, size_t); -obj_t *identity(obj_t *obj); -obj_t *typeof(obj_t *obj); -obj_t *type_check(obj_t *obj, int); -obj_t *type_check2(obj_t *obj, int, int); -obj_t *type_check3(obj_t *obj, int, int, int); -obj_t *car(obj_t *cons); -obj_t *cdr(obj_t *cons); -obj_t **car_l(obj_t *cons); -obj_t **cdr_l(obj_t *cons); -obj_t *first(obj_t *cons); -obj_t *rest(obj_t *cons); -obj_t *second(obj_t *cons); -obj_t *third(obj_t *cons); -obj_t *fourth(obj_t *cons); -obj_t *fifth(obj_t *cons); -obj_t *sixth(obj_t *cons); -obj_t **tail(obj_t *cons); -obj_t *pop(obj_t **plist); -obj_t *push(obj_t *val, obj_t **plist); -obj_t *copy_list(obj_t *list); -obj_t *nreverse(obj_t *in); -obj_t *reverse(obj_t *in); -obj_t *append2(obj_t *list1, obj_t *list2); -obj_t *nappend2(obj_t *list1, obj_t *list2); -obj_t *flatten(obj_t *list); -obj_t *memq(obj_t *obj, obj_t *list); -obj_t *tree_find(obj_t *obj, obj_t *tree); -obj_t *some_satisfy(obj_t *list, obj_t *pred, obj_t *key); -obj_t *all_satisfy(obj_t *list, obj_t *pred, obj_t *key); -obj_t *none_satisfy(obj_t *list, obj_t *pred, obj_t *key); -long c_num(obj_t *num); -obj_t *nump(obj_t *num); -obj_t *equal(obj_t *left, obj_t *right); +val identity(val obj); +val typeof(val obj); +val type_check(val obj, int); +val type_check2(val obj, int, int); +val type_check3(val obj, int, int, int); +val car(val cons); +val cdr(val cons); +val *car_l(val cons); +val *cdr_l(val cons); +val first(val cons); +val rest(val cons); +val second(val cons); +val third(val cons); +val fourth(val cons); +val fifth(val cons); +val sixth(val cons); +val *tail(val cons); +val pop(val *plist); +val push(val v, val *plist); +val copy_list(val list); +val nreverse(val in); +val reverse(val in); +val append2(val list1, val list2); +val nappend2(val list1, val list2); +val flatten(val list); +val memq(val obj, val list); +val tree_find(val obj, val tree); +val some_satisfy(val list, val pred, val key); +val all_satisfy(val list, val pred, val key); +val none_satisfy(val list, val pred, val key); +long c_num(val num); +val nump(val num); +val equal(val left, val right); unsigned char *chk_malloc(size_t size); unsigned char *chk_realloc(void *, size_t size); wchar_t *chk_strdup(const wchar_t *str); -obj_t *cons(obj_t *car, obj_t *cdr); -obj_t *list(obj_t *first, ...); /* terminated by nao */ -obj_t *consp(obj_t *obj); -obj_t *nullp(obj_t *obj); -obj_t *atom(obj_t *obj); -obj_t *listp(obj_t *obj); -obj_t *proper_listp(obj_t *obj); -obj_t *length(obj_t *list); -obj_t *num(long val); -long c_num(obj_t *num); -obj_t *plus(obj_t *anum, obj_t *bnum); -obj_t *minus(obj_t *anum, obj_t *bnum); -obj_t *neg(obj_t *num); -obj_t *zerop(obj_t *num); -obj_t *gt(obj_t *anum, obj_t *bnum); -obj_t *lt(obj_t *anum, obj_t *bnum); -obj_t *ge(obj_t *anum, obj_t *bnum); -obj_t *le(obj_t *anum, obj_t *bnum); -obj_t *numeq(obj_t *anum, obj_t *bnum); -obj_t *max2(obj_t *anum, obj_t *bnum); -obj_t *min2(obj_t *anum, obj_t *bnum); -obj_t *string_own(wchar_t *str); -obj_t *string(const wchar_t *str); -obj_t *string_utf8(const char *str); -obj_t *mkstring(obj_t *len, obj_t *ch); -obj_t *mkustring(obj_t *len); /* must initialize immediately with init_str! */ -obj_t *init_str(obj_t *str, const wchar_t *); -obj_t *copy_str(obj_t *str); -obj_t *stringp(obj_t *str); -obj_t *lazy_stringp(obj_t *str); -obj_t *length_str(obj_t *str); -const wchar_t *c_str(obj_t *str); -obj_t *search_str(obj_t *haystack, obj_t *needle, obj_t *start_num, - obj_t *from_end); -obj_t *search_str_tree(obj_t *haystack, obj_t *tree, obj_t *start_num, - obj_t *from_end); -obj_t *sub_str(obj_t *str_in, obj_t *from_num, obj_t *to_num); -obj_t *cat_str(obj_t *list, obj_t *sep); -obj_t *split_str(obj_t *str, obj_t *sep); -obj_t *trim_str(obj_t *str); -obj_t *string_lt(obj_t *astr, obj_t *bstr); -obj_t *chr(wchar_t ch); -obj_t *chrp(obj_t *chr); -wchar_t c_chr(obj_t *chr); -obj_t *chr_str(obj_t *str, obj_t *index); -obj_t *chr_str_set(obj_t *str, obj_t *index, obj_t *chr); -obj_t *sym_name(obj_t *sym); -obj_t *make_sym(obj_t *name); -obj_t *intern(obj_t *str); -obj_t *symbolp(obj_t *sym); -obj_t *symbol_name(obj_t *sym); -obj_t *func_f0(obj_t *, obj_t *(*fun)(obj_t *)); -obj_t *func_f1(obj_t *, obj_t *(*fun)(obj_t *, obj_t *)); -obj_t *func_f2(obj_t *, obj_t *(*fun)(obj_t *, obj_t *, obj_t *)); -obj_t *func_f3(obj_t *, obj_t *(*fun)(obj_t *, obj_t *, obj_t *, obj_t *)); -obj_t *func_f4(obj_t *, obj_t *(*fun)(obj_t *, obj_t *, obj_t *, obj_t *, - obj_t *)); -obj_t *func_n0(obj_t *(*fun)(void)); -obj_t *func_n1(obj_t *(*fun)(obj_t *)); -obj_t *func_n2(obj_t *(*fun)(obj_t *, obj_t *)); -obj_t *func_n3(obj_t *(*fun)(obj_t *, obj_t *, obj_t *)); -obj_t *func_n4(obj_t *(*fun)(obj_t *, obj_t *, obj_t *, obj_t *)); -obj_t *apply(obj_t *fun, obj_t *arglist); -obj_t *funcall(obj_t *fun); -obj_t *funcall1(obj_t *fun, obj_t *arg); -obj_t *funcall2(obj_t *fun, obj_t *arg1, obj_t *arg2); -obj_t *reduce_left(obj_t *fun, obj_t *list, obj_t *init, obj_t *key); -obj_t *bind2(obj_t *fun2, obj_t *arg); -obj_t *bind2other(obj_t *fun2, obj_t *arg2); -obj_t *chain(obj_t *fun1_list); -obj_t *vector(obj_t *alloc); -obj_t *vec_get_fill(obj_t *vec); -obj_t *vec_set_fill(obj_t *vec, obj_t *fill); -obj_t **vecref_l(obj_t *vec, obj_t *ind); -obj_t *vec_push(obj_t *vec, obj_t *item); -obj_t *lazy_stream_cons(obj_t *stream); -obj_t *lazy_str(obj_t *list, obj_t *term, obj_t *limit); -obj_t *lazy_str_force_upto(obj_t *lstr, obj_t *index); -obj_t *lazy_str_force(obj_t *lstr); -obj_t *lazy_str_get_trailing_list(obj_t *lstr, obj_t *index); -obj_t *length_str_gt(obj_t *str, obj_t *len); -obj_t *length_str_ge(obj_t *str, obj_t *len); -obj_t *length_str_lt(obj_t *str, obj_t *len); -obj_t *length_str_le(obj_t *str, obj_t *len); -obj_t *cobj(void *handle, obj_t *cls_sym, struct cobj_ops *ops); -void cobj_print_op(obj_t *, obj_t *); /* Default function for struct cobj_ops */ -obj_t *assoc(obj_t *list, obj_t *key); -obj_t *acons_new(obj_t *list, obj_t *key, obj_t *value); -obj_t **acons_new_l(obj_t **list, obj_t *key); -obj_t *alist_remove(obj_t *list, obj_t *keys); -obj_t *alist_remove1(obj_t *list, obj_t *key); -obj_t *copy_cons(obj_t *cons); -obj_t *copy_alist(obj_t *list); -obj_t *mapcar(obj_t *fun, obj_t *list); -obj_t *mappend(obj_t *fun, obj_t *list); -obj_t *sort(obj_t *list, obj_t *lessfun, obj_t *keyfun); - -void obj_print(obj_t *obj, obj_t *stream); -void obj_pprint(obj_t *obj, obj_t *stream); +val cons(val car, val cdr); +val list(val first, ...); /* terminated by nao */ +val consp(val obj); +val nullp(val obj); +val atom(val obj); +val listp(val obj); +val proper_listp(val obj); +val length(val list); +val num(long val); +long c_num(val num); +val plus(val anum, val bnum); +val minus(val anum, val bnum); +val neg(val num); +val zerop(val num); +val gt(val anum, val bnum); +val lt(val anum, val bnum); +val ge(val anum, val bnum); +val le(val anum, val bnum); +val numeq(val anum, val bnum); +val max2(val anum, val bnum); +val min2(val anum, val bnum); +val string_own(wchar_t *str); +val string(const wchar_t *str); +val string_utf8(const char *str); +val mkstring(val len, val ch); +val mkustring(val len); /* must initialize immediately with init_str! */ +val init_str(val str, const wchar_t *); +val copy_str(val str); +val stringp(val str); +val lazy_stringp(val str); +val length_str(val str); +const wchar_t *c_str(val str); +val search_str(val haystack, val needle, val start_num, val from_end); +val search_str_tree(val haystack, val tree, val start_num, val from_end); +val sub_str(val str_in, val from_num, val to_num); +val cat_str(val list, val sep); +val split_str(val str, val sep); +val trim_str(val str); +val string_lt(val astr, val bstr); +val chr(wchar_t ch); +val chrp(val chr); +wchar_t c_chr(val chr); +val chr_str(val str, val index); +val chr_str_set(val str, val index, val chr); +val sym_name(val sym); +val make_sym(val name); +val intern(val str); +val symbolp(val sym); +val symbol_name(val sym); +val func_f0(val, val (*fun)(val)); +val func_f1(val, val (*fun)(val, val)); +val func_f2(val, val (*fun)(val, val, val)); +val func_f3(val, val (*fun)(val, val, val, val)); +val func_f4(val, val (*fun)(val, val, val, val, val)); +val func_n0(val (*fun)(void)); +val func_n1(val (*fun)(val)); +val func_n2(val (*fun)(val, val)); +val func_n3(val (*fun)(val, val, val)); +val func_n4(val (*fun)(val, val, val, val)); +val apply(val fun, val arglist); +val funcall(val fun); +val funcall1(val fun, val arg); +val funcall2(val fun, val arg1, val arg2); +val reduce_left(val fun, val list, val init, val key); +val bind2(val fun2, val arg); +val bind2other(val fun2, val arg2); +val chain(val fun1_list); +val vector(val alloc); +val vec_get_fill(val vec); +val vec_set_fill(val vec, val fill); +val *vecref_l(val vec, val ind); +val vec_push(val vec, val item); +val lazy_stream_cons(val stream); +val lazy_str(val list, val term, val limit); +val lazy_str_force_upto(val lstr, val index); +val lazy_str_force(val lstr); +val lazy_str_get_trailing_list(val lstr, val index); +val length_str_gt(val str, val len); +val length_str_ge(val str, val len); +val length_str_lt(val str, val len); +val length_str_le(val str, val len); +val cobj(void *handle, val cls_sym, struct cobj_ops *ops); +void cobj_print_op(val, val); /* Default function for struct cobj_ops */ +val assoc(val list, val key); +val acons_new(val list, val key, val value); +val *acons_new_l(val *list, val key); +val alist_remove(val list, val keys); +val alist_remove1(val list, val key); +val copy_cons(val cons); +val copy_alist(val list); +val mapcar(val fun, val list); +val mappend(val fun, val list); +val sort(val list, val lessfun, val keyfun); + +void obj_print(val obj, val stream); +void obj_pprint(val obj, val stream); void init(const wchar_t *progname, void *(*oom_realloc)(void *, size_t), - obj_t **stack_bottom); -void dump(obj_t *obj, obj_t *stream); -obj_t *snarf(obj_t *in); -obj_t *match(obj_t *spec, obj_t *data); + val *stack_bottom); +void dump(val obj, val stream); +val match(val spec, val data); #define nil ((obj_t *) 0) @@ -45,7 +45,7 @@ int output_produced; -static void debugf(obj_t *fmt, ...) +static void debugf(val fmt, ...) { if (opt_loglevel >= 2) { va_list vl; @@ -57,7 +57,7 @@ static void debugf(obj_t *fmt, ...) } } -static void debuglf(obj_t *line, obj_t *fmt, ...) +static void debuglf(val line, val fmt, ...) { if (opt_loglevel >= 2) { va_list vl; @@ -70,10 +70,10 @@ static void debuglf(obj_t *line, obj_t *fmt, ...) } } -static void sem_error(obj_t *line, obj_t *fmt, ...) +static void sem_error(val line, val fmt, ...) { va_list vl; - obj_t *stream = make_string_output_stream(); + val stream = make_string_output_stream(); va_start (vl, fmt); if (line) @@ -85,10 +85,10 @@ static void sem_error(obj_t *line, obj_t *fmt, ...) abort(); } -static void file_err(obj_t *line, obj_t *fmt, ...) +static void file_err(val line, val fmt, ...) { va_list vl; - obj_t *stream = make_string_output_stream(); + val stream = make_string_output_stream(); va_start (vl, fmt); if (line) @@ -125,8 +125,8 @@ void dump_byte_string(const char *str) } -void dump_var(obj_t *var, char *pfx1, size_t len1, - char *pfx2, size_t len2, obj_t *value, int level) +void dump_var(val var, char *pfx1, size_t len1, + char *pfx2, size_t len2, val value, int level) { if (len1 >= 112 || len2 >= 112) internal_error("too much depth in bindings"); @@ -146,7 +146,7 @@ void dump_var(obj_t *var, char *pfx1, size_t len1, } put_char(std_output, chr('\n')); } else { - obj_t *iter; + val iter; int i; size_t add1 = 0, add2 = 0; @@ -164,7 +164,7 @@ void dump_var(obj_t *var, char *pfx1, size_t len1, } } -void dump_bindings(obj_t *bindings) +void dump_bindings(val bindings) { if (opt_loglevel >= 2) { put_line(std_error, lit("raw_bindings:")); @@ -173,17 +173,17 @@ void dump_bindings(obj_t *bindings) while (bindings) { char pfx1[128], pfx2[128]; - obj_t *var = car(car(bindings)); - obj_t *value = cdr(car(bindings)); + val var = car(car(bindings)); + val value = cdr(car(bindings)); *pfx1 = 0; *pfx2 = 0; dump_var(var, pfx1, 0, pfx2, 0, value, 0); bindings = cdr(bindings); } } -obj_t *depth(obj_t *obj) +val depth(val obj) { - obj_t *dep = zero; + val dep = zero; if (obj == nil) return one; @@ -199,10 +199,10 @@ obj_t *depth(obj_t *obj) return plus(dep, one); } -obj_t *weird_merge(obj_t *left, obj_t *right) +val weird_merge(val left, val right) { - obj_t *left_depth = depth(left); - obj_t *right_depth = depth(right); + val left_depth = depth(left); + val right_depth = depth(right); while (lt(left_depth, right_depth) || zerop(left_depth)) { left = cons(left, nil); @@ -217,7 +217,7 @@ obj_t *weird_merge(obj_t *left, obj_t *right) return append2(left, right); } -obj_t *map_leaf_lists(obj_t *func, obj_t *list) +val map_leaf_lists(val func, val list) { if (atom(list)) return list; @@ -226,13 +226,13 @@ obj_t *map_leaf_lists(obj_t *func, obj_t *list) return mapcar(bind2(func_n2(map_leaf_lists), func), list); } -obj_t *dest_bind(obj_t *bindings, obj_t *pattern, obj_t *value) +val dest_bind(val bindings, val pattern, val value) { if (nullp(pattern)) return bindings; if (symbolp(pattern)) { - obj_t *existing = assoc(bindings, pattern); + val existing = assoc(bindings, pattern); if (existing) { if (tree_find(value, cdr(existing))) return bindings; @@ -245,7 +245,7 @@ obj_t *dest_bind(obj_t *bindings, obj_t *pattern, obj_t *value) } if (consp(pattern)) { - obj_t *piter = pattern, *viter = value; + val piter = pattern, viter = value; while (consp(piter) && consp(viter)) { @@ -266,9 +266,9 @@ obj_t *dest_bind(obj_t *bindings, obj_t *pattern, obj_t *value) return bindings; } -obj_t *match_line(obj_t *bindings, obj_t *specline, obj_t *dataline, - obj_t *pos, obj_t *spec_lineno, obj_t *data_lineno, - obj_t *file) +val match_line(val bindings, val specline, val dataline, + val pos, val spec_lineno, val data_lineno, + val file) { #define LOG_MISMATCH(KIND) \ debuglf(spec_lineno, lit(KIND " mismatch, position ~a (~a:~a)"), pos, \ @@ -286,7 +286,7 @@ obj_t *match_line(obj_t *bindings, obj_t *specline, obj_t *dataline, minus(EXTENT, pos), lit("^"), nao) for (;;) { - obj_t *elem; + val elem; if (specline == nil) break; @@ -296,13 +296,13 @@ obj_t *match_line(obj_t *bindings, obj_t *specline, obj_t *dataline, switch (elem ? type(elem) : 0) { case CONS: /* directive */ { - obj_t *directive = first(elem); + val directive = first(elem); if (directive == var) { - obj_t *sym = second(elem); - obj_t *pat = third(elem); - obj_t *modifier = fourth(elem); - obj_t *pair = assoc(bindings, sym); /* var exists already? */ + val sym = second(elem); + val pat = third(elem); + val modifier = fourth(elem); + val pair = assoc(bindings, sym); /* var exists already? */ if (pair) { /* If the variable already has a binding, we replace @@ -313,7 +313,7 @@ obj_t *match_line(obj_t *bindings, obj_t *specline, obj_t *dataline, if (pat) { specline = cons(cdr(pair), cons(pat, rest(specline))); } else if (nump(modifier)) { - obj_t *past = plus(pos, modifier); + val past = plus(pos, modifier); if (length_str_lt(dataline, past) || lt(past, pos)) { @@ -337,7 +337,7 @@ obj_t *match_line(obj_t *bindings, obj_t *specline, obj_t *dataline, continue; } else if (pat == nil) { /* match to end of line or with regex */ if (consp(modifier)) { - obj_t *past = match_regex(dataline, car(modifier), pos); + val past = match_regex(dataline, car(modifier), pos); if (nullp(past)) { LOG_MISMATCH("var positive regex"); return nil; @@ -346,7 +346,7 @@ obj_t *match_line(obj_t *bindings, obj_t *specline, obj_t *dataline, bindings = acons_new(bindings, sym, sub_str(dataline, pos, past)); pos = past; } else if (nump(modifier)) { - obj_t *past = plus(pos, modifier); + val past = plus(pos, modifier); if (length_str_lt(dataline, past) || lt(past, pos)) { LOG_MISMATCH("count based var"); @@ -360,7 +360,7 @@ obj_t *match_line(obj_t *bindings, obj_t *specline, obj_t *dataline, pos = length_str(dataline); } } else if (type(pat) == STR) { - obj_t *find = search_str(dataline, pat, pos, modifier); + val find = search_str(dataline, pat, pos, modifier); if (!find) { LOG_MISMATCH("var delimiting string"); return nil; @@ -369,9 +369,9 @@ obj_t *match_line(obj_t *bindings, obj_t *specline, obj_t *dataline, bindings = acons_new(bindings, sym, sub_str(dataline, pos, find)); pos = plus(find, length_str(pat)); } else if (consp(pat) && typeof(first(pat)) == regex) { - obj_t *find = search_regex(dataline, first(pat), pos, modifier); - obj_t *fpos = car(find); - obj_t *flen = cdr(find); + val find = search_regex(dataline, first(pat), pos, modifier); + val fpos = car(find); + val flen = cdr(find); if (!find) { LOG_MISMATCH("var delimiting regex"); return nil; @@ -381,9 +381,9 @@ obj_t *match_line(obj_t *bindings, obj_t *specline, obj_t *dataline, pos = plus(fpos, flen); } else if (consp(pat) && first(pat) == var) { /* Unbound var followed by var: the following one must be bound. */ - obj_t *second_sym = second(pat); - obj_t *next_pat = third(pat); - obj_t *pair = assoc(bindings, second_sym); /* var exists already? */ + val second_sym = second(pat); + val next_pat = third(pat); + val pair = assoc(bindings, second_sym); /* var exists already? */ if (!pair) sem_error(spec_lineno, lit("consecutive unbound variables"), nao); @@ -391,7 +391,7 @@ obj_t *match_line(obj_t *bindings, obj_t *specline, obj_t *dataline, /* Re-generate a new spec with an edited version of the element we just processed, and repeat. */ { - obj_t *new_elem = list(var, sym, cdr(pair), modifier, nao); + val new_elem = list(var, sym, cdr(pair), modifier, nao); if (next_pat) specline = cons(new_elem, cons(next_pat, rest(specline))); @@ -413,7 +413,7 @@ obj_t *match_line(obj_t *bindings, obj_t *specline, obj_t *dataline, lit("variable followed by invalid element"), nao); } } else if (typeof(directive) == regex) { - obj_t *past = match_regex(dataline, directive, pos); + val past = match_regex(dataline, directive, pos); if (nullp(past)) { LOG_MISMATCH("regex"); return nil; @@ -421,10 +421,10 @@ obj_t *match_line(obj_t *bindings, obj_t *specline, obj_t *dataline, LOG_MATCH("regex", past); pos = past; } else if (directive == coll) { - obj_t *coll_specline = second(elem); - obj_t *until_specline = third(elem); - obj_t *bindings_coll = nil; - obj_t *iter; + val coll_specline = second(elem); + val until_specline = third(elem); + val bindings_coll = nil; + val iter; for (;;) { cons_bind (new_bindings, new_pos, @@ -451,8 +451,8 @@ obj_t *match_line(obj_t *bindings, obj_t *specline, obj_t *dataline, for (iter = new_bindings; iter && iter != bindings; iter = cdr(iter)) { - obj_t *binding = car(iter); - obj_t *existing = assoc(bindings_coll, car(binding)); + val binding = car(iter); + val existing = assoc(bindings_coll, car(binding)); bindings_coll = acons_new(bindings_coll, car(binding), cons(cdr(binding), cdr(existing))); @@ -475,13 +475,13 @@ obj_t *match_line(obj_t *bindings, obj_t *specline, obj_t *dataline, debuglf(spec_lineno, lit("nothing was collected"), nao); for (iter = bindings_coll; iter; iter = cdr(iter)) { - obj_t *pair = car(iter); - obj_t *rev = cons(car(pair), nreverse(cdr(pair))); + val pair = car(iter); + val rev = cons(car(pair), nreverse(cdr(pair))); bindings = cons(rev, bindings); } } else if (consp(directive) || stringp(directive)) { cons_bind (find, len, search_str_tree(dataline, elem, pos, nil)); - obj_t *newpos; + val newpos; if (find == nil || !equal(find, pos)) { LOG_MISMATCH("string tree"); @@ -498,8 +498,8 @@ obj_t *match_line(obj_t *bindings, obj_t *specline, obj_t *dataline, break; case STR: { - obj_t *find = search_str(dataline, elem, pos, nil); - obj_t *newpos; + val find = search_str(dataline, elem, pos, nil); + val newpos; if (find == nil || !equal(find, pos)) { LOG_MISMATCH("string"); return nil; @@ -519,15 +519,15 @@ obj_t *match_line(obj_t *bindings, obj_t *specline, obj_t *dataline, return cons(bindings, pos); } -obj_t *format_field(obj_t *string_or_list, obj_t *spec) +val format_field(val string_or_list, val spec) { if (!stringp(string_or_list)) return string_or_list; { - obj_t *right = lt(spec, zero); - obj_t *width = if3(lt(spec, zero), neg(spec), spec); - obj_t *diff = minus(width, length_str(string_or_list)); + val right = lt(spec, zero); + val width = if3(lt(spec, zero), neg(spec), spec); + val diff = minus(width, length_str(string_or_list)); if (le(diff, zero)) return string_or_list; @@ -536,28 +536,28 @@ obj_t *format_field(obj_t *string_or_list, obj_t *spec) return string_or_list; { - obj_t *padding = mkstring(diff, chr(' ')); + val padding = mkstring(diff, chr(' ')); return if3(right, - cat_str(list(padding, string_or_list, nao), nil), - cat_str(list(string_or_list, padding, nao), nil)); + cat_str(list(padding, string_or_list, nao), nil), + cat_str(list(string_or_list, padding, nao), nil)); } } } -obj_t *subst_vars(obj_t *spec, obj_t *bindings) +val subst_vars(val spec, val bindings) { list_collect_decl(out, iter); while (spec) { - obj_t *elem = first(spec); + val elem = first(spec); if (consp(elem)) { if (first(elem) == var) { - obj_t *sym = second(elem); - obj_t *pat = third(elem); - obj_t *modifier = fourth(elem); - obj_t *pair = assoc(bindings, sym); + val sym = second(elem); + val pat = third(elem); + val modifier = fourth(elem); + val pair = assoc(bindings, sym); if (pair) { if (pat) @@ -569,12 +569,12 @@ obj_t *subst_vars(obj_t *spec, obj_t *bindings) continue; } } else if (first(elem) == quasi) { - obj_t *nested = subst_vars(rest(elem), bindings); + val nested = subst_vars(rest(elem), bindings); list_collect_append(iter, nested); spec = cdr(spec); continue; } else { - obj_t *nested = subst_vars(elem, bindings); + val nested = subst_vars(elem, bindings); list_collect_append(iter, nested); spec = cdr(spec); continue; @@ -588,7 +588,7 @@ obj_t *subst_vars(obj_t *spec, obj_t *bindings) return out; } -obj_t *eval_form(obj_t *form, obj_t *bindings) +val eval_form(val form, val bindings) { if (!form) return cons(t, form); @@ -600,7 +600,7 @@ obj_t *eval_form(obj_t *form, obj_t *bindings) } else if (regexp(car(form))) { return cons(t, form); } else { - obj_t *subforms = mapcar(bind2other(func_n2(eval_form), bindings), form); + val subforms = mapcar(bind2other(func_n2(eval_form), bindings), form); if (all_satisfy(subforms, identity_f, nil)) return cons(t, mapcar(func_n1(cdr), subforms)); @@ -619,7 +619,7 @@ typedef struct fpip { enum { fpip_fclose, fpip_pclose, fpip_closedir } close; } fpip_t; -fpip_t complex_open(obj_t *name, obj_t *output) +fpip_t complex_open(val name, val output) { fpip_t ret = { 0, 0 }; @@ -677,7 +677,7 @@ void complex_close(fpip_t fp) internal_error("bad input source type code"); } -obj_t *complex_snarf(fpip_t fp, obj_t *name) +val complex_snarf(fpip_t fp, val name) { switch (fp.close) { case fpip_fclose: @@ -691,7 +691,7 @@ obj_t *complex_snarf(fpip_t fp, obj_t *name) internal_error("bad input source type"); } -obj_t *complex_stream(fpip_t fp, obj_t *name) +val complex_stream(fpip_t fp, val name) { switch (fp.close) { case fpip_fclose: @@ -706,7 +706,7 @@ obj_t *complex_stream(fpip_t fp, obj_t *name) } -obj_t *robust_length(obj_t *obj) +val robust_length(val obj) { if (obj == nil) return zero; @@ -715,21 +715,21 @@ obj_t *robust_length(obj_t *obj) return length(obj); } -obj_t *bind_car(obj_t *bind_cons) +val bind_car(val bind_cons) { return if3(consp(cdr(bind_cons)), cons(car(bind_cons), car(cdr(bind_cons))), bind_cons); } -obj_t *bind_cdr(obj_t *bind_cons) +val bind_cdr(val bind_cons) { return if3(consp(cdr(bind_cons)), cons(car(bind_cons), cdr(cdr(bind_cons))), bind_cons); } -obj_t *extract_vars(obj_t *output_spec) +val extract_vars(val output_spec) { list_collect_decl (vars, tai); @@ -745,10 +745,10 @@ obj_t *extract_vars(obj_t *output_spec) return vars; } -obj_t *extract_bindings(obj_t *bindings, obj_t *output_spec) +val extract_bindings(val bindings, val output_spec) { list_collect_decl (bindings_out, tail); - obj_t *var_list = extract_vars(output_spec); + val var_list = extract_vars(output_spec); for (; bindings; bindings = cdr(bindings)) if (memq(car(car(bindings)), var_list)) @@ -757,47 +757,47 @@ obj_t *extract_bindings(obj_t *bindings, obj_t *output_spec) return bindings_out; } -void do_output_line(obj_t *bindings, obj_t *specline, - obj_t *spec_lineno, obj_t *out) +void do_output_line(val bindings, val specline, + val spec_lineno, val out) { for (; specline; specline = rest(specline)) { - obj_t *elem = first(specline); + val elem = first(specline); switch (elem ? type(elem) : 0) { case CONS: { - obj_t *directive = first(elem); + val directive = first(elem); if (directive == var) { - obj_t *str = cat_str(subst_vars(cons(elem, nil), bindings), nil); + val str = cat_str(subst_vars(cons(elem, nil), bindings), nil); if (str == nil) sem_error(spec_lineno, lit("bad substitution: ~a"), second(elem), nao); put_string(out, str); } else if (directive == rep) { - obj_t *main_clauses = second(elem); - obj_t *single_clauses = third(elem); - obj_t *first_clauses = fourth(elem); - obj_t *last_clauses = fifth(elem); - obj_t *empty_clauses = sixth(elem); - obj_t *bind_cp = extract_bindings(bindings, elem); - obj_t *max_depth = reduce_left(func_n2(max2), - bind_cp, zero, - chain(list(func_n1(cdr), - func_n1(robust_length), - nao))); + val main_clauses = second(elem); + val single_clauses = third(elem); + val first_clauses = fourth(elem); + val last_clauses = fifth(elem); + val empty_clauses = sixth(elem); + val bind_cp = extract_bindings(bindings, elem); + val max_depth = reduce_left(func_n2(max2), + bind_cp, zero, + chain(list(func_n1(cdr), + func_n1(robust_length), + nao))); if (equal(max_depth, zero) && empty_clauses) { do_output_line(bindings, empty_clauses, spec_lineno, out); } else if (equal(max_depth, one) && single_clauses) { - obj_t *bind_a = mapcar(func_n1(bind_car), bind_cp); + val bind_a = mapcar(func_n1(bind_car), bind_cp); do_output_line(bind_a, single_clauses, spec_lineno, out); } else if (!zerop(max_depth)) { long i; for (i = 0; i < c_num(max_depth); i++) { - obj_t *bind_a = mapcar(func_n1(bind_car), bind_cp); - obj_t *bind_d = mapcar(func_n1(bind_cdr), bind_cp); + val bind_a = mapcar(func_n1(bind_car), bind_cp); + val bind_d = mapcar(func_n1(bind_cdr), bind_cp); if (i == 0 && first_clauses) { do_output_line(bind_a, first_clauses, spec_lineno, out); @@ -828,42 +828,42 @@ void do_output_line(obj_t *bindings, obj_t *specline, } } -void do_output(obj_t *bindings, obj_t *specs, obj_t *out) +void do_output(val bindings, val specs, val out) { if (equal(specs, null_list)) return; for (; specs; specs = cdr(specs)) { cons_bind (spec_lineno, specline, first(specs)); - obj_t *first_elem = first(specline); + val first_elem = first(specline); if (consp(first_elem)) { - obj_t *sym = first(first_elem); + val sym = first(first_elem); if (sym == repeat) { - obj_t *main_clauses = second(first_elem); - obj_t *single_clauses = third(first_elem); - obj_t *first_clauses = fourth(first_elem); - obj_t *last_clauses = fifth(first_elem); - obj_t *empty_clauses = sixth(first_elem); - obj_t *bind_cp = extract_bindings(bindings, first_elem); - obj_t *max_depth = reduce_left(func_n2(max2), - bind_cp, zero, - chain(list(func_n1(cdr), - func_n1(robust_length), - nao))); + val main_clauses = second(first_elem); + val single_clauses = third(first_elem); + val first_clauses = fourth(first_elem); + val last_clauses = fifth(first_elem); + val empty_clauses = sixth(first_elem); + val bind_cp = extract_bindings(bindings, first_elem); + val max_depth = reduce_left(func_n2(max2), + bind_cp, zero, + chain(list(func_n1(cdr), + func_n1(robust_length), + nao))); if (equal(max_depth, zero) && empty_clauses) { do_output(bind_cp, empty_clauses, out); } else if (equal(max_depth, one) && single_clauses) { - obj_t *bind_a = mapcar(func_n1(bind_car), bind_cp); + val bind_a = mapcar(func_n1(bind_car), bind_cp); do_output(bind_a, single_clauses, out); } else if (!zerop(max_depth)) { long i; for (i = 0; i < c_num(max_depth); i++) { - obj_t *bind_a = mapcar(func_n1(bind_car), bind_cp); - obj_t *bind_d = mapcar(func_n1(bind_cdr), bind_cp); + val bind_a = mapcar(func_n1(bind_car), bind_cp); + val bind_d = mapcar(func_n1(bind_cdr), bind_cp); if (i == 0 && first_clauses) { do_output(bind_a, first_clauses, out); @@ -885,11 +885,11 @@ void do_output(obj_t *bindings, obj_t *specs, obj_t *out) } } -obj_t *match_files(obj_t *spec, obj_t *files, - obj_t *bindings, obj_t *first_file_parsed, - obj_t *data_linenum) +val match_files(val spec, val files, + val bindings, val first_file_parsed, + val data_linenum) { - obj_t *data = nil; + val data = nil; long data_lineno = 0; if (listp(first_file_parsed)) { @@ -897,10 +897,10 @@ obj_t *match_files(obj_t *spec, obj_t *files, data_lineno = c_num(data_linenum); first_file_parsed = nil; } else if (files) { - obj_t *source_spec = first(files); - obj_t *name = consp(source_spec) ? cdr(source_spec) : source_spec; + val source_spec = first(files); + val name = consp(source_spec) ? cdr(source_spec) : source_spec; fpip_t fp = (errno = 0, complex_open(name, nil)); - obj_t *first_spec_item = second(first(spec)); + val first_spec_item = second(first(spec)); if (consp(first_spec_item) && eq(first(first_spec_item), next)) { debugf(lit("not opening source ~a " @@ -931,16 +931,16 @@ obj_t *match_files(obj_t *spec, obj_t *files, for (; spec; spec = rest(spec), data = rest(data), data_lineno++) repeat_spec_same_data: { - obj_t *specline = rest(first(spec)); - obj_t *dataline = first(data); - obj_t *spec_linenum = first(first(spec)); - obj_t *first_spec = first(specline); + val specline = rest(first(spec)); + val dataline = first(data); + val spec_linenum = first(first(spec)); + val first_spec = first(specline); if (consp(first_spec)) { - obj_t *sym = first(first_spec); + val sym = first(first_spec); if (sym == skip) { - obj_t *max = first(rest(first_spec)); + val max = first(rest(first_spec)); long cmax = nump(max) ? c_num(max) : 0; long reps = 0; @@ -997,8 +997,8 @@ repeat_spec_same_data: return nil; } } else if (sym == freeform) { - obj_t *args = rest(first_spec); - obj_t *vals = mapcar(func_n1(cdr), + val args = rest(first_spec); + val vals = mapcar(func_n1(cdr), mapcar(bind2other(func_n2(eval_form), bindings), args)); @@ -1006,12 +1006,12 @@ repeat_spec_same_data: sem_error(spec_linenum, lit("freeform must be followed by a query line"), nao); } else { - obj_t *limit = or2(if2(nump(first(vals)), first(vals)), - if2(nump(second(vals)), second(vals))); - obj_t *term = or2(if2(stringp(first(vals)), first(vals)), - if2(stringp(second(vals)), second(vals))); - obj_t *ff_specline = rest(first(spec)); - obj_t *ff_dataline = lazy_str(data, term, limit); + val limit = or2(if2(nump(first(vals)), first(vals)), + if2(nump(second(vals)), second(vals))); + val term = or2(if2(stringp(first(vals)), first(vals)), + if2(stringp(second(vals)), second(vals))); + val ff_specline = rest(first(spec)); + val ff_dataline = lazy_str(data, term, limit); cons_bind (new_bindings, success, match_line(bindings, ff_specline, ff_dataline, zero, @@ -1033,7 +1033,7 @@ repeat_spec_same_data: goto repeat_spec_same_data; } else if (sym == block) { - obj_t *name = first(rest(first_spec)); + val name = first(rest(first_spec)); if (rest(specline)) sem_error(spec_linenum, lit("unexpected material after block directive"), nao); @@ -1046,7 +1046,7 @@ repeat_spec_same_data: return result; } } else if (sym == fail || sym == accept) { - obj_t *target = first(rest(first_spec)); + val target = first(rest(first_spec)); if (rest(specline)) sem_error(spec_linenum, lit("unexpected material after ~a"), sym, nao); @@ -1072,15 +1072,15 @@ repeat_spec_same_data: break; if (rest(first_spec)) { - obj_t *source = rest(first_spec); + val source = rest(first_spec); if (eq(first(source), nothrow)) push(nil, &source); else if (eq(first(source), args)) { - obj_t *input_name = string(L"args"); + val input_name = string(L"args"); cons_bind (new_bindings, success, - match_files(spec, cons(input_name, files), - bindings, files, one)); + match_files(spec, cons(input_name, files), + bindings, files, one)); if (success) return cons(new_bindings, if3(data, cons(data, num(data_lineno)), t)); @@ -1088,10 +1088,10 @@ repeat_spec_same_data: } { - obj_t *val = eval_form(first(source), bindings); - obj_t *name = cdr(val); + val value = eval_form(first(source), bindings); + val name = cdr(value); - if (!val) + if (!value) sem_error(spec_linenum, lit("next: unbound variable in form ~a"), first(source), nao); @@ -1118,8 +1118,8 @@ repeat_spec_same_data: } } } else if (rest(specline)) { - obj_t *sub = subst_vars(rest(specline), bindings); - obj_t *str = cat_str(sub, nil); + val sub = subst_vars(rest(specline), bindings); + val str = cat_str(sub, nil); if (str == nil) { sem_error(spec_linenum, lit("bad substitution in next file spec"), nao); @@ -1147,16 +1147,16 @@ repeat_spec_same_data: } else if (sym == some || sym == all || sym == none || sym == maybe || sym == cases) { - obj_t *specs; - obj_t *all_match = t; - obj_t *some_match = nil; - obj_t *max_line = zero; - obj_t *max_data = nil; + val specs; + val all_match = t; + val some_match = nil; + val max_line = zero; + val max_data = nil; for (specs = rest(first_spec); specs != nil; specs = rest(specs)) { - obj_t *nested_spec = first(specs); - obj_t *data_linenum = num(data_lineno); + val nested_spec = first(specs); + val data_linenum = num(data_lineno); cons_bind (new_bindings, success, match_files(nested_spec, files, bindings, @@ -1211,10 +1211,10 @@ repeat_spec_same_data: goto repeat_spec_same_data; } else if (sym == collect) { - obj_t *coll_spec = second(first_spec); - obj_t *until_spec = third(first_spec); - obj_t *bindings_coll = nil; - obj_t *iter; + val coll_spec = second(first_spec); + val until_spec = third(first_spec); + val bindings_coll = nil; + val iter; uw_block_begin(nil, result); @@ -1245,8 +1245,8 @@ repeat_spec_same_data: for (iter = new_bindings; iter && iter != bindings; iter = cdr(iter)) { - obj_t *binding = car(iter); - obj_t *existing = assoc(bindings_coll, car(binding)); + val binding = car(iter); + val existing = assoc(bindings_coll, car(binding)); bindings_coll = acons_new(bindings_coll, car(binding), cons(cdr(binding), cdr(existing))); @@ -1291,8 +1291,8 @@ repeat_spec_same_data: debuglf(spec_linenum, lit("nothing was collected"), nao); for (iter = bindings_coll; iter; iter = cdr(iter)) { - obj_t *pair = car(iter); - obj_t *rev = cons(car(pair), nreverse(cdr(pair))); + val pair = car(iter); + val rev = cons(car(pair), nreverse(cdr(pair))); bindings = cons(rev, bindings); } @@ -1301,16 +1301,16 @@ repeat_spec_same_data: goto repeat_spec_same_data; } else if (sym == flattn) { - obj_t *iter; + val iter; for (iter = rest(first_spec); iter; iter = rest(iter)) { - obj_t *sym = first(iter); + val sym = first(iter); if (!symbolp(sym)) { sem_error(spec_linenum, lit("non-symbol in flatten directive"), nao); } else { - obj_t *existing = assoc(bindings, sym); + val existing = assoc(bindings, sym); if (existing) *cdr_l(existing) = flatten(cdr(existing)); @@ -1329,18 +1329,18 @@ repeat_spec_same_data: goto repeat_spec_same_data; } else if (sym == mrge) { - obj_t *target = first(rest(first_spec)); - obj_t *args = rest(rest(first_spec)); - obj_t *merged = nil; + val target = first(rest(first_spec)); + val args = rest(rest(first_spec)); + val merged = nil; if (!target || !symbolp(target)) sem_error(spec_linenum, lit("bad merge directive"), nao); for (; args; args = rest(args)) { - obj_t *other_sym = first(args); + val other_sym = first(args); if (other_sym) { - obj_t *other_lookup = assoc(bindings, other_sym); + val other_lookup = assoc(bindings, other_sym); if (!symbolp(other_sym)) sem_error(spec_linenum, lit("non-symbol in merge directive"), @@ -1363,10 +1363,10 @@ repeat_spec_same_data: goto repeat_spec_same_data; } else if (sym == bind) { - obj_t *args = rest(first_spec); - obj_t *pattern = first(args); - obj_t *form = second(args); - obj_t *val = eval_form(form, bindings); + val args = rest(first_spec); + val pattern = first(args); + val form = second(args); + val val = eval_form(form, bindings); if (!val) sem_error(spec_linenum, lit("bind: unbound variable on right side"), @@ -1382,19 +1382,19 @@ repeat_spec_same_data: goto repeat_spec_same_data; } else if (sym == cat) { - obj_t *iter; + val iter; for (iter = rest(first_spec); iter; iter = rest(iter)) { - obj_t *sym = first(iter); + val sym = first(iter); if (!symbolp(sym)) { sem_error(spec_linenum, lit("non-symbol in cat directive"), nao); } else { - obj_t *existing = assoc(bindings, sym); - obj_t *sep = nil; + val existing = assoc(bindings, sym); + val sep = nil; if (rest(specline)) { - obj_t *sub = subst_vars(rest(specline), bindings); + val sub = subst_vars(rest(specline), bindings); sep = cat_str(sub, nil); } @@ -1408,11 +1408,11 @@ repeat_spec_same_data: goto repeat_spec_same_data; } else if (sym == output) { - obj_t *specs = second(first_spec); - obj_t *old_style_dest = third(first_spec); - obj_t *new_style_dest = fourth(first_spec); - obj_t *nt = nil; - obj_t *dest; + val specs = second(first_spec); + val old_style_dest = third(first_spec); + val new_style_dest = fourth(first_spec); + val nt = nil; + val dest; fpip_t fp; if (old_style_dest) { @@ -1422,8 +1422,8 @@ repeat_spec_same_data: push(nil, &new_style_dest); { - obj_t *form = first(new_style_dest); - obj_t *val = eval_form(form, bindings); + val form = first(new_style_dest); + val val = eval_form(form, bindings); if (!val) sem_error(spec_linenum, @@ -1450,7 +1450,7 @@ repeat_spec_same_data: file_err(nil, lit("could not open ~a"), dest, nao); } } else { - obj_t *stream = complex_stream(fp, dest); + val stream = complex_stream(fp, dest); do_output(bindings, specs, stream); close_stream(stream, t); } @@ -1460,10 +1460,10 @@ repeat_spec_same_data: goto repeat_spec_same_data; } else if (sym == define) { - obj_t *args = second(first_spec); - obj_t *body = third(first_spec); - obj_t *name = first(args); - obj_t *params = second(args); + val args = second(first_spec); + val body = third(first_spec); + val name = first(args); + val params = second(args); if (rest(specline)) sem_error(spec_linenum, @@ -1476,10 +1476,10 @@ repeat_spec_same_data: goto repeat_spec_same_data; } else if (sym == try) { - obj_t *catch_syms = second(first_spec); - obj_t *try_clause = third(first_spec); - obj_t *catch_fin = fourth(first_spec); - obj_t *finally_clause = nil; + val catch_syms = second(first_spec); + val try_clause = third(first_spec); + val catch_fin = fourth(first_spec); + val finally_clause = nil; { uw_block_begin(nil, result); @@ -1493,31 +1493,31 @@ repeat_spec_same_data: uw_catch(exsym, exvals) { { - obj_t *iter; + val iter; for (iter = catch_fin; iter; iter = cdr(iter)) { - obj_t *clause = car(iter); - obj_t *type = first(second(clause)); - obj_t *params = second(second(clause)); - obj_t *body = third(clause); - obj_t *vals = if3(listp(exvals), - exvals, - cons(cons(t, exvals), nil)); + val clause = car(iter); + val type = first(second(clause)); + val params = second(second(clause)); + val body = third(clause); + val vals = if3(listp(exvals), + exvals, + cons(cons(t, exvals), nil)); if (first(clause) == catch) { if (uw_exception_subtype_p(exsym, type)) { - obj_t *all_bind = t; - obj_t *piter, *viter; + val all_bind = t; + val piter, viter; for (piter = params, viter = vals; piter && viter; piter = cdr(piter), viter = cdr(viter)) { - obj_t *param = car(piter); - obj_t *val = car(viter); + val param = car(piter); + val value = car(viter); - if (val) { - bindings = dest_bind(bindings, param, cdr(val)); + if (value) { + bindings = dest_bind(bindings, param, cdr(value)); if (bindings == t) { all_bind = nil; @@ -1552,7 +1552,7 @@ repeat_spec_same_data: } uw_unwind { - obj_t *iter; + val iter; /* result may be t, from catch above. */ if (consp(result)) { @@ -1571,7 +1571,7 @@ repeat_spec_same_data: if (!finally_clause) { for (iter = catch_fin; iter; iter = cdr(iter)) { - obj_t *clause = car(iter); + val clause = car(iter); if (first(clause) == finally) { finally_clause = third(clause); break; @@ -1608,7 +1608,7 @@ repeat_spec_same_data: goto repeat_spec_same_data; } } else if (sym == defex) { - obj_t *types = rest(first_spec); + val types = rest(first_spec); if (!all_satisfy(types, func_n1(symbolp), nil)) sem_error(spec_linenum, lit("defex arguments must all be symbols"), nao); @@ -1617,26 +1617,26 @@ repeat_spec_same_data: break; goto repeat_spec_same_data; } else if (sym == throw) { - obj_t *type = second(first_spec); - obj_t *args = rest(rest(first_spec)); + val type = second(first_spec); + val args = rest(rest(first_spec)); if (!symbolp(type)) sem_error(spec_linenum, lit("throw: ~a is not a type symbol"), first(first_spec), nao); { - obj_t *values = mapcar(bind2other(func_n2(eval_form), bindings), + val values = mapcar(bind2other(func_n2(eval_form), bindings), args); uw_throw(type, values); } } else { - obj_t *func = uw_get_func(sym); + val func = uw_get_func(sym); if (func) { - obj_t *args = rest(first_spec); - obj_t *params = car(func); - obj_t *ub_p_a_pairs = nil; - obj_t *body = cdr(func); - obj_t *piter, *aiter; - obj_t *bindings_cp = copy_alist(bindings); + val args = rest(first_spec); + val params = car(func); + val ub_p_a_pairs = nil; + val body = cdr(func); + val piter, aiter; + val bindings_cp = copy_alist(bindings); if (!equal(length(args), length(params))) sem_error(spec_linenum, lit("function ~a takes ~a argument(s)"), @@ -1645,11 +1645,11 @@ repeat_spec_same_data: for (piter = params, aiter = args; piter; piter = cdr(piter), aiter = cdr(aiter)) { - obj_t *param = car(piter); - obj_t *arg = car(aiter); + val param = car(piter); + val arg = car(aiter); if (arg && symbolp(arg)) { - obj_t *val = eval_form(arg, bindings); + val val = eval_form(arg, bindings); if (val) { bindings_cp = acons_new(bindings_cp, param, @@ -1659,7 +1659,7 @@ repeat_spec_same_data: ub_p_a_pairs = cons(cons(param, arg), ub_p_a_pairs); } } else { - obj_t *val = eval_form(arg, bindings); + val val = eval_form(arg, bindings); if (!val) sem_error(spec_linenum, lit("unbound variable in function argument form"), @@ -1689,7 +1689,7 @@ repeat_spec_same_data: cons_bind (param, arg, car(piter)); if (symbolp(arg)) { - obj_t *newbind = assoc(new_bindings, param); + val newbind = assoc(new_bindings, param); if (newbind) { bindings = dest_bind(bindings, arg, cdr(newbind)); if (bindings == t) { @@ -1749,7 +1749,7 @@ repeat_spec_same_data: return cons(bindings, if3(data, cons(data, num(data_lineno)), t)); } -int extract(obj_t *spec, obj_t *files, obj_t *predefined_bindings) +int extract(val spec, val files, val predefined_bindings) { cons_bind (bindings, success, match_files(spec, files, predefined_bindings, t, nil)); @@ -24,4 +24,4 @@ * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. */ -int extract(obj_t *spec, obj_t *filenames, obj_t *bindings); +int extract(val spec, val filenames, val bindings); @@ -27,10 +27,10 @@ #include <stdio.h> extern long lineno; extern int errors; -extern obj_t *yyin_stream; +extern val yyin_stream; extern const wchar_t *spec_file; -extern obj_t *spec_file_str; +extern val spec_file_str; int yyparse(void); -obj_t *get_spec(void); -void yyerrorf(obj_t *s, ...); +val get_spec(void); +void yyerrorf(val s, ...); void yybadtoken(int tok, const char *context); @@ -45,7 +45,7 @@ #define YY_INPUT(buf, result, max_size) \ do { \ - obj_t *c = nil; \ + val c = nil; \ int n, ch = '*'; \ for (n = 0; n < max_size && \ (c = get_byte(yyin_stream)) && \ @@ -56,7 +56,7 @@ result = n; \ } while (0) -obj_t *yyin_stream; +val yyin_stream; long lineno = 1; int opt_loglevel = 1; /* 0 - quiet; 1 - normal; 2 - verbose */ @@ -70,7 +70,7 @@ void yyerror(const char *s) yyerrorf(lit("~a"), string_utf8(s), nao); } -void yyerrorf(obj_t *fmt, ...) +void yyerrorf(val fmt, ...) { if (opt_loglevel >= 1) { va_list vl; @@ -86,7 +86,7 @@ void yyerrorf(obj_t *fmt, ...) void yybadtoken(int tok, const char *context) { - const obj_t *problem = nil; + val problem = nil; switch (tok) { case TEXT: problem = lit("text"); break; @@ -38,11 +38,11 @@ int yylex(void); void yyerror(const char *); -obj_t *repeat_rep_helper(obj_t *sym, obj_t *main, obj_t *parts); -obj_t *define_transform(obj_t *define_form); -obj_t *lit_char_helper(obj_t *litchars); +val repeat_rep_helper(val sym, val main, val parts); +val define_transform(val define_form); +val lit_char_helper(val litchars); -static obj_t *parsed_spec; +static val parsed_spec; %} @@ -524,18 +524,18 @@ litchars : LITCHAR { $$ = cons(chr($1), nil); } %% -obj_t *repeat_rep_helper(obj_t *sym, obj_t *main, obj_t *parts) +val repeat_rep_helper(val sym, val main, val parts) { - obj_t *single_parts = nil; - obj_t *first_parts = nil; - obj_t *last_parts = nil; - obj_t *empty_parts = nil; - obj_t *iter; + val single_parts = nil; + val first_parts = nil; + val last_parts = nil; + val empty_parts = nil; + val iter; for (iter = parts; iter != nil; iter = cdr(iter)) { - obj_t *part = car(iter); - obj_t *sym = car(part); - obj_t *clauses = cdr(part); + val part = car(iter); + val sym = car(part); + val clauses = cdr(part); if (sym == single) single_parts = nappend2(single_parts, clauses); @@ -553,10 +553,10 @@ obj_t *repeat_rep_helper(obj_t *sym, obj_t *main, obj_t *parts) last_parts, empty_parts, nao); } -obj_t *define_transform(obj_t *define_form) +val define_transform(val define_form) { - obj_t *sym = first(define_form); - obj_t *args = second(define_form); + val sym = first(define_form); + val args = second(define_form); if (define_form == nil) return nil; @@ -572,8 +572,8 @@ obj_t *define_transform(obj_t *define_form) yyerror("bad define argument syntax"); return define_form; } else { - obj_t *name = first(args); - obj_t *params = second(args); + val name = first(args); + val params = second(args); if (!symbolp(name)) { yyerror("function name must be a symbol"); @@ -592,12 +592,12 @@ obj_t *define_transform(obj_t *define_form) return define_form; } -obj_t *lit_char_helper(obj_t *litchars) +val lit_char_helper(val litchars) { - obj_t *ret = nil; + val ret = nil; if (litchars) { - obj_t *len = length(litchars), *iter, *ix; + val len = length(litchars), iter, ix; ret = mkustring(len); for (iter = litchars, ix = zero; iter; @@ -611,7 +611,7 @@ obj_t *lit_char_helper(obj_t *litchars) return ret; } -obj_t *get_spec(void) +val get_spec(void) { return parsed_spec; } @@ -550,19 +550,19 @@ nfa_t nfa_combine(nfa_t pred, nfa_t succ) return ret; } -nfa_t nfa_compile_set(obj_t *args, int compl) +nfa_t nfa_compile_set(val args, int compl) { - obj_t *iter; + val iter; wchar_t min = WCHAR_MAX; wchar_t max = 0; chset_type_t cst; for (iter = args; iter; iter = rest(iter)) { - obj_t *item = first(iter); + val item = first(iter); if (consp(item)) { - obj_t *from = car(item); - obj_t *to = cdr(item); + val from = car(item); + val to = cdr(item); assert (typeof(from) == chr_t && typeof(to) == chr_t); @@ -601,11 +601,11 @@ nfa_t nfa_compile_set(obj_t *args, int compl) nfa_t ret = nfa_make(s, acc); for (iter = args; iter; iter = rest(iter)) { - obj_t *item = first(iter); + val item = first(iter); if (consp(item)) { - obj_t *from = car(item); - obj_t *to = cdr(item); + val from = car(item); + val to = cdr(item); assert (typeof(from) == chr_t && typeof(to) == chr_t); char_set_add_range(set, c_chr(from), c_chr(to)); @@ -627,7 +627,7 @@ nfa_t nfa_compile_set(obj_t *args, int compl) * not including the regex symbol. * I.e. (rest '(regex ...)) not '(regex ...). */ -nfa_t nfa_compile_regex(obj_t *items) +nfa_t nfa_compile_regex(val items) { if (nullp(items)) { nfa_state_t *acc = nfa_state_accept(); @@ -635,7 +635,7 @@ nfa_t nfa_compile_regex(obj_t *items) nfa_t nfa = nfa_make(s, acc); return nfa; } else { - obj_t *item = first(items), *others = rest(items); + val item = first(items), others = rest(items); nfa_t nfa; if (typeof(item) == chr_t) { @@ -647,8 +647,8 @@ nfa_t nfa_compile_regex(obj_t *items) nfa_state_t *s = nfa_state_wild(acc); nfa = nfa_make(s, acc); } else if (consp(item)) { - obj_t *sym = first(item); - obj_t *args = rest(item); + val sym = first(item); + val args = rest(item); if (sym == set) { nfa = nfa_compile_set(args, 0); @@ -1035,12 +1035,12 @@ nfam_result_t nfa_machine_feed(nfa_machine_t *nfam, wchar_t ch) return NFAM_INCOMPLETE; } -static obj_t *regex_equal(obj_t *self, obj_t *other) +static val regex_equal(val self, val other) { return self == other ? t : nil; /* eq equality only */ } -static void regex_destroy(obj_t *regex) +static void regex_destroy(val regex) { nfa_t *pnfa = (nfa_t *) regex->co.handle; nfa_free(*pnfa); @@ -1052,26 +1052,26 @@ static struct cobj_ops regex_obj_ops = { regex_equal, cobj_print_op, regex_destroy, 0, 0 }; -obj_t *regex_compile(obj_t *regex_sexp) +val regex_compile(val regex_sexp) { nfa_t *pnfa = (nfa_t *) chk_malloc(sizeof *pnfa); *pnfa = nfa_compile_regex(regex_sexp); return cobj(pnfa, regex, ®ex_obj_ops); } -obj_t *regexp(obj_t *obj) +val regexp(val obj) { return (obj->co.type == COBJ && obj->co.cls == regex) ? t : nil; } -nfa_t *regex_nfa(obj_t *reg) +nfa_t *regex_nfa(val reg) { assert (reg->co.type == COBJ && reg->co.cls == regex); return (nfa_t *) reg->co.handle; } -obj_t *search_regex(obj_t *haystack, obj_t *needle_regex, obj_t *start, - obj_t *from_end) +val search_regex(val haystack, val needle_regex, val start, + val from_end) { nfa_t *pnfa = regex_nfa(needle_regex); @@ -1090,7 +1090,7 @@ obj_t *search_regex(obj_t *haystack, obj_t *needle_regex, obj_t *start, } } else { nfa_machine_t nfam; - obj_t *i, *pos = start, *retval; + val i, pos = start, retval; nfam_result_t last_res = NFAM_INCOMPLETE; nfa_machine_init(&nfam, *pnfa); @@ -1124,10 +1124,10 @@ again: } } -obj_t *match_regex(obj_t *str, obj_t *reg, obj_t *pos) +val match_regex(val str, val reg, val pos) { nfa_machine_t nfam; - obj_t *i, *retval; + val i, retval; nfam_result_t last_res = NFAM_INCOMPLETE; nfa_t *pnfa = regex_nfa(reg); @@ -153,7 +153,7 @@ typedef struct nfa_machine { nfa_t nfa; } nfa_machine_t; -nfa_t nfa_compile_regex(obj_t *regex); +nfa_t nfa_compile_regex(val regex); void nfa_free(nfa_t); long nfa_run(nfa_t nfa, const wchar_t *str); void nfa_machine_reset(nfa_machine_t *); @@ -161,9 +161,8 @@ void nfa_machine_init(nfa_machine_t *, nfa_t); void nfa_machine_cleanup(nfa_machine_t *); nfam_result_t nfa_machine_feed(nfa_machine_t *, wchar_t ch); long nfa_machine_match_span(nfa_machine_t *); -obj_t *regex_compile(obj_t *regex_sexp); -obj_t *regexp(obj_t *); -nfa_t *regex_nfa(obj_t *); -obj_t *search_regex(obj_t *haystack, obj_t *needle_regex, obj_t *start_num, - obj_t *from_end); -obj_t *match_regex(obj_t *str, obj_t *regex, obj_t *pos); +val regex_compile(val regex_sexp); +val regexp(val); +nfa_t *regex_nfa(val); +val search_regex(val haystack, val needle_regex, val start_num, val from_end); +val match_regex(val str, val regex, val pos); @@ -41,54 +41,54 @@ #include "stream.h" #include "utf8.h" -obj_t *std_input, *std_output, *std_error; +val std_input, std_output, std_error; struct strm_ops { struct cobj_ops cobj_ops; - obj_t *(*put_string)(obj_t *, obj_t *); - obj_t *(*put_char)(obj_t *, obj_t *); - obj_t *(*get_line)(obj_t *); - obj_t *(*get_char)(obj_t *); - obj_t *(*get_byte)(obj_t *); - obj_t *(*close)(obj_t *, obj_t *); + val (*put_string)(val, val); + val (*put_char)(val, val); + val (*get_line)(val); + val (*get_char)(val); + val (*get_byte)(val); + val (*close)(val, val); }; -static obj_t *common_equal(obj_t *self, obj_t *other) +static val common_equal(val self, val other) { return self == other ? t : nil; } -static void common_destroy(obj_t *obj) +static void common_destroy(val obj) { (void) close_stream(obj, nil); } struct stdio_handle { FILE *f; - obj_t *descr; + val descr; struct utf8_decoder ud; }; -void stdio_stream_print(obj_t *stream, obj_t *out) +void stdio_stream_print(val stream, val out) { struct stdio_handle *h = (struct stdio_handle *) stream->co.handle; format(out, lit("#<~s ~s>"), stream->co.cls, h->descr, nao); } -void stdio_stream_destroy(obj_t *stream) +void stdio_stream_destroy(val stream) { struct stdio_handle *h = (struct stdio_handle *) stream->co.handle; common_destroy(stream); free(h); } -void stdio_stream_mark(obj_t *stream) +void stdio_stream_mark(val stream) { struct stdio_handle *h = (struct stdio_handle *) stream->co.handle; gc_mark(h->descr); } -static obj_t *stdio_maybe_read_error(obj_t *stream) +static val stdio_maybe_read_error(val stream) { struct stdio_handle *h = (struct stdio_handle *) stream->co.handle; if (h->f == 0) @@ -101,7 +101,7 @@ static obj_t *stdio_maybe_read_error(obj_t *stream) return nil; } -static obj_t *stdio_maybe_write_error(obj_t *stream) +static val stdio_maybe_write_error(val stream) { struct stdio_handle *h = (struct stdio_handle *) stream->co.handle; if (h->f == 0) @@ -121,7 +121,7 @@ static int stdio_get_char_callback(void *f) return getc((FILE *) f); } -static obj_t *stdio_put_string(obj_t *stream, obj_t *str) +static val stdio_put_string(val stream, val str) { struct stdio_handle *h = (struct stdio_handle *) stream->co.handle; @@ -136,7 +136,7 @@ static obj_t *stdio_put_string(obj_t *stream, obj_t *str) return stdio_maybe_write_error(stream); } -static obj_t *stdio_put_char(obj_t *stream, obj_t *ch) +static val stdio_put_char(val stream, val ch) { struct stdio_handle *h = (struct stdio_handle *) stream->co.handle; return h->f != 0 && utf8_encode(c_chr(ch), stdio_put_char_callback, h->f) @@ -175,7 +175,7 @@ static wchar_t *snarf_line(struct stdio_handle *h) return buf; } -static obj_t *stdio_get_line(obj_t *stream) +static val stdio_get_line(val stream) { if (stream->co.handle == 0) { return stdio_maybe_read_error(stream); @@ -188,7 +188,7 @@ static obj_t *stdio_get_line(obj_t *stream) } } -obj_t *stdio_get_char(obj_t *stream) +val stdio_get_char(val stream) { struct stdio_handle *h = (struct stdio_handle *) stream->co.handle; if (h->f) { @@ -198,7 +198,7 @@ obj_t *stdio_get_char(obj_t *stream) return stdio_maybe_read_error(stream); } -obj_t *stdio_get_byte(obj_t *stream) +val stdio_get_byte(val stream) { struct stdio_handle *h = (struct stdio_handle *) stream->co.handle; if (h->f) { @@ -208,7 +208,7 @@ obj_t *stdio_get_byte(obj_t *stream) return stdio_maybe_read_error(stream); } -static obj_t *stdio_close(obj_t *stream, obj_t *throw_on_error) +static val stdio_close(val stream, val throw_on_error) { struct stdio_handle *h = (struct stdio_handle *) stream->co.handle; @@ -238,7 +238,7 @@ static struct strm_ops stdio_ops = { stdio_close }; -static obj_t *pipe_close(obj_t *stream, obj_t *throw_on_error) +static val pipe_close(val stream, val throw_on_error) { struct stdio_handle *h = (struct stdio_handle *) stream->co.handle; @@ -289,21 +289,21 @@ static struct strm_ops pipe_ops = { pipe_close }; -void string_in_stream_mark(obj_t *stream) +void string_in_stream_mark(val stream) { - obj_t *stuff = (obj_t *) stream->co.handle; + val stuff = (val) stream->co.handle; gc_mark(stuff); } -static obj_t *string_in_get_line(obj_t *stream) +static val string_in_get_line(val stream) { - obj_t *pair = (obj_t *) stream->co.handle; - obj_t *string = car(pair); - obj_t *pos = cdr(pair); + val pair = (val) stream->co.handle; + val string = car(pair); + val pos = cdr(pair); /* TODO: broken, should only scan to newline */ if (lt(pos, length(string))) { - obj_t *result = sub_str(string, pos, nil); + val result = sub_str(string, pos, nil); *cdr_l(pair) = length_str(string); return result; } @@ -311,11 +311,11 @@ static obj_t *string_in_get_line(obj_t *stream) return nil; } -static obj_t *string_in_get_char(obj_t *stream) +static val string_in_get_char(val stream) { - obj_t *pair = (obj_t *) stream->co.handle; - obj_t *string = car(pair); - obj_t *pos = cdr(pair); + val pair = (val) stream->co.handle; + val string = car(pair); + val pos = cdr(pair); if (lt(pos, length_str(string))) { *cdr_l(pair) = plus(pos, one); @@ -345,7 +345,7 @@ struct byte_input { size_t index; }; -static obj_t *byte_in_get_byte(obj_t *stream) +static val byte_in_get_byte(val stream) { struct byte_input *bi = (struct byte_input *) stream->co.handle; @@ -375,7 +375,7 @@ struct string_output { size_t fill; }; -static void string_out_stream_destroy(obj_t *stream) +static void string_out_stream_destroy(val stream) { struct string_output *so = (struct string_output *) stream->co.handle; @@ -387,7 +387,7 @@ static void string_out_stream_destroy(obj_t *stream) } } -static obj_t *string_out_put_string(obj_t *stream, obj_t *str) +static val string_out_put_string(val stream, val str) { struct string_output *so = (struct string_output *) stream->co.handle; @@ -416,7 +416,7 @@ static obj_t *string_out_put_string(obj_t *stream, obj_t *str) } } -static obj_t *string_out_put_char(obj_t *stream, obj_t *ch) +static val string_out_put_char(val stream, val ch) { wchar_t mini[2]; mini[0] = c_chr(ch); @@ -438,7 +438,7 @@ static struct strm_ops string_out_ops = { 0, }; -static obj_t *dir_get_line(obj_t *stream) +static val dir_get_line(val stream) { DIR *handle = (DIR *) stream->co.handle; @@ -456,7 +456,7 @@ static obj_t *dir_get_line(obj_t *stream) } } -static obj_t *dir_close(obj_t *stream, obj_t *throw_on_error) +static val dir_close(val stream, val throw_on_error) { if (stream->co.handle != 0) { closedir((DIR *) stream->co.handle); @@ -482,32 +482,32 @@ static struct strm_ops dir_ops = { }; -obj_t *make_stdio_stream(FILE *f, obj_t *descr, obj_t *input, obj_t *output) +val make_stdio_stream(FILE *f, val descr, val input, val output) { struct stdio_handle *h = (struct stdio_handle *) chk_malloc(sizeof *h); - obj_t *stream = cobj((void *) h, stream_t, &stdio_ops.cobj_ops); + val stream = cobj((void *) h, stream_t, &stdio_ops.cobj_ops); h->f = f; h->descr = descr; utf8_decoder_init(&h->ud); return stream; } -obj_t *make_pipe_stream(FILE *f, obj_t *descr, obj_t *input, obj_t *output) +val make_pipe_stream(FILE *f, val descr, val input, val output) { struct stdio_handle *h = (struct stdio_handle *) chk_malloc(sizeof *h); - obj_t *stream = cobj((void *) h, stream_t, &pipe_ops.cobj_ops); + val stream = cobj((void *) h, stream_t, &pipe_ops.cobj_ops); h->f = f; h->descr = descr; utf8_decoder_init(&h->ud); return stream; } -obj_t *make_string_input_stream(obj_t *string) +val make_string_input_stream(val string) { return cobj((void *) cons(string, zero), stream_t, &string_in_ops.cobj_ops); } -obj_t *make_string_byte_input_stream(obj_t *string) +val make_string_byte_input_stream(val string) { type_assert (stringp(string), (lit("~a is not a string"), string, nao)); @@ -521,7 +521,7 @@ obj_t *make_string_byte_input_stream(obj_t *string) } } -obj_t *make_string_output_stream(void) +val make_string_output_stream(void) { struct string_output *so = (struct string_output *) chk_malloc(sizeof *so); so->size = 128; @@ -531,7 +531,7 @@ obj_t *make_string_output_stream(void) return cobj((void *) so, stream_t, &string_out_ops.cobj_ops); } -obj_t *get_string_from_stream(obj_t *stream) +val get_string_from_stream(val stream) { type_check (stream, COBJ); type_assert (stream->co.cls == stream_t, @@ -539,7 +539,7 @@ obj_t *get_string_from_stream(obj_t *stream) if (stream->co.ops == &string_out_ops.cobj_ops) { struct string_output *so = (struct string_output *) stream->co.handle; - obj_t *out = nil; + val out = nil; stream->co.handle = 0; @@ -552,19 +552,19 @@ obj_t *get_string_from_stream(obj_t *stream) free(so); return out; } else if (stream->co.ops == &string_in_ops.cobj_ops) { - obj_t *pair = (obj_t *) stream->co.handle; + val pair = (val ) stream->co.handle; return pair ? car(pair) : nil; } else { abort(); /* not a string input or output stream */ } } -obj_t *make_dir_stream(DIR *dir) +val make_dir_stream(DIR *dir) { return cobj((void *) dir, stream_t, &dir_ops.cobj_ops); } -obj_t *close_stream(obj_t *stream, obj_t *throw_on_error) +val close_stream(val stream, val throw_on_error) { type_check (stream, COBJ); type_assert (stream->co.cls == stream_t, (lit("~a is not a stream"), @@ -576,7 +576,7 @@ obj_t *close_stream(obj_t *stream, obj_t *throw_on_error) } } -obj_t *get_line(obj_t *stream) +val get_line(val stream) { type_check (stream, COBJ); type_assert (stream->co.cls == stream_t, (lit("~a is not a stream"), @@ -588,7 +588,7 @@ obj_t *get_line(obj_t *stream) } } -obj_t *get_char(obj_t *stream) +val get_char(val stream) { type_check (stream, COBJ); type_assert (stream->co.cls == stream_t, (lit("~a is not a stream"), @@ -600,7 +600,7 @@ obj_t *get_char(obj_t *stream) } } -obj_t *get_byte(obj_t *stream) +val get_byte(val stream) { type_check (stream, COBJ); type_assert (stream->co.cls == stream_t, (lit("~a is not a stream"), @@ -612,8 +612,8 @@ obj_t *get_byte(obj_t *stream) } } -static obj_t *vformat_num(obj_t *stream, const char *str, - int width, int left, int pad, int precision) +static val vformat_num(val stream, const char *str, + int width, int left, int pad, int precision) { int len = strlen(str); int truewidth = (width < precision) ? width : precision; @@ -642,7 +642,7 @@ static obj_t *vformat_num(obj_t *stream, const char *str, return t; } -obj_t *vformat_str(obj_t *stream, obj_t *str, int width, int left, +val vformat_str(val stream, val str, int width, int left, int precision) { const wchar_t *cstr = c_str(str); @@ -668,7 +668,7 @@ obj_t *vformat_str(obj_t *stream, obj_t *str, int width, int left, return t; } -obj_t *vformat(obj_t *stream, obj_t *fmtstr, va_list vl) +val vformat(val stream, val fmtstr, va_list vl) { type_check (stream, COBJ); type_assert (stream->co.cls == stream_t, (lit("~a is not a stream"), @@ -681,12 +681,12 @@ obj_t *vformat(obj_t *stream, obj_t *fmtstr, va_list vl) } state = vf_init, saved_state = vf_init; int width = 0, precision = 0, digits = 0; int left = 0, zeropad = 0; - long val; + long value; void *ptr; char num_buf[64]; for (;;) { - obj_t *obj; + val obj; wchar_t ch = *fmt++; switch (state) { @@ -730,7 +730,7 @@ obj_t *vformat(obj_t *stream, obj_t *fmtstr, va_list vl) digits = ch - '0'; continue; case '*': - obj = va_arg(vl, obj_t *); + obj = va_arg(vl, val); width = c_num(obj); state = vf_precision; continue; @@ -749,7 +749,7 @@ obj_t *vformat(obj_t *stream, obj_t *fmtstr, va_list vl) digits = ch - '0'; continue; case '*': - obj = va_arg(vl, obj_t *); + obj = va_arg(vl, val); width = c_num(obj); precision = vf_precision; continue; @@ -791,27 +791,27 @@ obj_t *vformat(obj_t *stream, obj_t *fmtstr, va_list vl) state = vf_init; switch (ch) { case 'x': - obj = va_arg(vl, obj_t *); - val = c_num(obj); - sprintf(num_buf, "%lx", val); + obj = va_arg(vl, val); + value = c_num(obj); + sprintf(num_buf, "%lx", value); goto output_num; case 'X': - obj = va_arg(vl, obj_t *); - val = c_num(obj); - sprintf(num_buf, "%lX", val); + obj = va_arg(vl, val); + value = c_num(obj); + sprintf(num_buf, "%lX", value); goto output_num; case 'o': - obj = va_arg(vl, obj_t *); - val = c_num(obj); - sprintf(num_buf, "%lo", val); + obj = va_arg(vl, val); + value = c_num(obj); + sprintf(num_buf, "%lo", value); goto output_num; case 'a': - obj = va_arg(vl, obj_t *); + obj = va_arg(vl, val); if (obj == nao) goto premature; if (nump(obj)) { - val = c_num(obj); - sprintf(num_buf, "%ld", val); + value = c_num(obj); + sprintf(num_buf, "%ld", value); goto output_num; } else if (stringp(obj)) { if (!vformat_str(stream, obj, width, left, precision)) @@ -821,12 +821,12 @@ obj_t *vformat(obj_t *stream, obj_t *fmtstr, va_list vl) obj_pprint(obj, stream); continue; case 's': - obj = va_arg(vl, obj_t *); + obj = va_arg(vl, val); if (obj == nao) goto premature; if (nump(obj)) { - val = c_num(obj); - sprintf(num_buf, "%ld", val); + value = c_num(obj); + sprintf(num_buf, "%ld", value); if (vformat_num(stream, num_buf, 0, 0, 0, 0)) return nil; continue; @@ -835,8 +835,8 @@ obj_t *vformat(obj_t *stream, obj_t *fmtstr, va_list vl) continue; case 'p': ptr = va_arg(vl, void *); - val = (int) ptr; - sprintf(num_buf, "0x%lx", val); + value = (int) ptr; + sprintf(num_buf, "0x%lx", value); goto output_num; default: abort(); @@ -855,7 +855,7 @@ obj_t *vformat(obj_t *stream, obj_t *fmtstr, va_list vl) } - if (va_arg(vl, obj_t *) != nao) + if (va_arg(vl, val) != nao) internal_error("unterminated format argument list"); return t; premature: @@ -864,7 +864,7 @@ toobig: internal_error("ridiculous precision or field width in format"); } -obj_t *format(obj_t *stream, obj_t *str, ...) +val format(val stream, val str, ...) { type_check (stream, COBJ); type_assert (stream->co.cls == stream_t, (lit("~a is not a stream"), @@ -872,7 +872,7 @@ obj_t *format(obj_t *stream, obj_t *str, ...) { va_list vl; - obj_t *ret; + val ret; va_start (vl, str); ret = vformat(stream, str, vl); va_end (vl); @@ -880,7 +880,7 @@ obj_t *format(obj_t *stream, obj_t *str, ...) } } -obj_t *put_string(obj_t *stream, obj_t *string) +val put_string(val stream, val string) { type_check (stream, COBJ); type_assert (stream->co.cls == stream_t, (lit("~a is not a stream"), @@ -892,7 +892,7 @@ obj_t *put_string(obj_t *stream, obj_t *string) } } -obj_t *put_char(obj_t *stream, obj_t *ch) +val put_char(val stream, val ch) { type_check (stream, COBJ); type_assert (stream->co.cls == stream_t, (lit("~a is not a stream"), @@ -904,14 +904,14 @@ obj_t *put_char(obj_t *stream, obj_t *ch) } } -obj_t *put_line(obj_t *stream, obj_t *string) +val put_line(val stream, val string) { return (put_string(stream, string), put_char(stream, chr('\n'))); } void stream_init(void) { - protect(&std_input, &std_output, &std_error, (obj_t **) 0); + protect(&std_input, &std_output, &std_error, (val *) 0); std_input = make_stdio_stream(stdin, string(L"stdin"), t, nil); std_output = make_stdio_stream(stdout, string(L"stdout"), nil, t); std_error = make_stdio_stream(stderr, string(L"stderr"), nil, t); @@ -24,23 +24,23 @@ * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. */ -extern obj_t *std_input, *std_output, *std_error; +extern val std_input, std_output, std_error; -obj_t *make_stdio_stream(FILE *, obj_t *descr, obj_t *input, obj_t *output); -obj_t *make_pipe_stream(FILE *, obj_t *descr, obj_t *input, obj_t *output); -obj_t *make_string_input_stream(obj_t *); -obj_t *make_string_byte_input_stream(obj_t *); -obj_t *make_string_output_stream(void); -obj_t *get_string_from_stream(obj_t *); -obj_t *make_dir_stream(DIR *); -obj_t *close_stream(obj_t *stream, obj_t *throw_on_error); -obj_t *get_line(obj_t *); -obj_t *get_char(obj_t *); -obj_t *get_byte(obj_t *); -obj_t *vformat(obj_t *stream, obj_t *string, va_list); -obj_t *format(obj_t *stream, obj_t *string, ...); -obj_t *put_string(obj_t *stream, obj_t *string); -obj_t *put_line(obj_t *stream, obj_t *string); -obj_t *put_char(obj_t *stream, obj_t *ch); +val make_stdio_stream(FILE *, val descr, val input, val output); +val make_pipe_stream(FILE *, val descr, val input, val output); +val make_string_input_stream(val ); +val make_string_byte_input_stream(val ); +val make_string_output_stream(void); +val get_string_from_stream(val ); +val make_dir_stream(DIR *); +val close_stream(val stream, val throw_on_error); +val get_line(val); +val get_char(val); +val get_byte(val); +val vformat(val stream, val string, va_list); +val format(val stream, val string, ...); +val put_string(val stream, val string); +val put_line(val stream, val string); +val put_char(val stream, val ch); void stream_init(void); @@ -45,7 +45,7 @@ const wchar_t *version = L"024"; const wchar_t *progname = L"txr"; const wchar_t *spec_file = L"stdin"; -obj_t *spec_file_str; +val spec_file_str; /* * Can implement an emergency allocator here from a fixed storage @@ -61,7 +61,7 @@ void *oom_realloc_handler(void *old, size_t size) void help(void) { - obj_t *text = lit( + val text = lit( "\n" "txr version ~a\n" "\n" @@ -117,18 +117,18 @@ void hint(void) prog_string, nao); } -obj_t *remove_hash_bang_line(obj_t *spec) +val remove_hash_bang_line(val spec) { if (!consp(spec)) return spec; { - obj_t *shbang = string(L"#!"); - obj_t *firstline = first(spec); - obj_t *items = rest(firstline); + val shbang = string(L"#!"); + val firstline = first(spec); + val items = rest(firstline); if (stringp(first(items))) { - obj_t *twochars = sub_str(first(items), zero, two); + val twochars = sub_str(first(items), zero, two); if (equal(twochars, shbang)) return rest(spec); } @@ -141,7 +141,7 @@ static int txr_main(int argc, char **argv); int main(int argc, char **argv) { - obj_t *stack_bottom = nil; + val stack_bottom = nil; progname = argv[0] ? utf8_dup_from(argv[0]) : progname; init(progname, oom_realloc_handler, &stack_bottom); return txr_main(argc, argv); @@ -149,9 +149,9 @@ int main(int argc, char **argv) static int txr_main(int argc, char **argv) { - obj_t *specstring = nil; - obj_t *spec = nil; - obj_t *bindings = nil; + val specstring = nil; + val spec = nil; + val bindings = nil; int match_loglevel = opt_loglevel; prot1(&spec_file_str); @@ -181,31 +181,31 @@ static int txr_main(int argc, char **argv) char *has_comma = (equals != 0) ? strchr(equals, ',') : 0; if (has_comma) { - char *val = equals + 1; - obj_t *list = nil; + char *pval = equals + 1; + val list = nil; *equals = 0; for (;;) { - size_t piece = strcspn(val, ","); - char comma_p = val[piece]; + size_t piece = strcspn(pval, ","); + char comma_p = pval[piece]; - val[piece] = 0; + pval[piece] = 0; - list = cons(string_utf8(val), list); + list = cons(string_utf8(pval), list); if (!comma_p) break; - val += piece + 1; + pval += piece + 1; } list = nreverse(list); bindings = cons(cons(intern(string_utf8(var)), list), bindings); } else if (equals) { - char *val = equals + 1; + char *pval = equals + 1; *equals = 0; - bindings = cons(cons(intern(string_utf8(var)), string_utf8(val)), bindings); + bindings = cons(cons(intern(string_utf8(var)), string_utf8(pval)), bindings); } else { bindings = cons(cons(intern(string_utf8(var)), null_string), bindings); } @@ -226,7 +226,7 @@ static int txr_main(int argc, char **argv) } if (!strcmp(*argv, "-a") || !strcmp(*argv, "-c") || !strcmp(*argv, "-f")) { - long val; + long optval; char *errp; char opt = (*argv)[1]; @@ -241,7 +241,7 @@ static int txr_main(int argc, char **argv) switch (opt) { case 'a': - val = strtol(*argv, &errp, 10); + optval = strtol(*argv, &errp, 10); if (*errp != 0) { format(std_error, lit("~a: option -~a needs numeric argument, " "not ~a\n"), prog_string, chr(opt), @@ -249,7 +249,7 @@ static int txr_main(int argc, char **argv) return EXIT_FAILURE; } - opt_arraydims = val; + opt_arraydims = optval; break; case 'c': specstring = string_utf8(*argv); @@ -333,7 +333,7 @@ static int txr_main(int argc, char **argv) if (strcmp(*argv, "-") != 0) { FILE *in = fopen(*argv, "r"); - obj_t *name = string_utf8(*argv); + val name = string_utf8(*argv); if (in == 0) uw_throwf(file_error, lit("unable to open ~a"), name, nao); yyin_stream = make_stdio_stream(in, name, t, nil); @@ -99,7 +99,7 @@ static void uw_unwind_to_exit_point() } } -void uw_push_block(uw_frame_t *fr, obj_t *tag) +void uw_push_block(uw_frame_t *fr, val tag) { fr->bl.type = UW_BLOCK; fr->bl.tag = tag; @@ -135,13 +135,13 @@ void uw_push_env(uw_frame_t *fr) uw_stack = fr; } -obj_t *uw_get_func(obj_t *sym) +val uw_get_func(val sym) { uw_frame_t *env = uw_find_env(); return cdr(assoc(env->ev.func_bindings, sym)); } -obj_t *uw_set_func(obj_t *sym, obj_t *value) +val uw_set_func(val sym, val value) { uw_frame_t *env = uw_find_env(); env->ev.func_bindings = acons_new(env->ev.func_bindings, sym, value); @@ -154,7 +154,7 @@ void uw_pop_frame(uw_frame_t *fr) uw_stack = uw_stack->uw.up; } -obj_t *uw_block_return(obj_t *tag, obj_t *result) +val uw_block_return(val tag, val result) { uw_frame_t *ex; @@ -172,7 +172,7 @@ obj_t *uw_block_return(obj_t *tag, obj_t *result) abort(); } -void uw_push_catch(uw_frame_t *fr, obj_t *matches) +void uw_push_catch(uw_frame_t *fr, val matches) { fr->ca.type = UW_CATCH; fr->ca.matches = matches; @@ -183,19 +183,19 @@ void uw_push_catch(uw_frame_t *fr, obj_t *matches) uw_stack = fr; } -static obj_t *exception_subtypes; +static val exception_subtypes; -obj_t *uw_exception_subtype_p(obj_t *sub, obj_t *sup) +val uw_exception_subtype_p(val sub, val sup) { if (sub == nil || sup == t || sub == sup) { return t; } else { - obj_t *entry = assoc(exception_subtypes, sub); + val entry = assoc(exception_subtypes, sub); return memq(sup, entry) ? t : nil; } } -obj_t *uw_throw(obj_t *sym, obj_t *exception) +val uw_throw(val sym, val exception) { uw_frame_t *ex; @@ -204,8 +204,8 @@ obj_t *uw_throw(obj_t *sym, obj_t *exception) /* The some_satisfy would require us to cons up a function; we want to avoid consing in exception handling, if we can. */ - obj_t *matches = ex->ca.matches; - obj_t *match; + val matches = ex->ca.matches; + val match; for (match = matches; match; match = cdr(match)) if (uw_exception_subtype_p(sym, car(match))) break; @@ -216,7 +216,7 @@ obj_t *uw_throw(obj_t *sym, obj_t *exception) if (ex == 0) { if (opt_loglevel >= 1) { - obj_t *s = stringp(exception); + val s = stringp(exception); format(std_error, lit("~a: unhandled exception of type ~a:\n"), prog_string, sym, nao); format(std_error, s ? lit("~a: ~a\n") : lit("~a: ~s\n"), @@ -238,10 +238,10 @@ obj_t *uw_throw(obj_t *sym, obj_t *exception) abort(); } -obj_t *uw_throwf(obj_t *sym, obj_t *fmt, ...) +val uw_throwf(val sym, val fmt, ...) { va_list vl; - obj_t *stream = make_string_output_stream(); + val stream = make_string_output_stream(); va_start (vl, fmt); (void) vformat(stream, fmt, vl); @@ -251,10 +251,10 @@ obj_t *uw_throwf(obj_t *sym, obj_t *fmt, ...) abort(); } -obj_t *uw_errorf(obj_t *fmt, ...) +val uw_errorf(val fmt, ...) { va_list vl; - obj_t *stream = make_string_output_stream(); + val stream = make_string_output_stream(); va_start (vl, fmt); (void) vformat(stream, fmt, vl); @@ -264,10 +264,10 @@ obj_t *uw_errorf(obj_t *fmt, ...) abort(); } -obj_t *type_mismatch(obj_t *fmt, ...) +val type_mismatch(val fmt, ...) { va_list vl; - obj_t *stream = make_string_output_stream(); + val stream = make_string_output_stream(); va_start (vl, fmt); (void) vformat(stream, fmt, vl); @@ -277,11 +277,11 @@ obj_t *type_mismatch(obj_t *fmt, ...) abort(); } -obj_t *uw_register_subtype(obj_t *sub, obj_t *sup) +val uw_register_subtype(val sub, val sup) { - obj_t *t_entry = assoc(exception_subtypes, t); - obj_t *sub_entry = assoc(exception_subtypes, sub); - obj_t *sup_entry = assoc(exception_subtypes, sup); + val t_entry = assoc(exception_subtypes, t); + val sub_entry = assoc(exception_subtypes, sub); + val sup_entry = assoc(exception_subtypes, sup); assert (t_entry != 0); @@ -335,7 +335,7 @@ void uw_continue(uw_frame_t *current, uw_frame_t *cont) void uw_init(void) { - protect(&toplevel_env.ev.func_bindings, &exception_subtypes, (obj_t **) 0); + protect(&toplevel_env.ev.func_bindings, &exception_subtypes, (val *) 0); exception_subtypes = cons(cons(t, nil), exception_subtypes); uw_register_subtype(type_error, error); uw_register_subtype(internal_err, error); @@ -41,23 +41,23 @@ struct uw_common { struct uw_block { uw_frame_t *up; uw_frtype_t type; - obj_t *tag; - obj_t *result; + val tag; + val result; jmp_buf jb; }; struct uw_dynamic_env { uw_frame_t *up; uw_frtype_t type; - obj_t *func_bindings; + val func_bindings; }; struct uw_catch { uw_frame_t *up; uw_frtype_t type; - obj_t *matches; - obj_t *sym; - obj_t *exception; + val matches; + val sym; + val exception; uw_frame_t *cont; int visible; jmp_buf jb; @@ -70,22 +70,22 @@ union uw_frame { struct uw_catch ca; }; -void uw_push_block(uw_frame_t *, obj_t *tag); +void uw_push_block(uw_frame_t *, val tag); void uw_push_env(uw_frame_t *); -obj_t *uw_get_func(obj_t *sym); -obj_t *uw_set_func(obj_t *sym, obj_t *value); -obj_t *uw_block_return(obj_t *tag, obj_t *result); -void uw_push_catch(uw_frame_t *, obj_t *matches); -noreturn obj_t *uw_throw(obj_t *sym, obj_t *exception); -noreturn obj_t *uw_throwf(obj_t *sym, obj_t *fmt, ...); -noreturn obj_t *uw_errorf(obj_t *fmt, ...); -obj_t *uw_register_subtype(obj_t *sub, obj_t *super); -obj_t *uw_exception_subtype_p(obj_t *sub, obj_t *sup); +val uw_get_func(val sym); +val uw_set_func(val sym, val value); +val uw_block_return(val tag, val result); +void uw_push_catch(uw_frame_t *, val matches); +noreturn val uw_throw(val sym, val exception); +noreturn val uw_throwf(val sym, val fmt, ...); +noreturn val uw_errorf(val fmt, ...); +val uw_register_subtype(val sub, val super); +val uw_exception_subtype_p(val sub, val sup); void uw_continue(uw_frame_t *curr, uw_frame_t *target); void uw_pop_frame(uw_frame_t *); void uw_init(void); -noreturn obj_t *type_mismatch(obj_t *, ...); +noreturn val type_mismatch(val, ...); #define uw_block_begin(TAG, RESULTVAR) \ obj_t *RESULTVAR = nil; \ |