Adding with-resources macro.

* share/txr/stdlib/with-resources.tl: New file.

* lisplib.c (with_resource_set_entries, with_resources_instantiate):
New static functions.
(lisplib_init): Register new functions under dlt_register.

* txr.1: Document with-resources.

4 files changed, 114 insertions, 0 deletions

diff --git a/ChangeLog b/ChangeLog
index bb996325..70d0fa8a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+2015-07-23  Kaz Kylheku  <kaz@kylheku.com>
+
+	Adding with-resources macro.
+
+	* share/txr/stdlib/with-resources.tl: New file.
+
+	* lisplib.c (with_resource_set_entries, with_resources_instantiate):
+	New static functions.
+	(lisplib_init): Register new functions under dlt_register.
+
+	* txr.1: Document with-resources.
+
 2015-07-22  Kaz Kylheku  <kaz@kylheku.com>
 
 	Adding nthcdr as accessor.
diff --git a/lisplib.c b/lisplib.c
index 014e095b..8bb5816e 100644
--- a/lisplib.c
+++ b/lisplib.c
@@ -126,6 +126,20 @@ static val txr_case_instantiate(val set_fun)
   return nil;
 }
 
+static val with_resources_set_entries(val dlt, val fun)
+{
+  val name[] = { lit("with-resources"), nil };
+  set_dlt_entries(dlt, name, fun);
+  return nil;
+}
+
+static val with_resources_instantiate(val set_fun)
+{
+  funcall1(set_fun, nil);
+  load(format(nil, lit("~a/with-resources.tl"), stdlib_path, nao));
+  return nil;
+}
+
 val dlt_register(val dlt,
                  val (*instantiate)(val),
                  val (*set_entries)(val, val))
@@ -141,6 +155,7 @@ void lisplib_init(void)
   dlt_register(dl_table, ver_instantiate, ver_set_entries);
   dlt_register(dl_table, ifa_instantiate, ifa_set_entries);
   dlt_register(dl_table, txr_case_instantiate, txr_case_set_entries);
+  dlt_register(dl_table, with_resources_instantiate, with_resources_set_entries);
 }
 
 val lisplib_try_load(val sym)
diff --git a/share/txr/stdlib/with-resources.tl b/share/txr/stdlib/with-resources.tl
new file mode 100644
index 00000000..2a8c6791
--- /dev/null
+++ b/share/txr/stdlib/with-resources.tl
@@ -0,0 +1,17 @@
+(defmacro with-resources (res-bindings . body)
+  (tree-case res-bindings
+    (((var init cleanup) . rest)
+     ^(let ((,var ,init))
+        (when ,var
+          (unwind-protect
+            (with-resources ,rest ,*body)
+            ,cleanup))))
+    (((var init) . rest)
+     ^(let ((,var ,init))
+        (with-resources ,rest ,*body)))
+    ((var . rest)
+     ^(let (,var)
+        (with-resources ,rest ,*body)))
+    (nil
+      ^(progn ,*body))
+    (other (error "with-resources: bad syntax"))))
diff --git a/txr.1 b/txr.1
index 7afaa51a..c137359b 100644
--- a/txr.1
+++ b/txr.1
@@ -30830,6 +30830,76 @@ Parser error messages are directed to the
 .code *stderr*
 stream.
 
+.SS* Scoped Resource Management
+.coNP Macro @ with-resources
+.synb
+.mets (with-resources >> ({ sym >> [ init-form <> [ cleanup-form ])}*)
+.mets \ \  << body-form *)
+.syne
+.desc
+The
+.code with-resources
+macro provides a sequential binding construct similar to
+.codn let* .
+Every
+.meta sym
+is established as a variable which is visible to the
+.metn init-form -s
+of subsequent variables, to all subsequent
+.metn cleanup-form -s
+including that of the same variable,
+and to the
+.metn body-form -s.
+
+If no
+.meta init-form
+is supplied, then
+.meta sym
+is bound to the value
+.codn nil .
+
+If an
+.meta init-form
+is supplied, but no
+.metn cleanup-form ,
+then
+.meta sym
+is bound to the value of the
+.metn init-form .
+
+If a
+.meta cleanup-form
+is supplied in addition to
+.metn init-form ,
+it specifies code to be executed upon the termination of the
+entire
+.code with-resources
+construct.
+
+When an instance of
+.code with-resources
+terminates, all of the
+.metn cleanup-form -s
+specified in its binding clauses are evaluated, in reverse (right-to-left)
+order. The value of the last
+.meta body-form
+is returned, or else
+.code nil
+if no
+.metn body-form -s
+are present.
+
+.TP* "Example:"
+
+The following opens a text file and reads a line from it, returning that line,
+while ensuring that the stream is closed immediately:
+
+.cblk
+(with-resources ((f (open-file "/etc/motd") (close-stream f)))
+  (whilet ((l (get-line f)))
+    (put-line l)))
+.cble
+
 .SS* Debugger
 \*(TX has a simple, crude, built-in debugger. The debugger is invoked by adding
 the