Guile Emacs: Elisp nil/t and Guile #nil/#t

[Taylan Ulrich B.]

Hi,

It occurred to me that nil and t are basically just symbols in Elisp,
just with some magical properties.  Like any symbol, they respond to
symbolp, have a plist, value and symbol slot (although the value slot is
immutable), etc.  They're self-quoting, so 'nil and 't also just return
nil and t.  Nasty stuff.  Given all that, the #nil and #t values of
Guile are obviously not nearly interchangeable.  Did anyone already have
a solution in mind?  If not, I have thought of and implemented a
solution, which is dirty but seems to work well, except for perhaps
incorporating overhead in Elisp code (but not Scheme).  Explanation
follows.

* Qnil and Qt are simply SCM_ELISP_NIL and SCM_BOOL_T.

* NILP is simply scm_is_lisp_false, naturally.

* SYMBOLP handles Qnil and Qt specially:

  (SMOB_TYPEP (x, lisp_symbol_tag) || EQ (x, Qnil) || EQ (x, Qt))

  This has some overhead.  Maybe a more efficient solution exists.

* XSYMBOL handles Qnil and Qt specially, returning SMOB pointers for
  Qnil_ and Qt_ instead (explanation will follow):

  ((struct Lisp_Symbol *)                               \
   (EQ (a, Qnil) ? SMOB_PTR (Qnil_)                     \
    : EQ (a, Qt) ? SMOB_PTR (Qt_)                       \
    : (eassert (SMOB_TYPEP (a, lisp_symbol_tag)),       \
       SMOB_PTR (a))))

  Again, overhead.

* Last part is fancy: Qnil_ and Qt_ are basically the old Qnil and Qt,
  and are initialized with intern("nil") and intern("t"), however the
  implementation of intern has a twist: on subsequent calls with "nil"
  and "t" it actually returns Qnil and Qt instead of Qnil_ and Qt_, this
  works well because as per the previous points we assured that Qnil and
  Qt (SCM_ELISP_NIL and SCM_BOOL_T) are interchangeable with the symbols
  Qnil_ and Qt_ in the Elisp C API.  This incorporates overhead in
  intern, when returning and already-interned symbol: it is first tested
  against Qnil_ and Qt_, before being returned.

Note that `read' uses intern, too, so that's how we get Qnil and Qt when
reading source code or other data.

(Tell me if I missed a way in which one can accidentally access the
underlying nil and t symbols instead of the "delegating" Qnil and Qt
values, or something that could expose the non-symbol nature of the Qnil
and Qt values, for they must appear to be symbols.)

The result is that "everything works fine", except that I don't know how
much I slowed down SYMBOLP, XSYMBOL, and intern:

(The following examples use the Elisp macro `guile-ref' which works like
Guile's @, and they pass Guile procedures to funcall; I implemented
these locally.)

(funcall (guile-ref (guile) null?) nil) => t
(funcall (guile-ref (guile) not) nil) => t
(eq (eval-scheme "#nil") nil) => t
(eq (eval-scheme "#t") t) => t
(symbolp nil) => t
(symbolp t) => t
(symbol-value nil) => nil
(symbol-value t) => t
(null (eval-scheme "#nil")) => t
(null (eval-scheme "#f")) => t
(null (eval-scheme "'()")) => t

Patches follow.  The first one is the one relevant to the topic.  The
second allows Scheme procedures in `funcall' (thus also `apply') and
function-slots of symbols; the third implements guile-ref (@) and
guile-private-ref (@@), and fixes eval-scheme to not print excessively
(git insisted on putting the two changes in the same hunk, I gave up).
I'm providing the latter two for completion's sake and in case you want
to test this yoursel, since there's otherwise no way to pass Elisp data
to Scheme procedures (eval-scheme takes a string).  The problems they
solve will probably be solved better in the future.

>From f926a808e98e9ace24d07ee9ca7c1137f4670a62 Mon Sep 17 00:00:00 2001
From: Taylan Ulrich B <address@hidden>
Date: Thu, 1 Aug 2013 03:45:09 +0300
Subject: [PATCH 1/3] Reconcile Elisp nil and t with Guile #nil and #t.

