Commit | Line | Data |
---|---|---|
eb80072d LC |
1 | ;;; Guile Emacs Lisp |
2 | ||
474060a2 | 3 | ;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. |
eb80072d LC |
4 | ;;; |
5 | ;;; This library is free software; you can redistribute it and/or | |
6 | ;;; modify it under the terms of the GNU Lesser General Public | |
7 | ;;; License as published by the Free Software Foundation; either | |
8 | ;;; version 3 of the License, or (at your option) any later version. | |
9 | ;;; | |
10 | ;;; This library is distributed in the hope that it will be useful, | |
11 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
13 | ;;; Lesser General Public License for more details. | |
14 | ;;; | |
15 | ;;; You should have received a copy of the GNU Lesser General Public | |
16 | ;;; License along with this library; if not, write to the Free Software | |
17 | ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
344927c3 DK |
18 | |
19 | ;;; Code: | |
20 | ||
21 | (define-module (language elisp runtime) | |
3f70b2dc | 22 | #:export (nil-value |
f4e5e411 BT |
23 | t-value |
24 | value-slot-module | |
25 | function-slot-module | |
37099846 | 26 | elisp-bool |
f4e5e411 | 27 | ensure-fluid! |
85bc6238 BT |
28 | symbol-fluid |
29 | set-symbol-fluid! | |
30 | symbol-value | |
31 | set-symbol-value! | |
32 | symbol-function | |
33 | set-symbol-function! | |
34 | symbol-bound? | |
35 | symbol-fbound? | |
36 | makunbound! | |
37 | fmakunbound! | |
f4e5e411 BT |
38 | runtime-error |
39 | macro-error) | |
b652e2b9 | 40 | #:export-syntax (defspecial prim)) |
344927c3 | 41 | |
c983a199 | 42 | ;;; This module provides runtime support for the Elisp front-end. |
344927c3 | 43 | |
c983a199 | 44 | ;;; Values for t and nil. (FIXME remove this abstraction) |
1e018f6c | 45 | |
474060a2 | 46 | (define nil-value #nil) |
1e018f6c | 47 | |
abcf4a9e | 48 | (define t-value #t) |
1e018f6c | 49 | |
c983a199 BT |
50 | ;;; Modules for the binding slots. |
51 | ;;; Note: Naming those value-slot and/or function-slot clashes with the | |
52 | ;;; submodules of these names! | |
37099846 DK |
53 | |
54 | (define value-slot-module '(language elisp runtime value-slot)) | |
37099846 | 55 | |
abcf4a9e | 56 | (define function-slot-module '(language elisp runtime function-slot)) |
37099846 | 57 | |
c983a199 BT |
58 | ;;; Report an error during macro compilation, that means some special |
59 | ;;; compilation (syntax) error; or report a simple runtime-error from a | |
60 | ;;; built-in function. | |
7d1a9782 DK |
61 | |
62 | (define (macro-error msg . args) | |
63 | (apply error msg args)) | |
64 | ||
f614ca12 DK |
65 | (define runtime-error macro-error) |
66 | ||
c983a199 | 67 | ;;; Convert a scheme boolean to Elisp. |
1e018f6c DK |
68 | |
69 | (define (elisp-bool b) | |
70 | (if b | |
f4e5e411 BT |
71 | t-value |
72 | nil-value)) | |
1e018f6c | 73 | |
c983a199 BT |
74 | ;;; Routines for access to elisp dynamically bound symbols. This is |
75 | ;;; used for runtime access using functions like symbol-value or set, | |
76 | ;;; where the symbol accessed might not be known at compile-time. These | |
77 | ;;; always access the dynamic binding and can not be used for the | |
78 | ;;; lexical! | |
37099846 DK |
79 | |
80 | (define (ensure-fluid! module sym) | |
81 | (let ((intf (resolve-interface module)) | |
82 | (resolved (resolve-module module))) | |
83 | (if (not (module-defined? intf sym)) | |
e01163b5 | 84 | (let ((fluid (make-unbound-fluid))) |
f4e5e411 BT |
85 | (module-define! resolved sym fluid) |
86 | (module-export! resolved `(,sym)))))) | |
37099846 | 87 | |
85bc6238 BT |
88 | (define (symbol-fluid symbol) |
89 | (let ((module (resolve-module value-slot-module))) | |
90 | (ensure-fluid! value-slot-module symbol) ;++ implicit special proclamation | |
91 | (module-ref module symbol))) | |
37099846 | 92 | |
85bc6238 BT |
93 | (define (set-symbol-fluid! symbol fluid) |
94 | (let ((module (resolve-module value-slot-module))) | |
95 | (module-define! module symbol fluid) | |
96 | (module-export! module (list symbol))) | |
97 | fluid) | |
98 | ||
99 | (define (symbol-value symbol) | |
100 | (fluid-ref (symbol-fluid symbol))) | |
101 | ||
102 | (define (set-symbol-value! symbol value) | |
103 | (fluid-set! (symbol-fluid symbol) value) | |
c6920dc8 | 104 | value) |
37099846 | 105 | |
85bc6238 BT |
106 | (define (symbol-function symbol) |
107 | (let ((module (resolve-module function-slot-module))) | |
108 | (module-ref module symbol))) | |
109 | ||
110 | (define (set-symbol-function! symbol value) | |
111 | (let ((module (resolve-module function-slot-module))) | |
112 | (module-define! module symbol value) | |
113 | (module-export! module (list symbol))) | |
114 | value) | |
115 | ||
116 | (define (symbol-bound? symbol) | |
117 | (and | |
118 | (module-bound? (resolve-interface value-slot-module) symbol) | |
119 | (let ((var (module-variable (resolve-module value-slot-module) | |
120 | symbol))) | |
121 | (and (variable-bound? var) | |
122 | (if (fluid? (variable-ref var)) | |
123 | (fluid-bound? (variable-ref var)) | |
124 | #t))))) | |
125 | ||
126 | (define (symbol-fbound? symbol) | |
127 | (and | |
128 | (module-bound? (resolve-interface function-slot-module) symbol) | |
129 | (let* ((var (module-variable (resolve-module function-slot-module) | |
130 | symbol))) | |
131 | (and (variable-bound? var) | |
132 | (if (fluid? (variable-ref var)) | |
133 | (fluid-bound? (variable-ref var)) | |
134 | #t))))) | |
135 | ||
136 | (define (makunbound! symbol) | |
137 | (if (module-bound? (resolve-interface value-slot-module) symbol) | |
138 | (let ((var (module-variable (resolve-module value-slot-module) | |
139 | symbol))) | |
140 | (if (and (variable-bound? var) (fluid? (variable-ref var))) | |
141 | (fluid-unset! (variable-ref var)) | |
142 | (variable-unset! var)))) | |
143 | symbol) | |
144 | ||
145 | (define (fmakunbound! symbol) | |
146 | (if (module-bound? (resolve-interface function-slot-module) symbol) | |
147 | (let ((var (module-variable | |
148 | (resolve-module function-slot-module) | |
149 | symbol))) | |
150 | (if (and (variable-bound? var) (fluid? (variable-ref var))) | |
151 | (fluid-unset! (variable-ref var)) | |
152 | (variable-unset! var)))) | |
153 | symbol) | |
154 | ||
9b15703d | 155 | ;;; Define a predefined macro for use in the function-slot module. |
1e018f6c | 156 | |
44ae163d BT |
157 | (define (make-id template-id . data) |
158 | (let ((append-symbols | |
159 | (lambda (symbols) | |
160 | (string->symbol | |
161 | (apply string-append (map symbol->string symbols)))))) | |
162 | (datum->syntax template-id | |
163 | (append-symbols | |
164 | (map (lambda (datum) | |
165 | ((if (identifier? datum) | |
166 | syntax->datum | |
167 | identity) | |
168 | datum)) | |
169 | data))))) | |
170 | ||
44ae163d BT |
171 | (define-syntax defspecial |
172 | (lambda (x) | |
173 | (syntax-case x () | |
174 | ((_ name args body ...) | |
175 | (with-syntax ((scheme-name (make-id #'name 'compile- #'name))) | |
176 | #'(begin | |
177 | (define scheme-name (make-fluid)) | |
178 | (fluid-set! scheme-name | |
179 | (cons 'special-operator | |
180 | (lambda args body ...))))))))) | |
f614ca12 | 181 | |
c983a199 BT |
182 | ;;; Call a guile-primitive that may be rebound for elisp and thus needs |
183 | ;;; absolute addressing. | |
f614ca12 DK |
184 | |
185 | (define-syntax prim | |
186 | (syntax-rules () | |
187 | ((_ sym args ...) | |
188 | ((@ (guile) sym) args ...)))) |