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