---
 src/data.c  |  6 +++---
 src/lisp.h  | 16 +++++++++++-----
 src/lread.c | 47 +++++++++++++++++++++++++----------------------
 3 files changed, 39 insertions(+), 30 deletions(-)

diff --git a/src/data.c b/src/data.c
index 347c3f9..6d7c95d 100644
--- a/src/data.c
+++ b/src/data.c
@@ -34,7 +34,7 @@ along with GNU Emacs.  If not, see 
<http://www.gnu.org/licenses/>.  */
 #include "font.h"
 #include "keymap.h"
 
-Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
+Lisp_Object Qnil, Qnil_, Qt, Qt_, Qquote, Qlambda, Qunbound;
 static Lisp_Object Qsubr;
 Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
 Lisp_Object Qerror, Quser_error, Qquit, Qargs_out_of_range;
@@ -3081,8 +3081,8 @@ syms_of_data (void)
   PUT_ERROR (Qunderflow_error, Fcons (Qdomain_error, arith_tail),
             "Arithmetic underflow error");
 
-  staticpro (&Qnil);
-  staticpro (&Qt);
+  staticpro (&Qnil_);
+  staticpro (&Qt_);
   staticpro (&Qunbound);
 
   /* Types that type-of returns.  */
diff --git a/src/lisp.h b/src/lisp.h
index 438affb..2afac48 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -209,19 +209,24 @@ enum enum_USE_LSB_TAG { USE_LSB_TAG = 1 };
 #define lisp_h_INTEGERP(x) (SCM_I_INUMP (x))
 #define lisp_h_MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker)
 #define lisp_h_MISCP(x) (SMOB_TYPEP (x, lisp_misc_tag))
-#define lisp_h_NILP(x) EQ (x, Qnil)
+#define lisp_h_NILP(x) (scm_is_lisp_false (x))
 #define lisp_h_SET_SYMBOL_VAL(sym, v) \
    (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v))
 #define lisp_h_SYMBOL_CONSTANT_P(sym) (XSYMBOL (sym)->constant)
 #define lisp_h_SYMBOL_VAL(sym) \
    (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value)
-#define lisp_h_SYMBOLP(x) (SMOB_TYPEP (x, lisp_symbol_tag))
+#define lisp_h_SYMBOLP(x) \
+   (SMOB_TYPEP (x, lisp_symbol_tag) || EQ (x, Qnil) || EQ (x, Qt))
 #define lisp_h_VECTORLIKEP(x) (SMOB_TYPEP (x, lisp_vectorlike_tag))
 #define lisp_h_XCAR(c) (scm_car (c))
 #define lisp_h_XCDR(c) (scm_cdr (c))
 #define lisp_h_XHASH(a) (SCM_UNPACK (a))
-#define lisp_h_XSYMBOL(a) \
-   (eassert (SYMBOLP (a)), (struct Lisp_Symbol *) SMOB_PTR (a))
+#define lisp_h_XSYMBOL(a)                               \
+  ((struct Lisp_Symbol *)                               \
+   (EQ (a, Qnil) ? SMOB_PTR (Qnil_)                     \
+    : EQ (a, Qt) ? SMOB_PTR (Qt_)                       \
+    : (eassert (SMOB_TYPEP (a, lisp_symbol_tag)),       \
+       SMOB_PTR (a))))
 
 /* When compiling via gcc -O0, define the key operations as macros, as
    Emacs is too slow otherwise.  To disable this optimization, compile
@@ -529,7 +534,8 @@ extern int char_table_translate (Lisp_Object, int);
 
 /* Defined in data.c.  */
 extern Lisp_Object Qarrayp, Qbufferp, Qbuffer_or_string_p, Qchar_table_p;
-extern Lisp_Object Qconsp, Qfloatp, Qintegerp, Qlambda, Qlistp, Qmarkerp, Qnil;
+extern Lisp_Object Qconsp, Qfloatp, Qintegerp, Qlambda, Qlistp, Qmarkerp;
+extern Lisp_Object Qnil, Qnil_, Qt, Qt_;
 extern Lisp_Object Qnumberp, Qstringp, Qsymbolp, Qvectorp;
 extern Lisp_Object Qvector_or_char_table_p, Qwholenump;
 extern Lisp_Object Ffboundp (Lisp_Object);
