From f6e0a4a60c1b4e93d23b133777881f69dfd36a86 Mon Sep 17 00:00:00 2001 From: BT Templeton Date: Mon, 8 Aug 2011 17:45:42 -0400 Subject: [PATCH] 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. --- module/language/elisp/compile-tree-il.scm | 120 ++++++++++------------ test-suite/tests/elisp-compiler.test | 11 +- 2 files changed, 62 insertions(+), 69 deletions(-) diff --git a/module/language/elisp/compile-tree-il.scm b/module/language/elisp/compile-tree-il.scm index a872ecf36..1ea327009 100644 --- a/module/language/elisp/compile-tree-il.scm +++ b/module/language/elisp/compile-tree-il.scm @@ -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)) diff --git a/test-suite/tests/elisp-compiler.test b/test-suite/tests/elisp-compiler.test index 694b0a670..0379e8eb8 100644 --- a/test-suite/tests/elisp-compiler.test +++ b/test-suite/tests/elisp-compiler.test @@ -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)