summaryrefslogtreecommitdiffstats
path: root/eval.c
diff options
context:
space:
mode:
Diffstat (limited to 'eval.c')
-rw-r--r--eval.c61
1 files changed, 51 insertions, 10 deletions
diff --git a/eval.c b/eval.c
index 8d83f37d..af712130 100644
--- a/eval.c
+++ b/eval.c
@@ -637,7 +637,7 @@ static val op_defun(val form, val env)
return name;
}
-static val *dwim_loc(val form, val env, val op, val newval)
+static val *dwim_loc(val form, val env, val op, val newval, val *retval)
{
val obj = eval(second(form), env, form);
val args = eval_args(rest(rest(form)), env, form);
@@ -649,8 +649,38 @@ static val *dwim_loc(val form, val env, val op, val newval)
case LIT:
case STR:
case LSTR:
- eval_error(form, lit("[~s ...]: string element assignment not implemented!"),
- obj, nao);
+ if (rest(args))
+ eval_error(form, lit("[~s ...]: string indexing needs one arg"),
+ obj, nao);
+ {
+ val index = first(args);
+
+ if (consp(index)) {
+ if (op != set_s)
+ eval_error(form, lit("[~s ~s]: ranges takes only set assignments"),
+ obj, index, nao);
+
+ replace_str(obj, car(index), cdr(index), newval);
+ *retval = newval;
+ return 0;
+ } else {
+ uses_or2;
+ if (op == set_s) {
+ chr_str_set(obj, index, newval);
+ } else if (op == inc_s) {
+ newval = plus(chr_str(obj, index), or2(newval, one));
+ chr_str_set(obj, index, newval);
+ } else if (op == dec_s) {
+ newval = minus(chr_str(obj, index), or2(newval, one));
+ chr_str_set(obj, index, newval);
+ } else {
+ eval_error(form, lit("[~s ~s]: only set, inc and dec can be used "
+ "for string indices"), obj, index, nao);
+ }
+ *retval = newval;
+ return 0;
+ }
+ }
case SYM:
case FUN:
eval_error(form, lit("[~s ...]: assigning through function not implemented!"),
@@ -664,10 +694,11 @@ static val *dwim_loc(val form, val env, val op, val newval)
if (consp(index)) {
if (op != set_s)
- eval_error(form, lit("[~s ~s]: slice takes only simple assignments"),
+ eval_error(form, lit("[~s ~s]: ranges take only set assignments"),
obj, index, nao);
replace_vec(obj, car(index), cdr(index), newval);
+ *retval = newval;
return 0;
} else {
return vecref_l(obj, first(args));
@@ -688,13 +719,14 @@ static val *dwim_loc(val form, val env, val op, val newval)
val tempform;
if (op != set_s)
- eval_error(form, lit("[~s ~s]: slice takes only simple assignments"),
+ eval_error(form, lit("[~s ~s]: ranges take only simple assignments"),
cell, index, nao);
newlist = replace_list(obj, car(index), cdr(index), newval);
tempform = list(op, second(form),
cons(quote_s, cons(newlist, nil)), nao);
eval(tempform, env, form);
+ *retval = newval;
return 0;
} else {
eval_error(form, lit("[~s ~s]: index must be integer, or pair"),
@@ -750,9 +782,10 @@ static val op_modplace(val form, val env)
/* TODO: dispatch these with hash table. */
val sym = car(place);
if (sym == dwim_s) {
- loc = dwim_loc(place, env, op, newval);
+ val ret;
+ loc = dwim_loc(place, env, op, newval, &ret);
if (loc == 0)
- return newval;
+ return ret;
} else if (sym == gethash_s) {
val hash = eval(second(place), env, form);
val key = eval(third(place), env, form);
@@ -786,10 +819,10 @@ static val op_modplace(val form, val env)
eval_error(form, lit("~a: missing argument"), op, place, nao);
return *loc = newval;
} else if (op == inc_s) {
- val inc = or2(newval, num(1));
+ val inc = or2(newval, one);
return *loc = plus(*loc, inc);
} else if (op == dec_s) {
- val inc = or2(newval, num(1));
+ val inc = or2(newval, one);
return *loc = minus(*loc, inc);
} else if (op == push_s) {
return push(newval, loc);
@@ -916,7 +949,14 @@ static val op_dwim(val form, val env)
if (rest(args))
eval_error(form, lit("[~s ...]: string indexing needs one arg"),
obj, nao);
- return chr_str(obj, first(args));
+ {
+ val index = first(args);
+ if (consp(index)) {
+ return sub_str(obj, car(index), cdr(index));
+ } else {
+ return chr_str(obj, first(args));
+ }
+ }
case SYM:
{
val fbinding = lookup_fun(env, obj);
@@ -1858,6 +1898,7 @@ void eval_init(void)
reg_fun(intern(lit("search-str"), user_package), func_n4(search_str));
reg_fun(intern(lit("search-str-tree"), user_package), func_n4(search_str_tree));
reg_fun(intern(lit("sub-str"), user_package), func_n3(sub_str));
+ reg_fun(intern(lit("replace-str"), user_package), func_n4(replace_str));
reg_fun(intern(lit("cat-str"), user_package), func_n2(cat_str));
reg_fun(intern(lit("split-str"), user_package), func_n2(split_str));
reg_fun(intern(lit("split-str-set"), user_package), func_n2(split_str_set));