[RFC] caar/cadr/cdar/cddr

[RFC] caar/cadr/cdar/cddr

[Dmitry Antipov]

[-- Attachment #1: Type: text/plain, Size: 216 bytes --]

These are widely used, so why not doing them as C primitives and corresponding
bytecodes?  It shouldn't be too hard to tweak byte-opt.el to optimize
(car (cdr X)) -> (cadr X) etc., and so emit new bytecodes.

Dmitry

[-- Attachment #2: carcdr_nochangelog.patch --]
[-- Type: text/plain, Size: 17043 bytes --]

=== added file 'admin/coccinelle/carcdr.cocci'
--- admin/coccinelle/carcdr.cocci	1970-01-01 00:00:00 +0000
+++ admin/coccinelle/carcdr.cocci	2012-07-12 15:10:46 +0000
@@ -0,0 +1,24 @@
+// Use Fcaar, Fcadr, Fcdar and Fcddr where possible.
+// 1st and 2nd rules are needed to avoid ambiguity in eval.c
+@@
+expression X;
+@@
+(
+- Fcar (Fcdr (Fcdr (X)))
++ Fcar (Fcddr (X))
+|
+- Fcdr (Fcdr (Fcdr (X)))
++ Fcdr (Fcddr (X))
+|
+- Fcar (Fcar (X))
++ Fcaar (X)
+|
+- Fcar (Fcdr (X))
++ Fcadr (X)
+|
+- Fcdr (Fcar (X))
++ Fcdar (X)
+|
+- Fcdr (Fcdr (X))
++ Fcddr (X)
+)

=== modified file 'lisp/emacs-lisp/bytecomp.el'
--- lisp/emacs-lisp/bytecomp.el	2012-07-12 11:33:55 +0000
+++ lisp/emacs-lisp/bytecomp.el	2012-07-12 15:11:50 +0000
@@ -520,7 +520,13 @@
 (byte-defop  40  0 byte-unbind	"for unbinding special bindings")
 ;; codes 8-47 are consumed by the preceding opcodes
 
-;; unused: 48-55
+;; New since 24.2.
+(byte-defop 48   0 byte-caar)
+(byte-defop 49   0 byte-cadr)
+(byte-defop 50   0 byte-cdar)
+(byte-defop 51   0 byte-cddr)
+
+;; unused: 52-55
 
 (byte-defop  56 -1 byte-nth)
 (byte-defop  57  0 byte-symbolp)
@@ -3185,6 +3191,10 @@
 (byte-defop-compiler (null byte-not)	1)
 (byte-defop-compiler car		1)
 (byte-defop-compiler cdr		1)
+(byte-defop-compiler caar		1)
+(byte-defop-compiler cadr		1)
+(byte-defop-compiler cdar		1)
+(byte-defop-compiler cddr		1)
 (byte-defop-compiler length		1)
 (byte-defop-compiler symbol-value	1)
 (byte-defop-compiler symbol-function	1)

=== modified file 'lisp/subr.el'
--- lisp/subr.el	2012-06-22 21:24:54 +0000
+++ lisp/subr.el	2012-07-12 15:10:46 +0000
@@ -322,22 +322,6 @@
 \f
 ;;;; List functions.
 
-(defsubst caar (x)
-  "Return the car of the car of X."
-  (car (car x)))
-
-(defsubst cadr (x)
-  "Return the car of the cdr of X."
-  (car (cdr x)))
-
-(defsubst cdar (x)
-  "Return the cdr of the car of X."
-  (cdr (car x)))
-
-(defsubst cddr (x)
-  "Return the cdr of the cdr of X."
-  (cdr (cdr x)))
-
 (defun last (list &optional n)
   "Return the last link of LIST.  Its car is the last element.
 If LIST is nil, return nil.

=== modified file 'src/bytecode.c'
--- src/bytecode.c	2012-07-10 22:40:34 +0000
+++ src/bytecode.c	2012-07-12 15:11:50 +0000
@@ -141,6 +141,12 @@
 DEFINE (Bunbind6, 056)							\
 DEFINE (Bunbind7, 057)							\
 									\
+/* New since 24.2.  */							\
+DEFINE (Bcaar, 060)							\
+DEFINE (Bcadr, 061)							\
+DEFINE (Bcdar, 062)							\
+DEFINE (Bcddr, 063)							\
+									\
 DEFINE (Bnth, 070)							\
 DEFINE (Bsymbolp, 071)							\
 DEFINE (Bconsp, 072)							\
@@ -1842,6 +1848,46 @@
 	    TOP = CDR_SAFE (v1);
 	    NEXT;
 	  }
+	  
+	CASE (Bcaar):
+	  {
+	    Lisp_Object v1;
+	    BEFORE_POTENTIAL_GC ();
+	    v1 = TOP;
+	    TOP = Fcaar (v1);
+	    AFTER_POTENTIAL_GC ();
+	    NEXT;
+	  }
+
+	CASE (Bcadr):
+	  {
+	    Lisp_Object v1;
+	    BEFORE_POTENTIAL_GC ();
+	    v1 = TOP;
+	    TOP = Fcadr (v1);
+	    AFTER_POTENTIAL_GC ();
+	    NEXT;
+	  }
+
+	CASE (Bcdar):
+	  {
+	    Lisp_Object v1;
+	    BEFORE_POTENTIAL_GC ();
+	    v1 = TOP;
+	    TOP = Fcdar (v1);
+	    AFTER_POTENTIAL_GC ();
+	    NEXT;
+	  }
+
+	CASE (Bcddr):
+	  {
+	    Lisp_Object v1;
+	    BEFORE_POTENTIAL_GC ();
+	    v1 = TOP;
+	    TOP = Fcddr (v1);
+	    AFTER_POTENTIAL_GC ();
+	    NEXT;
+	  }
 
 	CASE (Bnconc):
 	  BEFORE_POTENTIAL_GC ();

=== modified file 'src/data.c'
--- src/data.c	2012-07-10 08:43:46 +0000
+++ src/data.c	2012-07-12 15:10:46 +0000
@@ -497,6 +497,74 @@
   return CDR_SAFE (object);
 }
 
+DEFUN ("caar", Fcaar, Scaar, 1, 1, 0,
+       doc: /* Widely used synonym for `car (car LIST)'.  See `car'.  */)
+  (Lisp_Object list)
+{
+  Lisp_Object tem = list;
+
+ loop:
+  if (CONSP (tem))
+    {
+      if (!EQ (tem, list))
+	return XCAR (tem);
+      tem = XCAR (tem);
+      goto loop;
+    }
+  else return NILP (tem) ? Qnil : wrong_type_argument (Qlistp, tem);
+}
+
+DEFUN ("cadr", Fcadr, Scadr, 1, 1, 0,
+       doc: /* /* Widely used synonym for `car (cdr LIST)'.  See `car' and `cdr'.  */)
+  (Lisp_Object list)
+{
+  Lisp_Object tem = list;
+
+ loop:
+  if (CONSP (tem))
+    {
+      if (!EQ (tem, list))
+	return XCAR (tem);
+      tem = XCDR (tem);
+      goto loop;
+    }
+  else return NILP (tem) ? Qnil : wrong_type_argument (Qlistp, tem);
+}
+
+DEFUN ("cdar", Fcdar, Scdar, 1, 1, 0,
+       doc: /* Widely used synonym for `cdr (car LIST)'.  See `cdr' and `car'.  */)
+  (Lisp_Object list)
+{
+  Lisp_Object tem = list;
+
+ loop:
+  if (CONSP (tem))
+    {
+      if (!EQ (tem, list))
+	return XCDR (tem);
+      tem = XCAR (tem);
+      goto loop;
+    }
+  else return NILP (tem) ? Qnil : wrong_type_argument (Qlistp, tem);
+}
+
+DEFUN ("cddr", Fcddr, Scddr, 1, 1, 0,
+       doc: /* /* Widely used synonym for `cdr (cdr LIST)'.  See `cdr'.  */)
+  (Lisp_Object list)
+{
+  Lisp_Object tem = list;
+
+ loop:
+  if (CONSP (tem))
+    {
+      if (!EQ (tem, list))
+	return XCDR (tem);
+      tem = XCDR (tem);
+      goto loop;
+    }
+  else return NILP (tem) ? Qnil : wrong_type_argument (Qlistp, tem);
+}
+
 DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0,
        doc: /* Set the car of CELL to be NEWCAR.  Returns NEWCAR.  */)
   (register Lisp_Object cell, Lisp_Object newcar)
