comparison src/eval.c @ 5615:5f4f92a31875

Move the functionality of #'cl-macroexpand into Fmacroexpand, eval.c src/ChangeLog addition: 2011-12-22 Aidan Kehoe <kehoea@parhasard.net> * eval.c (Fmacroexpand): Rename Fmacroexpand_internal, add the functionality that used to be in #'cl-macroexpand--it makes no sense for us, and needlessly slows things down, to have two separate functions. * eval.c: * eval.c (syms_of_eval): Move byte-compile-macro-environment here, now it's used by #'macroexpand. lisp/ChangeLog addition: 2011-12-22 Aidan Kehoe <kehoea@parhasard.net> * bytecomp-runtime.el: * bytecomp-runtime.el (byte-compile-macro-environment): Moved to eval.c. * cl.el: * cl.el ('cl-macroexpand): New alias. * cl.el ('macroexpand-internal): New alias. * cl.el (cl-macroexpand): Move the functionality of this to #'macroexpand (formerly #'macroexpand-internal) in eval.c; since CL is always loaded in XEmacs, it brings nothing and slows things down to have the two functions separate.
author Aidan Kehoe <kehoea@parhasard.net>
date Thu, 22 Dec 2011 12:51:03 +0000
parents 56144c8593a8
children f5315ccbf005
comparison
equal deleted inserted replaced
5614:281bf2b87915 5615:5f4f92a31875
228 Lisp_Object Qinteractive, Qcommandp, Qdefun, Qprogn, Qvalues; 228 Lisp_Object Qinteractive, Qcommandp, Qdefun, Qprogn, Qvalues;
229 Lisp_Object Vquit_flag, Vinhibit_quit; 229 Lisp_Object Vquit_flag, Vinhibit_quit;
230 Lisp_Object Qand_rest, Qand_optional; 230 Lisp_Object Qand_rest, Qand_optional;
231 Lisp_Object Qdebug_on_error, Qstack_trace_on_error; 231 Lisp_Object Qdebug_on_error, Qstack_trace_on_error;
232 Lisp_Object Qdebug_on_signal, Qstack_trace_on_signal; 232 Lisp_Object Qdebug_on_signal, Qstack_trace_on_signal;
233 Lisp_Object Qdebugger; 233 Lisp_Object Qdebugger, Qbyte_compile_macro_environment;
234 Lisp_Object Qinhibit_quit; 234 Lisp_Object Qinhibit_quit;
235 Lisp_Object Qfinalize_list; 235 Lisp_Object Qfinalize_list;
236 Lisp_Object Qrun_hooks; 236 Lisp_Object Qrun_hooks;
237 Lisp_Object Qsetq; 237 Lisp_Object Qsetq;
238 Lisp_Object Qdisplay_warning; 238 Lisp_Object Qdisplay_warning;
271 if the file being autoloaded is not fully loaded. 271 if the file being autoloaded is not fully loaded.
272 They are recorded by being consed onto the front of Vautoload_queue: 272 They are recorded by being consed onto the front of Vautoload_queue:
273 (FUN . ODEF) for a defun, (OFEATURES . nil) for a provide. */ 273 (FUN . ODEF) for a defun, (OFEATURES . nil) for a provide. */
274 Lisp_Object Vautoload_queue; 274 Lisp_Object Vautoload_queue;
275 275
276 Lisp_Object Vmacro_declaration_function; 276 Lisp_Object Vmacro_declaration_function, Vbyte_compile_macro_environment;
277 277
278 /* Current number of specbindings allocated in specpdl. */ 278 /* Current number of specbindings allocated in specpdl. */
279 int specpdl_size; 279 int specpdl_size;
280 280
281 /* Pointer to beginning of specpdl. */ 281 /* Pointer to beginning of specpdl. */
1547 } 1547 }
1548 1548
1549 /* XEmacs: user-variable-p is in symbols.c, since it needs to mess around 1549 /* XEmacs: user-variable-p is in symbols.c, since it needs to mess around
1550 with the symbol variable aliases. */ 1550 with the symbol variable aliases. */
1551 1551
1552 DEFUN ("macroexpand-internal", Fmacroexpand_internal, 1, 2, 0, /* 1552 DEFUN ("macroexpand", Fmacroexpand, 1, 2, 0, /*
1553 Return result of expanding macros at top level of FORM. 1553 Return result of expanding macros at top level of FORM.
1554 If FORM is not a macro call, it is returned unchanged. 1554 If FORM is not a macro call, it is returned unchanged.
1555 Otherwise, the macro is expanded and the expansion is considered 1555 Otherwise, the macro is expanded and the expansion is considered
1556 in place of FORM. When a non-macro-call results, it is returned. 1556 in place of FORM. When a non-macro-call results, it is returned.
1557 1557
1561 (form, environment)) 1561 (form, environment))
1562 { 1562 {
1563 /* This function can GC */ 1563 /* This function can GC */
1564 /* With cleanups from Hallvard Furuseth. */ 1564 /* With cleanups from Hallvard Furuseth. */
1565 REGISTER Lisp_Object expander, sym, def, tem; 1565 REGISTER Lisp_Object expander, sym, def, tem;
1566 int speccount = specpdl_depth ();
1567
1568 if (!NILP (environment))
1569 {
1570 if (NILP (Vbyte_compile_macro_environment))
1571 {
1572 specbind (Qbyte_compile_macro_environment, environment);
1573 }
1574 else
1575 {
1576 specbind (Qbyte_compile_macro_environment,
1577 nconc2 (Fcopy_list (environment),
1578 Vbyte_compile_macro_environment));
1579 environment = Vbyte_compile_macro_environment;
1580 }
1581 }
1566 1582
1567 while (1) 1583 while (1)
1568 { 1584 {
1569 /* Come back here each time we expand a macro call, 1585 /* Come back here each time we expand a macro call,
1570 in case it expands into another macro call. */ 1586 in case it expands into another macro call. */
1587 if (SYMBOLP (form))
1588 {
1589 Lisp_Object hashed = make_integer ((EMACS_INT) (LISP_HASH (form)));
1590 Lisp_Object assocked;
1591
1592 if (BIGNUMP (hashed))
1593 {
1594 struct gcpro gcpro1;
1595 GCPRO1 (hashed);
1596 assocked = Fassoc (hashed, environment);
1597 UNGCPRO;
1598 }
1599 else
1600 {
1601 assocked = Fassq (hashed, environment);
1602 }
1603
1604 if (CONSP (assocked) && !NILP (XCDR (assocked)))
1605 {
1606 form = Fcar (XCDR (assocked));
1607 continue;
1608 }
1609 }
1610
1571 if (!CONSP (form)) 1611 if (!CONSP (form))
1572 break; 1612 break;
1573 /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */ 1613 /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
1574 def = sym = XCAR (form); 1614 def = sym = XCAR (form);
1575 tem = Qnil; 1615 tem = Qnil;
1622 if (NILP (expander)) 1662 if (NILP (expander))
1623 break; 1663 break;
1624 } 1664 }
1625 form = apply1 (expander, XCDR (form)); 1665 form = apply1 (expander, XCDR (form));
1626 } 1666 }
1667
1668 unbind_to (speccount);
1669
1627 return form; 1670 return form;
1628 } 1671 }
1629 1672
1630 1673
1631 /************************************************************************/ 1674 /************************************************************************/
7332 INIT_LISP_OBJECT (subr); 7375 INIT_LISP_OBJECT (subr);
7333 INIT_LISP_OBJECT (multiple_value); 7376 INIT_LISP_OBJECT (multiple_value);
7334 7377
7335 DEFSYMBOL (Qinhibit_quit); 7378 DEFSYMBOL (Qinhibit_quit);
7336 DEFSYMBOL (Qautoload); 7379 DEFSYMBOL (Qautoload);
7380 DEFSYMBOL (Qbyte_compile_macro_environment);
7337 DEFSYMBOL (Qdebug_on_error); 7381 DEFSYMBOL (Qdebug_on_error);
7338 DEFSYMBOL (Qstack_trace_on_error); 7382 DEFSYMBOL (Qstack_trace_on_error);
7339 DEFSYMBOL (Qdebug_on_signal); 7383 DEFSYMBOL (Qdebug_on_signal);
7340 DEFSYMBOL (Qstack_trace_on_signal); 7384 DEFSYMBOL (Qstack_trace_on_signal);
7341 DEFSYMBOL (Qdebugger); 7385 DEFSYMBOL (Qdebugger);
7377 DEFSUBR (Fdefvar); 7421 DEFSUBR (Fdefvar);
7378 DEFSUBR (Fdefconst); 7422 DEFSUBR (Fdefconst);
7379 DEFSUBR (Flet); 7423 DEFSUBR (Flet);
7380 DEFSUBR (FletX); 7424 DEFSUBR (FletX);
7381 DEFSUBR (Fwhile); 7425 DEFSUBR (Fwhile);
7382 DEFSUBR (Fmacroexpand_internal); 7426 DEFSUBR (Fmacroexpand);
7383 DEFSUBR (Fcatch); 7427 DEFSUBR (Fcatch);
7384 DEFSUBR (Fthrow); 7428 DEFSUBR (Fthrow);
7385 DEFSUBR (Funwind_protect); 7429 DEFSUBR (Funwind_protect);
7386 DEFSUBR (Fcondition_case); 7430 DEFSUBR (Fcondition_case);
7387 DEFSUBR (Fcall_with_condition_handler); 7431 DEFSUBR (Fcall_with_condition_handler);
7609 DECL is a list `(declare ...)' containing the declarations. 7653 DECL is a list `(declare ...)' containing the declarations.
7610 The value the function returns is not used. 7654 The value the function returns is not used.
7611 */); 7655 */);
7612 Vmacro_declaration_function = Qnil; 7656 Vmacro_declaration_function = Qnil;
7613 7657
7658 DEFVAR_LISP ("byte-compile-macro-environment", &Vbyte_compile_macro_environment /*
7659 Alist of macros defined in the file being compiled.
7660 Each element looks like (MACRONAME . DEFINITION). It is
7661 \(MACRONAME . nil) when a macro is redefined as a function.
7662 */);
7663 Vbyte_compile_macro_environment = Qnil;
7664
7614 staticpro (&Vcatch_everything_tag); 7665 staticpro (&Vcatch_everything_tag);
7615 Vcatch_everything_tag = make_opaque (OPAQUE_CLEAR, 0); 7666 Vcatch_everything_tag = make_opaque (OPAQUE_CLEAR, 0);
7616 7667
7617 staticpro (&Vpending_warnings); 7668 staticpro (&Vpending_warnings);
7618 Vpending_warnings = Qnil; 7669 Vpending_warnings = Qnil;