diff options
| author | Stefan Monnier | 2010-12-13 22:37:44 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2010-12-13 22:37:44 -0500 |
| commit | defb141157dfa37c33cdcbfa4b29c702a8fc9edf (patch) | |
| tree | e0d40af60254aa9f680ce46f26c77bc47655b07f | |
| parent | 7a600d54c026061eee6db4e499802f524e7ebe00 (diff) | |
| download | emacs-defb141157dfa37c33cdcbfa4b29c702a8fc9edf.tar.gz emacs-defb141157dfa37c33cdcbfa4b29c702a8fc9edf.zip | |
Try and be more careful about propagation of lexical environment.
* src/eval.c (apply_lambda, funcall_lambda): Remove lexenv arg.
(Feval): Always eval in the empty environment.
(eval_sub): New function. Use it for all calls to Feval that should
evaluate in the lexical environment of the caller.
Pass `closure's as is to apply_lambda.
(Ffuncall): Pass `closure's as is to funcall_lambda.
(funcall_lambda): Extract lexenv for `closure's, when applicable.
Also use lexical scoping for the &rest argument, if applicable.
* src/lisp.h (eval_sub): Declare.
* src/lread.c (readevalloop): Remove `evalfun' argument.
* src/print.c (Fwith_output_to_temp_buffer):
* src/data.c (Fsetq_default): Use eval_sub.
* lisp/emacs-lisp/bytecomp.el (byte-compile-condition-case): Use push.
| -rw-r--r-- | lisp/ChangeLog | 4 | ||||
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 16 | ||||
| -rw-r--r-- | src/ChangeLog | 16 | ||||
| -rw-r--r-- | src/bytecode.c | 8 | ||||
| -rw-r--r-- | src/callint.c | 2 | ||||
| -rw-r--r-- | src/data.c | 2 | ||||
| -rw-r--r-- | src/eval.c | 133 | ||||
| -rw-r--r-- | src/lisp.h | 1 | ||||
| -rw-r--r-- | src/lread.c | 14 | ||||
| -rw-r--r-- | src/minibuf.c | 1 | ||||
| -rw-r--r-- | src/print.c | 2 |
11 files changed, 110 insertions, 89 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5a5b7ef44dc..053eb95329c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,7 @@ | |||
| 1 | 2010-12-14 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * emacs-lisp/bytecomp.el (byte-compile-condition-case): Use push. | ||
| 4 | |||
| 1 | 2010-12-13 Stefan Monnier <monnier@iro.umontreal.ca> | 5 | 2010-12-13 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 6 | ||
| 3 | * subr.el (with-lexical-binding): Remove. | 7 | * subr.el (with-lexical-binding): Remove. |
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 90fcf7fb8a6..0f7018b9b64 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el | |||
| @@ -2979,6 +2979,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 2979 | 2979 | ||
| 2980 | ;; Given BYTECOMP-BODY, compile it and return a new body. | 2980 | ;; Given BYTECOMP-BODY, compile it and return a new body. |
| 2981 | (defun byte-compile-top-level-body (bytecomp-body &optional for-effect) | 2981 | (defun byte-compile-top-level-body (bytecomp-body &optional for-effect) |
| 2982 | ;; FIXME: lexbind. Check all callers! | ||
| 2982 | (setq bytecomp-body | 2983 | (setq bytecomp-body |
| 2983 | (byte-compile-top-level (cons 'progn bytecomp-body) for-effect t)) | 2984 | (byte-compile-top-level (cons 'progn bytecomp-body) for-effect t)) |
| 2984 | (cond ((eq (car-safe bytecomp-body) 'progn) | 2985 | (cond ((eq (car-safe bytecomp-body) 'progn) |
| @@ -4083,8 +4084,8 @@ if LFORMINFO is nil (meaning all bindings are dynamic)." | |||
| 4083 | 4084 | ||
| 4084 | (defun byte-compile-track-mouse (form) | 4085 | (defun byte-compile-track-mouse (form) |
| 4085 | (byte-compile-form | 4086 | (byte-compile-form |
| 4086 | `(funcall '(lambda nil | 4087 | `(funcall #'(lambda nil |
| 4087 | (track-mouse ,@(byte-compile-top-level-body (cdr form))))))) | 4088 | (track-mouse ,@(byte-compile-top-level-body (cdr form))))))) |
| 4088 | 4089 | ||
| 4089 | (defun byte-compile-condition-case (form) | 4090 | (defun byte-compile-condition-case (form) |
| 4090 | (let* ((var (nth 1 form)) | 4091 | (let* ((var (nth 1 form)) |
| @@ -4121,11 +4122,10 @@ if LFORMINFO is nil (meaning all bindings are dynamic)." | |||
| 4121 | ;; "`%s' is not a known condition name (in condition-case)" | 4122 | ;; "`%s' is not a known condition name (in condition-case)" |
| 4122 | ;; condition)) | 4123 | ;; condition)) |
| 4123 | ) | 4124 | ) |
| 4124 | (setq compiled-clauses | 4125 | (push (cons condition |
| 4125 | (cons (cons condition | 4126 | (byte-compile-top-level-body |
| 4126 | (byte-compile-top-level-body | 4127 | (cdr clause) for-effect)) |
| 4127 | (cdr clause) for-effect)) | 4128 | compiled-clauses)) |
| 4128 | compiled-clauses))) | ||
| 4129 | (setq clauses (cdr clauses))) | 4129 | (setq clauses (cdr clauses))) |
| 4130 | (byte-compile-push-constant (nreverse compiled-clauses))) | 4130 | (byte-compile-push-constant (nreverse compiled-clauses))) |
| 4131 | (byte-compile-out 'byte-condition-case 0))) | 4131 | (byte-compile-out 'byte-condition-case 0))) |
| @@ -4244,7 +4244,7 @@ if LFORMINFO is nil (meaning all bindings are dynamic)." | |||
| 4244 | `(if (not (default-boundp ',var)) (setq-default ,var ,value)))) | 4244 | `(if (not (default-boundp ',var)) (setq-default ,var ,value)))) |
| 4245 | (when (eq fun 'defconst) | 4245 | (when (eq fun 'defconst) |
| 4246 | ;; This will signal an appropriate error at runtime. | 4246 | ;; This will signal an appropriate error at runtime. |
| 4247 | `(eval ',form))) | 4247 | `(eval ',form))) ;FIXME: lexbind |
| 4248 | `',var)))) | 4248 | `',var)))) |
| 4249 | 4249 | ||
| 4250 | (defun byte-compile-autoload (form) | 4250 | (defun byte-compile-autoload (form) |
diff --git a/src/ChangeLog b/src/ChangeLog index 6abdf583b00..c333b6388c6 100644 --- a/src/ChangeLog +++ b/src/ChangeLog | |||
| @@ -1,3 +1,19 @@ | |||
| 1 | 2010-12-14 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | Try and be more careful about propagation of lexical environment. | ||
| 4 | * eval.c (apply_lambda, funcall_lambda): Remove lexenv arg. | ||
| 5 | (Feval): Always eval in the empty environment. | ||
| 6 | (eval_sub): New function. Use it for all calls to Feval that should | ||
| 7 | evaluate in the lexical environment of the caller. | ||
| 8 | Pass `closure's as is to apply_lambda. | ||
| 9 | (Ffuncall): Pass `closure's as is to funcall_lambda. | ||
| 10 | (funcall_lambda): Extract lexenv for `closure's, when applicable. | ||
| 11 | Also use lexical scoping for the &rest argument, if applicable. | ||
| 12 | * lisp.h (eval_sub): Declare. | ||
| 13 | * lread.c (readevalloop): Remove `evalfun' argument. | ||
| 14 | * print.c (Fwith_output_to_temp_buffer): | ||
| 15 | * data.c (Fsetq_default): Use eval_sub. | ||
| 16 | |||
| 1 | 2010-12-13 Stefan Monnier <monnier@iro.umontreal.ca> | 17 | 2010-12-13 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 18 | ||
| 3 | Make the effect of (defvar foo) local. | 19 | Make the effect of (defvar foo) local. |
diff --git a/src/bytecode.c b/src/bytecode.c index d94b19b2d07..01fce0577b0 100644 --- a/src/bytecode.c +++ b/src/bytecode.c | |||
| @@ -901,7 +901,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 901 | 901 | ||
| 902 | case Bsave_window_excursion: | 902 | case Bsave_window_excursion: |
| 903 | BEFORE_POTENTIAL_GC (); | 903 | BEFORE_POTENTIAL_GC (); |
| 904 | TOP = Fsave_window_excursion (TOP); | 904 | TOP = Fsave_window_excursion (TOP); /* FIXME: lexbind */ |
| 905 | AFTER_POTENTIAL_GC (); | 905 | AFTER_POTENTIAL_GC (); |
| 906 | break; | 906 | break; |
| 907 | 907 | ||
| @@ -915,13 +915,13 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 915 | Lisp_Object v1; | 915 | Lisp_Object v1; |
| 916 | BEFORE_POTENTIAL_GC (); | 916 | BEFORE_POTENTIAL_GC (); |
| 917 | v1 = POP; | 917 | v1 = POP; |
| 918 | TOP = internal_catch (TOP, Feval, v1); | 918 | TOP = internal_catch (TOP, Feval, v1); /* FIXME: lexbind */ |
| 919 | AFTER_POTENTIAL_GC (); | 919 | AFTER_POTENTIAL_GC (); |
| 920 | break; | 920 | break; |
| 921 | } | 921 | } |
| 922 | 922 | ||
| 923 | case Bunwind_protect: | 923 | case Bunwind_protect: |
| 924 | record_unwind_protect (Fprogn, POP); | 924 | record_unwind_protect (Fprogn, POP); /* FIXME: lexbind */ |
| 925 | break; | 925 | break; |
| 926 | 926 | ||
| 927 | case Bcondition_case: | 927 | case Bcondition_case: |
| @@ -930,7 +930,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 930 | handlers = POP; | 930 | handlers = POP; |
| 931 | body = POP; | 931 | body = POP; |
| 932 | BEFORE_POTENTIAL_GC (); | 932 | BEFORE_POTENTIAL_GC (); |
| 933 | TOP = internal_lisp_condition_case (TOP, body, handlers); | 933 | TOP = internal_lisp_condition_case (TOP, body, handlers); /* FIXME: lexbind */ |
| 934 | AFTER_POTENTIAL_GC (); | 934 | AFTER_POTENTIAL_GC (); |
| 935 | break; | 935 | break; |
| 936 | } | 936 | } |
diff --git a/src/callint.c b/src/callint.c index ae11c7cb24d..960158029c3 100644 --- a/src/callint.c +++ b/src/callint.c | |||
| @@ -342,7 +342,7 @@ invoke it. If KEYS is omitted or nil, the return value of | |||
| 342 | input = specs; | 342 | input = specs; |
| 343 | /* Compute the arg values using the user's expression. */ | 343 | /* Compute the arg values using the user's expression. */ |
| 344 | GCPRO2 (input, filter_specs); | 344 | GCPRO2 (input, filter_specs); |
| 345 | specs = Feval (specs); | 345 | specs = Feval (specs); /* FIXME: lexbind */ |
| 346 | UNGCPRO; | 346 | UNGCPRO; |
| 347 | if (i != num_input_events || !NILP (record_flag)) | 347 | if (i != num_input_events || !NILP (record_flag)) |
| 348 | { | 348 | { |
diff --git a/src/data.c b/src/data.c index 924a717cf3d..42d9e076e80 100644 --- a/src/data.c +++ b/src/data.c | |||
| @@ -1452,7 +1452,7 @@ usage: (setq-default [VAR VALUE]...) */) | |||
| 1452 | 1452 | ||
| 1453 | do | 1453 | do |
| 1454 | { | 1454 | { |
| 1455 | val = Feval (Fcar (Fcdr (args_left))); | 1455 | val = eval_sub (Fcar (Fcdr (args_left))); |
| 1456 | symbol = XCAR (args_left); | 1456 | symbol = XCAR (args_left); |
| 1457 | Fset_default (symbol, val); | 1457 | Fset_default (symbol, val); |
| 1458 | args_left = Fcdr (XCDR (args_left)); | 1458 | args_left = Fcdr (XCDR (args_left)); |
diff --git a/src/eval.c b/src/eval.c index 74dd7e63aa1..485ba00c1e4 100644 --- a/src/eval.c +++ b/src/eval.c | |||
| @@ -178,10 +178,8 @@ int handling_signal; | |||
| 178 | 178 | ||
| 179 | Lisp_Object Vmacro_declaration_function; | 179 | Lisp_Object Vmacro_declaration_function; |
| 180 | 180 | ||
| 181 | static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args, | 181 | static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); |
| 182 | Lisp_Object lexenv); | 182 | static Lisp_Object funcall_lambda (Lisp_Object, int, Lisp_Object *); |
| 183 | static Lisp_Object funcall_lambda (Lisp_Object, int, Lisp_Object *, | ||
| 184 | Lisp_Object); | ||
| 185 | static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN; | 183 | static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN; |
| 186 | 184 | ||
| 187 | void | 185 | void |
| @@ -308,7 +306,7 @@ usage: (or CONDITIONS...) */) | |||
| 308 | 306 | ||
| 309 | while (CONSP (args)) | 307 | while (CONSP (args)) |
| 310 | { | 308 | { |
| 311 | val = Feval (XCAR (args)); | 309 | val = eval_sub (XCAR (args)); |
| 312 | if (!NILP (val)) | 310 | if (!NILP (val)) |
| 313 | break; | 311 | break; |
| 314 | args = XCDR (args); | 312 | args = XCDR (args); |
| @@ -332,7 +330,7 @@ usage: (and CONDITIONS...) */) | |||
| 332 | 330 | ||
| 333 | while (CONSP (args)) | 331 | while (CONSP (args)) |
| 334 | { | 332 | { |
| 335 | val = Feval (XCAR (args)); | 333 | val = eval_sub (XCAR (args)); |
| 336 | if (NILP (val)) | 334 | if (NILP (val)) |
| 337 | break; | 335 | break; |
| 338 | args = XCDR (args); | 336 | args = XCDR (args); |
| @@ -354,11 +352,11 @@ usage: (if COND THEN ELSE...) */) | |||
| 354 | struct gcpro gcpro1; | 352 | struct gcpro gcpro1; |
| 355 | 353 | ||
| 356 | GCPRO1 (args); | 354 | GCPRO1 (args); |
| 357 | cond = Feval (Fcar (args)); | 355 | cond = eval_sub (Fcar (args)); |
| 358 | UNGCPRO; | 356 | UNGCPRO; |
| 359 | 357 | ||
| 360 | if (!NILP (cond)) | 358 | if (!NILP (cond)) |
| 361 | return Feval (Fcar (Fcdr (args))); | 359 | return eval_sub (Fcar (Fcdr (args))); |
| 362 | return Fprogn (Fcdr (Fcdr (args))); | 360 | return Fprogn (Fcdr (Fcdr (args))); |
| 363 | } | 361 | } |
| 364 | 362 | ||
| @@ -382,7 +380,7 @@ usage: (cond CLAUSES...) */) | |||
| 382 | while (!NILP (args)) | 380 | while (!NILP (args)) |
| 383 | { | 381 | { |
| 384 | clause = Fcar (args); | 382 | clause = Fcar (args); |
| 385 | val = Feval (Fcar (clause)); | 383 | val = eval_sub (Fcar (clause)); |
| 386 | if (!NILP (val)) | 384 | if (!NILP (val)) |
| 387 | { | 385 | { |
| 388 | if (!EQ (XCDR (clause), Qnil)) | 386 | if (!EQ (XCDR (clause), Qnil)) |
| @@ -408,7 +406,7 @@ usage: (progn BODY...) */) | |||
| 408 | 406 | ||
| 409 | while (CONSP (args)) | 407 | while (CONSP (args)) |
| 410 | { | 408 | { |
| 411 | val = Feval (XCAR (args)); | 409 | val = eval_sub (XCAR (args)); |
| 412 | args = XCDR (args); | 410 | args = XCDR (args); |
| 413 | } | 411 | } |
| 414 | 412 | ||
| @@ -438,9 +436,9 @@ usage: (prog1 FIRST BODY...) */) | |||
| 438 | do | 436 | do |
| 439 | { | 437 | { |
| 440 | if (!(argnum++)) | 438 | if (!(argnum++)) |
| 441 | val = Feval (Fcar (args_left)); | 439 | val = eval_sub (Fcar (args_left)); |
| 442 | else | 440 | else |
| 443 | Feval (Fcar (args_left)); | 441 | eval_sub (Fcar (args_left)); |
| 444 | args_left = Fcdr (args_left); | 442 | args_left = Fcdr (args_left); |
| 445 | } | 443 | } |
| 446 | while (!NILP(args_left)); | 444 | while (!NILP(args_left)); |
| @@ -473,9 +471,9 @@ usage: (prog2 FORM1 FORM2 BODY...) */) | |||
| 473 | do | 471 | do |
| 474 | { | 472 | { |
| 475 | if (!(argnum++)) | 473 | if (!(argnum++)) |
| 476 | val = Feval (Fcar (args_left)); | 474 | val = eval_sub (Fcar (args_left)); |
| 477 | else | 475 | else |
| 478 | Feval (Fcar (args_left)); | 476 | eval_sub (Fcar (args_left)); |
| 479 | args_left = Fcdr (args_left); | 477 | args_left = Fcdr (args_left); |
| 480 | } | 478 | } |
| 481 | while (!NILP (args_left)); | 479 | while (!NILP (args_left)); |
| @@ -507,10 +505,10 @@ usage: (setq [SYM VAL]...) */) | |||
| 507 | 505 | ||
| 508 | do | 506 | do |
| 509 | { | 507 | { |
| 510 | val = Feval (Fcar (Fcdr (args_left))); | 508 | val = eval_sub (Fcar (Fcdr (args_left))); |
| 511 | sym = Fcar (args_left); | 509 | sym = Fcar (args_left); |
| 512 | 510 | ||
| 513 | /* Like for Feval, we do not check declared_special here since | 511 | /* Like for eval_sub, we do not check declared_special here since |
| 514 | it's been done when let-binding. */ | 512 | it's been done when let-binding. */ |
| 515 | if (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */ | 513 | if (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */ |
| 516 | && SYMBOLP (sym) | 514 | && SYMBOLP (sym) |
| @@ -870,7 +868,7 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) | |||
| 870 | } | 868 | } |
| 871 | 869 | ||
| 872 | if (NILP (tem)) | 870 | if (NILP (tem)) |
| 873 | Fset_default (sym, Feval (Fcar (tail))); | 871 | Fset_default (sym, eval_sub (Fcar (tail))); |
| 874 | else | 872 | else |
| 875 | { /* Check if there is really a global binding rather than just a let | 873 | { /* Check if there is really a global binding rather than just a let |
| 876 | binding that shadows the global unboundness of the var. */ | 874 | binding that shadows the global unboundness of the var. */ |
| @@ -935,7 +933,7 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */) | |||
| 935 | if (!NILP (Fcdr (Fcdr (Fcdr (args))))) | 933 | if (!NILP (Fcdr (Fcdr (Fcdr (args))))) |
| 936 | error ("Too many arguments"); | 934 | error ("Too many arguments"); |
| 937 | 935 | ||
| 938 | tem = Feval (Fcar (Fcdr (args))); | 936 | tem = eval_sub (Fcar (Fcdr (args))); |
| 939 | if (!NILP (Vpurify_flag)) | 937 | if (!NILP (Vpurify_flag)) |
| 940 | tem = Fpurecopy (tem); | 938 | tem = Fpurecopy (tem); |
| 941 | Fset_default (sym, tem); | 939 | Fset_default (sym, tem); |
| @@ -1049,7 +1047,7 @@ usage: (let* VARLIST BODY...) */) | |||
| 1049 | else | 1047 | else |
| 1050 | { | 1048 | { |
| 1051 | var = Fcar (elt); | 1049 | var = Fcar (elt); |
| 1052 | val = Feval (Fcar (Fcdr (elt))); | 1050 | val = eval_sub (Fcar (Fcdr (elt))); |
| 1053 | } | 1051 | } |
| 1054 | 1052 | ||
| 1055 | if (!NILP (lexenv) && SYMBOLP (var) | 1053 | if (!NILP (lexenv) && SYMBOLP (var) |
| @@ -1117,7 +1115,7 @@ usage: (let VARLIST BODY...) */) | |||
| 1117 | else if (! NILP (Fcdr (Fcdr (elt)))) | 1115 | else if (! NILP (Fcdr (Fcdr (elt)))) |
| 1118 | signal_error ("`let' bindings can have only one value-form", elt); | 1116 | signal_error ("`let' bindings can have only one value-form", elt); |
| 1119 | else | 1117 | else |
| 1120 | temps [argnum++] = Feval (Fcar (Fcdr (elt))); | 1118 | temps [argnum++] = eval_sub (Fcar (Fcdr (elt))); |
| 1121 | gcpro2.nvars = argnum; | 1119 | gcpro2.nvars = argnum; |
| 1122 | } | 1120 | } |
| 1123 | UNGCPRO; | 1121 | UNGCPRO; |
| @@ -1166,7 +1164,7 @@ usage: (while TEST BODY...) */) | |||
| 1166 | 1164 | ||
| 1167 | test = Fcar (args); | 1165 | test = Fcar (args); |
| 1168 | body = Fcdr (args); | 1166 | body = Fcdr (args); |
| 1169 | while (!NILP (Feval (test))) | 1167 | while (!NILP (eval_sub (test))) |
| 1170 | { | 1168 | { |
| 1171 | QUIT; | 1169 | QUIT; |
| 1172 | Fprogn (body); | 1170 | Fprogn (body); |
| @@ -1268,7 +1266,7 @@ usage: (catch TAG BODY...) */) | |||
| 1268 | struct gcpro gcpro1; | 1266 | struct gcpro gcpro1; |
| 1269 | 1267 | ||
| 1270 | GCPRO1 (args); | 1268 | GCPRO1 (args); |
| 1271 | tag = Feval (Fcar (args)); | 1269 | tag = eval_sub (Fcar (args)); |
| 1272 | UNGCPRO; | 1270 | UNGCPRO; |
| 1273 | return internal_catch (tag, Fprogn, Fcdr (args)); | 1271 | return internal_catch (tag, Fprogn, Fcdr (args)); |
| 1274 | } | 1272 | } |
| @@ -1401,7 +1399,7 @@ usage: (unwind-protect BODYFORM UNWINDFORMS...) */) | |||
| 1401 | int count = SPECPDL_INDEX (); | 1399 | int count = SPECPDL_INDEX (); |
| 1402 | 1400 | ||
| 1403 | record_unwind_protect (Fprogn, Fcdr (args)); | 1401 | record_unwind_protect (Fprogn, Fcdr (args)); |
| 1404 | val = Feval (Fcar (args)); | 1402 | val = eval_sub (Fcar (args)); |
| 1405 | return unbind_to (count, val); | 1403 | return unbind_to (count, val); |
| 1406 | } | 1404 | } |
| 1407 | 1405 | ||
| @@ -1502,7 +1500,7 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform, | |||
| 1502 | h.tag = &c; | 1500 | h.tag = &c; |
| 1503 | handlerlist = &h; | 1501 | handlerlist = &h; |
| 1504 | 1502 | ||
| 1505 | val = Feval (bodyform); | 1503 | val = eval_sub (bodyform); |
| 1506 | catchlist = c.next; | 1504 | catchlist = c.next; |
| 1507 | handlerlist = h.next; | 1505 | handlerlist = h.next; |
| 1508 | return val; | 1506 | return val; |
| @@ -2317,6 +2315,16 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, | |||
| 2317 | doc: /* Evaluate FORM and return its value. */) | 2315 | doc: /* Evaluate FORM and return its value. */) |
| 2318 | (Lisp_Object form) | 2316 | (Lisp_Object form) |
| 2319 | { | 2317 | { |
| 2318 | int count = SPECPDL_INDEX (); | ||
| 2319 | specbind (Qinternal_interpreter_environment, Qnil); | ||
| 2320 | return unbind_to (count, eval_sub (form)); | ||
| 2321 | } | ||
| 2322 | |||
| 2323 | /* Eval a sub-expression of the current expression (i.e. in the same | ||
| 2324 | lexical scope). */ | ||
| 2325 | Lisp_Object | ||
| 2326 | eval_sub (Lisp_Object form) | ||
| 2327 | { | ||
| 2320 | Lisp_Object fun, val, original_fun, original_args; | 2328 | Lisp_Object fun, val, original_fun, original_args; |
| 2321 | Lisp_Object funcar; | 2329 | Lisp_Object funcar; |
| 2322 | struct backtrace backtrace; | 2330 | struct backtrace backtrace; |
| @@ -2424,7 +2432,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, | |||
| 2424 | 2432 | ||
| 2425 | while (!NILP (args_left)) | 2433 | while (!NILP (args_left)) |
| 2426 | { | 2434 | { |
| 2427 | vals[argnum++] = Feval (Fcar (args_left)); | 2435 | vals[argnum++] = eval_sub (Fcar (args_left)); |
| 2428 | args_left = Fcdr (args_left); | 2436 | args_left = Fcdr (args_left); |
| 2429 | gcpro3.nvars = argnum; | 2437 | gcpro3.nvars = argnum; |
| 2430 | } | 2438 | } |
| @@ -2445,7 +2453,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, | |||
| 2445 | maxargs = XSUBR (fun)->max_args; | 2453 | maxargs = XSUBR (fun)->max_args; |
| 2446 | for (i = 0; i < maxargs; args_left = Fcdr (args_left)) | 2454 | for (i = 0; i < maxargs; args_left = Fcdr (args_left)) |
| 2447 | { | 2455 | { |
| 2448 | argvals[i] = Feval (Fcar (args_left)); | 2456 | argvals[i] = eval_sub (Fcar (args_left)); |
| 2449 | gcpro3.nvars = ++i; | 2457 | gcpro3.nvars = ++i; |
| 2450 | } | 2458 | } |
| 2451 | 2459 | ||
| @@ -2502,7 +2510,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, | |||
| 2502 | } | 2510 | } |
| 2503 | } | 2511 | } |
| 2504 | if (FUNVECP (fun)) | 2512 | if (FUNVECP (fun)) |
| 2505 | val = apply_lambda (fun, original_args, Qnil); | 2513 | val = apply_lambda (fun, original_args); |
| 2506 | else | 2514 | else |
| 2507 | { | 2515 | { |
| 2508 | if (EQ (fun, Qunbound)) | 2516 | if (EQ (fun, Qunbound)) |
| @@ -2518,20 +2526,10 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, | |||
| 2518 | goto retry; | 2526 | goto retry; |
| 2519 | } | 2527 | } |
| 2520 | if (EQ (funcar, Qmacro)) | 2528 | if (EQ (funcar, Qmacro)) |
| 2521 | val = Feval (apply1 (Fcdr (fun), original_args)); | 2529 | val = eval_sub (apply1 (Fcdr (fun), original_args)); |
| 2522 | else if (EQ (funcar, Qlambda)) | 2530 | else if (EQ (funcar, Qlambda) |
| 2523 | val = apply_lambda (fun, original_args, | 2531 | || EQ (funcar, Qclosure)) |
| 2524 | /* Only pass down the current lexical environment | 2532 | val = apply_lambda (fun, original_args); |
| 2525 | if FUN is lexically embedded in FORM. */ | ||
| 2526 | (CONSP (original_fun) | ||
| 2527 | ? Vinternal_interpreter_environment | ||
| 2528 | : Qnil)); | ||
| 2529 | else if (EQ (funcar, Qclosure) | ||
| 2530 | && CONSP (XCDR (fun)) | ||
| 2531 | && CONSP (XCDR (XCDR (fun))) | ||
| 2532 | && EQ (XCAR (XCDR (XCDR (fun))), Qlambda)) | ||
| 2533 | val = apply_lambda (XCDR (XCDR (fun)), original_args, | ||
| 2534 | XCAR (XCDR (fun))); | ||
| 2535 | else | 2533 | else |
| 2536 | xsignal1 (Qinvalid_function, original_fun); | 2534 | xsignal1 (Qinvalid_function, original_fun); |
| 2537 | } | 2535 | } |
| @@ -3189,7 +3187,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) | |||
| 3189 | } | 3187 | } |
| 3190 | 3188 | ||
| 3191 | if (FUNVECP (fun)) | 3189 | if (FUNVECP (fun)) |
| 3192 | val = funcall_lambda (fun, numargs, args + 1, Qnil); | 3190 | val = funcall_lambda (fun, numargs, args + 1); |
| 3193 | else | 3191 | else |
| 3194 | { | 3192 | { |
| 3195 | if (EQ (fun, Qunbound)) | 3193 | if (EQ (fun, Qunbound)) |
| @@ -3199,14 +3197,9 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) | |||
| 3199 | funcar = XCAR (fun); | 3197 | funcar = XCAR (fun); |
| 3200 | if (!SYMBOLP (funcar)) | 3198 | if (!SYMBOLP (funcar)) |
| 3201 | xsignal1 (Qinvalid_function, original_fun); | 3199 | xsignal1 (Qinvalid_function, original_fun); |
| 3202 | if (EQ (funcar, Qlambda)) | 3200 | if (EQ (funcar, Qlambda) |
| 3203 | val = funcall_lambda (fun, numargs, args + 1, Qnil); | 3201 | || EQ (funcar, Qclosure)) |
| 3204 | else if (EQ (funcar, Qclosure) | 3202 | val = funcall_lambda (fun, numargs, args + 1); |
| 3205 | && CONSP (XCDR (fun)) | ||
| 3206 | && CONSP (XCDR (XCDR (fun))) | ||
| 3207 | && EQ (XCAR (XCDR (XCDR (fun))), Qlambda)) | ||
| 3208 | val = funcall_lambda (XCDR (XCDR (fun)), numargs, args + 1, | ||
| 3209 | XCAR (XCDR (fun))); | ||
| 3210 | else if (EQ (funcar, Qautoload)) | 3203 | else if (EQ (funcar, Qautoload)) |
| 3211 | { | 3204 | { |
| 3212 | do_autoload (fun, original_fun); | 3205 | do_autoload (fun, original_fun); |
| @@ -3226,7 +3219,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) | |||
| 3226 | } | 3219 | } |
| 3227 | 3220 | ||
| 3228 | static Lisp_Object | 3221 | static Lisp_Object |
| 3229 | apply_lambda (Lisp_Object fun, Lisp_Object args, Lisp_Object lexenv) | 3222 | apply_lambda (Lisp_Object fun, Lisp_Object args) |
| 3230 | { | 3223 | { |
| 3231 | Lisp_Object args_left; | 3224 | Lisp_Object args_left; |
| 3232 | Lisp_Object numargs; | 3225 | Lisp_Object numargs; |
| @@ -3246,7 +3239,7 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, Lisp_Object lexenv) | |||
| 3246 | for (i = 0; i < XINT (numargs);) | 3239 | for (i = 0; i < XINT (numargs);) |
| 3247 | { | 3240 | { |
| 3248 | tem = Fcar (args_left), args_left = Fcdr (args_left); | 3241 | tem = Fcar (args_left), args_left = Fcdr (args_left); |
| 3249 | tem = Feval (tem); | 3242 | tem = eval_sub (tem); |
| 3250 | arg_vector[i++] = tem; | 3243 | arg_vector[i++] = tem; |
| 3251 | gcpro1.nvars = i; | 3244 | gcpro1.nvars = i; |
| 3252 | } | 3245 | } |
| @@ -3256,7 +3249,7 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, Lisp_Object lexenv) | |||
| 3256 | backtrace_list->args = arg_vector; | 3249 | backtrace_list->args = arg_vector; |
| 3257 | backtrace_list->nargs = i; | 3250 | backtrace_list->nargs = i; |
| 3258 | backtrace_list->evalargs = 0; | 3251 | backtrace_list->evalargs = 0; |
| 3259 | tem = funcall_lambda (fun, XINT (numargs), arg_vector, lexenv); | 3252 | tem = funcall_lambda (fun, XINT (numargs), arg_vector); |
| 3260 | 3253 | ||
| 3261 | /* Do the debug-on-exit now, while arg_vector still exists. */ | 3254 | /* Do the debug-on-exit now, while arg_vector still exists. */ |
| 3262 | if (backtrace_list->debug_on_exit) | 3255 | if (backtrace_list->debug_on_exit) |
| @@ -3321,10 +3314,9 @@ funcall_funvec (Lisp_Object fun, int nargs, Lisp_Object *args) | |||
| 3321 | 3314 | ||
| 3322 | static Lisp_Object | 3315 | static Lisp_Object |
| 3323 | funcall_lambda (Lisp_Object fun, int nargs, | 3316 | funcall_lambda (Lisp_Object fun, int nargs, |
| 3324 | register Lisp_Object *arg_vector, | 3317 | register Lisp_Object *arg_vector) |
| 3325 | Lisp_Object lexenv) | ||
| 3326 | { | 3318 | { |
| 3327 | Lisp_Object val, syms_left, next; | 3319 | Lisp_Object val, syms_left, next, lexenv; |
| 3328 | int count = SPECPDL_INDEX (); | 3320 | int count = SPECPDL_INDEX (); |
| 3329 | int i, optional, rest; | 3321 | int i, optional, rest; |
| 3330 | 3322 | ||
| @@ -3358,6 +3350,14 @@ funcall_lambda (Lisp_Object fun, int nargs, | |||
| 3358 | 3350 | ||
| 3359 | if (CONSP (fun)) | 3351 | if (CONSP (fun)) |
| 3360 | { | 3352 | { |
| 3353 | if (EQ (XCAR (fun), Qclosure)) | ||
| 3354 | { | ||
| 3355 | fun = XCDR (fun); /* Drop `closure'. */ | ||
| 3356 | lexenv = XCAR (fun); | ||
| 3357 | fun = XCDR (fun); /* Drop the lexical environment. */ | ||
| 3358 | } | ||
| 3359 | else | ||
| 3360 | lexenv = Qnil; | ||
| 3361 | syms_left = XCDR (fun); | 3361 | syms_left = XCDR (fun); |
| 3362 | if (CONSP (syms_left)) | 3362 | if (CONSP (syms_left)) |
| 3363 | syms_left = XCAR (syms_left); | 3363 | syms_left = XCAR (syms_left); |
| @@ -3365,7 +3365,10 @@ funcall_lambda (Lisp_Object fun, int nargs, | |||
| 3365 | xsignal1 (Qinvalid_function, fun); | 3365 | xsignal1 (Qinvalid_function, fun); |
| 3366 | } | 3366 | } |
| 3367 | else if (COMPILEDP (fun)) | 3367 | else if (COMPILEDP (fun)) |
| 3368 | syms_left = AREF (fun, COMPILED_ARGLIST); | 3368 | { |
| 3369 | syms_left = AREF (fun, COMPILED_ARGLIST); | ||
| 3370 | lexenv = Qnil; | ||
| 3371 | } | ||
| 3369 | else | 3372 | else |
| 3370 | abort (); | 3373 | abort (); |
| 3371 | 3374 | ||
| @@ -3382,23 +3385,21 @@ funcall_lambda (Lisp_Object fun, int nargs, | |||
| 3382 | rest = 1; | 3385 | rest = 1; |
| 3383 | else if (EQ (next, Qand_optional)) | 3386 | else if (EQ (next, Qand_optional)) |
| 3384 | optional = 1; | 3387 | optional = 1; |
| 3385 | else if (rest) | ||
| 3386 | { | ||
| 3387 | specbind (next, Flist (nargs - i, &arg_vector[i])); | ||
| 3388 | i = nargs; | ||
| 3389 | } | ||
| 3390 | else | 3388 | else |
| 3391 | { | 3389 | { |
| 3392 | Lisp_Object val; | 3390 | Lisp_Object val; |
| 3393 | 3391 | if (rest) | |
| 3394 | /* Get the argument's actual value. */ | 3392 | { |
| 3395 | if (i < nargs) | 3393 | val = Flist (nargs - i, &arg_vector[i]); |
| 3394 | i = nargs; | ||
| 3395 | } | ||
| 3396 | else if (i < nargs) | ||
| 3396 | val = arg_vector[i++]; | 3397 | val = arg_vector[i++]; |
| 3397 | else if (!optional) | 3398 | else if (!optional) |
| 3398 | xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs)); | 3399 | xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs)); |
| 3399 | else | 3400 | else |
| 3400 | val = Qnil; | 3401 | val = Qnil; |
| 3401 | 3402 | ||
| 3402 | /* Bind the argument. */ | 3403 | /* Bind the argument. */ |
| 3403 | if (!NILP (lexenv) && SYMBOLP (next) | 3404 | if (!NILP (lexenv) && SYMBOLP (next) |
| 3404 | /* FIXME: there's no good reason to allow dynamic-scoping | 3405 | /* FIXME: there's no good reason to allow dynamic-scoping |
diff --git a/src/lisp.h b/src/lisp.h index aafa3884273..20b50632c49 100644 --- a/src/lisp.h +++ b/src/lisp.h | |||
| @@ -2972,6 +2972,7 @@ extern void signal_error (const char *, Lisp_Object) NO_RETURN; | |||
| 2972 | EXFUN (Fautoload, 5); | 2972 | EXFUN (Fautoload, 5); |
| 2973 | EXFUN (Fcommandp, 2); | 2973 | EXFUN (Fcommandp, 2); |
| 2974 | EXFUN (Feval, 1); | 2974 | EXFUN (Feval, 1); |
| 2975 | extern Lisp_Object eval_sub (Lisp_Object form); | ||
| 2975 | EXFUN (Fapply, MANY); | 2976 | EXFUN (Fapply, MANY); |
| 2976 | EXFUN (Ffuncall, MANY); | 2977 | EXFUN (Ffuncall, MANY); |
| 2977 | EXFUN (Fbacktrace, 0); | 2978 | EXFUN (Fbacktrace, 0); |
diff --git a/src/lread.c b/src/lread.c index d85d146b157..550b5f076f9 100644 --- a/src/lread.c +++ b/src/lread.c | |||
| @@ -220,8 +220,7 @@ static Lisp_Object Vbytecomp_version_regexp; | |||
| 220 | static int read_emacs_mule_char (int, int (*) (int, Lisp_Object), | 220 | static int read_emacs_mule_char (int, int (*) (int, Lisp_Object), |
| 221 | Lisp_Object); | 221 | Lisp_Object); |
| 222 | 222 | ||
| 223 | static void readevalloop (Lisp_Object, FILE*, Lisp_Object, | 223 | static void readevalloop (Lisp_Object, FILE*, Lisp_Object, int, |
| 224 | Lisp_Object (*) (Lisp_Object), int, | ||
| 225 | Lisp_Object, Lisp_Object, | 224 | Lisp_Object, Lisp_Object, |
| 226 | Lisp_Object, Lisp_Object); | 225 | Lisp_Object, Lisp_Object); |
| 227 | static Lisp_Object load_unwind (Lisp_Object); | 226 | static Lisp_Object load_unwind (Lisp_Object); |
| @@ -1355,13 +1354,13 @@ Return t if the file exists and loads successfully. */) | |||
| 1355 | 1354 | ||
| 1356 | if (! version || version >= 22) | 1355 | if (! version || version >= 22) |
| 1357 | readevalloop (Qget_file_char, stream, hist_file_name, | 1356 | readevalloop (Qget_file_char, stream, hist_file_name, |
| 1358 | Feval, 0, Qnil, Qnil, Qnil, Qnil); | 1357 | 0, Qnil, Qnil, Qnil, Qnil); |
| 1359 | else | 1358 | else |
| 1360 | { | 1359 | { |
| 1361 | /* We can't handle a file which was compiled with | 1360 | /* We can't handle a file which was compiled with |
| 1362 | byte-compile-dynamic by older version of Emacs. */ | 1361 | byte-compile-dynamic by older version of Emacs. */ |
| 1363 | specbind (Qload_force_doc_strings, Qt); | 1362 | specbind (Qload_force_doc_strings, Qt); |
| 1364 | readevalloop (Qget_emacs_mule_file_char, stream, hist_file_name, Feval, | 1363 | readevalloop (Qget_emacs_mule_file_char, stream, hist_file_name, |
| 1365 | 0, Qnil, Qnil, Qnil, Qnil); | 1364 | 0, Qnil, Qnil, Qnil, Qnil); |
| 1366 | } | 1365 | } |
| 1367 | unbind_to (count, Qnil); | 1366 | unbind_to (count, Qnil); |
| @@ -1726,7 +1725,6 @@ static void | |||
| 1726 | readevalloop (Lisp_Object readcharfun, | 1725 | readevalloop (Lisp_Object readcharfun, |
| 1727 | FILE *stream, | 1726 | FILE *stream, |
| 1728 | Lisp_Object sourcename, | 1727 | Lisp_Object sourcename, |
| 1729 | Lisp_Object (*evalfun) (Lisp_Object), | ||
| 1730 | int printflag, | 1728 | int printflag, |
| 1731 | Lisp_Object unibyte, Lisp_Object readfun, | 1729 | Lisp_Object unibyte, Lisp_Object readfun, |
| 1732 | Lisp_Object start, Lisp_Object end) | 1730 | Lisp_Object start, Lisp_Object end) |
| @@ -1872,7 +1870,7 @@ readevalloop (Lisp_Object readcharfun, | |||
| 1872 | unbind_to (count1, Qnil); | 1870 | unbind_to (count1, Qnil); |
| 1873 | 1871 | ||
| 1874 | /* Now eval what we just read. */ | 1872 | /* Now eval what we just read. */ |
| 1875 | val = (*evalfun) (val); | 1873 | val = eval_sub (val); |
| 1876 | 1874 | ||
| 1877 | if (printflag) | 1875 | if (printflag) |
| 1878 | { | 1876 | { |
| @@ -1935,7 +1933,7 @@ This function preserves the position of point. */) | |||
| 1935 | BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf))); | 1933 | BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf))); |
| 1936 | if (lisp_file_lexically_bound_p (buf)) | 1934 | if (lisp_file_lexically_bound_p (buf)) |
| 1937 | Fset (Qlexical_binding, Qt); | 1935 | Fset (Qlexical_binding, Qt); |
| 1938 | readevalloop (buf, 0, filename, Feval, | 1936 | readevalloop (buf, 0, filename, |
| 1939 | !NILP (printflag), unibyte, Qnil, Qnil, Qnil); | 1937 | !NILP (printflag), unibyte, Qnil, Qnil, Qnil); |
| 1940 | unbind_to (count, Qnil); | 1938 | unbind_to (count, Qnil); |
| 1941 | 1939 | ||
| @@ -1969,7 +1967,7 @@ This function does not move point. */) | |||
| 1969 | specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list)); | 1967 | specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list)); |
| 1970 | 1968 | ||
| 1971 | /* readevalloop calls functions which check the type of start and end. */ | 1969 | /* readevalloop calls functions which check the type of start and end. */ |
| 1972 | readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval, | 1970 | readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, |
| 1973 | !NILP (printflag), Qnil, read_function, | 1971 | !NILP (printflag), Qnil, read_function, |
| 1974 | start, end); | 1972 | start, end); |
| 1975 | 1973 | ||
diff --git a/src/minibuf.c b/src/minibuf.c index 0f3def614f2..409f8a9a9ef 100644 --- a/src/minibuf.c +++ b/src/minibuf.c | |||
| @@ -1026,6 +1026,7 @@ is a string to insert in the minibuffer before reading. | |||
| 1026 | Such arguments are used as in `read-from-minibuffer'.) */) | 1026 | Such arguments are used as in `read-from-minibuffer'.) */) |
| 1027 | (Lisp_Object prompt, Lisp_Object initial_contents) | 1027 | (Lisp_Object prompt, Lisp_Object initial_contents) |
| 1028 | { | 1028 | { |
| 1029 | /* FIXME: lexbind. */ | ||
| 1029 | return Feval (read_minibuf (Vread_expression_map, initial_contents, | 1030 | return Feval (read_minibuf (Vread_expression_map, initial_contents, |
| 1030 | prompt, Qnil, 1, Qread_expression_history, | 1031 | prompt, Qnil, 1, Qread_expression_history, |
| 1031 | make_number (0), Qnil, 0, 0)); | 1032 | make_number (0), Qnil, 0, 0)); |
diff --git a/src/print.c b/src/print.c index 77cc2916952..41aa7fc4387 100644 --- a/src/print.c +++ b/src/print.c | |||
| @@ -652,7 +652,7 @@ usage: (with-output-to-temp-buffer BUFNAME BODY...) */) | |||
| 652 | Lisp_Object buf, val; | 652 | Lisp_Object buf, val; |
| 653 | 653 | ||
| 654 | GCPRO1(args); | 654 | GCPRO1(args); |
| 655 | name = Feval (Fcar (args)); | 655 | name = eval_sub (Fcar (args)); |
| 656 | CHECK_STRING (name); | 656 | CHECK_STRING (name); |
| 657 | temp_output_buffer_setup (SDATA (name)); | 657 | temp_output_buffer_setup (SDATA (name)); |
| 658 | buf = Vstandard_output; | 658 | buf = Vstandard_output; |