comparison src/eval.c @ 39577:d93909a71fa4

(Fdefvaralias): New function. (specbind): Simplify the test if symbol is a constant. (syms_of_eval): Defsubr Fdefvaralias.

39576:d2a8cced572f

    defn = Fpurecopy (defn);
  Ffset (fn_name, defn);
  LOADHIST_ATTACH (fn_name);
  return fn_name;
}

DEFUN ("defvar", Fdefvar, Sdefvar, 1, UNEVALLED, 0,
  "Define SYMBOL as a variable.\n\
You are not required to define a variable in order to use it,\n\
but the definition can supply documentation and an initial value\n\

void
specbind (symbol, value)
     Lisp_Object symbol, value;
{
  Lisp_Object ovalue;

  CHECK_SYMBOL (symbol, 0);
  if (specpdl_ptr == specpdl + specpdl_size)
    grow_specpdl ();

  /* The most common case is that a non-constant symbol with a trivial
     value.  Make that as fast as we can.  */
  if (!MISCP (XSYMBOL (symbol)->value)
      && !EQ (symbol, Qnil)
      && !EQ (symbol, Qt)
      && !(XSYMBOL (symbol)->name->data[0] == ':'
	   && EQ (XSYMBOL (symbol)->obarray, initial_obarray)
	   && !EQ (value, symbol)))
    {
      specpdl_ptr->symbol = symbol;
      specpdl_ptr->old_value = XSYMBOL (symbol)->value;
      specpdl_ptr->func = NULL;
      ++specpdl_ptr;
      XSYMBOL (symbol)->value = value;
    }
  else
    {
      Lisp_Object valcontents;
      

      else
	{
	  /* If variable has a trivial value (no forwarding), we can
	     just set it.  No need to check for constant symbols here,
	     since that was already done by specbind.  */
	  if (!MISCP (XSYMBOL (specpdl_ptr->symbol)->value))
	    XSYMBOL (specpdl_ptr->symbol)->value = specpdl_ptr->old_value;
	  else
	    set_internal (specpdl_ptr->symbol, specpdl_ptr->old_value, 0, 1);
	}
    }
  

  defsubr (&Squote);
  defsubr (&Sfunction);
  defsubr (&Sdefun);
  defsubr (&Sdefmacro);
  defsubr (&Sdefvar);
  defsubr (&Sdefconst);
  defsubr (&Suser_variable_p);
  defsubr (&Slet);
  defsubr (&SletX);
  defsubr (&Swhile);

39577:d93909a71fa4

    defn = Fpurecopy (defn);
  Ffset (fn_name, defn);
  LOADHIST_ATTACH (fn_name);
  return fn_name;
}


DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 2, 0,
  "Make SYMBOL a variable alias for symbol ALIASED.\n\
Setting the value of SYMBOL will subsequently set the value of ALIASED,\n\
and getting the value of SYMBOL will return the value ALIASED has.\n\
ALIASED nil means remove the alias; SYMBOL is unbound after that.")
  (symbol, aliased)
     Lisp_Object symbol, aliased;
{
  struct Lisp_Symbol *sym;
  
  CHECK_SYMBOL (symbol, 0);
  CHECK_SYMBOL (aliased, 1);

  if (SYMBOL_CONSTANT_P (symbol))
    error ("Cannot make a constant an alias");

  sym = XSYMBOL (symbol);
  sym->indirect_variable = 1;
  sym->value = aliased;
  sym->constant = SYMBOL_CONSTANT_P (aliased);
  LOADHIST_ATTACH (symbol);
  
  return aliased;
}


DEFUN ("defvar", Fdefvar, Sdefvar, 1, UNEVALLED, 0,
  "Define SYMBOL as a variable.\n\
You are not required to define a variable in order to use it,\n\
but the definition can supply documentation and an initial value\n\

void
specbind (symbol, value)
     Lisp_Object symbol, value;
{
  Lisp_Object ovalue;
  Lisp_Object valcontents;

  CHECK_SYMBOL (symbol, 0);
  if (specpdl_ptr == specpdl + specpdl_size)
    grow_specpdl ();

  /* The most common case is that of a non-constant symbol with a
     trivial value.  Make that as fast as we can.  */
  valcontents = SYMBOL_VALUE (symbol);
  if (!MISCP (valcontents) && !SYMBOL_CONSTANT_P (symbol))
    {
      specpdl_ptr->symbol = symbol;
      specpdl_ptr->old_value = valcontents;
      specpdl_ptr->func = NULL;
      ++specpdl_ptr;
      SET_SYMBOL_VALUE (symbol, value);
    }
  else
    {
      Lisp_Object valcontents;
      

      else
	{
	  /* If variable has a trivial value (no forwarding), we can
	     just set it.  No need to check for constant symbols here,
	     since that was already done by specbind.  */
	  if (!MISCP (SYMBOL_VALUE (specpdl_ptr->symbol)))
	    SET_SYMBOL_VALUE (specpdl_ptr->symbol, specpdl_ptr->old_value);
	  else
	    set_internal (specpdl_ptr->symbol, specpdl_ptr->old_value, 0, 1);
	}
    }
  

  defsubr (&Squote);
  defsubr (&Sfunction);
  defsubr (&Sdefun);
  defsubr (&Sdefmacro);
  defsubr (&Sdefvar);
  defsubr (&Sdefvaralias);
  defsubr (&Sdefconst);
  defsubr (&Suser_variable_p);
  defsubr (&Slet);
  defsubr (&SletX);
  defsubr (&Swhile);