* src/data.c (Ftype_of): Return `Qt' by default.
[bpt/emacs.git] / src / data.c
index 965ddd2..d053970 100644 (file)
@@ -205,12 +205,6 @@ wrong_type_argument (register Lisp_Object predicate, register Lisp_Object value)
   xsignal2 (Qwrong_type_argument, predicate, value);
 }
 
-void
-pure_write_error (Lisp_Object obj)
-{
-  xsignal2 (Qerror, build_string ("Attempt to modify read-only object"), obj);
-}
-
 void
 args_out_of_range (Lisp_Object a1, Lisp_Object a2)
 {
@@ -250,21 +244,16 @@ The symbol returned names the object's basic type;
 for example, (type-of 1) returns `integer'.  */)
   (Lisp_Object object)
 {
-  switch (XTYPE (object))
+  if (INTEGERP (object))
+    return Qinteger;
+  else if (SYMBOLP (object))
+    return Qsymbol;
+  else if (STRINGP (object))
+    return Qstring;
+  else if (CONSP (object))
+    return Qcons;
+  else if (MISCP (object))
     {
-    case_Lisp_Int:
-      return Qinteger;
-
-    case Lisp_Symbol:
-      return Qsymbol;
-
-    case Lisp_String:
-      return Qstring;
-
-    case Lisp_Cons:
-      return Qcons;
-
-    case Lisp_Misc:
       switch (XMISCTYPE (object))
        {
        case Lisp_Misc_Marker:
@@ -275,8 +264,9 @@ for example, (type-of 1) returns `integer'.  */)
          return Qfloat;
        }
       emacs_abort ();
-
-    case Lisp_Vectorlike:
+    }
+  else if (VECTORLIKEP (object))
+    {
       if (WINDOW_CONFIGURATIONP (object))
        return Qwindow_configuration;
       if (PROCESSP (object))
@@ -304,13 +294,11 @@ for example, (type-of 1) returns `integer'.  */)
       if (FONT_OBJECT_P (object))
        return Qfont_object;
       return Qvector;
-
-    case Lisp_Float:
-      return Qfloat;
-
-    default:
-      emacs_abort ();
     }
+  else if (FLOATP (object))
+    return Qfloat;
+  else
+    return Qt;
 }
 
 DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0,
@@ -2332,7 +2320,7 @@ arithcompare_driver (ptrdiff_t nargs, Lisp_Object *args,
   ptrdiff_t argnum;
   for (argnum = 1; argnum < nargs; ++argnum)
     {
-      if (EQ (Qnil, arithcompare (args[argnum-1], args[argnum], comparison)))
+      if (EQ (Qnil, arithcompare (args[argnum - 1], args[argnum], comparison)))
         return Qnil;
     }
   return Qt;
@@ -2347,7 +2335,7 @@ usage: (= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)  */)
 }
 
 DEFUN ("<", Flss, Slss, 1, MANY, 0,
-       doc: /* Return t if each arg is less than the next arg.  All must be numbers or markers.
+       doc: /* Return t if each arg (a number or marker), is less than the next arg.
 usage: (< NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
@@ -2355,7 +2343,7 @@ usage: (< NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)  */)
 }
 
 DEFUN (">", Fgtr, Sgtr, 1, MANY, 0,
-       doc: /* Return t if each arg is greater than the next arg.  All must be numbers or markers.
+       doc: /* Return t if each arg (a number or marker) is greater than the next arg.
 usage: (> NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
@@ -2363,8 +2351,7 @@ usage: (> NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)  */)
 }
 
 DEFUN ("<=", Fleq, Sleq, 1, MANY, 0,
-       doc: /* Return t if each arg is less than or equal to the next arg.
-All must be numbers or markers.
+       doc: /* Return t if each arg (a number or marker) is less than or equal to the next.
 usage: (<= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
@@ -2372,8 +2359,7 @@ usage: (<= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)  */)
 }
 
 DEFUN (">=", Fgeq, Sgeq, 1, MANY, 0,
-       doc: /* Return t if each arg is greater than or equal to the next arg.
-All must be numbers or markers.
+       doc: /* Return t if each arg (a number or marker) is greater than or equal to the next.
 usage: (>= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
@@ -2386,24 +2372,6 @@ DEFUN ("/=", Fneq, Sneq, 2, 2, 0,
 {
   return arithcompare (num1, num2, ARITH_NOTEQUAL);
 }
-
-DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0,
-       doc: /* Return t if NUMBER is zero.  */)
-  (register Lisp_Object number)
-{
-  CHECK_NUMBER_OR_FLOAT (number);
-
-  if (FLOATP (number))
-    {
-      if (XFLOAT_DATA (number) == 0.0)
-       return Qt;
-      return Qnil;
-    }
-
-  if (!XINT (number))
-    return Qt;
-  return Qnil;
-}
 \f
 /* Convert the cons-of-integers, integer, or float value C to an
    unsigned value with maximum value MAX.  Signal an error if C does not
@@ -2895,7 +2863,7 @@ In this case, the sign bit is duplicated.  */)
   if (XINT (count) >= BITS_PER_EMACS_INT)
     XSETINT (val, 0);
   else if (XINT (count) > 0)