@@ -754,7 +822,7 @@
     {
       Lisp_Object funcar = XCAR (fun);
       if (EQ (funcar, Qclosure))
-	return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))));
+	return Fassq (Qinteractive, Fcddr (XCDR (fun)));
       else if (EQ (funcar, Qlambda))
 	return Fassq (Qinteractive, Fcdr (XCDR (fun)));
       else if (EQ (funcar, Qautoload))
@@ -1441,7 +1509,7 @@
 
   do
     {
-      val = eval_sub (Fcar (Fcdr (args_left)));
+      val = eval_sub (Fcadr (args_left));
       symbol = XCAR (args_left);
       Fset_default (symbol, val);
       args_left = Fcdr (XCDR (args_left));
@@ -3134,6 +3202,10 @@
   defsubr (&Scdr);
   defsubr (&Scar_safe);
   defsubr (&Scdr_safe);
+  defsubr (&Scaar);
+  defsubr (&Scadr);
+  defsubr (&Scdar);
+  defsubr (&Scddr);
   defsubr (&Ssetcar);
   defsubr (&Ssetcdr);
   defsubr (&Ssymbol_function);

=== modified file 'src/doc.c'
--- src/doc.c	2012-07-10 21:48:34 +0000
+++ src/doc.c	2012-07-12 15:10:46 +0000
@@ -390,7 +390,7 @@
 	       || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1))
 	       || EQ (funcar, Qautoload))
 	{
-	  Lisp_Object tem1 = Fcdr (Fcdr (fun));
+	  Lisp_Object tem1 = Fcddr (fun);
 	  Lisp_Object tem = Fcar (tem1);
 	  if (STRINGP (tem))
 	    doc = tem;
@@ -528,7 +528,7 @@
       if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
 	  || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
 	{
-	  tem = Fcdr (Fcdr (fun));
+	  tem = Fcddr (fun);
 	  if (CONSP (tem) && INTEGERP (XCAR (tem)))
 	    XSETCAR (tem, make_number (offset));
 	}

=== modified file 'src/eval.c'
--- src/eval.c	2012-07-10 16:53:26 +0000
+++ src/eval.c	2012-07-12 15:10:46 +0000
@@ -309,8 +309,8 @@
   UNGCPRO;
 
   if (!NILP (cond))
-    return eval_sub (Fcar (Fcdr (args)));
-  return Fprogn (Fcdr (Fcdr (args)));
+    return eval_sub (Fcadr (args));
+  return Fprogn (Fcddr (args));
 }
 
 DEFUN ("cond", Fcond, Scond, 0, UNEVALLED, 0,
@@ -428,7 +428,7 @@
 
   do
     {
-      val = eval_sub (Fcar (Fcdr (args_left)));
+      val = eval_sub (Fcadr (args_left));
       sym = Fcar (args_left);
 
       /* Like for eval_sub, we do not check declared_special here since
@@ -441,7 +441,7 @@
       else
 	Fset (sym, val);	/* SYM is dynamically bound.  */
 
-      args_left = Fcdr (Fcdr (args_left));
+      args_left = Fcddr (args_left);
     }
   while (!NILP (args_left));
 
@@ -682,7 +682,7 @@
 
   sym = Fcar (args);
   tail = Fcdr (args);
-  if (!NILP (Fcdr (Fcdr (tail))))
+  if (!NILP (Fcddr (tail)))
     error ("Too many arguments");
 
   tem = Fdefault_boundp (sym);
@@ -768,15 +768,15 @@
   register Lisp_Object sym, tem;
 
   sym = Fcar (args);
-  if (!NILP (Fcdr (Fcdr (Fcdr (args)))))
+  if (!NILP (Fcdr (Fcddr (args))))
     error ("Too many arguments");
 
-  tem = eval_sub (Fcar (Fcdr (args)));
+  tem = eval_sub (Fcadr (args));
   if (!NILP (Vpurify_flag))
     tem = Fpurecopy (tem);
   Fset_default (sym, tem);
   XSYMBOL (sym)->declared_special = 1;
-  tem = Fcar (Fcdr (Fcdr (args)));
+  tem = Fcar (Fcddr (args));
   if (!NILP (tem))
     {
       if (!NILP (Vpurify_flag))
@@ -828,12 +828,12 @@
 	  var = elt;
 	  val = Qnil;
 	}
-      else if (! NILP (Fcdr (Fcdr (elt))))
+      else if (! NILP (Fcddr (elt)))
 	signal_error ("`let' bindings can have only one value-form", elt);
       else
 	{
 	  var = Fcar (elt);
-	  val = eval_sub (Fcar (Fcdr (elt)));
+	  val = eval_sub (Fcadr (elt));
 	}
 
       if (!NILP (lexenv) && SYMBOLP (var)
@@ -895,10 +895,10 @@
       elt = XCAR (varlist);
       if (SYMBOLP (elt))
 	temps [argnum++] = Qnil;
-      else if (! NILP (Fcdr (Fcdr (elt))))
+      else if (! NILP (Fcddr (elt)))
 	signal_error ("`let' bindings can have only one value-form", elt);
       else
-	temps [argnum++] = eval_sub (Fcar (Fcdr (elt)));
+	temps [argnum++] = eval_sub (Fcadr (elt));
       gcpro2.nvars = argnum;
     }
   UNGCPRO;
@@ -1221,8 +1221,8 @@
   volatile Lisp_Object var;
 
   var      = Fcar (args);
-  bodyform = Fcar (Fcdr (args));
-  handlers = Fcdr (Fcdr (args));
+  bodyform = Fcadr (args);
+  handlers = Fcddr (args);
 
   return internal_lisp_condition_case (var, bodyform, handlers);
 }
