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 BT |
27 | ensure-fluid! |
28 | reference-variable | |
37099846 | 29 | set-variable! |
f4e5e411 BT |
30 | runtime-error |
31 | macro-error) | |
44ae163d | 32 | #:export-syntax (built-in-func built-in-macro defspecial prim)) |
344927c3 | 33 | |
c983a199 | 34 | ;;; This module provides runtime support for the Elisp front-end. |
344927c3 | 35 | |
c983a199 | 36 | ;;; Values for t and nil. (FIXME remove this abstraction) |
1e018f6c | 37 | |
474060a2 | 38 | (define nil-value #nil) |
1e018f6c | 39 | |
abcf4a9e | 40 | (define t-value #t) |
1e018f6c | 41 | |
c983a199 BT |
42 | ;;; Modules for the binding slots. |
43 | ;;; Note: Naming those value-slot and/or function-slot clashes with the | |
44 | ;;; submodules of these names! | |
37099846 DK |
45 | |
46 | (define value-slot-module '(language elisp runtime value-slot)) | |
37099846 | 47 | |
abcf4a9e | 48 | (define function-slot-module '(language elisp runtime function-slot)) |
37099846 | 49 | |
c983a199 BT |
50 | ;;; Report an error during macro compilation, that means some special |
51 | ;;; compilation (syntax) error; or report a simple runtime-error from a | |
52 | ;;; built-in function. | |
7d1a9782 DK |
53 | |
54 | (define (macro-error msg . args) | |
55 | (apply error msg args)) | |
56 | ||
f614ca12 DK |
57 | (define runtime-error macro-error) |
58 | ||
c983a199 | 59 | ;;; Convert a scheme boolean to Elisp. |
1e018f6c DK |
60 | |
61 | (define (elisp-bool b) | |
62 | (if b | |
f4e5e411 BT |
63 | t-value |
64 | nil-value)) | |
1e018f6c | 65 | |
c983a199 BT |
66 | ;;; Routines for access to elisp dynamically bound symbols. This is |
67 | ;;; used for runtime access using functions like symbol-value or set, | |
68 | ;;; where the symbol accessed might not be known at compile-time. These | |
69 | ;;; always access the dynamic binding and can not be used for the | |
70 | ;;; lexical! | |
37099846 DK |
71 | |
72 | (define (ensure-fluid! module sym) | |
73 | (let ((intf (resolve-interface module)) | |
74 | (resolved (resolve-module module))) | |
75 | (if (not (module-defined? intf sym)) | |
e01163b5 | 76 | (let ((fluid (make-unbound-fluid))) |
f4e5e411 BT |
77 | (module-define! resolved sym fluid) |
78 | (module-export! resolved `(,sym)))))) | |
37099846 DK |
79 | |
80 | (define (reference-variable module sym) | |
37099846 | 81 | (let ((resolved (resolve-module module))) |
c6920dc8 BT |
82 | (cond |
83 | ((equal? module function-slot-module) | |
84 | (module-ref resolved sym)) | |
85 | (else | |
86 | (ensure-fluid! module sym) | |
87 | (fluid-ref (module-ref resolved sym)))))) | |
37099846 | 88 | |
37099846 | 89 | (define (set-variable! module sym value) |
c6920dc8 BT |
90 | (let ((intf (resolve-interface module)) |
91 | (resolved (resolve-module module))) | |
92 | (cond | |
93 | ((equal? module function-slot-module) | |
94 | (cond | |
95 | ((module-defined? intf sym) | |
96 | (module-set! resolved sym value)) | |
97 | (else | |
98 | (module-define! resolved sym value) | |
99 | (module-export! resolved `(,sym))))) | |
100 | (else | |
101 | (ensure-fluid! module sym) | |
102 | (fluid-set! (module-ref resolved sym) value)))) | |
103 | value) | |
37099846 | 104 | |
c983a199 BT |
105 | ;;; Define a predefined function or predefined macro for use in the |
106 | ;;; function-slot and macro-slot modules, respectively. | |
7d1a9782 DK |
107 | |
108 | (define-syntax built-in-func | |
109 | (syntax-rules () | |
110 | ((_ name value) | |
111 | (begin | |
c6920dc8 | 112 | (define-public name value))))) |
1e018f6c | 113 | |
44ae163d BT |
114 | (define (make-id template-id . data) |
115 | (let ((append-symbols | |
116 | (lambda (symbols) | |
117 | (string->symbol | |
118 | (apply string-append (map symbol->string symbols)))))) | |
119 | (datum->syntax template-id | |
120 | (append-symbols | |
121 | (map (lambda (datum) | |
122 | ((if (identifier? datum) | |
123 | syntax->datum | |
124 | identity) | |
125 | datum)) | |
126 | data))))) | |
127 | ||
7d1a9782 | 128 | (define-syntax built-in-macro |
44ae163d BT |
129 | (lambda (x) |
130 | (syntax-case x () | |
131 | ((_ name value) | |
132 | (with-syntax ((scheme-name (make-id #'name 'macro- #'name))) | |
133 | #'(begin | |
134 | (define-public scheme-name (make-fluid)) | |
135 | (fluid-set! scheme-name (cons 'macro value)))))))) | |
136 | ||
137 | (define-syntax defspecial | |
138 | (lambda (x) | |
139 | (syntax-case x () | |
140 | ((_ name args body ...) | |
141 | (with-syntax ((scheme-name (make-id #'name 'compile- #'name))) | |
142 | #'(begin | |
143 | (define scheme-name (make-fluid)) | |
144 | (fluid-set! scheme-name | |
145 | (cons 'special-operator | |
146 | (lambda args body ...))))))))) | |
f614ca12 | 147 | |
c983a199 BT |
148 | ;;; Call a guile-primitive that may be rebound for elisp and thus needs |
149 | ;;; absolute addressing. | |
f614ca12 DK |
150 | |
151 | (define-syntax prim | |
152 | (syntax-rules () | |
153 | ((_ sym args ...) | |
154 | ((@ (guile) sym) args ...)))) |