[Emacs-diffs] Changes to emacs/src/alloc.c [lexbind]

[Miles Bader]

Index: emacs/src/alloc.c
diff -c emacs/src/alloc.c:1.272.2.13 emacs/src/alloc.c:1.272.2.14
*** emacs/src/alloc.c:1.272.2.13        Sat Sep  4 09:18:39 2004
--- emacs/src/alloc.c   Sat Sep  4 09:20:09 2004
***************
*** 2675,2680 ****
--- 2675,2712 ----
  }
  
  
+ /* Return a new `function vector' containing KIND as the first element,
+    followed by NUM_NIL_SLOTS nil elements, and further elements copied from
+    the vector PARAMS of length NUM_PARAMS (so the total length of the
+    resulting vector is 1 + NUM_NIL_SLOTS + NUM_PARAMS).
+ 
+    If NUM_PARAMS is zero, then PARAMS may be NULL.
+ 
+    A `function vector', a.k.a. `funvec', is a funcallable vector in Emacs 
Lisp.
+    See the function `funvec' for more detail.  */
+ 
+ Lisp_Object
+ make_funvec (kind, num_nil_slots, num_params, params)
+      Lisp_Object kind;
+      int num_nil_slots, num_params;
+      Lisp_Object *params;
+ {
+   int param_index;
+   Lisp_Object funvec;
+ 
+   funvec = Fmake_vector (make_number (1 + num_nil_slots + num_params), Qnil);
+ 
+   ASET (funvec, 0, kind);
+ 
+   for (param_index = 0; param_index < num_params; param_index++)
+     ASET (funvec, 1 + num_nil_slots + param_index, params[param_index]);
+ 
+   XSETFUNVEC (funvec, XVECTOR (funvec));
+ 
+   return funvec;
+ }
+ 
+ 
  DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0,
         doc: /* Return a newly created char-table, with purpose PURPOSE.
  Each element is initialized to INIT, which defaults to nil.
***************
*** 2739,2744 ****
--- 2771,2799 ----
  }
  
  
+ DEFUN ("funvec", Ffunvec, Sfunvec, 1, MANY, 0,
+        doc: /* Return a newly created `function vector' of type KIND.
+ A `function vector', a.k.a. `funvec', is a funcallable vector in Emacs Lisp.
+ KIND indicates the kind of funvec, and determines its behavior when called.
+ The meaning of the remaining arguments depends on KIND.  Currently
+ implemented values of KIND, and their meaning, are:
+ 
+    A list  -- A byte-compiled function.  See `make-byte-code' for the usual
+               way to create byte-compiled functions.
+ 
+    `curry' -- A curried function.  Remaining arguments are a function to
+               call, and arguments to prepend to user arguments at the
+               time of the call; see the `curry' function.
+ 
+ usage: (funvec KIND &rest PARAMS)  */)
+      (nargs, args)
+      register int nargs;
+      Lisp_Object *args;
+ {
+   return make_funvec (args[0], 0, nargs - 1, args + 1);
+ }
+ 
+ 
  DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0,
         doc: /* Create a byte-code object with specified arguments as elements.
  The arguments should be the arglist, bytecode-string, constant vector,
***************
*** 2754,2759 ****
--- 2809,2818 ----
    register int index;
    register struct Lisp_Vector *p;
  
+   /* Make sure the arg-list is really a list, as that's what's used to
+      distinguish a byte-compiled object from other funvecs.  */
+   CHECK_LIST (args[0]);
+ 
    XSETFASTINT (len, nargs);
    if (!NILP (Vpurify_flag))
      val = make_pure_vector ((EMACS_INT) nargs);
***************
*** 2775,2781 ****
        args[index] = Fpurecopy (args[index]);
        p->contents[index] = args[index];
      }
!   XSETCOMPILED (val, p);
    return val;
  }
  
--- 2834,2840 ----
        args[index] = Fpurecopy (args[index]);
        p->contents[index] = args[index];
      }
!   XSETFUNVEC (val, p);
    return val;
  }
  
***************
*** 4272,4278 ****
      return make_pure_string (SDATA (obj), SCHARS (obj),
                             SBYTES (obj),
                             STRING_MULTIBYTE (obj));
!   else if (COMPILEDP (obj) || VECTORP (obj))
      {
        register struct Lisp_Vector *vec;
        register int i;
--- 4331,4337 ----
      return make_pure_string (SDATA (obj), SCHARS (obj),
                             SBYTES (obj),
                             STRING_MULTIBYTE (obj));
!   else if (FUNVECP (obj) || VECTORP (obj))
      {
        register struct Lisp_Vector *vec;
        register int i;
***************
*** 4284,4291 ****
        vec = XVECTOR (make_pure_vector (size));
        for (i = 0; i < size; i++)
        vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]);
!       if (COMPILEDP (obj))
!       XSETCOMPILED (obj, vec);
        else
        XSETVECTOR (obj, vec);
        return obj;
--- 4343,4350 ----
        vec = XVECTOR (make_pure_vector (size));
        for (i = 0; i < size; i++)
        vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]);
!       if (FUNVECP (obj))
!       XSETFUNVEC (obj, vec);
        else
        XSETVECTOR (obj, vec);
        return obj;
***************
*** 4825,4831 ****
        }
        else if (GC_SUBRP (obj))
        break;
!       else if (GC_COMPILEDP (obj))
        /* We could treat this just like a vector, but it is better to
           save the COMPILED_CONSTANTS element for last and avoid
           recursion there.  */
--- 4884,4890 ----
        }
        else if (GC_SUBRP (obj))
        break;
!       else if (GC_FUNVECP (obj) && FUNVEC_COMPILED_P (obj))
        /* We could treat this just like a vector, but it is better to
           save the COMPILED_CONSTANTS element for last and avoid
           recursion there.  */
***************
*** 5779,5784 ****
--- 5838,5844 ----
    defsubr (&Scons);
    defsubr (&Slist);
    defsubr (&Svector);
+   defsubr (&Sfunvec);
    defsubr (&Smake_byte_code);
    defsubr (&Smake_list);
    defsubr (&Smake_vector);