elisp function subrs

* module/language/elisp/boot.el (null, consp, listp, car, cdr)
  (make-symbol, signal): Use `%funcall' instead of `funcall' or `fset'.
  (symbolp, symbol-function, eval): Use `%funcall', since `funcall' now
  calls these functions.

  (functionp, %indirect-function): New functions.
  (funcall): Define in terms of `%funcall' and `%indirect-function'.
  (apply): New function. Previously defined in
  "module/language/elisp/runtime/subrs.scm".

  (fset): If `definition' is not a function, set the function cell of
  `symbol' to an falias for `definition'.

* module/language/elisp/falias.scm: New file.

* module/language/elisp/subrs.scm: Remove file.
  (apply): Remove. Now defined in "boot.el".
* module/language/elisp/runtime/function-slot.scm: Update module
  definition.

* module/Makefile.am: Update.

module/Makefile.am

@@ -132,6 +132,7 @@ ECMASCRIPT_LANG_SOURCES =			\
   language/ecmascript/spec.scm
 
 ELISP_LANG_SOURCES =				\
+  language/elisp/falias.scm			\
   language/elisp/lexer.scm			\
   language/elisp/parser.scm			\
   language/elisp/bindings.scm			\
@@ -139,7 +140,6 @@ ELISP_LANG_SOURCES =				\
   language/elisp/runtime.scm			\
   language/elisp/runtime/function-slot.scm	\
   language/elisp/runtime/value-slot.scm		\
-  language/elisp/runtime/subrs.scm		\
   language/elisp/spec.scm
 
 BRAINFUCK_LANG_SOURCES =			\

module/language/elisp/boot.el

@@ -28,24 +28,20 @@
      (progn ,@body)))
 
 (eval-and-compile
-  (defun funcall (function &rest arguments)
-    (apply function arguments))
-  (defun fset (symbol definition)
-    (funcall (@ (language elisp runtime) set-symbol-function!)
-             symbol
-             definition))
   (defun null (object)
     (if object nil t))
-  (fset 'consp (@ (guile) pair?))
+  (defun consp (object)
+    (%funcall (@ (guile) pair?) object))
   (defun listp (object)
     (if object (consp object) t))
   (defun car (list)
-    (if list (funcall (@ (guile) car) list) nil))
+    (if list (%funcall (@ (guile) car) list) nil))
   (defun cdr (list)
-    (if list (funcall (@ (guile) cdr) list) nil))
+    (if list (%funcall (@ (guile) cdr) list) nil))
-  (fset 'make-symbol (@ (guile) make-symbol))
+  (defun make-symbol (name)
+    (%funcall (@ (guile) make-symbol) name))
   (defun signal (&rest args)
-    (funcall (@ (guile) throw) 'elisp-error args)))
+    (%funcall (@ (guile) throw) 'elisp-error args)))
 
 (defmacro lambda (&rest cdr)
   `#'(lambda ,@cdr))
@@ -117,16 +113,61 @@
             #'(lambda () ,bodyform)
             #'(lambda () ,@unwindforms)))
 
-(defun throw (tag value)
+(defun symbolp (object)
-  (funcall (@ (guile) throw) 'elisp-exception tag value))
+  (%funcall (@ (guile) symbol?) object))
+
+(defun functionp (object)
+  (%funcall (@ (guile) procedure?) object))
+
+(defun symbol-function (symbol)
+  (let ((f (%funcall (@ (language elisp runtime) symbol-function)
+                     symbol)))
+    (if (%funcall (@ (language elisp falias) falias?) f)
+        (%funcall (@ (language elisp falias) falias-object) f)
+      f)))
 
 (defun eval (form)
-  (funcall (@ (system base compile) compile)
+  (%funcall (@ (system base compile) compile)
-           form
+            form
-           (funcall (@ (guile) symbol->keyword) 'from)
+            (%funcall (@ (guile) symbol->keyword) 'from)
-           'elisp
+            'elisp
-           (funcall (@ (guile) symbol->keyword) 'to)
+            (%funcall (@ (guile) symbol->keyword) 'to)
-           'value))
+            'value))
+
+(defun %indirect-function (object)
+  (cond
+   ((functionp object)
+    object)
+   ((symbolp object)                    ;++ cycle detection
+    (%indirect-function (symbol-function object)))
+   ((listp object)
+    (eval `(function ,object)))
+   (t
+    (signal 'invalid-function `(,object)))))
+
+(defun apply (function &rest arguments)
+  (%funcall (@ (guile) apply)
+            (@ (guile) apply)
+            (%indirect-function function)
+            arguments))
+
+(defun funcall (function &rest arguments)
+  (%funcall (@ (guile) apply)
+            (%indirect-function function)
+            arguments))
+
+(defun fset (symbol definition)
+  (funcall (@ (language elisp runtime) set-symbol-function!)
+           symbol
+           (if (functionp definition)
+               definition
+             (funcall (@ (language elisp falias) make-falias)
+                      #'(lambda (&rest args) (apply definition args))
+                      definition)))
+  definition)
+
+(defun throw (tag value)
+  (funcall (@ (guile) throw) 'elisp-exception tag value))
 
 (defun load (file)
   (funcall (@ (system base compile) compile-file)
@@ -156,9 +197,9 @@
 
 ;;; Symbols
 
-(fset 'symbolp (@ (guile) symbol?))
+;;; `symbolp' and `symbol-function' are defined above.
+
 (fset 'symbol-value (@ (language elisp runtime) symbol-value))
-(fset 'symbol-function (@ (language elisp runtime) symbol-function))
 (fset 'set (@ (language elisp runtime) set-symbol-value!))
 (fset 'makunbound (@ (language elisp runtime) makunbound!))
 (fset 'fmakunbound (@ (language elisp runtime) fmakunbound!))

module/language/elisp/compile-tree-il.scm

@@ -842,9 +842,7 @@
       => (lambda (macro-function)
            (compile-expr (apply macro-function arguments))))
      (else
-      (make-application loc
+      (compile-expr `(%funcall (function ,operator) ,@arguments))))))
-                        (compile-expr `(function ,operator))
-                        (map compile-expr arguments))))))
 
 ;;; Compile a symbol expression.  This is a variable reference or maybe
 ;;; some special value like nil.

module/language/elisp/falias.scm

@@ -0,0 +1,27 @@
+(define-module (language elisp falias)
+  #:export (falias?
+            make-falias
+            falias-function
+            falias-object))
+
+(define <falias-vtable>
+  (make-struct <applicable-struct-vtable>
+               0
+               (make-struct-layout "pwpw")
+               (lambda (object port)
+                 (format port "#<falias ~S>" (falias-object object)))))
+
+(set-struct-vtable-name! <falias-vtable> 'falias)
+
+(define (falias? object)
+  (and (struct? object)
+       (eq? (struct-vtable object) <falias-vtable>)))
+
+(define (make-falias f object)
+  (make-struct <falias-vtable> 0 f object))
+
+(define (falias-function object)
+  (struct-ref object 0))
+
+(define (falias-object object)
+  (struct-ref object 1))

module/language/elisp/runtime/function-slot.scm

@@ -17,8 +17,6 @@
 ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (language elisp runtime function-slot)
-  #:use-module ((language elisp runtime subrs)
-                #:select (apply))
   #:use-module ((language elisp compile-tree-il)
                 #:select
                 ((compile-progn . progn)
@@ -66,6 +64,4 @@
                quote
                %funcall
                %set-lexical-binding-mode)
-  ;; functions
-  #:re-export (apply)
   #:pure)

module/language/elisp/runtime/subrs.scm

@@ -1,41 +0,0 @@
-;;; Guile Emacs Lisp
-
-;;; Copyright (C) 2009 Free Software Foundation, Inc.
-;;;
-;;; This library is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU Lesser General Public License as
-;;; published by the Free Software Foundation; either version 3 of the
-;;; License, or (at your option) any later version.
-;;;
-;;; This library is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;; Lesser General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU Lesser General Public
-;;; License along with this library; if not, write to the Free Software
-;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-;;; 02110-1301 USA
-
-;;; Code:
-
-(define-module (language elisp runtime subrs)
-  #:use-module (language elisp runtime)
-  #:use-module (system base compile)
-  #:export (apply))
-
-;;; Function calls. These must take care of special cases, like using
-;;; symbols or raw lambda-lists as functions!
-
-(define (apply func . args)
-  (let ((real-func (cond
-                    ((symbol? func)
-                     (symbol-function func))
-                    ((list? func)
-                     (if (and (prim not (null? func))
-                              (eq? (prim car func) 'lambda))
-                         (compile func #:from 'elisp #:to 'value)
-                         (runtime-error "list is not a function"
-                                        func)))
-                    (else func))))
-    (prim apply (@ (guile) apply) real-func args)))