From 513749ee1862278385028d6700e1d2ce8abd35e6 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 8 Jun 2012 09:18:26 -0400 Subject: [PATCH] Clean up scoping rule of predefined single-word vars. * lisp/startup.el (argv, argi): Make lexically scoped. * lisp/emacs-lisp/float-sup.el (pi): Use internal-make-var-non-special. * lisp/emacs-lisp/cl-macs.el: Use lexical-binding. Rename cl-bind-* to cl--bind-*. * lisp/files.el: Don't require `cl' since it doesn't use it. * lisp/emacs-lisp/pcase.el, lisp/emacs-lisp/macroexp.el: Add coding cookie. * src/eval.c (Fmake_var_non_special): New primitive. (syms_of_eval): Defsubr it. * src/lread.c (syms_of_lread): Mark `values' as lexically scoped. --- lisp/ChangeLog | 9 ++++ lisp/emacs-lisp/cl-loaddefs.el | 2 +- lisp/emacs-lisp/cl-macs.el | 98 +++++++++++++++++----------------- lisp/emacs-lisp/float-sup.el | 10 ++-- lisp/emacs-lisp/macroexp.el | 2 +- lisp/emacs-lisp/pcase.el | 2 +- lisp/files.el | 2 - lisp/startup.el | 9 ++-- src/ChangeLog | 8 ++- src/eval.c | 12 +++++ src/lread.c | 7 +-- 11 files changed, 92 insertions(+), 69 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 655dcf184d..4609954ff7 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2012-06-08 Stefan Monnier + + * startup.el (argv, argi): Make lexically scoped. + * emacs-lisp/float-sup.el (pi): Use internal-make-var-non-special. + * emacs-lisp/cl-macs.el: Use lexical-binding. + Rename cl-bind-* to cl--bind-*. + * files.el: Don't require `cl' since it doesn't use it. + * emacs-lisp/pcase.el, emacs-lisp/macroexp.el: Add coding cookie. + 2012-06-08 Juanma Barranquero * textmodes/texinfmt.el: Fix bug#11640 (reverts part of 2008-07-31T05:33:56Z!dann@ics.uci.edu). diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index cd26660f4f..337a82e2e4 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -263,7 +263,7 @@ Remove from SYMBOL's plist the property PROPNAME and its value. ;;;;;; cl-do* cl-do cl-loop cl-return-from cl-return cl-block cl-etypecase ;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when ;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp -;;;;;; cl-gensym) "cl-macs" "cl-macs.el" "ce1ef5c6c925f03cb425d9a46cfa6d5f") +;;;;;; cl-gensym) "cl-macs" "cl-macs.el" "07b3d08f956d6740ea1979825c84bc01") ;;; Generated autoloads from cl-macs.el (autoload 'cl-gensym "cl-macs" "\ diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 4d8e4f3921..22ef55e3a5 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -1,4 +1,4 @@ -;;; cl-macs.el --- Common Lisp macros +;;; cl-macs.el --- Common Lisp macros --*- lexical-binding: t -*- ;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc. @@ -310,8 +310,8 @@ its argument list allows full Common Lisp conventions." (defconst cl-lambda-list-keywords '(&optional &rest &key &allow-other-keys &aux &whole &body &environment)) -(defvar cl-bind-block) (defvar cl-bind-defs) (defvar cl-bind-enquote) -(defvar cl-bind-inits) (defvar cl-bind-lets) (defvar cl-bind-forms) +(defvar cl--bind-block) (defvar cl--bind-defs) (defvar cl--bind-enquote) +(defvar cl--bind-inits) (defvar cl--bind-lets) (defvar cl--bind-forms) (declare-function help-add-fundoc-usage "help-fns" (docstring arglist)) @@ -346,20 +346,20 @@ its argument list allows full Common Lisp conventions." )))) arglist))) -(defun cl--transform-lambda (form cl-bind-block) +(defun cl--transform-lambda (form bind-block) (let* ((args (car form)) (body (cdr form)) (orig-args args) - (cl-bind-defs nil) (cl-bind-enquote nil) - (cl-bind-inits nil) (cl-bind-lets nil) (cl-bind-forms nil) + (cl--bind-block bind-block) (cl--bind-defs nil) (cl--bind-enquote nil) + (cl--bind-inits nil) (cl--bind-lets nil) (cl--bind-forms nil) (header nil) (simple-args nil)) (while (or (stringp (car body)) (memq (car-safe (car body)) '(interactive cl-declare))) (push (pop body) header)) (setq args (if (listp args) (cl-copy-list args) (list '&rest args))) (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p))))) - (if (setq cl-bind-defs (cadr (memq '&cl-defs args))) - (setq args (delq '&cl-defs (delq cl-bind-defs args)) - cl-bind-defs (cadr cl-bind-defs))) - (if (setq cl-bind-enquote (memq '&cl-quote args)) + (if (setq cl--bind-defs (cadr (memq '&cl-defs args))) + (setq args (delq '&cl-defs (delq cl--bind-defs args)) + cl--bind-defs (cadr cl--bind-defs))) + (if (setq cl--bind-enquote (memq '&cl-quote args)) (setq args (delq '&cl-quote args))) (if (memq '&whole args) (error "&whole not currently implemented")) (let* ((p (memq '&environment args)) (v (cadr p)) @@ -369,20 +369,20 @@ its argument list allows full Common Lisp conventions." (while (and args (symbolp (car args)) (not (memq (car args) '(nil &rest &body &key &aux))) (not (and (eq (car args) '&optional) - (or cl-bind-defs (consp (cadr args)))))) + (or cl--bind-defs (consp (cadr args)))))) (push (pop args) simple-args)) - (or (eq cl-bind-block 'cl-none) - (setq body (list `(cl-block ,cl-bind-block ,@body)))) + (or (eq cl--bind-block 'cl-none) + (setq body (list `(cl-block ,cl--bind-block ,@body)))) (if (null args) (cl-list* nil (nreverse simple-args) (nconc (nreverse header) body)) (if (memq '&optional simple-args) (push '&optional args)) (cl--do-arglist args nil (- (length simple-args) (if (memq '&optional simple-args) 1 0))) - (setq cl-bind-lets (nreverse cl-bind-lets)) - (cl-list* (and cl-bind-inits `(cl-eval-when (compile load eval) - ,@(nreverse cl-bind-inits))) + (setq cl--bind-lets (nreverse cl--bind-lets)) + (cl-list* (and cl--bind-inits `(cl-eval-when (compile load eval) + ,@(nreverse cl--bind-inits))) (nconc (nreverse simple-args) - (list '&rest (car (pop cl-bind-lets)))) + (list '&rest (car (pop cl--bind-lets)))) (nconc (let ((hdr (nreverse header))) ;; Macro expansion can take place in the middle of ;; apparently harmless computation, so it should not @@ -395,15 +395,15 @@ its argument list allows full Common Lisp conventions." (cons 'fn (cl--make-usage-args orig-args)))) hdr))) - (list `(let* ,cl-bind-lets - ,@(nreverse cl-bind-forms) + (list `(let* ,cl--bind-lets + ,@(nreverse cl--bind-forms) ,@body))))))) (defun cl--do-arglist (args expr &optional num) ; uses bind-* (if (nlistp args) (if (or (memq args cl-lambda-list-keywords) (not (symbolp args))) (error "Invalid argument name: %s" args) - (push (list args expr) cl-bind-lets)) + (push (list args expr) cl--bind-lets)) (setq args (cl-copy-list args)) (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p))))) (let ((p (memq '&body args))) (if p (setcar p '&rest))) @@ -417,9 +417,9 @@ its argument list allows full Common Lisp conventions." (if (listp (cadr restarg)) (setq restarg (make-symbol "--cl-rest--")) (setq restarg (cadr restarg))) - (push (list restarg expr) cl-bind-lets) + (push (list restarg expr) cl--bind-lets) (if (eq (car args) '&whole) - (push (list (cl-pop2 args) restarg) cl-bind-lets)) + (push (list (cl-pop2 args) restarg) cl--bind-lets)) (let ((p args)) (setq minarg restarg) (while (and p (not (memq (car p) cl-lambda-list-keywords))) @@ -437,8 +437,8 @@ its argument list allows full Common Lisp conventions." (if (or laterarg (= safety 0)) poparg `(if ,minarg ,poparg (signal 'wrong-number-of-arguments - (list ,(and (not (eq cl-bind-block 'cl-none)) - `',cl-bind-block) + (list ,(and (not (eq cl--bind-block 'cl-none)) + `',cl--bind-block) (length ,restarg))))))) (setq num (1+ num) laterarg t)) (while (and (eq (car args) '&optional) (pop args)) @@ -447,10 +447,10 @@ its argument list allows full Common Lisp conventions." (or (consp arg) (setq arg (list arg))) (if (cddr arg) (cl--do-arglist (nth 2 arg) `(and ,restarg t))) (let ((def (if (cdr arg) (nth 1 arg) - (or (car cl-bind-defs) - (nth 1 (assq (car arg) cl-bind-defs))))) + (or (car cl--bind-defs) + (nth 1 (assq (car arg) cl--bind-defs))))) (poparg `(pop ,restarg))) - (and def cl-bind-enquote (setq def `',def)) + (and def cl--bind-enquote (setq def `',def)) (cl--do-arglist (car arg) (if def `(if ,restarg ,poparg ,def) poparg)) (setq num (1+ num)))))) @@ -461,10 +461,10 @@ its argument list allows full Common Lisp conventions." (push `(if ,restarg (signal 'wrong-number-of-arguments (list - ,(and (not (eq cl-bind-block 'cl-none)) - `',cl-bind-block) + ,(and (not (eq cl--bind-block 'cl-none)) + `',cl--bind-block) (+ ,num (length ,restarg))))) - cl-bind-forms))) + cl--bind-forms))) (while (and (eq (car args) '&key) (pop args)) (while (and args (not (memq (car args) cl-lambda-list-keywords))) (let ((arg (pop args))) @@ -473,9 +473,9 @@ its argument list allows full Common Lisp conventions." (intern (format ":%s" (car arg))))) (varg (if (consp (car arg)) (cl-cadar arg) (car arg))) (def (if (cdr arg) (cadr arg) - (or (car cl-bind-defs) (cadr (assq varg cl-bind-defs))))) + (or (car cl--bind-defs) (cadr (assq varg cl--bind-defs))))) (look `(memq ',karg ,restarg))) - (and def cl-bind-enquote (setq def `',def)) + (and def cl--bind-enquote (setq def `',def)) (if (cddr arg) (let* ((temp (or (nth 2 arg) (make-symbol "--cl-var--"))) (val `(car (cdr ,temp)))) @@ -509,11 +509,11 @@ its argument list allows full Common Lisp conventions." ,(format "Keyword argument %%s not one of %s" keys) (car ,var))))))) - (push `(let ((,var ,restarg)) ,check) cl-bind-forms))) + (push `(let ((,var ,restarg)) ,check) cl--bind-forms))) (while (and (eq (car args) '&aux) (pop args)) (while (and args (not (memq (car args) cl-lambda-list-keywords))) (if (consp (car args)) - (if (and cl-bind-enquote (cl-cadar args)) + (if (and cl--bind-enquote (cl-cadar args)) (cl--do-arglist (caar args) `',(cadr (pop args))) (cl--do-arglist (caar args) (cadr (pop args)))) @@ -536,12 +536,12 @@ its argument list allows full Common Lisp conventions." (defmacro cl-destructuring-bind (args expr &rest body) (declare (indent 2) (debug (&define cl-macro-list def-form cl-declarations def-body))) - (let* ((cl-bind-lets nil) (cl-bind-forms nil) (cl-bind-inits nil) - (cl-bind-defs nil) (cl-bind-block 'cl-none) (cl-bind-enquote nil)) + (let* ((cl--bind-lets nil) (cl--bind-forms nil) (cl--bind-inits nil) + (cl--bind-defs nil) (cl--bind-block 'cl-none) (cl--bind-enquote nil)) (cl--do-arglist (or args '(&aux)) expr) - (append '(progn) cl-bind-inits - (list `(let* ,(nreverse cl-bind-lets) - ,@(nreverse cl-bind-forms) ,@body))))) + (append '(progn) cl--bind-inits + (list `(let* ,(nreverse cl--bind-lets) + ,@(nreverse cl--bind-forms) ,@body))))) ;;; The `cl-eval-when' form. @@ -582,7 +582,7 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level. (t (eval form) form))) ;;;###autoload -(defmacro cl-load-time-value (form &optional read-only) +(defmacro cl-load-time-value (form &optional _read-only) "Like `progn', but evaluates the body at load time. The result of the body appears to the compiler as a quoted constant." (declare (debug (form &optional sexp))) @@ -734,7 +734,7 @@ This is compatible with Common Lisp, but note that `defun' and (defvar cl--loop-result-var) (defvar cl--loop-steps) (defvar cl--loop-symbol-macs) ;;;###autoload -(defmacro cl-loop (&rest cl--loop-args) +(defmacro cl-loop (&rest loop-args) "The Common Lisp `cl-loop' macro. Valid clauses are: for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM, @@ -750,9 +750,9 @@ Valid clauses are: \(fn CLAUSE...)" (declare (debug (&rest &or symbolp form))) - (if (not (memq t (mapcar 'symbolp (delq nil (delq t (cl-copy-list cl--loop-args)))))) - `(cl-block nil (while t ,@cl--loop-args)) - (let ((cl--loop-name nil) (cl--loop-bindings nil) + (if (not (memq t (mapcar 'symbolp (delq nil (delq t (cl-copy-list loop-args)))))) + `(cl-block nil (while t ,@loop-args)) + (let ((cl--loop-args loop-args) (cl--loop-name nil) (cl--loop-bindings nil) (cl--loop-body nil) (cl--loop-steps nil) (cl--loop-result nil) (cl--loop-result-explicit nil) (cl--loop-result-var nil) (cl--loop-finish-flag nil) @@ -1807,7 +1807,7 @@ values. For compatibility, (cl-values A B C) is a synonym for (list A B C). (declare (debug t)) (cons 'progn body)) ;;;###autoload -(defmacro cl-the (type form) +(defmacro cl-the (_type form) (declare (indent 1) (debug (cl-type-spec form))) form) @@ -2386,8 +2386,8 @@ the PLACE is not modified before executing BODY. (declare (indent 1) (debug ((&rest (gate place &optional form)) body))) (if (and (not (cdr bindings)) (cdar bindings) (symbolp (caar bindings))) `(let ,bindings ,@body) - (let ((lets nil) (sets nil) - (unsets nil) (rev (reverse bindings))) + (let ((lets nil) + (rev (reverse bindings))) (while rev (let* ((place (if (symbolp (caar rev)) `(symbol-value ',(caar rev)) @@ -2822,11 +2822,13 @@ The type name can then be used in `cl-typecase', `cl-check-type', etc." ((eq (car type) 'satisfies) (list (cadr type) val)) (t (error "Bad type spec: %s" type))))) +(defvar cl--object) ;;;###autoload (defun cl-typep (object type) ; See compiler macro below. "Check that OBJECT is of type TYPE. TYPE is a Common Lisp-style type specifier." - (eval (cl--make-type-test 'object type))) + (let ((cl--object object)) ;; Yuck!! + (eval (cl--make-type-test 'cl--object type)))) ;;;###autoload (defmacro cl-check-type (form type &optional string) diff --git a/lisp/emacs-lisp/float-sup.el b/lisp/emacs-lisp/float-sup.el index 375704ab6d..f7d6cdc3b7 100644 --- a/lisp/emacs-lisp/float-sup.el +++ b/lisp/emacs-lisp/float-sup.el @@ -28,13 +28,9 @@ ;; Provide an easy hook to tell if we are running with floats or not. ;; Define pi and e via math-lib calls (much less prone to killer typos). (defconst float-pi (* 4 (atan 1)) "The value of Pi (3.1415926...).") -(progn - ;; Simulate a defconst that doesn't declare the variable dynamically bound. - (setq-default pi float-pi) - (put 'pi 'variable-documentation - "Obsolete since Emacs-23.3. Use `float-pi' instead.") - (put 'pi 'risky-local-variable t) - (push 'pi current-load-list)) +(defconst pi float-pi + "Obsolete since Emacs-23.3. Use `float-pi' instead.") +(internal-make-var-non-special 'pi) (defconst float-e (exp 1) "The value of e (2.7182818...).") diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index ca6a04d605..5ca028c4ba 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -1,4 +1,4 @@ -;;; macroexp.el --- Additional macro-expansion support -*- lexical-binding: t -*- +;;; macroexp.el --- Additional macro-expansion support -*- lexical-binding: t; coding: utf-8 -*- ;; ;; Copyright (C) 2004-2012 Free Software Foundation, Inc. ;; diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 67f4c4af7e..3c9e82a823 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -1,4 +1,4 @@ -;;; pcase.el --- ML-style pattern-matching macro for Elisp -*- lexical-binding: t -*- +;;; pcase.el --- ML-style pattern-matching macro for Elisp -*- lexical-binding: t; coding: utf-8 -*- ;; Copyright (C) 2010-2012 Free Software Foundation, Inc. diff --git a/lisp/files.el b/lisp/files.el index 7f92ba7b20..619e64ddb0 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -28,8 +28,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - (defvar font-lock-keywords) (defgroup backup nil diff --git a/lisp/startup.el b/lisp/startup.el index 862e14f0c9..59d2562637 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -101,16 +101,15 @@ the remaining command-line args are in the variable `command-line-args-left'.") "List of command-line args not yet processed.") (defvaralias 'argv 'command-line-args-left - ;; FIXME: Bad name for a dynamically bound variable. "List of command-line args not yet processed. This is a convenience alias, so that one can write \(pop argv\) inside of --eval command line arguments in order to access following arguments.") +(internal-make-var-non-special 'argv) -(with-no-warnings - ;; FIXME: Bad name for a dynamically bound variable - (defvar argi nil - "Current command-line argument.")) +(defvar argi nil + "Current command-line argument.") +(internal-make-var-non-special 'argi) (defvar command-line-functions nil ;; lrs 7/31/89 "List of functions to process unrecognized command-line arguments. diff --git a/src/ChangeLog b/src/ChangeLog index ff9664d208..dd66821261 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2012-06-08 Stefan Monnier + + * eval.c (Fmake_var_non_special): New primitive. + (syms_of_eval): Defsubr it. + * lread.c (syms_of_lread): Mark `values' as lexically scoped. + 2012-06-08 Juanma Barranquero * dispnew.c (showing_window_margins_p): Wrap in #if 0 to prevent unused @@ -23,7 +29,7 @@ (roundup_size): New constant. (struct vector_block): New data type. (vector_blocks, vector_free_lists, zero_vector): New variables. - (all_vectors): Renamed to `large_vectors'. + (all_vectors): Rename to `large_vectors'. (allocate_vector_from_block, init_vectors, allocate_vector_from_block) (sweep_vectors): New functions. (allocate_vectorlike): Return `zero_vector' as the only vector of diff --git a/src/eval.c b/src/eval.c index 85ff3ae19e..5a9327a99d 100644 --- a/src/eval.c +++ b/src/eval.c @@ -790,6 +790,17 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */) return sym; } +/* Make SYMBOL lexically scoped. */ +DEFUN ("internal-make-var-non-special", Fmake_var_non_special, + Smake_var_non_special, 1, 1, 0, + doc: /* Internal function. */) + (Lisp_Object symbol) +{ + CHECK_SYMBOL (symbol); + XSYMBOL (symbol)->declared_special = 0; + return Qnil; +} + DEFUN ("let*", FletX, SletX, 1, UNEVALLED, 0, doc: /* Bind variables according to VARLIST then eval BODY. @@ -3582,6 +3593,7 @@ alist of active lexical bindings. */); defsubr (&Sdefvar); defsubr (&Sdefvaralias); defsubr (&Sdefconst); + defsubr (&Smake_var_non_special); defsubr (&Slet); defsubr (&SletX); defsubr (&Swhile); diff --git a/src/lread.c b/src/lread.c index 38b00a6696..726f1f0e90 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4375,7 +4375,8 @@ to find all the symbols in an obarray, use `mapatoms'. */); DEFVAR_LISP ("values", Vvalues, doc: /* List of values of all expressions which were read, evaluated and printed. -Order is reverse chronological. */); + Order is reverse chronological. */); + XSYMBOL (intern ("values"))->declared_special = 0; DEFVAR_LISP ("standard-input", Vstandard_input, doc: /* Stream for read to get input from. @@ -4393,7 +4394,7 @@ defined, although they may be in the future. The positions are relative to the last call to `read' or `read-from-string'. It is probably a bad idea to set this variable at -the toplevel; bind it instead. */); +the toplevel; bind it instead. */); Vread_with_symbol_positions = Qnil; DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list, @@ -4408,7 +4409,7 @@ symbol from the position where `read' or `read-from-string' started. Note that a symbol will appear multiple times in this list, if it was read multiple times. The list is in the same order as the symbols -were read in. */); +were read in. */); Vread_symbol_positions_list = Qnil; DEFVAR_LISP ("read-circle", Vread_circle, -- 2.20.1