diff options
| -rw-r--r-- | lisplib.c | 18 | ||||
| -rw-r--r-- | share/txr/stdlib/doloop.tl | 54 | ||||
| -rw-r--r-- | txr.1 | 164 |
3 files changed, 236 insertions, 0 deletions
@@ -541,6 +541,23 @@ static val ffi_instantiate(val set_fun) return nil; } +static val doloop_set_entries(val dlt, val fun) +{ + val name[] = { + lit("doloop"), lit("doloop*"), + nil + }; + set_dlt_entries(dlt, name, fun); + return nil; +} + +static val doloop_instantiate(val set_fun) +{ + funcall1(set_fun, nil); + load(format(nil, lit("~adoloop.tl"), stdlib_path, nao)); + return nil; +} + val dlt_register(val dlt, val (*instantiate)(val), val (*set_entries)(val, val)) @@ -581,6 +598,7 @@ void lisplib_init(void) dlt_register(dl_table, error_instantiate, error_set_entries); dlt_register(dl_table, keyparams_instantiate, keyparams_set_entries); dlt_register(dl_table, ffi_instantiate, ffi_set_entries); + dlt_register(dl_table, doloop_instantiate, doloop_set_entries); reg_fun(intern(lit("try-load"), system_package), func_n1(lisplib_try_load)); } diff --git a/share/txr/stdlib/doloop.tl b/share/txr/stdlib/doloop.tl new file mode 100644 index 00000000..770b7b05 --- /dev/null +++ b/share/txr/stdlib/doloop.tl @@ -0,0 +1,54 @@ +;; Copyright 2017 +;; Kaz Kylheku <kaz@kylheku.com> +;; Vancouver, Canada +;; All rights reserved. +;; +;; Redistribution and use in source and binary forms, with or without +;; modification, are permitted provided that the following conditions are met: +;; +;; 1. Redistributions of source code must retain the above copyright notice, this +;; list of conditions and the following disclaimer. +;; +;; 2. Redistributions in binary form must reproduce the above copyright notice, +;; this list of conditions and the following disclaimer in the documentation +;; and/or other materials provided with the distribution. +;; +;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(defun sys:expand-doloop (f vars cexp body) + (let ((xvars (mapcar (tc + (((:whole w v i s . r)) + (if r (compile-error f "excess elements in ~s" w) w)) + (((:whole w v i . r)) + (if r + (compile-error f "bad variable clause syntax ~s" w) + ^(,v ,i ,i))) + (((:whole w v . r)) + (if r + (compile-error f "bad variable clause syntax ~s" w) + ^(,v nil ,v))) + ((v) ^(,v nil ,v))) + vars)) + (pllel (eq (car f) 'doloop))) + ^(,(if pllel 'for 'for*) + ,(mapcar (aret ^(,@1 ,@2)) xvars) + ,cexp + ((,(if pllel 'pset 'set) ,*(mappend (ado unless (eq @1 @3) + ^(,@1 ,@3)) + xvars))) + ,*body))) + +(defmacro doloop (:form f vars cexp . body) + (sys:expand-doloop f vars cexp body)) + +(defmacro doloop* (:form f vars cexp . body) + (sys:expand-doloop f vars cexp body)) @@ -15365,6 +15365,170 @@ allowing the .code return operator to be used to terminate at any point. +.coNP Macros @ doloop and @ doloop* +.synb +.mets ({doloop | doloop*} +.mets \ \ ({ sym | >> ( sym >> [ init-form <> [ step-form ])}*) +.mets \ \ >> ([ test-form << result-form *]) +.mets \ \ << body-form *) +.syne +.desc +The +.code doloop +and +.code doloop* +macros provide an iteration construct inspired by the ANSI Common Lisp +.code do +and +.code do* +macros. + +Each +.meta sym +element in the form must be a symbol suitable for use as a variable name. + +The +.code doloop +macro binds each +.meta sym +to the value produced by evaluating the adjacent +.metn init-form . +Then, in the environment in which these variables now exist, +.meta test-form +is evaluated. If that form yields +.codn nil , +then the loop terminates. The +.metn result-form -s +are evaluated, and the value of the last one is returned. + +If +.metn result-form -s +are absent, then +.code nil +is returned. + +If +.meta test-form +is also absent, then the loop terminates and returns +.codn nil . + +If +.meta test-form +produces a true value, then +.metn result-form -s +are not evaluated. Instead, the +.metn body-form -s +are evaluated. Next, the loop variables are updated by assigning +to each +.meta sym +the value of +.metn step-form . + +The following defaulting behaviors apply in regard to the variable +syntax. For each +.meta sym +which has an associated +.meta init-form +but no +.metn step-form , +the +.meta init-form +is duplicated and taken as the +.metn step-form . +Thus a variable specification like +.code "(x y)" +is equivalent to +.codn "(x y y)" . +If both forms are omitted, then the +.meta init-form +is taken to be +.codn nil , +and the +.meta step-form +is taken to be +.metn sym . +This means that the variable form +.code "(x)" +is equivalent to +.code "(x nil x)" +which has the effect that +.code x +retains its current value when the next loop iteration begins. +Lastly, the +.meta sym +variant is equivalent to +.cblk +.meti <> ( sym ) +.cble +so that +.code x +is also equivalent to +.codn "(x nil x)" . + +The differences between +.code doloop +and +.code doloop* +are: +.code doloop +binds the variables in parallel, similarly to +.codn let , +whereas +.code doloop* +binds sequentially, like +.codn let* ; +moreover, +.code doloop +performs the +.meta step-form +assignments in parallel as if using a single +.cblk +.meti (pset < sym0 < step-form-0 < sym1 < step-form-1 ...) +.cble +form, whereas +.code doloop* +performs the assignment sequentially as if using +.code set +rather than +.codn pset . + +The +.code doloop +and +.code doloop* +macros establish an anonymous +.codn block , +allowing early return from the loop, with a value, via the +.code return +operator. + +.TP* "Dialect Note:" +These macros are substantially different from the ANSI Common Lisp +.code do +and +.code do* +macros. Firstly, the termination logic is inverted; effectively they +implement "while" loops, whereas their ANSI CL counterparts implement +"until" loops. Secondly, in the ANSI CL macros, the defaulting of +the missing +.meta step-form +is different. Variables with no +.meta step-form +are not updated. In particular, this means that the form +.code "(x y)" +is not equivalent to +.codn "(x y y)" ; +the ANSI CL macros do not feature the automatic replication of +.meta init-form +into the +.meta step-form +position. +Lastly, +.code doloop +and +.code doloop* +do not implement an implicit +.codn tagbody . .coNP Operators @ block and @ block* .synb |