scratch/handler-bind-2 20098915feb 1/2: Experimental record type for all conditions (bug#68075)

[João Távora]

branch: scratch/handler-bind-2
commit 20098915febff7577d6923ce78b4dce014ca879f
Author: João Távora <joaotavora@gmail.com>
Commit: João Távora <joaotavora@gmail.com>

    Experimental record type for all conditions (bug#68075)
    
    * src/print.c (Ferror_message_string): Work with cons or with
    records.
    (print_error_message): Still work with cons errors, but rename
    parameter.
    
    * src/eval.c (signal_or_quit): Make a record, not a cons.  Except
    in the sub-case of CONDITION_CASE, where a fresh cons is given.
    Name this object 'condition', not 'error'.
    (skip_debugger): Rename parameter 'data' to 'condition'
    (signal_quit_p)
    (maybe_call_debugger): Expect record, not cons.
    (syms_of_eval): Define symbol Qcondition.
---
 src/eval.c  | 42 +++++++++++++++++++++++-------------------
 src/print.c | 23 ++++++++++++++++-------
 2 files changed, 39 insertions(+), 26 deletions(-)

diff --git a/src/eval.c b/src/eval.c
index 3e352911479..2a77965d22a 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1766,15 +1766,17 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object 
data, bool continuable)
      and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
      That is a special case--don't do this in other situations.  */
   bool oom = NILP (error_symbol);
-  Lisp_Object error             /* The error object.  */
+  Lisp_Object args[3] = {Qcondition, error_symbol, data};
+  Lisp_Object condition             /* The error object.  */
     = oom ? data
       : (!SYMBOLP (error_symbol) && NILP (data)) ? error_symbol
-      : Fcons (error_symbol, data);
+       : Frecord (3, args);
   Lisp_Object conditions;
   Lisp_Object string;
   Lisp_Object real_error_symbol
-    = CONSP (error) ? XCAR (error) : error_symbol;
+    = RECORDP (condition) ? AREF (condition, 1) : error_symbol;
   Lisp_Object clause = Qnil;
+  bool legacy_cons = false;
   struct handler *h;
   int skip;
 
@@ -1827,7 +1829,8 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object 
data, bool continuable)
           break;
        case CATCHER:
          continue;
-        case CONDITION_CASE:
+       case CONDITION_CASE:
+         legacy_cons = true;
           clause = find_handler_clause (h->tag_or_ch, conditions);
          break;
        case HANDLER_BIND:
@@ -1838,7 +1841,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object 
data, bool continuable)
                max_ensure_room (20);
                push_handler (make_fixnum (skip + h->bytecode_dest),
                              SKIP_CONDITIONS);
-               call1 (h->val, error);
+               call1 (h->val, condition);
                unbind_to (count, Qnil);
                pop_handler ();
              }
@@ -1873,7 +1876,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object 
data, bool continuable)
          || EQ (clause, Qerror)))
     {
       debugger_called
-       = maybe_call_debugger (conditions, error);
+       = maybe_call_debugger (conditions, condition);
       /* We can't return values to code which signaled an error, but we
         can continue code which has signaled a quit.  */
       if (continuable && debugger_called)
@@ -1881,14 +1884,17 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object 
data, bool continuable)
     }
 
   if (!NILP (clause))
-    unwind_to_catch (h, NONLOCAL_EXIT_SIGNAL, error);
+    unwind_to_catch (h,
+                    NONLOCAL_EXIT_SIGNAL,
+                    legacy_cons?Fcons(AREF(condition, 1), AREF(condition, 2))
+                    :condition);
   else if (handlerlist != handlerlist_sentinel)
     /* FIXME: This will come right back here if there's no `top-level'
        catcher.  A better solution would be to abort here, and instead
        add a catch-all condition handler so we never come here.  */
     Fthrow (Qtop_level, Qt);
 
-  string = Ferror_message_string (error);
+  string = Ferror_message_string (condition);
   fatal ("%s", SDATA (string));
 }
 
@@ -1980,7 +1986,7 @@ wants_debugger (Lisp_Object list, Lisp_Object conditions)
    according to debugger-ignored-errors.  */
 
 static bool