diff --git a/src/lread.c b/src/lread.c
index 859725d..06f6e14 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -3737,7 +3737,16 @@ it defaults to the value of `obarray'.  */)
                  SCHARS (string),
                  SBYTES (string));
   if (!INTEGERP (tem))
-    return tem;
+    {
+      /* The symbols `nil' and `t' are only returned the first time
+       * they're created, to initialize Qnil_ and Qt_.  On subsequent
+       * calls, we return Qnil and Qt instead. */
+      if (EQ (tem, Qnil_))
+        return Qnil;
+      if (EQ (tem, Qt_))
+        return Qt;
+      return tem;
+    }
 
   if (!NILP (Vpurify_flag))
     string = Fpurecopy (string);
@@ -3955,31 +3964,25 @@ init_obarray (void)
   initial_obarray = Vobarray;
   staticpro (&initial_obarray);
 
-  Qunbound = Fmake_symbol (build_pure_c_string ("unbound"));
-  /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
-     NILP (Vpurify_flag) check in intern_c_string.  */
-  Qnil = make_number (-1); Vpurify_flag = make_number (1);
-  Qnil = intern_c_string ("nil");
-
-  /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
-     so those two need to be fixed manually.  */
-  SET_SYMBOL_VAL (XSYMBOL (Qunbound), Qunbound);
-  set_symbol_function (Qunbound, Qnil);
-  set_symbol_plist (Qunbound, Qnil);
-  SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil);
-  XSYMBOL (Qnil)->constant = 1;
-  XSYMBOL (Qnil)->declared_special = 1;
-  set_symbol_plist (Qnil, Qnil);
-  set_symbol_function (Qnil, Qnil);
-
-  Qt = intern_c_string ("t");
-  SET_SYMBOL_VAL (XSYMBOL (Qt), Qt);
-  XSYMBOL (Qnil)->declared_special = 1;
-  XSYMBOL (Qt)->constant = 1;
+  Qnil = SCM_ELISP_NIL;
+  Qt = SCM_BOOL_T;
 
   /* Qt is correct even if CANNOT_DUMP.  loadup.el will set to nil at end.  */
   Vpurify_flag = Qt;
 
+  Qnil_ = intern_c_string ("nil");
+  SET_SYMBOL_VAL (XSYMBOL (Qnil_), Qnil);
+  XSYMBOL (Qnil_)->constant = 1;
+  XSYMBOL (Qnil_)->declared_special = 1;
+
+  Qt_ = intern_c_string ("t");
+  SET_SYMBOL_VAL (XSYMBOL (Qt_), Qt);
+  XSYMBOL (Qt_)->constant = 1;
+  XSYMBOL (Qt_)->declared_special = 1;
+
+  Qunbound = Fmake_symbol (build_pure_c_string ("unbound"));
+  SET_SYMBOL_VAL (XSYMBOL (Qunbound), Qunbound);
+
   DEFSYM (Qvariable_documentation, "variable-documentation");
 
   read_buffer = xmalloc_atomic (size);
-- 
1.8.1.2

>From 5b951edbb9710ccbd0178bfea5e0fee4ecbcc40f Mon Sep 17 00:00:00 2001
From: Taylan Ulrich B <address@hidden>
Date: Thu, 1 Aug 2013 04:02:40 +0300
Subject: [PATCH 2/3] Allow Scheme procedures as Elisp functions.

* src/eval.c (eval_sub, Ffuncall, funcall_lambda): Allow Scheme
  procedures.
---
 src/eval.c | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/src/eval.c b/src/eval.c
index 7911397..b2094e9 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -2349,7 +2349,7 @@ eval_sub (Lisp_Object form)
            }
        }
     }
-  else if (COMPILEDP (fun))
+  else if (COMPILEDP (fun) || scm_is_true (scm_procedure_p (fun)))
     val = apply_lambda (fun, original_args);
   else
     {
@@ -2984,7 +2984,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
            }
        }
     }
