elisp updates

(Best-ability ChangeLog annotation added by Christopher Allan 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.

6 files changed, 583 insertions, 263 deletions

diff --git a/module/language/elisp/bindings.scm b/module/language/elisp/bindings.scm
index 9fabddfc4..1dc296f68 100644
--- a/module/language/elisp/bindings.scm
+++ b/module/language/elisp/bindings.scm
@@ -61,12 +61,22 @@
   (let* ((lex (lexical-bindings bindings))
          (slot (hash-ref lex sym #f)))
     (if slot
-        (fluid-ref slot)
+        (cadr slot)
         #f)))
 
 (define (get-function-binding bindings symbol)
   (and=> (hash-ref (function-bindings bindings) symbol)
-         fluid-ref))
+         cadr))
+
+(define (with-fluids** fls vals proc)
+  (dynamic-wind
+    (lambda ()
+      (for-each (lambda (f v) (set-cdr! f (cons v (cdr f))))
+                fls vals))
+    proc
+    (lambda ()
+      (for-each (lambda (f) (set-cdr! f (cdr (cdr f))))
+                fls))))
 
 ;;; Establish a binding or mark a symbol as dynamically bound for the
 ;;; extent of calling proc.
@@ -78,17 +88,14 @@
   (let ((lex (lexical-bindings bindings)))
     (for-each (lambda (sym)
                 (if (not (hash-ref lex sym))
-                    (hash-set! lex sym (make-fluid))))
+                    (hash-set! lex sym (list #f #f))))
               syms)
-    (with-fluids* (map (lambda (sym) (hash-ref lex sym)) syms)
-                  targets
-                  proc)))
+    (with-fluids** (map (lambda (sym) (hash-ref lex sym)) syms)
+                   targets
+                   proc)))
 
 (define (with-lexical-bindings bindings syms targets proc)
-  (if (or (not (list? targets))
-          (not (and-map symbol? targets)))
-      (error "invalid targets for lexical binding" targets)
-      (with-symbol-bindings bindings syms targets proc)))
+  (with-symbol-bindings bindings syms targets proc))
 
 (define (with-dynamic-bindings bindings syms proc)
   (with-symbol-bindings bindings
@@ -100,8 +107,8 @@
   (let ((fb (function-bindings bindings)))
     (for-each (lambda (symbol)
                 (if (not (hash-ref fb symbol))
-                    (hash-set! fb symbol (make-fluid))))
+                    (hash-set! fb symbol (list #f #f))))
               symbols)
-    (with-fluids* (map (cut hash-ref fb <>) symbols)
-                  gensyms
-                  thunk)))
+    (with-fluids** (map (cut hash-ref fb <>) symbols)
+                   gensyms
+                   thunk)))
diff --git a/module/language/elisp/boot.el b/module/language/elisp/boot.el
index f55722a9a..1079357be 100644
--- a/module/language/elisp/boot.el
+++ b/module/language/elisp/boot.el
@@ -22,12 +22,27 @@
 (defmacro @ (module symbol)
   `(guile-ref ,module ,symbol))
 
+(defmacro defun (name args &rest body)
+  `(let ((proc (function (lambda ,args ,@body))))
+     (%funcall (@ (language elisp runtime) set-symbol-function!)
+               ',name
+               proc)
+     (%funcall (@ (guile) set-procedure-property!)
+               proc 'name ',name)
+     ',name))
+
+(defun omega () (omega))
+
 (defmacro eval-and-compile (&rest body)
   `(progn
      (eval-when-compile ,@body)
      (progn ,@body)))
 
 (eval-and-compile
+  (defun eval (form)
+    (%funcall (@ (language elisp runtime) eval-elisp) form)))
+
+(eval-and-compile
   (defun null (object)
     (if object nil t))
   (defun consp (object)
@@ -40,6 +55,8 @@
     (if list (%funcall (@ (guile) cdr) list) nil))
   (defun make-symbol (name)
     (%funcall (@ (guile) make-symbol) name))
+  (defun gensym ()
+    (%funcall (@ (guile) gensym)))
   (defun signal (error-symbol data)
     (%funcall (@ (guile) throw) 'elisp-condition error-symbol data)))
 
@@ -47,12 +64,15 @@
   `#'(lambda ,@cdr))
 
 (defmacro prog1 (first &rest body)
-  (let ((temp (make-symbol "prog1-temp")))
+  (let ((temp (gensym)))
     `(let ((,temp ,first))
        (declare (lexical ,temp))
        ,@body
        ,temp)))
 
+(defun interactive (&optional arg)
+  nil)
+
 (defmacro prog2 (form1 form2 &rest body)
   `(progn ,form1 (prog1 ,form2 ,@body)))
 
@@ -65,7 +85,7 @@
          (let ((condition (car first))
                (body (cdr first)))
            (if (null body)
-               (let ((temp (make-symbol "cond-temp")))
+               (let ((temp (gensym)))
                  `(let ((,temp ,condition))
                     (declare (lexical ,temp))
                     (if ,temp
@@ -86,7 +106,7 @@
 (defmacro or (&rest conditions)
   (cond ((null conditions) nil)
         ((null (cdr conditions)) (car conditions))
-        (t (let ((temp (make-symbol "or-temp")))
+        (t (let ((temp (gensym)))
              `(let ((,temp ,(car conditions)))
                 (declare (lexical ,temp))
                 (if ,temp
@@ -118,7 +138,7 @@
     (loop bindings '())))
 
 (defmacro while (test &rest body)
-  (let ((loop (make-symbol "loop")))
+  (let ((loop (gensym)))
     `(labels ((,loop ()
                  (if ,test
                      (progn ,@body (,loop))
@@ -126,10 +146,10 @@
        (,loop))))
 
 (defmacro unwind-protect (bodyform &rest unwindforms)
-  `(funcall (@ (guile) dynamic-wind)
-            #'(lambda () nil)
-            #'(lambda () ,bodyform)
-            #'(lambda () ,@unwindforms)))
+  `(%funcall (@ (guile) dynamic-wind)
+             #'(lambda () nil)
+             #'(lambda () ,bodyform)
+             #'(lambda () ,@unwindforms)))
 
 (defmacro when (cond &rest body)
   `(if ,cond
@@ -142,7 +162,7 @@
 (defun symbolp (object)
   (%funcall (@ (guile) symbol?) object))
 
-(defun functionp (object)
+(defun %functionp (object)
   (%funcall (@ (guile) procedure?) object))
 
 (defun symbol-function (symbol)
@@ -162,10 +182,13 @@
 
 (defun %indirect-function (object)
   (cond
-   ((functionp object)
+   ((%functionp object)
     object)
+   ((null object)
+    (signal 'void-function nil))
    ((symbolp object)                    ;++ cycle detection
-    (%indirect-function (symbol-function object)))
+    (%indirect-function
+     (%funcall (@ (language elisp runtime) symbol-function) object)))
    ((listp object)
     (eval `(function ,object)))
    (t
@@ -182,17 +205,67 @@
             (%indirect-function function)
             arguments))
 
+(defun autoload-do-load (fundef &optional funname macro-only)
+  (and (load (cadr fundef))
+       (%indirect-function funname)))
+
+(defun fset (symbol definition)
+  (funcall (@ (language elisp runtime) set-symbol-function!)
+           symbol
+           definition))
+
+(defun eq (obj1 obj2)
+  (if obj1
+      (%funcall (@ (guile) eq?) obj1 obj2)
+    (if obj2 nil t)))
+
+(defun nthcdr (n list)
+  (let ((i 0))
+    (while (< i n)
+      (setq list (cdr list)
+            i (+ i 1)))
+    list))
+
+(defun nth (n list)
+  (car (nthcdr n list)))
+
 (defun fset (symbol definition)
   (funcall (@ (language elisp runtime) set-symbol-function!)
            symbol
-           (if (functionp definition)
-               definition
+           (cond
+            ((%funcall (@ (guile) procedure?) definition)
+             definition)
+            ((and (consp definition)
+                  (eq (car definition) 'macro))
+             (if (%funcall (@ (guile) procedure?) (cdr definition))
+                 definition
+               (cons 'macro
+                     (funcall (@ (language elisp falias) make-falias)
+                              (function
+                               (lambda (&rest args) (apply (cdr definition) args)))
+                              (cdr definition)))))
+            ((and (consp definition)
+                  (eq (car definition) 'autoload))
+             (if (or (eq (nth 4 definition) 'macro)
+                     (eq (nth 4 definition) t))
+                 (cons 'macro
+                       (funcall
+                        (@ (language elisp falias) make-falias)
+                        (function (lambda (&rest args)
+                                    (apply (cdr (autoload-do-load definition symbol nil)) args)))
+                        definition))
+               (funcall
+                (@ (language elisp falias) make-falias)
+                (function (lambda (&rest args)
+                            (apply (autoload-do-load definition symbol nil) args)))
+                definition)))
+            (t
              (funcall (@ (language elisp falias) make-falias)
-                      #'(lambda (&rest args) (apply definition args))
-                      definition)))
+                      (function (lambda (&rest args) (apply definition args)))
+                      definition))))
   definition)
 
-(defun load (file)
+(defun gload (file)
   (funcall (@ (system base compile) compile-file)
            file
            (funcall (@ (guile) symbol->keyword) 'from)
@@ -203,11 +276,6 @@
 
 ;;; Equality predicates
 
-(defun eq (obj1 obj2)
-  (if obj1
-      (funcall (@ (guile) eq?) obj1 obj2)
-    (null obj2)))
-
 (defun eql (obj1 obj2)
   (if obj1
       (funcall (@ (guile) eqv?) obj1 obj2)
@@ -231,13 +299,13 @@
 (fset 'fboundp (@ (language elisp runtime) symbol-fbound?))
 (fset 'intern (@ (guile) string->symbol))
 
-(defun defvaralias (new-alias base-variable &optional docstring)
-  (let ((fluid (funcall (@ (language elisp runtime) symbol-fluid)
-                        base-variable)))
-    (funcall (@ (language elisp runtime) set-symbol-fluid!)
-             new-alias
-             fluid)
-    base-variable))
+;(defun defvaralias (new-alias base-variable &optional docstring)
+;  (let ((fluid (funcall (@ (language elisp runtime) symbol-fluid)
+;                        base-variable)))
+;    (funcall (@ (language elisp runtime) set-symbol-fluid!)
+;             new-alias
+;             fluid)
+;    base-variable))
 
 ;;; Numerical type predicates
 
@@ -344,16 +412,6 @@
         newcdr)
     (signal 'wrong-type-argument `(consp ,cell))))
 
-(defun nthcdr (n list)
-  (let ((i 0))
-    (while (< i n)
-      (setq list (cdr list)
-            i (+ i 1)))
-    list))
-
-(defun nth (n list)
-  (car (nthcdr n list)))
-
 (defun %member (elt list test)
   (cond
    ((null list) nil)
@@ -400,10 +458,11 @@
 
 (defmacro dolist (spec &rest body)
   (apply #'(lambda (var list &optional result)
-             `(mapc #'(lambda (,var)
-                        ,@body
-                        ,result)
-                    ,list))
+             (list 'progn
+                   (list 'mapc
+                         (cons 'lambda (cons (list var) body))
+                         list)
+                   result))
          spec))
 
 ;;; Strings
@@ -582,6 +641,9 @@
 (defun print (object)
   (funcall (@ (guile) write) object))
 
+(defun prin1 (object)
+  (funcall (@ (guile) write) object))
+
 (defun terpri ()
   (funcall (@ (guile) newline)))
 
@@ -607,11 +669,90 @@
                                (@ (guile) *random-state*)))
 
 (defun random (&optional limit)
-  (if (eq limit t)
-      (setq %random-state
-            (funcall (@ (guile) random-state-from-platform))))
-  (funcall (@ (guile) random)
-           (if (wholenump limit)
-               limit
-             (@ (guile) most-positive-fixnum))
-           %random-state))
+   (if (eq limit t)
+       (setq %random-state
+             (funcall (@ (guile) random-state-from-platform))))
+   (funcall (@ (guile) random)
+            (if (wholenump limit)
+                limit
+              (@ (guile) most-positive-fixnum))
+            %random-state))
+
+(defmacro save-excursion (&rest body)
+  `(call-with-save-excursion #'(lambda () ,@body)))
+
+(defmacro save-current-buffer (&rest body)
+  `(call-with-save-current-buffer #'(lambda () ,@body)))
+
+(defmacro save-restriction (&rest body)
+  `(call-with-save-restriction #'(lambda () ,@body)))
+
+(defmacro track-mouse (&rest body)
+  `(call-with-track-mouse #'(lambda () ,@body)))
+
+(defmacro setq-default (var value &rest args)
+  `(progn (set-default ',var ,value)
+          ,(if (null args)
+               var
+             `(setq-default ,@args))))
+
+(defmacro catch (tag &rest body)
+  `(call-with-catch ,tag #'(lambda () ,@body)))
+
+(defmacro condition-case (var bodyform &rest args)
+  (if (consp args)
+      (let* ((handler (car args))
+             (handlers (cdr args))
+             (handler-conditions (car handler))
+             (handler-body (cdr handler)))
+        `(call-with-handler ',var
+                            ',handler-conditions
+                            #'(lambda () ,@handler-body)
+                            #'(lambda ()
+                                (condition-case ,var
+                                    ,bodyform
+                                  ,@handlers))))
+    bodyform))
+
+(defun backtrace-frame (nframes)
+  (let* ((stack (funcall (@ (guile) make-stack) t))
+         (frame (stack-ref stack nframes))
+         (proc (funcall (@ (guile) frame-procedure) frame))
+         (pname (or (and (%functionp proc)
+                         (funcall (@ (guile) procedure-name) proc))
+                    proc))
+         (args (funcall (@ (guile) frame-arguments) frame)))
+    (cons t (cons pname args))))
+
+(defun backtrace ()
+  (interactive)
+  (let* ((stack (funcall (@ (guile) make-stack) t))
+         (frame (funcall (@ (guile) stack-ref) stack 1))
+         (space (funcall (@ (guile) integer->char) 32)))
+    (while frame
+      (princ (string 32 32))
+      (let ((proc (funcall (@ (guile) frame-procedure) frame)))
+        (prin1 (or (and (%functionp proc)
+                        (funcall (@ (guile) procedure-name) proc))
+                   proc)))
+      (prin1 (funcall (@ (guile) frame-arguments) frame))
+      (terpri)
+      (setq frame (funcall (@ (guile) frame-previous) frame)))
+    nil))
+
+(defun %set-eager-macroexpansion-mode (ignore)
+  nil)
+
+(defun progn (&rest args) (error "Special operator"))
+(defun eval-when-compile (&rest args) (error "Special operator"))
+(defun if (&rest args) (error "Special operator"))
+(defun defconst (&rest args) (error "Special operator"))
+(defun defvar (&rest args) (error "Special operator"))
+(defun setq (&rest args) (error "Special operator"))
+(defun let (&rest args) (error "Special operator"))
+(defun flet (&rest args) (error "Special operator"))
+(defun labels (&rest args) (error "Special operator"))
+(defun let* (&rest args) (error "Special operator"))
+(defun function (&rest args) (error "Special operator"))
+(defun defmacro (&rest args) (error "Special operator"))
+(defun quote (&rest args) (error "Special operator"))
diff --git a/module/language/elisp/compile-tree-il.scm b/module/language/elisp/compile-tree-il.scm
index 5d6ebc591..8da1d583c 100644
--- a/module/language/elisp/compile-tree-il.scm
+++ b/module/language/elisp/compile-tree-il.scm
@@ -30,6 +30,7 @@
   #:use-module (srfi srfi-8)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
+  #:use-module (ice-9 format)
   #:export (compile-tree-il
             compile-progn
             compile-eval-when-compile
@@ -44,6 +45,7 @@
             compile-guile-ref
             compile-guile-private-ref
             compile-guile-primitive
+            compile-%function
             compile-function
             compile-defmacro
             compile-defun
@@ -61,8 +63,6 @@
 
 (define bindings-data (make-fluid))
 
-(define lexical-binding (make-fluid))
-
 ;;; Find the source properties of some parsed expression if there are
 ;;; any associated with it.
 
@@ -122,28 +122,29 @@
    loc
    symbol
    (lambda (lexical)
-     (make-lexical-ref loc lexical lexical))
+     (if (symbol? lexical)
+         (make-lexical-ref loc symbol lexical)
+         (make-call loc lexical '())))
    (lambda ()
-     (call-primitive loc
-                     'fluid-ref
-                     (make-module-ref loc value-slot symbol #t)))))
+     (make-call loc
+                (make-module-ref loc runtime 'symbol-value #t)
+                (list (make-const loc symbol))))))
 
-(define (global? module symbol)
-  (module-variable module symbol))
+(define (global? symbol)
+  (module-variable value-slot symbol))
 
 (define (ensure-globals! loc names body)
-  (if (and (every (cut global? (resolve-module value-slot) <>) names)
+  (if (and (every global? names)
            (every symbol-interned? names))
       body
       (list->seq
        loc
        `(,@(map
             (lambda (name)
-              (ensure-fluid! value-slot name)
+              (symbol-desc name)
               (make-call loc
-                         (make-module-ref loc runtime 'ensure-fluid! #t)
-                         (list (make-const loc value-slot)
-                               (make-const loc name))))
+                         (make-module-ref loc runtime 'symbol-desc #t)
+                         (list (make-const loc name))))
             names)
          ,body))))
 
@@ -152,15 +153,17 @@
    loc
    symbol
    (lambda (lexical)
-     (make-lexical-set loc lexical lexical value))
+     (if (symbol? lexical)
+         (make-lexical-set loc symbol lexical value)
+         (make-call loc lexical (list value))))
    (lambda ()
      (ensure-globals!
       loc
       (list symbol)
-      (call-primitive loc
-                      'fluid-set!
-                      (make-module-ref loc value-slot symbol #t)
-                      value)))))
+      (make-call loc
+                 (make-module-ref loc runtime 'set-symbol-value! #t)
+                 (list (make-const loc symbol)
+                       value))))))
 
 (define (access-function loc symbol handle-lexical handle-global)
   (cond
@@ -174,7 +177,8 @@
    loc
    symbol
    (lambda (gensym) (make-lexical-ref loc symbol gensym))
-   (lambda () (make-module-ref loc function-slot symbol #t))))
+   (lambda ()
+     (make-module-ref loc '(elisp-functions) symbol #t))))
 
 (define (set-function! loc symbol value)
   (access-function
@@ -187,15 +191,12 @@
       (make-module-ref loc runtime 'set-symbol-function! #t)
       (list (make-const loc symbol) value)))))
 
-(define (bind-lexically? sym module decls)
-  (or (eq? module function-slot)
-      (let ((decl (assq-ref decls sym)))
-        (and (equal? module value-slot)
-             (or
-              (eq? decl 'lexical)
-              (and
-               (fluid-ref lexical-binding)
-               (not (global? (resolve-module module) sym))))))))
+(define (bind-lexically? sym decls)
+  (let ((decl (assq-ref decls sym)))
+    (or (eq? decl 'lexical)
+        (and
+         (lexical-binding?)
+         (not (special? sym))))))
 
 (define (parse-let-binding loc binding)
   (pmatch binding
@@ -234,11 +235,14 @@
     (pmatch lst
       (((declare . ,x) . ,tail)
        (loop tail (append-reverse x decls) intspec doc))
-      (((interactive . ,x) . ,tail)
+      (((interactive) . ,tail)
+       (guard lambda? (not intspec))
+       (loop tail decls (cons 'interactive-form #nil) doc))
+      (((interactive ,x) . ,tail)
        (guard lambda? (not intspec))
-       (loop tail decls x doc))
+       (loop tail decls (cons 'interactive-form x) doc))
       ((,x . ,tail)
-       (guard lambda? (string? x) (not doc) (not (null? tail)))
+       (guard lambda? (or (string? x) (lisp-string? x)) (not doc) (not (null? tail)))
        (loop tail decls intspec x))
       (else
        (values (append-map parse-declaration decls)
@@ -257,12 +261,13 @@
 ;;; optional and rest arguments.
 
 (define (parse-lambda-list lst)
-  (define (%match lst null optional rest symbol)
+  (define (%match lst null optional rest symbol list*)
     (pmatch lst
       (() (null))
       ((&optional . ,tail) (optional tail))
       ((&rest . ,tail) (rest tail))
       ((,arg . ,tail) (guard (symbol? arg)) (symbol arg tail))
+      ((,arg . ,tail) (guard (list? arg)) (list* arg tail))
       (else (fail))))
   (define (return rreq ropt rest)
     (values #t (reverse rreq) (reverse ropt) rest))
@@ -273,24 +278,28 @@
             (lambda () (return rreq '() #f))
             (lambda (tail) (parse-opt tail rreq '()))
             (lambda (tail) (parse-rest tail rreq '()))
-            (lambda (arg tail) (parse-req tail (cons arg rreq)))))
+            (lambda (arg tail) (parse-req tail (cons arg rreq)))
+            (lambda (arg tail) (fail))))
   (define (parse-opt lst rreq ropt)
     (%match lst
             (lambda () (return rreq ropt #f))
             (lambda (tail) (fail))
             (lambda (tail) (parse-rest tail rreq ropt))
+            (lambda (arg tail) (parse-opt tail rreq (cons (list arg) ropt)))
             (lambda (arg tail) (parse-opt tail rreq (cons arg ropt)))))
   (define (parse-rest lst rreq ropt)
     (%match lst
             (lambda () (fail))
             (lambda (tail) (fail))
             (lambda (tail) (fail))
-            (lambda (arg tail) (parse-post-rest tail rreq ropt arg))))
+            (lambda (arg tail) (parse-post-rest tail rreq ropt arg))
+            (lambda (arg tail) (fail))))
   (define (parse-post-rest lst rreq ropt rest)
     (%match lst
             (lambda () (return rreq ropt rest))
             (lambda () (fail))
             (lambda () (fail))
+            (lambda (arg tail) (fail))
             (lambda (arg tail) (fail))))
   (parse-req lst '()))
 
@@ -307,30 +316,30 @@
                         (let lp ((f f) (v v))
                           (if (null? f)
                               body
-                              (make-primcall
-                               src 'with-fluid*
-                               (list (make-lexical-ref #f 'fluid (car f))
-                                     (make-lexical-ref #f 'val (car v))
-                                     (make-lambda
-                                      src '()
-                                      (make-lambda-case
-                                       src '() #f #f #f '() '()
-                                       (lp (cdr f) (cdr v))
-                                       #f))))))))))
+                              (make-call src
+                                         (make-module-ref src runtime 'bind-symbol #t)
+                                         (list (make-lexical-ref #f 'fluid (car f))
+                                               (make-lexical-ref #f 'val (car v))
+                                               (make-lambda
+                                                src '()
+                                                (make-lambda-case
+                                                 src '() #f #f #f '() '()
+                                                 (lp (cdr f) (cdr v))
+                                                 #f))))))))))
 
 (define (compile-lambda loc meta args body)
-  (receive (valid? req-ids opt-ids rest-id)
+  (receive (valid? req-ids opts rest-id)
            (parse-lambda-list args)
     (if valid?
         (let* ((all-ids (append req-ids
-                                opt-ids
+                                (and opts (map car opts))
                                 (or (and=> rest-id list) '())))
                (all-vars (map (lambda (ignore) (gensym)) all-ids)))
           (let*-values (((decls intspec doc forms)
                          (parse-lambda-body body))
                         ((lexical dynamic)
                          (partition
-                          (compose (cut bind-lexically? <> value-slot decls)
+                          (compose (cut bind-lexically? <> decls)
                                    car)
                           (map list all-ids all-vars)))
                         ((lexical-ids lexical-vars) (unzip2 lexical))
@@ -360,50 +369,42 @@
                                tree-il
                                (make-dynlet
                                 loc
-                                (map (cut make-module-ref loc value-slot <> #t)
-                                     dynamic-ids)
+                                (map (cut make-const loc <>) dynamic-ids)
                                 (map (cut make-lexical-ref loc <> <>)
                                      dynamic-ids
                                      dynamic-vars)
                                 tree-il))))
                      (make-simple-lambda loc
-                                         meta
+                                         (append (if intspec
+                                                     (list intspec)
+                                                     '())
+                                                 (if doc
+                                                     (list (cons 'emacs-documentation doc))
+                                                     '())
+                                                 meta)
                                          req-ids
-                                         opt-ids
-                                         (map (const (nil-value loc))
-                                              opt-ids)
+                                         (map car opts)
+                                         (map (lambda (x)
+                                                (if (pair? (cdr x))
+                                                    (compile-expr (car (cdr x)))
+                                                    (make-const loc #nil)))
+                                              opts)
                                          rest-id
                                          all-vars
                                          full-body)))))))))
         (report-error "invalid function" `(lambda ,args ,@body)))))
 
-;;; Handle the common part of defconst and defvar, that is, checking for
-;;; a correct doc string and arguments as well as maybe in the future
-;;; handling the docstring somehow.
-
-(define (handle-var-def loc sym doc)
-  (cond
-   ((not (symbol? sym)) (report-error loc "expected symbol, got" sym))
-   ((> (length doc) 1) (report-error loc "too many arguments to defvar"))
-   ((and (not (null? doc)) (not (string? (car doc))))
-    (report-error loc "expected string as third argument of defvar, got"
-                  (car doc)))
-   ;; TODO: Handle doc string if present.
-   (else #t)))
-
 ;;; Handle macro and special operator bindings.
 
 (define (find-operator name type)
   (and
    (symbol? name)
-   (module-defined? (resolve-interface function-slot) name)
-   (let ((op (module-ref (resolve-module function-slot) name)))
+   (module-defined? function-slot name)
+   (let ((op (module-ref function-slot name)))
      (if (and (pair? op) (eq? (car op) type))
          (cdr op)
          #f))))
 
-;;; See if a (backquoted) expression contains any unquotes.
-
 (define (contains-unquotes? expr)
   (if (pair? expr)
       (if (or (unquote? (car expr)) (unquote-splicing? (car expr)))
@@ -474,41 +475,47 @@
       (call-primitive loc 'not
        (call-primitive loc 'nil? (compile-expr cond)))
       (compile-expr then)
-      (compile-expr `(progn ,@else))))))
+      (compile-expr `(progn ,@else))))
+    (else (report-error loc "Bad if" args))))
 
 (defspecial defconst (loc args)
   (pmatch args
     ((,sym ,value . ,doc)
-     (if (handle-var-def loc sym doc)
-         (make-seq loc
-                   (set-variable! loc sym (compile-expr value))
-                   (make-const loc sym))))))
+     (make-seq
+      loc
+      (make-call loc
+                 (make-module-ref loc runtime 'proclaim-special! #t)
+                 (list (make-const loc sym)))
+      (make-seq loc
+                (set-variable! loc sym (compile-expr value))
+                (make-const loc sym))))
+    (else (report-error loc "Bad defconst" args))))
 
 (defspecial defvar (loc args)
   (pmatch args
-    ((,sym) (make-const loc sym))
+    ((,sym)
+     (make-seq loc
+               (make-call loc
+                          (make-module-ref loc runtime 'proclaim-special! #t)
+                          (list (make-const loc sym)))
+               (make-const loc sym)))
     ((,sym ,value . ,doc)
-     (if (handle-var-def loc sym doc)
-         (make-seq
-          loc
-          (make-conditional
-           loc
-           (make-conditional
-            loc
-            (call-primitive
-             loc
-             'module-bound?
-             (call-primitive loc
-                             'resolve-interface
-                             (make-const loc value-slot))
-             (make-const loc sym))
-            (call-primitive loc
-                            'fluid-bound?
-                            (make-module-ref loc value-slot sym #t))
-            (make-const loc #f))
-           (make-void loc)
-           (set-variable! loc sym (compile-expr value)))
-          (make-const loc sym))))))
+     (make-seq
+      loc
+      (make-call loc
+                 (make-module-ref loc runtime 'proclaim-special! #t)
+                 (list (make-const loc sym)))
+      (make-seq
+       loc
+       (make-conditional
+        loc
+        (make-call loc
+                   (make-module-ref loc runtime 'symbol-bound? #t)
+                   (list (make-const loc sym)))
+        (make-void loc)
+        (set-variable! loc sym (compile-expr value)))
+       (make-const loc sym))))
+    (else (report-error loc "Bad defvar" args))))
 
 (defspecial setq (loc args)
   (define (car* x) (if (null? x) '() (car x)))
@@ -523,7 +530,7 @@
          (let ((sym (car args))
                (val (compile-expr (cadr* args))))
            (if (not (symbol? sym))
-               (report-error loc "expected symbol in setq")
+               (report-error loc "expected symbol in setq" args)
                (cons
                 (set-variable! loc sym val)
                 (loop (cddr* args)
@@ -536,7 +543,7 @@
        (receive (decls forms) (parse-body body)
          (receive (lexical dynamic)
                   (partition
-                   (compose (cut bind-lexically? <> value-slot decls)
+                   (compose (cut bind-lexically? <> decls)
                             car)
                    bindings)
            (let ((make-values (lambda (for)
@@ -548,12 +555,7 @@
               (map car dynamic)
               (if (null? lexical)
                   (make-dynlet loc
-                               (map (compose (cut make-module-ref
-                                                  loc
-                                                  value-slot
-                                                  <>
-                                                  #t)
-                                             car)
+                               (map (compose (cut make-const loc <>) car)
                                     dynamic)
                                (map (compose compile-expr cdr)
                                     dynamic)
@@ -576,13 +578,10 @@
                                      (make-body)
                                      (make-dynlet loc
                                                   (map
-                                                   (compose
-                                                    (cut make-module-ref
-                                                         loc
-                                                         value-slot
-                                                         <>
-                                                         #t)
-                                                    car)
+                                                   (compose (cut make-const
+                                                                 loc
+                                                                 <>)
+                                                            car)
                                                    dynamic)
                                                   (map
                                                    (lambda (sym)
@@ -591,7 +590,8 @@
                                                       sym
                                                       sym))
                                                    dynamic-syms)
-                                                  (make-body))))))))))))))))
+                                                  (make-body))))))))))))))
+    (else (report-error loc "bad let args"))))
 
 (defspecial let* (loc args)
   (pmatch args
@@ -603,7 +603,7 @@
                (compile-expr `(progn ,@forms))
                (let ((sym (caar tail))
                      (value (compile-expr (cdar tail))))
-                 (if (bind-lexically? sym value-slot decls)
+                 (if (bind-lexically? sym decls)
                      (let ((target (gensym)))
                        (make-let loc
                                  `(,target)
@@ -618,9 +618,10 @@
                       loc
                       (list sym)
                       (make-dynlet loc
-                                   (list (make-module-ref loc value-slot sym #t))
+                                   (list (make-const loc sym))
                                    (list value)
-                                   (iterate (cdr tail)))))))))))))
+                                   (iterate (cdr tail)))))))))))
+    (else (report-error loc "Bad let*" args))))
 
 (defspecial flet (loc args)
   (pmatch args
@@ -639,7 +640,8 @@
                         names
                         gensyms
                         (map compile-expr vals)
-                        (compile-expr `(progn ,@forms)))))))))))
+                        (compile-expr `(progn ,@forms)))))))))
+    (else (report-error loc "bad flet" args))))
 
 (defspecial labels (loc args)
   (pmatch args
@@ -659,7 +661,8 @@
                            names
                            gensyms
                            (map compile-expr vals)
-                           (compile-expr `(progn ,@forms)))))))))))
+                           (compile-expr `(progn ,@forms)))))))))
+    (else (report-error loc "bad labels" args))))
 
 ;;; guile-ref allows building TreeIL's module references from within
 ;;; elisp as a way to access data within the Guile universe.  The module
@@ -669,12 +672,14 @@
 (defspecial guile-ref (loc args)
   (pmatch args
     ((,module ,sym) (guard (and (list? module) (symbol? sym)))
-     (make-module-ref loc module sym #t))))
+     (make-module-ref loc module sym #t))
+    (else (report-error loc "bad guile-ref" args))))
 
 (defspecial guile-private-ref (loc args)
   (pmatch args
     ((,module ,sym) (guard (and (list? module) (symbol? sym)))
-     (make-module-ref loc module sym #f))))
+     (make-module-ref loc module sym #f))
+    (else (report-error loc "bad guile-private-ref" args))))
 
 ;;; guile-primitive allows to create primitive references, which are
 ;;; still a little faster.
@@ -682,14 +687,46 @@
 (defspecial guile-primitive (loc args)
   (pmatch args
     ((,sym)
-     (make-primitive-ref loc sym))))
+     (make-primitive-ref loc sym))
+    (else (report-error loc "bad guile-primitive" args))))
 
-(defspecial function (loc args)
+(defspecial %function (loc args)
   (pmatch args
     (((lambda ,args . ,body))
      (compile-lambda loc '() args body))
+    (((closure ,env ,args . ,body))
+     (let ((bindings (map (lambda (x) (list (car x) (cdr x)))
+                          (filter pair? env))))
+       (compile-expr
+        (let ((form `(let ,bindings
+                       (declare ,@(map (lambda (x) (list 'lexical x))
+                                       bindings))
+                       (function (lambda ,args
+                                   (declare
+                                    (lexical
+                                     ,@(filter-map
+                                        (lambda (x)
+                                          (cond
+                                           ((memq x '(&optional &rest))
+                                            #f)
+                                           ((symbol? x)
+                                            x)
+                                           ((list? x)
+                                            (car x))))
+                                        args)))
+                                   ,@body)))))
+          form))))
+    ((,sym) (guard (symbol? sym))
+     (reference-function loc sym))
+    ((,x)
+     (make-const loc x))
+    (else (report-error loc "bad function" args))))
+
+(defspecial function (loc args)
+  (pmatch args
     ((,sym) (guard (symbol? sym))
-     (reference-function loc sym))))
+     (make-const loc sym))
+    (else ((cdr compile-%function) loc args))))
 
 (defspecial defmacro (loc args)
   (pmatch args
@@ -714,7 +751,8 @@
            (with-native-target
             (lambda ()
               (compile tree-il #:from 'tree-il #:to 'value)))
-           tree-il)))))
+           tree-il)))
+    (else (report-error loc "bad defmacro" args))))
 
 (defspecial defun (loc args)
   (pmatch args
@@ -733,25 +771,54 @@
 (defspecial #{`}# (loc args)
   (pmatch args
     ((,val)
-     (process-backquote loc val))))
+     (process-backquote loc val))
+    (else (report-error loc "bad backquote" args))))
 
 (defspecial quote (loc args)
   (pmatch args
     ((,val)
-     (make-const loc val))))
+     (make-const loc val))
+    (else (report-error loc "bad quote" args))))
 
 (defspecial %funcall (loc args)
   (pmatch args
     ((,function . ,arguments)
      (make-call loc
                 (compile-expr function)
-                (map compile-expr arguments)))))
+                (map compile-expr arguments)))
+    (else (report-error loc "bad %funcall" args))))
 
 (defspecial %set-lexical-binding-mode (loc args)
   (pmatch args
     ((,val)
-     (fluid-set! lexical-binding val)
-     (make-void loc))))
+     (set-lexical-binding-mode val)
+     (make-void loc))
+    (else (report-error loc "bad %set-lexical-binding-mode" args))))
+
+(define special-operators (make-hash-table))
+
+(for-each
+ (lambda (pair) (hashq-set! special-operators (car pair) (cddr pair)))
+ `((progn . ,compile-progn)
+   (eval-when-compile . ,compile-eval-when-compile)
+   (if . ,compile-if)
+   (defconst . ,compile-defconst)
+   (defvar . ,compile-defvar)
+   (setq . ,compile-setq)
+   (let . ,compile-let)
+   (flet . ,compile-flet)
+   (labels . ,compile-labels)
+   (let* . ,compile-let*)
+   (guile-ref . ,compile-guile-ref)
+   (guile-private-ref . ,compile-guile-private-ref)
+   (guile-primitive . ,compile-guile-primitive)
+   (%function . ,compile-%function)
+   (function . ,compile-function)
+   (defmacro . ,compile-defmacro)
+   (#{`}# . ,#{compile-`}#)
+   (quote . ,compile-quote)
+   (%funcall . ,compile-%funcall)
+   (%set-lexical-binding-mode . ,compile-%set-lexical-binding-mode)))
 
 ;;; Compile a compound expression to Tree-IL.
 
@@ -759,14 +826,14 @@
   (let ((operator (car expr))
         (arguments (cdr expr)))
     (cond
-     ((find-operator operator 'special-operator)
-      => (lambda (special-operator-function)
-           (special-operator-function loc arguments)))
      ((find-operator operator 'macro)
       => (lambda (macro-function)
            (compile-expr (apply macro-function arguments))))
+     ((hashq-ref special-operators operator)
+      => (lambda (special-operator-function)
+           (special-operator-function loc arguments)))
      (else
-      (compile-expr `(%funcall (function ,operator) ,@arguments))))))
+      (compile-expr `(%funcall (%function ,operator) ,@arguments))))))
 
 ;;; Compile a symbol expression.  This is a variable reference or maybe
 ;;; some special value like nil.
@@ -788,31 +855,9 @@
       (compile-pair loc expr))
      (else (make-const loc expr)))))
 
-;;; Process the compiler options.
-;;; FIXME: Why is '(()) passed as options by the REPL?
-
-(define (valid-symbol-list-arg? value)
-  (or (eq? value 'all)
-      (and (list? value) (and-map symbol? value))))
-
-(define (process-options! opt)
-  (if (and (not (null? opt))
-           (not (equal? opt '(()))))
-      (if (null? (cdr opt))
-          (report-error #f "Invalid compiler options" opt)
-          (let ((key (car opt))
-                (value (cadr opt)))
-            (case key
-              ((#:warnings #:to-file?)  ; ignore
-               #f)
-              (else (report-error #f
-                                  "Invalid compiler option"
-                                  key)))))))
-
 (define (compile-tree-il expr env opts)
   (values
    (with-fluids ((bindings-data (make-bindings)))
-     (process-options! opts)
      (compile-expr expr))
    env
    env))
diff --git a/module/language/elisp/lexer.scm b/module/language/elisp/lexer.scm
index 5a0e6b3ff..8152a1182 100644
--- a/module/language/elisp/lexer.scm
+++ b/module/language/elisp/lexer.scm
@@ -20,6 +20,7 @@
 
 (define-module (language elisp lexer)
   #:use-module (ice-9 regex)
+  #:use-module (language elisp runtime)
   #:export (get-lexer get-lexer/1))
 
 ;;; This is the lexical analyzer for the elisp reader.  It is
@@ -316,7 +317,9 @@
            (let ((cur (read-char port)))
              (case cur
                ((#\")
-                (return 'string (list->string (reverse result-chars))))
+                (return 'string
+                        (make-lisp-string
+                         (list->string (reverse result-chars)))))
                ((#\\)
                 (let ((escaped (read-char port)))
                   (case escaped
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)
diff --git a/module/language/elisp/spec.scm b/module/language/elisp/spec.scm
index 0a064b2fa..6032004c4 100644
--- a/module/language/elisp/spec.scm
+++ b/module/language/elisp/spec.scm
@@ -24,14 +24,25 @@
   #:use-module (system base language)
   #:use-module (system base compile)
   #:use-module (system base target)
+  #:use-module (system vm vm)
   #:export (elisp))
 
+(save-module-excursion
+ (lambda ()
+   (define-module (elisp-symbols) #:pure #:filename #f)
+   (define-module (elisp-functions) #:pure #:filename #f)
+   (define-module (elisp-plists) #:pure #:filename #f)))
+
 (define-language elisp
   #:title     "Emacs Lisp"
   #:reader    (lambda (port env) (read-elisp port))
+  ;;#:joiner (lambda (exps env) (cons 'progn exps))
   #:printer   write
   #:compilers `((tree-il . ,compile-tree-il)))
 
+(set-default-vm-engine! 'debug)
+(set-vm-engine! 'debug)
+
 ;; Compile and load the Elisp boot code for the native host
 ;; architecture.  We must specifically ask for native compilation here,
 ;; because this module might be loaded in a dynamic environment where