@@ -1888,12 +1888,12 @@
     return Qnil;
   funcar = XCAR (fun);
   if (EQ (funcar, Qclosure))
-    return (!NILP (Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun)))))
+    return (!NILP (Fassq (Qinteractive, Fcddr (XCDR (fun))))
 	    ? Qt : if_prop);
   else if (EQ (funcar, Qlambda))
     return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop;
   else if (EQ (funcar, Qautoload))
-    return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop;
+    return !NILP (Fcar (Fcddr (XCDR (fun)))) ? Qt : if_prop;
   else
     return Qnil;
 }
@@ -1994,7 +1994,7 @@
      The value saved here is to be restored into Vautoload_queue.  */
   record_unwind_protect (un_autoload, Vautoload_queue);
   Vautoload_queue = Qt;
-  Fload (Fcar (Fcdr (fundef)), Qnil, Qt, Qnil, Qt);
+  Fload (Fcadr (fundef), Qnil, Qt, Qnil, Qt);
 
   /* Once loading finishes, don't undo it.  */
   Vautoload_queue = Qt;

=== modified file 'src/fileio.c'
--- src/fileio.c	2012-07-10 23:24:36 +0000
+++ src/fileio.c	2012-07-12 15:10:46 +0000
@@ -4976,7 +4976,7 @@
 	  pos = nextpos;
 	}
       /* Output the annotation.  */
