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) 5 #:export (fset 6 fref 7 fref/error-if-void 8 elisp-apply 9 interactive-specification 10 not-subr? 11 elisp-export-module)) 12 13(define the-variables-module (resolve-module '(lang elisp variables))) 14 15;; By default, Guile GC's unreachable symbols. So we need to make 16;; sure they stay reachable! 17(define syms '()) 18 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)) 23 24;; Store the procedure, macro or alias symbol PROC in SYM's function 25;; slot. 26(define (fset sym proc) 27 (or (memq sym syms) 28 (set! syms (cons sym syms))) 29 (let ((vcell (symbol-fref sym)) 30 (vsym #f) 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 34 ;; variables). 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 41 ;; <elisp-subr:NAME>. 42 (or (procedure-name proc) 43 (set-procedure-property! proc 44 'name 45 (symbol-append '<elisp-subr: sym '>))) 46 (set! vsym (procedure-name proc))) 47 ((macro? proc) 48 ;; Macros coming through here must be defmacros, as all 49 ;; primitive special forms are handled directly by the 50 ;; transformer. 51 (set-procedure-property! (macro-transformer proc) 52 'name 53 (symbol-append '<elisp-defmacro: sym '>)) 54 (set! vsym (procedure-name (macro-transformer proc)))) 55 (else 56 ;; An alias symbol. 57 (set! vsym (symbol-append '<elisp-defalias: sym '>)))) 58 ;; This is the important bit! 59 (if (variable? vcell) 60 (variable-set! vcell proc) 61 (begin 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 69 (or (procedure? proc) 70 (macro? proc))) 71 (begin 72 (module-add! export-module sym vcell) 73 (module-export! export-module (list sym)))))) 74 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. 79(define (fref sym) 80 (let ((var (symbol-fref sym))) 81 (if (and var (variable? var)) 82 (let ((proc (variable-ref var))) 83 (cond ((symbol? proc) 84 (fref proc)) 85 (else 86 proc))) 87 #f))) 88 89;; Same as fref, but signals an Elisp error if SYM's function 90;; definition is void. 91(define (fref/error-if-void sym) 92 (or (fref sym) 93 (signal 'void-function (list sym)))) 94 95;; Maps a procedure to its (interactive ...) spec. 96(define interactive-specification (make-object-property)) 97 98;; Maps a procedure to #t if it is NOT a built-in. 99(define not-subr? (make-object-property)) 100 101(define (elisp-apply function . args) 102 (apply apply 103 (cond ((symbol? function) 104 (fref/error-if-void function)) 105 ((procedure? function) 106 function) 107 ((and (pair? function) 108 (eq? (car function) 'lambda)) 109 (eval (transform-lambda/interactive function '<elisp-lambda>) 110 the-root-module)) 111 (else 112 (signal 'invalid-function (list function)))) 113 args)) 114