From 407e775282843945882bb529bdcc59acd6d85ed3 Mon Sep 17 00:00:00 2001 From: panasenco Date: Mon, 12 Apr 2021 15:15:29 -0700 Subject: [PATCH 01/11] Began working on json library (fresh start after thinking about instantiation in terms of search strategies) --- src/lib/json.pl | 133 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 133 insertions(+) create mode 100644 src/lib/json.pl diff --git a/src/lib/json.pl b/src/lib/json.pl new file mode 100644 index 00000000..c83cd6fd --- /dev/null +++ b/src/lib/json.pl @@ -0,0 +1,133 @@ +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + Written Apr 2021 by Aram Panasenco (panasenco@ucla.edu) + Part of Scryer Prolog. + + BSD 3-Clause License + + Copyright (c) 2021, Aram Panasenco + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + + * Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE + DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE + FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR + SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, + OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE + OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ + +:- module(json, [ + json_whitespace//0, + json_string//1 + ]). + +:- use_module(library(charsio)). +:- use_module(library(clpz)). +:- use_module(library(dcgs)). +:- use_module(library(dif)). +:- use_module(library(error)). +:- use_module(library(lists)). + +char_uniontypes(Char, Types) :- + must_be(list, Types), + bagof(Type, (char_type(Char, Type), member(Type, Types)), [_|_]). + +json_whitespace --> "". +json_whitespace --> " ", json_whitespace. +json_whitespace --> "\n", json_whitespace. +json_whitespace --> "\r", json_whitespace. +json_whitespace --> "\t", json_whitespace. + +escape_map([ + '"' - '"', + ('\\') - ('\\'), + ('/') - ('/'), + '\b' - 'b', + '\f' - 'f', + '\n' - 'n', + '\r' - 'r', + '\t' - 't' +]). + +hex(0) --> "0". +hex(1) --> "1". +hex(2) --> "2". +hex(3) --> "3". +hex(4) --> "4". +hex(5) --> "5". +hex(6) --> "6". +hex(7) --> "7". +hex(8) --> "8". +hex(9) --> "9". +hex(10) --> "a". +hex(11) --> "b". +hex(12) --> "c". +hex(13) --> "d". +hex(14) --> "e". +hex(15) --> "f". + +inner_string("") --> "". +inner_string([PrintChar | Tail]) --> + [PrintChar], + { + escape_map(EscapeMap), + \+ member(PrintChar-_, EscapeMap), + ( + PrintChar = ' ' + ; char_uniontypes(PrintChar, [alphanumeric, ascii_graphic]) + ) + }, + inner_string(Tail). +inner_string([EscapeChar | Tail]) --> + "\\", + [PrintChar], + { + escape_map(EscapeMap), + member(EscapeChar-PrintChar, EscapeMap) + }, + inner_string(Tail). +inner_string([NonPrintChar | Tail]) --> + "\\u", + { + [H1, H2, H3, H4] ins 0..15, + NonPrintCharCode in 0..65535, + NonPrintCharCode #= H1 * 16^3 + H2 * 16^2 + H3 * 16 + H4, + ( + ground(NonPrintChar) -> + escape_map(EscapeMap), + \+ member(NonPrintChar-_, EscapeMap), + dif(NonPrintChar, ' '), + \+ char_uniontypes(NonPrintChar, [alphanumeric, ascii_graphic]), + char_code(NonPrintChar, NonPrintCharCode) + ; true + ) + }, + hex(H1), + hex(H2), + hex(H3), + hex(H4), + { + \+ ground(NonPrintChar) -> + char_code(NonPrintChar, NonPrintCharCode) + ; true + }, + inner_string(Tail). + +json_string(Inner) --> "\"", inner_string(Inner), "\"". From 216d4da85af4c4181c7a1a2e4611eba3785a5762 Mon Sep 17 00:00:00 2001 From: panasenco Date: Sat, 17 Apr 2021 21:44:57 -0700 Subject: [PATCH 02/11] Parsing and generating JSON numbers works perfectly now as far as I can tell --- src/lib/json.pl | 67 +++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 65 insertions(+), 2 deletions(-) diff --git a/src/lib/json.pl b/src/lib/json.pl index c83cd6fd..26814df6 100644 --- a/src/lib/json.pl +++ b/src/lib/json.pl @@ -35,7 +35,10 @@ :- module(json, [ json_whitespace//0, - json_string//1 + json_string//1, + json_number//1, + json_value//1, + json_array//1 ]). :- use_module(library(charsio)). @@ -44,6 +47,7 @@ :- use_module(library(dif)). :- use_module(library(error)). :- use_module(library(lists)). +:- use_module(library(reif)). char_uniontypes(Char, Types) :- must_be(list, Types), @@ -130,4 +134,63 @@ inner_string([NonPrintChar | Tail]) --> }, inner_string(Tail). -json_string(Inner) --> "\"", inner_string(Inner), "\"". +json_string(Inner) --> + "\"", + inner_string(Inner), + "\"". + +posdigit(Digit) --> [Digit], {member(Digit, "123456789")}. +digit('0') --> "0". +digit(Digit) --> posdigit(Digit). +number_str(['-'|Rest], sign) --> "-", number_str(Rest, wholestart). +number_str(Rest, sign) --> number_str(Rest, wholestart). +number_str([PosDigit|Rest], wholestart) --> posdigit(PosDigit), number_str(Rest, wholerest). +number_str(['0'|Rest], wholestart) --> "0", number_str(Rest, fractionstart). +number_str([Digit|Rest], wholerest) --> digit(Digit), number_str(Rest, wholerest). +number_str(Rest, wholerest) --> number_str(Rest, fractionstart). +number_str(Rest, wholerest) --> number_str(Rest, exponentstart). +number_str(['.'|Rest], fractionstart) --> ".", number_str(Rest, fraction). +number_str([Digit|Rest], fraction) --> digit(Digit), number_str(Rest, fraction). +number_str([Digit|Rest], fraction) --> digit(Digit), number_str(Rest, exponentstart). +number_str(['e'|Rest], exponentstart) --> "e", number_str(Rest, exponentsign). +number_str(['e'|Rest], exponentstart) --> "E", number_str(Rest, exponentsign). +number_str("", exponentstart) --> "". +number_str(['-'|Rest], exponentsign) --> "-", number_str(Rest, exponent). +number_str(Rest, exponentsign) --> "+", number_str(Rest, exponent). +number_str(Rest, exponentsign) --> number_str(Rest, exponent). +number_str([Digit|Rest], exponent) --> digit(Digit), number_str(Rest, exponent). +number_str([Digit], exponent) --> digit(Digit). + +json_number(Number) --> + { + ground(Number) -> + ( + number(Number) -> + number_chars(Number, NumberChars) + ; false + ) + ; true + }, + number_str(NumberChars, sign), + { + ground(Number) -> + true + ; number_chars(Number, NumberChars) + }. + +inner_value(String) --> json_string(String). +inner_value(Number) --> json_number(Number). +%inner_value(Object) --> json_object(Object). +inner_value(Array) --> json_array(Array). +inner_value(true) --> "true". +inner_value(false) --> "false". +inner_value(null) --> "null". +json_value(Value) --> json_whitespace, inner_value(Value), json_whitespace. + +inner_array([]) --> "". +inner_array([Value]) --> json_value(Value). +inner_array([Value1, Value2 | Tail]) --> + json_value(Value1), + ",", + inner_array([Value2 | Tail]). +json_array(List) --> "[", inner_array(List), "]". From e2923c378e62233bbc5590c726051a107edb1e6d Mon Sep 17 00:00:00 2001 From: panasenco Date: Sun, 18 Apr 2021 14:59:16 -0700 Subject: [PATCH 03/11] Added objects and type distinction based on the principal functor --- src/lib/json.pl | 38 +++++++++++++++++++++++++++++++------- 1 file changed, 31 insertions(+), 7 deletions(-) diff --git a/src/lib/json.pl b/src/lib/json.pl index 26814df6..4b6915ff 100644 --- a/src/lib/json.pl +++ b/src/lib/json.pl @@ -38,9 +38,11 @@ json_string//1, json_number//1, json_value//1, - json_array//1 + json_array//1, + json_object//1 ]). +:- use_module(library(assoc)). :- use_module(library(charsio)). :- use_module(library(clpz)). :- use_module(library(dcgs)). @@ -178,12 +180,12 @@ json_number(Number) --> ; number_chars(Number, NumberChars) }. -inner_value(String) --> json_string(String). -inner_value(Number) --> json_number(Number). -%inner_value(Object) --> json_object(Object). -inner_value(Array) --> json_array(Array). -inner_value(true) --> "true". -inner_value(false) --> "false". +inner_value(string(Chars)) --> json_string(Chars). +inner_value(number(Number)) --> json_number(Number). +inner_value(object(Object)) --> json_object(Object). +inner_value(array(Array)) --> json_array(Array). +inner_value(boolean(true)) --> "true". +inner_value(boolean(false)) --> "false". inner_value(null) --> "null". json_value(Value) --> json_whitespace, inner_value(Value), json_whitespace. @@ -194,3 +196,25 @@ inner_array([Value1, Value2 | Tail]) --> ",", inner_array([Value2 | Tail]). json_array(List) --> "[", inner_array(List), "]". + +json_member(Key, Value) --> json_whitespace, json_string(Key), json_whitespace, ":", json_value(Value). + +json_members([Key-Value]) --> json_member(Key, Value). +json_members([Key-Value | Tail]) --> json_member(Key, Value), ",", json_members(Tail). + +json_object(EmptyAssoc) --> {empty_assoc(EmptyAssoc)}, "{", json_whitespace, "}". +json_object(Assoc) --> + { + nonvar(Assoc) -> + \+ empty_assoc(Assoc), + assoc_to_list(Assoc, [Pair|Pairs]) + ; true + }, + "{", + json_members([Pair|Pairs]), + "}", + { + var(Assoc) -> + list_to_assoc([Pair|Pairs], Assoc) + ; true + }. From 0e73b5380376eb81c984b304faf2143a6ee94e88 Mon Sep 17 00:00:00 2001 From: panasenco Date: Sun, 18 Apr 2021 23:21:12 -0700 Subject: [PATCH 04/11] Complete reordering and partial rewrite to match the official McKeeman form of the JSON specification --- src/lib/json.pl | 359 +++++++++++++++++++++++++++--------------------- 1 file changed, 203 insertions(+), 156 deletions(-) diff --git a/src/lib/json.pl b/src/lib/json.pl index 4b6915ff..1875d3c7 100644 --- a/src/lib/json.pl +++ b/src/lib/json.pl @@ -34,15 +34,11 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- module(json, [ - json_whitespace//0, - json_string//1, - json_number//1, - json_value//1, - json_array//1, - json_object//1 + json_chars//1 ]). :- use_module(library(assoc)). +:- use_module(library(between)). :- use_module(library(charsio)). :- use_module(library(clpz)). :- use_module(library(dcgs)). @@ -51,158 +47,32 @@ :- use_module(library(lists)). :- use_module(library(reif)). -char_uniontypes(Char, Types) :- - must_be(list, Types), - bagof(Type, (char_type(Char, Type), member(Type, Types)), [_|_]). +/* The DCGs are written to match the McKeeman Form presented on the right side of https://www.json.org/json-en.html + almost perfectly. Note that the McKeeman form conflicts some with the pictures on the left side. */ +json_chars(Internal) --> json_element(Internal). -json_whitespace --> "". -json_whitespace --> " ", json_whitespace. -json_whitespace --> "\n", json_whitespace. -json_whitespace --> "\r", json_whitespace. -json_whitespace --> "\t", json_whitespace. +/* Because it's impossible to distinguish between an empty array [] and an empty string "", we distinguish between + different types of values based on their principal functor. The principal functors match the types defined in + the JSON Schema spec here: https://json-schema.org/draft/2020-12/json-schema-validation.html#rfc.section.6.1.1 + Down the line we'll incorporate more JSON Schema support, but this is it for now. */ +json_value(object(Assoc)) --> json_object(Assoc). +json_value(array(List)) --> json_array(List). +json_value(string(Chars)) --> json_string(Chars). +json_value(number(Number)) --> json_number(Number). +json_value(boolean(true)) --> "true". +json_value(boolean(false)) --> "false". +json_value(null) --> "null". -escape_map([ - '"' - '"', - ('\\') - ('\\'), - ('/') - ('/'), - '\b' - 'b', - '\f' - 'f', - '\n' - 'n', - '\r' - 'r', - '\t' - 't' -]). - -hex(0) --> "0". -hex(1) --> "1". -hex(2) --> "2". -hex(3) --> "3". -hex(4) --> "4". -hex(5) --> "5". -hex(6) --> "6". -hex(7) --> "7". -hex(8) --> "8". -hex(9) --> "9". -hex(10) --> "a". -hex(11) --> "b". -hex(12) --> "c". -hex(13) --> "d". -hex(14) --> "e". -hex(15) --> "f". - -inner_string("") --> "". -inner_string([PrintChar | Tail]) --> - [PrintChar], - { - escape_map(EscapeMap), - \+ member(PrintChar-_, EscapeMap), - ( - PrintChar = ' ' - ; char_uniontypes(PrintChar, [alphanumeric, ascii_graphic]) - ) - }, - inner_string(Tail). -inner_string([EscapeChar | Tail]) --> - "\\", - [PrintChar], - { - escape_map(EscapeMap), - member(EscapeChar-PrintChar, EscapeMap) - }, - inner_string(Tail). -inner_string([NonPrintChar | Tail]) --> - "\\u", - { - [H1, H2, H3, H4] ins 0..15, - NonPrintCharCode in 0..65535, - NonPrintCharCode #= H1 * 16^3 + H2 * 16^2 + H3 * 16 + H4, - ( - ground(NonPrintChar) -> - escape_map(EscapeMap), - \+ member(NonPrintChar-_, EscapeMap), - dif(NonPrintChar, ' '), - \+ char_uniontypes(NonPrintChar, [alphanumeric, ascii_graphic]), - char_code(NonPrintChar, NonPrintCharCode) - ; true - ) - }, - hex(H1), - hex(H2), - hex(H3), - hex(H4), - { - \+ ground(NonPrintChar) -> - char_code(NonPrintChar, NonPrintCharCode) - ; true - }, - inner_string(Tail). - -json_string(Inner) --> - "\"", - inner_string(Inner), - "\"". - -posdigit(Digit) --> [Digit], {member(Digit, "123456789")}. -digit('0') --> "0". -digit(Digit) --> posdigit(Digit). -number_str(['-'|Rest], sign) --> "-", number_str(Rest, wholestart). -number_str(Rest, sign) --> number_str(Rest, wholestart). -number_str([PosDigit|Rest], wholestart) --> posdigit(PosDigit), number_str(Rest, wholerest). -number_str(['0'|Rest], wholestart) --> "0", number_str(Rest, fractionstart). -number_str([Digit|Rest], wholerest) --> digit(Digit), number_str(Rest, wholerest). -number_str(Rest, wholerest) --> number_str(Rest, fractionstart). -number_str(Rest, wholerest) --> number_str(Rest, exponentstart). -number_str(['.'|Rest], fractionstart) --> ".", number_str(Rest, fraction). -number_str([Digit|Rest], fraction) --> digit(Digit), number_str(Rest, fraction). -number_str([Digit|Rest], fraction) --> digit(Digit), number_str(Rest, exponentstart). -number_str(['e'|Rest], exponentstart) --> "e", number_str(Rest, exponentsign). -number_str(['e'|Rest], exponentstart) --> "E", number_str(Rest, exponentsign). -number_str("", exponentstart) --> "". -number_str(['-'|Rest], exponentsign) --> "-", number_str(Rest, exponent). -number_str(Rest, exponentsign) --> "+", number_str(Rest, exponent). -number_str(Rest, exponentsign) --> number_str(Rest, exponent). -number_str([Digit|Rest], exponent) --> digit(Digit), number_str(Rest, exponent). -number_str([Digit], exponent) --> digit(Digit). - -json_number(Number) --> - { - ground(Number) -> - ( - number(Number) -> - number_chars(Number, NumberChars) - ; false - ) - ; true - }, - number_str(NumberChars, sign), - { - ground(Number) -> - true - ; number_chars(Number, NumberChars) - }. - -inner_value(string(Chars)) --> json_string(Chars). -inner_value(number(Number)) --> json_number(Number). -inner_value(object(Object)) --> json_object(Object). -inner_value(array(Array)) --> json_array(Array). -inner_value(boolean(true)) --> "true". -inner_value(boolean(false)) --> "false". -inner_value(null) --> "null". -json_value(Value) --> json_whitespace, inner_value(Value), json_whitespace. - -inner_array([]) --> "". -inner_array([Value]) --> json_value(Value). -inner_array([Value1, Value2 | Tail]) --> - json_value(Value1), - ",", - inner_array([Value2 | Tail]). -json_array(List) --> "[", inner_array(List), "]". - -json_member(Key, Value) --> json_whitespace, json_string(Key), json_whitespace, ":", json_value(Value). - -json_members([Key-Value]) --> json_member(Key, Value). -json_members([Key-Value | Tail]) --> json_member(Key, Value), ",", json_members(Tail). - -json_object(EmptyAssoc) --> {empty_assoc(EmptyAssoc)}, "{", json_whitespace, "}". +/* Read Bob Kowalski's "Algorithm = Logic + Control": + https://www.doc.ic.ac.uk/~rak/papers/algorithm%20=%20logic%20+%20control.pdf + This DCG definition does two things: + 1. Logic: Relate an association list to a JSON object serialized in a string. + 2. Control: Define the exact strategy by which we obtain an association list from a JSON string and vice versa. + This is done via instantiation checks `var/1` and `nonvar/1`. + Unfortunately, the logic and control in this DCG aren't separated cleanly like Bob Kowalski proposed. + Maybe at some point in the future we'll have a library that takes a pure logic character parsing/generating DCG + and 'injects' control strategy into it. We aren't there yet... */ +json_object(EmptyAssoc) --> {empty_assoc(EmptyAssoc)}, "{", json_ws, "}". json_object(Assoc) --> { nonvar(Assoc) -> @@ -218,3 +88,180 @@ json_object(Assoc) --> list_to_assoc([Pair|Pairs], Assoc) ; true }. + +json_members([Key-Value]) --> json_member(Key, Value). +json_members([Key-Value | Pairs]) --> json_member(Key, Value), ",", json_members(Pairs). + +json_member(Key, Value) --> json_ws, json_string(Key), json_ws, ":", json_element(Value). + +json_array([]) --> "[", json_ws, "]". +json_array([Value|Values]) --> "[", json_elements([Value|Values]), "]". + +json_elements([Value]) --> json_element(Value). +json_elements([Value|Values]) --> json_element(Value), ",", json_elements(Values). + +json_element(Value) --> json_ws, json_value(Value), json_ws. + +json_string(Chars) --> "\"", json_characters(Chars), "\"". + +json_characters("") --> "". +json_characters([Char|Chars]) --> json_character(Char), json_characters(Chars). + +/* A directly printable character is defined by the JSON spec as a character between 0020 and 10FFFF except the + escaped characters. + Note that `char_code/2` throws an instantiation error if both its arguments are undefined, so we delay + calling it until we've seen both the generating and the parsing sides of the DCG. + If we moved the block containing `char_code/2` up before `[PrintChar]`, we would still be able to generate JSON, + but attempting to parse JSON would cause an instantiation error. */ +escape_map([ + '"' - '"', + ('\\') - ('\\'), + ('/') - ('/'), + '\b' - 'b', + '\f' - 'f', + '\n' - 'n', + '\r' - 'r', + '\t' - 't' +]). + +json_character(PrintChar) --> + [PrintChar], + { + escape_map(EscapeMap), + \+ member(PrintChar-_, EscapeMap), + char_code(PrintChar, PrintCharCode), + PrintCharCode in 32..1114111 /* 20.10FFFF */ + }. +json_character(EscapeChar) --> "\\", json_escape(EscapeChar). + +json_escape(EscapeChar) --> + [PrintChar], + { + escape_map(EscapeMap), + member(EscapeChar-PrintChar, EscapeMap) + }. +json_escape(EscapeChar) --> + "u", + { /* Logic: Define the domain of the escape character as well as the relationship between the escape character + and the four hexes */ + [H1, H2, H3, H4] ins 0..15, + EscapeCharCode in 0..65535, + EscapeCharCode #= H1 * 16^3 + H2 * 16^2 + H3 * 16 + H4 + }, + { /* Control: Get the code of the escape character if we can. Otherwise we'll end up backtracking over 65,536 + possible hex values. + Logic: Only the first 32 Unicode characters not escaped in the escape map are eligible for \u-escaping + when generating. However, we want to be able to parse any of the 65,536 \u-escaped values when parsing. */ + nonvar(EscapeChar) -> + char_code(EscapeChar, EscapeCharCode), + EscapeCharCode in 0..31, + escape_map(EscapeMap), + \+ member(EscapeChar-_, EscapeMap) + ; true + }, + json_hex(H1), + json_hex(H2), + json_hex(H3), + json_hex(H4), + { /* Control + Logic: Get the escape character atom from the character code computed from the hexes. */ + var(EscapeChar) -> + char_code(EscapeChar, EscapeCharCode) + ; true + }. + +json_hex(Digit) --> json_digit(Digit). +json_hex(10) --> "a". +json_hex(11) --> "b". +json_hex(12) --> "c". +json_hex(13) --> "d". +json_hex(14) --> "e". +json_hex(15) --> "f". +json_hex(10) --> "A". +json_hex(11) --> "B". +json_hex(12) --> "C". +json_hex(13) --> "D". +json_hex(14) --> "E". +json_hex(15) --> "F". + +/* Here we are going to write completely different DCGs for parsing and generating, and rely on built-in + predicates. However, the underlying logic remains the same. */ +json_number(Number) --> + { + nonvar(Number) -> + number_chars(Number, NumberChars) + ; false + }, + NumberChars. +json_number(Number) --> + { + var(Number) + }, + json_sign_noplus(Sign), + json_integer(Integer), + json_fraction(Fraction), + json_exponent(Exponent), + { + Number is Sign * (Integer + Fraction) * 10.0 ^ Exponent + }. + +json_integer(Digit) --> json_digit(Digit). +json_integer(TotalValue) --> + json_onenine(FirstDigit), + json_digits(RemainingValue, Power), + { + TotalValue #= FirstDigit * 10 ^ (Power + 1) + RemainingValue + }. + +json_digits(Digit, 0) --> json_digit(Digit). +json_digits(Value, Power) --> + json_digit(FirstDigit), + json_digits(RemainingValue, NextPower), + { + Power #= NextPower + 1, + Value #= FirstDigit * 10^Power + RemainingValue + }. + +json_digit(0) --> "0". +json_digit(Digit) --> json_onenine(Digit). + +json_onenine(1) --> "1". +json_onenine(2) --> "2". +json_onenine(3) --> "3". +json_onenine(4) --> "4". +json_onenine(5) --> "5". +json_onenine(6) --> "6". +json_onenine(7) --> "7". +json_onenine(8) --> "8". +json_onenine(9) --> "9". + +json_fraction(0) --> "". +json_fraction(Fraction) --> + ".", + json_digits(Value, Power), + { + Fraction is Value / 10 ^ (Power + 1) + }. + +json_exponent(0) --> "". +json_exponent(Exponent) --> + json_exponent_signifier, + json_sign(Sign), + json_digits(Value, _), + { + Exponent #= Sign * Value + }. + +json_exponent_signifier --> "E". +json_exponent_signifier --> "e". + +json_sign_noplus(1) --> "". +json_sign_noplus(-1) --> "-". + +json_sign(Sign) --> json_sign_noplus(Sign). +json_sign(1) --> "+". + +json_ws --> "". +json_ws --> " ", json_ws. +json_ws --> "\n", json_ws. +json_ws --> "\r", json_ws. +json_ws --> "\t", json_ws. From 20f192daa14473c0428bf95d07aa24dc680c71a4 Mon Sep 17 00:00:00 2001 From: panasenco Date: Sun, 18 Apr 2021 23:44:10 -0700 Subject: [PATCH 05/11] Changed formatting to match Markus Triska's as much as I can tell --- src/lib/json.pl | 216 ++++++++++++++++++++++-------------------------- 1 file changed, 98 insertions(+), 118 deletions(-) diff --git a/src/lib/json.pl b/src/lib/json.pl index 1875d3c7..959f6b45 100644 --- a/src/lib/json.pl +++ b/src/lib/json.pl @@ -47,7 +47,7 @@ :- use_module(library(lists)). :- use_module(library(reif)). -/* The DCGs are written to match the McKeeman Form presented on the right side of https://www.json.org/json-en.html +/* The DCGs are written to match the McKeeman form presented on the right side of https://www.json.org/json-en.html almost perfectly. Note that the McKeeman form conflicts some with the pictures on the left side. */ json_chars(Internal) --> json_element(Internal). @@ -55,13 +55,13 @@ json_chars(Internal) --> json_element(Internal). different types of values based on their principal functor. The principal functors match the types defined in the JSON Schema spec here: https://json-schema.org/draft/2020-12/json-schema-validation.html#rfc.section.6.1.1 Down the line we'll incorporate more JSON Schema support, but this is it for now. */ -json_value(object(Assoc)) --> json_object(Assoc). -json_value(array(List)) --> json_array(List). -json_value(string(Chars)) --> json_string(Chars). -json_value(number(Number)) --> json_number(Number). -json_value(boolean(true)) --> "true". -json_value(boolean(false)) --> "false". -json_value(null) --> "null". +json_value(object(Assoc)) --> json_object(Assoc). +json_value(array(List)) --> json_array(List). +json_value(string(Chars)) --> json_string(Chars). +json_value(number(Number)) --> json_number(Number). +json_value(boolean(true)) --> "true". +json_value(boolean(false)) --> "false". +json_value(null) --> "null". /* Read Bob Kowalski's "Algorithm = Logic + Control": https://www.doc.ic.ac.uk/~rak/papers/algorithm%20=%20logic%20+%20control.pdf @@ -73,38 +73,36 @@ json_value(null) --> "null". Maybe at some point in the future we'll have a library that takes a pure logic character parsing/generating DCG and 'injects' control strategy into it. We aren't there yet... */ json_object(EmptyAssoc) --> {empty_assoc(EmptyAssoc)}, "{", json_ws, "}". -json_object(Assoc) --> - { - nonvar(Assoc) -> - \+ empty_assoc(Assoc), - assoc_to_list(Assoc, [Pair|Pairs]) - ; true - }, - "{", - json_members([Pair|Pairs]), - "}", - { - var(Assoc) -> - list_to_assoc([Pair|Pairs], Assoc) - ; true - }. +json_object(Assoc) --> + { ( nonvar(Assoc) -> + \+ empty_assoc(Assoc), + assoc_to_list(Assoc, [Pair|Pairs]) + ; true + ) }, + "{", + json_members([Pair|Pairs]), + "}", + { ( var(Assoc) -> + list_to_assoc([Pair|Pairs], Assoc) + ; true + ) }. -json_members([Key-Value]) --> json_member(Key, Value). +json_members([Key-Value]) --> json_member(Key, Value). json_members([Key-Value | Pairs]) --> json_member(Key, Value), ",", json_members(Pairs). json_member(Key, Value) --> json_ws, json_string(Key), json_ws, ":", json_element(Value). -json_array([]) --> "[", json_ws, "]". +json_array([]) --> "[", json_ws, "]". json_array([Value|Values]) --> "[", json_elements([Value|Values]), "]". -json_elements([Value]) --> json_element(Value). +json_elements([Value]) --> json_element(Value). json_elements([Value|Values]) --> json_element(Value), ",", json_elements(Values). json_element(Value) --> json_ws, json_value(Value), json_ws. json_string(Chars) --> "\"", json_characters(Chars), "\"". -json_characters("") --> "". +json_characters("") --> "". json_characters([Char|Chars]) --> json_character(Char), json_characters(Chars). /* A directly printable character is defined by the JSON spec as a character between 0020 and 10FFFF except the @@ -114,114 +112,100 @@ json_characters([Char|Chars]) --> json_character(Char), json_characters(Chars). If we moved the block containing `char_code/2` up before `[PrintChar]`, we would still be able to generate JSON, but attempting to parse JSON would cause an instantiation error. */ escape_map([ - '"' - '"', - ('\\') - ('\\'), - ('/') - ('/'), - '\b' - 'b', - '\f' - 'f', - '\n' - 'n', - '\r' - 'r', - '\t' - 't' -]). + '"' - '"', + ('\\') - ('\\'), + ('/') - ('/'), + '\b' - 'b', + '\f' - 'f', + '\n' - 'n', + '\r' - 'r', + '\t' - 't' ]). -json_character(PrintChar) --> - [PrintChar], - { - escape_map(EscapeMap), - \+ member(PrintChar-_, EscapeMap), - char_code(PrintChar, PrintCharCode), - PrintCharCode in 32..1114111 /* 20.10FFFF */ - }. +json_character(PrintChar) --> + [PrintChar], + { escape_map(EscapeMap), + \+ member(PrintChar-_, EscapeMap), + char_code(PrintChar, PrintCharCode), + PrintCharCode in 32..1114111 /* 20.10FFFF */ }. json_character(EscapeChar) --> "\\", json_escape(EscapeChar). json_escape(EscapeChar) --> - [PrintChar], - { - escape_map(EscapeMap), - member(EscapeChar-PrintChar, EscapeMap) - }. + [PrintChar], + { escape_map(EscapeMap), + member(EscapeChar-PrintChar, EscapeMap) }. json_escape(EscapeChar) --> - "u", - { /* Logic: Define the domain of the escape character as well as the relationship between the escape character + "u", + /* Logic: Define the domain of the escape character as well as the relationship between the escape character and the four hexes */ - [H1, H2, H3, H4] ins 0..15, - EscapeCharCode in 0..65535, - EscapeCharCode #= H1 * 16^3 + H2 * 16^2 + H3 * 16 + H4 - }, - { /* Control: Get the code of the escape character if we can. Otherwise we'll end up backtracking over 65,536 - possible hex values. - Logic: Only the first 32 Unicode characters not escaped in the escape map are eligible for \u-escaping - when generating. However, we want to be able to parse any of the 65,536 \u-escaped values when parsing. */ - nonvar(EscapeChar) -> - char_code(EscapeChar, EscapeCharCode), - EscapeCharCode in 0..31, - escape_map(EscapeMap), - \+ member(EscapeChar-_, EscapeMap) - ; true - }, - json_hex(H1), - json_hex(H2), - json_hex(H3), - json_hex(H4), - { /* Control + Logic: Get the escape character atom from the character code computed from the hexes. */ - var(EscapeChar) -> - char_code(EscapeChar, EscapeCharCode) - ; true - }. + { [H1, H2, H3, H4] ins 0..15, + EscapeCharCode in 0..65535, + EscapeCharCode #= H1 * 16^3 + H2 * 16^2 + H3 * 16 + H4, + /* Control: Get the code of the escape character if we can. Otherwise we'll end up backtracking over 65,536 + possible hex values. + Logic: Only the first 32 Unicode characters not escaped in the escape map are eligible for \u-escaping + when generating. However, we want to be able to parse any of the 65,536 \u-escaped values when parsing. */ + ( nonvar(EscapeChar) -> + char_code(EscapeChar, EscapeCharCode), + EscapeCharCode in 0..31, + escape_map(EscapeMap), + \+ member(EscapeChar-_, EscapeMap) + ; true + ) + }, + json_hex(H1), + json_hex(H2), + json_hex(H3), + json_hex(H4), + /* Control + Logic: Get the escape character atom from the character code computed from the hexes. */ + { ( var(EscapeChar) -> + char_code(EscapeChar, EscapeCharCode) + ; true + ) }. json_hex(Digit) --> json_digit(Digit). -json_hex(10) --> "a". -json_hex(11) --> "b". -json_hex(12) --> "c". -json_hex(13) --> "d". -json_hex(14) --> "e". -json_hex(15) --> "f". -json_hex(10) --> "A". -json_hex(11) --> "B". -json_hex(12) --> "C". -json_hex(13) --> "D". -json_hex(14) --> "E". -json_hex(15) --> "F". +json_hex(10) --> "a". +json_hex(11) --> "b". +json_hex(12) --> "c". +json_hex(13) --> "d". +json_hex(14) --> "e". +json_hex(15) --> "f". +json_hex(10) --> "A". +json_hex(11) --> "B". +json_hex(12) --> "C". +json_hex(13) --> "D". +json_hex(14) --> "E". +json_hex(15) --> "F". /* Here we are going to write completely different DCGs for parsing and generating, and rely on built-in predicates. However, the underlying logic remains the same. */ json_number(Number) --> - { - nonvar(Number) -> - number_chars(Number, NumberChars) - ; false - }, + { ( nonvar(Number) -> + number_chars(Number, NumberChars) + ; false + ) }, NumberChars. json_number(Number) --> - { - var(Number) - }, + { var(Number) }, json_sign_noplus(Sign), json_integer(Integer), json_fraction(Fraction), json_exponent(Exponent), - { - Number is Sign * (Integer + Fraction) * 10.0 ^ Exponent - }. + { Number is Sign * (Integer + Fraction) * 10.0 ^ Exponent }. -json_integer(Digit) --> json_digit(Digit). +json_integer(Digit) --> json_digit(Digit). json_integer(TotalValue) --> json_onenine(FirstDigit), json_digits(RemainingValue, Power), - { - TotalValue #= FirstDigit * 10 ^ (Power + 1) + RemainingValue - }. + { TotalValue #= FirstDigit * 10 ^ (Power + 1) + RemainingValue }. -json_digits(Digit, 0) --> json_digit(Digit). +json_digits(Digit, 0) --> json_digit(Digit). json_digits(Value, Power) --> json_digit(FirstDigit), json_digits(RemainingValue, NextPower), - { - Power #= NextPower + 1, - Value #= FirstDigit * 10^Power + RemainingValue - }. + { Power #= NextPower + 1, + Value #= FirstDigit * 10^Power + RemainingValue }. -json_digit(0) --> "0". +json_digit(0) --> "0". json_digit(Digit) --> json_onenine(Digit). json_onenine(1) --> "1". @@ -234,31 +218,27 @@ json_onenine(7) --> "7". json_onenine(8) --> "8". json_onenine(9) --> "9". -json_fraction(0) --> "". +json_fraction(0) --> "". json_fraction(Fraction) --> ".", json_digits(Value, Power), - { - Fraction is Value / 10 ^ (Power + 1) - }. + { Fraction is Value / 10 ^ (Power + 1) }. -json_exponent(0) --> "". +json_exponent(0) --> "". json_exponent(Exponent) --> json_exponent_signifier, json_sign(Sign), json_digits(Value, _), - { - Exponent #= Sign * Value - }. + { Exponent #= Sign * Value }. json_exponent_signifier --> "E". json_exponent_signifier --> "e". -json_sign_noplus(1) --> "". +json_sign_noplus(1) --> "". json_sign_noplus(-1) --> "-". json_sign(Sign) --> json_sign_noplus(Sign). -json_sign(1) --> "+". +json_sign(1) --> "+". json_ws --> "". json_ws --> " ", json_ws. From c0c6f13d4400329cdaddbccd2cafe13d275496ab Mon Sep 17 00:00:00 2001 From: panasenco Date: Mon, 19 Apr 2021 14:57:15 -0700 Subject: [PATCH 06/11] Fixed defaulty representations of json_members//1 and json_elements//1 --- src/lib/json.pl | 44 +++++++++++++++++++++++++++++++++++++++----- 1 file changed, 39 insertions(+), 5 deletions(-) diff --git a/src/lib/json.pl b/src/lib/json.pl index 959f6b45..1b0340f6 100644 --- a/src/lib/json.pl +++ b/src/lib/json.pl @@ -63,8 +63,16 @@ json_value(boolean(true)) --> "true". json_value(boolean(false)) --> "false". json_value(null) --> "null". -/* Read Bob Kowalski's "Algorithm = Logic + Control": +/* Note on variable instantiation checks (`var/1` and `nonvar/1`) used below and in Prolog in general. + Instantiation checks should never ever be used to change the logic of your program! Instead, they are one of + many tools to adjust the 'control' or 'search strategy' used by Prolog to execute the logic of your program. + Control tweaks are used for the following: + - Prevent instantiation errors. + - Prevent nontermination. + - Improve the time complexity of execution (e.g. from superexponential to linear). + For a general overview of the idea, read Bob Kowalski's "Algorithm = Logic + Control": https://www.doc.ic.ac.uk/~rak/papers/algorithm%20=%20logic%20+%20control.pdf + For an introduction to search strategies in Prolog, read: https://www.metalevel.at/prolog/sorting#searching This DCG definition does two things: 1. Logic: Relate an association list to a JSON object serialized in a string. 2. Control: Define the exact strategy by which we obtain an association list from a JSON string and vice versa. @@ -87,16 +95,42 @@ json_object(Assoc) --> ; true ) }. -json_members([Key-Value]) --> json_member(Key, Value). -json_members([Key-Value | Pairs]) --> json_member(Key, Value), ",", json_members(Pairs). + +/* Why have both `json_members//1` and `json_members_//2`? Wouldn't it be less confusing to have just + `json_members//1`? + In fact in the first version of the code there was just this simple definition of `json_members//1`: + ``` + json_members([Key-Value]) --> json_member(Key, Value). + json_members([Key-Value | Pairs]) --> json_member(Key, Value), ",", json_members(Pairs). + ``` + The problem with this definition was that there's no way for Prolog to distinguish between the two DCG heads, + because [Key-Value] unifies with [Key-Value|[]], which unifies with [Key-Value|Pairs]. + Therefore, such a representation is defaulty, and is actually misleading because when you look at it you think + that a list with only one pair would apply to only the first definition, but it actually applies to both! + For more info on clean vs defaulty representations, read: https://www.metalevel.at/prolog/data#clean + The below definition, while longer, cleanly distinguishes member lists with just one value from member lists + with two or more values. + */ +json_members([Pair|Pairs]) --> json_members_(Pairs, Pair). + +json_members_([], Key-Value) --> json_member(Key, Value). +json_members_([NextPair|Pairs], Key-Value) --> + json_member(Key, Value), + ",", + json_members_(Pairs, NextPair). json_member(Key, Value) --> json_ws, json_string(Key), json_ws, ":", json_element(Value). json_array([]) --> "[", json_ws, "]". json_array([Value|Values]) --> "[", json_elements([Value|Values]), "]". -json_elements([Value]) --> json_element(Value). -json_elements([Value|Values]) --> json_element(Value), ",", json_elements(Values). +json_elements([Value|Values]) --> json_elements_(Values, Value). + +json_elements_([], Value) --> json_element(Value). +json_elements_([NextValue|Values], Value) --> + json_element(Value), + ",", + json_elements_(Values, NextValue). json_element(Value) --> json_ws, json_value(Value), json_ws. From 5b1b12ec9e5df91f8c8e3897b588244ae9873bfc Mon Sep 17 00:00:00 2001 From: panasenco Date: Mon, 19 Apr 2021 21:46:11 -0700 Subject: [PATCH 07/11] Fixed forward slash special case issue, added a bunch of test files that were successfully read! --- src/lib/json.pl | 10 ++-- src/tests/json/fail_bigint.json | 1 + src/tests/json/pass_alnum.json | 1 + src/tests/json/pass_bigfloat.json | 1 + src/tests/json/pass_everything.json | 56 ++++++++++++++++++++++ src/tests/json/pass_forward_slash.json | 1 + src/tests/json/pass_hex.json | 1 + src/tests/json/pass_mandatory_escapes.json | 1 + src/tests/json/pass_null.json | 1 + src/tests/json/pass_smallfloat.json | 1 + src/tests/json/pass_special.json | 1 + 11 files changed, 72 insertions(+), 3 deletions(-) create mode 100644 src/tests/json/fail_bigint.json create mode 100644 src/tests/json/pass_alnum.json create mode 100644 src/tests/json/pass_bigfloat.json create mode 100644 src/tests/json/pass_everything.json create mode 100644 src/tests/json/pass_forward_slash.json create mode 100644 src/tests/json/pass_hex.json create mode 100644 src/tests/json/pass_mandatory_escapes.json create mode 100644 src/tests/json/pass_null.json create mode 100644 src/tests/json/pass_smallfloat.json create mode 100644 src/tests/json/pass_special.json diff --git a/src/lib/json.pl b/src/lib/json.pl index 1b0340f6..a134d30a 100644 --- a/src/lib/json.pl +++ b/src/lib/json.pl @@ -148,7 +148,7 @@ json_characters([Char|Chars]) --> json_character(Char), json_characters(Chars). escape_map([ '"' - '"', ('\\') - ('\\'), - ('/') - ('/'), + ('/') - ('/'), /* Forward slash parsed with or without a preceding backslash, but always generated with. */ '\b' - 'b', '\f' - 'f', '\n' - 'n', @@ -156,9 +156,13 @@ escape_map([ '\t' - 't' ]). json_character(PrintChar) --> + { ( nonvar(PrintChar) -> + dif(PrintChar, '/') /* Don't generate forward slash without preceding backslash */ + ; true + ) }, [PrintChar], - { escape_map(EscapeMap), - \+ member(PrintChar-_, EscapeMap), + { dif(PrintChar, '"'), + dif(PrintChar, '\\'), char_code(PrintChar, PrintCharCode), PrintCharCode in 32..1114111 /* 20.10FFFF */ }. json_character(EscapeChar) --> "\\", json_escape(EscapeChar). diff --git a/src/tests/json/fail_bigint.json b/src/tests/json/fail_bigint.json new file mode 100644 index 00000000..09c33d95 --- /dev/null +++ b/src/tests/json/fail_bigint.json @@ -0,0 +1 @@ +23456789012E666 diff --git a/src/tests/json/pass_alnum.json b/src/tests/json/pass_alnum.json new file mode 100644 index 00000000..b37bf501 --- /dev/null +++ b/src/tests/json/pass_alnum.json @@ -0,0 +1 @@ +"ABCDEFGHIJKLMNOPQRSTUVWYZabcdefghijklmnopqrstuvwyz0123456789" diff --git a/src/tests/json/pass_bigfloat.json b/src/tests/json/pass_bigfloat.json new file mode 100644 index 00000000..1c996bda --- /dev/null +++ b/src/tests/json/pass_bigfloat.json @@ -0,0 +1 @@ +1.234567890E+34 diff --git a/src/tests/json/pass_everything.json b/src/tests/json/pass_everything.json new file mode 100644 index 00000000..086b5562 --- /dev/null +++ b/src/tests/json/pass_everything.json @@ -0,0 +1,56 @@ +[ + "JSON Test Pattern pass1", + {"object with 1 member":["array with 1 element"]}, + {}, + [], + -42, + true, + false, + null, + { + "integer": 1234567890, + "real": -9876.543210, + "e": 0.123456789e-12, + "E": 1.234567890E+34, + "": 23456789012E66, + "zero": 0, + "one": 1, + "space": " ", + "quote": "\"", + "backslash": "\\", + "controls": "\b\f\n\r\t", + "slash": "/ & \/", + "alpha": "abcdefghijklmnopqrstuvwyz", + "ALPHA": "ABCDEFGHIJKLMNOPQRSTUVWYZ", + "digit": "0123456789", + "special": "`1~!@#$%^&*()_+-={':[,]}|;.?", + "hex": "\u0123\u4567\u89AB\uCDEF\uabcd\uef4A", + "true": true, + "false": false, + "null": null, + "array":[ ], + "object":{ }, + "address": "50 St. James Street", + "url": "http://www.JSON.org/", + "comment": "// /* */": " ", + " s p a c e d " :[1,2 , 3 + +, + +4 , 5 , 6 ,7 ], + "compact": [1,2,3,4,5,6,7], + "jsontext": "{\"object with 1 member\":[\"array with 1 element\"]}", + "quotes": "" \u0022 %22 0x22 034 "", + "\/\\\"\uCAFE\uBABE\uAB98\uFCDE\ubcda\uef4A\b\f\n\r\t`1~!@#$%^&*()_+-=[]{}|;:',./<>?" +: "A key can be any string" + }, + 0.5 ,98.6 +, +99.44 +, + +1066 + + +,"rosebud"] diff --git a/src/tests/json/pass_forward_slash.json b/src/tests/json/pass_forward_slash.json new file mode 100644 index 00000000..803b3248 --- /dev/null +++ b/src/tests/json/pass_forward_slash.json @@ -0,0 +1 @@ +"/ & \/" diff --git a/src/tests/json/pass_hex.json b/src/tests/json/pass_hex.json new file mode 100644 index 00000000..e33d13b8 --- /dev/null +++ b/src/tests/json/pass_hex.json @@ -0,0 +1 @@ +"\u0123\u4567\u89AB\uCDEF\uabcd\uef4A" diff --git a/src/tests/json/pass_mandatory_escapes.json b/src/tests/json/pass_mandatory_escapes.json new file mode 100644 index 00000000..7a3191ba --- /dev/null +++ b/src/tests/json/pass_mandatory_escapes.json @@ -0,0 +1 @@ +" \" \\ \b\f\n\r\t " diff --git a/src/tests/json/pass_null.json b/src/tests/json/pass_null.json new file mode 100644 index 00000000..19765bd5 --- /dev/null +++ b/src/tests/json/pass_null.json @@ -0,0 +1 @@ +null diff --git a/src/tests/json/pass_smallfloat.json b/src/tests/json/pass_smallfloat.json new file mode 100644 index 00000000..85a4e511 --- /dev/null +++ b/src/tests/json/pass_smallfloat.json @@ -0,0 +1 @@ +0.123456789e-12 diff --git a/src/tests/json/pass_special.json b/src/tests/json/pass_special.json new file mode 100644 index 00000000..dbb9e9c7 --- /dev/null +++ b/src/tests/json/pass_special.json @@ -0,0 +1 @@ +"`1~!@#$%^&*()_+-={':[,]}|;.?" From c87e3eac080a526964597de8e2cda96d899f450a Mon Sep 17 00:00:00 2001 From: panasenco Date: Tue, 20 Apr 2021 16:58:33 -0700 Subject: [PATCH 08/11] Removed CLP(Z) from library(json), achieving a 100x speedup in JSON parsing. --- Dockerfile | 1 - src/lib/json.pl | 30 ++++++++++++++---------------- src/tests/json/README.md | 13 +++++++++++++ src/tests/json/test_json.pl | 27 +++++++++++++++++++++++++++ 4 files changed, 54 insertions(+), 17 deletions(-) create mode 100644 src/tests/json/README.md create mode 100644 src/tests/json/test_json.pl diff --git a/Dockerfile b/Dockerfile index a2469ebc..87cf1aee 100755 --- a/Dockerfile +++ b/Dockerfile @@ -18,7 +18,6 @@ COPY --from=cacher $CARGO_HOME $CARGO_HOME RUN cargo build --release --bin scryer-prolog FROM debian:stable-slim -WORKDIR scryer-prolog COPY --from=builder /scryer-prolog/target/release/scryer-prolog /usr/local/bin ENV RUST_BACKTRACE=1 ENTRYPOINT ["/usr/local/bin/scryer-prolog"] diff --git a/src/lib/json.pl b/src/lib/json.pl index a134d30a..218152e2 100644 --- a/src/lib/json.pl +++ b/src/lib/json.pl @@ -40,7 +40,6 @@ :- use_module(library(assoc)). :- use_module(library(between)). :- use_module(library(charsio)). -:- use_module(library(clpz)). :- use_module(library(dcgs)). :- use_module(library(dif)). :- use_module(library(error)). @@ -164,7 +163,7 @@ json_character(PrintChar) --> { dif(PrintChar, '"'), dif(PrintChar, '\\'), char_code(PrintChar, PrintCharCode), - PrintCharCode in 32..1114111 /* 20.10FFFF */ }. + PrintCharCode >= 32 /* 20.10FFFF */ }. json_character(EscapeChar) --> "\\", json_escape(EscapeChar). json_escape(EscapeChar) --> @@ -173,29 +172,28 @@ json_escape(EscapeChar) --> member(EscapeChar-PrintChar, EscapeMap) }. json_escape(EscapeChar) --> "u", - /* Logic: Define the domain of the escape character as well as the relationship between the escape character - and the four hexes */ - { [H1, H2, H3, H4] ins 0..15, - EscapeCharCode in 0..65535, - EscapeCharCode #= H1 * 16^3 + H2 * 16^2 + H3 * 16 + H4, - /* Control: Get the code of the escape character if we can. Otherwise we'll end up backtracking over 65,536 + { /* Control: Get the code of the escape character if we can. Otherwise we'll end up backtracking over 65,536 possible hex values. Logic: Only the first 32 Unicode characters not escaped in the escape map are eligible for \u-escaping when generating. However, we want to be able to parse any of the 65,536 \u-escaped values when parsing. */ ( nonvar(EscapeChar) -> char_code(EscapeChar, EscapeCharCode), - EscapeCharCode in 0..31, + EscapeCharCode < 32, escape_map(EscapeMap), - \+ member(EscapeChar-_, EscapeMap) + \+ member(EscapeChar-_, EscapeMap), + H1 = 0, + H2 = 0, + H3 is EscapeCharCode // 16, + H4 is EscapeCharCode mod 16 ; true - ) - }, + ) }, json_hex(H1), json_hex(H2), json_hex(H3), json_hex(H4), /* Control + Logic: Get the escape character atom from the character code computed from the hexes. */ { ( var(EscapeChar) -> + EscapeCharCode is H1 * 16^3 + H2 * 16^2 + H3 * 16 + H4, char_code(EscapeChar, EscapeCharCode) ; true ) }. @@ -234,14 +232,14 @@ json_integer(Digit) --> json_digit(Digit). json_integer(TotalValue) --> json_onenine(FirstDigit), json_digits(RemainingValue, Power), - { TotalValue #= FirstDigit * 10 ^ (Power + 1) + RemainingValue }. + { TotalValue is FirstDigit * 10 ^ (Power + 1) + RemainingValue }. json_digits(Digit, 0) --> json_digit(Digit). json_digits(Value, Power) --> json_digit(FirstDigit), json_digits(RemainingValue, NextPower), - { Power #= NextPower + 1, - Value #= FirstDigit * 10^Power + RemainingValue }. + { Power is NextPower + 1, + Value is FirstDigit * 10^Power + RemainingValue }. json_digit(0) --> "0". json_digit(Digit) --> json_onenine(Digit). @@ -267,7 +265,7 @@ json_exponent(Exponent) --> json_exponent_signifier, json_sign(Sign), json_digits(Value, _), - { Exponent #= Sign * Value }. + { Exponent is Sign * Value }. json_exponent_signifier --> "E". json_exponent_signifier --> "e". diff --git a/src/tests/json/README.md b/src/tests/json/README.md new file mode 100644 index 00000000..a8347528 --- /dev/null +++ b/src/tests/json/README.md @@ -0,0 +1,13 @@ +## Benchmarks + +### With CLP(Z): +``` +?- test_json_read. + % CPU time: 41.522 seconds +``` + +### After removing CLP(Z): +``` +?- test_json_read. + % CPU time: 0.444 seconds +``` diff --git a/src/tests/json/test_json.pl b/src/tests/json/test_json.pl new file mode 100644 index 00000000..ff196911 --- /dev/null +++ b/src/tests/json/test_json.pl @@ -0,0 +1,27 @@ +:- module(test_json, [test_json_read/0]). + +:- use_module(library(json)). +:- use_module(library(lists)). +:- use_module(library(os)). +:- use_module(library(pio)). +:- use_module(library(time)). + +test_path(TestName, TestPath) :- + getenv("SCRYER_JSON_TESTS_PATH", JsonPath), + append(JsonPath, TestName, TestPathChars), + atom_chars(TestPath, TestPathChars). + +name_parse(Name, Json) :- + test_path(Name, Path), + once(phrase_from_file(json_chars(Json), Path)). + +test_json_read :- + name_parse("pass_null.json", _), + name_parse("pass_alnum.json", _), + name_parse("pass_special.json", _), + name_parse("pass_mandatory_escapes.json", _), + name_parse("pass_forward_slash.json", _), + name_parse("pass_hex.json", _), + name_parse("pass_smallfloat.json", _), + name_parse("pass_bigfloat.json", _), + time(name_parse("pass_everything.json", _)). From 7e802706fe90b70aadf965bf0d51cc3464e15992 Mon Sep 17 00:00:00 2001 From: panasenco Date: Tue, 20 Apr 2021 17:26:38 -0700 Subject: [PATCH 09/11] Seem to be generating JSON correctly and at a good speed too! --- src/tests/json/pass_everything.json | 2 +- src/tests/json/pass_everything.min.json | 1 + src/tests/json/test_json.pl | 13 ++++++++++++- 3 files changed, 14 insertions(+), 2 deletions(-) create mode 100644 src/tests/json/pass_everything.min.json diff --git a/src/tests/json/pass_everything.json b/src/tests/json/pass_everything.json index 086b5562..35d7ea34 100644 --- a/src/tests/json/pass_everything.json +++ b/src/tests/json/pass_everything.json @@ -24,7 +24,7 @@ "ALPHA": "ABCDEFGHIJKLMNOPQRSTUVWYZ", "digit": "0123456789", "special": "`1~!@#$%^&*()_+-={':[,]}|;.?", - "hex": "\u0123\u4567\u89AB\uCDEF\uabcd\uef4A", + "hex": "\u0123\u4567\u89AB\u0001\uCDEF\uabcd\u001A\uef4A", "true": true, "false": false, "null": null, diff --git a/src/tests/json/pass_everything.min.json b/src/tests/json/pass_everything.min.json new file mode 100644 index 00000000..85cf7acb --- /dev/null +++ b/src/tests/json/pass_everything.min.json @@ -0,0 +1 @@ +["JSON Test Pattern pass1",{"object with 1 member":["array with 1 element"]},{},[],-42.0,true,false,null,{"":23456789011999997000000000000000000000000000000000000000000000000000000000000.0," s p a c e d ":[1.0,2.0,3.0,4.0,5.0,6.0,7.0],"# -- --> *\/":" ","\/\\\"쫾몾ꮘﳞ볚\b\f\n\r\t`1~!@#$%^&*()_+-=[]{}|;:',.\/<>?":"A key can be any string","ALPHA":"ABCDEFGHIJKLMNOPQRSTUVWYZ","E":12345678900000000000000000000000000.0,"address":"50 St. James Street","alpha":"abcdefghijklmnopqrstuvwyz","array":[],"backslash":"\\","comment":"\/\/ \/* json_integer(Integer), json_fraction(Fraction), json_exponent(Exponent), - { Number is Sign * (Integer + Fraction) * 10.0 ^ Exponent }. + { ( Exponent >= 0 -> + Base = 10 + ; Base = 10.0 + ), + Number is Sign * (Integer + Fraction) * Base ^ Exponent }. json_integer(Digit) --> json_digit(Digit). json_integer(TotalValue) --> diff --git a/src/tests/json/pass_everything.min.json b/src/tests/json/pass_everything.min.json index 85cf7acb..35137af4 100644 --- a/src/tests/json/pass_everything.min.json +++ b/src/tests/json/pass_everything.min.json @@ -1 +1 @@ -["JSON Test Pattern pass1",{"object with 1 member":["array with 1 element"]},{},[],-42.0,true,false,null,{"":23456789011999997000000000000000000000000000000000000000000000000000000000000.0," s p a c e d ":[1.0,2.0,3.0,4.0,5.0,6.0,7.0],"# -- --> *\/":" ","\/\\\"쫾몾ꮘﳞ볚\b\f\n\r\t`1~!@#$%^&*()_+-=[]{}|;:',.\/<>?":"A key can be any string","ALPHA":"ABCDEFGHIJKLMNOPQRSTUVWYZ","E":12345678900000000000000000000000000.0,"address":"50 St. James Street","alpha":"abcdefghijklmnopqrstuvwyz","array":[],"backslash":"\\","comment":"\/\/ \/* *\/":" ","\/\\\"쫾몾ꮘﳞ볚\b\f\n\r\t`1~!@#$%^&*()_+-=[]{}|;:',.\/<>?":"A key can be any string","ALPHA":"ABCDEFGHIJKLMNOPQRSTUVWYZ","E":12345678900000000000000000000000000.0,"address":"50 St. James Street","alpha":"abcdefghijklmnopqrstuvwyz","array":[],"backslash":"\\","comment":"\/\/ \/* json_element(Internal). /* Because it's impossible to distinguish between an empty array [] and an empty string "", we distinguish between different types of values based on their principal functor. The principal functors match the types defined in the JSON Schema spec here: https://json-schema.org/draft/2020-12/json-schema-validation.html#rfc.section.6.1.1 - Down the line we'll incorporate more JSON Schema support, but this is it for now. */ + EXCEPT we don't yet support the integer type. There are plans for more JSON Schema support in the near future. */ json_value(object(Assoc)) --> json_object(Assoc). json_value(array(List)) --> json_array(List). json_value(string(Chars)) --> json_string(Chars). json_value(number(Number)) --> json_number(Number). -json_value(boolean(true)) --> "true". -json_value(boolean(false)) --> "false". +json_value(boolean(Bool)) --> json_boolean(Bool). json_value(null) --> "null". -/* Note on variable instantiation checks (`var/1` and `nonvar/1`) used below and in Prolog in general. - Instantiation checks should never ever be used to change the logic of your program! Instead, they are one of - many tools to adjust the 'control' or 'search strategy' used by Prolog to execute the logic of your program. - Control tweaks are used for the following: - - Prevent instantiation errors. - - Prevent nontermination. - - Improve the time complexity of execution (e.g. from superexponential to linear). - For a general overview of the idea, read Bob Kowalski's "Algorithm = Logic + Control": - https://www.doc.ic.ac.uk/~rak/papers/algorithm%20=%20logic%20+%20control.pdf - For an introduction to search strategies in Prolog, read: https://www.metalevel.at/prolog/sorting#searching - This DCG definition does two things: - 1. Logic: Relate an association list to a JSON object serialized in a string. - 2. Control: Define the exact strategy by which we obtain an association list from a JSON string and vice versa. - This is done via instantiation checks `var/1` and `nonvar/1`. - Unfortunately, the logic and control in this DCG aren't separated cleanly like Bob Kowalski proposed. - Maybe at some point in the future we'll have a library that takes a pure logic character parsing/generating DCG - and 'injects' control strategy into it. We aren't there yet... */ -json_object(EmptyAssoc) --> {empty_assoc(EmptyAssoc)}, "{", json_ws, "}". -json_object(Assoc) --> - { ( nonvar(Assoc) -> - \+ empty_assoc(Assoc), - assoc_to_list(Assoc, [Pair|Pairs]) - ; true - ) }, +/* We pull json_boolean out into its own predicate in order to take advantage of first argument indexing and not leave + choice points. For more details, watch this video on decomposing arguments: https://youtu.be/FZLofckPu4A?t=1648 */ +json_boolean(true) --> "true". +json_boolean(false) --> "false". + +json_object([]) --> "{", json_ws, "}". +json_object([Pair|Pairs]) --> "{", - json_members([Pair|Pairs]), - "}", - { ( var(Assoc) -> - list_to_assoc([Pair|Pairs], Assoc) - ; true - ) }. + json_members(Pairs, Pair), + "}". - -/* Why have both `json_members//1` and `json_members_//2`? Wouldn't it be less confusing to have just - `json_members//1`? - In fact in the first version of the code there was just this simple definition of `json_members//1`: +/* `json_members//2` below is implemented with a lagged argument to take advantage of first argument indexing. + This is a pure performance-driven decision that doesn't affect the logic. The predicate could equivalently be + implementes as `json_members//1` below: ``` - json_members([Key-Value]) --> json_member(Key, Value). - json_members([Key-Value | Pairs]) --> json_member(Key, Value), ",", json_members(Pairs). + json_members([Key-Value]) --> json_member(Key, Value). + json_members([Key-Value, Pair2 | Pairs]) --> json_member(Key, Value), ",", json_members([Pair2 | Pairs]). ``` - The problem with this definition was that there's no way for Prolog to distinguish between the two DCG heads, - because [Key-Value] unifies with [Key-Value|[]], which unifies with [Key-Value|Pairs]. - Therefore, such a representation is defaulty, and is actually misleading because when you look at it you think - that a list with only one pair would apply to only the first definition, but it actually applies to both! - For more info on clean vs defaulty representations, read: https://www.metalevel.at/prolog/data#clean - The below definition, while longer, cleanly distinguishes member lists with just one value from member lists - with two or more values. + That's a logically equivalent and equally clean representation to the lagged argument. However, it leaves + choice points, while using the lagged argument doesn't. For more info, watch: https://youtu.be/FZLofckPu4A?t=1737 */ -json_members([Pair|Pairs]) --> json_members_(Pairs, Pair). - -json_members_([], Key-Value) --> json_member(Key, Value). -json_members_([NextPair|Pairs], Key-Value) --> +json_members([], Key-Value) --> json_member(Key, Value). +json_members([NextPair|Pairs], Key-Value) --> json_member(Key, Value), ",", - json_members_(Pairs, NextPair). + json_members(Pairs, NextPair). json_member(Key, Value) --> json_ws, json_string(Key), json_ws, ":", json_element(Value). json_array([]) --> "[", json_ws, "]". -json_array([Value|Values]) --> "[", json_elements([Value|Values]), "]". +json_array([Value|Values]) --> "[", json_elements(Values, Value), "]". -json_elements([Value|Values]) --> json_elements_(Values, Value). - -json_elements_([], Value) --> json_element(Value). -json_elements_([NextValue|Values], Value) --> +/* Also using a lagged argument with `json_elements//2` to take advantage of first-argument indexing */ +json_elements([], Value) --> json_element(Value). +json_elements([NextValue|Values], Value) --> json_element(Value), ",", - json_elements_(Values, NextValue). + json_elements(Values, NextValue). json_element(Value) --> json_ws, json_value(Value), json_ws. @@ -138,49 +107,55 @@ json_string(Chars) --> "\"", json_characters(Chars), "\"". json_characters("") --> "". json_characters([Char|Chars]) --> json_character(Char), json_characters(Chars). -/* A directly printable character is defined by the JSON spec as a character between 0020 and 10FFFF except the - escaped characters. - Note that `char_code/2` throws an instantiation error if both its arguments are undefined, so we delay - calling it until we've seen both the generating and the parsing sides of the DCG. - If we moved the block containing `char_code/2` up before `[PrintChar]`, we would still be able to generate JSON, - but attempting to parse JSON would cause an instantiation error. */ -escape_map([ - '"' - '"', - ('\\') - ('\\'), - ('/') - ('/'), /* Forward slash parsed with or without a preceding backslash, but always generated with. */ - '\b' - 'b', - '\f' - 'f', - '\n' - 'n', - '\r' - 'r', - '\t' - 't' ]). +letter_escape('"', '"'). +letter_escape('\\', '\\'). +letter_escape('/', '/'). +letter_escape('\b', 'b'). +letter_escape('\f', 'f'). +letter_escape('\n', 'n'). +letter_escape('\r', 'r'). +letter_escape('\t', 't'). -json_character(PrintChar) --> - { ( nonvar(PrintChar) -> - dif(PrintChar, '/') /* Don't generate forward slash without preceding backslash */ +/* Note on variable instantiation checks (`var/1` and `nonvar/1`) used below and in Prolog in general. + Instantiation checks should ideally never be used to change the logic of your program. Instead, they are one of + many tools to adjust the 'control' or 'search strategy' used by Prolog to execute the logic of your program. + For a general overview of the idea, read Bob Kowalski's "Algorithm = Logic + Control": + https://www.doc.ic.ac.uk/~rak/papers/algorithm%20=%20logic%20+%20control.pdf + For an introduction to search strategies in Prolog, read: https://www.metalevel.at/prolog/sorting#searching + However, when dealing with a real-world data format standard, real differences arise in how a string should be + parsed vs generated. Usually, parsing should allow multiple ways of doing things, while generating should only + happen in one best way. + JSON characters are parsed/generated in one of three ways: + 1. Directly. All characters in the range 20.10FFFF, except '"' and '\\' must be generated and parsed directly, + escape for the forward slash '/', which must not be generated directly, but can be parsed directly. + 2. Backslash followed by a single special character defined in the escape map - both parsing and generating. + 3. Backslash followed by 'u' and 4 hex values defining the character code of the internal character. + When generating, only allow range 0.20 excepting characters in the escape map. + When parsing, allow any value. + In order to take advantage of first argument indexing, we must reify this distinction in a single predicate. */ +json_character(InternalChar) --> + { ( nonvar(InternalChar) -> + ( letter_escape(InternalChar, _) -> + Type = letter_escape + ; char_code(InternalChar, InternalCharCode), + ( InternalCharCode >= 32 -> + Type = direct + ; Type = hex_escape + ) + ) ; true ) }, - [PrintChar], - { dif(PrintChar, '"'), - dif(PrintChar, '\\'), - char_code(PrintChar, PrintCharCode), - PrintCharCode >= 32 /* 20.10FFFF */ }. -json_character(EscapeChar) --> "\\", json_escape(EscapeChar). + json_character(Type, InternalChar). -json_escape(EscapeChar) --> - [PrintChar], - { escape_map(EscapeMap), - member(EscapeChar-PrintChar, EscapeMap) }. -json_escape(EscapeChar) --> - "u", - { /* Control: Get the code of the escape character if we can. Otherwise we'll end up backtracking over 65,536 - possible hex values. - Logic: Only the first 32 Unicode characters not escaped in the escape map are eligible for \u-escaping - when generating. However, we want to be able to parse any of the 65,536 \u-escaped values when parsing. */ - ( nonvar(EscapeChar) -> +json_character(direct, PrintChar) --> [PrintChar]. +json_character(letter_escape, EscapeChar) --> + { letter_escape(EscapeChar, PrintChar) }, + "\\", + [PrintChar]. +json_character(hex_escape, EscapeChar) --> + "\\u", + { ( nonvar(EscapeChar) -> char_code(EscapeChar, EscapeCharCode), - EscapeCharCode < 32, - escape_map(EscapeMap), - \+ member(EscapeChar-_, EscapeMap), H1 = 0, H2 = 0, H3 is EscapeCharCode // 16, @@ -191,62 +166,69 @@ json_escape(EscapeChar) --> json_hex(H2), json_hex(H3), json_hex(H4), - /* Control + Logic: Get the escape character atom from the character code computed from the hexes. */ { ( var(EscapeChar) -> EscapeCharCode is H1 * 16^3 + H2 * 16^2 + H3 * 16 + H4, char_code(EscapeChar, EscapeCharCode) ; true ) }. -json_hex(Digit) --> json_digit(Digit). -json_hex(10) --> "a". -json_hex(11) --> "b". -json_hex(12) --> "c". -json_hex(13) --> "d". -json_hex(14) --> "e". -json_hex(15) --> "f". -json_hex(10) --> "A". -json_hex(11) --> "B". -json_hex(12) --> "C". -json_hex(13) --> "D". -json_hex(14) --> "E". -json_hex(15) --> "F". +json_hex(Value) --> + { ( nonvar(Value) -> + ( between(0, 9, Value) -> + Code is Value + 48 + ; ( between(10, 15, Value) -> + Code is Value + 87 + ; false + ) + ), + char_code(Char, Code) + ; true + ) + }, + [Char], + { ( var(Value) -> + char_code(Char, Code), + ( between(48, 57, Code) -> + Value is Code - 48 + ; ( between(65, 70, Code) -> + Value is Code - 55 + ; ( between(97, 102, Code) -> + Value is Code - 87 + ; false + ) + ) + ) + ; true + ) }. -/* Here we are going to write completely different DCGs for parsing and generating, and rely on built-in - predicates. However, the underlying logic remains the same. */ +/* Here we are going to simply rely on `number_chars/2` when generating. */ json_number(Number) --> - { ( nonvar(Number) -> - number_chars(Number, NumberChars) - ; false - ) }, - NumberChars. -json_number(Number) --> - { var(Number) }, - json_sign_noplus(Sign), - json_integer(Integer), - json_fraction(Fraction), - json_exponent(Exponent), - { ( Exponent >= 0 -> - Base = 10 - ; Base = 10.0 - ), - Number is Sign * (Integer + Fraction) * Base ^ Exponent }. + ( { nonvar(Number) } -> + { number_chars(Number, NumberChars) }, + NumberChars + ; json_sign_noplus(Sign), + json_integer(Integer), + json_fraction(Fraction), + json_exponent(Exponent), + { ( Exponent >= 0 -> + Base = 10 + ; Base = 10.0 + ), + Number is Sign * (Integer + Fraction) * Base ^ Exponent } + ). json_integer(Digit) --> json_digit(Digit). json_integer(TotalValue) --> - json_onenine(FirstDigit), - json_digits(RemainingValue, Power), - { TotalValue is FirstDigit * 10 ^ (Power + 1) + RemainingValue }. + json_onenine(FirstDigit), + json_digits(RemainingValue, Power), + { TotalValue is FirstDigit * 10 ^ (Power + 1) + RemainingValue }. json_digits(Digit, 0) --> json_digit(Digit). json_digits(Value, Power) --> - json_digit(FirstDigit), - json_digits(RemainingValue, NextPower), - { Power is NextPower + 1, - Value is FirstDigit * 10^Power + RemainingValue }. - -json_digit(0) --> "0". -json_digit(Digit) --> json_onenine(Digit). + json_digit(FirstDigit), + json_digits(RemainingValue, NextPower), + { Power is NextPower + 1, + Value is FirstDigit * 10^Power + RemainingValue }. json_onenine(1) --> "1". json_onenine(2) --> "2". @@ -258,6 +240,17 @@ json_onenine(7) --> "7". json_onenine(8) --> "8". json_onenine(9) --> "9". +json_digit(0) --> "0". +json_digit(1) --> "1". +json_digit(2) --> "2". +json_digit(3) --> "3". +json_digit(4) --> "4". +json_digit(5) --> "5". +json_digit(6) --> "6". +json_digit(7) --> "7". +json_digit(8) --> "8". +json_digit(9) --> "9". + json_fraction(0) --> "". json_fraction(Fraction) --> ".", @@ -280,8 +273,6 @@ json_sign_noplus(-1) --> "-". json_sign(Sign) --> json_sign_noplus(Sign). json_sign(1) --> "+". +/* Make sure json_ws doesn't attempt to generate whitespace and succeeds without choicepoints when generating */ +json_ws --> [C], {nonvar(C), member(C, " \n\r\t")}, json_ws. json_ws --> "". -json_ws --> " ", json_ws. -json_ws --> "\n", json_ws. -json_ws --> "\r", json_ws. -json_ws --> "\t", json_ws. diff --git a/src/tests/json/README.md b/src/tests/json/README.md index a8347528..9450226e 100644 --- a/src/tests/json/README.md +++ b/src/tests/json/README.md @@ -1,13 +1,38 @@ ## Benchmarks -### With CLP(Z): +### Read + +With CLP(Z): + ``` -?- test_json_read. +?- test_json:test_json_read. % CPU time: 41.522 seconds ``` -### After removing CLP(Z): +After removing CLP(Z): + ``` -?- test_json_read. +?- test_json:test_json_read. % CPU time: 0.444 seconds ``` + +With first argument indexing optimizations: +``` +?- test_json:test_json_read. + % CPU time: 0.310 seconds +``` + +### Write + +Without first argument indexing optimizations: +``` +?- test_json:test_json_minify. + % CPU time: 0.014 seconds +``` + +With first argument indexing optimizations: + +``` +?- test_json:test_json_minify. + % CPU time: 0.015 seconds +``` diff --git a/src/tests/json/test_json.pl b/src/tests/json/test_json.pl index 85bf4774..31f748b3 100644 --- a/src/tests/json/test_json.pl +++ b/src/tests/json/test_json.pl @@ -34,7 +34,7 @@ test_json_minify :- read_line_to_chars(RefMin, RefChars, []), close(RefMin), name_parse("pass_everything.json", Json), - time(once(phrase(json_chars(Json), MinChars))), + time(phrase(json_chars(Json), MinChars)), RefChars = MinChars. test_json_int_float :-