Re: JSON->lisp Mapping: Hash vs AList

[T.V Raman]

Nice!
Could you check it into master once others have had a chance to comment/

Philipp Stephani writes:
 >    raman <address@hidden> 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.
 > 
 > References
 > 
 >    1. mailto:address@hidden
 > 
 > ----------------------------------------------------------------------
 > From eb1162893fadd928a893a79fe0ddeaf827e5dfc5 Mon Sep 17 00:00:00 2001
 > From: Philipp Stephani <address@hidden>
 > 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
 > address@hidden, @code{false}, or an empty array, all of which are
 > +Note that @code{nil} represents the empty JSON object, @address@hidden@}},
 > +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
 >  
 > address@hidden json-parse-string string
 > address@hidden 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
 >  
 > address@hidden json-parse-buffer
 > address@hidden 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
 > 

-- 

--