asn1ct_gen.erl

来自「OTP是开放电信平台的简称」· ERL 代码 · 共 1,973 行 · 第 1/4 页

gen_part_decode_funcs({constructed,bif},TypeName,
		      {_Name,undecoded,Tag,_Type}) ->
    emit(["  'dec_",TypeName,"'(Data,",{asis,Tag},")"]);
gen_part_decode_funcs({primitive,bif},_TypeName,
		      {_Name,undecoded,Tag,Type}) ->
    % Argument no 6 is 0, i.e. bit 6 for primitive encoding.
    asn1ct_gen_ber_bin_v2:gen_dec_prim(ber_bin_v2,Type,"Data",Tag,[],0,", mandatory, ");
gen_part_decode_funcs(WhatKind,_TypeName,{_,Directive,_,_}) ->
    throw({error,{asn1,{"Not implemented yet",WhatKind," partial incomplete directive:",Directive}}}).
    
gen_types(Erules,Tname,{RootList,ExtList}) when list(RootList) ->
    gen_types(Erules,Tname,RootList),
    gen_types(Erules,Tname,ExtList);
gen_types(Erules,Tname,[{'EXTENSIONMARK',_,_}|Rest]) ->
    gen_types(Erules,Tname,Rest);
gen_types(Erules,Tname,[ComponentType|Rest]) ->
    Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules),
				       rt2ct_suffix(Erules)])),
    asn1ct_name:clear(),
    Rtmod:gen_encode(Erules,Tname,ComponentType),
    asn1ct_name:clear(),
    Rtmod:gen_decode(Erules,Tname,ComponentType),
    gen_types(Erules,Tname,Rest);
gen_types(_,_,[]) ->
    true;
gen_types(Erules,Tname,Type) when record(Type,type) ->
    Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules),
				       rt2ct_suffix(Erules)])),
    asn1ct_name:clear(),
    Rtmod:gen_encode(Erules,Tname,Type),
    asn1ct_name:clear(),
    Rtmod:gen_decode(Erules,Tname,Type).

gen_value_match(Module) ->
    case get(value_match) of
	{true,Module} ->
	    emit(["value_match([{Index,Cname}|Rest],Value) ->",nl,
		  "  Value2 =",nl,
		  "    case element(Index,Value) of",nl,
		  "      {Cname,Val2} -> Val2;",nl,
		  "      X -> X",nl,
		  "    end,",nl,
		  "  value_match(Rest,Value2);",nl,
		  "value_match([],Value) ->",nl,
		  "  Value.",nl]);
	_  -> ok
    end,
    put(value_match,undefined).

gen_check_defaultval(Erules,Module,[{Name,Type}|Rest]) ->
    gen_check_func(Name,Type),
    gen_check_defaultval(Erules,Module,Rest);
gen_check_defaultval(_,_,[]) ->
    ok.

