Commit | Line | Data |
---|---|---|
eb80072d LC |
1 | ;;; Guile Emacs Lisp |
2 | ||
c983a199 | 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 | |
5d221ca3 DK |
18 | |
19 | ;;; Code: | |
20 | ||
21 | (define-module (language elisp bindings) | |
221dc803 BT |
22 | #:use-module (srfi srfi-1) |
23 | #:use-module (srfi srfi-8) | |
d5da7661 | 24 | #:use-module (srfi srfi-9) |
221dc803 | 25 | #:use-module (srfi srfi-26) |
a6a5cf03 | 26 | #:export (make-bindings |
f4e5e411 BT |
27 | with-lexical-bindings |
28 | with-dynamic-bindings | |
eaeda0d5 BT |
29 | with-function-bindings |
30 | get-lexical-binding | |
31 | get-function-binding)) | |
5d221ca3 | 32 | |
c983a199 BT |
33 | ;;; This module defines routines to handle analysis of symbol bindings |
34 | ;;; used during elisp compilation. This data allows to collect the | |
35 | ;;; symbols, for which globals need to be created, or mark certain | |
36 | ;;; symbols as lexically bound. | |
37 | ;;; | |
c983a199 BT |
38 | ;;; The lexical bindings of symbols are stored in a hash-table that |
39 | ;;; associates symbols to fluids; those fluids are used in the | |
40 | ;;; with-lexical-binding and with-dynamic-binding routines to associate | |
41 | ;;; symbols to different bindings over a dynamic extent. | |
a6a5cf03 | 42 | |
c983a199 | 43 | ;;; Record type used to hold the data necessary. |
5d221ca3 | 44 | |
d5da7661 | 45 | (define-record-type bindings |
eaeda0d5 | 46 | (%make-bindings lexical-bindings function-bindings) |
d5da7661 | 47 | bindings? |
eaeda0d5 BT |
48 | (lexical-bindings lexical-bindings) |
49 | (function-bindings function-bindings)) | |
5d221ca3 | 50 | |
c983a199 BT |
51 | ;;; Construct an 'empty' instance of the bindings data structure to be |
52 | ;;; used at the start of a fresh compilation. | |
5d221ca3 DK |
53 | |
54 | (define (make-bindings) | |
eaeda0d5 | 55 | (%make-bindings (make-hash-table) (make-hash-table))) |
a6a5cf03 | 56 | |
c983a199 BT |
57 | ;;; Get the current lexical binding (gensym it should refer to in the |
58 | ;;; current scope) for a symbol or #f if it is dynamically bound. | |
a6a5cf03 DK |
59 | |
60 | (define (get-lexical-binding bindings sym) | |
d5da7661 | 61 | (let* ((lex (lexical-bindings bindings)) |
a6a5cf03 DK |
62 | (slot (hash-ref lex sym #f))) |
63 | (if slot | |
0faf3965 | 64 | (cadr slot) |
f4e5e411 | 65 | #f))) |
a6a5cf03 | 66 | |
eaeda0d5 BT |
67 | (define (get-function-binding bindings symbol) |
68 | (and=> (hash-ref (function-bindings bindings) symbol) | |
0faf3965 RT |
69 | cadr)) |
70 | ||
71 | (define (with-fluids** fls vals proc) | |
72 | (dynamic-wind | |
73 | (lambda () | |
74 | (for-each (lambda (f v) (set-cdr! f (cons v (cdr f)))) | |
75 | fls vals)) | |
76 | proc | |
77 | (lambda () | |
78 | (for-each (lambda (f) (set-cdr! f (cdr (cdr f)))) | |
79 | fls)))) | |
eaeda0d5 | 80 | |
c983a199 BT |
81 | ;;; Establish a binding or mark a symbol as dynamically bound for the |
82 | ;;; extent of calling proc. | |
a6a5cf03 DK |
83 | |
84 | (define (with-symbol-bindings bindings syms targets proc) | |
85 | (if (or (not (list? syms)) | |
86 | (not (and-map symbol? syms))) | |
f4e5e411 | 87 | (error "can't bind non-symbols" syms)) |
d5da7661 | 88 | (let ((lex (lexical-bindings bindings))) |
a6a5cf03 DK |
89 | (for-each (lambda (sym) |
90 | (if (not (hash-ref lex sym)) | |
0faf3965 | 91 | (hash-set! lex sym (list #f #f)))) |
a6a5cf03 | 92 | syms) |
0faf3965 RT |
93 | (with-fluids** (map (lambda (sym) (hash-ref lex sym)) syms) |
94 | targets | |
95 | proc))) | |
a6a5cf03 DK |
96 | |
97 | (define (with-lexical-bindings bindings syms targets proc) | |
0faf3965 | 98 | (with-symbol-bindings bindings syms targets proc)) |
a6a5cf03 DK |
99 | |
100 | (define (with-dynamic-bindings bindings syms proc) | |
101 | (with-symbol-bindings bindings | |
f4e5e411 BT |
102 | syms |
103 | (map (lambda (el) #f) syms) | |
a6a5cf03 | 104 | proc)) |
eaeda0d5 BT |
105 | |
106 | (define (with-function-bindings bindings symbols gensyms thunk) | |
107 | (let ((fb (function-bindings bindings))) | |
108 | (for-each (lambda (symbol) | |
109 | (if (not (hash-ref fb symbol)) | |
0faf3965 | 110 | (hash-set! fb symbol (list #f #f)))) |
eaeda0d5 | 111 | symbols) |
0faf3965 RT |
112 | (with-fluids** (map (cut hash-ref fb <>) symbols) |
113 | gensyms | |
114 | thunk))) |