Re: JSON->lisp Mapping: Hash vs AList

[Philipp Stephani <p.stephani2@gmail.com>]

[-- Attachment #1.1: Type: text/plain, Size: 465 bytes --]

raman <raman@google.com> schrieb am Di., 12. Dez. 2017 um 02:40 Uhr:

> Build Emacs from @Head and started playing with the native
> implementation of JSON parsing -- it works well and is much faster
> than the lisp version as expected.
>
> After writing some code with it, I have a feature request --- could we
> set it up so that the caller can specify that json-hashes map to lisp
> alists -- rather than lisp hash-tables?
>

Sounds reasonable, here is a patch.

[-- Attachment #1.2: Type: text/html, Size: 756 bytes --]

[-- Attachment #2: 0001-Allow-JSON-parser-functions-to-return-alists.txt --]
[-- Type: text/plain, Size: 11879 bytes --]

From eb1162893fadd928a893a79fe0ddeaf827e5dfc5 Mon Sep 17 00:00:00 2001
From: Philipp Stephani <phst@google.com>
Date: Wed, 13 Dec 2017 23:35:07 +0100
Subject: [PATCH] Allow JSON parser functions to return alists

* src/json.c (Fjson_parse_string, Fjson_parse_buffer): Give these
functions a keyword argument to specify the return type for JSON
objects.
(json_to_lisp): Convert objects to alists if requested.
(json_parse_object_type): New helper function to parse keyword
arguments.

* test/src/json-tests.el (json-parse-string/object): Add a unit test.

* doc/lispref/text.texi (Parsing JSON): Document new functionality.
---
 doc/lispref/text.texi  |  20 ++++----
 src/json.c             | 128 +++++++++++++++++++++++++++++++++++++------------
 test/src/json-tests.el |  16 ++++---
 3 files changed, 119 insertions(+), 45 deletions(-)

diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 5b288d9750..7517dbcfb6 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -4965,14 +4965,13 @@ Parsing JSON
 
 @item
 JSON has only one map type, the object.  JSON objects are represented
-using Lisp hashtables.
+using Lisp hashtables or alists.
 
 @end itemize
 
 @noindent
-Note that @code{nil} doesn't represent any JSON values: this is to
-avoid confusion, because @code{nil} could either represent
-@code{null}, @code{false}, or an empty array, all of which are
+Note that @code{nil} represents the empty JSON object, @code{@{@}},
+not @code{null}, @code{false}, or an empty array, all of which are
 different JSON values.
 
   If some Lisp object can't be represented in JSON, the serialization
@@ -4995,8 +4994,13 @@ Parsing JSON
 
   Only top-level values (arrays and objects) can be serialized to
 JSON.  The subobjects within these top-level values can be of any
-type.  Likewise, the parsing functions will only return vectors and
-hashtables.
+type.  Likewise, the parsing functions will only return vectors,
+hashtables, and alists.
+
+  The parsing functions accept keyword arguments.  Currently only one
+keyword argument, @code{:object-type}, is recognized; its value can be
+either @code{hash-table} to parse JSON objects as hashtables with
+string keys (the default) or @code{alist} to parse them as alists.
 
 @defun json-serialize object
 This function returns a new Lisp string which contains the JSON
@@ -5008,12 +5012,12 @@ Parsing JSON
 current buffer before point.
 @end defun
 
-@defun json-parse-string string
+@defun json-parse-string string &key (object-type 'hash-table)
 This function parses the JSON value in @var{string}, which must be a
 Lisp string.
 @end defun
 
-@defun json-parse-buffer
+@defun json-parse-buffer &key (object-type 'hash-table)
 This function reads the next JSON value from the current buffer,
 starting at point.  It moves point to the position immediately after
 the value if a value could be read and converted to Lisp; otherwise it
diff --git a/src/json.c b/src/json.c
index 7025ae165c..34c568d76f 100644
--- a/src/json.c
+++ b/src/json.c
@@ -507,10 +507,15 @@ OBJECT.  */)
   return unbind_to (count, Qnil);
 }
 
+enum json_object_type {
+  json_object_hashtable,
+  json_object_alist,
+};
+
 /* Convert a JSON object to a Lisp object.  */
 
 static _GL_ARG_NONNULL ((1)) Lisp_Object
-json_to_lisp (json_t *json)
+json_to_lisp (json_t *json, enum json_object_type object_type)
 {
   switch (json_typeof (json))
     {
@@ -544,7 +549,7 @@ json_to_lisp (json_t *json)
         Lisp_Object result = Fmake_vector (make_natnum (size), Qunbound);
         for (ptrdiff_t i = 0; i < size; ++i)
           ASET (result, i,
-                json_to_lisp (json_array_get (json, i)));
+                json_to_lisp (json_array_get (json, i), object_type));
         --lisp_eval_depth;
         return result;
       }
@@ -552,23 +557,49 @@ json_to_lisp (json_t *json)
       {
         if (++lisp_eval_depth > max_lisp_eval_depth)
           xsignal0 (Qjson_object_too_deep);
-        size_t size = json_object_size (json);
-        if (FIXNUM_OVERFLOW_P (size))
-          xsignal0 (Qoverflow_error);
-        Lisp_Object result = CALLN (Fmake_hash_table, QCtest, Qequal,
-                                    QCsize, make_natnum (size));
-        struct Lisp_Hash_Table *h = XHASH_TABLE (result);
-        const char *key_str;
-        json_t *value;
-        json_object_foreach (json, key_str, value)
+        Lisp_Object result;
+        switch (object_type)
           {
-            Lisp_Object key = json_build_string (key_str);
-            EMACS_UINT hash;
-            ptrdiff_t i = hash_lookup (h, key, &hash);
-            /* Keys in JSON objects are unique, so the key can’t be
-               present yet.  */
-            eassert (i < 0);
-            hash_put (h, key, json_to_lisp (value), hash);
+          case json_object_hashtable:
+            {
+              size_t size = json_object_size (json);
+              if (FIXNUM_OVERFLOW_P (size))
+                xsignal0 (Qoverflow_error);
+              result = CALLN (Fmake_hash_table, QCtest, Qequal, QCsize,
+                              make_natnum (size));
+              struct Lisp_Hash_Table *h = XHASH_TABLE (result);
+              const char *key_str;
+              json_t *value;
+              json_object_foreach (json, key_str, value)
+                {
+                  Lisp_Object key = json_build_string (key_str);
+                  EMACS_UINT hash;
+                  ptrdiff_t i = hash_lookup (h, key, &hash);
+                  /* Keys in JSON objects are unique, so the key can’t
+                     be present yet.  */
+                  eassert (i < 0);
+                  hash_put (h, key, json_to_lisp (value, object_type), hash);
+                }
+              break;
+            }
+          case json_object_alist:
+            {
+              result = Qnil;
+              const char *key_str;
+              json_t *value;
+              json_object_foreach (json, key_str, value)
+                {
+                  Lisp_Object key = Fintern (json_build_string (key_str), Qnil);
+                  result
+                    = Fcons (Fcons (key, json_to_lisp (value, object_type)),
+                             result);
+                }
+              result = Fnreverse (result);
+              break;
+            }
+          default:
+            /* Can’t get here.  */
+            emacs_abort ();
           }
         --lisp_eval_depth;
         return result;
@@ -578,15 +609,43 @@ json_to_lisp (json_t *json)
   emacs_abort ();
 }
 
-DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, 1, NULL,
+static enum json_object_type
+json_parse_object_type (ptrdiff_t nargs, Lisp_Object *args)
+{
+  switch (nargs)
+    {
+    case 0:
+      return json_object_hashtable;
+    case 2: {
+      Lisp_Object key = args[0];
+      Lisp_Object value = args[1];
+      if (!EQ (key, QCobject_type))
+        wrong_choice (list1 (QCobject_type), key);
+      if (EQ (value, Qhash_table))
+        return json_object_hashtable;
+      else if (EQ (value, Qalist))
+        return json_object_alist;
+      else
+        wrong_choice (list2 (Qhash_table, Qalist), value);
+    }
+    default:
+      wrong_type_argument (Qplistp, Flist (nargs, args));
+    }
+}
+
+DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, MANY,
+       NULL,
        doc: /* Parse the JSON STRING into a Lisp object.
 This is essentially the reverse operation of `json-serialize', which
-see.  The returned object will be a vector or hashtable.  Its elements
-will be `:null', `:false', t, numbers, strings, or further vectors and
-hashtables.  If there are duplicate keys in an object, all but the
-last one are ignored.  If STRING doesn't contain a valid JSON object,
-an error of type `json-parse-error' is signaled.  */)
-  (Lisp_Object string)
+see.  The returned object will be a vector, hashtable, or alist.  Its
+elements will be `:null', `:false', t, numbers, strings, or further
+vectors, hashtables, and alists.  If there are duplicate keys in an
+object, all but the last one are ignored.  If STRING doesn't contain a
+valid JSON object, an error of type `json-parse-error' is signaled.
+The keyword argument OBJECT-TYPE specifies which Lisp type is used to
+represent objects; it can be `hash-table' or `alist'.
+usage: (string &key (OBJECT-TYPE \\='hash-table))  */)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
   ptrdiff_t count = SPECPDL_INDEX ();
 
@@ -605,8 +664,11 @@ an error of type `json-parse-error' is signaled.  */)
     }
 #endif
 
+  Lisp_Object string = args[0];
   Lisp_Object encoded = json_encode (string);
   check_string_without_embedded_nulls (encoded);
+  enum json_object_type object_type
+    = json_parse_object_type (nargs - 1, args + 1);
 
   json_error_t error;
   json_t *object = json_loads (SSDATA (encoded), 0, &error);
@@ -617,7 +679,7 @@ an error of type `json-parse-error' is signaled.  */)
   if (object != NULL)
     record_unwind_protect_ptr (json_release_object, object);
 
-  return unbind_to (count, json_to_lisp (object));
+  return unbind_to (count, json_to_lisp (object, object_type));
 }
 
 struct json_read_buffer_data
@@ -650,12 +712,13 @@ json_read_buffer_callback (void *buffer, size_t buflen, void *data)
 }
 
 DEFUN ("json-parse-buffer", Fjson_parse_buffer, Sjson_parse_buffer,
-       0, 0, NULL,
+       0, MANY, NULL,
        doc: /* Read JSON object from current buffer starting at point.
 This is similar to `json-parse-string', which see.  Move point after
 the end of the object if parsing was successful.  On error, point is
-not moved.  */)
-  (void)
+not moved.
+usage: (&key (OBJECT-TYPE \\='hash-table))  */)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
   ptrdiff_t count = SPECPDL_INDEX ();
 
@@ -674,6 +737,8 @@ not moved.  */)
     }
 #endif
 
+  enum json_object_type object_type = json_parse_object_type (nargs, args);
+
   ptrdiff_t point = PT_BYTE;
   struct json_read_buffer_data data = {.point = point};
   json_error_t error;
@@ -687,7 +752,7 @@ not moved.  */)
   record_unwind_protect_ptr (json_release_object, object);
 
   /* Convert and then move point only if everything succeeded.  */
-  Lisp_Object lisp = json_to_lisp (object);
+  Lisp_Object lisp = json_to_lisp (object, object_type);
 
   /* Adjust point by how much we just read.  */
   point += error.position;
@@ -750,6 +815,9 @@ syms_of_json (void)
   Fput (Qjson_parse_string, Qpure, Qt);
   Fput (Qjson_parse_string, Qside_effect_free, Qt);
 
+  DEFSYM (QCobject_type, ":object-type");
+  DEFSYM (Qalist, "alist");
+
   defsubr (&Sjson_serialize);
   defsubr (&Sjson_insert);
   defsubr (&Sjson_parse_string);
diff --git a/test/src/json-tests.el b/test/src/json-tests.el
index 07eb41d093..da51aac8c8 100644
--- a/test/src/json-tests.el
+++ b/test/src/json-tests.el
@@ -52,13 +52,15 @@
 
 (ert-deftest json-parse-string/object ()
   (skip-unless (fboundp 'json-parse-string))
-  (let ((actual
-         (json-parse-string
-          "{ \"abc\" : [1, 2, true], \"def\" : null, \"abc\" : [9, false] }\n")))
-    (should (hash-table-p actual))
-    (should (equal (hash-table-count actual) 2))
-    (should (equal (cl-sort (map-pairs actual) #'string< :key #'car)
-                   '(("abc" . [9 :false]) ("def" . :null))))))
+  (let ((input
+         "{ \"abc\" : [1, 2, true], \"def\" : null, \"abc\" : [9, false] }\n"))
+    (let ((actual (json-parse-string input)))
+      (should (hash-table-p actual))
+      (should (equal (hash-table-count actual) 2))
+      (should (equal (cl-sort (map-pairs actual) #'string< :key #'car)
+                     '(("abc" . [9 :false]) ("def" . :null)))))
+    (should (equal (json-parse-string input :object-type 'alist)
+                   '((abc . [9 :false]) (def . :null))))))
 
 (ert-deftest json-parse-string/string ()
   (skip-unless (fboundp 'json-parse-string))
-- 
2.15.1