bug#32793: 27.0.50; json-parse-string doesn't have the equivalent of json.el's json-array-type

[Dmitry Gutov <dgutov@yandex.ru>]

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

On 12.04.2019 12:22, Eli Zaretskii wrote:

> Can't say I like this conversion of Lisp symbols into C enumerations.
> I'd rather we used symbols (Qarray, Qlist, etc.), but I can understand
> why you did this as json.c already did for the other keyword values.

I vaguely suspect it might help with performance. *shrug* Or not.

>> @@ -521,7 +527,7 @@ static void
>>   json_parse_args (ptrdiff_t nargs,
>>                    Lisp_Object *args,
>>                    struct json_configuration *conf,
>> -                 bool configure_object_type)
>> +                 bool configure_types)
> 
> If we are renaming this argument, let's do a better job: I think its
> name should have been parse_object_types.

OK.

> Come to think of this: why do we need this boolean at all?  The
> callers which don't want :object-type parsed will ignore the result
> anyway, so it sounds like something we could just toss.

I'd rather we didn't accept argument we cannot handle, to avoid false 
expectations.

For example with this patch we can parse a JSON array into a Lisp list.

But there's no way to serialize a list back into a JSON array, yet.

I looked at implementing it, just for completeness (it's not necessary 
for my use case, for now). But there's an ambiguity between lists and 
alists which is not trivial to solve (i.e. when object-type is alist and 
array-type is list, how do we determinine, quickly and reliably, that a 
given list is actually an alist?). So maybe leave it for the future.

>> +          case json_array_list:
>> +            {
>> +              result = Qnil;
>> +              for (ptrdiff_t i = 0; i < size; ++i)
>> +                result = Fcons (json_to_lisp (json_array_get (json, i), conf),
>> +                                result);
>> +              result = Fnreverse (result);
> 
> If you cons the list back to front, you can avoid the Fnreverse call,
> which will make this faster.

Done. No real performance impact that I can see, but it didn't hurt either.

> Also, please insert a call to rarely_quit into the loop, as JSON
> vectors could be quite large, AFAIU.

Also done. In the json_array_array case as well, where it was missing, 
it seems.

> Finally, this needs documentation update: the doc strings of
> json-parse-string and json-parse-buffer, NEWS, and the ELisp manual.

json-parse-buffer and NEWS don't need updating, I think.

Otherwise, done, see the new patch.

[-- Attachment #2: json-array-type.diff --]
[-- Type: text/x-patch, Size: 7292 bytes --]

diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 1ef836b8f9..b46ee64786 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -5167,6 +5167,11 @@ Parsing JSON
 keys; @code{alist} to use alists with symbols as keys; or @code{plist}
 to use plists with keyword symbols as keys.
 
+@item :array-type
+The value decides which Lisp object to use for representing a JSON
+array.  It can be either @code{array}, the default, to use Lisp
+arrays; or @code{list} to use lists.
+
 @item :null-object
 The value decides which Lisp object to use to represent the JSON
 keyword @code{null}.  It defaults to the symbol @code{:null}.
diff --git a/src/json.c b/src/json.c
index 5e1439f881..1f45fe527f 100644
--- a/src/json.c
+++ b/src/json.c
@@ -337,8 +337,14 @@ enum json_object_type {
   json_object_plist
 };
 
+enum json_array_type {
+  json_array_array,
+  json_array_list
+};
+
 struct json_configuration {
   enum json_object_type object_type;
+  enum json_array_type array_type;
   Lisp_Object null_object;
   Lisp_Object false_object;
 };
@@ -521,7 +527,7 @@ static void
 json_parse_args (ptrdiff_t nargs,
                  Lisp_Object *args,
                  struct json_configuration *conf,
-                 bool configure_object_type)
+                 bool parse_object_types)
 {
   if ((nargs % 2) != 0)
     wrong_type_argument (Qplistp, Flist (nargs, args));
@@ -531,7 +537,7 @@ json_parse_args (ptrdiff_t nargs,
   for (ptrdiff_t i = nargs; i > 0; i -= 2) {
     Lisp_Object key = args[i - 2];
     Lisp_Object value = args[i - 1];
-    if (configure_object_type && EQ (key, QCobject_type))
+    if (parse_object_types && EQ (key, QCobject_type))
       {
         if (EQ (value, Qhash_table))
           conf->object_type = json_object_hashtable;
@@ -542,12 +548,22 @@ json_parse_args (ptrdiff_t nargs,
         else
           wrong_choice (list3 (Qhash_table, Qalist, Qplist), value);
       }
+    else if (parse_object_types && EQ (key, QCarray_type))
+      {
+        if (EQ (value, Qarray))
+          conf->array_type = json_array_array;
+        else if (EQ (value, Qlist))
+          conf->array_type = json_array_list;
+        else
+          wrong_choice (list2 (Qarray, Qlist), value);
+      }
     else if (EQ (key, QCnull_object))
       conf->null_object = value;
     else if (EQ (key, QCfalse_object))
       conf->false_object = value;
-    else if (configure_object_type)
-      wrong_choice (list3 (QCobject_type,
+    else if (parse_object_types)
+      wrong_choice (list4 (QCobject_type,
+                           QCarray_type,
                            QCnull_object,
                            QCfalse_object),
                     value);
@@ -604,7 +620,8 @@ usage: (json-serialize OBJECT &rest ARGS)  */)
     }
 #endif
 
-  struct json_configuration conf = {json_object_hashtable, QCnull, QCfalse};
+  struct json_configuration conf =
+    {json_object_hashtable, json_array_array, QCnull, QCfalse};
   json_parse_args (nargs - 1, args + 1, &conf, false);
 
   json_t *json = lisp_to_json_toplevel (args[0], &conf);
@@ -701,7 +718,8 @@ usage: (json-insert OBJECT &rest ARGS)  */)
     }
 #endif
 
-  struct json_configuration conf = {json_object_hashtable, QCnull, QCfalse};
+  struct json_configuration conf =
+    {json_object_hashtable, json_array_array, QCnull, QCfalse};
   json_parse_args (nargs - 1, args + 1, &conf, false);
 
   json_t *json = lisp_to_json (args[0], &conf);
@@ -817,10 +835,35 @@ json_to_lisp (json_t *json, struct json_configuration *conf)
         size_t size = json_array_size (json);
         if (PTRDIFF_MAX < size)
           overflow_error ();
-        Lisp_Object result = make_vector (size, Qunbound);
-        for (ptrdiff_t i = 0; i < size; ++i)
-          ASET (result, i,
-                json_to_lisp (json_array_get (json, i), conf));
+        Lisp_Object result;
+        switch (conf->array_type)
+          {
+          case json_array_array:
+            {
+              result = make_vector (size, Qunbound);
+              for (ptrdiff_t i = 0; i < size; ++i)
+                {
+                  rarely_quit (i);
+                  ASET (result, i,
+                        json_to_lisp (json_array_get (json, i), conf));
+                }
+              break;
+            }
+          case json_array_list:
+            {
+              result = Qnil;
+              for (ptrdiff_t i = size - 1; i >= 0; --i)
+                {
+                  rarely_quit (i);
+                  result = Fcons (json_to_lisp (json_array_get (json, i), conf),
+                                  result);
+                }
+              break;
+            }
+          default:
+            /* Can't get here.  */
+            emacs_abort ();
+          }
         --lisp_eval_depth;
         return result;
       }
@@ -918,6 +961,9 @@ a list of keyword/argument pairs:
 The keyword argument `:object-type' specifies which Lisp type is used
 to represent objects; it can be `hash-table', `alist' or `plist'.
 
+The keyword argument `:array-type' specifies which Lisp type is used
+to represent arrays; it can be `array' or `list'.
+
 The keyword argument `:null-object' specifies which object to use
 to represent a JSON null value.  It defaults to `:null'.
 
@@ -946,7 +992,8 @@ usage: (json-parse-string STRING &rest ARGS) */)
   Lisp_Object string = args[0];
   Lisp_Object encoded = json_encode (string);
   check_string_without_embedded_nuls (encoded);
-  struct json_configuration conf = {json_object_hashtable, QCnull, QCfalse};
+  struct json_configuration conf =
+    {json_object_hashtable, json_array_array, QCnull, QCfalse};
   json_parse_args (nargs - 1, args + 1, &conf, true);
 
   json_error_t error;
@@ -1016,7 +1063,8 @@ usage: (json-parse-buffer &rest args) */)
     }
 #endif
 
-  struct json_configuration conf = {json_object_hashtable, QCnull, QCfalse};
+  struct json_configuration conf =
+    {json_object_hashtable, json_array_array, QCnull, QCfalse};
   json_parse_args (nargs, args, &conf, true);
 
   ptrdiff_t point = PT_BYTE;
@@ -1095,10 +1143,12 @@ syms_of_json (void)
   Fput (Qjson_parse_string, Qside_effect_free, Qt);
 
   DEFSYM (QCobject_type, ":object-type");
+  DEFSYM (QCarray_type, ":array-type");
   DEFSYM (QCnull_object, ":null-object");
   DEFSYM (QCfalse_object, ":false-object");
   DEFSYM (Qalist, "alist");
   DEFSYM (Qplist, "plist");
+  DEFSYM (Qarray, "array");
 
   defsubr (&Sjson_serialize);
   defsubr (&Sjson_insert);
diff --git a/test/src/json-tests.el b/test/src/json-tests.el
index 04f91f4abb..542eec11bf 100644
--- a/test/src/json-tests.el
+++ b/test/src/json-tests.el
@@ -117,6 +117,14 @@ 'json-tests--error
     (should (equal (json-parse-string input :object-type 'plist)
                    '(:abc [9 :false] :def :null)))))
 
+(ert-deftest json-parse-string/array ()
+  (skip-unless (fboundp 'json-parse-string))
+  (let ((input "[\"a\", 1, [\"b\", 2]]"))
+    (should (equal (json-parse-string input)
+                   ["a" 1 ["b" 2]]))
+    (should (equal (json-parse-string input :array-type 'list)
+                   '("a" 1 ("b" 2))))))
+
 (ert-deftest json-parse-string/string ()
   (skip-unless (fboundp 'json-parse-string))
   (should-error (json-parse-string "[\"formfeed\f\"]") :type 'json-parse-error)