summaryrefslogtreecommitdiffstats
path: root/eval.c
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2012-01-25 09:59:40 -0800
committerKaz Kylheku <kaz@kylheku.com>2012-01-25 09:59:40 -0800
commit11173ced6d65339869fe74fbc9c4452a75e3fe26 (patch)
tree6c7e21fa0f7ebab6d5b4af9dc960fd96660682be /eval.c
parent8b4578f295cc022e8bf0bb62d1a8cf8673636f27 (diff)
downloadtxr-11173ced6d65339869fe74fbc9c4452a75e3fe26.tar.gz
txr-11173ced6d65339869fe74fbc9c4452a75e3fe26.tar.bz2
txr-11173ced6d65339869fe74fbc9c4452a75e3fe26.zip
* eval.c (dwim_s): New symbol variable.
(dwim_loc, op_dwim): New static functions. (op_modplace): Support assignment to dwim forms with the help of dwim_loc. (expand_place): Handle dwim places. (eval_init): Initialize dwim_s. Register dwim operator in op_table. * eval.h (dwim_s): Declared. * lib.c (chr_str, chr_str_set): Allow negative indices to index backwards from end of string. (vecref, vecref_l): Allow negative indices to index from rear of array. (obj_print, obj_pprint): Render (dwim ...) forms as [...]. * parser.l: Peoduce new METABKT token type for @[, and '[', ']' tokens. * parser.y (METABKT): New token. %type declaration for '['. (list): Support square-bracket style of list, translated into dwim form. (meta_expr): Support @[...] variant. (yybadtoken): Handle METABKT in switch. * txr.1: Documented [...] syntax and dwim operator. * txr.vim: Updated.
Diffstat (limited to 'eval.c')
-rw-r--r--eval.c149
1 files changed, 144 insertions, 5 deletions
diff --git a/eval.c b/eval.c
index f2bc2b47..f8acd8aa 100644
--- a/eval.c
+++ b/eval.c
@@ -56,7 +56,7 @@ val top_vb, top_fb;
val op_table;
val eval_error_s;
-val progn_s, prog1_s, let_s, let_star_s, lambda_s, call_s;
+val dwim_s, progn_s, prog1_s, let_s, let_star_s, lambda_s, call_s;
val cond_s, if_s, defvar_s, defun_s;
val inc_s, dec_s, push_s, pop_s, flip_s, gethash_s, car_s, cdr_s, vecref_s;
val for_s, for_star_s, each_s, each_star_s, collect_each_s, collect_each_star_s;
@@ -637,6 +637,67 @@ static val op_defun(val form, val env)
return name;
}
+static val *dwim_loc(val form, val env)
+{
+ val obj = eval(second(form), env, form);
+ val args = eval_args(rest(rest(form)), env, form);
+
+ if (!obj)
+ eval_error(form, lit("[~s ]: cannot assign nil"), obj, nao);
+
+ switch (type(obj)) {
+ case LIT:
+ case STR:
+ case LSTR:
+ eval_error(form, lit("[~s ...]: string element assignment not implemented!"),
+ obj, nao);
+ case SYM:
+ case FUN:
+ eval_error(form, lit("[~s ...]: assigning through function not implemented!"),
+ obj, nao);
+ case VEC:
+ if (rest(args))
+ eval_error(form, lit("[~s ...]: vector indexing needs one arg"),
+ obj, nao);
+ return vecref_l(obj, first(args));
+ case CONS:
+ case LCONS:
+ if (rest(args))
+ eval_error(form, lit("[~s ...]: list indexing needs one arg"),
+ obj, nao);
+ {
+ val index = first(args);
+ val cell = obj;
+ if (!bignump(index) && !fixnump(index))
+ eval_error(form, lit("[~s ~s]: index must be integer"),
+ cell, index, nao);
+ for (; gt(index, zero); index = minus(index, one))
+ cell = cdr(cell);
+ if (lt(index, zero) || !cell)
+ eval_error(form, lit("[~s ~s]: cannot assign nonexistent location"),
+ cell, first(args), nao);
+ return car_l(cell);
+ }
+ case COBJ:
+ {
+ if (hashp(obj)) {
+ val new_p, *loc;
+ if (length(args) != two)
+ eval_error(form, lit("[~s ...]: hash indexing needs two args"),
+ obj, nao);
+ loc = gethash_l(obj, first(args), &new_p);
+ if (new_p)
+ *loc = second(args);
+ return loc;
+ }
+ }
+ default:
+ eval_error(form, lit("object ~s not supported by [] notation"), obj, nao);
+ }
+
+ return 0;
+}
+
static val op_modplace(val form, val env)
{
uses_or2;
@@ -665,7 +726,9 @@ static val op_modplace(val form, val env)
} else if (consp(place)) {
/* TODO: dispatch these with hash table. */
val sym = car(place);
- if (sym == gethash_s) {
+ if (sym == dwim_s) {
+ loc = dwim_loc(place, env);
+ } else if (sym == gethash_s) {
val hash = eval(second(place), env, form);
val key = eval(third(place), env, form);
val new_p;
@@ -675,7 +738,7 @@ static val op_modplace(val form, val env)
} else if (sym == car_s) {
val cons = eval(second(place), env, form);
loc = car_l(cons);
- } else if (sym == car_s) {
+ } else if (sym == cdr_s) {
val cons = eval(second(place), env, form);
loc = cdr_l(cons);
} else if (sym == vecref_s) {
@@ -813,6 +876,72 @@ static val op_return_from(val form, val env)
abort();
}
+static val op_dwim(val form, val env)
+{
+ val obj = eval(second(form), env, form);
+ val args = eval_args(rest(rest(form)), env, form);
+
+ if (!obj)
+ return nil;
+
+ switch (type(obj)) {
+ case LIT:
+ case STR:
+ case LSTR:
+ if (rest(args))
+ eval_error(form, lit("[~s ...]: string indexing needs one arg"),
+ obj, nao);
+ return chr_str(obj, first(args));
+ case SYM:
+ {
+ val fbinding = lookup_fun(env, obj);
+
+ if (!fbinding)
+ eval_error(form, lit("[~s ...]: no function exists named ~s"),
+ obj, obj, nao);
+
+ return apply(cdr(fbinding), args, form);
+ }
+ case FUN:
+ return apply(obj, args, form);
+ case VEC:
+ if (rest(args))
+ eval_error(form, lit("[~s ...]: vector indexing needs one arg"),
+ obj, nao);
+ return vecref(obj, first(args));
+ case CONS:
+ case LCONS:
+ if (rest(args))
+ eval_error(form, lit("[~s ...]: list indexing needs one arg"),
+ obj, nao);
+ {
+ val index = first(args);
+ if (!bignump(index) && !fixnump(index))
+ eval_error(form, lit("[~s ~s]: index must be integer"),
+ obj, index, nao);
+ if (lt(index, zero))
+ return nil;
+ for (; gt(index, zero); index = minus(index, one))
+ obj = cdr(obj);
+ return car(obj);
+ }
+ case COBJ:
+ {
+ if (hashp(obj)) {
+ if (length(args) != two)
+ eval_error(form, lit("[~s ...]: hash indexing needs two args"),
+ obj, nao);
+ return gethash_n(obj, first(args), second(args));
+ }
+ }
+ /* fallthrough */
+ default:
+ eval_error(form, lit("object ~s not supported by [] notation"), obj, nao);
+ }
+
+ return nil;
+}
+
static val subst_vars(val forms, val env)
{
list_collect_decl(out, iter);
@@ -914,7 +1043,15 @@ static val expand_place(val place)
return place;
} else {
val sym = first(place);
- if (sym == gethash_s) {
+ if (sym == dwim_s) {
+ val args = rest(place);
+ val args_ex = expand_forms(args);
+
+ if (args == args_ex)
+ return place;
+
+ return rlcp(cons(sym, args_ex), place);
+ } if (sym == gethash_s) {
val hash = second(place);
val key = third(place);
val dfl_val = fourth(place);
@@ -1195,7 +1332,7 @@ val expand(val form)
} else {
/* funtion call
also handles: progn, prog1, call, if, and, or,
- unwind-protect, return */
+ unwind-protect, return, dwim */
val args = rest(form);
val args_ex = expand_forms(args);
@@ -1477,6 +1614,7 @@ void eval_init(void)
top_vb = make_hash(t, nil, nil);
op_table = make_hash(nil, nil, nil);
+ dwim_s = intern(lit("dwim"), user_package);
progn_s = intern(lit("progn"), user_package);
prog1_s = intern(lit("prog1"), user_package);
let_s = intern(lit("let"), user_package);
@@ -1548,6 +1686,7 @@ void eval_init(void)
sethash(op_table, block_s, cptr((mem_t *) op_block));
sethash(op_table, return_s, cptr((mem_t *) op_return));
sethash(op_table, return_from_s, cptr((mem_t *) op_return_from));
+ sethash(op_table, dwim_s, cptr((mem_t *) op_dwim));
sethash(op_table, quasi_s, cptr((mem_t *) op_quasi_lit));
reg_fun(cons_s, func_n2(cons));