From 3709984696eaba6698318312ceaf9997f3b1c4fd Mon Sep 17 00:00:00 2001 From: Daniel Kraft Date: Thu, 23 Jul 2009 14:09:55 +0200 Subject: [PATCH] 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. --- module/language/elisp/README | 4 +- module/language/elisp/compile-tree-il.scm | 24 ++------- module/language/elisp/runtime.scm | 51 ++++++++++++++++++- .../language/elisp/runtime/function-slot.scm | 35 +++++++++++++ test-suite/tests/elisp-compiler.test | 34 +++++++++++-- 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" -- 2.20.1