-skip_debugger (Lisp_Object conditions, Lisp_Object data)
+skip_debugger (Lisp_Object conditions, Lisp_Object condition)
 {
   Lisp_Object tail;
   bool first_string = 1;
@@ -1993,7 +1999,7 @@ skip_debugger (Lisp_Object conditions, Lisp_Object data)
        {
          if (first_string)
            {
-             error_message = Ferror_message_string (data);
+             error_message = Ferror_message_string (condition);
              first_string = 0;
            }
 
@@ -2015,9 +2021,9 @@ skip_debugger (Lisp_Object conditions, Lisp_Object data)
 
 /* Say whether SIGNAL is a `quit' error (or inherits from it).  */
 bool
-signal_quit_p (Lisp_Object error)
+signal_quit_p (Lisp_Object condition)
 {
-  Lisp_Object signal = CONSP (error) ? XCAR (error) : Qnil;
+  Lisp_Object signal = RECORDP (condition) ? AREF (condition, 1) : Qnil;
   Lisp_Object list;
 
   return EQ (signal, Qquit)
@@ -2027,12 +2033,9 @@ signal_quit_p (Lisp_Object error)
 }
 
 /* Call the debugger if calling it is currently enabled for CONDITIONS.
-   SIG and DATA describe the signal.  There are two ways to pass them:
-    = SIG is the error symbol, and DATA is the rest of the data.
-    = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
       This is for memory-full errors only.  */
 static bool
-maybe_call_debugger (Lisp_Object conditions, Lisp_Object error)
+maybe_call_debugger (Lisp_Object conditions, Lisp_Object condition)
 {
   if (
       /* Don't try to run the debugger with interrupts blocked.
@@ -2040,15 +2043,15 @@ maybe_call_debugger (Lisp_Object conditions, 
Lisp_Object error)
       ! input_blocked_p ()
       && NILP (Vinhibit_debugger)
       /* Does user want to enter debugger for this kind of error?  */
-      && (signal_quit_p (error)
+      && (signal_quit_p (condition)
          ? debug_on_quit
          : wants_debugger (Vdebug_on_error, conditions))
-      && ! skip_debugger (conditions, error)
+      && ! skip_debugger (conditions, condition)
       /* See commentary on definition of
          `internal-when-entered-debugger'.  */
       && when_entered_debugger < num_nonmacro_input_events)
     {
-      call_debugger (list2 (Qerror, error));
+      call_debugger (list2 (Qerror, condition));
       return 1;
     }
 
@@ -4348,6 +4351,7 @@ is temporarily non-nil if 
`eval-expression-debug-on-error' is non-nil.
 The command `toggle-debug-on-error' toggles this.
 See also the variable `debug-on-quit' and `inhibit-debugger'.  */);
   Vdebug_on_error = Qnil;
+  DEFSYM (Qcondition, "condition")
 
   DEFVAR_LISP ("debug-ignored-errors", Vdebug_ignored_errors,
     doc: /* List of errors for which the debugger should not be called.
diff --git a/src/print.c b/src/print.c
index 96c4d0a5d1e..497170109bb 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1035,6 +1035,15 @@ error message is constructed.  */)
       && NILP (XCDR (XCDR (obj))))
     return XCAR (XCDR (obj));
 
+
+  if (RECORDP (obj)) {
+    /* If OBJ is #s(condition error STRING), proceed as above */
+    if (EQ (AREF (obj, 1), Qerror) && STRINGP (AREF (obj, 2)))
+      return AREF (obj, 2);
+
+    obj = Fcons(AREF (obj, 1), AREF (obj, 2));
+  }
+
   print_error_message (obj, Vprin1_to_string_buffer, 0, Qnil);
 
   set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
@@ -1052,7 +1061,7 @@ error message is constructed.  */)
    CALLER is the Lisp function inside which the error was signaled.  */
 
 void
-print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
+print_error_message (Lisp_Object error_as_cons, Lisp_Object stream, const char 
*context,
                     Lisp_Object caller)
 {
   Lisp_Object errname, errmsg, file_error, tail;
@@ -1074,14 +1083,14 @@ print_error_message (Lisp_Object data, Lisp_Object 
stream, const char *context,
       SAFE_FREE ();
     }
 
-  errname = Fcar (data);
+  errname = Fcar (error_as_cons);
 
   if (EQ (errname, Qerror))
     {
-      data = Fcdr (data);
-      if (!CONSP (data))
-       data = Qnil;
-      errmsg = Fcar (data);
+      error_as_cons = Fcdr (error_as_cons);
+      if (!CONSP (error_as_cons))
+       error_as_cons = Qnil;
+      errmsg = Fcar (error_as_cons);
       file_error = Qnil;
     }
   else
@@ -1104,7 +1113,7 @@ print_error_message (Lisp_Object data, Lisp_Object 
stream, const char *context,
 
   /* Print an error message including the data items.  */
 
-  tail = Fcdr_safe (data);
+  tail = Fcdr_safe (error_as_cons);
 
   /* For file-error, make error message by concatenating
      all the data items.  They are all strings.  */