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) | |
a6a5cf03 | 22 | #:export (make-bindings |
f4e5e411 BT |
23 | mark-global-needed! |
24 | map-globals-needed | |
25 | with-lexical-bindings | |
26 | with-dynamic-bindings | |
a6a5cf03 | 27 | get-lexical-binding)) |
5d221ca3 | 28 | |
c983a199 BT |
29 | ;;; This module defines routines to handle analysis of symbol bindings |
30 | ;;; used during elisp compilation. This data allows to collect the | |
31 | ;;; symbols, for which globals need to be created, or mark certain | |
32 | ;;; symbols as lexically bound. | |
33 | ;;; | |
34 | ;;; Needed globals are stored in an association-list that stores a list | |
35 | ;;; of symbols for each module they are needed in. | |
36 | ;;; | |
37 | ;;; The lexical bindings of symbols are stored in a hash-table that | |
38 | ;;; associates symbols to fluids; those fluids are used in the | |
39 | ;;; with-lexical-binding and with-dynamic-binding routines to associate | |
40 | ;;; symbols to different bindings over a dynamic extent. | |
a6a5cf03 | 41 | |
c983a199 | 42 | ;;; Record type used to hold the data necessary. |
5d221ca3 | 43 | |
a6a5cf03 | 44 | (define bindings-type |
f4e5e411 | 45 | (make-record-type 'bindings '(needed-globals lexical-bindings))) |
5d221ca3 | 46 | |
c983a199 BT |
47 | ;;; Construct an 'empty' instance of the bindings data structure to be |
48 | ;;; used at the start of a fresh compilation. | |
5d221ca3 DK |
49 | |
50 | (define (make-bindings) | |
a6a5cf03 | 51 | ((record-constructor bindings-type) '() (make-hash-table))) |
5d221ca3 | 52 | |
c983a199 BT |
53 | ;;; Mark that a given symbol is needed as global in the specified |
54 | ;;; slot-module. | |
5d221ca3 | 55 | |
1b1195f2 | 56 | (define (mark-global-needed! bindings sym module) |
f4e5e411 BT |
57 | (let* ((old-needed ((record-accessor bindings-type 'needed-globals) |
58 | bindings)) | |
5d221ca3 DK |
59 | (old-in-module (or (assoc-ref old-needed module) '())) |
60 | (new-in-module (if (memq sym old-in-module) | |
f4e5e411 BT |
61 | old-in-module |
62 | (cons sym old-in-module))) | |
5d221ca3 | 63 | (new-needed (assoc-set! old-needed module new-in-module))) |
f4e5e411 BT |
64 | ((record-modifier bindings-type 'needed-globals) |
65 | bindings | |
66 | new-needed))) | |
5d221ca3 | 67 | |
c983a199 BT |
68 | ;;; Cycle through all globals needed in order to generate the code for |
69 | ;;; their creation or some other analysis. | |
5d221ca3 | 70 | |
1b1195f2 | 71 | (define (map-globals-needed bindings proc) |
f4e5e411 BT |
72 | (let ((needed ((record-accessor bindings-type 'needed-globals) |
73 | bindings))) | |
5d221ca3 DK |
74 | (let iterate-modules ((mod-tail needed) |
75 | (mod-result '())) | |
76 | (if (null? mod-tail) | |
f4e5e411 BT |
77 | mod-result |
78 | (iterate-modules | |
79 | (cdr mod-tail) | |
80 | (let* ((aentry (car mod-tail)) | |
81 | (module (car aentry)) | |
82 | (symbols (cdr aentry))) | |
83 | (let iterate-symbols ((sym-tail symbols) | |
84 | (sym-result mod-result)) | |
85 | (if (null? sym-tail) | |
86 | sym-result | |
87 | (iterate-symbols (cdr sym-tail) | |
88 | (cons (proc module (car sym-tail)) | |
89 | sym-result)))))))))) | |
a6a5cf03 | 90 | |
c983a199 BT |
91 | ;;; Get the current lexical binding (gensym it should refer to in the |
92 | ;;; current scope) for a symbol or #f if it is dynamically bound. | |
a6a5cf03 DK |
93 | |
94 | (define (get-lexical-binding bindings sym) | |
f4e5e411 BT |
95 | (let* ((lex ((record-accessor bindings-type 'lexical-bindings) |
96 | bindings)) | |
a6a5cf03 DK |
97 | (slot (hash-ref lex sym #f))) |
98 | (if slot | |
f4e5e411 BT |
99 | (fluid-ref slot) |
100 | #f))) | |
a6a5cf03 | 101 | |
c983a199 BT |
102 | ;;; Establish a binding or mark a symbol as dynamically bound for the |
103 | ;;; extent of calling proc. | |
a6a5cf03 DK |
104 | |
105 | (define (with-symbol-bindings bindings syms targets proc) | |
106 | (if (or (not (list? syms)) | |
107 | (not (and-map symbol? syms))) | |
f4e5e411 BT |
108 | (error "can't bind non-symbols" syms)) |
109 | (let ((lex ((record-accessor bindings-type 'lexical-bindings) | |
110 | bindings))) | |
a6a5cf03 DK |
111 | (for-each (lambda (sym) |
112 | (if (not (hash-ref lex sym)) | |
f4e5e411 | 113 | (hash-set! lex sym (make-fluid)))) |
a6a5cf03 | 114 | syms) |
f4e5e411 | 115 | (with-fluids* (map (lambda (sym) (hash-ref lex sym)) syms) |
a6a5cf03 DK |
116 | targets |
117 | proc))) | |
118 | ||
119 | (define (with-lexical-bindings bindings syms targets proc) | |
120 | (if (or (not (list? targets)) | |
121 | (not (and-map symbol? targets))) | |
f4e5e411 BT |
122 | (error "invalid targets for lexical binding" targets) |
123 | (with-symbol-bindings bindings syms targets proc))) | |
a6a5cf03 DK |
124 | |
125 | (define (with-dynamic-bindings bindings syms proc) | |
126 | (with-symbol-bindings bindings | |
f4e5e411 BT |
127 | syms |
128 | (map (lambda (el) #f) syms) | |
a6a5cf03 | 129 | proc)) |