mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-10 14:00:21 +02:00
elisp binding declarations
* module/language/elisp/compile-tree-il.scm (bind-lexically?): Accept a new `decls' argument and check it for `lexical' declarations. Establish the same kind of binding whether or not a lexical binding for `sym' exists, whereas previously the presence of a lexical binding would cause newly-established bindings to be lexical bindings as well. (split-let-bindings): Remove. All callers changed. (generate-let, generate-let*, compile-lambda): Pass the declarations list to `bind-lexically?'. * test-suite/tests/elisp-compiler.test: Explicitly disable the lexical-binding mode. Add `lexical' declarations where necessary.
This commit is contained in:
BT Templeton
parent
805b821189
commit
f6e0a4a60c
2 changed files with 62 additions and 69 deletions
|
|
@ -223,28 +223,21 @@
|
|||
(cons (car b) (cadr b))))))
|
||||
bindings))
|
||||
|
||||
;;; Split the let bindings into a list to be done lexically and one
|
||||
;;; dynamically. A symbol will be bound lexically if and only if: We're
|
||||
;;; processing a lexical-let (i.e. module is 'lexical), OR we're
|
||||
;;; processing a value-slot binding AND the symbol is already lexically
|
||||
;;; bound or is always lexical, OR we're processing a function-slot
|
||||
;;; binding.
|
||||
|
||||
(define (bind-lexically? sym module)
|
||||
(define (bind-lexically? sym module decls)
|
||||
(or (eq? module 'lexical)
|
||||
(eq? module function-slot)
|
||||
(and (equal? module value-slot)
|
||||
(or (get-lexical-binding (fluid-ref bindings-data) sym)
|
||||
(and
|
||||
(fluid-ref lexical-binding)
|
||||
(not (global? (fluid-ref bindings-data) sym module)))))))
|
||||
(let ((decl (assq-ref decls sym)))
|
||||
(and (equal? module value-slot)
|
||||
(or
|
||||
(eq? decl 'lexical)
|
||||
(and
|
||||
(fluid-ref lexical-binding)
|
||||
(not (global? (fluid-ref bindings-data) sym module))))))))
|
||||
|
||||
(define (parse-declaration expr)
|
||||
(pmatch expr
|
||||
((lexical . ,vars)
|
||||
(map (cut cons <> 'lexical) vars))
|
||||
((special . ,vars)
|
||||
(map (cut cons <> 'special) vars))
|
||||
(else
|
||||
'())))
|
||||
|
||||
|
|
@ -275,16 +268,6 @@
|
|||
(receive (decls intspec doc body) (parse-body-1 body #f)
|
||||
(values decls body)))
|
||||
|
||||
(define (split-let-bindings bindings module)
|
||||
(let iterate ((tail bindings)
|
||||
(lexical '())
|
||||
(dynamic '()))
|
||||
(if (null? tail)
|
||||
(values (reverse lexical) (reverse dynamic))
|
||||
(if (bind-lexically? (caar tail) module)
|
||||
(iterate (cdr tail) (cons (car tail) lexical) dynamic)
|
||||
(iterate (cdr tail) lexical (cons (car tail) dynamic))))))
|
||||
|
||||
;;; Compile let and let* expressions. The code here is used both for
|
||||
;;; let/let* and flet, just with a different bindings module.
|
||||
;;;
|
||||
|
|
@ -301,46 +284,47 @@
|
|||
(define (generate-let loc module bindings body)
|
||||
(let ((bind (process-let-bindings loc bindings)))
|
||||
(receive (decls forms) (parse-body body)
|
||||
(call-with-values
|
||||
(lambda () (split-let-bindings bind module))
|
||||
(lambda (lexical dynamic)
|
||||
(for-each (lambda (sym)
|
||||
(mark-global! (fluid-ref bindings-data)
|
||||
sym
|
||||
module))
|
||||
(map car dynamic))
|
||||
(let ((make-values (lambda (for)
|
||||
(map (lambda (el) (compile-expr (cdr el)))
|
||||
for)))
|
||||
(make-body (lambda () (compile-expr `(progn ,@forms)))))
|
||||
(if (null? lexical)
|
||||
(let-dynamic loc (map car dynamic) module
|
||||
(make-values dynamic) (make-body))
|
||||
(let* ((lexical-syms (map (lambda (el) (gensym)) lexical))
|
||||
(dynamic-syms (map (lambda (el) (gensym)) dynamic))
|
||||
(all-syms (append lexical-syms dynamic-syms))
|
||||
(vals (append (make-values lexical)
|
||||
(make-values dynamic))))
|
||||
(make-let loc
|
||||
all-syms
|
||||
all-syms
|
||||
vals
|
||||
(with-lexical-bindings
|
||||
(fluid-ref bindings-data)
|
||||
(map car lexical) lexical-syms
|
||||
(lambda ()
|
||||
(if (null? dynamic)
|
||||
(make-body)
|
||||
(let-dynamic loc
|
||||
(map car dynamic)
|
||||
module
|
||||
(map
|
||||
(lambda (sym)
|
||||
(make-lexical-ref loc
|
||||
sym
|
||||
sym))
|
||||
dynamic-syms)
|
||||
(make-body))))))))))))))
|
||||
(receive (lexical dynamic)
|
||||
(partition (compose (cut bind-lexically? <> module decls)
|
||||
car)
|
||||
bind)
|
||||
(for-each (lambda (sym)
|
||||
(mark-global! (fluid-ref bindings-data)
|
||||
sym
|
||||
module))
|
||||
(map car dynamic))
|
||||
(let ((make-values (lambda (for)
|
||||
(map (lambda (el) (compile-expr (cdr el)))
|
||||
for)))
|
||||
(make-body (lambda () (compile-expr `(progn ,@forms)))))
|
||||
(if (null? lexical)
|
||||
(let-dynamic loc (map car dynamic) module
|
||||
(make-values dynamic) (make-body))
|
||||
(let* ((lexical-syms (map (lambda (el) (gensym)) lexical))
|
||||
(dynamic-syms (map (lambda (el) (gensym)) dynamic))
|
||||
(all-syms (append lexical-syms dynamic-syms))
|
||||
(vals (append (make-values lexical)
|
||||
(make-values dynamic))))
|
||||
(make-let loc
|
||||
all-syms
|
||||
all-syms
|
||||
vals
|
||||
(with-lexical-bindings
|
||||
(fluid-ref bindings-data)
|
||||
(map car lexical) lexical-syms
|
||||
(lambda ()
|
||||
(if (null? dynamic)
|
||||
(make-body)
|
||||
(let-dynamic loc
|
||||
(map car dynamic)
|
||||
module
|
||||
(map
|
||||
(lambda (sym)
|
||||
(make-lexical-ref loc
|
||||
sym
|
||||
sym))
|
||||
dynamic-syms)
|
||||
(make-body)))))))))))))
|
||||
|
||||
;;; Let* is compiled to a cascaded set of "small lets" for each binding
|
||||
;;; in turn so that each one already sees the preceding bindings.
|
||||
|
|
@ -350,7 +334,7 @@
|
|||
(receive (decls forms) (parse-body body)
|
||||
(begin
|
||||
(for-each (lambda (sym)
|
||||
(if (not (bind-lexically? sym module))
|
||||
(if (not (bind-lexically? sym module decls))
|
||||
(mark-global! (fluid-ref bindings-data)
|
||||
sym
|
||||
module)))
|
||||
|
|
@ -360,7 +344,7 @@
|
|||
(compile-expr `(progn ,@forms))
|
||||
(let ((sym (caar tail))
|
||||
(value (compile-expr (cdar tail))))
|
||||
(if (bind-lexically? sym module)
|
||||
(if (bind-lexically? sym module decls)
|
||||
(let ((target (gensym)))
|
||||
(make-let loc
|
||||
`(,target)
|
||||
|
|
@ -435,7 +419,7 @@
|
|||
(parse-lambda-body body))
|
||||
((lexical dynamic)
|
||||
(partition
|
||||
(compose (cut bind-lexically? <> value-slot)
|
||||
(compose (cut bind-lexically? <> value-slot decls)
|
||||
car)
|
||||
(map list all-ids all-vars)))
|
||||
((lexical-ids lexical-vars) (unzip2 lexical))
|
||||
|
|
|
|||
|
|
@ -47,6 +47,8 @@
|
|||
; Test control structures.
|
||||
; ========================
|
||||
|
||||
(compile '(%set-lexical-binding-mode #nil) #:from 'elisp #:to 'value)
|
||||
|
||||
(with-test-prefix/compile "Sequencing"
|
||||
|
||||
(pass-if-equal "progn" 1
|
||||
|
|
@ -282,9 +284,11 @@
|
|||
(lexical-let ((a 2))
|
||||
(and (= a 2) (equal (dynvals) '(1 . 1))
|
||||
(let ((a 3) (b a))
|
||||
(declare (lexical a))
|
||||
(and (= a 3) (= b 2)
|
||||
(equal (dynvals) '(1 . 2))))
|
||||
(let* ((a 4) (b a))
|
||||
(declare (lexical a))
|
||||
(and (= a 4) (= b 4)
|
||||
(equal (dynvals) '(1 . 4))))
|
||||
(= a 2)))
|
||||
|
|
@ -295,8 +299,11 @@
|
|||
(defun dyna () a)
|
||||
(lexical-let ((a 2) (b 42))
|
||||
(and (= a 2) (= (dyna) 1)
|
||||
((lambda (a) (and (= a 3) (= b 42) (= (dyna) 1))) 3)
|
||||
((lambda (a)
|
||||
(declare (lexical a))
|
||||
(and (= a 3) (= b 42) (= (dyna) 1))) 3)
|
||||
((lambda () (let ((a 3))
|
||||
(declare (lexical a))
|
||||
(and (= a 3) (= (dyna) 1)))))
|
||||
(= a 2) (= (dyna) 1)))
|
||||
(= a 1)))
|
||||
|
|
@ -321,6 +328,7 @@
|
|||
(defun dynb () b)
|
||||
(lexical-let (a c)
|
||||
((lambda (a b &optional c)
|
||||
(declare (lexical a c))
|
||||
(and (= a 3) (= (dyna) 1)
|
||||
(= b 2) (= (dynb) 2)
|
||||
(= c 1)))
|
||||
|
|
@ -333,6 +341,7 @@
|
|||
(lexical-let (i)
|
||||
(setq to 1000000)
|
||||
(defun iteration-1 (i)
|
||||
(declare (lexical i))
|
||||
(if (< i to)
|
||||
(iteration-1 (1+ i))))
|
||||
(iteration-1 0)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue