Mercurial > emacs
comparison src/eval.c @ 9148:e7ab930bb7eb
(Fprogn, Finteractive_p, Fuser_variable_p, FletX, Flet, Fmacroexpand,
Fcommandp, Fautoload, Feval, Fapply, Ffuncall, funcall_lambda, specbind): Use
type test macros.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Tue, 27 Sep 1994 04:03:15 +0000 |
parents | e641b60610a1 |
children | ac852c183fa1 |
comparison
equal
deleted
inserted
replaced
9147:ee9adbda1ad1 | 9148:e7ab930bb7eb |
---|---|
320 /* In Mocklisp code, symbols at the front of the progn arglist | 320 /* In Mocklisp code, symbols at the front of the progn arglist |
321 are to be bound to zero. */ | 321 are to be bound to zero. */ |
322 if (!EQ (Vmocklisp_arguments, Qt)) | 322 if (!EQ (Vmocklisp_arguments, Qt)) |
323 { | 323 { |
324 val = make_number (0); | 324 val = make_number (0); |
325 while (!NILP (args) && (tem = Fcar (args), XTYPE (tem) == Lisp_Symbol)) | 325 while (!NILP (args) && (tem = Fcar (args), SYMBOLP (tem))) |
326 { | 326 { |
327 QUIT; | 327 QUIT; |
328 specbind (tem, val), args = Fcdr (args); | 328 specbind (tem, val), args = Fcdr (args); |
329 } | 329 } |
330 } | 330 } |
482 btp = backtrace_list; | 482 btp = backtrace_list; |
483 | 483 |
484 /* If this isn't a byte-compiled function, there may be a frame at | 484 /* If this isn't a byte-compiled function, there may be a frame at |
485 the top for Finteractive_p itself. If so, skip it. */ | 485 the top for Finteractive_p itself. If so, skip it. */ |
486 fun = Findirect_function (*btp->function); | 486 fun = Findirect_function (*btp->function); |
487 if (XTYPE (fun) == Lisp_Subr | 487 if (SUBRP (fun) |
488 && (struct Lisp_Subr *) XPNTR (fun) == &Sinteractive_p) | 488 && (struct Lisp_Subr *) XPNTR (fun) == &Sinteractive_p) |
489 btp = btp->next; | 489 btp = btp->next; |
490 | 490 |
491 /* If we're running an Emacs 18-style byte-compiled function, there | 491 /* If we're running an Emacs 18-style byte-compiled function, there |
492 may be a frame for Fbytecode. Now, given the strictest | 492 may be a frame for Fbytecode. Now, given the strictest |
505 /* btp now points at the frame of the innermost function that isn't | 505 /* btp now points at the frame of the innermost function that isn't |
506 a special form, ignoring frames for Finteractive_p and/or | 506 a special form, ignoring frames for Finteractive_p and/or |
507 Fbytecode at the top. If this frame is for a built-in function | 507 Fbytecode at the top. If this frame is for a built-in function |
508 (such as load or eval-region) return nil. */ | 508 (such as load or eval-region) return nil. */ |
509 fun = Findirect_function (*btp->function); | 509 fun = Findirect_function (*btp->function); |
510 if (XTYPE (fun) == Lisp_Subr) | 510 if (SUBRP (fun)) |
511 return Qnil; | 511 return Qnil; |
512 /* btp points to the frame of a Lisp function that called interactive-p. | 512 /* btp points to the frame of a Lisp function that called interactive-p. |
513 Return t if that function was called interactively. */ | 513 Return t if that function was called interactively. */ |
514 if (btp && btp->next && EQ (*btp->next->function, Qcall_interactively)) | 514 if (btp && btp->next && EQ (*btp->next->function, Qcall_interactively)) |
515 return Qt; | 515 return Qt; |
634 Lisp_Object variable; | 634 Lisp_Object variable; |
635 { | 635 { |
636 Lisp_Object documentation; | 636 Lisp_Object documentation; |
637 | 637 |
638 documentation = Fget (variable, Qvariable_documentation); | 638 documentation = Fget (variable, Qvariable_documentation); |
639 if (XTYPE (documentation) == Lisp_Int && XINT (documentation) < 0) | 639 if (INTEGERP (documentation) && XINT (documentation) < 0) |
640 return Qt; | 640 return Qt; |
641 if ((XTYPE (documentation) == Lisp_String) && | 641 if ((STRINGP (documentation)) && |
642 ((unsigned char) XSTRING (documentation)->data[0] == '*')) | 642 ((unsigned char) XSTRING (documentation)->data[0] == '*')) |
643 return Qt; | 643 return Qt; |
644 return Qnil; | 644 return Qnil; |
645 } | 645 } |
646 | 646 |
662 varlist = Fcar (args); | 662 varlist = Fcar (args); |
663 while (!NILP (varlist)) | 663 while (!NILP (varlist)) |
664 { | 664 { |
665 QUIT; | 665 QUIT; |
666 elt = Fcar (varlist); | 666 elt = Fcar (varlist); |
667 if (XTYPE (elt) == Lisp_Symbol) | 667 if (SYMBOLP (elt)) |
668 specbind (elt, Qnil); | 668 specbind (elt, Qnil); |
669 else if (! NILP (Fcdr (Fcdr (elt)))) | 669 else if (! NILP (Fcdr (Fcdr (elt)))) |
670 Fsignal (Qerror, | 670 Fsignal (Qerror, |
671 Fcons (build_string ("`let' bindings can have only one value-form"), | 671 Fcons (build_string ("`let' bindings can have only one value-form"), |
672 elt)); | 672 elt)); |
710 | 710 |
711 for (argnum = 0; !NILP (varlist); varlist = Fcdr (varlist)) | 711 for (argnum = 0; !NILP (varlist); varlist = Fcdr (varlist)) |
712 { | 712 { |
713 QUIT; | 713 QUIT; |
714 elt = Fcar (varlist); | 714 elt = Fcar (varlist); |
715 if (XTYPE (elt) == Lisp_Symbol) | 715 if (SYMBOLP (elt)) |
716 temps [argnum++] = Qnil; | 716 temps [argnum++] = Qnil; |
717 else if (! NILP (Fcdr (Fcdr (elt)))) | 717 else if (! NILP (Fcdr (Fcdr (elt)))) |
718 Fsignal (Qerror, | 718 Fsignal (Qerror, |
719 Fcons (build_string ("`let' bindings can have only one value-form"), | 719 Fcons (build_string ("`let' bindings can have only one value-form"), |
720 elt)); | 720 elt)); |
727 varlist = Fcar (args); | 727 varlist = Fcar (args); |
728 for (argnum = 0; !NILP (varlist); varlist = Fcdr (varlist)) | 728 for (argnum = 0; !NILP (varlist); varlist = Fcdr (varlist)) |
729 { | 729 { |
730 elt = Fcar (varlist); | 730 elt = Fcar (varlist); |
731 tem = temps[argnum++]; | 731 tem = temps[argnum++]; |
732 if (XTYPE (elt) == Lisp_Symbol) | 732 if (SYMBOLP (elt)) |
733 specbind (elt, tem); | 733 specbind (elt, tem); |
734 else | 734 else |
735 specbind (Fcar (elt), tem); | 735 specbind (Fcar (elt), tem); |
736 } | 736 } |
737 | 737 |
780 | 780 |
781 while (1) | 781 while (1) |
782 { | 782 { |
783 /* Come back here each time we expand a macro call, | 783 /* Come back here each time we expand a macro call, |
784 in case it expands into another macro call. */ | 784 in case it expands into another macro call. */ |
785 if (XTYPE (form) != Lisp_Cons) | 785 if (!CONSP (form)) |
786 break; | 786 break; |
787 /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */ | 787 /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */ |
788 def = sym = XCONS (form)->car; | 788 def = sym = XCONS (form)->car; |
789 tem = Qnil; | 789 tem = Qnil; |
790 /* Trace symbols aliases to other symbols | 790 /* Trace symbols aliases to other symbols |
791 until we get a symbol that is not an alias. */ | 791 until we get a symbol that is not an alias. */ |
792 while (XTYPE (def) == Lisp_Symbol) | 792 while (SYMBOLP (def)) |
793 { | 793 { |
794 QUIT; | 794 QUIT; |
795 sym = def; | 795 sym = def; |
796 tem = Fassq (sym, env); | 796 tem = Fassq (sym, env); |
797 if (NILP (tem)) | 797 if (NILP (tem)) |
806 and if TEM is nil then DEF is SYM's function definition. */ | 806 and if TEM is nil then DEF is SYM's function definition. */ |
807 if (NILP (tem)) | 807 if (NILP (tem)) |
808 { | 808 { |
809 /* SYM is not mentioned in ENV. | 809 /* SYM is not mentioned in ENV. |
810 Look at its function definition. */ | 810 Look at its function definition. */ |
811 if (EQ (def, Qunbound) | 811 if (EQ (def, Qunbound) || !CONSP (def)) |
812 || XTYPE (def) != Lisp_Cons) | |
813 /* Not defined or definition not suitable */ | 812 /* Not defined or definition not suitable */ |
814 break; | 813 break; |
815 if (EQ (XCONS (def)->car, Qautoload)) | 814 if (EQ (XCONS (def)->car, Qautoload)) |
816 { | 815 { |
817 /* Autoloading function: will it be a macro when loaded? */ | 816 /* Autoloading function: will it be a macro when loaded? */ |
1373 if (EQ (fun, Qunbound)) | 1372 if (EQ (fun, Qunbound)) |
1374 return Qnil; | 1373 return Qnil; |
1375 | 1374 |
1376 /* Emacs primitives are interactive if their DEFUN specifies an | 1375 /* Emacs primitives are interactive if their DEFUN specifies an |
1377 interactive spec. */ | 1376 interactive spec. */ |
1378 if (XTYPE (fun) == Lisp_Subr) | 1377 if (SUBRP (fun)) |
1379 { | 1378 { |
1380 if (XSUBR (fun)->prompt) | 1379 if (XSUBR (fun)->prompt) |
1381 return Qt; | 1380 return Qt; |
1382 else | 1381 else |
1383 return Qnil; | 1382 return Qnil; |
1384 } | 1383 } |
1385 | 1384 |
1386 /* Bytecode objects are interactive if they are long enough to | 1385 /* Bytecode objects are interactive if they are long enough to |
1387 have an element whose index is COMPILED_INTERACTIVE, which is | 1386 have an element whose index is COMPILED_INTERACTIVE, which is |
1388 where the interactive spec is stored. */ | 1387 where the interactive spec is stored. */ |
1389 else if (XTYPE (fun) == Lisp_Compiled) | 1388 else if (COMPILEDP (fun)) |
1390 return (XVECTOR (fun)->size > COMPILED_INTERACTIVE | 1389 return (XVECTOR (fun)->size > COMPILED_INTERACTIVE |
1391 ? Qt : Qnil); | 1390 ? Qt : Qnil); |
1392 | 1391 |
1393 /* Strings and vectors are keyboard macros. */ | 1392 /* Strings and vectors are keyboard macros. */ |
1394 if (XTYPE (fun) == Lisp_String | 1393 if (STRINGP (fun) || VECTORP (fun)) |
1395 || XTYPE (fun) == Lisp_Vector) | |
1396 return Qt; | 1394 return Qt; |
1397 | 1395 |
1398 /* Lists may represent commands. */ | 1396 /* Lists may represent commands. */ |
1399 if (!CONSP (fun)) | 1397 if (!CONSP (fun)) |
1400 return Qnil; | 1398 return Qnil; |
1401 funcar = Fcar (fun); | 1399 funcar = Fcar (fun); |
1402 if (XTYPE (funcar) != Lisp_Symbol) | 1400 if (!SYMBOLP (funcar)) |
1403 return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); | 1401 return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); |
1404 if (EQ (funcar, Qlambda)) | 1402 if (EQ (funcar, Qlambda)) |
1405 return Fassq (Qinteractive, Fcdr (Fcdr (fun))); | 1403 return Fassq (Qinteractive, Fcdr (Fcdr (fun))); |
1406 if (EQ (funcar, Qmocklisp)) | 1404 if (EQ (funcar, Qmocklisp)) |
1407 return Qt; /* All mocklisp functions can be called interactively */ | 1405 return Qt; /* All mocklisp functions can be called interactively */ |
1435 CHECK_SYMBOL (function, 0); | 1433 CHECK_SYMBOL (function, 0); |
1436 CHECK_STRING (file, 1); | 1434 CHECK_STRING (file, 1); |
1437 | 1435 |
1438 /* If function is defined and not as an autoload, don't override */ | 1436 /* If function is defined and not as an autoload, don't override */ |
1439 if (!EQ (XSYMBOL (function)->function, Qunbound) | 1437 if (!EQ (XSYMBOL (function)->function, Qunbound) |
1440 && !(XTYPE (XSYMBOL (function)->function) == Lisp_Cons | 1438 && !(CONSP (XSYMBOL (function)->function) |
1441 && EQ (XCONS (XSYMBOL (function)->function)->car, Qautoload))) | 1439 && EQ (XCONS (XSYMBOL (function)->function)->car, Qautoload))) |
1442 return Qnil; | 1440 return Qnil; |
1443 | 1441 |
1444 #ifdef NO_ARG_ARRAY | 1442 #ifdef NO_ARG_ARRAY |
1445 args[0] = file; | 1443 args[0] = file; |
1527 Lisp_Object fun, val, original_fun, original_args; | 1525 Lisp_Object fun, val, original_fun, original_args; |
1528 Lisp_Object funcar; | 1526 Lisp_Object funcar; |
1529 struct backtrace backtrace; | 1527 struct backtrace backtrace; |
1530 struct gcpro gcpro1, gcpro2, gcpro3; | 1528 struct gcpro gcpro1, gcpro2, gcpro3; |
1531 | 1529 |
1532 if (XTYPE (form) == Lisp_Symbol) | 1530 if (SYMBOLP (form)) |
1533 { | 1531 { |
1534 if (EQ (Vmocklisp_arguments, Qt)) | 1532 if (EQ (Vmocklisp_arguments, Qt)) |
1535 return Fsymbol_value (form); | 1533 return Fsymbol_value (form); |
1536 val = Fsymbol_value (form); | 1534 val = Fsymbol_value (form); |
1537 if (NILP (val)) | 1535 if (NILP (val)) |
1576 /* At this point, only original_fun and original_args | 1574 /* At this point, only original_fun and original_args |
1577 have values that will be used below */ | 1575 have values that will be used below */ |
1578 retry: | 1576 retry: |
1579 fun = Findirect_function (original_fun); | 1577 fun = Findirect_function (original_fun); |
1580 | 1578 |
1581 if (XTYPE (fun) == Lisp_Subr) | 1579 if (SUBRP (fun)) |
1582 { | 1580 { |
1583 Lisp_Object numargs; | 1581 Lisp_Object numargs; |
1584 Lisp_Object argvals[7]; | 1582 Lisp_Object argvals[7]; |
1585 Lisp_Object args_left; | 1583 Lisp_Object args_left; |
1586 register int i, maxargs; | 1584 register int i, maxargs; |
1681 subr to use a different argument protocol, or add more | 1679 subr to use a different argument protocol, or add more |
1682 cases to this switch. */ | 1680 cases to this switch. */ |
1683 abort (); | 1681 abort (); |
1684 } | 1682 } |
1685 } | 1683 } |
1686 if (XTYPE (fun) == Lisp_Compiled) | 1684 if (COMPILEDP (fun)) |
1687 val = apply_lambda (fun, original_args, 1); | 1685 val = apply_lambda (fun, original_args, 1); |
1688 else | 1686 else |
1689 { | 1687 { |
1690 if (!CONSP (fun)) | 1688 if (!CONSP (fun)) |
1691 return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); | 1689 return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); |
1692 funcar = Fcar (fun); | 1690 funcar = Fcar (fun); |
1693 if (XTYPE (funcar) != Lisp_Symbol) | 1691 if (!SYMBOLP (funcar)) |
1694 return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); | 1692 return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); |
1695 if (EQ (funcar, Qautoload)) | 1693 if (EQ (funcar, Qautoload)) |
1696 { | 1694 { |
1697 do_autoload (fun, original_fun); | 1695 do_autoload (fun, original_fun); |
1698 goto retry; | 1696 goto retry; |
1757 /* Let funcall get the error */ | 1755 /* Let funcall get the error */ |
1758 fun = args[0]; | 1756 fun = args[0]; |
1759 goto funcall; | 1757 goto funcall; |
1760 } | 1758 } |
1761 | 1759 |
1762 if (XTYPE (fun) == Lisp_Subr) | 1760 if (SUBRP (fun)) |
1763 { | 1761 { |
1764 if (numargs < XSUBR (fun)->min_args | 1762 if (numargs < XSUBR (fun)->min_args |
1765 || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs)) | 1763 || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs)) |
1766 goto funcall; /* Let funcall get the error */ | 1764 goto funcall; /* Let funcall get the error */ |
1767 else if (XSUBR (fun)->max_args > numargs) | 1765 else if (XSUBR (fun)->max_args > numargs) |
2020 | 2018 |
2021 fun = args[0]; | 2019 fun = args[0]; |
2022 | 2020 |
2023 fun = Findirect_function (fun); | 2021 fun = Findirect_function (fun); |
2024 | 2022 |
2025 if (XTYPE (fun) == Lisp_Subr) | 2023 if (SUBRP (fun)) |
2026 { | 2024 { |
2027 if (numargs < XSUBR (fun)->min_args | 2025 if (numargs < XSUBR (fun)->min_args |
2028 || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs)) | 2026 || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs)) |
2029 { | 2027 { |
2030 XFASTINT (lisp_numargs) = numargs; | 2028 XFASTINT (lisp_numargs) = numargs; |
2093 or UNEVALLED, we need to extend this function to support it. | 2091 or UNEVALLED, we need to extend this function to support it. |
2094 Until this is done, there is no way to call the function. */ | 2092 Until this is done, there is no way to call the function. */ |
2095 abort (); | 2093 abort (); |
2096 } | 2094 } |
2097 } | 2095 } |
2098 if (XTYPE (fun) == Lisp_Compiled) | 2096 if (COMPILEDP (fun)) |
2099 val = funcall_lambda (fun, numargs, args + 1); | 2097 val = funcall_lambda (fun, numargs, args + 1); |
2100 else | 2098 else |
2101 { | 2099 { |
2102 if (!CONSP (fun)) | 2100 if (!CONSP (fun)) |
2103 return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); | 2101 return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); |
2104 funcar = Fcar (fun); | 2102 funcar = Fcar (fun); |
2105 if (XTYPE (funcar) != Lisp_Symbol) | 2103 if (!SYMBOLP (funcar)) |
2106 return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); | 2104 return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); |
2107 if (EQ (funcar, Qlambda)) | 2105 if (EQ (funcar, Qlambda)) |
2108 val = funcall_lambda (fun, numargs, args + 1); | 2106 val = funcall_lambda (fun, numargs, args + 1); |
2109 else if (EQ (funcar, Qmocklisp)) | 2107 else if (EQ (funcar, Qmocklisp)) |
2110 val = ml_apply (fun, Flist (numargs, args + 1)); | 2108 val = ml_apply (fun, Flist (numargs, args + 1)); |
2189 | 2187 |
2190 specbind (Qmocklisp_arguments, Qt); /* t means NOT mocklisp! */ | 2188 specbind (Qmocklisp_arguments, Qt); /* t means NOT mocklisp! */ |
2191 | 2189 |
2192 XFASTINT (numargs) = nargs; | 2190 XFASTINT (numargs) = nargs; |
2193 | 2191 |
2194 if (XTYPE (fun) == Lisp_Cons) | 2192 if (CONSP (fun)) |
2195 syms_left = Fcar (Fcdr (fun)); | 2193 syms_left = Fcar (Fcdr (fun)); |
2196 else if (XTYPE (fun) == Lisp_Compiled) | 2194 else if (COMPILEDP (fun)) |
2197 syms_left = XVECTOR (fun)->contents[COMPILED_ARGLIST]; | 2195 syms_left = XVECTOR (fun)->contents[COMPILED_ARGLIST]; |
2198 else abort (); | 2196 else abort (); |
2199 | 2197 |
2200 i = 0; | 2198 i = 0; |
2201 for (; !NILP (syms_left); syms_left = Fcdr (syms_left)) | 2199 for (; !NILP (syms_left); syms_left = Fcdr (syms_left)) |
2202 { | 2200 { |
2203 QUIT; | 2201 QUIT; |
2204 next = Fcar (syms_left); | 2202 next = Fcar (syms_left); |
2205 while (XTYPE (next) != Lisp_Symbol) | 2203 while (!SYMBOLP (next)) |
2206 next = Fsignal (Qinvalid_function, Fcons (fun, Qnil)); | 2204 next = Fsignal (Qinvalid_function, Fcons (fun, Qnil)); |
2207 if (EQ (next, Qand_rest)) | 2205 if (EQ (next, Qand_rest)) |
2208 rest = 1; | 2206 rest = 1; |
2209 else if (EQ (next, Qand_optional)) | 2207 else if (EQ (next, Qand_optional)) |
2210 optional = 1; | 2208 optional = 1; |
2225 } | 2223 } |
2226 | 2224 |
2227 if (i < nargs) | 2225 if (i < nargs) |
2228 return Fsignal (Qwrong_number_of_arguments, Fcons (fun, Fcons (numargs, Qnil))); | 2226 return Fsignal (Qwrong_number_of_arguments, Fcons (fun, Fcons (numargs, Qnil))); |
2229 | 2227 |
2230 if (XTYPE (fun) == Lisp_Cons) | 2228 if (CONSP (fun)) |
2231 val = Fprogn (Fcdr (Fcdr (fun))); | 2229 val = Fprogn (Fcdr (Fcdr (fun))); |
2232 else | 2230 else |
2233 val = Fbyte_code (XVECTOR (fun)->contents[COMPILED_BYTECODE], | 2231 val = Fbyte_code (XVECTOR (fun)->contents[COMPILED_BYTECODE], |
2234 XVECTOR (fun)->contents[COMPILED_CONSTANTS], | 2232 XVECTOR (fun)->contents[COMPILED_CONSTANTS], |
2235 XVECTOR (fun)->contents[COMPILED_STACK_DEPTH]); | 2233 XVECTOR (fun)->contents[COMPILED_STACK_DEPTH]); |
2273 grow_specpdl (); | 2271 grow_specpdl (); |
2274 specpdl_ptr->symbol = symbol; | 2272 specpdl_ptr->symbol = symbol; |
2275 specpdl_ptr->func = 0; | 2273 specpdl_ptr->func = 0; |
2276 specpdl_ptr->old_value = ovalue = find_symbol_value (symbol); | 2274 specpdl_ptr->old_value = ovalue = find_symbol_value (symbol); |
2277 specpdl_ptr++; | 2275 specpdl_ptr++; |
2278 if (XTYPE (ovalue) == Lisp_Buffer_Objfwd) | 2276 if (BUFFER_OBJFWDP (ovalue)) |
2279 store_symval_forwarding (symbol, ovalue, value); | 2277 store_symval_forwarding (symbol, ovalue, value); |
2280 else | 2278 else |
2281 Fset (symbol, value); | 2279 Fset (symbol, value); |
2282 } | 2280 } |
2283 | 2281 |