-      tem = Fcdr (Fcar (*annot));
+      tem = Fcdar (*annot);
       if (STRINGP (tem))
 	{
 	  if (0 > e_write (desc, tem, 0, SCHARS (tem), coding))

=== modified file 'src/gnutls.c'
--- src/gnutls.c	2012-07-11 07:20:14 +0000
+++ src/gnutls.c	2012-07-12 15:10:46 +0000
@@ -916,7 +916,7 @@
       for (tail = keylist; CONSP (tail); tail = XCDR (tail))
 	{
 	  Lisp_Object keyfile = Fcar (XCAR (tail));
-	  Lisp_Object certfile = Fcar (Fcdr (XCAR (tail)));
+	  Lisp_Object certfile = Fcadr (XCAR (tail));
 	  if (STRINGP (keyfile) && STRINGP (certfile))
 	    {
 	      GNUTLS_LOG2 (1, max_log_level, "setting the client key file: ",

=== modified file 'src/intervals.c'
--- src/intervals.c	2012-06-16 12:24:15 +0000
+++ src/intervals.c	2012-07-12 15:10:46 +0000
@@ -1124,7 +1124,7 @@
 	 (We know it is defined explicitly on the right
 	 because otherwise we don't get here.)  */
       lpresent = ! NILP (tail2);
-      lval = (NILP (tail2) ? Qnil : Fcar (Fcdr (tail2)));
+      lval = (NILP (tail2) ? Qnil : Fcadr (tail2));
 
       /* Even if lrear or rfront say nothing about the stickiness of
 	 SYM, Vtext_property_default_nonsticky may give default

=== modified file 'src/keyboard.c'
--- src/keyboard.c	2012-07-12 03:45:46 +0000
+++ src/keyboard.c	2012-07-12 15:10:46 +0000
@@ -5629,8 +5629,8 @@
 
 		/* The third element of every position
 		   should be the (x,y) pair.  */
-		down = Fcar (Fcdr (Fcdr (start_pos)));
-		new_down = Fcar (Fcdr (Fcdr (position)));
+		down = Fcar (Fcddr (start_pos));
+		new_down = Fcar (Fcddr (position));
 
 		if (CONSP (down)
 		    && INTEGERP (XCAR (down)) && INTEGERP (XCDR (down)))
@@ -5656,7 +5656,7 @@
 		       a click.  But mouse-drag-region completely ignores
 		       this case and it hasn't caused any real problem, so
 		       it's probably OK to ignore it as well.  */
-		    && EQ (Fcar (Fcdr (start_pos)), Fcar (Fcdr (position))))
+		    && EQ (Fcadr (start_pos), Fcadr (position)))
 		  /* Mouse hasn't moved (much).  */
 		  event->modifiers |= click_modifier;
 		else

=== modified file 'src/lread.c'
--- src/lread.c	2012-07-12 03:45:46 +0000
+++ src/lread.c	2012-07-12 15:10:46 +0000
@@ -643,7 +643,7 @@
 	      /* Merge this symbol's modifier bits
 		 with the ASCII equivalent of its basic code.  */
 	      if (!NILP (tem1))
-		XSETFASTINT (val, XINT (tem1) | XINT (Fcar (Fcdr (tem))));
+		XSETFASTINT (val, XINT (tem1) | XINT (Fcadr (tem)));
 	    }
 	}
 

=== modified file 'src/menu.c'
--- src/menu.c	2012-07-05 18:35:48 +0000
+++ src/menu.c	2012-07-12 15:10:46 +0000
@@ -1107,16 +1107,16 @@
 	tem = Fcar (position);
 	if (CONSP (tem))
 	  {
-	    window = Fcar (Fcdr (position));
+	    window = Fcadr (position);
 	    x = XCAR (tem);
 	    y = Fcar (XCDR (tem));
 	  }
 	else
 	  {
 	    for_click = 1;
-	    tem = Fcar (Fcdr (position));  /* EVENT_START (position) */
+	    tem = Fcadr (position);  /* EVENT_START (position) */
 	    window = Fcar (tem);	     /* POSN_WINDOW (tem) */
-	    tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
+	    tem = Fcar (Fcddr (tem)); /* POSN_WINDOW_POSN (tem) */
 	    x = Fcar (tem);
 	    y = Fcdr (tem);
 	  }

=== modified file 'src/textprop.c'
--- src/textprop.c	2012-07-10 16:53:26 +0000
+++ src/textprop.c	2012-07-12 15:10:46 +0000
@@ -1814,10 +1814,10 @@
 	  {
 	    if (EQ (Fcar (plist), prop))
 	      {
-		plist = Fcons (prop, Fcons (Fcar (Fcdr (plist)), Qnil));
+		plist = Fcons (prop, Fcons (Fcadr (plist), Qnil));
 		break;
 	      }
-	    plist = Fcdr (Fcdr (plist));
+	    plist = Fcddr (plist);
 	  }
       if (! NILP (plist))
 	{
@@ -1842,8 +1842,8 @@
   while (! NILP (stuff))
     {
       res = Fcar (stuff);
-      res = Fadd_text_properties (Fcar (res), Fcar (Fcdr (res)),
-				  Fcar (Fcdr (Fcdr (res))), dest);
+      res = Fadd_text_properties (Fcar (res), Fcadr (res),
+				  Fcar (Fcddr (res)), dest);
       if (! NILP (res))
 	modified++;
       stuff = Fcdr (stuff);

=== modified file 'src/undo.c'
--- src/undo.c	2012-07-10 23:24:36 +0000
+++ src/undo.c	2012-07-12 15:10:46 +0000
@@ -576,11 +576,11 @@
 		      /* Long format: (apply DELTA START END FUN . ARGS).  */
 		      Lisp_Object delta = car;
 		      Lisp_Object start = Fcar (cdr);
-		      Lisp_Object end   = Fcar (Fcdr (cdr));
+		      Lisp_Object end   = Fcadr (cdr);
 		      Lisp_Object start_mark = Fcopy_marker (start, Qnil);
 		      Lisp_Object end_mark   = Fcopy_marker (end, Qt);
 
-		      cdr = Fcdr (Fcdr (cdr));
+		      cdr = Fcddr (cdr);
 		      apply1 (Fcar (cdr), Fcdr (cdr));
 
 		      /* Check that the function did what the entry said it

=== modified file 'src/w32fns.c'
--- src/w32fns.c	2012-07-11 04:31:53 +0000
+++ src/w32fns.c	2012-07-12 15:10:46 +0000
@@ -6254,7 +6254,7 @@
   if (SYMBOLP (c))
     {
       c = parse_modifiers (c);
-      lisp_modifiers = XINT (Fcar (Fcdr (c)));
+      lisp_modifiers = XINT (Fcadr (c));
       c = Fcar (c);
       if (!SYMBOLP (c))
 	abort ();

=== modified file 'src/w32font.c'
--- src/w32font.c	2012-07-11 07:37:39 +0000
+++ src/w32font.c	2012-07-12 15:10:46 +0000
@@ -1656,7 +1656,7 @@
         return DEFAULT_CHARSET;
     }
 
-  w32_charset = Fcar (Fcdr (this_entry));
+  w32_charset = Fcadr (this_entry);
 
   /* Translate Lisp symbol to number.  */
   if (EQ (w32_charset, Qw32_charset_ansi))

=== modified file 'src/xfaces.c'
--- src/xfaces.c	2012-07-10 08:43:46 +0000
+++ src/xfaces.c	2012-07-12 15:10:46 +0000
@@ -958,8 +958,8 @@
       Lisp_Object bits;
 
       w = XINT (Fcar (name));
-      h = XINT (Fcar (Fcdr (name)));
-      bits = Fcar (Fcdr (Fcdr (name)));
+      h = XINT (Fcadr (name));
+      bits = Fcar (Fcddr (name));
 
       bitmap_id = x_create_bitmap_from_data (f, SSDATA (bits),
 					     w, h);

=== modified file 'src/xmenu.c'
--- src/xmenu.c	2012-07-11 07:19:44 +0000
+++ src/xmenu.c	2012-07-12 15:10:46 +0000
@@ -325,7 +325,7 @@
     CHECK_STRING (title);
     record_unwind_protect (unuse_menu_items, Qnil);
 
-    if (NILP (Fcar (Fcdr (contents))))
+    if (NILP (Fcadr (contents)))
       /* No buttons specified, add an "Ok" button so users can pop down
          the dialog.  Also, the lesstif/motif version crashes if there are
          no buttons.  */

=== modified file 'src/xselect.c'
--- src/xselect.c	2012-07-05 18:35:48 +0000
+++ src/xselect.c	2012-07-12 15:10:46 +0000
@@ -1036,7 +1036,7 @@
       /* Run the `x-lost-selection-functions' abnormal hook.  */
       Lisp_Object args[2];
       args[0] = Qx_lost_selection_functions;
-      args[1] = Fcar (Fcar (t->Vselection_alist));
+      args[1] = Fcaar (t->Vselection_alist);
       Frun_hook_with_args (2, args);
 
       t->Vselection_alist = XCDR (t->Vselection_alist);

Re: [RFC] caar/cadr/cdar/cddr

[Tom Tromey]

>>>>> "Dmitry" == Dmitry Antipov <dmantipov@yandex.ru> writes:

Dmitry> These are widely used, so why not doing them as C primitives and
Dmitry> corresponding bytecodes?  It shouldn't be too hard to tweak
Dmitry> byte-opt.el to optimize (car (cdr X)) -> (cadr X) etc., and so
Dmitry> emit new bytecodes.

Did you try to measure the performance benefit?

Dmitry> +(byte-defop 48   0 byte-caar)
Dmitry> +(byte-defop 49   0 byte-cadr)
Dmitry> +(byte-defop 50   0 byte-cdar)
Dmitry> +(byte-defop 51   0 byte-cddr)

Occasionally I wish we were sharing these definitions with bytecode.c;
or more generally that parts of the Emacs core could be written in some
form of Lisp.

Dmitry> + loop:
Dmitry> +  if (CONSP (tem))
Dmitry> +    {
Dmitry> +      if (!EQ (tem, list))
Dmitry> +	return XCAR (tem);
Dmitry> +      tem = XCDR (tem);
Dmitry> +      goto loop;
Dmitry> +    }
Dmitry> +  else return NILP (tem) ? Qnil : wrong_type_argument (Qlistp, tem);

All these functions are implemented in what seems, to me, a very weird
way.  Why not just write the obvious straight-line code?

Tom

Re: [RFC] caar/cadr/cdar/cddr

[Tom Tromey]

>>>>> "Dmitry" == Dmitry Antipov <dmantipov@yandex.ru> writes:

Dmitry> These are widely used, so why not doing them as C primitives and
Dmitry> corresponding bytecodes?  It shouldn't be too hard to tweak
Dmitry> byte-opt.el to optimize (car (cdr X)) -> (cadr X) etc., and so
Dmitry> emit new bytecodes.

One other thing worth noting -- if we used vmgen, we could get
"superinstructions" like this for free, without needing to dedicate
special byte codes to them.

Tom

Re: [RFC] caar/cadr/cdar/cddr

[Paul Eggert]

On 07/12/2012 09:26 AM, Dmitry Antipov wrote:
> These are widely used

How widely?  I've always been leery about those
functions, myself.  Since this is a performance
improvement, how much does performance improve?

Quite possibly they're a win in the C implementation,
but I'm not sure they're worth adding bytecodes for.
We might want to save bytecodes for something more
important.

Assuming they're needed, I vote for a clean
implementation of Fcaar etc. rather than tricky
ones involving loops.  Especially since the tricky
loops are wrong and will infinite-loop in some
cases.

Re: [RFC] caar/cadr/cdar/cddr

[Dmitry Antipov]

On 07/12/2012 08:53 PM, Paul Eggert wrote:

> How widely?  I've always been leery about those
> functions, myself.

$ grep -nHR "(car (car (" lisp | wc -l
45
$ grep -nHR "(car (cdr (" lisp | wc -l
164
$ grep -nHR "(cdr (car (" lisp | wc -l
45
$ grep -nHR "(cdr (cdr (" lisp | wc -l
84

> Since this is a performance
> improvement, how much does performance improve?

Not yet because byte-opt.el should be able to optimize
(car (cdr X)) -> (cadr X) etc. Or, all Lisp sources
should be converted manually :-).

> Quite possibly they're a win in the C implementation,
> but I'm not sure they're worth adding bytecodes for.

Calling them via Funcall is too slow.

> We might want to save bytecodes for something more
> important.

Do we really runs out of bytecode range?

> Assuming they're needed, I vote for a clean
> implementation of Fcaar etc. rather than tricky
> ones involving loops.  Especially since the tricky
> loops are wrong and will infinite-loop in some
> cases.

This Fcaar is 6 insns smaller than the obvious CAR (CAR (x))
implementation :-).

Dmitry

Re: [RFC] caar/cadr/cdar/cddr

[Samuel Bronson]

On Jul 12, 2012, at 1:44 PM, Dmitry Antipov wrote:

> On 07/12/2012 08:53 PM, Paul Eggert wrote:
>
>> How widely?  I've always been leery about those
>> functions, myself.
>
> $ grep -nHR "(car (car (" lisp | wc -l
> 45
> $ grep -nHR "(car (cdr (" lisp | wc -l
> 164
> $ grep -nHR "(cdr (car (" lisp | wc -l
> 45
> $ grep -nHR "(cdr (cdr (" lisp | wc -l
> 84
>
>> Since this is a performance
>> improvement, how much does performance improve?
>
> Not yet because byte-opt.el should be able to optimize
> (car (cdr X)) -> (cadr X) etc. Or, all Lisp sources
> should be converted manually :-).
>
>> Quite possibly they're a win in the C implementation,
>> but I'm not sure they're worth adding bytecodes for.
>
> Calling them via Funcall is too slow.

