Changed formatting to match Markus Triska's as much as I can tell
This commit is contained in:
@@ -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).
|
||||
|
||||
@@ -74,20 +74,18 @@ json_value(null) --> "null".
|
||||
and 'injects' control strategy into it. We aren't there yet... */
|
||||
json_object(EmptyAssoc) --> {empty_assoc(EmptyAssoc)}, "{", json_ws, "}".
|
||||
json_object(Assoc) -->
|
||||
{
|
||||
nonvar(Assoc) ->
|
||||
{ ( nonvar(Assoc) ->
|
||||
\+ empty_assoc(Assoc),
|
||||
assoc_to_list(Assoc, [Pair|Pairs])
|
||||
; true
|
||||
},
|
||||
) },
|
||||
"{",
|
||||
json_members([Pair|Pairs]),
|
||||
"}",
|
||||
{
|
||||
var(Assoc) ->
|
||||
{ ( var(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).
|
||||
@@ -121,53 +119,48 @@ escape_map([
|
||||
'\f' - 'f',
|
||||
'\n' - 'n',
|
||||
'\r' - 'r',
|
||||
'\t' - 't'
|
||||
]).
|
||||
'\t' - 't' ]).
|
||||
|
||||
json_character(PrintChar) -->
|
||||
[PrintChar],
|
||||
{
|
||||
escape_map(EscapeMap),
|
||||
{ escape_map(EscapeMap),
|
||||
\+ member(PrintChar-_, EscapeMap),
|
||||
char_code(PrintChar, PrintCharCode),
|
||||
PrintCharCode in 32..1114111 /* 20.10FFFF */
|
||||
}.
|
||||
PrintCharCode in 32..1114111 /* 20.10FFFF */ }.
|
||||
json_character(EscapeChar) --> "\\", json_escape(EscapeChar).
|
||||
|
||||
json_escape(EscapeChar) -->
|
||||
[PrintChar],
|
||||
{
|
||||
escape_map(EscapeMap),
|
||||
member(EscapeChar-PrintChar, EscapeMap)
|
||||
}.
|
||||
{ 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
|
||||
/* 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,
|
||||
{ [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
|
||||
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) ->
|
||||
( 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) ->
|
||||
/* 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".
|
||||
@@ -186,40 +179,31 @@ 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) ->
|
||||
{ ( 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(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(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(Digit) --> json_onenine(Digit).
|
||||
@@ -238,18 +222,14 @@ 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(Exponent) -->
|
||||
json_exponent_signifier,
|
||||
json_sign(Sign),
|
||||
json_digits(Value, _),
|
||||
{
|
||||
Exponent #= Sign * Value
|
||||
}.
|
||||
{ Exponent #= Sign * Value }.
|
||||
|
||||
json_exponent_signifier --> "E".
|
||||
json_exponent_signifier --> "e".
|
||||
|
||||
Reference in New Issue
Block a user