From 70dca98f3500158716f49d5281d55769a44f7f67 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 27 Sep 2019 08:06:47 -0700
Subject: symbol-function: support lambda expressions.

* eval.c (lookup_fun): Check for a lambda expression and
return a faked binding containing the interpreted function.
(do_eval, op_fun): Remove checks for lambda that are now
being done in lookup_fun. In many other places where
lookup_fun is used, we still need lambda checks, like
in the expander.

* share/txr/stdlib/place.tl (sys:get-fun-getter-setter): Take
form argument. Diagnose assignments to lambda, and to unknown
function place syntax.
(defplace symbol-function): Pass sys:*pl-form* to
sys:get-fun-getter-setter as form argument.

* txr.1: fboundp and symbol-function doc updated.
---
 eval.c                    | 10 +++-------
 share/txr/stdlib/place.tl |  8 ++++++--
 txr.1                     | 30 ++++++++++++++++++++++++------
 3 files changed, 33 insertions(+), 15 deletions(-)

diff --git a/eval.c b/eval.c
index 714b86a1..7268f893 100644
--- a/eval.c
+++ b/eval.c
@@ -550,6 +550,8 @@ val lookup_fun(val env, val sym)
       }
     } else if (car(sym) == macro_s) {
       return lookup_mac(nil, cadr(sym));
+    } else if (car(sym) == lambda_s) {
+      return cons(sym, func_interp(env, sym));
     } else {
       return nil;
     }
@@ -1532,9 +1534,6 @@ static val do_eval(val form, val env, val ctx,
     } else {
       val fbinding = lookup_fun(env, oper);
 
-      if (!fbinding && consp(oper) && car(oper) == lambda_s)
-        fbinding = cons(oper, func_interp(env, oper));
-
       if (!fbinding) {
         last_form_evaled = form;
         eval_error(form, lit("~s does not name a function or operator"), oper, nao);
@@ -1855,11 +1854,8 @@ static val op_fun(val form, val env)
   val name = second(form);
   val fbinding = lookup_fun(env, name);
 
-  if (!fbinding) {
-    if (consp(name) && car(name) == lambda_s)
-      return func_interp(env, name);
+  if (!fbinding)
     eval_error(form, lit("no function exists named ~s"), name, nao);
-  }
 
   return cdr(fbinding);
 }
diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl
index 0aef499a..9fa15bdc 100644
--- a/share/txr/stdlib/place.tl
+++ b/share/txr/stdlib/place.tl
@@ -776,7 +776,7 @@
                     ^(fmakunbound ',',sym)))
        ,body)))
 
-(defun sys:get-fun-getter-setter (sym)
+(defun sys:get-fun-getter-setter (f sym)
   (tree-case sym
     ((type struct slot)
       (if (eq type 'meth)
@@ -795,6 +795,10 @@
           (cons (op cdr)
                 (op sys:rplacd cell)))
         :))
+    ((op . rest)
+     (if (eq op 'lambda)
+       (compile-error f "cannot assign to lambda")
+       (compile-error f "invalid function syntax ~s" sym)))
     (else
       (let ((cell (or (gethash sys:top-fb sym)
                       (sethash sys:top-fb sym (cons sym nil)))))
@@ -804,7 +808,7 @@
 (defplace (symbol-function sym-expr) body
   (getter setter
     (with-gensyms (gs-sym)
-      ^(let ((,gs-sym (sys:get-fun-getter-setter ,sym-expr)))
+      ^(let ((,gs-sym (sys:get-fun-getter-setter ',sys:*pl-form* ,sym-expr)))
           (macrolet ((,getter () ^(call (car ,',gs-sym)))
                      (,setter (val) ^(call (cdr ,',gs-sym) ,val)))
             ,body))))
diff --git a/txr.1 b/txr.1
index 75695f3e..6586d9fe 100644
--- a/txr.1
+++ b/txr.1
@@ -16747,10 +16747,10 @@ returns
 .SS* Global Environment
 .coNP Accessors @, symbol-function @ symbol-macro and @ symbol-value
 .synb
-.mets (symbol-function >> { symbol | << method-name } )
+.mets (symbol-function >> { symbol | < method-name | << lambda-expr })
 .mets (symbol-macro << symbol )
 .mets (symbol-value << symbol )
-.mets (set (symbol-function << symbol ) << new-value )
+.mets (set (symbol-function >> { symbol | << method-name }) << new-value )
 .mets (set (symbol-macro << symbol ) << new-value )
 .mets (set (symbol-value << symbol ) << new-value )
 .syne
@@ -16797,6 +16797,13 @@ which denote macros. Thus,
 .code symbol-function
 provides unified access to functions, methods and macros.
 
+If a
+.code lambda
+expression is passed to
+.codn symbol-function ,
+then the function implied by that expression is returned.
+It is unspecified whether this function is interpreted or compiled.
+
 The
 .code symbol-macro
 function retrieves the value of the global macro binding of
@@ -16883,6 +16890,10 @@ Storing a value, using any one of these three accessors, to a nonexistent
 variable, function or macro binding, is not erroneous. It has has the effect of
 creating that binding.
 
+Using
+.code symbol-function
+accessor to assign to a lambda expression is erroneous.
+
 Deleting a binding, using any of these three accessors, when the binding does not
 exist, also isn't erroneous. There is no effect and the
 .code del
@@ -16905,22 +16916,29 @@ function doesn't exist in Common Lisp.
 .coNP Functions @, boundp @ fboundp and @ mboundp
 .synb
 .mets (boundp << symbol )
-.mets (fboundp << symbol )
+.mets (fboundp >> { symbol | < method-name | << lambda-expr })
 .mets (mboundp << symbol )
 .syne
 .desc
 .code boundp
 returns
 .code t
-if the symbol is bound as a variable or symbol macro in the global
+if the
+.meta symbol
+is bound as a variable or symbol macro in the global
 environment, otherwise
 .codn nil .
 
 .code fboundp
 returns
 .code t
-if the symbol has a function binding in the global
-environment, otherwise it returns nil
+if the
+.meta symbol
+has a function binding in the global
+environment, the method specified by
+.meta method-name
+exists, or a lambda expression argument is given.
+Otherwise it returns nil
 .codn nil .
 
 .code mboundp
-- 
cgit v1.2.3