%% -*- erlang-indent-level: 4 -*-
%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
%%
%% %CopyrightEnd%
%%
-module(eval_bits).
%% Avoid warning for local function error/1 clashing with autoimported BIF.
-compile({no_auto_import,[error/1]}).
-export([expr_grp/3,expr_grp/5,match_bits/6,
match_bits/7,bin_gen/6]).
%% Types used in this module:
%% @type bindings(). An abstract structure for bindings between
%% variables and values (the environment)
%%
%% @type evalfun(). A closure which evaluates an expression given an
%% environment
%%
%% @type matchfun(). A closure which depending on its first argument
%% can perform a match (given a value, a pattern and an environment),
%% lookup a variable in the bindings, or add a new binding
%%
%% @type field(). Represents a field in a "bin".
%%% Part 1: expression evaluation (binary construction)
%% @spec expr_grp(Fields::[field()], Bindings::bindings(),
%% EvalFun::evalfun(), term(), term()) ->
%% {value, binary(), bindings()}
%%
%% @doc Returns a tuple with {value,Bin,Bs} where Bin is the binary
%% constructed from form the Fields under the current Bindings. Bs
%% contains the present bindings. This function can also throw an
%% exception if the construction fails.
expr_grp(Fields, Bindings, EvalFun, [], _) ->
expr_grp(Fields, Bindings, EvalFun, <<>>);
expr_grp(Fields, Bindings, EvalFun, ListOfBits, _) ->
Bin = convert_list(ListOfBits),
expr_grp(Fields, Bindings, EvalFun, Bin).
convert_list(List) ->
<< <<X:1>> || X <- List >>.
expr_grp(Fields, Bindings, EvalFun) ->
expr_grp(Fields, Bindings, EvalFun, <<>>).
expr_grp([Field | FS], Bs0, Lf, Acc) ->
{Bin,Bs} = eval_field(Field, Bs0, Lf),
expr_grp(FS, Bs, Lf, <<Acc/binary-unit:1,Bin/binary-unit:1>>);
expr_grp([], Bs0, _Lf, Acc) ->
{value,Acc,Bs0}.
eval_field({bin_element, _, {string, _, S}, default, default}, Bs0, _Fun) ->
{list_to_binary(S),Bs0};
eval_field({bin_element, Line, {string, _, S}, Size0, Options0}, Bs, _Fun) ->
{_Size,[Type,_Unit,_Sign,Endian]} =
make_bit_type(Line, Size0, Options0),
Res = << <<(eval_exp_field1(C, no_size, no_unit,
Type, Endian, no_sign))/binary>> ||
C <- S >>,
{Res,Bs};
eval_field({bin_element,Line,E,Size0,Options0}, Bs0, Fun) ->
{value,V,Bs1} = Fun(E, Bs0),
{Size1,[Type,{unit,Unit},Sign,Endian]} =
make_bit_type(Line, Size0, Options0),
{value,Size,Bs} = Fun(Size1, Bs1),
{eval_exp_field1(V, Size, Unit, Type, Endian, Sign),Bs}.
eval_exp_field1(V, Size, Unit, Type, Endian, Sign) ->
try
eval_exp_field(V, Size, Unit, Type, Endian, Sign)
catch
error:system_limit ->
error(system_limit);
error:_ ->
error(badarg)
end.
eval_exp_field(Val, Size, Unit, integer, little, signed) ->
<<Val:(Size*Unit)/little-signed>>;
eval_exp_field(Val, Size, Unit, integer, little, unsigned) ->
<<Val:(Size*Unit)/little>>;
eval_exp_field(Val, Size, Unit, integer, native, signed) ->
<<Val:(Size*Unit)/native-signed>>;
eval_exp_field(Val, Size, Unit, integer, native, unsigned) ->
<<Val:(Size*Unit)/native>>;
eval_exp_field(Val, Size, Unit, integer, big, signed) ->
<<Val:(Size*Unit)/signed>>;
eval_exp_field(Val, Size, Unit, integer, big, unsigned) ->
<<Val:(Size*Unit)>>;
eval_exp_field(Val, _Size, _Unit, utf8, _, _) ->
<<Val/utf8>>;
eval_exp_field(Val, _Size, _Unit, utf16, big, _) ->
<<Val/big-utf16>>;
eval_exp_field(Val, _Size, _Unit, utf16, little, _) ->
<<Val/little-utf16>>;
eval_exp_field(Val, _Size, _Unit, utf32, big, _) ->
<<Val/big-utf32>>;
eval_exp_field(Val, _Size, _Unit, utf32, little, _) ->
<<Val/little-utf32>>;
eval_exp_field(Val, Size, Unit, float, little, _) ->
<<Val:(Size*Unit)/float-little>>;
eval_exp_field(Val, Size, Unit, float, native, _) ->
<<Val:(Size*Unit)/float-native>>;
eval_exp_field(Val, Size, Unit, float, big, _) ->
<<Val:(Size*Unit)/float>>;
eval_exp_field(Val, all, Unit, binary, _, _) ->
case bit_size(Val) of
Size when Size rem Unit =:= 0 ->
<<Val:Size/binary-unit:1>>;
_ ->
error(badarg)
end;
eval_exp_field(Val, Size, Unit, binary, _, _) ->
<<Val:(Size*Unit)/binary-unit:1>>.
%%% Part 2: matching in binary comprehensions
%% @spec bin_gen(BinPattern::{bin,integer(),[field()]}, Bin::binary(),
%% GlobalEnv::bindings(), LocalEnv::bindings(),
%% MatchFun::matchfun(), EvalFun::evalfun()) ->
%% {match, binary(), bindings()} | {nomatch, binary()} | done
%%
%% @doc Used to perform matching in a comprehension. If the match
%% succeeds a new environment and what remains of the binary is
%% returned. If the match fails what remains of the binary is returned.
%% If nothing remains of the binary the atom 'done' is returned.
bin_gen({bin,_,Fs}, Bin, Bs0, BBs0, Mfun, Efun) ->
bin_gen(Fs, Bin, Bs0, BBs0, Mfun, Efun, true).
bin_gen([F|Fs], Bin, Bs0, BBs0, Mfun, Efun, Flag)
when is_function(Mfun, 2), is_function(Efun, 2) ->
case bin_gen_field(F, Bin, Bs0, BBs0, Mfun, Efun) of
{match,Bs,BBs,Rest} ->
bin_gen(Fs, Rest, Bs, BBs, Mfun, Efun, Flag);
{nomatch,Rest} ->
bin_gen(Fs, Rest, Bs0, BBs0, Mfun, Efun, false);
done ->
done
end;
bin_gen([], Bin, Bs0, _BBs0, _Mfun, _Efun, true) ->
{match, Bin, Bs0};
bin_gen([], Bin, _Bs0, _BBs0, _Mfun, _Efun, false) ->
{nomatch, Bin}.
bin_gen_field({bin_element,_,{string,_,S},default,default},
Bin, Bs, BBs, _Mfun, _Efun) ->
Bits = list_to_binary(S),
Size = byte_size(Bits),
case Bin of
<<Bits:Size/binary,Rest/bitstring>> ->
{match,Bs,BBs,Rest};
<<_:Size/binary,Rest/bitstring>> ->
{nomatch,Rest};
_ ->
done
end;
bin_gen_field({bin_element,Line,VE,Size0,Options0},
Bin, Bs0, BBs0, Mfun, Efun) ->
{Size1, [Type,{unit,Unit},Sign,Endian]} =
make_bit_type(Line, Size0, Options0),
V = erl_eval:partial_eval(VE),
match_check_size(Mfun, Size1, BBs0),
{value, Size, _BBs} = Efun(Size1, BBs0),
case catch get_value(Bin, Type, Size, Unit, Sign, Endian) of
{Val,<<_/bitstring>>=Rest} ->
NewV = coerce_to_float(V, Type),
case catch Mfun(match, {NewV,Val,Bs0}) of
{match,Bs} ->
BBs = add_bin_binding(Mfun, NewV, Bs, BBs0),
{match,Bs,BBs,Rest};
_ ->
{nomatch,Rest}
end;
_ ->
done
end.
%%% Part 3: binary pattern matching
%% @spec match_bits(Fields::[field()], Bin::binary(),
%% GlobalEnv::bindings(), LocalEnv::bindings(),
%% MatchFun::matchfun(),EvalFun::evalfun(), term()) ->
%% {match, bindings()}
%% @doc Used to perform matching. If the match succeeds a new
%% environment is returned. If the match have some syntactic or
%% semantic problem which would have been caught at compile time this
%% function throws 'invalid', if the matching fails for other reasons
%% the function throws 'nomatch'
match_bits(Fs, Bin, Bs0, BBs, Mfun, Efun, _) ->
match_bits(Fs, Bin, Bs0, BBs, Mfun, Efun).
match_bits(Fs, Bin, Bs0, BBs, Mfun, Efun)
when is_function(Mfun, 2), is_function(Efun, 2) ->
case catch match_bits_1(Fs, Bin, Bs0, BBs, Mfun, Efun) of
{match,Bs} -> {match,Bs};
invalid -> throw(invalid);
_Error -> throw(nomatch)
end.
match_bits_1([], <<>>, Bs, _BBs, _Mfun, _Efun) ->
{match,Bs};
match_bits_1([F|Fs], Bits0, Bs0, BBs0, Mfun, Efun) ->
{Bs,BBs,Bits} = match_field_1(F, Bits0, Bs0, BBs0, Mfun, Efun),
match_bits_1(Fs, Bits, Bs, BBs, Mfun, Efun).
match_field_1({bin_element,_,{string,_,S},default,default},
Bin, Bs, BBs, _Mfun, _Efun) ->
Bits = list_to_binary(S),
Size = byte_size(Bits),
<<Bits:Size/binary,Rest/binary-unit:1>> = Bin,
{Bs,BBs,Rest};
match_field_1({bin_element,Line,VE,Size0,Options0},
Bin, Bs0, BBs0, Mfun, Efun) ->
{Size1, [Type,{unit,Unit},Sign,Endian]} =
make_bit_type(Line, Size0, Options0),
V = erl_eval:partial_eval(VE),
Size2 = erl_eval:partial_eval(Size1),
match_check_size(Mfun, Size2, BBs0),
{value, Size, _BBs} = Efun(Size2, BBs0),
{Val,Rest} = get_value(Bin, Type, Size, Unit, Sign, Endian),
NewV = coerce_to_float(V, Type),
{match,Bs} = Mfun(match, {NewV,Val,Bs0}),
BBs = add_bin_binding(Mfun, NewV, Bs, BBs0),
{Bs,BBs,Rest}.
%% Almost identical to the one in sys_pre_expand.
coerce_to_float({integer,L,I}=E, float) ->
try
{float,L,float(I)}
catch
error:badarg -> E;
error:badarith -> E
end;
coerce_to_float(E, _Type) ->
E.
add_bin_binding(_, {var,_,'_'}, _Bs, BBs) ->
BBs;
add_bin_binding(Mfun, {var,_,Name}, Bs, BBs) ->
{value,Value} = Mfun(binding, {Name,Bs}),
Mfun(add_binding, {Name,Value,BBs});
add_bin_binding(_, _, _Bs, BBs) ->
BBs.
get_value(Bin, integer, Size, Unit, Sign, Endian) ->
get_integer(Bin, Size*Unit, Sign, Endian);
get_value(Bin, float, Size, Unit, _Sign, Endian) ->
get_float(Bin, Size*Unit, Endian);
get_value(Bin, utf8, undefined, _Unit, _Sign, _Endian) ->
<<I/utf8,Rest/bits>> = Bin,
{I,Rest};
get_value(Bin, utf16, undefined, _Unit, _Sign, big) ->
<<I/big-utf16,Rest/bits>> = Bin,
{I,Rest};
get_value(Bin, utf16, undefined, _Unit, _Sign, little) ->
<<I/little-utf16,Rest/bits>> = Bin,
{I,Rest};
get_value(Bin, utf32, undefined, _Unit, _Sign, big) ->
<<Val/big-utf32,Rest/bits>> = Bin,
{Val,Rest};
get_value(Bin, utf32, undefined, _Unit, _Sign, little) ->
<<Val/little-utf32,Rest/bits>> = Bin,
{Val,Rest};
get_value(Bin, binary, all, Unit, _Sign, _Endian) ->
0 = (bit_size(Bin) rem Unit),
{Bin,<<>>};
get_value(Bin, binary, Size, Unit, _Sign, _Endian) ->
TotSize = Size*Unit,
<<Val:TotSize/bitstring,Rest/bits>> = Bin,
{Val,Rest}.
get_integer(Bin, Size, signed, little) ->
<<Val:Size/little-signed,Rest/binary-unit:1>> = Bin,
{Val,Rest};
get_integer(Bin, Size, unsigned, little) ->
<<Val:Size/little,Rest/binary-unit:1>> = Bin,
{Val,Rest};
get_integer(Bin, Size, signed, native) ->
<<Val:Size/native-signed,Rest/binary-unit:1>> = Bin,
{Val,Rest};
get_integer(Bin, Size, unsigned, native) ->
<<Val:Size/native,Rest/binary-unit:1>> = Bin,
{Val,Rest};
get_integer(Bin, Size, signed, big) ->
<<Val:Size/signed,Rest/binary-unit:1>> = Bin,
{Val,Rest};
get_integer(Bin, Size, unsigned, big) ->
<<Val:Size,Rest/binary-unit:1>> = Bin,
{Val,Rest}.
get_float(Bin, Size, little) ->
<<Val:Size/float-little,Rest/binary-unit:1>> = Bin,
{Val,Rest};
get_float(Bin, Size, native) ->
<<Val:Size/float-native,Rest/binary-unit:1>> = Bin,
{Val,Rest};
get_float(Bin, Size, big) ->
<<Val:Size/float,Rest/binary-unit:1>> = Bin,
{Val,Rest}.
%% Identical to the one in sys_pre_expand.
make_bit_type(Line, default, Type0) ->
case erl_bits:set_bit_type(default, Type0) of
{ok,all,Bt} -> {{atom,Line,all},erl_bits:as_list(Bt)};
{ok,undefined,Bt} -> {{atom,Line,undefined},erl_bits:as_list(Bt)};
{ok,Size,Bt} -> {{integer,Line,Size},erl_bits:as_list(Bt)};
{error,Reason} -> error(Reason)
end;
make_bit_type(_Line, Size, Type0) -> %Size evaluates to an integer or 'all'
case erl_bits:set_bit_type(Size, Type0) of
{ok,Size,Bt} -> {Size,erl_bits:as_list(Bt)};
{error,Reason} -> error(Reason)
end.
match_check_size(Mfun, {var,_,V}, Bs) ->
case Mfun(binding, {V,Bs}) of
{value,_} -> ok;
unbound -> throw(invalid) % or, rather, error({unbound,V})
end;
match_check_size(_, {atom,_,all}, _Bs) ->
ok;
match_check_size(_, {atom,_,undefined}, _Bs) ->
ok;
match_check_size(_, {integer,_,_}, _Bs) ->
ok;
match_check_size(_, {value,_,_}, _Bs) ->
ok; %From the debugger.
match_check_size(_, _, _Bs) ->
throw(invalid).
%% error(Reason) -> exception thrown
%% Throw a nice-looking exception, similar to exceptions from erl_eval.
error(Reason) ->
erlang:raise(error, Reason, [{erl_eval,expr,3}]).