What Funcall? The byte compiler uses the appropriate sequence of Bcar/ 
Bcdr ...

Re: [RFC] caar/cadr/cdar/cddr

[Paul Eggert]

On 07/12/2012 10:44 AM, Dmitry Antipov wrote:
> This Fcaar is 6 insns smaller than the obvious CAR (CAR (x))

And it also loops forever when given a pair
whose car is itself.  Let's stick with the
obvious and reliable version, if we need this
sort of thing (we don't have performance
numbers yet).

Re: [RFC] caar/cadr/cdar/cddr

[Alp Aker]

On Thu, Jul 12, 2012 at 1:44 PM, Dmitry Antipov <dmantipov@yandex.ru> wrote:
>
> $ grep -nHR "(car (car (" lisp | wc -l
> 45
> $ grep -nHR "(car (cdr (" lisp | wc -l
> 164
> $ grep -nHR "(cdr (car (" lisp | wc -l
> 45
> $ grep -nHR "(cdr (cdr (" lisp | wc -l
> 84

Isn't the final open paren in each of the above producing an undercount?

$ grep -R "(car (car " lisp | wc -l
     547
$ grep -R "(car (cdr " lisp | wc -l
     630
$ grep -R "(cdr (car " lisp | wc -l
     379
$ grep -R "(cdr (cdr " lisp | wc -l
     449

