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
|
;;; 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 bindings)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-8)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
#:export (make-bindings
with-lexical-bindings
with-dynamic-bindings
with-function-bindings
get-lexical-binding
get-function-binding))
;;; This module defines routines to handle analysis of symbol bindings
;;; used during elisp compilation. This data allows to collect the
;;; symbols, for which globals need to be created, or mark certain
;;; symbols as lexically bound.
;;;
;;; The lexical bindings of symbols are stored in a hash-table that
;;; associates symbols to fluids; those fluids are used in the
;;; with-lexical-binding and with-dynamic-binding routines to associate
;;; symbols to different bindings over a dynamic extent.
;;; Record type used to hold the data necessary.
(define-record-type bindings
(%make-bindings lexical-bindings function-bindings)
bindings?
(lexical-bindings lexical-bindings)
(function-bindings function-bindings))
;;; Construct an 'empty' instance of the bindings data structure to be
;;; used at the start of a fresh compilation.
(define (make-bindings)
(%make-bindings (make-hash-table) (make-hash-table)))
;;; Get the current lexical binding (gensym it should refer to in the
;;; current scope) for a symbol or #f if it is dynamically bound.
(define (get-lexical-binding bindings sym)
(let* ((lex (lexical-bindings bindings))
(slot (hash-ref lex sym #f)))
(if slot
(cadr slot)
#f)))
(define (get-function-binding bindings symbol)
(and=> (hash-ref (function-bindings bindings) symbol)
cadr))
(define (with-fluids** fls vals proc)
(dynamic-wind
(lambda ()
(for-each (lambda (f v) (set-cdr! f (cons v (cdr f))))
fls vals))
proc
(lambda ()
(for-each (lambda (f) (set-cdr! f (cdr (cdr f))))
fls))))
;;; Establish a binding or mark a symbol as dynamically bound for the
;;; extent of calling proc.
(define (with-symbol-bindings bindings syms targets proc)
(if (or (not (list? syms))
(not (and-map symbol? syms)))
(error "can't bind non-symbols" syms))
(let ((lex (lexical-bindings bindings)))
(for-each (lambda (sym)
(if (not (hash-ref lex sym))
(hash-set! lex sym (list #f #f))))
syms)
(with-fluids** (map (lambda (sym) (hash-ref lex sym)) syms)
targets
proc)))
(define (with-lexical-bindings bindings syms targets proc)
(with-symbol-bindings bindings syms targets proc))
(define (with-dynamic-bindings bindings syms proc)
(with-symbol-bindings bindings
syms
(map (lambda (el) #f) syms)
proc))
(define (with-function-bindings bindings symbols gensyms thunk)
(let ((fb (function-bindings bindings)))
(for-each (lambda (symbol)
(if (not (hash-ref fb symbol))
(hash-set! fb symbol (list #f #f))))
symbols)
(with-fluids** (map (cut hash-ref fb <>) symbols)
gensyms
thunk)))
|
