LoginSignup
3
3

More than 5 years have passed since last update.

@sile

Erlangコード最適化メモ: JSONデコード処理(3): JSON文字列パースの効率化

Last updated at Posted at 2014-05-20

『Erlangコード最適化メモ: JSONデコード処理(2): HiPEを使う』の続き。
今回は、実際にコードに手を入れてJSONデコード処理の最適化を試みる。
ベースとなるソースコードに関してはjson_decode_1.erlを参照のこと。

JSONデコード処理のボトルネック

例えば入力として(今回計時に使用している)以下のようなJSONデータを考えてみる。

erl_json_test/priv/1x.json
{
"id": 1,
"jsonrpc": "2.0",
"total": 1,
"result": [
{
"id": 1,
"avatar": "images/user_1.png",
"age": 38,
"admin": false,
"name": "Феликс Швец",
"company": "Genland",
"phone": "+70955600298",
"email": "feliks@genland.com",
"registerDate": "Tue, 18 Aug 2009 14:09:40 GMT",
"friends": [
{
"id": 1,
"name": "Яков Олейник",
"phone": "+70950177368"
},
{
"id": 2,
"name": "Антон Коваленко",
"phone": "+70958920708"
},
{
"id": 3,
"name": "Леонид Приходько",
"phone": "+70958423612"
}
],
"field": "field value"
}
]
}

一見して分かるのは、JSONでは文字列が頻繁に使われるということ。
オブジェクトのキーは全て文字列だし、その他の値に関しても数字や真偽値、nullとして扱えないものは基本的に全て文字列として表現される必要がある。

実際に、文字列処理部分は、(今回の計時における)全体の処理時間の中で大きな割合を占めており、例えば以下のようにデコードした文字列を保持するコードを削るだけで、処理時間をだいたい1/3に落とすことができた。

まず修正差分: (修正版のファイル名は json_decode_1_a.erl)

