diff options
author | Daniel Kraft <d@domob.eu> | 2009-07-29 16:27:45 +0200 |
---|---|---|
committer | Daniel Kraft <d@domob.eu> | 2009-07-29 16:27:45 +0200 |
commit | e96a9591cedc0d7dff6b3e64003542ad2d10cd9d (patch) | |
tree | 1f227eae5edfa24d3ccd95fff2083ad5c5eebab5 | |
parent | c61ec8e29e0454cfd4a69daf54f100ec0f438b39 (diff) | |
download | guile-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/README | 3 | ||||
-rw-r--r-- | module/language/elisp/runtime/function-slot.scm | 35 | ||||
-rw-r--r-- | test-suite/tests/elisp-compiler.test | 47 |
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. |