summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDaniel Kraft <d@domob.eu>2009-07-29 16:27:45 +0200
committerDaniel Kraft <d@domob.eu>2009-07-29 16:27:45 +0200
commite96a9591cedc0d7dff6b3e64003542ad2d10cd9d (patch)
tree1f227eae5edfa24d3ccd95fff2083ad5c5eebab5
parentc61ec8e29e0454cfd4a69daf54f100ec0f438b39 (diff)
downloadguile-e96a9591cedc0d7dff6b3e64003542ad2d10cd9d.tar.gz
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.
-rw-r--r--module/language/elisp/README3
-rw-r--r--module/language/elisp/runtime/function-slot.scm35
-rw-r--r--test-suite/tests/elisp-compiler.test47
3 files changed, 80 insertions, 5 deletions
diff --git a/module/language/elisp/README b/module/language/elisp/README
index 2c23a947f..17206221c 100644
--- 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 e2838b543..79eaeaf64 100644
--- 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 5f154d2e6..1eed4502e 100644
--- 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.