-    XSETINT (val, XINT (value) << XFASTINT (count));
+    XSETINT (val, XUINT (value) << XFASTINT (count));
   else if (XINT (count) <= -BITS_PER_EMACS_INT)
     XSETINT (val, XINT (value) < 0 ? -1 : 0);
   else
@@ -3409,6 +3377,8 @@ syms_of_data (void)
 {
   Lisp_Object error_tail, arith_tail;
 
+#include "data.x"
+
   DEFSYM (Qquote, "quote");
   DEFSYM (Qlambda, "lambda");
   DEFSYM (Qsubr, "subr");
@@ -3576,110 +3546,6 @@ syms_of_data (void)
   DEFSYM (Qinteractive_form, "interactive-form");
   DEFSYM (Qdefalias_fset_function, "defalias-fset-function");
 
-  defsubr (&Sindirect_variable);
-  defsubr (&Sinteractive_form);
-  defsubr (&Seq);
-  defsubr (&Snull);
-  defsubr (&Stype_of);
-  defsubr (&Slistp);
-  defsubr (&Snlistp);
-  defsubr (&Sconsp);
-  defsubr (&Satom);
-  defsubr (&Sintegerp);
-  defsubr (&Sinteger_or_marker_p);
-  defsubr (&Snumberp);
-  defsubr (&Snumber_or_marker_p);
-  defsubr (&Sfloatp);
-  defsubr (&Snatnump);
-  defsubr (&Ssymbolp);
-  defsubr (&Skeywordp);
-  defsubr (&Sstringp);
-  defsubr (&Smultibyte_string_p);
-  defsubr (&Svectorp);
-  defsubr (&Schar_table_p);
-  defsubr (&Svector_or_char_table_p);
-  defsubr (&Sbool_vector_p);
-  defsubr (&Sarrayp);
-  defsubr (&Ssequencep);
-  defsubr (&Sbufferp);
-  defsubr (&Smarkerp);
-  defsubr (&Ssubrp);
-  defsubr (&Sbyte_code_function_p);
-  defsubr (&Schar_or_string_p);
-  defsubr (&Scar);
-  defsubr (&Scdr);
-  defsubr (&Scar_safe);
-  defsubr (&Scdr_safe);
-  defsubr (&Ssetcar);
-  defsubr (&Ssetcdr);
-  defsubr (&Ssymbol_function);
-  defsubr (&Sindirect_function);
-  defsubr (&Ssymbol_plist);
-  defsubr (&Ssymbol_name);
-  defsubr (&Smakunbound);
-  defsubr (&Sfmakunbound);
-  defsubr (&Sboundp);
-  defsubr (&Sfboundp);
-  defsubr (&Sfset);
-  defsubr (&Sdefalias);
-  defsubr (&Ssetplist);
-  defsubr (&Ssymbol_value);
-  defsubr (&Sset);
-  defsubr (&Sdefault_boundp);
-  defsubr (&Sdefault_value);
-  defsubr (&Sset_default);
-  defsubr (&Ssetq_default);
-  defsubr (&Smake_variable_buffer_local);
-  defsubr (&Smake_local_variable);
-  defsubr (&Skill_local_variable);
-  defsubr (&Smake_variable_frame_local);
-  defsubr (&Slocal_variable_p);
-  defsubr (&Slocal_variable_if_set_p);
-  defsubr (&Svariable_binding_locus);
-#if 0                           /* XXX Remove this. --lorentey */
-  defsubr (&Sterminal_local_value);
-  defsubr (&Sset_terminal_local_value);
-#endif
-  defsubr (&Saref);
-  defsubr (&Saset);
-  defsubr (&Snumber_to_string);
-  defsubr (&Sstring_to_number);
-  defsubr (&Seqlsign);
-  defsubr (&Slss);
-  defsubr (&Sgtr);
-  defsubr (&Sleq);
-  defsubr (&Sgeq);
-  defsubr (&Sneq);
-  defsubr (&Szerop);
-  defsubr (&Splus);
-  defsubr (&Sminus);
-  defsubr (&Stimes);
-  defsubr (&Squo);
-  defsubr (&Srem);
-  defsubr (&Smod);
-  defsubr (&Smax);
-  defsubr (&Smin);
-  defsubr (&Slogand);
-  defsubr (&Slogior);
-  defsubr (&Slogxor);
-  defsubr (&Slsh);
-  defsubr (&Sash);
-  defsubr (&Sadd1);
-  defsubr (&Ssub1);
-  defsubr (&Slognot);
-  defsubr (&Sbyteorder);
-  defsubr (&Ssubr_arity);
-  defsubr (&Ssubr_name);
-
-  defsubr (&Sbool_vector_exclusive_or);
-  defsubr (&Sbool_vector_union);
-  defsubr (&Sbool_vector_intersection);
-  defsubr (&Sbool_vector_set_difference);
-  defsubr (&Sbool_vector_not);
-  defsubr (&Sbool_vector_subsetp);
-  defsubr (&Sbool_vector_count_consecutive);
-  defsubr (&Sbool_vector_count_population);
-
   set_symbol_function (Qwholenump, XSYMBOL (Qnatnump)->function);
 
   DEFVAR_LISP ("most-positive-fixnum", Vmost_positive_fixnum,