mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-04-27 16:51:06 -07:00
* 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.
This commit is contained in:
Stefan Monnier
parent
f619ad4ca2
commit
cb9336bd97
5 changed files with 60 additions and 43 deletions
|
|
@ -1,3 +1,12 @@
|
|||
2011-02-21 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* 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 <monnier@iro.umontreal.ca>
|
||||
|
||||
* subr.el (with-output-to-temp-buffer): New macro.
|
||||
|
|
|
|||
|
|
@ -1,3 +1,8 @@
|
|||
2011-02-21 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* semantic/wisent/comp.el (wisent-byte-compile-grammar):
|
||||
Macroexpand before passing to byte-compile-form.
|
||||
|
||||
2011-01-13 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* srecode/srt-mode.el (srecode-template-mode): Use define-derived-mode.
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue