mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 06:20:23 +02:00
Code Activity

elisp binding declarations

Browse source 
* 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 2011-08-08 17:45:42 -04:00
parent 805b821189
commit f6e0a4a60c
2 changed files with 62 additions and 69 deletions
Download patch file Download diff file Expand all files Collapse all files

120
module/language/elisp/compile-tree-il.scm
View file

@ -223,28 +223,21 @@
(cons (car b) (cadr b)))))) (cons (car b) (cadr b))))))
bindings)) bindings))
;;; Split the let bindings into a list to be done lexically and one (define (bind-lexically? sym module decls)
;;; 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)
(or (eq? module 'lexical) (or (eq? module 'lexical)
(eq? module function-slot) (eq? module function-slot)
(and (equal? module value-slot) (let ((decl (assq-ref decls sym)))
(or (get-lexical-binding (fluid-ref bindings-data) sym) (and (equal? module value-slot)
(and (or
(fluid-ref lexical-binding) (eq? decl 'lexical)
(not (global? (fluid-ref bindings-data) sym module))))))) (and
(fluid-ref lexical-binding)
(not (global? (fluid-ref bindings-data) sym module))))))))
(define (parse-declaration expr) (define (parse-declaration expr)
(pmatch expr (pmatch expr
((lexical . ,vars) ((lexical . ,vars)
(map (cut cons <> 'lexical) vars)) (map (cut cons <> 'lexical) vars))
((special . ,vars)
(map (cut cons <> 'special) vars))
(else (else
'()))) '())))
@ -275,16 +268,6 @@
(receive (decls intspec doc body) (parse-body-1 body #f) (receive (decls intspec doc body) (parse-body-1 body #f)
(values decls body))) (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 ;;; Compile let and let* expressions. The code here is used both for
;;; let/let* and flet, just with a different bindings module. ;;; let/let* and flet, just with a different bindings module.
;;; ;;;
@ -301,46 +284,47 @@
(define (generate-let loc module bindings body) (define (generate-let loc module bindings body)
(let ((bind (process-let-bindings loc bindings))) (let ((bind (process-let-bindings loc bindings)))
(receive (decls forms) (parse-body body) (receive (decls forms) (parse-body body)
(call-with-values (receive (lexical dynamic)
(lambda () (split-let-bindings bind module)) (partition (compose (cut bind-lexically? <> module decls)
(lambda (lexical dynamic) car)
(for-each (lambda (sym) bind)
(mark-global! (fluid-ref bindings-data) (for-each (lambda (sym)
sym (mark-global! (fluid-ref bindings-data)
module)) sym
(map car dynamic)) module))
(let ((make-values (lambda (for) (map car dynamic))
(map (lambda (el) (compile-expr (cdr el))) (let ((make-values (lambda (for)
for))) (map (lambda (el) (compile-expr (cdr el)))
(make-body (lambda () (compile-expr `(progn ,@forms))))) for)))
(if (null? lexical) (make-body (lambda () (compile-expr `(progn ,@forms)))))
(let-dynamic loc (map car dynamic) module (if (null? lexical)
(make-values dynamic) (make-body)) (let-dynamic loc (map car dynamic) module
(let* ((lexical-syms (map (lambda (el) (gensym)) lexical)) (make-values dynamic) (make-body))
(dynamic-syms (map (lambda (el) (gensym)) dynamic)) (let* ((lexical-syms (map (lambda (el) (gensym)) lexical))
(all-syms (append lexical-syms dynamic-syms)) (dynamic-syms (map (lambda (el) (gensym)) dynamic))
(vals (append (make-values lexical) (all-syms (append lexical-syms dynamic-syms))
(make-values dynamic)))) (vals (append (make-values lexical)
(make-let loc (make-values dynamic))))
all-syms (make-let loc
all-syms all-syms
vals all-syms
(with-lexical-bindings vals
(fluid-ref bindings-data) (with-lexical-bindings
(map car lexical) lexical-syms (fluid-ref bindings-data)
(lambda () (map car lexical) lexical-syms
(if (null? dynamic) (lambda ()
(make-body) (if (null? dynamic)
(let-dynamic loc (make-body)
(map car dynamic) (let-dynamic loc
module (map car dynamic)
(map module
(lambda (sym) (map
(make-lexical-ref loc (lambda (sym)
sym (make-lexical-ref loc
sym)) sym
dynamic-syms) sym))
(make-body)))))))))))))) dynamic-syms)
(make-body)))))))))))))
;;; Let* is compiled to a cascaded set of "small lets" for each binding ;;; Let* is compiled to a cascaded set of "small lets" for each binding
;;; in turn so that each one already sees the preceding bindings. ;;; in turn so that each one already sees the preceding bindings.
@ -350,7 +334,7 @@
(receive (decls forms) (parse-body body) (receive (decls forms) (parse-body body)
(begin (begin
(for-each (lambda (sym) (for-each (lambda (sym)
(if (not (bind-lexically? sym module)) (if (not (bind-lexically? sym module decls))
(mark-global! (fluid-ref bindings-data) (mark-global! (fluid-ref bindings-data)
sym sym
module))) module)))
@ -360,7 +344,7 @@
(compile-expr `(progn ,@forms)) (compile-expr `(progn ,@forms))
(let ((sym (caar tail)) (let ((sym (caar tail))
(value (compile-expr (cdar tail)))) (value (compile-expr (cdar tail))))
(if (bind-lexically? sym module) (if (bind-lexically? sym module decls)
(let ((target (gensym))) (let ((target (gensym)))
(make-let loc (make-let loc
`(,target) `(,target)
@ -435,7 +419,7 @@
(parse-lambda-body body)) (parse-lambda-body body))
((lexical dynamic) ((lexical dynamic)
(partition (partition
(compose (cut bind-lexically? <> value-slot) (compose (cut bind-lexically? <> value-slot decls)
car) car)
(map list all-ids all-vars))) (map list all-ids all-vars)))
((lexical-ids lexical-vars) (unzip2 lexical)) ((lexical-ids lexical-vars) (unzip2 lexical))

11
test-suite/tests/elisp-compiler.test
View file

@ -47,6 +47,8 @@
; Test control structures. ; Test control structures.
; ======================== ; ========================
(compile '(%set-lexical-binding-mode #nil) #:from 'elisp #:to 'value)
(with-test-prefix/compile "Sequencing" (with-test-prefix/compile "Sequencing"
(pass-if-equal "progn" 1 (pass-if-equal "progn" 1
@ -282,9 +284,11 @@
(lexical-let ((a 2)) (lexical-let ((a 2))
(and (= a 2) (equal (dynvals) '(1 . 1)) (and (= a 2) (equal (dynvals) '(1 . 1))
(let ((a 3) (b a)) (let ((a 3) (b a))
(declare (lexical a))
(and (= a 3) (= b 2) (and (= a 3) (= b 2)
(equal (dynvals) '(1 . 2)))) (equal (dynvals) '(1 . 2))))
(let* ((a 4) (b a)) (let* ((a 4) (b a))
(declare (lexical a))
(and (= a 4) (= b 4) (and (= a 4) (= b 4)
(equal (dynvals) '(1 . 4)))) (equal (dynvals) '(1 . 4))))
(= a 2))) (= a 2)))
@ -295,8 +299,11 @@
(defun dyna () a) (defun dyna () a)
(lexical-let ((a 2) (b 42)) (lexical-let ((a 2) (b 42))
(and (= a 2) (= (dyna) 1) (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)) ((lambda () (let ((a 3))
(declare (lexical a))
(and (= a 3) (= (dyna) 1))))) (and (= a 3) (= (dyna) 1)))))
(= a 2) (= (dyna) 1))) (= a 2) (= (dyna) 1)))
(= a 1))) (= a 1)))
@ -321,6 +328,7 @@
(defun dynb () b) (defun dynb () b)
(lexical-let (a c) (lexical-let (a c)
((lambda (a b &optional c) ((lambda (a b &optional c)
(declare (lexical a c))
(and (= a 3) (= (dyna) 1) (and (= a 3) (= (dyna) 1)
(= b 2) (= (dynb) 2) (= b 2) (= (dynb) 2)
(= c 1))) (= c 1)))
@ -333,6 +341,7 @@
(lexical-let (i) (lexical-let (i)
(setq to 1000000) (setq to 1000000)
(defun iteration-1 (i) (defun iteration-1 (i)
(declare (lexical i))
(if (< i to) (if (< i to)
(iteration-1 (1+ i)))) (iteration-1 (1+ i))))
(iteration-1 0) (iteration-1 0)