funcall, apply and eval built-ins.

* module/language/elisp/README: Document new features.
* module/language/elisp/runtime/function-slot.scm: Implement funcall, apply and
  eval by using the existing compiler code.
* test-suite/tests/elisp-compiler.test: Test those.

diff --git a/module/language/elisp/README b/module/language/elisp/README
index 2c23a94..1720622 100644 (file)
--- a/module/language/elisp/README
+++ b/module/language/elisp/README
@@ -11,6 +11,8 @@ Already implemented:
   * referencing and setting (setq) variables
   * set, symbol-value, makunbound, boundp functions
   * fset, symbol-function, fmakunbound, fboundp
+  * funcall, apply (also with raw lists as arguments and the like!)
+  * eval
   * while, dotimes, dolist
   * catch, throw, unwind-protect
   * let, let*
@@ -23,7 +25,6 @@ Already implemented:
 Especially still missing:
   * real elisp reader instead of Scheme's
   * more general built-ins
-  * funcall and apply functions
   * advice?
   * defsubst and inlining
   * recursive macros

diff --git a/module/language/elisp/runtime/function-slot.scm b/module/language/elisp/runtime/function-slot.scm
index e2838b5..79eaeaf 100644 (file)
--- a/module/language/elisp/runtime/function-slot.scm
+++ b/module/language/elisp/runtime/function-slot.scm
@@ -20,7 +20,8 @@
 ;;; Code:
 
 (define-module (language elisp runtime function-slot)
-  #:use-module (language elisp runtime))
+  #:use-module (language elisp runtime)
+  #:use-module (system base compile))
 
 ; This module contains the function-slots of elisp symbols.  Elisp built-in
 ; functions are implemented as predefined function bindings here.
@@ -272,6 +273,29 @@
                   (eq? void (reference-variable function-slot-module sym))))))
 
 
+; Function calls.  These must take care of special cases, like using symbols
+; or raw lambda-lists as functions!
+
+(built-in-func apply
+  (lambda (func . args)
+    (let ((real-func (cond
+                       ((symbol? func)
+                        (reference-variable-with-check function-slot-module
+                                                       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))))
+
+(built-in-func funcall
+  (let ((myapply (fluid-ref apply)))
+    (lambda (func . args)
+      (myapply func args))))
+
+
 ; Throw can be implemented as built-in function.
 
 (built-in-func throw
@@ -281,5 +305,10 @@
 
 ; Miscellaneous.
 
-(built-in-func not (lambda (x)
-                     (if x nil-value t-value)))
+(built-in-func not
+  (lambda (x)
+    (if x nil-value t-value)))
+
+(built-in-func eval
+  (lambda (form)
+    (compile form #:from 'elisp #:to 'value)))

diff --git a/test-suite/tests/elisp-compiler.test b/test-suite/tests/elisp-compiler.test
index 5f154d2..1eed450 100644 (file)
--- a/test-suite/tests/elisp-compiler.test
+++ b/test-suite/tests/elisp-compiler.test
@@ -182,6 +182,32 @@
            (and (= a 0) (= b 0) (= c 0)
                 (= (unwind-protect 42 1 2 3) 42)))))
 
+(with-test-prefix/compile "Eval"
+
+  (pass-if-equal "basic eval" 3
+    (progn (setq code '(+ 1 2))
+           (eval code)))
+
+  (pass-if "real dynamic code"
+    (and (setq a 1 b 1 c 1)
+         (defun set-code (var val)
+           (list 'setq var val))
+         (= a 1) (= b 1) (= c 1)
+         (eval (set-code 'a '(+ 2 3)))
+         (eval (set-code 'c 42))
+         (= a 5) (= b 1) (= c 42)))
+
+  ; Build code that recursively again and again calls eval.  What we want is
+  ; something like:
+  ; (eval '(1+ (eval '(1+ (eval 1)))))
+  (pass-if "recursive eval"
+    (progn (setq depth 10 i depth)
+           (setq code '(eval 0))
+           (while (not (zerop i))
+             (setq code (\` (eval (quote (1+ (\, code))))))
+             (setq i (1- i)))
+           (= (eval code) depth))))
+
 
 ; Test handling of variables.
 ; ===========================
@@ -193,6 +219,9 @@
   (pass-if-equal "setq and reference" 6
     (progn (setq a 1 b 2 c 3)
            (+ a b c)))
+  (pass-if-equal "setq evaluation order" 1
+    (progn (setq a 0 b 0)
+           (setq a 1 b a)))
   (pass-if-equal "setq value" 2
     (progn (setq a 1 b 2)))
 
@@ -410,7 +439,23 @@
            (defun bar (a)
              (foo))
            (and (= 43 (bar 42))
-                (zerop a)))))
+                (zerop a))))
+
+  (pass-if "funcall and apply argument handling"
+    (and (defun allid (&rest args) args)
+         (setq allid-var (symbol-function 'allid))
+         (equal (funcall allid-var 1 2 3) '(1 2 3))
+         (equal (funcall allid-var) nil)
+         (equal (funcall allid-var 1 2 '(3 4)) '(1 2 (3 4)))
+         (equal (funcall allid-var '()) '(()))
+         (equal (apply allid-var 1 2 '(3 4)) '(1 2 3 4))
+         (equal (apply allid-var '(1 2)) '(1 2))
+         (equal (apply allid-var '()) nil)))
+
+  (pass-if "raw functions with funcall"
+    (and (= (funcall '+ 1 2) 3)
+         (= (funcall (lambda (a b) (+ a b)) 1 2) 3)
+         (= (funcall '(lambda (a b) (+ a b)) 1 2) 3))))
 
 
 ; Quoting and Backquotation.