summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDaniel Kraft <d@domob.eu>2009-07-23 14:09:55 +0200
committerDaniel Kraft <d@domob.eu>2009-07-23 14:09:55 +0200
commit3709984696eaba6698318312ceaf9997f3b1c4fd (patch)
treedda331ce11b7bb46ad9c2626468b1ebc559133ee
parent33da12eeff22c5b460fc01f2e0e8fe8f85a1d220 (diff)
downloadguile-3709984696eaba6698318312ceaf9997f3b1c4fd.tar.gz
Implemented dynamic symbol access built-ins (set, fset, symbol-value, makunbound...)
* module/language/elisp/README: Document it. * module/language/elisp/compile-tree-il.scm: Moved ensure-fluid! to runtime function. * module/language/elisp/runtime.scm: Runtime functions to support dynamic value access. * module/language/elisp/runtime/function-slot.scm: Defined the built-ins. * test-suite/tests/elisp-compiler.test: Test them.
-rw-r--r--module/language/elisp/README4
-rw-r--r--module/language/elisp/compile-tree-il.scm24
-rw-r--r--module/language/elisp/runtime.scm51
-rw-r--r--module/language/elisp/runtime/function-slot.scm35
-rw-r--r--test-suite/tests/elisp-compiler.test34
5 files changed, 121 insertions, 27 deletions
diff --git a/module/language/elisp/README b/module/language/elisp/README
index 9cfe14384..140124dba 100644
--- a/module/language/elisp/README
+++ b/module/language/elisp/README
@@ -9,6 +9,8 @@ Already implemented:
* if, cond, when, unless
* not, and, or
* referencing and setting (setq) variables
+ * set, symbol-value, makunbound, boundp functions
+ * fset, symbol-function, fmakunbound, fboundp
* while, dotimes, dolist
* catch, throw, unwind-protect
* let, let*
@@ -20,10 +22,8 @@ Already implemented:
Especially still missing:
* real elisp reader instead of Scheme's
- * set, makunbound, boundp functions
* more general built-ins
* funcall and apply functions
- * fset & friends, defalias functions
* advice?
* defsubst and inlining
* need fluids for function bindings?
diff --git a/module/language/elisp/compile-tree-il.scm b/module/language/elisp/compile-tree-il.scm
index 03772ff5f..e44303b4c 100644
--- a/module/language/elisp/compile-tree-il.scm
+++ b/module/language/elisp/compile-tree-il.scm
@@ -46,9 +46,9 @@
; Modules that contain the value and function slot bindings.
(define runtime '(language elisp runtime))
-(define value-slot '(language elisp runtime value-slot))
-(define function-slot '(language elisp runtime function-slot))
(define macro-slot '(language elisp runtime macro-slot))
+(define value-slot (@ (language elisp runtime) value-slot-module))
+(define function-slot (@ (language elisp runtime) function-slot-module))
; The backquoting works the same as quasiquotes in Scheme, but the forms are
@@ -94,23 +94,9 @@
; the fluids are really generated with this routine.
(define (generate-ensure-fluid loc sym module)
- (let ((resolved-module (call-primitive loc 'resolve-module
- (make-const loc module)))
- (resolved-intf (call-primitive loc 'resolve-interface
- (make-const loc module))))
- (make-conditional loc
- (call-primitive loc 'module-defined? resolved-intf (make-const loc sym))
- (make-void loc)
- (make-sequence loc
- (list (call-primitive loc 'module-define!
- resolved-module (make-const loc sym)
- (call-primitive loc 'make-fluid))
- (call-primitive loc 'module-export!
- resolved-module
- (call-primitive loc 'list (make-const loc sym)))
- (call-primitive loc 'fluid-set!
- (make-module-ref loc module sym #t)
- (make-module-ref loc runtime 'void #t)))))))
+ (make-application loc (make-module-ref loc runtime 'ensure-fluid! #t)
+ (list (make-const loc module)
+ (make-const loc sym))))
; Generate code to reference a fluid saved variable.
diff --git a/module/language/elisp/runtime.scm b/module/language/elisp/runtime.scm
index 1ec5bb4c1..bad9b38c4 100644
--- a/module/language/elisp/runtime.scm
+++ b/module/language/elisp/runtime.scm
@@ -20,7 +20,16 @@
;;; Code:
(define-module (language elisp runtime)
- #:export (void nil-value t-value elisp-bool runtime-error macro-error)
+ #:export (void
+ nil-value t-value
+ value-slot-module function-slot-module
+
+ elisp-bool
+
+ ensure-fluid! reference-variable reference-variable-with-check
+ set-variable!
+
+ runtime-error macro-error)
#:export-syntax (built-in-func built-in-macro prim))
; This module provides runtime support for the Elisp front-end.
@@ -38,6 +47,14 @@
(define t-value #t)
+; Modules for the binding slots.
+; Note: Naming those value-slot and/or function-slot clashes with the
+; submodules of these names!
+
+(define value-slot-module '(language elisp runtime value-slot))
+(define function-slot-module '(language elisp runtime function-slot))
+
+
; Report an error during macro compilation, that means some special compilation
; (syntax) error; or report a simple runtime-error from a built-in function.
@@ -55,6 +72,38 @@
nil-value))
+; Routines for access to elisp dynamically bound symbols.
+; This is used for runtime access using functions like symbol-value or set,
+; where the symbol accessed might not be known at compile-time.
+; These always access the dynamic binding and can not be used for the lexical!
+
+(define (ensure-fluid! module sym)
+ (let ((intf (resolve-interface module))
+ (resolved (resolve-module module)))
+ (if (not (module-defined? intf sym))
+ (let ((fluid (make-fluid)))
+ (fluid-set! fluid void)
+ (module-define! resolved sym fluid)
+ (module-export! resolved `(,sym))))))
+
+(define (reference-variable module sym)
+ (ensure-fluid! module sym)
+ (let ((resolved (resolve-module module)))
+ (fluid-ref (module-ref resolved sym))))
+
+(define (reference-variable-with-check module sym)
+ (let ((value (reference-variable module sym)))
+ (if (eq? value void)
+ (runtime-error "variable is void:" sym)
+ value)))
+
+(define (set-variable! module sym value)
+ (ensure-fluid! module sym)
+ (let ((resolved (resolve-module module)))
+ (fluid-set! (module-ref resolved sym) value)
+ value))
+
+
; Define a predefined function or predefined macro for use in the function-slot
; and macro-slot modules, respectively.
diff --git a/module/language/elisp/runtime/function-slot.scm b/module/language/elisp/runtime/function-slot.scm
index bc1645d8d..805f22a38 100644
--- a/module/language/elisp/runtime/function-slot.scm
+++ b/module/language/elisp/runtime/function-slot.scm
@@ -235,6 +235,41 @@
val))
+; Accessing symbol bindings for symbols known only at runtime.
+
+(built-in-func symbol-value
+ (lambda (sym)
+ (reference-variable-with-check value-slot-module sym)))
+(built-in-func symbol-function
+ (lambda (sym)
+ (reference-variable-with-check function-slot-module sym)))
+
+(built-in-func set
+ (lambda (sym value)
+ (set-variable! value-slot-module sym value)))
+(built-in-func fset
+ (lambda (sym value)
+ (set-variable! function-slot-module sym value)))
+
+(built-in-func makunbound
+ (lambda (sym)
+ (set-variable! value-slot-module sym void)
+ sym))
+(built-in-func fmakunbound
+ (lambda (sym)
+ (set-variable! function-slot-module sym void)
+ sym))
+
+(built-in-func boundp
+ (lambda (sym)
+ (elisp-bool (prim not
+ (eq? void (reference-variable value-slot-module sym))))))
+(built-in-func fboundp
+ (lambda (sym)
+ (elisp-bool (prim not
+ (eq? void (reference-variable function-slot-module sym))))))
+
+
; Throw can be implemented as built-in function.
(built-in-func throw
diff --git a/test-suite/tests/elisp-compiler.test b/test-suite/tests/elisp-compiler.test
index cb87840a3..67dbc70ed 100644
--- a/test-suite/tests/elisp-compiler.test
+++ b/test-suite/tests/elisp-compiler.test
@@ -191,9 +191,19 @@
(pass-if-equal "setq and reference" 6
(progn (setq a 1 b 2 c 3)
(+ a b c)))
-
(pass-if-equal "setq value" 2
- (progn (setq a 1 b 2))))
+ (progn (setq a 1 b 2)))
+
+ (pass-if "set and symbol-value"
+ (progn (setq myvar 'a)
+ (and (= (set myvar 42) 42)
+ (= a 42)
+ (= (symbol-value myvar) 42))))
+ (pass-if "void variables"
+ (progn (setq a 1 b 2)
+ (and (eq (makunbound 'b) 'b)
+ (boundp 'a)
+ (not (boundp 'b))))))
(with-test-prefix/compile "Let and Let*"
@@ -235,9 +245,9 @@
(progn (setq a 42)
(defvar a 1 "Some docstring is also ok")
a))
- ; FIXME: makunbound a!
(pass-if-equal "defvar on undefined variable" 1
- (progn (defvar a 1)
+ (progn (makunbound 'a)
+ (defvar a 1)
a))
(pass-if-equal "defvar value" 'a
(defvar a)))
@@ -267,7 +277,21 @@
(progn (defun test (a b) (+ a b))
(test 1 2)))
(pass-if-equal "defun value" 'test
- (defun test (a b) (+ a b))))
+ (defun test (a b) (+ a b)))
+
+ (pass-if "fset and symbol-function"
+ (progn (setq myfunc 'x x 5)
+ (and (= (fset myfunc 42) 42)
+ (= (symbol-function myfunc) 42)
+ (= x 5))))
+ (pass-if "void function values"
+ (progn (setq a 1)
+ (defun test (a b) (+ a b))
+ (fmakunbound 'a)
+ (fset 'b 5)
+ (and (fboundp 'b) (fboundp 'test)
+ (not (fboundp 'a))
+ (= a 1)))))
(with-test-prefix/compile "Calling Functions"