--- json_decode_1.erl   2014-05-16 02:57:15.842341685 +0900
+++ json_decode_1_a.erl 2014-05-21 02:36:30.794384932 +0900
@@ -1,1 +1,1 @@
--module(json_decode_1).
+-module(json_decode_1_a).
@@ -73,1 +73,1 @@
-string(<<$",       Bin/binary>>, Acc) -> {list_to_binary(lists:reverse(Acc)), Bin};
+string(<<$",       Bin/binary>>,   _) -> {<<"">>, Bin}; % ダミー値を返す
@@ -83,1 +83,1 @@
-string(<<0:1, C:7, Bin/binary>>, Acc) -> string(Bin, [C | Acc]);
+string(<<0:1, _:7, Bin/binary>>, Acc) -> string(Bin, Acc); % 文字列パース中間結果は保存しない

コード本体:

json_decode_1_a.erl
-module(json_decode_1_a).

-export([decode/1]).

-type json_value()  :: null | boolean() | json_number() |
                       json_string() | json_array() | json_object().
-type json_number() :: non_neg_integer().
-type json_string() :: binary().
-type json_array()  :: [json_value()].
-type json_object() :: {[json_object_member()]}.
-type json_object_member() :: {json_string(), json_value()}.

%% @doc JSON文字列をデコードする
%%
%% 不正なJSON文字列が渡された場合は、badargエラーが送出される
-spec decode(binary()) -> json_value().
decode(Json) ->
    {Value, _RestBin} = value(skip_whitespace(Json)),
    Value.

-spec skip_whitespace(binary()) -> binary().
skip_whitespace(<<$  , Bin/binary>>) -> skip_whitespace(Bin);
skip_whitespace(<<$\t, Bin/binary>>) -> skip_whitespace(Bin);
skip_whitespace(<<$\r, Bin/binary>>) -> skip_whitespace(Bin);
skip_whitespace(<<$\n, Bin/binary>>) -> skip_whitespace(Bin);
skip_whitespace(Bin)                 -> Bin.

-spec value(binary()) -> {json_value(), binary()}.
value(<<"null", Bin/binary>>)                  -> {null, Bin};
value(<<"false", Bin/binary>>)                 -> {false, Bin};
value(<<"true", Bin/binary>>)                  -> {true, Bin};
value(<<$[, Bin/binary>>)                      -> array(skip_whitespace(Bin));
value(<<${, Bin/binary>>)                      -> object(skip_whitespace(Bin));
value(<<$", Bin/binary>>)                      -> string(Bin, "");
value(<<C, Bin/binary>>) when $0 =< C, C =< $9 -> number(C - $0, Bin);
value(Bin)                                     -> error(badarg, [Bin]).

-spec array(binary()) -> {json_array(), binary()}.
array(<<$], Bin/binary>>) -> {[], Bin};
array(Bin)                -> array(Bin, []).

-spec array(binary(), [json_value()]) -> {json_array(), binary()}.
array(Bin, Values) ->
    {Value, Bin2} = value(Bin),
    Values2 = [Value | Values],
    case skip_whitespace(Bin2) of
        <<$], Bin3/binary>> -> {lists:reverse(Values2), Bin3};
        <<$,, Bin3/binary>> -> array(skip_whitespace(Bin3), Values2);
        _                   -> error(badarg, [Bin, Values])
    end.

-spec object(binary()) -> {json_object(), binary()}.
object(<<$}, Bin/binary>>) -> {{[]}, Bin};
object(Bin)                -> object(Bin, []).

-spec object(binary(), [json_object_member()]) -> {json_object(), binary()}.
object(<<$", Bin/binary>>, Members) ->
    {Key, Bin2} = string(Bin, ""),
    case skip_whitespace(Bin2) of
        <<$:, Bin3/binary>> ->
            {Value, Bin4} = value(skip_whitespace(Bin3)),
            Members2 = [{Key, Value} | Members],
            case skip_whitespace(Bin4) of
                <<$}, Bin5/binary>> -> {{lists:reverse(Members2)}, Bin5};
                <<$,, Bin5/binary>> -> object(skip_whitespace(Bin5), Members2);
                _                   -> error(badarg, [<<$", Bin/binary>>, Members])
            end;
        _ -> error(badarg, [<<$", Bin/binary>>, Members])
    end;
object(Bin, Members) -> error(badarg, [Bin, Members]).

-spec string(binary(), string()) -> {json_string(), binary()}.
string(<<$",       Bin/binary>>,   _) -> {<<"">>, Bin}; % ダミー値を返す
string(<<$\\, $",  Bin/binary>>, Acc) -> string(Bin, [$" | Acc]);
string(<<$\\, $/,  Bin/binary>>, Acc) -> string(Bin, [$/ | Acc]);
string(<<$\\, $\\, Bin/binary>>, Acc) -> string(Bin, [$\\ | Acc]);
string(<<$\\, $b,  Bin/binary>>, Acc) -> string(Bin, [$\b | Acc]);
string(<<$\\, $f,  Bin/binary>>, Acc) -> string(Bin, [$\f | Acc]);
string(<<$\\, $n,  Bin/binary>>, Acc) -> string(Bin, [$\n | Acc]);
string(<<$\\, $r,  Bin/binary>>, Acc) -> string(Bin, [$\r | Acc]);
string(<<$\\, $t,  Bin/binary>>, Acc) -> string(Bin, [$\t | Acc]);
string(<<$\\,      Bin/binary>>, Acc) -> error(badarg, [<<$\\, Bin/binary>>, Acc]);
string(<<0:1, _:7, Bin/binary>>, Acc) -> string(Bin, Acc); % 文字列パース中間結果は保存しない
string(Bin,                      Acc) -> error(badarg, [Bin, Acc]).

-spec number(json_number(), binary()) -> {json_number(), binary()}.
number(N, <<C, Bin/binary>>) when $0 =< C, C =< $9 -> number(N * 10 + C - $0, Bin);
number(N, Bin)                                     -> {N, Bin}.

計時結果: (測定方法などは初回を参照)

平均処理時間 1x.json 3x.json 9x.json 27x.json 81x.json 243x.json
json_decode_1:decode/1 49μs 153μs 412μs 1163μs 4089μs 11780μs
json_decode_1:decode/1(hipe) 24μs 68μs 236μs 750μs 2158μs 6221μs
json_decode_1_a:decode/1(hipe) 9μs 23μs 64μs 228μs 799μs 2289μs

実際にデコードしてみると、当然結果は不正(文字列は常に <<"">>)なものとなる。

$ erl
Erlang R16B03-1 (erts-5.10.4) [source] [64-bit] [smp:2:2] [async-threads:10] [hipe]
Eshell V5.10.4  (abort with ^G)

> json_decode_1_a:decode(<<"{\"a\":10, \"b\":\"c\"}">>).
{[{<<"">>,10},{<<"">>,<<"">>}]}

当然、この修正をそのまま使うことはできないが、文字列処理部分がボトルネック(少なくとも大きな一つ)であることは間違いないので、次はこの箇所を最適化していく。

文字列デコード処理の最適化

中間結果をリストで持ちまわすのを止めてみる

個人的には、Erlangでバイナリをパースして、別のバイナリを生成する場合は、json_decode_1.erlのstring/2関数でも行っているように「まず途中結果をリストに逆順で保持」し「最後にリバースしてバイナリに変換」というパターンを採用することが多かった。

%% json_decode_1.erlのstring/2の簡易版
string(<<$",       Bin/binary>>, Acc) -> {list_to_binary(lists:reverse(Acc)), Bin};
string(<<$\\, $",  Bin/binary>>, Acc) -> string(Bin, [$" | Acc]);
string(<<$\\, $n,  Bin/binary>>, Acc) -> string(Bin, [$\n | Acc]);
string(<<$\\, $t,  Bin/binary>>, Acc) -> string(Bin, [$\t | Acc]);
string(<<0:1, C:7, Bin/binary>>, Acc) -> string(Bin, [C | Acc]).

この方法自体は、それほど非効率という訳ではなく、それなりに気に入ってはいたのだが、前述のように現時点ではここがボトルネックになってしまっている。

中間結果生成・リバース・リストからバイナリへの変換、と一回のパース関数呼び出しで、入力サイズに等しいオーダーのメモリアロケーションが必要な処理が三回も必要になるので、その辺りの改善案を考える。

まず最初に思いつくのはErlangの最適化ガイド(バイナリ処理)の冒頭でも説明されているように、中間結果を逆順リストとして保持するのではなく、直接結果バイナリの末尾に追加していく、という方法。

イメージ的には以下のようなコードとなる。

string(Bin) -> string(Bin, <<"">>).

string(<<$",       Bin/binary>>, Acc) -> {Acc, Bin};
string(<<$\\, $",  Bin/binary>>, Acc) -> string(Bin, <<Acc/binary, $">>);
string(<<$\\, $n,  Bin/binary>>, Acc) -> string(Bin, <<Acc/binary, $n>>);
string(<<$\\, $t,  Bin/binary>>, Acc) -> string(Bin, <<Acc/binary, $t>>);
string(<<0:1, C:7, Bin/binary>>, Acc) -> string(Bin, <<Acc/binary, C>>).
%% Accバイナリの末尾に直接文字を追加する。
%% もしAccバイナリの末尾部分の(内部的な)空き領域が不足している場合は、自動でリサイズが行われる。

%% http://www.erlang.org/doc/efficiency_guide/binaryhandling.html より引用:
%%   Acc will be copied only in the first iteration and extra space will be allocated at the end
%%   of the copied binary. In the next iteration, H will be written in to the extra space. When %%   the extra space runs out, the binary will be reallocated with more extra space.

これは一見以前よりも無駄がなさそうに見えるが、実際に処理速度を計測してみると、むしろ大幅に遅くなっていることが分かる。
(上記修正を適用した版のファイル名は仮に json_decode_2_a.erl としておく)

平均処理時間 1x.json 3x.json 9x.json 27x.json 81x.json 243x.json
json_decode_1:decode/1 49μs 153μs 412μs 1163μs 4089μs 11780μs
json_decode_1:decode/1(hipe) 24μs 68μs 236μs 750μs 2158μs 6221μs
json_decode_1_a:decode/1(hipe) 9μs 23μs 64μs 228μs 799μs 2289μs
json_decode_2_a:decode/1(hipe) 29μs 81μs 480μs 1678μs 5891μs 18049μs

Erlangの最適化ガイド(バイナリ処理)を見ると、バイナリの末尾への要素追加時のリアロケートに関して以下のような一文がある:

The extra space allocated (or reallocated) will be twice the size of the existing binary data, or 256, whichever is larger.

バイナリの内部的なサイズが足りない場合、要素追加の前に、もともとのサイズの二倍 or 256バイトの大きい方にリサイズされるらしい。
上記コードでは常に初期値として空バイナリを渡すようにしているので、初回リサイズは常に256バイトになるものと思われるが、JSONのオブジェクトのキーのように短い長さの文字列が多い場合は、確保した領域のほとんどが使用されることがなく無駄になってしまうので、結果として逆にオーバヘッドが大きくなってしまったのではないかと思う。
(詳細な検証は行っていないので、勝手な推測)

バッファとして使用するバイナリを持ちまわすようにする

では、どうするかと云えば、結果文字列の格納用にグローバルなバッファ(バイナリ)を持ちまわすようにすれば、無駄なリサイズが頻繁に発生するのは避けられそう。
具体的には以下のようなコードとなる。

%% 新たにバッファ用のバイナリを引数に追加し、全ての関数で持ちまわすようにする
string(Bin, Buf) -> string(Bin, byte_size(Buf), Buf).

string(<<$",       Bin/binary>>, BufStart, Buf) ->
  Str = binary:part(Buf, 0, byte_size(Buf) - BufStart), % 今回の追加分だけを含むサブバイナリを作成する
  {Str, Bin, Buf};  % バッファも返り値に含めて、次の処理に持ちまわすせるようにする
string(<<$\\, $",  Bin/binary>>, BufStart, Buf) -> string(Bin, BufStart, <<Buf/binary, $">>);
string(<<$\\, $n,  Bin/binary>>, BufStart, Buf) -> string(Bin, BufStart, <<Buf/binary, $n>>);
string(<<$\\, $t,  Bin/binary>>, BufStart, Buf) -> string(Bin, BufStart, <<Buf/binary, $t>>);
string(<<0:1, C:7, Bin/binary>>, BufStart, Buf) -> string(Bin, BufStart, <<Buf/binary, C>>).

文字の追加を常に単一のバッファ用バイナリに行うようにすることで、小さいサイズでのリサイズが頻繁に起こることは避けられるようになる。
また、結果文字列を作成する際にbinary:part/3を使ってサブバイナリを生成しているが、この関数は指定された範囲のバイナリを新たにコピーする訳ではなく、参照情報(ex. 開始と終了位置)のみを生成するはずなので、オーバーヘッドは小さい。
(ただし、この方法だとJSONデコード結果に含まれる全ての文字列が参照扱いになるので、例えばその内の一つだけを長期間残しておきたくて、残りは不要な場合とかでも、メモリ領域としてはバッファ全体分が常に確保され続けてしまうことになるので、その辺りは注意が必要)

以下は、この修正を行った版の完全なソースコードと計時結果。

ソースコード:

json_decode_2_b.erl
-module(json_decode_2_b).

-export([decode/1]).

-type json_value()  :: null | boolean() | json_number() |
                       json_string() | json_array() | json_object().
-type json_number() :: non_neg_integer().
-type json_string() :: binary().
-type json_array()  :: [json_value()].
-type json_object() :: {[json_object_member()]}.
-type json_object_member() :: {json_string(), json_value()}.

%% @doc JSON文字列をデコードする
%%
%% 不正なJSON文字列が渡された場合は、badargエラーが送出される
-spec decode(binary()) -> json_value().
decode(Json) ->
    {Value, _RestBin, _Buf} = value(skip_whitespace(Json), <<"">>),
    Value.

-spec skip_whitespace(binary()) -> binary().
skip_whitespace(<<$  , Bin/binary>>) -> skip_whitespace(Bin);
skip_whitespace(<<$\t, Bin/binary>>) -> skip_whitespace(Bin);
skip_whitespace(<<$\r, Bin/binary>>) -> skip_whitespace(Bin);
skip_whitespace(<<$\n, Bin/binary>>) -> skip_whitespace(Bin);
skip_whitespace(Bin)                 -> Bin.

-spec value(binary(), binary()) -> {json_value(), binary(), binary()}.
value(<<"null", Bin/binary>>, Buf)                  -> {null, Bin, Buf};
value(<<"false", Bin/binary>>, Buf)                 -> {false, Bin, Buf};
value(<<"true", Bin/binary>>, Buf)                  -> {true, Bin, Buf};
value(<<$[, Bin/binary>>, Buf)                      -> array(skip_whitespace(Bin), Buf);
value(<<${, Bin/binary>>, Buf)                      -> object(skip_whitespace(Bin), Buf);
value(<<$", Bin/binary>>, Buf)                      -> string(Bin, byte_size(Buf), Buf);
value(<<C, Bin/binary>>, Buf) when $0 =< C, C =< $9 -> number(C - $0, Bin, Buf);
value(Bin, Buf)                                     -> error(badarg, [Bin, Buf]).

-spec array(binary(), binary()) -> {json_array(), binary(), binary()}.
array(<<$], Bin/binary>>, Buf) -> {[], Bin, Buf};
array(Bin, Buf)                -> array(Bin, [], Buf).

-spec array(binary(), [json_value()], binary()) -> {json_array(), binary(), binary()}.
array(Bin, Values, Buf) ->
    {Value, Bin2, Buf2} = value(Bin, Buf),
    Values2 = [Value | Values],
    case skip_whitespace(Bin2) of
        <<$], Bin3/binary>> -> {lists:reverse(Values2), Bin3, Buf2};
        <<$,, Bin3/binary>> -> array(skip_whitespace(Bin3), Values2, Buf2);
        _                   -> error(badarg, [Bin, Values, Buf])
    end.

-spec object(binary(), binary()) -> {json_object(), binary(), binary()}.
object(<<$}, Bin/binary>>, Buf) -> {{[]}, Bin, Buf};
object(Bin, Buf)                -> object(Bin, [], Buf).

-spec object(binary(), [json_object_member()], binary()) -> {json_object(), binary(), binary()}.
object(<<$", Bin/binary>>, Members, Buf) ->
    {Key, Bin2, Buf2} = string(Bin, byte_size(Buf), Buf),
    case skip_whitespace(Bin2) of
        <<$:, Bin3/binary>> ->
            {Value, Bin4, Buf3} = value(skip_whitespace(Bin3), Buf2),
            Members2 = [{Key, Value} | Members],
            case skip_whitespace(Bin4) of
                <<$}, Bin5/binary>> -> {{lists:reverse(Members2)}, Bin5, Buf3};
                <<$,, Bin5/binary>> -> object(skip_whitespace(Bin5), Members2, Buf3);
                _                   -> error(badarg, [<<$", Bin/binary>>, Members, Buf])
            end;
        _ -> error(badarg, [<<$", Bin/binary>>, Members, Buf])
    end;
object(Bin, Members, Buf) -> error(badarg, [Bin, Members, Buf]).

-spec string(binary(), non_neg_integer(), binary()) -> {json_string(), binary(), binary()}.
string(<<$",       Bin/binary>>, Start, Buf) -> {binary:part(Buf, Start, byte_size(Buf) - Start), Bin, Buf};
string(<<$\\, $",  Bin/binary>>, Start, Buf) -> string(Bin, Start, <<Buf/binary, $">>);
string(<<$\\, $/,  Bin/binary>>, Start, Buf) -> string(Bin, Start, <<Buf/binary, $/>>);
string(<<$\\, $\\, Bin/binary>>, Start, Buf) -> string(Bin, Start, <<Buf/binary, $\\>>);
string(<<$\\, $b,  Bin/binary>>, Start, Buf) -> string(Bin, Start, <<Buf/binary, $\b>>);
string(<<$\\, $f,  Bin/binary>>, Start, Buf) -> string(Bin, Start, <<Buf/binary, $\f>>);
string(<<$\\, $n,  Bin/binary>>, Start, Buf) -> string(Bin, Start, <<Buf/binary, $\n>>);
string(<<$\\, $r,  Bin/binary>>, Start, Buf) -> string(Bin, Start, <<Buf/binary, $\r>>);
string(<<$\\, $t,  Bin/binary>>, Start, Buf) -> string(Bin, Start, <<Buf/binary, $\t>>);
string(<<$\\,      Bin/binary>>, Start, Buf) -> error(badarg, [<<$\\, Bin/binary>>, Start, Buf]);
string(<<0:1, C:7, Bin/binary>>, Start, Buf) -> string(Bin, Start, <<Buf/binary, C>>);
string(Bin,                      Start, Buf) -> error(badarg, [Bin, Start, Buf]).

-spec number(json_number(), binary(), binary()) -> {json_number(), binary(), binary()}.
number(N, <<C, Bin/binary>>, Buf) when $0 =< C, C =< $9 -> number(N * 10 + C - $0, Bin, Buf);
number(N, Bin, Buf)                                     -> {N, Bin, Buf}.

計時結果:

平均処理時間 1x.json 3x.json 9x.json 27x.json 81x.json 243x.json
json_decode_1:decode/1 49μs 153μs 412μs 1163μs 4089μs 11780μs
json_decode_1:decode/1(hipe) 24μs 68μs 236μs 750μs 2158μs 6221μs
json_decode_1_a:decode/1(hipe) 9μs 23μs 64μs 228μs 799μs 2289μs
json_decode_2_a:decode/1(hipe) 29μs 81μs 480μs 1678μs 5891μs 18049μs
json_decode_2_b:decode/1(hipe) 18μs 46μs 203μs 589μs 1700μs 4892μs

もともとの実装(json_decode_1.erlのHiPE版)に比べて、劇的という程ではないが、二割程度は処理時間が短くなった。

文字の追加をまとめて行うようにする

文字列処理関連の(最後の)最適化として、string/3関数を、さらに次のように修正する。

-spec string(binary(), non_neg_integer(), binary()) -> {json_string(), binary(), binary()}.
string(Bin, Start, Buf) ->
    string(Bin, Bin, Start, Buf).

-spec string(binary(), binary(), non_neg_integer(), binary()) -> {json_string(), binary(), binary()}.
string(<<$",       Bin/binary>>, Base, Start, Buf) ->
    Prefix = binary:part(Base, 0, byte_size(Base) - byte_size(Bin) - 1), % 追加すべき範囲を入力から取り出す
    case Start =:= byte_size(Buf) of
        true  -> {Prefix, Bin, Buf}; % エスケープ文字を含まないので、入力バイナリのサブバイナリがそのまま利用可能
        false ->
            Buf2 = <<Buf/binary, Prefix/binary>>,
            {binary:part(Buf2, Start, byte_size(Buf2) - Start), Bin, Buf2}
    end;
string(<<$\\,     Bin0/binary>>, Base, Start, Buf) ->
    Prefix = binary:part(Base, 0, byte_size(Base) - byte_size(Bin0) - 1), % 追加すべき範囲を入力から取り出す
    case Bin0 of
        <<$",  Bin/binary>> -> string(Bin, Start, <<Buf/binary, Prefix/binary, $">>);
        <<$/,  Bin/binary>> -> string(Bin, Start, <<Buf/binary, Prefix/binary, $/>>);
        <<$\\, Bin/binary>> -> string(Bin, Start, <<Buf/binary, Prefix/binary, $\\>>);
        <<$b,  Bin/binary>> -> string(Bin, Start, <<Buf/binary, Prefix/binary, $\b>>);
        <<$f,  Bin/binary>> -> string(Bin, Start, <<Buf/binary, Prefix/binary, $\f>>);
        <<$n,  Bin/binary>> -> string(Bin, Start, <<Buf/binary, Prefix/binary, $\n>>);
        <<$r,  Bin/binary>> -> string(Bin, Start, <<Buf/binary, Prefix/binary, $\r>>);
        <<$t,  Bin/binary>> -> string(Bin, Start, <<Buf/binary, Prefix/binary, $\t>>);
        <<     Bin/binary>> -> error(badarg, [<<$\\, Bin/binary>>, Base, Start, Buf])
    end;
string(<<0:1, _:7, Bin/binary>>, Base, Start, Buf) -> string(Bin, Base, Start, Buf); % この時点では文字は追加しない
string(Bin,                      Base, Start, Buf) -> error(badarg, [Bin, Base, Start, Buf]).

これまでは入力バイナリ内の文字を走査するたびに、必ずバッファの末尾に文字を追加していたのを、実際に必要になるまで処理を遅延しかつ文字列単位で一気に追加が行われるように変更した。
また、入力バイナリがエスケープ文字を一切含まない場合は、そもそもバッファ用バイナリへの追加も不要なようになっている。
(ただし、文字列内に(エスケープされた)日本語しか含まない場合などは、結局常に一文字毎のバッファへの追加処理が必要になるので、よりシンプルなもともと(json_decode_2_b.erl)の実装の方が高速な可能性は高いと思う。)

以下、この修正を反映したソースコードと計時結果。

ソースコード:

json_decode_2.erl
-module(json_decode_2).

-export([decode/1]).

-type json_value()  :: null | boolean() | json_number() |
                       json_string() | json_array() | json_object().
-type json_number() :: non_neg_integer().
-type json_string() :: binary().
-type json_array()  :: [json_value()].
-type json_object() :: {[json_object_member()]}.
-type json_object_member() :: {json_string(), json_value()}.

%% @doc JSON文字列をデコードする
%%
%% 不正なJSON文字列が渡された場合は、badargエラーが送出される
-spec decode(binary()) -> json_value().
decode(Json) ->
    {Value, _RestBin, _Buf} = value(skip_whitespace(Json), <<"">>),
    Value.

-spec skip_whitespace(binary()) -> binary().
skip_whitespace(<<$  , Bin/binary>>) -> skip_whitespace(Bin);
skip_whitespace(<<$\t, Bin/binary>>) -> skip_whitespace(Bin);
skip_whitespace(<<$\r, Bin/binary>>) -> skip_whitespace(Bin);
skip_whitespace(<<$\n, Bin/binary>>) -> skip_whitespace(Bin);
skip_whitespace(Bin)                 -> Bin.

-spec value(binary(), binary()) -> {json_value(), binary(), binary()}.
value(<<"null", Bin/binary>>, Buf)                  -> {null, Bin, Buf};
value(<<"false", Bin/binary>>, Buf)                 -> {false, Bin, Buf};
value(<<"true", Bin/binary>>, Buf)                  -> {true, Bin, Buf};
value(<<$[, Bin/binary>>, Buf)                      -> array(skip_whitespace(Bin), Buf);
value(<<${, Bin/binary>>, Buf)                      -> object(skip_whitespace(Bin), Buf);
value(<<$", Bin/binary>>, Buf)                      -> string(Bin, byte_size(Buf), Buf);
value(<<C, Bin/binary>>, Buf) when $0 =< C, C =< $9 -> number(C - $0, Bin, Buf);
value(Bin, Buf)                                     -> error(badarg, [Bin, Buf]).

-spec array(binary(), binary()) -> {json_array(), binary(), binary()}.
array(<<$], Bin/binary>>, Buf) -> {[], Bin, Buf};
array(Bin, Buf)                -> array(Bin, [], Buf).

-spec array(binary(), [json_value()], binary()) -> {json_array(), binary(), binary()}.
array(Bin, Values, Buf) ->
    {Value, Bin2, Buf2} = value(Bin, Buf),
    Values2 = [Value | Values],
    case skip_whitespace(Bin2) of
        <<$], Bin3/binary>> -> {lists:reverse(Values2), Bin3, Buf2};
        <<$,, Bin3/binary>> -> array(skip_whitespace(Bin3), Values2, Buf2);
        _                   -> error(badarg, [Bin, Values, Buf])
    end.

-spec object(binary(), binary()) -> {json_object(), binary(), binary()}.
object(<<$}, Bin/binary>>, Buf) -> {{[]}, Bin, Buf};
object(Bin, Buf)                -> object(Bin, [], Buf).

-spec object(binary(), [json_object_member()], binary()) -> {json_object(), binary(), binary()}.
object(<<$", Bin/binary>>, Members, Buf) ->
    {Key, Bin2, Buf2} = string(Bin, byte_size(Buf), Buf),
    case skip_whitespace(Bin2) of
        <<$:, Bin3/binary>> ->
            {Value, Bin4, Buf3} = value(skip_whitespace(Bin3), Buf2),
            Members2 = [{Key, Value} | Members],
            case skip_whitespace(Bin4) of
                <<$}, Bin5/binary>> -> {{lists:reverse(Members2)}, Bin5, Buf3};
                <<$,, Bin5/binary>> -> object(skip_whitespace(Bin5), Members2, Buf3);
                _                   -> error(badarg, [<<$", Bin/binary>>, Members, Buf])
            end;
        _ -> error(badarg, [<<$", Bin/binary>>, Members, Buf])
    end;
object(Bin, Members, Buf) -> error(badarg, [Bin, Members, Buf]).

-spec string(binary(), non_neg_integer(), binary()) -> {json_string(), binary(), binary()}.
string(Bin, Start, Buf) ->
    string(Bin, Bin, Start, Buf).

-spec string(binary(), binary(), non_neg_integer(), binary()) -> {json_string(), binary(), binary()}.
string(<<$",       Bin/binary>>, Base, Start, Buf) ->
    Prefix = binary:part(Base, 0, byte_size(Base) - byte_size(Bin) - 1),
    case Start =:= byte_size(Buf) of
        true  -> {Prefix, Bin, Buf}; % エスケープ文字を含まないので、入力バイナリのサブバイナリがそのまま利用可能
        false ->
            Buf2 = <<Buf/binary, Prefix/binary>>,
            {binary:part(Buf2, Start, byte_size(Buf2) - Start), Bin, Buf2}
    end;
string(<<$\\,     Bin0/binary>>, Base, Start, Buf) ->
    Prefix = binary:part(Base, 0, byte_size(Base) - byte_size(Bin0) - 1),
    case Bin0 of
        <<$",  Bin/binary>> -> string(Bin, Start, <<Buf/binary, Prefix/binary, $">>);
        <<$/,  Bin/binary>> -> string(Bin, Start, <<Buf/binary, Prefix/binary, $/>>);
        <<$\\, Bin/binary>> -> string(Bin, Start, <<Buf/binary, Prefix/binary, $\\>>);
        <<$b,  Bin/binary>> -> string(Bin, Start, <<Buf/binary, Prefix/binary, $\b>>);
        <<$f,  Bin/binary>> -> string(Bin, Start, <<Buf/binary, Prefix/binary, $\f>>);
        <<$n,  Bin/binary>> -> string(Bin, Start, <<Buf/binary, Prefix/binary, $\n>>);
        <<$r,  Bin/binary>> -> string(Bin, Start, <<Buf/binary, Prefix/binary, $\r>>);
        <<$t,  Bin/binary>> -> string(Bin, Start, <<Buf/binary, Prefix/binary, $\t>>);
        <<     Bin/binary>> -> error(badarg, [<<$\\, Bin/binary>>, Base, Start, Buf])
    end;
string(<<0:1, _:7, Bin/binary>>, Base, Start, Buf) -> string(Bin, Base, Start, Buf);
string(Bin,                      Base, Start, Buf) -> error(badarg, [Bin, Base, Start, Buf]).

-spec number(json_number(), binary(), binary()) -> {json_number(), binary(), binary()}.
number(N, <<C, Bin/binary>>, Buf) when $0 =< C, C =< $9 -> number(N * 10 + C - $0, Bin, Buf);
number(N, Bin, Buf)                                     -> {N, Bin, Buf}.

計時結果:

平均処理時間 1x.json 3x.json 9x.json 27x.json 81x.json 243x.json
json_decode_1:decode/1 49μs 153μs 412μs 1163μs 4089μs 11780μs
json_decode_1:decode/1(hipe) 24μs 68μs 236μs 750μs 2158μs 6221μs
json_decode_1_a:decode/1(hipe) 9μs 23μs 64μs 228μs 799μs 2289μs
json_decode_2_a:decode/1(hipe) 29μs 81μs 480μs 1678μs 5891μs 18049μs
json_decode_2_b:decode/1(hipe) 18μs 46μs 203μs 589μs 1700μs 4892μs
json_decode_2:decode/1(hipe) 13μs 31μs 95μs 289μs 1363μs 3585μs

入力JSONにエスケープ文字が少ないこともあってか、この修正で結構性能が改善している。

とりあえず、JSON文字列デコード周りの最適化に関してはここまで。

3
3
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
3
3