288 lines
12 KiB
Prolog
288 lines
12 KiB
Prolog
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
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_chars//1
|
|
]).
|
|
|
|
:- use_module(library(assoc)).
|
|
:- use_module(library(between)).
|
|
:- use_module(library(charsio)).
|
|
:- use_module(library(dcgs)).
|
|
:- use_module(library(dif)).
|
|
:- use_module(library(error)).
|
|
:- 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
|
|
almost perfectly. Note that the McKeeman form conflicts some with the pictures on the left side. */
|
|
json_chars(Internal) --> 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. */
|
|
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".
|
|
|
|
/* 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
|
|
) },
|
|
"{",
|
|
json_members([Pair|Pairs]),
|
|
"}",
|
|
{ ( var(Assoc) ->
|
|
list_to_assoc([Pair|Pairs], Assoc)
|
|
; true
|
|
) }.
|
|
|
|
|
|
/* 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|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.
|
|
|
|
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' ]).
|
|
|
|
json_character(PrintChar) -->
|
|
{ ( nonvar(PrintChar) ->
|
|
dif(PrintChar, '/') /* Don't generate forward slash without preceding backslash */
|
|
; true
|
|
) },
|
|
[PrintChar],
|
|
{ dif(PrintChar, '"'),
|
|
dif(PrintChar, '\\'),
|
|
char_code(PrintChar, PrintCharCode),
|
|
PrintCharCode >= 32 /* 20.10FFFF */ }.
|
|
json_character(EscapeChar) --> "\\", json_escape(EscapeChar).
|
|
|
|
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) ->
|
|
char_code(EscapeChar, EscapeCharCode),
|
|
EscapeCharCode < 32,
|
|
escape_map(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
|
|
) }.
|
|
|
|
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),
|
|
{ ( 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_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_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 is 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.
|