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 | |
f4e5e411 BT |
64 | (fluid-ref slot) |
65 | #f))) | |
a6a5cf03 | 66 | |
eaeda0d5 BT |
67 | (define (get-function-binding bindings symbol) |
68 | (and=> (hash-ref (function-bindings bindings) symbol) | |
69 | fluid-ref)) | |
70 | ||
c983a199 BT |
71 | ;;; Establish a binding or mark a symbol as dynamically bound for the |
72 | ;;; extent of calling proc. | |
a6a5cf03 DK |
73 | |
74 | (define (with-symbol-bindings bindings syms targets proc) | |
75 | (if (or (not (list? syms)) | |
76 | (not (and-map symbol? syms))) | |
f4e5e411 | 77 | (error "can't bind non-symbols" syms)) |
d5da7661 | 78 | (let ((lex (lexical-bindings bindings))) |
a6a5cf03 DK |
79 | (for-each (lambda (sym) |
80 | (if (not (hash-ref lex sym)) | |
f4e5e411 | 81 | (hash-set! lex sym (make-fluid)))) |
a6a5cf03 | 82 | syms) |
f4e5e411 | 83 | (with-fluids* (map (lambda (sym) (hash-ref lex sym)) syms) |
a6a5cf03 DK |
84 | targets |
85 | proc))) | |
86 | ||
87 | (define (with-lexical-bindings bindings syms targets proc) | |
88 | (if (or (not (list? targets)) | |
89 | (not (and-map symbol? targets))) | |
f4e5e411 BT |
90 | (error "invalid targets for lexical binding" targets) |
91 | (with-symbol-bindings bindings syms targets proc))) | |
a6a5cf03 DK |
92 | |
93 | (define (with-dynamic-bindings bindings syms proc) | |
94 | (with-symbol-bindings bindings | |
f4e5e411 BT |
95 | syms |
96 | (map (lambda (el) #f) syms) | |
a6a5cf03 | 97 | proc)) |
eaeda0d5 BT |
98 | |
99 | (define (with-function-bindings bindings symbols gensyms thunk) | |
100 | (let ((fb (function-bindings bindings))) | |
101 | (for-each (lambda (symbol) | |
102 | (if (not (hash-ref fb symbol)) | |
103 | (hash-set! fb symbol (make-fluid)))) | |
104 | symbols) | |
105 | (with-fluids* (map (cut hash-ref fb <>) symbols) | |
106 | gensyms | |
107 | thunk))) |