From 11173ced6d65339869fe74fbc9c4452a75e3fe26 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Wed, 25 Jan 2012 09:59:40 -0800 Subject: * 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. --- eval.c | 149 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 144 insertions(+), 5 deletions(-) (limited to 'eval.c') 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)); -- cgit v1.2.3