Re: [RFC] caar/cadr/cdar/cddr

[Stefan Monnier]

>> How widely?  I've always been leery about those functions, myself.

> $ grep -nHR "(car (car (" lisp | wc -l
> 45
> $ grep -nHR "(car (cdr (" lisp | wc -l
> 164
> $ grep -nHR "(cdr (car (" lisp | wc -l
> 45
> $ grep -nHR "(cdr (cdr (" lisp | wc -l
> 84

Static counts might not be related to dynamic counts and don't indicate
much either in terms of actual performance gains.

FWIW the current cXXr implementation using `defsubst' is not very
efficient because they're written in subr.el which does not use lexical
scoping, so the bytecodes that get inlined by the compiler include an
unneeded "varref x".  So you'd already get better performance by simply
moving these definitions to a file using lexical-binding.

> Not yet because byte-opt.el should be able to optimize
> (car (cdr X)) -> (cadr X) etc. Or, all Lisp sources
> should be converted manually :-).

It's easy to add such a rewrite to byte-optimize-lapcode.

>> We might want to save bytecodes for something more important.
> Do we really runs out of bytecode range?

Not really, but there aren't many left either.  Another issue is
breaking compatibility.  There are other bytecodes that will need to be
added to eliminate some glaring inefficiencies in lexical-binding code
(mostly Bunwind-protect, Bcondition-case, and Bcatch).


        Stefan

Re: [RFC] caar/cadr/cdar/cddr

[Samuel Bronson]

On Jul 12, 2012, at 8:12 PM, Stefan Monnier wrote:

>>> How widely?  I've always been leery about those functions, myself.
>
>> $ grep -nHR "(car (car (" lisp | wc -l
>> 45
>> $ grep -nHR "(car (cdr (" lisp | wc -l
>> 164
>> $ grep -nHR "(cdr (car (" lisp | wc -l
>> 45
>> $ grep -nHR "(cdr (cdr (" lisp | wc -l
>> 84
>
> Static counts might not be related to dynamic counts and don't  
> indicate
> much either in terms of actual performance gains.
>
> FWIW the current cXXr implementation using `defsubst' is not very
> efficient because they're written in subr.el which does not use  
> lexical
> scoping, so the bytecodes that get inlined by the compiler include an
> unneeded "varref x".  So you'd already get better performance by  
> simply
> moving these definitions to a file using lexical-binding.

Hmm. I see what you mean:

(disassemble '(lambda (x) (caar (cadr x))) (current-buffer))

nil
byte code:
   args: (x)
0	varref	  x
1	dup	
2	varbind	  x
3	cdr	
4	car	
5	unbind	  1
6	dup	
7	varbind	  x
8	car	
9	car	
10	unbind	  1
11	return	

Surely the bytecode compiler can be made to do better with this; it's  
currently much more efficient to use car and cdr directly:

(disassemble '(lambda (x) (car (car (car (cdr x))))) (current-buffer))
nil
byte code:
   args: (x)
0	varref	  x
1	cdr	
2	car	
3	car	
4	car	
5	return	

Re: [RFC] caar/cadr/cdar/cddr

[Stefan Monnier]

> Surely the bytecode compiler can be made to do better with this;

Why bother: you can get the same efficient result by switching to
lexical-binding without any extra byte-compiler hacking.  AFAIC, the
only code worth optimizing for is the one using lexical-binding.
Of course, if it also speeds up dynamically scoped code, that's
even better.


        Stefan