3 ;;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc.
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.
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.
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
21 (define-module (language elisp runtime)
22 #:use-module (ice-9 format)
23 #:use-module ((system base compile)
42 set-symbol-default-value!
52 set-lexical-binding-mode
59 #:export-syntax (defspecial prim))
61 ;;; This module provides runtime support for the Elisp front-end.
63 ;;; Values for t and nil. (FIXME remove this abstraction)
65 (define nil-value #nil)
69 (define make-lisp-string identity)
70 (define lisp-string? string?)
72 ;;; Modules for the binding slots.
73 ;;; Note: Naming those value-slot and/or function-slot clashes with the
74 ;;; submodules of these names!
76 (define value-slot-module (define-module* '(elisp-symbols) #:pure #t))
78 (define function-slot-module (define-module* '(elisp-functions) #:pure #t))
80 (define plist-slot-module (define-module* '(elisp-plists) #:pure #t))
85 ;;; Routines for access to elisp dynamically bound symbols. This is
86 ;;; used for runtime access using functions like symbol-value or set,
87 ;;; where the symbol accessed might not be known at compile-time. These
88 ;;; always access the dynamic binding and can not be used for the
91 (define lexical-binding #t)
93 (define (lexical-binding?)
96 (define (set-lexical-binding-mode x)
97 (set! lexical-binding x))
99 (define unbound (make-symbol "unbound"))
101 (define dynamic? vector?)
102 (define (make-dynamic)
103 (vector #f 4 0 0 unbound))
104 (define (dynamic-ref x)
106 (define (dynamic-set! x v)
108 (define (dynamic-unset! x)
109 (vector-set! x 4 unbound))
110 (define (dynamic-bound? x)
111 (not (eq? (vector-ref x 4) unbound)))
112 (define (dynamic-bind x v thunk)
113 (let ((old (vector-ref x 4)))
115 (lambda () (vector-set! x 4 v))
117 (lambda () (vector-set! x 4 old)))))
119 (define-inlinable (ensure-present! module sym thunk)
120 (or (module-local-variable module sym)
121 (let ((variable (make-variable (thunk))))
122 (module-add! module sym variable)
125 (define-inlinable (ensure-desc! module sym)
126 (ensure-present! module
129 (let ((x (make-dynamic)))
130 (vector-set! x 0 sym)
133 (define-inlinable (schemify symbol)
139 (define (symbol-name symbol)
140 (symbol->string (schemify symbol)))
142 (define (symbol-desc symbol)
143 (let ((symbol (schemify symbol)))
144 (let ((module value-slot-module))
145 (variable-ref (ensure-desc! module symbol)))))
147 (define (ensure-dynamic! sym)
148 (vector-set! (symbol-desc sym) 3 1))
150 (define (symbol-dynamic symbol)
151 (ensure-dynamic! symbol)
152 (symbol-desc symbol))
154 (define (symbol-value symbol)
155 (dynamic-ref (symbol-desc symbol)))
157 (define (set-symbol-value! symbol value)
158 (dynamic-set! (symbol-desc symbol) value)
161 (define (symbol-function symbol)
163 ((module-variable function-slot-module (schemify symbol))
167 (define (set-symbol-function! symbol value)
168 (set! symbol (schemify symbol))
169 (ensure-present! function-slot-module symbol (lambda () #nil))
170 (let ((module function-slot-module))
171 (module-define! module symbol value)
172 (module-export! module (list symbol)))
175 (define (symbol-plist symbol)
176 (set! symbol (schemify symbol))
177 (ensure-present! plist-slot-module symbol (lambda () #nil))
178 (let ((module plist-slot-module))
179 (module-ref module symbol)))
181 (define (set-symbol-plist! symbol value)
182 (set! symbol (schemify symbol))
183 (ensure-present! plist-slot-module symbol (lambda () #nil))
184 (let ((module plist-slot-module))
185 (module-define! module symbol value)
186 (module-export! module (list symbol)))
189 (define (symbol-bound? symbol)
190 (set! symbol (schemify symbol))
192 (module-bound? value-slot-module symbol)
193 (let ((var (module-variable value-slot-module
195 (and (variable-bound? var)
196 (if (dynamic? (variable-ref var))
197 (dynamic-bound? (variable-ref var))
200 (define symbol-default-bound? symbol-bound?)
202 (define symbol-default-value symbol-value)
204 (define set-symbol-default-value! set-symbol-value!)
206 (define (symbol-fbound? symbol)
207 (set! symbol (schemify symbol))
209 (module-bound? function-slot-module symbol)
211 (module-variable function-slot-module symbol))
212 (variable-ref (module-variable function-slot-module symbol))))
214 (define (bind-symbol symbol value thunk)
215 (dynamic-bind (symbol-desc symbol) value thunk))
217 (define (makunbound! symbol)
218 (if (module-bound? value-slot-module symbol)
219 (let ((var (module-variable value-slot-module
221 (if (and (variable-bound? var) (dynamic? (variable-ref var)))
222 (dynamic-unset! (variable-ref var))
223 (variable-unset! var))))
226 (define (fmakunbound! symbol)
227 (if (module-bound? function-slot-module symbol)
228 (variable-unset! (module-variable function-slot-module symbol)))
231 (define (special? sym)
232 (eqv? (vector-ref (symbol-desc sym) 3) 1))
234 (define (proclaim-special! sym)
235 (vector-set! (symbol-desc sym) 3 1)
238 (define (emacs! ref set boundp dref dset dboundp bind)
239 (set! symbol-value ref)
240 (set! set-symbol-value! set)
241 (set! symbol-bound? boundp)
242 (set! symbol-default-value dref)
243 (set! set-symbol-default-value! dset)
244 (set! symbol-default-bound? dboundp)
245 (set! bind-symbol bind)
246 (set! lexical-binding? (lambda () (symbol-value 'lexical-binding)))
247 (set! set-lexical-binding-mode (lambda (x) (set-symbol-value! 'lexical-binding x))))
249 (define (eval-elisp form)
250 (compile form #:from 'elisp #:to 'value))
252 (define (compile-elisp form)
253 (compile (compile form #:from 'elisp #:to 'bytecode)
254 #:from 'bytecode #:to 'value))
256 (set-symbol-value! nil_ #nil)
257 (set-symbol-value! t_ #t)
259 (define (make-string s) s)
261 ;;; Define a predefined macro for use in the function-slot module.
263 (define (make-id template-id . data)
264 (let ((append-symbols
267 (apply string-append (map symbol->string symbols))))))
268 (datum->syntax template-id
271 ((if (identifier? datum)
277 (define-syntax defspecial
280 ((_ name args body ...)
281 (with-syntax ((scheme-name (make-id #'name 'compile- #'name)))
284 (cons 'special-operator (lambda args body ...)))
285 (set-symbol-function! 'name scheme-name)))))))