From d453ed5dfbd7dee9d281c2d03a43146e0509bbde Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Wed, 7 Dec 2011 21:16:34 -0800
Subject: * eval.c (op_defun): Transform a function body by inserting a named
 block around it, thereby imitating a Common Lisp feature. (op_for): Establish
 an anonymous block around the loop body, test form and increment forms.

* txr.1: Documented named block in defun. Documented for and for *.
---
 ChangeLog |  9 +++++++++
 eval.c    | 14 ++++++++++++--
 txr.1     | 57 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 3 files changed, 77 insertions(+), 3 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index e31e8b97..ca930a46 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2011-12-07  Kaz Kylheku  <kaz@kylheku.com>
+
+	* eval.c (op_defun): Transform a function body by inserting
+	a named block around it, thereby imitating a Common Lisp feature.
+	(op_for): Establish an anonymous block around the loop body,
+	test form and increment forms.
+
+	* txr.1: Documented named block in defun. Documented for and for *.
+
 2011-12-07  Kaz Kylheku  <kaz@kylheku.com>
 
 	* txr.vim: Updated with all operators and functions.
diff --git a/eval.c b/eval.c
index ce456ebd..f3ee2b4f 100644
--- a/eval.c
+++ b/eval.c
@@ -514,6 +514,9 @@ static val op_defun(val form, val env)
   val args = rest(form);
   val name = first(args);
   val params = second(args);
+  val body = rest(rest(args));
+  val block = cons(block_s, cons(name, body));
+  val fun = cons(name, cons(params, cons(block, nil)));
 
   if (!bindable(name))
     eval_error(form, lit("defun: ~s is not a bindable sybol"), name, nao);
@@ -521,8 +524,9 @@ static val op_defun(val form, val env)
   if (!all_satisfy(params, func_n1(bindable), nil))
     eval_error(form, lit("defun: arguments must be bindable symbols"), nao);
 
+  
   /* defun captures lexical environment, so env is passed */
-  sethash(top_fb, name, cons(name, func_interp(env, args)));
+  sethash(top_fb, name, cons(name, func_interp(env, fun)));
   return name;
 }
 
@@ -617,10 +621,16 @@ static val op_for(val form, val env)
   val new_bindings = bindings_helper(vars, env, eq(forsym, for_star_s), form);
   val new_env = make_env(new_bindings, nil, env);
 
+  uw_block_begin (nil, result);
+
   for (; eval(car(cond), new_env, form); eval_progn(incs, new_env, form))
     eval_progn(forms, new_env, form);
 
-  return eval_progn(rest(cond), new_env, form);
+  result = eval_progn(rest(cond), new_env, form);
+
+  uw_block_end;
+
+  return result;
 }
 
 static val op_dohash(val form, val env)
diff --git a/txr.1 b/txr.1
index 74b3dac6..ae7e2972 100644
--- a/txr.1
+++ b/txr.1
@@ -4326,6 +4326,7 @@ indicated as bar-separated items.
 
 .TP
 Syntax:
+
 (progn <form>*)
 
 .TP
@@ -4342,6 +4343,7 @@ These operators are said to feature an "implicit progn".
 
 .TP
 Syntax:
+
 (let ({<sym> | (<sym> <init-form>)}*) <body-form>*)
 
 (let* ({<sym> | (<sym> <init-form>)}*) <body-form>*)
@@ -4389,6 +4391,7 @@ Examples:
 
 .TP
 Syntax:
+
 (lambda ({<sym>}*[. <sym>]) {<body-form>}*)
 
 .TP
@@ -4435,6 +4438,7 @@ are aggregated into a list passed as the single parameter z:
 
 .TP
 Syntax:
+
 (call <function-form> {<argument-form>}*)
 
 .TP
@@ -4466,6 +4470,7 @@ Useless use of call on a named function; equivalent to (list 1 2):
 
 .TP
 Syntax:
+
 (fun <function-name>)
 
 .TP
@@ -4484,6 +4489,7 @@ syntax (fun (lambda ...)) is invalid.
 
 .TP
 Syntax:
+
 (cond {(<test> {form}*)}*)
 
 .TP
@@ -4508,6 +4514,7 @@ nil.  This holds in the case that the syntax is empty: (cond) yields nil.
 
 .TP
 Syntax:
+
 (if <cond> <t-form> [<e-form>])
 
 .TP
@@ -4524,6 +4531,7 @@ as if <e-form> were specified as nil.
 
 .TP
 Syntax:
+
 (and {<form>}*)
 
 .TP
@@ -4554,6 +4562,7 @@ Examples:
 
 .TP
 Syntax:
+
 (or {<form>}*)
 
 .TP
@@ -4586,16 +4595,25 @@ Examples:
 
 .TP
 Syntax:
-(defun <name> ({<param> [. <rest-param>]}*) {<body-form>}*)
+
+(defun <name> ({<param> [. <rest-param>]}*) <body-form>*)
 
 Description:
 
 The defun operator introduces a new function in the global function namespace.
+The function is similar to a lambda, except that <body-form>-s are surrounded
+by a named block called nil. The name of this block is the same as the name of
+the function, making it possible to terminate the function and return a
+value using (return-from <name> <value>). For more information, see the
+definition of the block operator.
+
+A function may call itself by name, allowing for recursion.
 
 .SS Operators inc, dec, set, push, pop and flip
 
 .TP
 Syntax:
+
 (inc <place> [<delta>])
 
 (dec <place> [<delta>])
@@ -4680,6 +4698,43 @@ determine the initial value of the place. Otherwise it is ignored.
 
 .SS Operators for and for*
 
+.TP
+Syntax:
+
+({for | for*} ({<sym> | (<sym> <init-form>)}*) 
+              (<test-form> <result-form>*) 
+              (<inc-form>*)
+  <body-form>*)
+
+.TP
+Description:
+
+The for and for* operators combine variable binding with loop iteration.
+The first argument is a list of variables with optional initializers,
+exactly the same as in the let and let* operators. Furthermore, the
+difference between for and for* is like that between let and let* with
+regard to this list of variables. 
+The for operators execute these steps:
+
+1. Establish bindings for the specified variables similarly to let
+and let*. The variable bindings are visible over the <test-form>, each
+<result-form>, each <inc-form> and each <body-form>.
+
+2. Establish an anonymous block over the remaining forms, allowing
+the return operator to be used to terminate the loop.
+
+3. Evaluate <test-form>. If <test-form> yields nil, then each
+<result-form> is evaluated, and the vale of the last of these forms
+is is the result value of the for loop. If there are no such forms
+then the return value is nil.
+
+4. Otherwise, if <test-form> yields non-nil, then each <body-form>
+is evaluated in turn. Then, each <inc-form> is evaluated in turn
+and processing resumes at step 2.
+
+Furthermore, the for operators establish an anonymous block,
+allowing the return operator to be used to terminate at any point.
+
 .SS Operator dohash
 
 .SS Operator unwind-protect
-- 
cgit v1.2.3