diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | eval.c | 59 | ||||
| -rw-r--r-- | txr.1 | 108 |
3 files changed, 175 insertions, 1 deletions
@@ -1,5 +1,14 @@ 2015-04-25 Kaz Kylheku <kaz@kylheku.com> + Introducing mlet macro. + + * eval.c (me_mlet): New static function. + (eval_init): Registered mlet macro. + + * txr.1: Documented mlet. + +2015-04-25 Kaz Kylheku <kaz@kylheku.com> + * lib.c (symbol_package): If the argument is nil, return the user package directly, not the value of the *user-package* variable. @@ -2881,6 +2881,64 @@ static val me_lcons(val form, val menv) list(rplacd, lc_sym, cdr_form, nao), nao), nao); } +static val me_mlet(val form, val menv) +{ + uses_or2; + val body = cdr(form); + val bindings = pop(&body); + val symacrolet = intern(lit("symacrolet"), user_package); + val delay = intern(lit("delay"), user_package); + val force = intern(lit("force"), user_package); + + list_collect_decl (ordinary_syms, ptail_osyms); + list_collect_decl (syms, ptail_syms); + list_collect_decl (inits, ptail_inits); + list_collect_decl (gensyms, ptail_gensyms); + list_collect_decl (smacs, ptail_smacs); + list_collect_decl (sets, ptail_sets); + + for (; consp(bindings); bindings = cdr(bindings)) { + val binding = car(bindings); + + if (atom(binding)) { + if (!bindable(binding)) + uw_throwf(error_s, lit("mlet: ~s isn't a bindable symbol"), + binding, nao); + ptail_osyms = list_collect(ptail_osyms, binding); + } else { + val sym = car(binding); + + if (!bindable(sym)) + uw_throwf(error_s, lit("mlet: ~s isn't a bindable symbol"), + sym, nao); + + if (cdr(binding)) { + val init = car(cdr(binding)); + val gen = gensym(nil); + ptail_syms = list_collect(ptail_syms, sym); + ptail_inits = list_collect(ptail_inits, init); + ptail_gensyms = list_collect(ptail_gensyms, gen); + ptail_smacs = list_collect(ptail_smacs, + list(sym, list(force, gen, nao), nao)); + ptail_sets = list_collect(ptail_sets, + list(set_s, gen, + list(delay, init, nao), nao)); + } else { + ptail_osyms = list_collect(ptail_osyms, sym); + } + } + } + + if (bindings) + uw_throwf(error_s, lit("mlet: misplaced atom ~s in binding syntax"), + bindings, nao); + + return list(let_s, append2(ordinary_syms, gensyms), + apply_frob_args(list(symacrolet, smacs, + append2(sets, or2(body, cons(nil, nil))), + nao)), nao); +} + static val expand_catch_clause(val form, val menv) { val sym = first(form); @@ -4032,6 +4090,7 @@ void eval_init(void) reg_mac(intern(lit("whenlet"), user_package), me_iflet_whenlet); reg_mac(intern(lit("dotimes"), user_package), me_dotimes); reg_mac(intern(lit("lcons"), user_package), me_lcons); + reg_mac(intern(lit("mlet"), user_package), me_mlet); reg_fun(cons_s, func_n2(cons)); reg_fun(intern(lit("make-lazy-cons"), user_package), func_n1(make_lazy_cons)); @@ -15519,7 +15519,113 @@ function call. If the function is invoked additional times on the same promise, the cached value is retrieved. -.SS* Lazy Sequences, Ranges, Permutations and Combinations +.coNP Macro @ mlet +.synb +.mets (mlet >> ({ sym | >> ( sym << init-form )}*) << body-form *) +.syne +.desc +The +.code mlet +macro ("magic let" or "mutual let") implements a variable binding construct +similar to +.code let +and +.codn let* . + +Under +.codn mlet , +the scope of the bindings of the +.meta sym +variables extends over the +.metn init-form -s, +as well as the +.metn body-form -s. + +Unlike the +.code let* +construct, each +.meta init-form +has each +.meta sym +in scope. That is to say, an +.metn init-form +can refer not only to previous variables, but also to later variables +as well as to its own variable. + +The variables are not initialized until their values are accessed for +the first time. Any +.meta sym +whose value is not accessed is not initialized. + +Furthermore, the evaluation of each +.meta init-form +does not take place until the time when its value is needed +to initialize the associated +.metn sym . +This evaluation takes place once. If a given +.meta sym +is not accessed during the evaluation of the +.code mlet +construct, then its +.meta init-form +is never evaluated. + +Any +.meta sym +which has no initializer is an ordinary variable. It is initialized +immediately with the value +.code nil +and may be assigned. Those +.metn sym -s +which have initializers may not be assigned. + +Direct circular references erroneous and are diagnosed. + +.TP* Examples: + +.cblk + ;; Dependent calculations in arbitrary order + (mlet ((x (+ y 3)) + (z (+ x 1)) + (y 4)) + (+ z 4)) --> 12 + + ;; Error: circular reference: + ;; x depends on y, y on z, but z on x again. + (mlet ((x (+ y 1)) + (y (+ z 1)) + (z (+ x 1))) + z) + + ;; Okay: lazy circular reference because lcons is used + (mlet ((list (lcons 1 list))) + list) --> (1 1 1 1 1 ...) ;; circular list +.cble + +In the last example, the +.code list +variable is accessed for the first time in the body of the +.code mlet +form. This causes the evaluation of the +.code lcons +form. This form evaluates its arguments lazily, which means that it +is not a problem that +.code list +is not yet initialized. The form produces a lazy cons, which is then used +to initialize +.code list. +When the +.code car +or +.code cdr +fields of the lazy cons are accessed, the +.code list +expression in the +.code lcons +argument is accessed. By that time, the variable is initialized +and holds the lazy cons itself, which creates the circular reference, +and a circular list. + .coNP Functions @ generate and @ giterate .synb .mets (generate < while-fun << gen-fun ) |