1 (define-module (lang elisp internals fset)
2 #:use-module (lang elisp internals evaluation)
3 #:use-module (lang elisp internals lambda)
4 #:use-module (lang elisp internals signal)
9 interactive-specification
13 (define the-variables-module (resolve-module '(lang elisp variables)))
15 ;; By default, Guile GC's unreachable symbols. So we need to make
16 ;; sure they stay reachable!
19 ;; elisp-export-module, if non-#f, holds a module to which definitions
20 ;; should be exported under their normal symbol names. This is used
21 ;; when importing Elisp definitions into Scheme.
22 (define elisp-export-module (make-fluid))
24 ;; Store the procedure, macro or alias symbol PROC in SYM's function
26 (define (fset sym proc)
28 (set! syms (cons sym syms)))
29 (let ((vcell (symbol-fref sym))
31 (export-module (fluid-ref elisp-export-module)))
32 ;; Playing around with variables and name properties... For the
33 ;; reasoning behind this, see the commentary in (lang elisp
35 (cond ((procedure? proc)
36 ;; A procedure created from Elisp will already have a name
37 ;; property attached, with value of the form
38 ;; <elisp-defun:NAME> or <elisp-lambda>. Any other
39 ;; procedure coming through here must be an Elisp primitive
40 ;; definition, so we give it a name of the form
42 (or (procedure-name proc)
43 (set-procedure-property! proc
45 (symbol-append '<elisp-subr: sym '>)))
46 (set! vsym (procedure-name proc)))
48 ;; Macros coming through here must be defmacros, as all
49 ;; primitive special forms are handled directly by the
51 (set-procedure-property! (macro-transformer proc)
53 (symbol-append '<elisp-defmacro: sym '>))
54 (set! vsym (procedure-name (macro-transformer proc))))
57 (set! vsym (symbol-append '<elisp-defalias: sym '>))))
58 ;; This is the important bit!
60 (variable-set! vcell proc)
62 (set! vcell (make-variable proc))
63 (symbol-fset! sym vcell)
64 ;; Playing with names and variables again - see above.
65 (module-add! the-variables-module vsym vcell)
66 (module-export! the-variables-module (list vsym))))
67 ;; Export variable to the export module, if non-#f.
68 (if (and export-module
72 (module-add! export-module sym vcell)
73 (module-export! export-module (list sym))))))
75 ;; Retrieve the procedure or macro stored in SYM's function slot.
76 ;; Note the asymmetry w.r.t. fset: if fref finds an alias symbol, it
77 ;; recursively calls fref on that symbol. Returns #f if SYM's
78 ;; function slot doesn't contain a valid definition.
80 (let ((var (symbol-fref sym)))
81 (if (and var (variable? var))
82 (let ((proc (variable-ref var)))
89 ;; Same as fref, but signals an Elisp error if SYM's function
90 ;; definition is void.
91 (define (fref/error-if-void sym)
93 (signal 'void-function (list sym))))
95 ;; Maps a procedure to its (interactive ...) spec.
96 (define interactive-specification (make-object-property))
98 ;; Maps a procedure to #t if it is NOT a built-in.
99 (define not-subr? (make-object-property))
101 (define (elisp-apply function . args)
103 (cond ((symbol? function)
104 (fref/error-if-void function))
105 ((procedure? function)
107 ((and (pair? function)
108 (eq? (car function) 'lambda))
109 (eval (transform-lambda/interactive function '<elisp-lambda>)
112 (signal 'invalid-function (list function))))