-  else if (COMPILEDP (fun))
+  else if (COMPILEDP (fun) || scm_is_true (scm_procedure_p (fun)))
     val = funcall_lambda (fun, numargs, args + 1);
   else
     {
@@ -3110,6 +3110,11 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
        }
       lexenv = Qnil;
     }
+  else if (scm_is_true (scm_procedure_p (fun)))
+    {
+      dynwind_end();
+      return scm_call_n (fun, arg_vector, nargs);
+    }
   else
     emacs_abort ();
 
-- 
1.8.1.2

>From 103a2a2348a3abfd9a2f8f967ba146a856210d7e Mon Sep 17 00:00:00 2001
From: Taylan Ulrich B <address@hidden>
Date: Thu, 1 Aug 2013 04:08:14 +0300
Subject: [PATCH 3/3] src/fns.c: Add `guile-ref' and `guile-private-ref'.
 (Feval_scheme): Don't print, it's done automatically.

---
 src/fns.c | 57 +++++++++++++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 53 insertions(+), 4 deletions(-)

diff --git a/src/fns.c b/src/fns.c
index cb89437..79a50ad 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -48,6 +48,8 @@ Lisp_Object Qcursor_in_echo_area;
 static Lisp_Object Qwidget_type;
 static Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper;
 
+static Lisp_Object Qguile_ref, Qguile_private_ref;
+
 static Lisp_Object Qmd5, Qsha1, Qsha224, Qsha256, Qsha384, Qsha512;
 
 DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
@@ -4502,12 +4504,56 @@ DEFUN ("eval-scheme", Feval_scheme, Seval_scheme, 1, 1,
        doc: /* Evaluate a string containing a Scheme expression.  */)
   (Lisp_Object string)
 {
-  Lisp_Object tem;
-
   CHECK_STRING (string);
+  return scm_c_eval_string (SSDATA (string));
+}
+
+static SCM
+elisp_symbol_or_string_to_scm (Lisp_Object obj)
+{
+  return scm_from_locale_symbol (SSDATA (SYMBOLP (obj)
+                                         ? (Fsymbol_name (obj))
+                                         : obj));
+}
+
+static SCM
+guile_ref (Lisp_Object args, int privatep)
+{
+  Lisp_Object module, binding;
+
+  if (XINT (Flength (args)) != 2)
+    xsignal2 (Qwrong_number_of_arguments,
+              (privatep ? Qguile_private_ref : Qguile_ref),
+              Flength (args));
 
-  tem = scm_c_eval_string (SSDATA (string));
-  return (INTERACTIVE ? Fprin1 (tem, Qt) : tem);
+  module = Fcar (args);
+  binding = Fcar (Fcdr (args));
+
+  CHECK_LIST (module);
+  CHECK_SYMBOL (binding);
+
+  for (Lisp_Object mod = module; !NILP (mod); mod = XCDR (mod))
+    XSETCAR (mod, elisp_symbol_or_string_to_scm (XCAR (mod)));
+
+  binding = elisp_symbol_or_string_to_scm (binding);
+
+  return ((privatep ? scm_private_ref : scm_public_ref)
+          (module, binding));
+}
+
+DEFUN ("guile-ref", Fguile_ref, Sguile_ref, 2, UNEVALLED, 0,
+       doc: /* Reference a binding in a Guile module. */)
+  (Lisp_Object args)
+{
+  return guile_ref (args, 0);
+}
+
+DEFUN ("guile-private-ref", Fguile_private_ref, Sguile_private_ref,
+       2, UNEVALLED, 0,
+       doc: /* Reference a private binding in a Guile module. */)
+  (Lisp_Object args)
+{
+  return guile_ref (args, 1);
 }
 
 void
@@ -4554,6 +4600,9 @@ syms_of_fns (void)
   DEFSYM (Qcursor_in_echo_area, "cursor-in-echo-area");
   DEFSYM (Qwidget_type, "widget-type");
 
+  DEFSYM (Qguile_ref, "guile-ref");
+  DEFSYM (Qguile_private_ref, "guile-private-ref");
+
   staticpro (&string_char_byte_cache_string);
   string_char_byte_cache_string = Qnil;
 
-- 
1.8.1.2

Taylan