Mercurial > hg > xemacs-beta

comparison src/eval.c @ 243:f220cc83d72e r20-5b20

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-5b20
author cvs
date Mon, 13 Aug 2007 10:17:07 +0200
parents f955c73f5258
children 51092a27c943
comparison
equal deleted inserted replaced
242:fc816b73a05f 243:f220cc83d72e
652 If all args return nil, return nil. 652 If all args return nil, return nil.
653 */ 653 */
654 (args)) 654 (args))
655 { 655 {
656 /* This function can GC */ 656 /* This function can GC */
657 REGISTER Lisp_Object val; 657 Lisp_Object val = Qnil;
658 Lisp_Object args_left;
659 struct gcpro gcpro1; 658 struct gcpro gcpro1;
660 659
661 if (NILP (args)) 660 GCPRO1 (args);
662 return Qnil; 661
663 662 while (!NILP (args))
664 args_left = args; 663 {
665 GCPRO1 (args_left); 664 val = Feval (XCAR (args));
666
667 do
668 {
669 val = Feval (Fcar (args_left));
670 if (!NILP (val)) 665 if (!NILP (val))
671 break; 666 break;
672 args_left = Fcdr (args_left); 667 args = XCDR (args);
673 } 668 }
674 while (!NILP (args_left));
675 669
676 UNGCPRO; 670 UNGCPRO;
677 return val; 671 return val;
678 } 672 }
679 673
683 If no arg yields nil, return the last arg's value. 677 If no arg yields nil, return the last arg's value.
684 */ 678 */
685 (args)) 679 (args))
686 { 680 {
687 /* This function can GC */ 681 /* This function can GC */
688 REGISTER Lisp_Object val; 682 Lisp_Object val = Qt;
689 Lisp_Object args_left;
690 struct gcpro gcpro1; 683 struct gcpro gcpro1;
691 684
692 if (NILP (args)) 685 GCPRO1 (args);
693 return Qt; 686
694 687 while (!NILP (args))
695 args_left = args; 688 {
696 GCPRO1 (args_left); 689 val = Feval (XCAR (args));
697
698 do
699 {
700 val = Feval (Fcar (args_left));
701 if (NILP (val)) 690 if (NILP (val))
702 break; 691 break;
703 args_left = Fcdr (args_left); 692 args = XCDR (args);
704 } 693 }
705 while (!NILP (args_left));
706 694
707 UNGCPRO; 695 UNGCPRO;
708 return val; 696 return val;
709 } 697 }
710 698
719 /* This function can GC */ 707 /* This function can GC */
720 Lisp_Object cond; 708 Lisp_Object cond;
721 struct gcpro gcpro1; 709 struct gcpro gcpro1;
722 710
723 GCPRO1 (args); 711 GCPRO1 (args);
724 cond = Feval (Fcar (args)); 712 cond = Feval (XCAR (args));
725 UNGCPRO; 713 UNGCPRO;
726 714
715 args = XCDR (args);
716
727 if (!NILP (cond)) 717 if (!NILP (cond))
728 return Feval (Fcar (Fcdr (args))); 718 return Feval (XCAR (args));
729 return Fprogn (Fcdr (Fcdr (args))); 719 return Fprogn (XCDR (args));
730 } 720 }
731 721
732 DEFUN ("cond", Fcond, 0, UNEVALLED, 0, /* 722 DEFUN ("cond", Fcond, 0, UNEVALLED, 0, /*
733 (cond CLAUSES...): try each clause until one succeeds. 723 (cond CLAUSES...): try each clause until one succeeds.
734 Each clause looks like (CONDITION BODY...). CONDITION is evaluated 724 Each clause looks like (CONDITION BODY...). CONDITION is evaluated
740 CONDITION's value if non-nil is returned from the cond-form. 730 CONDITION's value if non-nil is returned from the cond-form.
741 */ 731 */
742 (args)) 732 (args))
743 { 733 {
744 /* This function can GC */ 734 /* This function can GC */
745 REGISTER Lisp_Object clause, val; 735 Lisp_Object val = Qnil;
746 struct gcpro gcpro1; 736 struct gcpro gcpro1;
747 737
748 val = Qnil;
749 GCPRO1 (args); 738 GCPRO1 (args);
750 while (!NILP (args)) 739 while (!NILP (args))
751 { 740 {
752 clause = Fcar (args); 741 Lisp_Object clause = XCAR (args);
753 val = Feval (Fcar (clause)); 742 val = Feval (XCAR (clause));
754 if (!NILP (val)) 743 if (!NILP (val))
755 { 744 {
756 if (!EQ (XCDR (clause), Qnil)) 745 if (!EQ (XCDR (clause), Qnil))
757 val = Fprogn (XCDR (clause)); 746 val = Fprogn (XCDR (clause));
758 break; 747 break;
768 (progn BODY...): eval BODY forms sequentially and return value of last one. 757 (progn BODY...): eval BODY forms sequentially and return value of last one.
769 */ 758 */
770 (args)) 759 (args))
771 { 760 {
772 /* This function can GC */ 761 /* This function can GC */
773 REGISTER Lisp_Object val; 762 Lisp_Object val = Qnil;
774 Lisp_Object args_left;
775 struct gcpro gcpro1; 763 struct gcpro gcpro1;
776 764
777 if (! CONSP (args)) 765 GCPRO1 (args);
778 return Qnil; 766
779 767 while (!NILP (args))
780 args_left = args; 768 {
781 GCPRO1 (args_left); 769 val = Feval (XCAR (args));
782 770 args = XCDR (args);
783 do 771 }
784 {
785 val = Feval (XCAR (args_left));
786 args_left = XCDR (args_left);
787 }
788 while (CONSP (args_left));
789 772
790 UNGCPRO; 773 UNGCPRO;
791 return val; 774 return val;
792 } 775 }
793 776
798 */ 781 */
799 (args)) 782 (args))
800 { 783 {
801 /* This function can GC */ 784 /* This function can GC */
802 Lisp_Object val; 785 Lisp_Object val;
803 REGISTER Lisp_Object args_left;
804 struct gcpro gcpro1, gcpro2; 786 struct gcpro gcpro1, gcpro2;
805 REGISTER int argnum = 0; 787
806
807 if (NILP (args))
808 return Qnil;
809
810 args_left = args;
811 val = Qnil;
812 GCPRO2 (args, val); 788 GCPRO2 (args, val);
813 789
814 do 790 val = Feval (XCAR (args));
815 { 791 args = XCDR (args);
816 if (!(argnum++)) 792
817 val = Feval (Fcar (args_left)); 793 while (!NILP (args))
818 else 794 {
819 Feval (Fcar (args_left)); 795 Feval (XCAR (args));
820 args_left = Fcdr (args_left); 796 args = XCDR (args);
821 } 797 }
822 while (!NILP (args_left));
823 798
824 UNGCPRO; 799 UNGCPRO;
825 return val; 800 return val;
826 } 801 }
827 802
832 */ 807 */
833 (args)) 808 (args))
834 { 809 {
835 /* This function can GC */ 810 /* This function can GC */
836 Lisp_Object val; 811 Lisp_Object val;
837 REGISTER Lisp_Object args_left;
838 struct gcpro gcpro1, gcpro2; 812 struct gcpro gcpro1, gcpro2;
839 REGISTER int argnum = -1; 813
840
841 val = Qnil;
842
843 if (NILP (args))
844 return Qnil;
845
846 args_left = args;
847 val = Qnil;
848 GCPRO2 (args, val); 814 GCPRO2 (args, val);
849 815
850 do 816 Feval (XCAR (args));
851 { 817 args = XCDR (args);
852 if (!(argnum++)) 818 val = Feval (XCAR (args));
853 val = Feval (Fcar (args_left)); 819 args = XCDR (args);
854 else 820
855 Feval (Fcar (args_left)); 821 while (!NILP (args))
856 args_left = Fcdr (args_left); 822 {
857 } 823 Feval (XCAR (args));
858 while (!NILP (args_left)); 824 args = XCDR (args);
825 }
859 826
860 UNGCPRO; 827 UNGCPRO;
861 return val; 828 return val;
862 } 829 }
863 830
959 DEFUN ("while", Fwhile, 1, UNEVALLED, 0, /* 926 DEFUN ("while", Fwhile, 1, UNEVALLED, 0, /*
960 (while TEST BODY...): if TEST yields non-nil, eval BODY... and repeat. 927 (while TEST BODY...): if TEST yields non-nil, eval BODY... and repeat.
961 The order of execution is thus TEST, BODY, TEST, BODY and so on 928 The order of execution is thus TEST, BODY, TEST, BODY and so on
962 until TEST returns nil. 929 until TEST returns nil.
963 */ 930 */
964 (args)) 931 (args))
965 { 932 {
966 /* This function can GC */ 933 /* This function can GC */
967 Lisp_Object test, body, tem; 934 Lisp_Object test, body, tem;
968 struct gcpro gcpro1, gcpro2; 935 struct gcpro gcpro1, gcpro2;
969 936
1006 { 973 {
1007 i++; 974 i++;
1008 /* 975 /*
1009 * uncomment the QUIT if there is some way a circular 976 * uncomment the QUIT if there is some way a circular
1010 * arglist can get in here. I think Feval or Fapply would 977 * arglist can get in here. I think Feval or Fapply would
1011 * spin first and the list would never get here. 978 * spin first and the list would never get here.
1012 */ 979 */
1013 /* QUIT; */ 980 /* QUIT; */
1014 } 981 }
1015 if (i & 1) /* Odd number of arguments? */ 982 if (i & 1) /* Odd number of arguments? */
1016 Fsignal (Qwrong_number_of_arguments, list2 (Qsetq, make_int(i))); 983 Fsignal (Qwrong_number_of_arguments, list2 (Qsetq, make_int(i)));