From 6a5ea25622c3dbab61b35bab87506c83206ec5fd Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sat, 15 Oct 2016 19:56:39 -0700
Subject: Support nil env in env-fbind and env-vbind.

* eval.c (env_fbind, env_vbind): Allow env to be
nil, indicating that the binding is to take
place in the global environment.

* txr.1: Documented.
---
 eval.c | 34 ++++++++++++++++++++++++----------
 txr.1  |  6 ++++++
 2 files changed, 30 insertions(+), 10 deletions(-)

diff --git a/eval.c b/eval.c
index ed87549b..82afee1c 100644
--- a/eval.c
+++ b/eval.c
@@ -149,20 +149,34 @@ static val make_env_intrinsic(val vbindings, val fbindings, val up_env)
 
 val env_fbind(val env, val sym, val fun)
 {
-  val cell;
-  type_check(env, ENV);
-  cell = acons_new_c(sym, nulloc, mkloc(env->e.fbindings, env));
-  rplacd(cell, fun);
-  return cell;
+  if (env) {
+    val cell;
+    type_check(env, ENV);
+    cell = acons_new_c(sym, nulloc, mkloc(env->e.fbindings, env));
+    return rplacd(cell, fun);
+  } else {
+    val hcell = gethash_c(top_fb, sym, nulloc);
+    val cell = cdr(hcell);
+    if (cell)
+      return rplacd(cell, fun);
+    return sys_rplacd(hcell, cons(sym, fun));
+  }
 }
 
 val env_vbind(val env, val sym, val obj)
 {
-  val cell;
-  type_check(env, ENV);
-  cell = acons_new_c(sym, nulloc, mkloc(env->e.vbindings, env));
-  rplacd(cell, obj);
-  return cell;
+  if (env) {
+    val cell;
+    type_check(env, ENV);
+    cell = acons_new_c(sym, nulloc, mkloc(env->e.vbindings, env));
+    return rplacd(cell, obj);
+  } else {
+    val hcell = gethash_c(top_vb, sym, nulloc);
+    val cell = cdr(hcell);
+    if (cell)
+      return rplacd(cell, obj);
+    return sys_rplacd(hcell, cons(sym, obj));
+  }
 }
 
 static void env_vb_to_fb(val env)
diff --git a/txr.1 b/txr.1
index eb2f379a..9585fdaf 100644
--- a/txr.1
+++ b/txr.1
@@ -14245,6 +14245,12 @@ already exists in the environment, in the given space, then its
 value is updated with
 .codn value .
 
+If
+.meta env
+is specified as
+.codn nil ,
+then the binding takes place in the global environment.
+
 .SS* Global Environment
 .coNP Accessors @, symbol-function @ symbol-macro and @ symbol-value
 .synb
-- 
cgit v1.2.3