Task #11442. Access to environment variables.

* lib.c (env_list): New static variable.
(env): New function.
(match): Declaration of nonexistent function removed.
(obj_init): New variable gc-protected.

* lib.h (env): Declared.

* match.c (env_k): New symbol variable.
(v_next): Implemented :env.

* txr.1: @(next :env) described.

5 files changed, 68 insertions, 10 deletions

diff --git a/ChangeLog b/ChangeLog
index 6526a9e8..022e51a6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,19 @@
+2011-11-05  Kaz Kylheku  <kaz@kylheku.com>
+
+	Task #11442. Access to environment variables.
+
+	* lib.c (env_list): New static variable.
+	(env): New function.
+	(match): Declaration of nonexistent function removed.
+	(obj_init): New variable gc-protected.
+
+	* lib.h (env): Declared.
+
+	* match.c (env_k): New symbol variable.
+	(v_next): Implemented :env.
+
+	* txr.1: @(next :env) described.
+
 2011-11-04  Kaz Kylheku  <kaz@kylheku.com>
 
 	* hash.c (ll_hash): Added a break in the case that handles
diff --git a/lib.c b/lib.c
index 6af8dd58..d874e3ab 100644
--- a/lib.c
+++ b/lib.c
@@ -76,6 +76,8 @@ val identity_f, equal_f, eq_f, car_f;
 
 val prog_string;
 
+static val env_list;
+
 mem_t *(*oom_realloc)(mem_t *, size_t);
 
 val identity(val obj)
@@ -2297,6 +2299,23 @@ val set_diff(val list1, val list2, val testfun, val keyfun)
   return out;
 }
 
+val env(void)
+{
+  extern char **environ;
+  char **iter;
+
+  if (env_list) {
+    return env_list;
+  } else {
+    list_collect_decl (out, ptail);
+
+    for (iter = environ; *iter != 0; iter++)
+      list_collect (ptail, string_utf8(*iter));
+
+    return env_list = out;
+  }
+}
+
 static void obj_init(void)
 {
   /*
@@ -2308,7 +2327,7 @@ static void obj_init(void)
   protect(&packages, &system_package, &keyword_package,
           &user_package, &null_string, &nil_string,
           &null_list, &equal_f, &eq_f, &car_f,
-          &identity_f, &prog_string,
+          &identity_f, &prog_string, &env_list,
           (val *) 0);
 
   nil_string = lit("nil");
diff --git a/lib.h b/lib.h
index 50789367..b0bd50a8 100644
--- a/lib.h
+++ b/lib.h
@@ -435,6 +435,7 @@ val merge(val list1, val list2, val lessfun, val keyfun);
 val sort(val list, val lessfun, val keyfun);
 val find(val list, val key, val testfun, val keyfun);
 val set_diff(val list1, val list2, val testfun, val keyfun);
+val env(void);
 
 void obj_print(val obj, val stream);
 void obj_pprint(val obj, val stream);
@@ -442,7 +443,6 @@ void init(const wchar_t *progname, mem_t *(*oom_realloc)(mem_t *, size_t),
           val *stack_bottom);
 void dump(val obj, val stream);
 void d(val obj);
-val match(val spec, val data);
 
 #define nil ((obj_t *) 0)
 
diff --git a/match.c b/match.c
index e1a6842c..4716e724 100644
--- a/match.c
+++ b/match.c
@@ -53,7 +53,7 @@ val mingap_k, maxgap_k, gap_k, mintimes_k, maxtimes_k, times_k;
 val lines_k, chars_k;
 val choose_s, longest_k, shortest_k, greedy_k;
 val vars_k;
-val append_k, into_k, var_k, list_k, string_k;
+val append_k, into_k, var_k, list_k, string_k, env_k;
 
 val filter_s;
 
@@ -1662,15 +1662,31 @@ static val v_next(match_files_ctx *c)
     val source = first(args);
 
     if (source == args_k) {
-      if (rest(args))
+      if (rest(args)) {
         sem_error(spec_linenum, lit("(next :args) takes no additional arguments"), nao);
-      cons_bind (new_bindings, success,
-                 match_files(mf_args(*c)));
+      } else {
+        cons_bind (new_bindings, success,
+                   match_files(mf_args(*c)));
 
-      if (success)
-        return cons(new_bindings,
-                    if3(c->data, cons(c->data, c->data_lineno), t));
-      return nil;
+        if (success)
+          return cons(new_bindings,
+                      if3(c->data, cons(c->data, c->data_lineno), t));
+        return nil;
+      }
+    }
+
+    if (source == env_k) {
+      if (rest(args)) {
+        sem_error(spec_linenum, lit("(next :env) takes no additional arguments"), nao);
+      } else {
+        cons_bind (new_bindings, success,
+                   match_files(mf_data(*c, env(), num(1))));
+
+        if (success)
+          return cons(new_bindings,
+                      if3(c->data, cons(c->data, c->data_lineno), t));
+        return nil;
+      }
     }
     
     if (keywordp(first(args))) {
@@ -2870,6 +2886,7 @@ static void syms_init(void)
   var_k = intern(lit("var"), keyword_package);
   list_k = intern(lit("list"), keyword_package);
   string_k = intern(lit("string"), keyword_package);
+  env_k = intern(lit("env"), keyword_package);
 
   filter_s = intern(lit("filter"), user_package);
 }
diff --git a/txr.1 b/txr.1
index edf0bbd0..1523f3a4 100644
--- a/txr.1
+++ b/txr.1
@@ -1114,6 +1114,7 @@ with, or without arguments:
   @(next SOURCE)
   @(next SOURCE :nothrow)
   @(next :args)
+  @(next :env)
   @(next :list EXPR)
   @(next :string EXPR)
 
@@ -1151,6 +1152,11 @@ open the input source named by that argument. If the very first directive of a q
 avoids opening the first input source, but it does open the input source for
 any other directive, even one which does not consume any data.
 
+The variant @(next :env) means that the list of process enviornment variables
+is treated as a source of data. It looks like a text file stream
+consisting of lines of the form "name=value".  If this feature is not available
+on a given platform, an exception is thrown.
+
 The syntax @(next :list EXPR) treats the expression as a source of
 text. The value of the expression is flattened to a list in a way similar
 to the @(flatten) directive.  The resulting list is treated as if it were the