diff options
author | Robin Templeton <robin@terpri.org> | 2014-06-02 20:01:55 -0400 |
---|---|---|
committer | Christine Lemmer-Webber <cwebber@dustycloud.org> | 2021-10-19 18:10:04 -0400 |
commit | cf5e02f1a666b5a05d081a7894c00c4a42d9aa53 (patch) | |
tree | 2809838ba5083e9b5e5001f4ee4de8d779902401 /module/language/elisp/runtime.scm | |
parent | ad3d498d31d574a20fd69346adcc357e74166e56 (diff) | |
download | guile-cf5e02f1a666b5a05d081a7894c00c4a42d9aa53.tar.gz |
elisp updates
(Best-ability ChangeLog annotation added by Christine Lemmer-Webber.)
* module/language/elisp/bindings.scm (get-lexical-binding)
(get-function-binding): Use cadr instead of fluid-ref on slot.
(with-fluids**): New procedure.
(with-symbol-bindings, with-function-bindings): Use with-fluids**.
Also stop using "make-fluid", use "(list #f #f)" instead as default
lexical-bindings hashtable value.
(with-lexical-bindings): Drop the error checking for invalid targets.
* module/language/elisp/boot.el (defun, save-excursion)
(save-current-buffer, save-restriction, track-mouse, setq-default)
(catch, condition-case): New macros.
(omega, eval, gensym, interactive, autoload-do-load, fset, prin1)
(backtrace-frame, backtrace, %set-eager-macroexpansion-mode): New functions.
(null, consp, listp, car, cdr, make-symbol, signal): Wrap in eval-and-compile.
(prog1, cond, or, while): Update to make use of gensym.
(unwind-protect): Switch from funcall to %funcall.
(%functionp): Rename from functionp.
(%indirect-function): Update to use %functionp instead of functionp.
Add check for if object is null, signaling void-function. Instead of
calling symbol-function directly, call via %funcall from the module
"(language elisp runtime)".
(fset): Significant additions and refactoring.
(gload): Renamed from fload.
(defvaralias, nthcdr, nth, eq): Move functions to a different location.
(eq): Also stop using null.
(dolist): Remove quasiquoting, build list manually.
(random): Fix indentation.
(progn, eval-when-compile, if, defconst, defvar, setq, let, flet)
(labels, let*, function, defmacro, quote): Protect as special
operators by raising error if invoked as a function.
* module/language/elisp/compile-tree-il.scm: Import "(ice-9 format)".
Export compile-%function.
(lexical-binding, handle-var-def, defun, valid-symbol-list-arg?)
(process-options!): Remove.
(reference-variable): Adjust functions passed to access-variable.
(global?): Drop module parameter, use value-slot instead.
(ensure-globals!, set-variable!, parse-body-1, parse-lambda-list)
(compile-lambda, defconst, defvar, let, let*, compile-pair): Refactor.
(reference-function): Use '(elisp-functions) instead of function-slot.
(bind-lexically?): Drop module parameter, simplify.
(make-dynlet): Switch from using make-primcall to make-call.
(find-operator): Switch from using resolve-interface/resolve-module
to using function-slot.
(if, defconst, defvar, let, let*, flet, labels, guile-ref)
(guile-private-ref, guile-primitive, defmacro, `, quote, %funcall)
(%set-lexical-binding-mode): Add error checking.
(setq): Pass in args to report-error.
(function): Simplified, now calling %function.
(%function): New function, based on prior "function". Refactor, including
adding support for matching against a closure.
(%set-lexical-binding-mode): Switch from using fluid-set! to
set-lexical-binding-mode.
(special-operators): New variable. Build from following for-each
statement.
(compile-tree-il): Drop call to "process-options!"
* module/language/elisp/lexer.scm: Import "(language elisp runtime)".
(lex): Switch from using "list->string" to "make-lisp-string".
* module/language/elisp/runtime.scm: Use modules "(ice-9 format)",
"(system base compile)".
Remove from export list list, removing ensure-fluid!, symbol-fluid!,
set-symbol-fluid!. Add to export list ensure-dynamic!, symbol-name,
symbol-plist, set-symbol-plist!, bind-symbol, symbol-desc, proclaim-symbol!
special? emacs! unbound, lexical-binding?, set-lexical-binding-mode,
log!, eval-elisp, local-eval-elisp, make-lisp-string, lisp-string?
(make-list-string, lisp-string?) New function aliases.
(value-slot-module, function-slot-module): Adjust module resolution.
(nil_, t_): New variables.
(ensure-fluid!, symbol-fluid, set-symbol-fluid!): Removed.
(lexical-binding, unbound): New variables.
(lexical-binding?, set-lexical-binding-mode, unbound, dynamic?)
(make-dynamic, dynamic-ref, dynamic-set!, dynamic-unset!)
(dynamic-bound?, dynamic-bind, ensure-present!, ensure-desc!)
(schemify, symbol-name, symbol-desc, ensure-dynamic!, symbol-dynamic)
(set-symbol-plist!, special?, proclaim-special!, emacs!, eval-elisp)
(make-string): New procedures.
(symbol-value): Use dynamic-ref! instead of fluid-ref!.
(set-symbol-value!): Use dynamic-set! instead of fluid-set!.
(symbol-function, set-symbol-function!, symbol-bound?)
(symbol-fbound?, makunbound!, fmakunbound!): Refactor, including
adjusting how module resolution is being done.
* module/language/elisp/spec.scm: Import module "(system vm vm)".
Setup elisp-symbols, elisp-functions, elisp-plists.
Use "set-default-vm-engine!" and "set-vm-engine!" to be set to
'debug.
(elisp): Comment out joiner.
Diffstat (limited to 'module/language/elisp/runtime.scm')
-rw-r--r-- | module/language/elisp/runtime.scm | 197 |
1 files changed, 155 insertions, 42 deletions
diff --git a/module/language/elisp/runtime.scm b/module/language/elisp/runtime.scm index 6f6a22074..bedb15a8a 100644 --- a/module/language/elisp/runtime.scm +++ b/module/language/elisp/runtime.scm @@ -19,22 +19,39 @@ ;;; Code: (define-module (language elisp runtime) + #:use-module (ice-9 format) + #:use-module ((system base compile) + #:select (compile)) #:export (nil-value t-value value-slot-module function-slot-module elisp-bool - ensure-fluid! - symbol-fluid - set-symbol-fluid! + ensure-dynamic! + symbol-name symbol-value set-symbol-value! symbol-function set-symbol-function! + symbol-plist + set-symbol-plist! symbol-bound? symbol-fbound? + bind-symbol makunbound! - fmakunbound!) + fmakunbound! + symbol-desc + proclaim-special! + special? + emacs! + unbound + lexical-binding? + set-lexical-binding-mode + log! + eval-elisp + local-eval-elisp + make-lisp-string + lisp-string?) #:export-syntax (defspecial prim)) ;;; This module provides runtime support for the Elisp front-end. @@ -45,13 +62,21 @@ (define t-value #t) +(define make-lisp-string identity) +(define lisp-string? string?) + ;;; 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 value-slot-module (resolve-module '(elisp-symbols))) + +(define function-slot-module (resolve-module '(elisp-functions))) -(define function-slot-module '(language elisp runtime function-slot)) +(define plist-slot-module (resolve-module '(elisp-plists))) + +(define nil_ 'nil) +(define t_ 't) ;;; Routines for access to elisp dynamically bound symbols. This is ;;; used for runtime access using functions like symbol-value or set, @@ -59,75 +84,163 @@ ;;; 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-unbound-fluid))) - (module-define! resolved sym fluid) - (module-export! resolved `(,sym)))))) - -(define (symbol-fluid symbol) - (let ((module (resolve-module value-slot-module))) - (ensure-fluid! value-slot-module symbol) ;++ implicit special proclamation - (module-ref module symbol))) +(define lexical-binding #t) + +(define (lexical-binding?) + lexical-binding) + +(define (set-lexical-binding-mode x) + (set! lexical-binding x)) + +(define unbound (make-symbol "unbound")) + +(define dynamic? vector?) +(define (make-dynamic) + (vector #f 4 0 0 unbound)) +(define (dynamic-ref x) + (vector-ref x 4)) +(define (dynamic-set! x v) + (vector-set! x 4 v)) +(define (dynamic-unset! x) + (vector-set! x 4 unbound)) +(define (dynamic-bound? x) + (not (eq? (vector-ref x 4) unbound))) +(define (dynamic-bind x v thunk) + (let ((old (vector-ref x 4))) + (dynamic-wind + (lambda () (vector-set! x 4 v)) + thunk + (lambda () (vector-set! x 4 old))))) + +(define-inlinable (ensure-present! module sym thunk) + (or (module-local-variable module sym) + (let ((variable (make-variable (thunk)))) + (module-add! module sym variable) + variable))) + +(define-inlinable (ensure-desc! module sym) + (ensure-present! module + sym + (lambda () + (let ((x (make-dynamic))) + (vector-set! x 0 sym) + x)))) + +(define-inlinable (schemify symbol) + (case symbol + ((#nil) nil_) + ((#t) t_) + (else symbol))) + +(define (symbol-name symbol) + (symbol->string (schemify symbol))) + +(define (symbol-desc symbol) + (let ((symbol (schemify symbol))) + (let ((module value-slot-module)) + (variable-ref (ensure-desc! module symbol))))) + +(define (ensure-dynamic! sym) + (vector-set! (symbol-desc sym) 3 1)) -(define (set-symbol-fluid! symbol fluid) - (let ((module (resolve-module value-slot-module))) - (module-define! module symbol fluid) - (module-export! module (list symbol))) - fluid) +(define (symbol-dynamic symbol) + (ensure-dynamic! symbol) + (symbol-desc symbol)) (define (symbol-value symbol) - (fluid-ref (symbol-fluid symbol))) + (dynamic-ref (symbol-desc symbol))) (define (set-symbol-value! symbol value) - (fluid-set! (symbol-fluid symbol) value) + (dynamic-set! (symbol-desc symbol) value) value) (define (symbol-function symbol) - (let ((module (resolve-module function-slot-module))) + (set! symbol (schemify symbol)) + (ensure-present! function-slot-module symbol (lambda () #nil)) + (let ((module function-slot-module)) (module-ref module symbol))) (define (set-symbol-function! symbol value) - (let ((module (resolve-module function-slot-module))) + (set! symbol (schemify symbol)) + (ensure-present! function-slot-module symbol (lambda () #nil)) + (let ((module function-slot-module)) + (module-define! module symbol value) + (module-export! module (list symbol))) + value) + +(define (symbol-plist symbol) + (set! symbol (schemify symbol)) + (ensure-present! plist-slot-module symbol (lambda () #nil)) + (let ((module plist-slot-module)) + (module-ref module symbol))) + +(define (set-symbol-plist! symbol value) + (set! symbol (schemify symbol)) + (ensure-present! plist-slot-module symbol (lambda () #nil)) + (let ((module plist-slot-module)) (module-define! module symbol value) (module-export! module (list symbol))) value) (define (symbol-bound? symbol) + (set! symbol (schemify symbol)) (and - (module-bound? (resolve-interface value-slot-module) symbol) - (let ((var (module-variable (resolve-module value-slot-module) + (module-bound? value-slot-module symbol) + (let ((var (module-variable value-slot-module symbol))) (and (variable-bound? var) - (if (fluid? (variable-ref var)) - (fluid-bound? (variable-ref var)) + (if (dynamic? (variable-ref var)) + (dynamic-bound? (variable-ref var)) #t))))) (define (symbol-fbound? symbol) + (set! symbol (schemify symbol)) (and - (module-bound? (resolve-interface function-slot-module) symbol) + (module-bound? function-slot-module symbol) (variable-bound? - (module-variable (resolve-module function-slot-module) - symbol)))) + (module-variable function-slot-module symbol)) + (variable-ref (module-variable function-slot-module symbol)))) + +(define (bind-symbol symbol value thunk) + (dynamic-bind (symbol-desc symbol) value thunk)) (define (makunbound! symbol) - (if (module-bound? (resolve-interface value-slot-module) symbol) - (let ((var (module-variable (resolve-module value-slot-module) + (if (module-bound? value-slot-module symbol) + (let ((var (module-variable value-slot-module symbol))) - (if (and (variable-bound? var) (fluid? (variable-ref var))) - (fluid-unset! (variable-ref var)) + (if (and (variable-bound? var) (dynamic? (variable-ref var))) + (dynamic-unset! (variable-ref var)) (variable-unset! var)))) symbol) (define (fmakunbound! symbol) - (if (module-bound? (resolve-interface function-slot-module) symbol) - (variable-unset! (module-variable - (resolve-module function-slot-module) - symbol))) + (if (module-bound? function-slot-module symbol) + (variable-unset! (module-variable function-slot-module symbol))) symbol) +(define (special? sym) + (eqv? (vector-ref (symbol-desc sym) 3) 1)) + +(define (proclaim-special! sym) + (vector-set! (symbol-desc sym) 3 1) + #nil) + +(define (emacs! ref set boundp bind) + (set! symbol-value ref) + (set! set-symbol-value! set) + (set! symbol-bound? boundp) + (set! bind-symbol bind) + (set! lexical-binding? (lambda () (symbol-value 'lexical-binding))) + (set! set-lexical-binding-mode (lambda (x) (set-symbol-value! 'lexical-binding x)))) + +(define (eval-elisp form) + (compile form #:from 'elisp #:to 'value)) + +(set-symbol-value! nil_ #nil) +(set-symbol-value! t_ #t) + +(define (make-string s) s) + ;;; Define a predefined macro for use in the function-slot module. (define (make-id template-id . data) |