fix symbol-function

[bpt/guile.git] / module / language / elisp / runtime.scm

diff --git a/module/language/elisp/runtime.scm b/module/language/elisp/runtime.scm
index bedb15a..dba2a54 100644 (file)
--- a/module/language/elisp/runtime.scm
+++ b/module/language/elisp/runtime.scm
@@ -37,6 +37,9 @@
             set-symbol-plist!
             symbol-bound?
             symbol-fbound?
+            symbol-default-bound?
+            symbol-default-value
+            set-symbol-default-value!
             bind-symbol
             makunbound!
             fmakunbound!
@@ -69,11 +72,11 @@
 ;;; Note: Naming those value-slot and/or function-slot clashes with the
 ;;; submodules of these names!
 
-(define value-slot-module (resolve-module '(elisp-symbols)))
+(define value-slot-module (define-module* '(elisp-symbols) #:pure #t))
 
-(define function-slot-module (resolve-module '(elisp-functions)))
+(define function-slot-module (define-module* '(elisp-functions) #:pure #t))
 
-(define plist-slot-module (resolve-module '(elisp-plists)))
+(define plist-slot-module (define-module* '(elisp-plists) #:pure #t))
 
 (define nil_ 'nil)
 (define t_ 't)
@@ -155,10 +158,10 @@
   value)
 
 (define (symbol-function symbol)
-  (set! symbol (schemify symbol))
-  (ensure-present! function-slot-module symbol (lambda () #nil))
-  (let ((module function-slot-module))
-    (module-ref module symbol)))
+  (cond
+   ((module-variable function-slot-module (schemify symbol))
+    => variable-ref)
+   (else #nil)))
 
 (define (set-symbol-function! symbol value)
   (set! symbol (schemify symbol))
@@ -193,6 +196,12 @@
               (dynamic-bound? (variable-ref var))
               #t)))))
 
+(define symbol-default-bound? symbol-bound?)
+
+(define symbol-default-value symbol-value)
+
+(define set-symbol-default-value! set-symbol-value!)
+
 (define (symbol-fbound? symbol)
   (set! symbol (schemify symbol))
   (and
@@ -225,10 +234,13 @@
   (vector-set! (symbol-desc sym) 3 1)
   #nil)
 
-(define (emacs! ref set boundp bind)
+(define (emacs! ref set boundp dref dset dboundp bind)
   (set! symbol-value ref)
   (set! set-symbol-value! set)
   (set! symbol-bound? boundp)
+  (set! symbol-default-value dref)
+  (set! set-symbol-default-value! dset)
+  (set! symbol-default-bound? dboundp)
   (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))))
@@ -262,5 +274,7 @@
     (syntax-case x ()
       ((_ name args body ...)
        (with-syntax ((scheme-name (make-id #'name 'compile- #'name)))
-         #'(define scheme-name
-             (cons 'special-operator (lambda args body ...))))))))
+         #'(begin
+             (define scheme-name
+               (cons 'special-operator (lambda args body ...)))
+             (set-symbol-function! 'name scheme-name)))))))