summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog24
-rw-r--r--eval.c19
-rw-r--r--hash.c8
-rw-r--r--lib.c14
-rw-r--r--lib.h4
-rw-r--r--match.c78
-rw-r--r--txr.126
-rw-r--r--unwind.c10
8 files changed, 124 insertions, 59 deletions
diff --git a/ChangeLog b/ChangeLog
index f8aaf0d2..6042d04b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,29 @@
2011-12-07 Kaz Kylheku <kaz@kylheku.com>
+ * eval.c (lookup_var, lookup_fun): Reversing assoc arguments.
+ (eval_init): New intrinsics.
+
+ * hash.c (struct_hash): assoc_fun parameters reversed.
+ (gethash, gethash_f, gethash_n): Likewise.
+
+ * lib.c (assoc, assq): Reversing parameters.
+ (find_package, acons_new, acons_new_l, aconsq_new): Reversing
+ arguments to assoc adn assq.
+
+ * lib.h (assoc, assq): Declarations updated.
+
+ * match.c (dest_set, dest_bind, h_var, h_coll, h_parallel, h_fun,
+ subst_vars, do_txeval, v_next, v_parallel, v_gather, v_collect,
+ v_flatten, v_cat, v_output, v_filter, f_fun, match_funcall):
+ Reversing arguments to assoc.
+
+ * unwind.c (uw_get_func, uw_exception_subtype_p, uw_register_subtype):
+ Reversing arguments to assoc.
+
+ * txr.1: Blank sections created for new functions.
+
+2011-12-07 Kaz Kylheku <kaz@kylheku.com>
+
* txr.1: Blank sections created for character functions.
2011-12-07 Kaz Kylheku <kaz@kylheku.com>
diff --git a/eval.c b/eval.c
index 2f03b91f..7ecb4ec7 100644
--- a/eval.c
+++ b/eval.c
@@ -109,7 +109,7 @@ val lookup_var(val env, val sym)
type_check(env, ENV);
{
- val binding = assoc(env->e.vbindings, sym);
+ val binding = assoc(sym, env->e.vbindings);
if (binding)
return binding;
return lookup_var(env->e.up_env, sym);
@@ -125,7 +125,7 @@ val lookup_fun(val env, val sym)
type_check(env, ENV);
{
- val binding = assoc(env->e.fbindings, sym);
+ val binding = assoc(sym, env->e.fbindings);
if (binding)
return binding;
return lookup_fun(env->e.up_env, sym);
@@ -1215,6 +1215,21 @@ void eval_init(void)
reg_fun(intern(lit("length-vec"), user_package), func_n1(length_vec));
reg_fun(intern(lit("size-vec"), user_package), func_n1(size_vec));
reg_fun(intern(lit("vector-list"), user_package), func_n1(vector_list));
+
+ reg_fun(intern(lit("assoc"), user_package), func_n2(assoc));
+ reg_fun(intern(lit("assq"), user_package), func_n2(assq));
+ reg_fun(intern(lit("acons"), user_package), func_n3(acons));
+ reg_fun(intern(lit("acons-new"), user_package), func_n3(acons_new));
+ reg_fun(intern(lit("aconsq-new"), user_package), func_n3(aconsq_new));
+ reg_fun(intern(lit("alist-remove"), user_package), func_n1v(alist_remove));
+ reg_fun(intern(lit("alist-nremove"), user_package), func_n1v(alist_nremove));
+ reg_fun(intern(lit("copy-cons"), user_package), func_n1(copy_cons));
+ reg_fun(intern(lit("copy-alist"), user_package), func_n1(copy_alist));
+ reg_fun(intern(lit("merge"), user_package), func_n4(merge));
+ reg_fun(intern(lit("sort"), user_package), func_n3(sort));
+ reg_fun(intern(lit("find"), user_package), func_n4(find));
+ reg_fun(intern(lit("set-diff"), user_package), func_n4(set_diff));
+
reg_fun(intern(lit("length"), user_package), func_n1(length));
eval_error_s = intern(lit("eval-error"), user_package);
diff --git a/hash.c b/hash.c
index c2dee744..495cc0e3 100644
--- a/hash.c
+++ b/hash.c
@@ -53,7 +53,7 @@ struct hash {
cnum count;
val userdata;
cnum (*hash_fun)(val);
- val (*assoc_fun)(val list, val key);
+ val (*assoc_fun)(val key, val list);
val *(*acons_new_l_fun)(val key, val *new_p, val *list);
};
@@ -282,7 +282,7 @@ val gethash(val hash, val key)
{
struct hash *h = (struct hash *) cobj_handle(hash, hash_s);
val chain = *vecref_l(h->table, num(h->hash_fun(key) % h->modulus));
- val found = h->assoc_fun(chain, key);
+ val found = h->assoc_fun(key, chain);
return cdr(found);
}
@@ -290,7 +290,7 @@ val gethash_f(val hash, val key, val *found)
{
struct hash *h = (struct hash *) cobj_handle(hash, hash_s);
val chain = *vecref_l(h->table, num(h->hash_fun(key) % h->modulus));
- *found = h->assoc_fun(chain, key);
+ *found = h->assoc_fun(key, chain);
return cdr(*found);
}
@@ -298,7 +298,7 @@ val gethash_n(val hash, val key, val notfound_val)
{
struct hash *h = (struct hash *) cobj_handle(hash, hash_s);
val chain = *vecref_l(h->table, num(h->hash_fun(key) % h->modulus));
- val existing = h->assoc_fun(chain, key);
+ val existing = h->assoc_fun(key, chain);
return if3(existing, cdr(existing), notfound_val);
}
diff --git a/lib.c b/lib.c
index 21e068cc..be23f012 100644
--- a/lib.c
+++ b/lib.c
@@ -1632,7 +1632,7 @@ val make_package(val name)
val find_package(val name)
{
- return cdr(assoc(packages, name));
+ return cdr(assoc(name, packages));
}
val intern(val str, val package)
@@ -2668,7 +2668,7 @@ mem_t *cptr_get(val cptr)
return cobj_handle(cptr, cptr_s);
}
-val assoc(val list, val key)
+val assoc(val key, val list)
{
while (list) {
val elem = car(list);
@@ -2680,7 +2680,7 @@ val assoc(val list, val key)
return nil;
}
-val assq(val list, val key)
+val assq(val key, val list)
{
while (list) {
val elem = car(list);
@@ -2699,7 +2699,7 @@ val acons(val car, val cdr, val list)
val acons_new(val key, val value, val list)
{
- val existing = assoc(list, key);
+ val existing = assoc(key, list);
if (existing) {
*cdr_l(existing) = value;
@@ -2711,7 +2711,7 @@ val acons_new(val key, val value, val list)
val *acons_new_l(val key, val *new_p, val *list)
{
- val existing = assoc(*list, key);
+ val existing = assoc(key, *list);
if (existing) {
if (new_p)
@@ -2728,7 +2728,7 @@ val *acons_new_l(val key, val *new_p, val *list)
val aconsq_new(val key, val value, val list)
{
- val existing = assq(list, key);
+ val existing = assq(key, list);
if (existing) {
*cdr_l(existing) = value;
@@ -2740,7 +2740,7 @@ val aconsq_new(val key, val value, val list)
val *aconsq_new_l(val key, val *new_p, val *list)
{
- val existing = assq(*list, key);
+ val existing = assq(key, *list);
if (existing) {
if (new_p)
diff --git a/lib.h b/lib.h
index b5e1a15f..aa3f9567 100644
--- a/lib.h
+++ b/lib.h
@@ -487,8 +487,8 @@ val cobjp(val obj);
mem_t *cobj_handle(val cobj, val cls_sym);
val cptr(mem_t *ptr);
mem_t *cptr_get(val cptr);
-val assoc(val list, val key);
-val assq(val list, val key);
+val assoc(val key, val list);
+val assq(val key, val list);
val acons(val car, val cdr, val list);
val acons_new(val key, val value, val list);
val *acons_new_l(val key, val *new_p, val *list);
diff --git a/match.c b/match.c
index 3071844b..b39bb514 100644
--- a/match.c
+++ b/match.c
@@ -230,7 +230,7 @@ static val weird_merge(val left, val right)
static val dest_set(val spec, val bindings, val pattern, val value)
{
if (symbolp(pattern)) {
- val existing = assoc(bindings, pattern);
+ val existing = assoc(pattern, bindings);
if (!bindable(pattern))
sem_error(spec, lit("~s cannot be used as a variable"), pattern, nao);
if (!existing)
@@ -263,7 +263,7 @@ static val dest_bind(val spec, val bindings, val pattern,
{
if (symbolp(pattern)) {
if (bindable(pattern)) {
- val existing = assoc(bindings, pattern);
+ val existing = assoc(pattern, bindings);
if (existing) {
if (tree_find(value, cdr(existing), swap_12_21(testfun)))
return bindings;
@@ -445,7 +445,7 @@ static val h_var(match_line_ctx c, match_line_ctx *cout)
val pat = third(elem);
val modifiers = fourth(elem);
val modifier = first(modifiers);
- val pair = assoc(c.bindings, sym); /* var exists already? */
+ val pair = assoc(sym, c.bindings); /* var exists already? */
if (gt(length_list(modifiers), one)) {
sem_error(elem, lit("multiple modifiers on variable ~s"),
@@ -554,7 +554,7 @@ static val h_var(match_line_ctx c, match_line_ctx *cout)
val next_pat = third(pat);
val next_modifiers = fourth(pat);
val next_modifier = first(fourth(pat));
- val pair = assoc(c.bindings, second_sym); /* var exists already? */
+ val pair = assoc(second_sym, c.bindings); /* var exists already? */
if (gt(length_list(next_modifiers), one)) {
sem_error(elem, lit("multiple modifiers on variable ~s"),
@@ -761,7 +761,7 @@ static val h_coll(match_line_ctx c, match_line_ctx *cout)
for (iter = vars; iter; iter = cdr(iter)) {
cons_bind (var, dfl, car(iter));
- val exists = assoc(new_bindings, var);
+ val exists = assoc(var, new_bindings);
if (!exists) {
if (dfl == noval_s)
@@ -778,10 +778,10 @@ static val h_coll(match_line_ctx c, match_line_ctx *cout)
for (iter = strictly_new_bindings; iter; iter = cdr(iter))
{
val binding = car(iter);
- val vars_binding = assoc(vars, car(binding));
+ val vars_binding = assoc(car(binding), vars);
if (!have_vars || vars_binding) {
- val existing = assoc(bindings_coll, car(binding));
+ val existing = assoc(car(binding), bindings_coll);
bindings_coll = acons_new(car(binding),
cons(cdr(binding), cdr(existing)),
bindings_coll);
@@ -838,7 +838,7 @@ next_coll:
if (!bindings_coll && vars) {
for (iter = vars; iter; iter = cdr(iter)) {
val sym = car(car(iter));
- val exists = assoc(c.bindings, sym);
+ val exists = assoc(sym, c.bindings);
if (!exists)
c.bindings = acons(sym, nil, c.bindings);
}
@@ -877,7 +877,7 @@ static val h_parallel(match_line_ctx c, match_line_ctx *cout)
if (resolve) {
for (iter = resolve; iter; iter = cdr(iter)) {
val var = car(iter);
- if (!assoc(c.bindings, var))
+ if (!assoc(var, c.bindings))
push(var, &resolve_ub_vars);
}
}
@@ -894,7 +894,7 @@ static val h_parallel(match_line_ctx c, match_line_ctx *cout)
val uiter;
for (uiter = resolve_ub_vars; uiter; uiter = cdr(uiter)) {
val ubvar = car(uiter);
- val exists = assoc(new_bindings, ubvar);
+ val exists = assoc(ubvar, new_bindings);
if (exists)
resolve_bindings = acons_new(ubvar, cdr(exists), resolve_bindings);
@@ -907,7 +907,7 @@ static val h_parallel(match_line_ctx c, match_line_ctx *cout)
max_pos = new_pos;
if (directive == choose_s) {
- val binding = choose_sym ? assoc(new_bindings, choose_sym) : nil;
+ val binding = choose_sym ? assoc(choose_sym, new_bindings) : nil;
val value = cdr(binding);
if (value) {
@@ -1005,7 +1005,7 @@ static val h_fun(match_line_ctx c, match_line_ctx *cout)
val arg = car(aiter);
if (arg && bindable(arg)) {
- val val = assoc(c.bindings, arg);
+ val val = assoc(arg, c.bindings);
if (val) {
bindings_cp = acons_new(param, cdr(val), bindings_cp);
} else {
@@ -1042,7 +1042,7 @@ static val h_fun(match_line_ctx c, match_line_ctx *cout)
cons_bind (param, arg, car(piter));
if (symbolp(arg)) {
- val newbind = assoc(new_bindings, param);
+ val newbind = assoc(param, new_bindings);
if (newbind) {
c.bindings = dest_bind(elem, c.bindings,
arg, cdr(newbind), equal_f);
@@ -1275,7 +1275,7 @@ static val subst_vars(val spec, val bindings, val filter)
val sym = second(elem);
val pat = third(elem);
val modifiers = fourth(elem);
- val pair = assoc(bindings, sym);
+ val pair = assoc(sym, bindings);
if (pair) {
val str = cdr(pair);
@@ -1329,7 +1329,7 @@ static val do_txeval(val spec, val form, val bindings, val allow_unbound)
if (!form) {
ret = form;
} else if (bindable(form)) {
- val binding = assoc(bindings, form);
+ val binding = assoc(form, bindings);
if (!binding) {
if (allow_unbound)
ret = noval_s;
@@ -1940,10 +1940,10 @@ static val v_next(match_files_ctx *c)
{
val alist = improper_plist_to_alist(args, list(nothrow_k, nao));
- val from_var = cdr(assoc(alist, var_k));
- val list_expr = cdr(assoc(alist, list_k));
- val string_expr = cdr(assoc(alist, string_k));
- val nothrow = cdr(assoc(alist, nothrow_k));
+ val from_var = cdr(assoc(var_k, alist));
+ val list_expr = cdr(assoc(list_k, alist));
+ val string_expr = cdr(assoc(string_k, alist));
+ val nothrow = cdr(assoc(nothrow_k, alist));
val str = txeval(specline, source, c->bindings);
if (!from_var && !source && !string_expr && !list_expr)
@@ -1956,7 +1956,7 @@ static val v_next(match_files_ctx *c)
}
if (from_var) {
- val existing = assoc(c->bindings, from_var);
+ val existing = assoc(from_var, c->bindings);
if (!symbolp(from_var))
sem_error(specline, lit(":var requires a variable, not ~s"), from_var, nao);
@@ -2075,7 +2075,7 @@ static val v_parallel(match_files_ctx *c)
if (resolve) {
for (iter = resolve; iter; iter = cdr(iter)) {
val var = car(iter);
- if (!assoc(c->bindings, var))
+ if (!assoc(var, c->bindings))
push(var, &resolve_ub_vars);
}
}
@@ -2093,7 +2093,7 @@ static val v_parallel(match_files_ctx *c)
val uiter;
for (uiter = resolve_ub_vars; uiter; uiter = cdr(uiter)) {
val ubvar = car(uiter);
- val exists = assoc(new_bindings, ubvar);
+ val exists = assoc(ubvar, new_bindings);
if (exists)
resolve_bindings = acons_new(ubvar, cdr(exists), resolve_bindings);
@@ -2103,7 +2103,7 @@ static val v_parallel(match_files_ctx *c)
}
if (sym == choose_s) {
- val binding = choose_sym ? assoc(new_bindings, choose_sym) : nil;
+ val binding = choose_sym ? assoc(choose_sym, new_bindings) : nil;
val value = cdr(binding);
if (value) {
@@ -2244,7 +2244,7 @@ static val v_gather(match_files_ctx *c)
for (iter = vars; iter != nil; iter = cdr(iter)) {
cons_bind (var, dfl_val, car(iter));
- if (!assoc(c->bindings, var)) {
+ if (!assoc(var, c->bindings)) {
if (dfl_val == noval_s) {
debuglf(specline, lit("gather failed to match some required vars"), nao);
return nil;
@@ -2358,7 +2358,7 @@ static val v_collect(match_files_ctx *c)
for (iter = vars; iter; iter = cdr(iter)) {
cons_bind (var, dfl, car(iter));
- val exists = assoc(new_bindings, var);
+ val exists = assoc(var, new_bindings);
if (!exists) {
if (dfl == noval_s)
@@ -2375,10 +2375,10 @@ static val v_collect(match_files_ctx *c)
for (iter = strictly_new_bindings; iter; iter = cdr(iter))
{
val binding = car(iter);
- val vars_binding = assoc(vars, car(binding));
+ val vars_binding = assoc(car(binding), vars);
if (!have_vars || vars_binding) {
- val existing = assoc(bindings_coll, car(binding));
+ val existing = assoc(car(binding), bindings_coll);
bindings_coll = acons_new(car(binding), cons(cdr(binding), cdr(existing)), bindings_coll);
}
@@ -2458,7 +2458,7 @@ next_collect:
if (!bindings_coll && vars) {
for (iter = vars; iter; iter = cdr(iter)) {
val sym = car(car(iter));
- val exists = assoc(c->bindings, sym);
+ val exists = assoc(sym, c->bindings);
if (!exists)
c->bindings = acons(sym, nil, c->bindings);
}
@@ -2479,7 +2479,7 @@ static val v_flatten(match_files_ctx *c)
sem_error(specline,
lit("flatten: ~s is not a bindable symbol"), sym, nao);
} else {
- val existing = assoc(c->bindings, sym);
+ val existing = assoc(sym, c->bindings);
if (existing)
*cdr_l(existing) = flatten(cdr(existing));
@@ -2624,7 +2624,7 @@ static val v_cat(match_files_ctx *c)
if (!bindable(sym)) {
sem_error(specline, lit("cat: ~s is not a bindable symbol"), sym, nao);
} else {
- val existing = assoc(c->bindings, sym);
+ val existing = assoc(sym, c->bindings);
if (existing) {
val sep = if3(sep_form, txeval(specline, sep_form, c->bindings),
lit(" "));
@@ -2662,11 +2662,11 @@ static val v_output(match_files_ctx *c)
alist = improper_plist_to_alist(dest_spec, list(nothrow_k, append_k, nao));
- nothrow = cdr(assoc(alist, nothrow_k));
- append = cdr(assoc(alist, append_k));
+ nothrow = cdr(assoc(nothrow_k, alist));
+ append = cdr(assoc(append_k, alist));
{
- val filter_sym = cdr(assoc(alist, filter_k));
+ val filter_sym = cdr(assoc(filter_k, alist));
if (filter_sym) {
filter = get_filter(filter_sym);
@@ -2677,7 +2677,7 @@ static val v_output(match_files_ctx *c)
}
{
- val into_var = cdr(assoc(alist, into_k));
+ val into_var = cdr(assoc(into_k, alist));
if (into_var) {
val stream = make_strlist_output_stream();
@@ -2692,7 +2692,7 @@ static val v_output(match_files_ctx *c)
uw_env_end;
{
- val existing = assoc(c->bindings, into_var);
+ val existing = assoc(into_var, c->bindings);
val list_out = get_list_from_stream(stream);
if (existing) {
@@ -2984,7 +2984,7 @@ static val v_filter(match_files_ctx *c)
for (; vars; vars = cdr(vars)) {
val var = car(vars);
- val existing = assoc(c->bindings, var);
+ val existing = assoc(var, c->bindings);
if (!bindable(var))
sem_error(specline, lit("filter: ~a is not a variable name"),
@@ -3036,7 +3036,7 @@ static val v_fun(match_files_ctx *c)
val arg = car(aiter);
if (arg && bindable(arg)) {
- val val = assoc(c->bindings, arg);
+ val val = assoc(arg, c->bindings);
if (val) {
bindings_cp = acons_new(param, cdr(val), bindings_cp);
} else {
@@ -3072,7 +3072,7 @@ static val v_fun(match_files_ctx *c)
cons_bind (param, arg, car(piter));
if (symbolp(arg)) {
- val newbind = assoc(new_bindings, param);
+ val newbind = assoc(param, new_bindings);
if (newbind) {
c->bindings = dest_bind(specline, c->bindings,
arg, cdr(newbind), equal_f);
@@ -3258,7 +3258,7 @@ val match_funcall(val name, val arg, val other_args)
sem_error(specline, lit("filter: function ~s not found"), name, nao);
{
- val out = assoc(c.bindings, out_arg_sym);
+ val out = assoc(out_arg_sym, c.bindings);
if (!out)
sem_error(specline,
lit("filter: (~s ~s ~s) did not bind ~s"), name,
diff --git a/txr.1 b/txr.1
index 9f988953..a9693b97 100644
--- a/txr.1
+++ b/txr.1
@@ -4912,6 +4912,32 @@ The following are Lisp functions and variables built-in to TXR.
.SS Function vector-list
+.SS Function assoc
+
+.SS Function assq
+
+.SS Function acons
+
+.SS Function acons-new
+
+.SS Function aconsq-new
+
+.SS Function alist-remove
+
+.SS Function alist-nremove
+
+.SS Function copy-cons
+
+.SS Function copy-alist
+
+.SS Function merge
+
+.SS Function sort
+
+.SS Function find
+
+.SS Function set-diff
+
.SS Function length
diff --git a/unwind.c b/unwind.c
index 33acfb79..7abd4e97 100644
--- a/unwind.c
+++ b/unwind.c
@@ -137,7 +137,7 @@ val uw_get_func(val sym)
for (env = uw_find_env(); env != 0; env = env->ev.up_env) {
if (env->ev.func_bindings) {
- val found = assoc(env->ev.func_bindings, sym);
+ val found = assoc(sym, env->ev.func_bindings);
if (found)
return cdr(found);
}
@@ -233,7 +233,7 @@ val uw_exception_subtype_p(val sub, val sup)
if (sub == nil || sup == t || sub == sup) {
return t;
} else {
- val entry = assoc(exception_subtypes, sub);
+ val entry = assoc(sub, exception_subtypes);
return memq(sup, entry) ? t : nil;
}
}
@@ -327,9 +327,9 @@ val type_mismatch(val fmt, ...)
val uw_register_subtype(val sub, val sup)
{
- val t_entry = assoc(exception_subtypes, t);
- val sub_entry = assoc(exception_subtypes, sub);
- val sup_entry = assoc(exception_subtypes, sup);
+ val t_entry = assoc(t, exception_subtypes);
+ val sub_entry = assoc(sub, exception_subtypes);
+ val sup_entry = assoc(sup, exception_subtypes);
assert (t_entry != 0);
generated by cgit v1.2.3 (git 2.25.1) at 2025-03-10 13:44:55 +0000