From: Stefan Monnier Date: Mon, 21 Feb 2011 23:40:54 +0000 (-0500) Subject: * lisp/emacs-lisp/cconv.el (cconv-closure-convert-rec): Let the byte X-Git-Tag: emacs-pretest-24.0.90~104^2~275^2~438^2~26 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=cb9336bd977d3345b86234c36d45228f7fb27eec;p=emacs.git * lisp/emacs-lisp/cconv.el (cconv-closure-convert-rec): Let the byte compiler choose the representation of closures. (cconv--env-var): Remove. * lisp/emacs-lisp/bytecomp.el (byte-compile--env-var): New var. (byte-compile-make-closure, byte-compile-get-closed-var): New functions. * lisp/cedet/semantic/wisent/comp.el (wisent-byte-compile-grammar): Macroexpand before passing to byte-compile-form. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 4e2e87ab60f..f7a62bc8385 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2011-02-21 Stefan Monnier + + * emacs-lisp/cconv.el (cconv-closure-convert-rec): Let the byte + compiler choose the representation of closures. + (cconv--env-var): Remove. + * emacs-lisp/bytecomp.el (byte-compile--env-var): New var. + (byte-compile-make-closure, byte-compile-get-closed-var): + New functions. + 2011-02-21 Stefan Monnier * subr.el (with-output-to-temp-buffer): New macro. diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog index b6d5cff6b51..fa3f633d1ac 100644 --- a/lisp/cedet/ChangeLog +++ b/lisp/cedet/ChangeLog @@ -1,3 +1,8 @@ +2011-02-21 Stefan Monnier + + * semantic/wisent/comp.el (wisent-byte-compile-grammar): + Macroexpand before passing to byte-compile-form. + 2011-01-13 Stefan Monnier * srecode/srt-mode.el (srecode-template-mode): Use define-derived-mode. diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el index c3243c12923..6b473f9ad81 100644 --- a/lisp/cedet/semantic/wisent/comp.el +++ b/lisp/cedet/semantic/wisent/comp.el @@ -3452,15 +3452,13 @@ where: (if (wisent-automaton-p grammar) grammar ;; Grammar already compiled just return it (wisent-with-context compile-grammar - (let* ((gc-cons-threshold 1000000) - automaton) + (let* ((gc-cons-threshold 1000000)) (garbage-collect) (setq wisent-new-log-flag t) ;; Parse input grammar (wisent-parse-grammar grammar start-list) ;; Generate the LALR(1) automaton - (setq automaton (wisent-parser-automaton)) - automaton)))) + (wisent-parser-automaton))))) ;;;; -------------------------- ;;;; Byte compile input grammar @@ -3476,7 +3474,15 @@ Automatically called by the Emacs Lisp byte compiler as a ;; automaton internal data structure. Then, because the internal ;; data structure contains an obarray, convert it to a lisp form so ;; it can be byte-compiled. - (byte-compile-form (wisent-automaton-lisp-form (eval form)))) + (byte-compile-form + ;; FIXME: we macroexpand here since `byte-compile-form' expects + ;; macroexpanded code, but that's just a workaround: for lexical-binding + ;; the lisp form should have to pass through closure-conversion and + ;; `wisent-byte-compile-grammar' is called much too late for that. + ;; Why isn't this `wisent-automaton-lisp-form' performed at + ;; macroexpansion time? --Stef + (macroexpand-all + (wisent-automaton-lisp-form (eval form))))) (put 'wisent-compile-grammar 'byte-compile 'wisent-byte-compile-grammar) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 8892a27b29c..771306bb0e6 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3339,6 +3339,24 @@ discarding." "Output byte codes to store the top-of-stack value at position STACK-POS in the stack." (byte-compile-out 'byte-stack-set (- byte-compile-depth (1+ stack-pos)))) +(byte-defop-compiler-1 internal-make-closure byte-compile-make-closure) +(byte-defop-compiler-1 internal-get-closed-var byte-compile-get-closed-var) + +(defconst byte-compile--env-var (make-symbol "env")) + +(defun byte-compile-make-closure (form) + ;; FIXME: don't use `curry'! + (byte-compile-form + (unless for-effect + `(curry (function (lambda (,byte-compile--env-var . ,(nth 1 form)) + . ,(nthcdr 3 form))) + (vector . ,(nth 2 form)))) + for-effect)) + +(defun byte-compile-get-closed-var (form) + (byte-compile-form (unless for-effect + `(aref ,byte-compile--env-var ,(nth 1 form))) + for-effect)) ;; Compile a function that accepts one or more args and is right-associative. ;; We do it by left-associativity so that the operations diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 66e5051c2f1..6aa4b7e0a61 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -71,6 +71,8 @@ ;;; Code: ;;; TODO: +;; - canonize code in macro-expand so we don't have to handle (let (var) body) +;; and other oddities. ;; - Change new byte-code representation, so it directly gives the ;; number of mandatory and optional arguments as well as whether or ;; not there's a &rest arg. @@ -229,7 +231,6 @@ Returns a form where all lambdas don't have any free variables." res)) (defconst cconv--dummy-var (make-symbol "ignored")) -(defconst cconv--env-var (make-symbol "env")) (defun cconv--set-diff (s1 s2) "Return elements of set S1 that are not in set S2." @@ -494,32 +495,18 @@ Returns a form where all lambdas don't have any free variables." (envector nil)) (when fv ;; Here we form our environment vector. - ;; If outer closure contains all - ;; free variables of this function(and nothing else) - ;; then we use the same environment vector as for outer closure, - ;; i.e. we leave the environment vector unchanged, - ;; otherwise we build a new environment vector. - (if (eq (length envs) (length fv)) - (let ((fv-temp fv)) - (while (and fv-temp leave) - (when (not (memq (car fv-temp) fvrs-new)) (setq leave nil)) - (setq fv-temp (cdr fv-temp)))) - (setq leave nil)) - - (if (not leave) - (progn - (dolist (elm fv) - (push - (cconv-closure-convert-rec - ;; Remove `elm' from `emvrs' for this call because in case - ;; `elm' is a variable that's wrapped in a cons-cell, we - ;; want to put the cons-cell itself in the closure, rather - ;; than just a copy of its current content. - elm (remq elm emvrs) fvrs envs lmenvs) - envector)) ; Process vars for closure vector. - (setq envector (reverse envector)) - (setq envs fv)) - (setq envector `(,cconv--env-var))) ; Leave unchanged. + + (dolist (elm fv) + (push + (cconv-closure-convert-rec + ;; Remove `elm' from `emvrs' for this call because in case + ;; `elm' is a variable that's wrapped in a cons-cell, we + ;; want to put the cons-cell itself in the closure, rather + ;; than just a copy of its current content. + elm (remq elm emvrs) fvrs envs lmenvs) + envector)) ; Process vars for closure vector. + (setq envector (reverse envector)) + (setq envs fv) (setq fvrs-new fv)) ; Update substitution list. (setq emvrs (cconv--set-diff emvrs vars)) @@ -546,15 +533,9 @@ Returns a form where all lambdas don't have any free variables." ((null envector) `(function (lambda ,vars . ,body-forms-new))) ; 1 free variable - do not build vector - ((null (cdr envector)) - `(curry - (function (lambda (,cconv--env-var . ,vars) . ,body-forms-new)) - ,(car envector))) - ; >=2 free variables - build vector (t - `(curry - (function (lambda (,cconv--env-var . ,vars) . ,body-forms-new)) - (vector . ,envector)))))) + `(internal-make-closure + ,vars ,envector . ,body-forms-new))))) (`(function . ,_) form) ; Same as quote. @@ -714,10 +695,8 @@ Returns a form where all lambdas don't have any free variables." (let ((free (memq form fvrs))) (if free ;form is a free variable (let* ((numero (- (length fvrs) (length free))) - (var (if (null (cdr envs)) - cconv--env-var - ;; Replace form => (aref env #) - `(aref ,cconv--env-var ,numero)))) + ;; Replace form => (aref env #) + (var `(internal-get-closed-var ,numero))) (if (memq form emvrs) ; form => (car (aref env #)) if mutable `(car ,var) var))