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