JSON parser in PascalScript

Question

Is there a JSON parser written in standard, procedural Pascal? There are a couple of object-oriented implementations in Delphi, but I need to do the parsing in PascalScript, and unfortunately classes cannot be declared in PascalScript.

In the future I will add the JSON parser to the Delphi host app, and JSON parsing will be the part of its PascalScript API, but I need something right now, which can be run directly from PascalScript.

Thanks!

=== UPDATE ===

There is another problem: PascalScript cannot handle pointers. So I should say what I need is a JSON parser not in Pascal, but in PascalScript (I changed the title of the question accordingly).

Why do you think you can't publish classes in PascalScript ? — TLama, Jun 18 '13 at 11:16
@TLama I can *publish* classes from host code, but I can't *declare* classes directly inside PascalScript code. — kol, Jun 18 '13 at 11:20
Well, but why would you need to define JSON parser class inside PascalScript code ? You'll just define it in host application and consume it in PascalScript. — TLama, Jun 18 '13 at 11:22
@TLama Yes, this is what I will do in the long term, but I don't have time to do it right now. The problem is a client needs to do JSON parsing *today*. — kol, Jun 18 '13 at 11:25
@kol - then this sounds more like a project management problem and not a programming problem. — J..., Jun 18 '13 at 11:35
@J..., the project has moved to [`http://code.google.com/p/jsonexpr`](http://code.google.com/p/jsonexpr). — TLama, Jun 18 '13 at 11:42
@J... Thank you, but the parser in jsonexpr is also an OO parser, not standard Pascal. — kol, Jun 18 '13 at 11:44
I'm not sure if this one from Synopse is OO or not, but have a look:[`Fast-JSON-parsing`](http://blog.synopse.info/post/2011/06/02/Fast-JSON-parsing). — LU RD, Jun 18 '13 at 11:47
@LURD It's not OO, but unfortunately PS cannot handle pointers, and the Synopse parser heavily uses pointers. I modified my question accordingly. — kol, Jun 18 '13 at 12:25
If your scripting engine was DWS, then there is a built-in JSON parser. — LU RD, Jun 18 '13 at 12:26
@LURD Our Synopse JSON parser is OO oriented, with some low-level functions (like `GetJSONField()`). *But* it is very optimized for speed and make extensive use of pointers (e.g. during in-place escaping, which is the main performance point of this parser). Therefore, I suspect it won't be a good candidate for conversion to PascalScript. — Arnaud Bouchez, Jun 18 '13 at 12:58
@ArnaudBouchez When I said it's not OO I was thinking of the low-level functions. Thanks, anyway! — kol, Jun 18 '13 at 13:03
I'm not sure why this is your problem and not your customer's. Before Embarcadero provided a JSON library with Delphi, we had to either write our own or use something someone else had written. Embarcadero was under no obligation to do that. Now, you're the one providing the development environment; it's not your job to write your customers' software for them. If it were, you wouldn't have included Pascal Script in your product because you could just write it all in ordinary Delphi instead. — Rob Kennedy, Jun 18 '13 at 13:36
@RobKennedy You're right. I've done my best to put a full-fledged PascalScript IDE into the app (it has syntax-highlighting, code-completion, breakpoints, variable inspection etc.), and it's really the user's job to use it to write his scripts. It's just that I would like to make my users happy :) — kol, Jun 18 '13 at 13:43

kol · Accepted Answer · 2013-06-19T07:24:05.310

As a quick-and-dirty solution, I translated Douglas Crockford's recursive descent parser into PascalScript. Since I couldn't use pointers or classes, I had to use dynamic arrays to store JSON values in a type-safe way.

JsonParser.pas:

type
  TJsonNumber = Double;
  TJsonString = WideString;
  TJsonChar = WideChar;
  TJsonWord = (JWUnknown, JWTrue, JWFalse, JWNull);
  TJsonValueKind = (JVKUnknown, JVKNumber, JVKString, JVKWord, JVKArray, JVKObject);
  TJsonValue = record
    Kind: TJsonValueKind;
    Index: Integer;
  end;
  TJsonArray = array of TJsonValue;
  TJsonPair = record
    Key: TJsonString;
    Value: TJsonValue;
  end;
  TJsonObject = array of TJsonPair;
  TJsonParserOutput = record
    Numbers: array of TJsonNumber;
    Strings: array of TJsonString;
    Words: array of TJsonWord;
    Arrays: array of TJsonArray;
    Objects: array of TJsonObject; // The root object is the first one
    Errors: array of TJsonString;
  end;
  TJsonParser = record
    At: Integer; // The index of the current character
    Ch: TJsonChar; // The current character
    Text: TJsonString;
    Output: TJsonParserOutput;
  end;
  TJsonValueParser = function (var JsonParser: TJsonParser): TJsonValue;

// Call error when something is wrong.
procedure Error(var JsonParser: TJsonParser; Msg: TJsonString);
var
  ErrorMsg: TJsonString;
  N: Integer;
begin
  ErrorMsg := Format('Error: "%s". Position: %d. Text: "%s"', [Msg, JsonParser.At, JsonParser.Text]);
  N := Length(JsonParser.Output.Errors);
  SetLength(JsonParser.Output.Errors, N + 1);
  JsonParser.Output.Errors[N] := ErrorMsg;
end;

function Next(var JsonParser: TJsonParser; C: TJsonChar): TJsonChar;
begin
  Result := #0;
  // If a non-#0 C parameter is provided, verify that it matches the current character.
  if (C <> #0) and (C <> JsonParser.Ch) then
  begin
    Error(JsonParser, 'Expected "' + C + '" instead of "' + JsonParser.Ch + '"');
    Exit;
  end;
  // Get the next character. When there are no more characters, return #0.
  if JsonParser.At > Length(JsonParser.Text) then
  begin
    JsonParser.Ch := #0;
    Exit;
  end;
  JsonParser.Ch := JsonParser.Text[JsonParser.At];
  Inc(JsonParser.At);
  Result := JsonParser.Ch;
end;

// Parse a number value.
function Number(var JsonParser: TJsonParser): Double;
var
  S: WideString;
begin
  Result := 0;
  S := '';
  if JsonParser.Ch = '-' then
  begin
    S := '-';
    Next(JsonParser, '-');
  end;
  while (JsonParser.Ch >= '0') and (JsonParser.Ch <= '9') do
  begin
    S := S + JsonParser.Ch;
    Next(JsonParser, #0);
  end;
  if JsonParser.Ch = '.' then
  begin
    S := S + '.';
    while (Next(JsonParser, #0) <> #0) and (JsonParser.Ch >= '0') and (JsonParser.Ch <= '9') do
      S := S + JsonParser.Ch;
  end;
  if (JsonParser.Ch = 'e') or (JsonParser.Ch = 'E') then
  begin
    S := S + JsonParser.Ch;
    Next(JSonParser, #0);
    if (JsonParser.Ch = '-') or (JsonParser.Ch = '+') then
    begin
      S := S + JsonParser.Ch;
      Next(JsonParser, #0);
    end;
    while (JsonParser.Ch >= '0') and (JsonParser.Ch <= '9') do
    begin
      S := S + JsonParser.Ch;
      Next(JsonParser, #0);
    end;
  end;
  if S = '' then
    Error(JsonParser, 'Bad number')
  else
    Result := StrToFloat(S);
end;

// Parse a string value.
function String_(var JsonParser: TJsonParser): TJsonString;
var
  HexDigit, HexValue: Integer;
  I: Integer;
  SpecChar: TJsonChar;
begin
  Result := '';
  // When parsing for string values, we must look for " and \ characters.
  if JsonParser.Ch = '"' then
  begin
    while Next(JsonParser, #0) <> #0 do
    begin
      if JsonParser.Ch = '"' then
      begin
        Next(JsonParser, #0);
        Exit;
      end;
      if JsonParser.Ch = '\' then
      begin
        Next(JsonParser, #0);
        if JsonParser.Ch = 'u' then
        begin
          HexValue := 0;
          for I := 1 to 4 do
          begin
            HexDigit := StrToInt('0x' + Next(JsonParser, #0));
            HexValue := HexValue * 16 + HexDigit;
          end;
          Result := Result + Chr(HexValue);
        end
        else
        begin
          case JsonParser.Ch of
            '"': SpecChar := '"';
            '\': SpecChar := '\';
            '/': SpecChar := '/';
            'b': SpecChar := #8;
            'f': SpecChar := #12;
            'n': SpecChar := #10;
            'r': SpecChar := #13;
            't': SpecChar := #9;
          else
            Break;
          end;
        end;
      end
      else 
        Result := Result + JsonParser.Ch;
    end;
  end;
  Error(JsonParser, 'Bad string');
end;

// Skip whitespace.
procedure White(var JsonParser: TJsonParser);
begin
  while (JsonParser.Ch <> #0) and (JsonParser.Ch <= ' ') do
    Next(JsonParser, #0);
end;

// true, false, or null.
function Word_(var JsonParser: TJsonParser): TJsonWord;
begin
  Result := JWUnknown;
  case JsonParser.Ch of
    't':
    begin
      Next(JsonParser, 't');
      Next(JsonParser, 'r');
      Next(JsonParser, 'u');
      Next(JsonParser, 'e');
      Result := JWTrue;
      Exit;
    end;
    'f':
    begin
      Next(JsonParser, 'f');
      Next(JsonParser, 'a');
      Next(JsonParser, 'l');
      Next(JsonParser, 's');
      Next(JsonParser, 'e');
      Result := JWFalse;
      Exit;
    end;
    'n':
    begin
      Next(JsonParser, 'n');
      Next(JsonParser, 'u');
      Next(JsonParser, 'l');
      Next(JsonParser, 'l');
      Result := JWNull;
      Exit;
    end;
  end;
  Error(JsonParser, 'Unexpected "' + JsonParser.Ch + '"');
end;

// Parse an array value.
function Array_(var JsonParser: TJsonParser; Value: TJsonValueParser): TJsonArray;
var
  N: Integer;
begin
  SetLength(Result, 0); // Empty array
  N := 0;
  if JsonParser.Ch = '[' then
  begin
    Next(JsonParser, '[');
    White(JsonParser);
    if JsonParser.Ch = ']' then
    begin
      Next(JsonParser, ']');
      Exit; // Return empty array
    end;
    while JsonParser.Ch <> #0 do
    begin
      Inc(N);
      SetLength(Result, N);
      Result[N - 1] := Value(JsonParser);
      White(JsonParser);
      if JsonParser.Ch = ']' then
      begin
        Next(JsonParser, ']');
        Exit;
      end;
      Next(JsonParser, ',');
      White(JsonParser);
    end;
  end;
  Error(JsonParser, 'Bad array');
end;

// Parse an object value.
function Object_(var JsonParser: TJsonParser; Value: TJsonValueParser): TJsonObject;
var
  Key: TJsonString;
  I, N: Integer;
begin
  SetLength(Result, 0); // Empty object
  N := 0;
  if JsonParser.Ch = '{' then
  begin
    Next(JsonParser, '{');
    White(JsonParser);
    if JsonParser.Ch = '}' then
    begin
      Next(JsonParser, '}');
      Exit; // Return empty object
    end;
    while JsonParser.Ch <> #0 do
    begin
      Key := String_(JsonParser);
      White(JsonParser);
      Next(JsonParser, ':');
      for I := 0 to N - 1 do
      begin
        if Key = Result[I].Key then
          Error(JsonParser, 'Duplicate key "' + Key + '"');
      end;
      Inc(N);
      SetLength(Result, N);
      Result[N - 1].Key := Key;
      Result[N - 1].Value := Value(JsonParser);
      White(JsonParser);
      if JsonParser.Ch = '}' then
      begin
        Next(JsonParser, '}');
        Exit;
      end;
      Next(JsonParser, ',');
      White(JsonParser);
    end;
  end;
  Error(JsonParser, 'Bad object');
end;

// Parse a JSON value. It could be a number, a string, a word, an array, or an object.
function Value(var JsonParser: TJsonParser): TJsonValue;
var
  N: Integer;
begin
  Result.Kind := JVKUnknown;
  Result.Index := -1;
  White(JsonParser);
  case JsonParser.Ch of
    '-', '0'..'9':
    begin
      N := Length(JsonParser.Output.Numbers);
      SetLength(JsonParser.Output.Numbers, N + 1);
      JsonParser.Output.Numbers[N] := Number(JsonParser);
      Result.Kind := JVKNumber;
      Result.Index := N;
    end;
    '"':
    begin
      N := Length(JsonParser.Output.Strings);
      SetLength(JsonParser.Output.Strings, N + 1);
      JsonParser.Output.Strings[N] := String_(JsonParser);
      Result.Kind := JVKString;
      Result.Index := N;
    end;
    't', 'f', 'n':
    begin
      N := Length(JsonParser.Output.Words);
      SetLength(JsonParser.Output.Words, N + 1);
      JsonParser.Output.Words[N] := Word_(JsonParser);
      Result.Kind := JVKWord;
      Result.Index := N;
    end;
    '[':
    begin
      N := Length(JsonParser.Output.Arrays);
      SetLength(JsonParser.Output.Arrays, N + 1);
      JsonParser.Output.Arrays[N] := Array_(JsonParser, @Value);
      Result.Kind := JVKArray;
      Result.Index := N;
    end;
    '{':
    begin
      N := Length(JsonParser.Output.Objects);
      SetLength(JsonParser.Output.Objects, N + 1);
      JsonParser.Output.Objects[N] := Object_(JsonParser, @Value);
      Result.Kind := JVKObject;
      Result.Index := N;
    end;
  else
    Error(JsonParser, 'Bad JSON value');
  end;
end;

procedure ParseJson(var JsonParser: TJsonParser; const Source: WideString);
begin
  if Source = '' then
    Exit;
  JsonParser.At := 1;
  JsonParser.Ch := ' ';
  JsonParser.Text := Source;
  Value(JsonParser);
  White(JsonParser);
  if JsonParser.Ch <> #0 then
    Error(JsonParser, 'Syntax error');
end;

procedure ClearJsonParser(var JsonParser: TJsonParser);
begin
  JsonParser.At := 0;
  JsonParser.Ch := #0;
  JsonParser.Text := '';
  SetLength(JsonParser.Output.Numbers, 0);
  SetLength(JsonParser.Output.Strings, 0);
  SetLength(JsonParser.Output.Words, 0);
  SetLength(JsonParser.Output.Arrays, 0);
  SetLength(JsonParser.Output.Objects, 0);
  SetLength(JsonParser.Output.Errors, 0);
end;

function IndentString(Indent: Integer): TJsonString;
var
  I: Integer;
begin
  for I := 1 to 4 * Indent do
    Result := Result + ' ';
end;

procedure PrintJsonObject(const Output: TJsonParserOutput; Index, Indent: Integer; Lines: TStringList; CommaAfter: TJsonString); forward;

procedure PrintJsonArray(const Output: TJsonParserOutput; Index, Indent: Integer; Lines: TStringList; CommaAfter: TJsonString);
var
  IS0, IS1: TJsonString;
  I: Integer;
  V: TJsonValue;
  S, Comma: TJsonString;
begin
  IS0 := IndentString(Indent);
  IS1 := IndentString(Indent + 1);
  Lines.Add(IS0 + '[');
  for I := 0 to Length(Output.Arrays[Index]) - 1 do
  begin
    if I < Length(Output.Arrays[Index]) - 1 then
      Comma := ','
    else
      Comma := '';
    V := Output.Arrays[Index][I];
    case V.Kind of
      JVKUnknown: Lines.Add(IS1 + '?kind?' + Comma);
      JVKNumber: Lines.Add(Format('%s%g' + Comma, [IS1, Output.Numbers[V.Index]]));
      JVKString: Lines.Add(IS1 + '"' + Output.Strings[V.Index] + '"' + Comma);
      JVKWord:
      begin
        case Output.Words[V.Index] of
          JWUnknown: S := '?word?';
          JWTrue: S := 'true';
          JWFalse: S := 'false';
          JWNull: S := 'null';
        end;
        Lines.Add(IS1 + S + Comma);
      end;
      JVKArray: PrintJsonArray(Output, V.Index, Indent + 1, Lines, Comma);
      JVKObject: PrintJsonObject(Output, V.Index, Indent + 1, Lines, Comma);
    end;
  end;
  Lines.Add(IS0 + ']' + CommaAfter);
end;

procedure PrintJsonObject(const Output: TJsonParserOutput; Index, Indent: Integer; Lines: TStringList; CommaAfter: TJsonString);
var
  IS0, IS1: TJsonString;
  I: Integer;
  K: TJsonString;
  V: TJsonValue;
  S, Comma: TJsonString;
begin
  IS0 := IndentString(Indent);
  IS1 := IndentString(Indent + 1);
  Lines.Add(IS0 + '{');
  for I := 0 to Length(Output.Objects[Index]) - 1 do
  begin
    if I < Length(Output.Objects[Index]) - 1 then
      Comma := ','
    else
      Comma := '';
    K := '"' + Output.Objects[Index][I].Key + '"';
    V := Output.Objects[Index][I].Value;
    case V.Kind of
      JVKUnknown: Lines.Add(IS1 + K + ': ?kind?' + Comma);
      JVKNumber: Lines.Add(Format('%s: %g' + Comma, [IS1 + K, Output.Numbers[V.Index]]));
      JVKString: Lines.Add(IS1 + K + ': "' + Output.Strings[V.Index] + '"' + Comma);
      JVKWord:
      begin
        case Output.Words[V.Index] of
          JWUnknown: S := '?word?';
          JWTrue: S := 'true';
          JWFalse: S := 'false';
          JWNull: S := 'null';
        end;
        Lines.Add(IS1 + K + ': ' + S + Comma);
      end;
      JVKArray:
      begin
        Lines.Add(IS1 + K + ':');
        PrintJsonArray(Output, V.Index, Indent + 1, Lines, Comma);
      end;
      JVKObject:
      begin
        Lines.Add(IS1 + K + ':');
        PrintJsonObject(Output, V.Index, Indent + 1, Lines, Comma);
      end;
    end;
  end;
  Lines.Add(IS0 + '}' + CommaAfter);
end;

procedure PrintJsonParserOutput(const Output: TJsonParserOutput; Lines: TStringList);
begin
  PrintJsonObject(Output, 0, 0, Lines, '');
end;

Usage example (JsonParserTest.pas):

{$INCLUDE JsonParser.pas}

var
  Source, Lines: TStringList;
  JsonParser: TJsonParser;
  I, J: Integer;

begin
  for I := 1 to 5 do
  begin
    Source := TStringList.Create;
    Source.LoadFromFile(Format('Test%d.json', [I]));
    ClearJsonParser(JsonParser);
    ParseJson(JsonParser, Source.Text);
    Source.Free;
    for J := 0 to Length(JsonParser.Output.Errors) - 1 do
      WriteLn(JsonParser.Output.Errors[J]);
    Lines := TStringList.Create;
    PrintJsonParserOutput(JsonParser.Output, Lines);
    Lines.SaveToFile(Format('Test%d.txt', [I]));
    Lines.Free;
  end;
end.

I borrowed the 5 test files (Test1.json, ..., Test5.json) from here.

score -1 · Answer 2 · answered Jun 10 '14 at 03:39

-1

theres a fpjson unit on free pascal

usage

procedure ParseJsonString(S: string);
  Var
  J : TJSONData;
  locParser : TJSONParser;
  x : integer;
  item : TJSONObject;
begin
  locParser := TJSONParser.Create(S);
  J :=locParser.Parse;
  for X := 0 to J.Count - 1 do   begin
   item := (J as TJSONArray).Objects[X];
  end;
  locParser.Free;
end;

answered Jun 10 '14 at 03:39

Richard Lagsit

79
1
5

the question is about a JSON parser implementation that can be executed in a PascalScript environment – mjn Jun 10 '14 at 09:24

JSON parser in PascalScript

2 Answers2