gen_check_func(Name,FType = #type{def=Def}) ->
    emit({Name,"(V,asn1_DEFAULT) ->",nl,"   true;",nl}),
    emit({Name,"(V,V) ->",nl,"   true;",nl}),
    emit({Name,"(V,{_,V}) ->",nl,"   true;",nl}),
    case Def of
	{'SEQUENCE OF',Type} ->
	    gen_check_sof(Name,'SEQOF',Type);
	{'SET OF',Type} ->
	    gen_check_sof(Name,'SETOF',Type);
	#'SEQUENCE'{components=Components} ->
	    gen_check_sequence(Name,Components);
	#'SET'{components=Components} ->
	    gen_check_sequence(Name,Components);
	{'CHOICE',Components} ->
	    gen_check_choice(Name,Components);
	#'Externaltypereference'{type=T} ->
	    emit({Name,"(DefaultValue,Value) ->",nl}),
	    emit({"   ",list2name([T,check]),"(DefaultValue,Value).",nl});
	MaybePrim ->
	    InnerType = get_inner(MaybePrim),
	    case type(InnerType) of
		{primitive,bif} ->
		    emit({Name,"(DefaultValue,Value) ->",nl,"   "}),
		    gen_prim_check_call(InnerType,"DefaultValue","Value",
					FType),
		    emit({".",nl,nl});
		_ ->
		    throw({asn1_error,{unknown,type,MaybePrim}})
	    end
    end.

gen_check_sof(Name,SOF,Type) ->
    NewName = list2name([sorted,Name]),
    emit({Name,"(V1,V2) ->",nl}),
    emit({"   ",NewName,"(lists:sort(V1),lists:sort(V2)).",nl,nl}),
    emit({NewName,"([],[]) ->",nl,"   true;",nl}),
    emit({NewName,"([DV|DVs],[V|Vs]) ->",nl,"   "}),
    InnerType = get_inner(Type#type.def),
    case type(InnerType) of
	{primitive,bif} ->
	    gen_prim_check_call(InnerType,"DV","V",Type),
	    emit({",",nl});
	{constructed,bif} ->
	    emit({list2name([SOF,Name]),"(DV, V),",nl});
	#'Externaltypereference'{type=T} ->
	    emit({list2name([T,check]),"(DV,V),",nl})
    end,
    emit({"   ",NewName,"(DVs,Vs).",nl,nl}).

gen_check_sequence(Name,Components) ->
    emit({Name,"(DefaultValue,Value) ->",nl}),
    gen_check_sequence(Name,Components,1).
gen_check_sequence(Name,[#'ComponentType'{name=N,typespec=Type}|Cs],Num) ->
    InnerType = get_inner(Type#type.def),
%    NthDefV = lists:concat(["lists:nth(",Num,",DefaultValue)"]),
    NthDefV = ["element(",Num+1,",DefaultValue)"],
%    NthV = lists:concat(["lists:nth(",Num,",Value)"]),
    NthV = ["element(",Num+1,",Value)"],
    gen_check_func_call(Name,Type,InnerType,NthDefV,NthV,N),
    case Cs of
	[] ->
	    emit({".",nl,nl});
	_ ->
	    emit({",",nl}),
	    gen_check_sequence(Name,Cs,Num+1)
    end;
gen_check_sequence(_,[],_) ->
    ok.

gen_check_choice(Name,CList=[#'ComponentType'{}|_Cs]) ->
    emit({Name,"({Id,DefaultValue},{Id,Value}) ->",nl}),
    emit({"   case Id of",nl}),
    gen_check_choice_components(Name,CList,1).

gen_check_choice_components(_,[],_)->
    ok;
gen_check_choice_components(Name,[#'ComponentType'{name=N,typespec=Type}|
				  Cs],Num) ->
    Ind6 = "      ",
    InnerType = get_inner(Type#type.def),
%    DefVal = ["element(2,lists:nth(",Num,",DefaultValue))"],
    emit({Ind6,N," ->",nl,Ind6}),
    gen_check_func_call(Name,Type,InnerType,{var,"defaultValue"},
			{var,"value"},N),
    case Cs of
	[] ->
	    emit({nl,"   end.",nl,nl});
	_ ->
	    emit({";",nl}),
	    gen_check_choice_components(Name,Cs,Num+1)
    end.

gen_check_func_call(Name,Type,InnerType,DefVal,Val,N) ->
    case type(InnerType) of
	{primitive,bif} ->
	    emit("   "),
	    gen_prim_check_call(InnerType,DefVal,Val,Type);
	#'Externaltypereference'{type=T} ->
	    emit({"   ",list2name([T,check]),"(",DefVal,",",Val,")"});
	_ ->
	    emit({"   ",list2name([N,Name]),"(",DefVal,",",Val,")"})
    end.
		  
    
%% VARIOUS GENERATOR STUFF 
%% *************************************************
%%**************************************************

mk_var(X) when atom(X) ->
    list_to_atom(mk_var(atom_to_list(X)));

mk_var([H|T]) ->
    [H-32|T].

%% Since hyphens are allowed in ASN.1 names, it may occur in a
%% variable to. Turn a hyphen into a under-score sign.
un_hyphen_var(X) when atom(X) ->
    list_to_atom(un_hyphen_var(atom_to_list(X)));
un_hyphen_var([45|T]) ->
    [95|un_hyphen_var(T)];
un_hyphen_var([H|T]) ->
    [H|un_hyphen_var(T)];
un_hyphen_var([]) ->
    [].

%% Generate value functions ***************
%% ****************************************
%% Generates a function 'V'/0 for each Value V defined in the ASN.1 module
%% the function returns the value in an Erlang representation which can be
%% used as  input to the runtime encode functions

gen_value(Value) when record(Value,valuedef) ->
%%    io:format(" ~w ",[Value#valuedef.name]),
    emit({"'",Value#valuedef.name,"'() ->",nl}),
    V = Value#valuedef.value,
    emit([{asis,V},".",nl,nl]).

gen_encode_constructed(Erules,Typename,InnerType,D) when record(D,type) ->

    Rtmod = list_to_atom(lists:concat(["asn1ct_constructed_",erule(Erules)])),
    case InnerType of
	'SET' ->
	    Rtmod:gen_encode_set(Erules,Typename,D),
	    #'SET'{components=Components} = D#type.def,
	    gen_types(Erules,Typename,Components);
	'SEQUENCE' ->
	    Rtmod:gen_encode_sequence(Erules,Typename,D),
	    #'SEQUENCE'{components=Components} = D#type.def,
	    gen_types(Erules,Typename,Components);
	'CHOICE' ->
	    Rtmod:gen_encode_choice(Erules,Typename,D),
	    {_,Components} = D#type.def,
	    gen_types(Erules,Typename,Components);
	'SEQUENCE OF' ->
	    Rtmod:gen_encode_sof(Erules,Typename,InnerType,D),
	    {_,Type} = D#type.def,
	    NameSuffix = asn1ct_gen:constructed_suffix(InnerType,Type#type.def),
	    gen_types(Erules,[NameSuffix|Typename],Type);
	'SET OF' ->
	    Rtmod:gen_encode_sof(Erules,Typename,InnerType,D),
	    {_,Type} = D#type.def,
	    NameSuffix = asn1ct_gen:constructed_suffix(InnerType,Type#type.def),
	    gen_types(Erules,[NameSuffix|Typename],Type);
	_ ->
	    exit({nyi,InnerType})
    end;
gen_encode_constructed(Erules,Typename,InnerType,D) 
  when record(D,typedef) ->
    gen_encode_constructed(Erules,Typename,InnerType,D#typedef.typespec).

gen_decode_constructed(Erules,Typename,InnerType,D) when record(D,type) ->
    Rtmod = list_to_atom(lists:concat(["asn1ct_constructed_",erule(Erules)])),
    asn1ct:step_in_constructed(), %% updates namelist for exclusive decode
    case InnerType of
	'SET' ->
	    Rtmod:gen_decode_set(Erules,Typename,D);
	'SEQUENCE' ->
	    Rtmod:gen_decode_sequence(Erules,Typename,D);
	'CHOICE' ->
	    Rtmod:gen_decode_choice(Erules,Typename,D);
	'SEQUENCE OF' ->
	    Rtmod:gen_decode_sof(Erules,Typename,InnerType,D);
	'SET OF' ->
	    Rtmod:gen_decode_sof(Erules,Typename,InnerType,D);
	_ ->
	    exit({nyi,InnerType})
    end;


gen_decode_constructed(Erules,Typename,InnerType,D) when record(D,typedef) ->
    gen_decode_constructed(Erules,Typename,InnerType,D#typedef.typespec).


pgen_exports(Erules,_Module,{Types,Values,_,_,Objects,ObjectSets}) ->
    emit({"-export([encoding_rule/0]).",nl}),
    case Types of
	[] -> ok;
	_ ->
	    emit({"-export([",nl}),
	    case Erules of
		ber ->
		    gen_exports1(Types,"enc_",2);
		ber_bin ->
		    gen_exports1(Types,"enc_",2);
		ber_bin_v2 ->
		    gen_exports1(Types,"enc_",2);
		_ ->
		    gen_exports1(Types,"enc_",1)
	    end,
	    emit({"-export([",nl}),
	    gen_exports1(Types,"dec_",2),
	    case Erules of
		ber ->
		    emit({"-export([",nl}),
		    gen_exports1(Types,"dec_",3);
		ber_bin ->
		    emit({"-export([",nl}),
		    gen_exports1(Types,"dec_",3);
% 		ber_bin_v2 ->
% 		    emit({"-export([",nl}),
% 		    gen_exports1(Types,"dec_",2);
		_ -> ok
	    end
    end,
    case Values of
	[] -> ok;
	_ ->
	    emit({"-export([",nl}),
	    gen_exports1(Values,"",0)
    end,
    case Objects of
	[] -> ok;
	_ ->
	    case erule(Erules) of
		per ->
		    emit({"-export([",nl}),
		    gen_exports1(Objects,"enc_",3),
		    emit({"-export([",nl}),
		    gen_exports1(Objects,"dec_",4);
		ber_bin_v2 ->
		    emit({"-export([",nl}),
		    gen_exports1(Objects,"enc_",3),
		    emit({"-export([",nl}),
		    gen_exports1(Objects,"dec_",3);
		_ -> 
		    emit({"-export([",nl}),
		    gen_exports1(Objects,"enc_",4),
		    emit({"-export([",nl}),
		    gen_exports1(Objects,"dec_",4)
	    end
    end,
    case ObjectSets of
	[] -> ok;
	_ ->
	    emit({"-export([",nl}),
	    gen_exports1(ObjectSets,"getenc_",2),
	    emit({"-export([",nl}),
	    gen_exports1(ObjectSets,"getdec_",2)
    end,
    emit({"-export([info/0]).",nl}),
    gen_partial_inc_decode_exports(),
    gen_selected_decode_exports(),
    emit({nl,nl}).

gen_exports1([F1,F2|T],Prefix,Arity) ->
	emit({"'",Prefix,F1,"'/",Arity,com,nl}),
	gen_exports1([F2|T],Prefix,Arity);
gen_exports1([Flast|_T],Prefix,Arity) ->
	emit({"'",Prefix,Flast,"'/",Arity,nl,"]).",nl,nl}).

gen_partial_inc_decode_exports() ->
    case {asn1ct:read_config_data(partial_incomplete_decode),
	  asn1ct:get_gen_state_field(inc_type_pattern)}  of
	{undefined,_} ->
	    ok;
	{_,undefined} ->
	    ok;
	{Data,_} ->
	    gen_partial_inc_decode_exports(Data),
	    emit(["-export([decode_part/2]).",nl])
    end.
gen_partial_inc_decode_exports([]) ->
    ok;
gen_partial_inc_decode_exports([{Name,_,_}|Rest]) ->
    emit(["-export([",Name,"/1"]),
    gen_partial_inc_decode_exports1(Rest);
gen_partial_inc_decode_exports([_|Rest]) ->
    gen_partial_inc_decode_exports(Rest).

gen_partial_inc_decode_exports1([]) ->
    emit(["]).",nl]);
gen_partial_inc_decode_exports1([{Name,_,_}|Rest]) ->
    emit([", ",Name,"/1"]),
    gen_partial_inc_decode_exports1(Rest);
gen_partial_inc_decode_exports1([_|Rest]) ->
    gen_partial_inc_decode_exports1(Rest).

gen_selected_decode_exports() ->
    case asn1ct:get_gen_state_field(type_pattern) of
	undefined ->
	    ok;
	L ->
	   gen_selected_decode_exports(L)
    end.

gen_selected_decode_exports([]) ->
    ok;
gen_selected_decode_exports([{FuncName,_}|Rest]) ->
    emit(["-export([",FuncName,"/1"]),
    gen_selected_decode_exports1(Rest).
gen_selected_decode_exports1([]) ->
    emit(["]).",nl,nl]);
gen_selected_decode_exports1([{FuncName,_}|Rest]) ->
    emit([",",nl,"          ",FuncName,"/1"]),
    gen_selected_decode_exports1(Rest).

pgen_dispatcher(Erules,_Module,{[],_Values,_,_,_Objects,_ObjectSets}) ->
    emit(["encoding_rule() ->",nl]),
    emit([{asis,Erules},".",nl,nl]);
pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) ->
    emit(["-export([encode/2,decode/2,encode_disp/2,decode_disp/2]).",nl,nl]),
    emit(["encoding_rule() ->",nl]),
    emit(["   ",{asis,Erules},".",nl,nl]),
    Call = case Erules of
	       per -> "?RT_PER:complete(encode_disp(Type,Data))";
	       per_bin -> "?RT_PER:complete(encode_disp(Type,Data))";
	       ber -> "encode_disp(Type,Data)";
	       ber_bin -> "encode_disp(Type,Data)";
	       ber_bin_v2 -> "encode_disp(Type,Data)"
	   end,
    EncWrap = case Erules of
	       ber -> "wrap_encode(Bytes)";
	       _ -> "Bytes"
	   end,
    emit(["encode(Type,Data) ->",nl,
	  "case catch ",Call," of",nl,
	  "  {'EXIT',{error,Reason}} ->",nl,
	  "    {error,Reason};",nl,
	  "  {'EXIT',Reason} ->",nl,
	  "    {error,{asn1,Reason}};",nl,
	  "  {Bytes,_Len} ->",nl,
	  "    {ok,",EncWrap,"};",nl]),
    case Erules of
	per ->
	    emit(["  Bytes when is_binary(Bytes) ->",nl,
		  "    {ok,binary_to_list(Bytes)};",nl,
		  "  Bytes ->",nl,
		  "    {ok,binary_to_list(list_to_binary(Bytes))}",nl,
		  "  end.",nl,nl]);
	_ ->
	    emit(["  Bytes ->",nl,
		  "    {ok,",EncWrap,"}",nl,
		  "end.",nl,nl])
    end,

%     case Erules of
% 	ber_bin_v2 ->
% 	    emit(["decode(Type,Data0) ->",nl]),
% 	    emit(["{Data,_RestBin} = ?RT_BER:decode(Data0",driver_parameter(),"),",nl]);
% 	_ ->
% 	    emit(["decode(Type,Data) ->",nl])
%     end,

    Return_rest = lists:member(undec_rest,get(encoding_options)),
    Data = case {Erules,Return_rest} of
	       {ber_bin_v2,true} -> "Data0";
	       _ -> "Data"
	   end,

    emit(["decode(Type,",Data,") ->",nl]),
    DecAnonymous =
	case {Erules,Return_rest} of
	    {ber_bin_v2,false} ->
		io_lib:format("~s~s~s~n",
			      ["element(1,?RT_BER:decode(Data",
			       driver_parameter(),"))"]);
	    {ber_bin_v2,true} ->
		emit(["{Data,Rest} = ?RT_BER:decode(Data0",
		      driver_parameter(),"),",nl]),
		"Data";
	    _ ->
		"Data"
	end,
    DecWrap = case Erules of
		  ber -> "wrap_decode(Data)";
		  ber_bin_v2 ->
		      DecAnonymous;
		  per -> "list_to_binary(Data)";
		  _ -> "Data"
	      end,
	    
    emit(["case catch decode_disp(Type,",DecWrap,") of",nl,
	  "  {'EXIT',{error,Reason}} ->",nl,
	  "    {error,Reason};",nl,
	  "  {'EXIT',Reason} ->",nl,
	  "    {error,{asn1,Reason}};",nl]),
    case {Erules,Return_rest} of 
	{ber_bin_v2,false} ->
	    emit(["  Result ->",nl,
		  "    {ok,Result}",nl]);
	{ber_bin_v2,true} ->
	    emit(["  Result ->",nl,
		  "    {ok,Result,Rest}",nl]);
	{per,false} ->
	    emit(["  {X,_Rest} ->",nl,
		  "    {ok,if_binary2list(X)};",nl,
		  "  {X,_Rest,_Len} ->",nl,
		  "    {ok,if_binary2list(X)}",nl]);
	{_,false} ->
	    emit(["  {X,_Rest} ->",nl,
		  "    {ok,X};",nl,
		  "  {X,_Rest,_Len} ->",nl,
		  "    {ok,X}",nl]);
	{per,true}  ->
	    emit(["  {X,{_,Rest}} ->",nl,
		  "    {ok,if_binary2list(X),Rest};",nl,
		  "  {X,{_,Rest},_Len} ->",nl,
		  "    {ok,if_binary2list(X),Rest};",nl,
		  "  {X,Rest} ->",nl,
		  "    {ok,if_binary2list(X),Rest};",nl,
		  "  {X,Rest,_Len} ->",nl,
		  "    {ok,if_binary2list(X),Rest}",nl]);
	{per_bin,true} ->
	    emit(["  {X,{_,Rest}} ->",nl,
		  "    {ok,X,Rest};",nl,
		  "  {X,{_,Rest},_Len} ->",nl,
		  "    {ok,X,Rest};",nl,
		  "  {X,Rest} ->",nl,
		  "    {ok,X,Rest};",nl,
		  "  {X,Rest,_Len} ->",nl,
		  "    {ok,X,Rest}",nl]);
	_ ->
	    emit(["  {X,Rest} ->",nl,
		  "    {ok,X,Rest};",nl,
		  "  {X,Rest,_Len} ->",nl,
		  "    {ok,X,Rest}",nl])
    end,
    emit(["end.",nl,nl]),