summaryrefslogtreecommitdiff
path: root/module/language/elisp/runtime.scm
diff options
context:
space:
mode:
authorRobin Templeton <robin@terpri.org>2014-06-02 20:01:55 -0400
committerChristine Lemmer-Webber <cwebber@dustycloud.org>2021-10-19 18:10:04 -0400
commitcf5e02f1a666b5a05d081a7894c00c4a42d9aa53 (patch)
tree2809838ba5083e9b5e5001f4ee4de8d779902401 /module/language/elisp/runtime.scm
parentad3d498d31d574a20fd69346adcc357e74166e56 (diff)
downloadguile-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.scm197
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)