aboutsummaryrefslogtreecommitdiffstats
path: root/lib/ic/src/ic_pragma.erl
diff options
context:
space:
mode:
authorErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
committerErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
commit84adefa331c4159d432d22840663c38f155cd4c1 (patch)
treebff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/ic/src/ic_pragma.erl
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/ic/src/ic_pragma.erl')
-rw-r--r--lib/ic/src/ic_pragma.erl1957
1 files changed, 1957 insertions, 0 deletions
diff --git a/lib/ic/src/ic_pragma.erl b/lib/ic/src/ic_pragma.erl
new file mode 100644
index 0000000000..9165e3b03b
--- /dev/null
+++ b/lib/ic/src/ic_pragma.erl
@@ -0,0 +1,1957 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. 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(ic_pragma).
+
+
+-export([pragma_reg/2,pragma_cover/3]).
+-export([pragma_prefix/3,pragma_version/3,pragma_id/3]).
+-export([mk_alias/3,get_alias/2,scope2id/2,id2scope/2,mk_scope/1]).
+-export([mk_ref/3,get_incl_refs/1,get_local_refs/1]).
+-export([get_dependencies/1, add_inh_data/3, preproc/3]).
+-export([getBrokerData/3,defaultBrokerData/1,list_to_term/1]).
+-export([get_local_c_headers/2,get_included_c_headers/1,is_inherited_by/3]).
+-export([no_doubles/1,fetchRandomLocalType/1,fetchLocalOperationNames/2]).
+-export([is_local/2]).
+
+%% Debug
+-export([print_tab/1,slashify/1,is_short/1]).
+
+-import(lists,[suffix/2,delete/2,reverse/1,keysearch/3,member/2,last/1,flatten/1]).
+-import(string,[tokens/2]).
+-import(ets,[insert/2,lookup/2]).
+
+-import(ic_forms, [get_id2/1, get_body/1, get_line/1]).
+-import(ic_util, [to_atom/1]).
+-import(ic_genobj, [idlfile/1]).
+-import(ic_options, [get_opt/2]).
+
+-include("icforms.hrl").
+-include("ic.hrl").
+
+
+
+
+%% Initialization of the pragma table and
+%% start of pragma registration.
+%% NOTE : this pragma registration is build
+%% as a separate stage under compilation.
+%% If it is to be optimised, it should be
+%% embodied in one of other compiling stages.
+pragma_reg(G,X) ->
+ S = ic_genobj:pragmatab(G),
+ init_idlfile(G,S),
+ init_pragma_status(S),
+ registerOptions(G,S),
+ pragma_reg_all(G, S, [], X),
+ denote_specific_code_opts(G), %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ case get_pragma_compilation_status(S) of
+ true ->
+ %% Remove ugly pragmas from form
+ PragmaCleanForm = cleanup(X),
+ {ok,PragmaCleanForm};
+ false ->
+ ErrorNr = get_pragma_error_nr(S),
+ %% Just print the number of errors found
+ case ErrorNr > 1 of
+ true ->
+ io:format("There were ~p errors found on file ~p~n",
+ [ErrorNr,get_idlfile(S)]),
+ error;
+ false ->
+ io:format("There were ~p error found on file ~p~n",
+ [ErrorNr,get_idlfile(S)]),
+ error
+ end
+ end.
+
+
+
+registerOptions(G,S) ->
+ OptList = ets:tab2list(ic_genobj:optiontab(G)),
+ registerOptions(G,S,OptList).
+
+
+registerOptions(_G,_S,[]) ->
+ true;
+registerOptions(G,S,[{{option,{broker,Scope}},{Mod,Type}}|Rest]) ->
+ insert(S,
+ {codeopt,
+ reverse(tokens(Scope,":")),
+ {broker,{Mod,Type}},
+ -1,
+ nil,
+ nil}),
+ registerOptions(G,S,Rest);
+registerOptions(G,S,[_|Rest]) ->
+ registerOptions(G,S,Rest).
+
+
+%% Decide if to apply pragmas
+%% by checking backend switch
+applyPragmasInBe(G) ->
+ case get_opt(G, be) of
+ erl_plain ->
+ false;
+ _ ->
+ true
+ end.
+
+
+%% Decide if the code option directive
+%% is allowed to change backend
+applyCodeOpt(G) ->
+ case get_opt(G, be) of
+ erl_corba -> %% Does not support codeopt
+ false;
+ erl_plain -> %% Does not support codeopt
+ false;
+ c_native -> %% Does not support codeopt
+ false;
+ _ ->
+ true
+ end.
+
+
+
+%% This removes all pragma records from the form.
+%% When debugged, it can be enbodied in pragma_reg_all.
+cleanup([],C) -> C;
+cleanup([X|Xs],CSF) ->
+ cleanup(Xs, CSF++cleanup(X)).
+
+cleanup(X) when is_list(X) -> cleanup(X,[]);
+cleanup(X) when is_record(X, preproc) -> [X];
+cleanup(X) when is_record(X, pragma) -> [];
+cleanup(X) when is_record(X, op) -> % Clean inside operation parameters
+ [ X#op{params = cleanup(X#op.params,[])}];
+
+cleanup(X) when is_record(X, module) -> % Clean inside module body
+ [ X#module{body = cleanup(X#module.body,[])}];
+
+cleanup(X) when is_record(X, interface) -> % Clean inside interface body
+ [ X#interface{body = cleanup(X#interface.body,[])}];
+
+cleanup(X) when is_record(X, except) -> % Clean inside exception body
+ [ X#except{body = cleanup(X#except.body,[])}];
+
+cleanup(X) when is_record(X, struct) -> % Clean inside struct body
+ [ X#struct{body = cleanup(X#struct.body,[])}];
+
+cleanup(X) when is_record(X, case_dcl) -> % Clean inside union body
+ [ X#case_dcl{label = cleanup(X#case_dcl.label,[])}];
+
+cleanup(X) when is_record(X, union) -> % Clean inside union body
+ [ X#union{body = cleanup(X#union.body,[])}];
+
+cleanup(X) when is_record(X, enum) -> % Clean inside enum body
+ [ X#enum{body = cleanup(X#enum.body,[])}];
+
+cleanup(X) -> [X].
+
+
+
+
+%% pragma_reg_all is top level registration for pragmas
+pragma_reg_all(_G, _S, _N, []) -> ok;
+pragma_reg_all(G, S, N, [X|Xs]) ->
+ pragma_reg(G, S, N, X),
+ pragma_reg_all(G, S, N, Xs).
+
+
+%% pragma_reg is top level registration for pragmas
+pragma_reg(G, S, N, X) when is_list(X) -> pragma_reg_list(G, S, N, X);
+pragma_reg(_G, S, _N, X) when element(1, X) == preproc ->
+ case X#preproc.aux of
+ [{_, _, "1"}] ->
+ IncludeEntryLNr = get_line(X#preproc.id),
+ IncludeFileName = element(3,element(3,X)),
+ insert(S,{includes,get_idlfile(S),IncludeFileName,IncludeEntryLNr});
+ _Other ->
+ ok
+ end,
+ set_idlfile(S,element(3,element(3,X)));
+pragma_reg(G, S, N, X) when element(1, X) == pragma ->
+ case applyPragmasInBe(G) of
+
+ %% Pragmas are allowed to be
+ %% applied in this this backend.
+ true ->
+
+ File = get_idlfile(S), % The current file or an included one.
+ Type = case idlfile(G) of % Local/Included flag
+ File ->
+ local;
+ _ ->
+ included
+ end,
+
+ %% Register pragmas into pragmatab.
+ case X of
+ {pragma,{_,LineNr,"prefix"}, _To, _Apply} ->
+ insert(S,{prefix,X,LineNr,N,File,Type});
+
+ {pragma,{_,_,"ID"},_,_} ->
+ pragma_reg_ID(G, S, N, X);
+
+ {pragma,{_,_,"version"},_,_} ->
+ pragma_reg_version(G, S, N, X );
+
+ {pragma,{_,_,"CODEOPT"},_,_} ->
+ pragma_reg_codeOpt(G,S,N,X);
+
+ {pragma,{_,LineNr,BadPragma}, _To, _Apply} ->
+ io:format("Warning : on file ~p :~n",[get_idlfile(S)]),
+ io:format(" Unknown pragma directive ~p on line ~p, ignored.~n",
+ [BadPragma,LineNr])
+ end;
+
+ %% Pragmas are not to be applied in
+ %% this backend, ignore all pragmas.
+ false ->
+ true
+ end,
+ ok;
+
+pragma_reg(G, S, N, X) when is_record(X, module) ->
+ mk_ref(G,[get_id2(X) | N],mod_ref),
+ mk_file_data(G,X,N,module),
+ pragma_reg_all(G, S, [get_id2(X) | N], get_body(X));
+
+pragma_reg(G, S, N, X) when is_record(X, interface) ->
+ mk_ref(G,[get_id2(X) | N],ifc_ref),
+ mk_file_data(G,X,N,interface),
+ pragma_reg_all(G, S, [get_id2(X) | N], get_body(X));
+
+pragma_reg(G, S, N, X) when is_record(X, op) ->
+ %% Add operation in table
+ insert(S,{op,
+ get_id2(X),
+ N,
+ get_idlfile(S),
+ get_filepath(S)}),
+ mk_file_data(G,X,N,op),
+ pragma_reg_all(G, S, N, X#op.params);
+
+pragma_reg(G, S, N, X) when is_record(X, except) ->
+ mk_ref(G,[get_id2(X) | N],except_ref),
+ mk_file_data(G,X,N,except),
+ pragma_reg_all(G, S, N, X#except.body);
+
+pragma_reg(G, _S, N, X) when is_record(X, const) ->
+ mk_ref(G,[get_id2(X) | N],const_ref),
+ mk_file_data(G,X,N,const);
+
+pragma_reg(G, _S, N, X) when is_record(X, typedef) ->
+ XX = #id_of{type=X},
+ lists:foreach(fun(Id) ->
+ mk_ref(G,[get_id2(Id) | N],typedef_ref),
+ mk_file_data(G,XX#id_of{id=Id},N,typedef)
+ end,
+ ic_forms:get_idlist(X));
+
+pragma_reg(G, S, N, X) when is_record(X, enum) ->
+ mk_ref(G,[get_id2(X) | N],enum_ref),
+ mk_file_data(G,X,N,enum),
+ pragma_reg_all(G, S, N, X#enum.body);
+
+pragma_reg(G, S, N, X) when is_record(X, union) ->
+ mk_ref(G,[get_id2(X) | N],union_ref),
+ mk_file_data(G,X,N,union),
+ pragma_reg_all(G, S, N, X#union.body);
+
+pragma_reg(G, S, N, X) when is_record(X, struct) ->
+ mk_ref(G,[get_id2(X) | N],struct_ref),
+ mk_file_data(G,X,N,struct),
+ pragma_reg_all(G, S, N, X#struct.body);
+
+pragma_reg(G, _S, N, X) when is_record(X, attr) ->
+ XX = #id_of{type=X},
+ lists:foreach(fun(Id) ->
+ mk_ref(G,[get_id2(Id) | N],attr_ref),
+ mk_file_data(G,XX#id_of{id=Id},N,attr)
+ end,
+ ic_forms:get_idlist(X));
+
+pragma_reg(_G, _S, _N, _X) -> ok.
+
+
+
+
+pragma_reg_list(_G, _S, _N, []) -> ok;
+pragma_reg_list(G, S, N, List ) ->
+ CurrentFileName = get_idlfile(S),
+ pragma_reg_list(G, S, N, CurrentFileName, List).
+
+pragma_reg_list(_G, _S, _N, _CFN, []) -> ok;
+pragma_reg_list(G, S, N, CFN, [X | Xs]) ->
+ case X of
+ {preproc,_,{_,_,FileName},_} ->
+ set_idlfile(S,FileName),
+ pragma_reg(G, S, N, X),
+ pragma_reg_list(G, S, N, FileName, Xs);
+ _ ->
+ pragma_reg(G, S, N, X),
+ pragma_reg_list(G, S, N, CFN, Xs)
+ end.
+
+
+
+
+
+pragma_reg_ID(G, S, N, X) ->
+ {pragma,{_,LineNr,"ID"}, _To, Apply} = X,
+
+
+ File = get_idlfile(S), % The current file or an included one.
+ Type = case idlfile(G) of % Local/Included flag
+ File ->
+ local;
+ _ ->
+ included
+ end,
+
+ %% Check if ID is one of the allowed types :
+ %% * OMG IDL
+ %% * DCE UUID
+ %% * LOCAL
+ case tokens(element(3,Apply),":") of
+ ["IDL",_,_] ->
+ insert(S,{id,X,LineNr,N,File,Type});
+ ["DCE",_,VSN] ->
+ case is_short(VSN) of
+ true ->
+ insert(S,{id,X,LineNr,N,File,Type});
+ false ->
+ set_compilation_failure(S),
+ io:format("Error on file ~p :~n",[get_idlfile(S)]),
+ io:format(" Bad pragma ID ~p on line ~p,~n",
+ [element(3,Apply),LineNr]),
+ io:format(" the version part of ID is not a short integer.~n")
+ end;
+ ["LOCAL"|_] ->
+ insert(S,{id,X,LineNr,N,File,Type});
+ _ ->
+ set_compilation_failure(S),
+ io:format("Error on file ~p :~n",[get_idlfile(S)]),
+ io:format(" Bad pragma ID ~p on line ~p.~n",
+ [element(3,Apply),LineNr])
+ end.
+
+
+
+pragma_reg_version(G, S, N, X) ->
+ {pragma,{_,LineNr,"version"}, _To, Apply} = X,
+
+ File = get_idlfile(S), % The current file or an included one.
+ Type = case idlfile(G) of % Local/Included flag
+ File ->
+ local;
+ _ ->
+ included
+ end,
+
+ case tokens(Apply,".") of
+ [Major,Minor] ->
+ case is_short(Major) and is_short(Minor) of
+ true ->
+ insert(S,{version,X,LineNr,N,File,Type});
+ false ->
+ set_compilation_failure(S),
+ io:format("Error on file ~p :~n",[get_idlfile(S)]),
+ io:format(" Bad pragma version ~p on line ~p,~n",
+ [Apply,LineNr]),
+ io:format(" the version is not valid.~n")
+ end;
+ _ ->
+ set_compilation_failure(S),
+ io:format("Error on file ~p :~n",[get_idlfile(S)]),
+ io:format(" Bad pragma version ~p on line ~p,~n",
+ [Apply,LineNr]),
+ io:format(" the version is not valid.~n")
+ end.
+
+
+pragma_reg_codeOpt(G, S, _N, {pragma,{_,LineNr,"CODEOPT"},_,Apply} )->
+ case applyCodeOpt(G) of
+ true ->
+ {_,_,OptionList_str} = Apply,
+ case list_to_term(OptionList_str) of
+ error ->
+ ic_error:error(G,{pragma_code_opt_bad_option_list,LineNr});
+ OptionList ->
+ case lists:keysearch(be,1,OptionList) of
+ false ->
+ %% Add the terms of the option list
+ %% to the compiler option list
+ applyCodeOpts(G,S,LineNr,OptionList);
+ {value, {be,Type}} ->
+ %% If backend is set from user,
+ %% let the same backend be otherwize
+ %% set backend by codeOpt directive
+ case get_opt(G, be) of
+ false ->
+ %% Add the terms of the option list
+ %% to the compiler option list
+ applyCodeOpts(G,S,LineNr,OptionList);
+ _ ->
+ %% Add all the terms of the option list
+ %% to the compiler option list but the
+ %% backend option
+ applyCodeOpts(G,
+ S,
+ LineNr,
+ lists:delete({be,Type},OptionList))
+ end
+ end
+ end;
+ false ->
+ true
+ end.
+
+
+
+applyCodeOpts(_,_,_,[]) ->
+ true;
+applyCodeOpts(G,S,LNr,[{{broker,Scope},{M,T}}|Xs]) ->
+ ScopedId = reverse(tokens(Scope,":")),
+ case ets:match(S,
+ {codeopt,ScopedId,
+ '$1','$2','_','_'}) of
+ [] ->
+ %% Add pragma in table
+ insert(S,
+ {codeopt,
+ ScopedId,
+ {broker,{M,T}},
+ LNr,
+ get_idlfile(S),
+ get_filepath(S)}),
+ %% Continue
+ applyCodeOpts(G,S,LNr,Xs);
+ _ ->
+ %% Use the code option
+ %% from user and continue
+ applyCodeOpts(G,S,LNr,Xs)
+ end;
+applyCodeOpts(G,S,LNr,[X|Xs]) ->
+ case is_allowed_opt(X) of
+ true ->
+ %% Add that term of the option list
+ %% to the compiler option list
+ ic_options:add_opt(G, [X], true),
+ %% Continue
+ applyCodeOpts(G,S,LNr,Xs);
+ false ->
+ %% Print warning and continue
+ io:format("Warning on file ~p :~n",[get_idlfile(S)]),
+ io:format(" Bad option in pragma : ~p, ignored !~n",[X]),
+ applyCodeOpts(G,S,LNr,Xs)
+ end.
+
+
+is_allowed_opt({X,Y}) ->
+ ic_options:allowed_opt(X,Y);
+is_allowed_opt(_X) ->
+ false.
+
+
+
+%% Returns a tuple { PFX, VSN, ID }, that is the
+%% pragma prefix, version and id coverages of
+%% the scope SCOPE. This is done by use of the
+%% function pragma_cover/4.
+pragma_cover(G,Scope,Object) ->
+ pragma_cover(ic_genobj:pragmatab(G),get_id2(Object),Scope,get_line(Object)).
+
+%% Returns a tuple { PFX, VSN, ID }, that is the
+%% pragma prefix, version and id coverages of
+%% the scope SCOPE
+pragma_cover(PragmaTab,Name,Scope,LineNr) ->
+ PFX = pragma_prefix_cover(PragmaTab,Name,Scope,LineNr),
+ VSN = pragma_version_cover(PragmaTab,Name,Scope,LineNr),
+ ID = pragma_id_cover(PragmaTab,Name,Scope,LineNr),
+ { PFX, VSN, ID }.
+
+
+
+%% Finds out which pragma PREFIX that affects
+%% the scope Scope
+pragma_prefix(G,Scope,Object) ->
+ pragma_prefix_cover(ic_genobj:pragmatab(G),get_id2(Object),Scope,get_line(Object)).
+
+
+%% Finds out which pragma PREFIX that affects
+%% the scope Scope
+pragma_prefix_cover(PragmaTab,Name,Scope,LineNr) ->
+ case lookup(PragmaTab,prefix) of
+ [] ->
+ none;
+ PragmaPrefixList ->
+ FilteredPragmaPrefixList =
+ filter_pragma_prefix_list(PragmaTab,Name,Scope,PragmaPrefixList),
+ case most_local(FilteredPragmaPrefixList,Scope) of
+ [] ->
+ none;
+ MostLocalList ->
+ case dominant_prefix(MostLocalList,LineNr) of
+ none ->
+ none;
+
+ %% Just filter empty pragma prefix
+ {prefix,{pragma,{_,_,_},_,{'<string_literal>',_,[]}},_,_,_,_} ->
+ none;
+
+ DP ->
+ %% Return the scoped id (reversed list of
+ %% path elements, but remember to remove
+ %% '[]' that represents the top level
+ slashify(lists:sublist(Scope, 1,
+ length(Scope) - length(element(4,DP))) ++
+ [ element(3,element(4,element(2,DP)))])
+ end
+ end
+ end.
+
+
+%% Returns a slashified name, [I1, M1] becomes "M1/I1"
+slashify(List) -> lists:foldl(fun(X, Acc) -> X++"/"++Acc end,
+ hd(List), tl(List)).
+
+
+%% Finds out which pragma VERSION that affects
+%% the scope Scope
+pragma_version(G,Scope,Object) ->
+ pragma_version_cover(ic_genobj:pragmatab(G),get_id2(Object),Scope,get_line(Object)).
+
+%% Finds out which pragma VERSION that affects
+%% the scope Scope
+pragma_version_cover(PragmaTab,Name,Scope,LineNr) ->
+ case lookup(PragmaTab,version) of
+ [] ->
+ default_version();
+ PragmaVersionList ->
+ case all_actual_for_version_or_id( PragmaVersionList, Name ) of
+ [] ->
+ default_version();
+ ActualVersionList ->
+ case most_local(ActualVersionList,Scope) of
+ [] ->
+ default_version();
+ MostLocalList ->
+ case dominant_version(MostLocalList,LineNr) of
+ DV ->
+ element(4,element(2,DV))
+ end
+ end
+ end
+ end.
+
+
+default_version() -> "1.0".
+
+
+
+%% Finds out which pragma ID that affects
+%% the scope Scope
+pragma_id(G,Scope,Object) ->
+ pragma_id_cover(ic_genobj:pragmatab(G),get_id2(Object),Scope,get_line(Object)).
+
+%% Finds out which pragma ID that affects
+%% the scope Scope
+pragma_id_cover(PragmaTab,Name,Scope,LineNr) ->
+ case lookup(PragmaTab,id) of
+ [] ->
+ none;
+ PragmaIdList ->
+ case all_actual_for_version_or_id( PragmaIdList, Name ) of
+ [] ->
+ none;
+ ActualIdList ->
+ case most_local(ActualIdList,Scope) of
+ [] ->
+ none;
+ MostLocalList ->
+ case dominant_id(MostLocalList,LineNr) of
+ PI ->
+ element(3,element(4,element(2,PI)))
+ end
+ end
+ end
+ end.
+
+
+
+
+%% Finds out which pragma VERSION ( or ID ) that
+%% that affects the scope object with name NAME
+all_actual_for_version_or_id(NList, Name) ->
+ all_actual_for_version_or_id( NList, [], Name ).
+
+all_actual_for_version_or_id([], Actual, _) ->
+ Actual;
+all_actual_for_version_or_id([First|Rest], Found, Name) ->
+ case is_actual_for_version_or_id(First,Name) of
+ true ->
+ all_actual_for_version_or_id(Rest, [First|Found], Name);
+ false ->
+ all_actual_for_version_or_id(Rest, Found, Name)
+ end.
+
+is_actual_for_version_or_id( Current, Name ) ->
+ case element(3,element(3,element(2,Current))) of
+ Name ->
+ true;
+ OtherName ->
+ suffix([Name],tokens(OtherName,"::"))
+ end.
+
+
+
+
+%% Find the most locally defind pragmas
+%% to the scope SCOPE
+most_local( SList, Scope ) ->
+ case SList of
+ [] ->
+ [];
+ [First|Rest] ->
+ case suffix( element(4,First), Scope ) of
+ true ->
+ most_local( Rest, First, Scope, [First] );
+ false ->
+ most_local( Rest, Scope )
+ end
+ end.
+
+%% Returns a list of all pragmas found in the
+%% same scope. Should choose the right one by looking
+%% att the position of the pragma in relation to
+%% the current object..... ( For hairy cases ).
+most_local( SList, Current, Scope, AllFound ) ->
+ case SList of
+ [] ->
+ AllFound;
+ [First|Rest] ->
+ FirstScope = element(4,First),
+ case suffix( FirstScope, Scope ) of
+ true ->
+ CurrentScope = element(4,Current),
+ case suffix( CurrentScope, FirstScope ) of
+ true ->
+ case length( CurrentScope ) == length( FirstScope ) of
+ true -> %% SAME SCOPE ! KEEP BOTH
+ most_local( Rest, Current, Scope, [First|AllFound] );
+ false ->
+ most_local( Rest, First, Scope, [First] )
+ end;
+ false ->
+ most_local( Rest, Current, Scope, AllFound )
+ end;
+ false ->
+ most_local( Rest, Current, Scope, AllFound )
+ end
+ end.
+
+
+
+
+%% Find the most dominant prefix pragmas
+%% located onto the SAME scope. Now
+%% we look att the line number, the position
+%% on the file.
+dominant_prefix(SList,LineNr) ->
+ case SList of
+ [First|Rest] ->
+ dominant_prefix(Rest,First,LineNr)
+ end.
+
+
+dominant_prefix([],{prefix,X,PLNr,N,F,T},LineNr) ->
+ case LineNr > PLNr of
+ true ->
+ {prefix,X,PLNr,N,F,T};
+ false ->
+ none
+ end;
+dominant_prefix([{prefix,FX,FPLNr,FN,F1,T1}|Rest],{prefix,CX,CPLNr,CN,F2,T2},LineNr) ->
+ case LineNr > FPLNr of % Check if FIRST before the object
+ true ->
+ case FPLNr > CPLNr of % Check if FIRST after CURRENT
+ true ->
+ dominant_prefix(Rest,{prefix,FX,FPLNr,FN,F1,T1},LineNr);
+ false ->
+ dominant_prefix(Rest,{prefix,CX,CPLNr,CN,F2,T2},LineNr)
+ end;
+ false -> % FIRST does not affect the object
+ dominant_prefix(Rest,{prefix,CX,CPLNr,CN,F2,T2},LineNr)
+ end.
+
+
+
+
+%% Find the most dominant version pragmas
+%% located onto the SAME scope. Now
+%% we look att the line number, the position
+%% on the file.
+dominant_version(SList,LineNr) ->
+ case SList of
+ [First|Rest] ->
+ dominant_version(Rest,First,LineNr)
+ end.
+
+
+dominant_version([],Current,_) -> Current;
+dominant_version([{version,FX,FPLNr,FN,F1,T1}|Rest],{version,CX,CPLNr,CN,F2,T2},LineNr) ->
+ case FPLNr > CPLNr of % Check if FIRST after CURRENT
+ true ->
+ dominant_version(Rest,{prefix,FX,FPLNr,FN,F1,T1},LineNr);
+ false ->
+ dominant_version(Rest,{prefix,CX,CPLNr,CN,F2,T2},LineNr)
+ end.
+
+
+
+
+%% Find the most dominant id pragmas
+%% located onto the SAME scope. Now
+%% we look att the line number, the position
+%% on the file.
+dominant_id(SList,LineNr) ->
+ case SList of
+ [First|Rest] ->
+ dominant_id(Rest,First,LineNr)
+ end.
+
+
+dominant_id([],Current,_) -> Current;
+dominant_id([{id,FX,FPLNr,FN,F1,T1}|Rest],{id,CX,CPLNr,CN,F2,T2},LineNr) ->
+ case FPLNr > CPLNr of % Check if FIRST after CURRENT
+ true ->
+ dominant_id(Rest,{id,FX,FPLNr,FN,F1,T1},LineNr);
+ false ->
+ dominant_id(Rest,{id,CX,CPLNr,CN,F2,T2},LineNr)
+ end.
+
+
+
+
+
+%% This registers a module defined inside the file or
+%% an included file. A tuple that describes the module
+%% is added to the table.
+%% Observe that the modules registered are ONLY those
+%% who are in the top level, not definedd inside others !
+mk_ref(G,Name,Type) ->
+ case length(Name) > 1 of
+ true -> %% The interface is NOT defined att top level
+ true;
+ false ->
+ S = ic_genobj:pragmatab(G),
+ File = get_idlfile(S), % The current file or an included one.
+ case idlfile(G) of % The current file to be compiled.
+ File ->
+ insert(S,{Type,Name,File,local});
+ _ ->
+ insert(S,{Type,Name,File,included})
+ end
+ end.
+
+
+%% The same as mk_ref/3 but this registers everything with
+%% all vital information available inside files.
+%% Registers ESSENTIAL data for included files
+mk_file_data(G,X,Scope,Type) ->
+ S = ic_genobj:pragmatab(G),
+ Name = get_id2(X),
+ PreprocFile = get_idlfile(S), % The current file or an included one.
+ CompFile = idlfile(G), % The current file compiled
+ Depth = length(Scope), % The depth of the scope
+ ScopedName = ic_util:to_undersc([Name|Scope]),
+ Line = ic_forms:get_line(X),
+ case PreprocFile of
+ CompFile ->
+ insert(S,{file_data_local,CompFile,CompFile,Type,Scope,Name,ScopedName,Depth,Line});
+ PreprocFile ->
+ insert(S,{file_data_included,PreprocFile,CompFile,Type,Scope,Name,ScopedName,Depth,Line})
+ end.
+
+
+
+%% Return a list with all the headers from
+%% the local file that represent the module
+%% or interface that is preciding the current
+get_local_c_headers(G,X) ->
+ S = ic_genobj:pragmatab(G),
+ Local = lookup(S,file_data_local),
+ FoundLocal = get_local_c_headers(X,Local,Local),
+ no_doubles(FoundLocal).
+
+get_local_c_headers(X,Local,Local) ->
+ get_local_c_headers(X,Local,Local,[]).
+
+get_local_c_headers(_X,[],_All,Found) ->
+ Found;
+get_local_c_headers(X,[{file_data_local,_PF_idl,_,module,_,_,SN,_,Line}|Hs],All,Found)->
+ case ic_forms:get_line(X) > Line of
+ true ->
+ get_local_c_headers(X,Hs,All,[SN|Found]);
+ false ->
+ get_local_c_headers(X,Hs,All,Found)
+ end;
+get_local_c_headers(X,[{file_data_local,_PF_idl,_,interface,_,_,SN,_,Line}|Hs],All,Found)->
+ case ic_forms:get_line(X) > Line of
+ true ->
+ get_local_c_headers(X,Hs,All,[SN|Found]);
+ false ->
+ get_local_c_headers(X,Hs,All,Found)
+ end;
+get_local_c_headers(X,[_|Hs],All,Found) ->
+ get_local_c_headers(X,Hs,All,Found).
+
+
+
+%% Return a list with all the headers from
+%% the included file that represent the module
+%% or interface that have to be included
+get_included_c_headers(G) ->
+ S = ic_genobj:pragmatab(G),
+ Included = lookup(S,file_data_included),
+ FoundIncluded = get_included_c_headers(Included,Included),
+ no_doubles(FoundIncluded).
+
+get_included_c_headers(Included,Included) ->
+ get_included_c_headers(Included,Included,[]).
+
+get_included_c_headers([],_All,Found) ->
+ Found;
+get_included_c_headers([{file_data_included,PF_idl,_CF_idl,T,_S,_N,SN,0,_}|Hs],All,Found) ->
+ Len = length(PF_idl),
+ FN = string:sub_string(PF_idl,1,Len-4),
+ case only_top_level(PF_idl,All) of
+ true ->
+ %%
+ L = string:tokens(FN,"/"),
+ FN2 = lists:last(L),
+ %%
+ get_included_c_headers(Hs,All,["oe_"++FN2|Found]);
+ false ->
+ case T of
+ module ->
+ case contains_interface(PF_idl,All) of
+ true ->
+ %%
+ L = string:tokens(FN,"/"),
+ FN2 = lists:last(L),
+ %%
+ get_included_c_headers(Hs,All,["oe_"++FN2|Found]);
+ false ->
+ get_included_c_headers(Hs,All,[SN|Found])
+ end;
+ interface ->
+ case contains_interface(PF_idl,All) of
+ true ->
+ %%
+ L = string:tokens(FN,"/"),
+ FN2 = lists:last(L),
+ %%
+ get_included_c_headers(Hs,All,["oe_"++FN2|Found]);
+ false ->
+ get_included_c_headers(Hs,All,[SN|Found])
+ end;
+ _ ->
+ get_included_c_headers(Hs,All,["oe_"++FN|Found])
+ end
+ end;
+get_included_c_headers([{file_data_included,_PF_idl,_,module,_,_,SN,_,_}|Hs],All,Found)->
+ get_included_c_headers(Hs,All,[SN|Found]);
+get_included_c_headers([{file_data_included,_PF_idl,_,interface,_,_,SN,_,_}|Hs],All,Found)->
+ get_included_c_headers(Hs,All,[SN|Found]);
+get_included_c_headers([_|Hs],All,Found) ->
+ get_included_c_headers(Hs,All,Found).
+
+%% Help functions for the above
+
+only_top_level(_PF_idl,[]) ->
+ true;
+only_top_level(PF_idl,[H|Hs]) ->
+ case element(2,H) of
+ PF_idl ->
+ case element(8,H) > 0 of
+ true ->
+ false;
+ false ->
+ only_top_level(PF_idl,Hs)
+ end;
+ _ ->
+ only_top_level(PF_idl,Hs)
+ end.
+
+contains_interface(_PF_idl,[]) ->
+ false;
+contains_interface(PF_idl,[H|Hs]) ->
+ case element(2,H) of
+ PF_idl ->
+ case element(4,H) of
+ interface ->
+ case element(8,H) > 0 of
+ true ->
+ true;
+ false ->
+ contains_interface(PF_idl,Hs)
+ end;
+ _ ->
+ contains_interface(PF_idl,Hs)
+ end;
+ _ ->
+ contains_interface(PF_idl,Hs)
+ end.
+
+
+
+%% This returns a list of everything defined in an included file.
+get_incl_refs(G) ->
+ S = ic_genobj:pragmatab(G),
+
+ RefList =
+ ets:match(S,{mod_ref,'$0','_',included}) ++
+ ets:match(S,{ifc_ref,'$0','_',included}) ++
+ ets:match(S,{const_ref,'$0','_',included}) ++
+ ets:match(S,{typedef_ref,'$0','_',included}) ++
+ ets:match(S,{except_ref,'$0','_',included}) ++
+ ets:match(S,{struct_ref,'$0','_',included}) ++
+ ets:match(S,{union_ref,'$0','_',included}) ++
+ ets:match(S,{enum_ref,'$0','_',included}) ++
+ ets:match(S,{attr_ref,'$0','_',included}),
+
+ case RefList of
+ [] ->
+ none;
+ _ ->
+ RefList
+ end.
+
+
+
+%% This returns a list of everything locally defined.
+get_local_refs(G) ->
+ S = ic_genobj:pragmatab(G),
+
+ RefList =
+ ets:match(S,{mod_ref,'$0','_',local}) ++
+ ets:match(S,{ifc_ref,'$0','_',local}) ++
+ ets:match(S,{const_ref,'$0','_',local}) ++
+ ets:match(S,{typedef_ref,'$0','_',local}) ++
+ ets:match(S,{except_ref,'$0','_',local}) ++
+ ets:match(S,{struct_ref,'$0','_',local}) ++
+ ets:match(S,{union_ref,'$0','_',local}) ++
+ ets:match(S,{enum_ref,'$0','_',local}) ++
+ ets:match(S,{attr_ref,'$0','_',local}),
+
+ case RefList of
+ [] ->
+ none;
+ _ ->
+ RefList
+ end.
+
+
+
+
+
+%% This is intented to be used for solving the identification
+%% problem introduced by pragmas. It creates aliases between
+%% scoped and "final" identities.
+mk_alias(G,PragmaId,ScopedId) ->
+ %io:format("~nMaking alias -> ~p~n",[PragmaId]),
+ S = ic_genobj:pragmatab(G),
+ insert(S,{alias,ScopedId,PragmaId}).
+
+
+%% This is used to find out if the object described with
+%% the scoped id is created. If this is the case, it should
+%% be registered as an alias and the identity of the object
+%% is returned. Otherwize "none" is returned.
+get_alias(G,ScopedId) ->
+ S = ic_genobj:pragmatab(G),
+ case ets:match(S,{alias,ScopedId,'$1'}) of
+ [] ->
+ none;
+ [[IfrId]] ->
+ %io:format("~nFound alias -> ~p~n",[IfrId]),
+ IfrId
+ end.
+
+
+
+%% Returns the alias id or constructs an id
+scope2id(G,ScopedId) ->
+ case get_alias(G,ScopedId) of
+ none ->
+ case is_included(G,ScopedId) of
+ true -> %% File included
+ get_included_IR_ID(G,ScopedId);
+ false -> %% File local
+ NewIfrId = mk_id(ScopedId), % Create a "standard" id
+ mk_alias(G,NewIfrId,ScopedId), % Create an alias
+ NewIfrId
+ end;
+ IfrId ->
+ IfrId
+ end.
+
+
+
+
+is_included(G,ScopedId) ->
+ S = ic_genobj:pragmatab(G),
+ Name = ic_util:to_undersc(ScopedId),
+ case ets:match(S,{file_data_included,'_','_','_','_','_',Name,'_','_'}) of
+ [[]] ->
+ true;
+ _ ->
+ false
+ end.
+
+
+
+get_included_IR_ID(G,ScopedId) ->
+ S = ic_genobj:pragmatab(G),
+ ScopedName = ic_util:to_undersc(ScopedId),
+ [[Scope,Name,LNr]] = ets:match(S,{file_data_included,'_','_','_','$3','$4',ScopedName,'_','$7'}),
+ {Prefix,Vsn,Id} = pragma_cover(S,Name,Scope,LNr),
+ case Id of
+ none ->
+ case Prefix of
+ none ->
+ IR_ID =
+ lists:flatten(io_lib:format("IDL:~s:~s",[ScopedName, Vsn])),
+ ic_pragma:mk_alias(G,IR_ID,ScopedId),
+ IR_ID;
+ _ ->
+ IR_ID =
+ lists:flatten(io_lib:format("IDL:~s:~s",[Prefix ++ "/" ++ ScopedName, Vsn])),
+ ic_pragma:mk_alias(G,IR_ID,ScopedId),
+ IR_ID
+ end;
+ _ ->
+ ic_pragma:mk_alias(G,Id,ScopedId),
+ Id
+ end.
+
+
+
+
+
+%% Returns the scope for object
+id2scope(G,IfrId) ->
+ S = ic_genobj:pragmatab(G),
+ case lookup(S,alias) of
+ [] ->
+ mk_scope(IfrId);
+ AliasList ->
+ case keysearch(IfrId,3,AliasList) of
+ false ->
+ mk_scope(IfrId);
+ {value,{alias,ScopedId,_}} ->
+ ScopedId
+ end
+ end.
+
+%% Returns a "standard" IDL ID by getting the scope list
+mk_id(ScopedId) ->
+ "IDL:" ++ ic_pragma:slashify(ScopedId) ++ ":" ++ default_version().
+
+%% Returns the scope of an object when getting a "standard" IDL ID
+mk_scope(IfrId) ->
+ [_,Body,_] = tokens(IfrId,":"),
+ reverse(tokens(Body,"/")).
+
+
+
+%% This is used to note the exact compiled file
+%% under pragma creation. There are two options, the
+%% main file or files included by the main file. This
+%% just denotes the CURRENT file, the main file or
+%% the included ones. A very usual field is the file
+%% path that shows the include path of the file
+
+init_idlfile(G,S) ->
+ IdlFile = idlfile(G),
+ insert(S,{file,IdlFile,[]}).
+
+set_idlfile(S,FileName) ->
+ FilePath = get_filepath(S),
+ case FilePath of
+ [] ->
+ ets:delete(S,file),
+ insert(S,{file,FileName,[FileName|FilePath]});
+ _ ->
+ case hd(FilePath) of
+ [] ->
+ ets:delete(S,file),
+ insert(S,{file,FileName,[FileName|FilePath]});
+ _ ->
+ case tl(FilePath) of
+ [] ->
+ ets:delete(S,file),
+ insert(S,{file,FileName,[FileName|FilePath]});
+ _ ->
+ case hd(tl(FilePath)) of
+ [] ->
+ ets:delete(S,file),
+ insert(S,{file,FileName,[FileName|FilePath]});
+ FileName ->
+ ets:delete(S,file),
+ insert(S,{dependency,FilePath}), % Add dependency branch
+ insert(S,{file,FileName,tl(FilePath)});
+ _ ->
+ ets:delete(S,file),
+ insert(S,{file,FileName,[FileName|FilePath]})
+ end
+ end
+ end
+ end.
+
+get_idlfile(S) ->
+ [FT] = lookup(S,file),
+ element(2,FT).
+
+get_filepath(S) ->
+ [FT] = lookup(S,file),
+ element(3,FT).
+
+
+%% This returns a list of file names
+%% that direct or indirect the current
+%% compiled file is depended on.
+get_dependencies(G) ->
+ S = ic_genobj:pragmatab(G),
+ case lookup(S,dependency) of
+ [] ->
+ [];
+ Dependencies ->
+ {get_idlfile(S),get_dependencies(Dependencies,[])}
+ end.
+
+get_dependencies([],Dependencies) ->
+ no_doubles(Dependencies);
+get_dependencies([{dependency,Path}|Tail],Current) ->
+ get_dependencies(Tail,[hd(Path)|Current]).
+
+
+no_doubles(List) ->
+ no_doubles(List,[]).
+
+no_doubles([],NoDoubles) ->
+ NoDoubles;
+no_doubles([X|Xs],Current) ->
+ case member(X,Xs) of
+ true ->
+ no_doubles(Xs,Current);
+ false ->
+ no_doubles(Xs,[X|Current])
+ end.
+
+
+
+
+%% Pragma compilation status initialization
+init_pragma_status(S) ->
+ insert(S,{status,true,0}).
+
+%% Pragma compilation status set to failure
+%% and count up the number of errors
+set_compilation_failure(S) ->
+ [{status,_,ErrorNr}] = lookup(S,status),
+ ets:delete(S,status),
+ insert(S,{status,false,ErrorNr+1}).
+
+%% Pragma compilation status set to lookup
+get_pragma_compilation_status(S) ->
+ [Status] = lookup(S,status),
+ element(2,Status).
+
+%% Pragma error number
+get_pragma_error_nr(S) ->
+ [Status] = lookup(S,status),
+ element(3,Status).
+
+
+%% Short check
+is_short(N_str) when is_list(N_str) ->
+ case is_short_decimal_str(N_str) of
+ true ->
+ true;
+ false ->
+ false
+ end;
+is_short(N) when is_integer(N)->
+ (N < 65535) and (N > -65536);
+is_short(_) -> false.
+
+
+%% Check if the string is a
+%% list of characters representing
+%% a short. Avoid crash !.
+is_short_decimal_str(N_str) ->
+ case is_decimal_str(N_str) of
+ true ->
+ N = list_to_integer(N_str),
+ (N < 65535) and (N > -65536);
+ false ->
+ false
+ end.
+
+%% Check if the string is a
+%% list of characters representing
+%% decimals.
+is_decimal_str([]) ->
+ true;
+is_decimal_str([First|Rest]) ->
+ case is_decimal_char(First) of
+ true ->
+ is_decimal_str(Rest);
+ false ->
+ false
+ end.
+
+%% True if D is a character
+%% representing a decimal (0-9).
+is_decimal_char(D) ->
+ case (48=<D) and (D=<57) of
+ true ->
+ true;
+ false ->
+ false
+ end.
+
+
+%% Prints out all the table
+print_tab(G) ->
+ io:format("~nPragmaTab = ~p~n",[ets:tab2list(ic_genobj:pragmatab(G))]).
+
+
+list_to_term(List) ->
+ case catch erl_scan:string(List) of
+ {ok, Tokens, _} ->
+ case erl_parse:parse_term(Tokens ++ [{dot, 1}]) of
+ {ok,Term} ->
+ Term;
+ _ ->
+ error
+ end;
+ _ ->
+ error
+ end.
+
+
+
+%% Cleanup all other code options for a specified scope
+%% in the same file, but the most dominant.
+cleanup_codeOptions(G,S,ScopedId) ->
+ case ets:match(S,{codeopt,ScopedId,'$1','$2',idlfile(G),'$4'}) of
+ [] ->
+ %% No codeOpt directive is placed inside the
+ %% currently compiled file. Try to find other
+ %% directives located in included files.
+ true;
+ List ->
+ %% A codeOpt directive is placed inside the
+ %% currently compiled file. This dominates
+ %% all other directives.
+ CodeOption = best_positioned_codeOpt(List),
+ %% Remove code options that do not affect
+ %% the code production (redundant)
+ remove_redundant_codeOpt(S,[ScopedId|CodeOption])
+ end.
+
+
+%% Best positioned is the codeopt located
+%% "highest" on the SAME file, the one with
+%% lowest line number.
+best_positioned_codeOpt([X|Xs]) ->
+ best_positioned_codeOpt(Xs,X).
+
+best_positioned_codeOpt([],Found) ->
+ Found;
+best_positioned_codeOpt([X|Xs],Current) ->
+ case hd(tl(X)) > hd(tl(Current)) of
+ true ->
+ best_positioned_codeOpt(Xs,Current);
+ false ->
+ best_positioned_codeOpt(Xs,X)
+ end.
+
+
+remove_redundant_codeOpt(S,[ScopedId,CodeOption,LNr,FilePath]) ->
+ ets:match_delete(S,{codeopt,ScopedId,'$1','$2','$3','$4'}),
+ ets:insert(S,{codeopt,ScopedId,CodeOption,LNr,last(FilePath),FilePath}).
+
+
+
+
+add_inh_data(G,InclScope,X) ->
+ S = ic_genobj:pragmatab(G),
+ case X#interface.inherit of
+ [] ->
+ true;
+ [InhBody] ->
+ Scope = [get_id2(X)|InclScope],
+ insert(S,{inherits,Scope,InhBody});
+ InhList ->
+ add_inh_data(G, S, InclScope, X, InhList)
+ end.
+
+add_inh_data(_,_,_,_,[]) ->
+ true;
+add_inh_data(G, S, InclScope, X, [InhBody|InhBodies]) ->
+ Scope = [get_id2(X)|InclScope],
+ insert(S, {inherits,Scope,InhBody}),
+ add_inh_data(G, S, InclScope, X, InhBodies).
+
+
+%% Returns a default broker data
+defaultBrokerData(G) ->
+ {to_atom(ic_genobj:impl(G)),transparent}.
+
+
+%% Loops through the form and sdds inheritence data
+preproc(G, N, [X|Xs]) when is_record(X, interface) ->
+ %% Add inheritence data to pragmatab
+ ic_pragma:add_inh_data(G,N,X),
+ N2 = [get_id2(X) | N],
+ preproc(G, N2, get_body(X)),
+ lists:foreach(fun({_Name, Body}) -> preproc(G, N2, Body) end,
+ X#interface.inherit_body),
+ preproc(G, N, Xs);
+
+preproc(G,N,[X|Xs]) when is_record(X, module) ->
+ N2 = [get_id2(X) | N],
+ preproc(G, N2, get_body(X)),
+ preproc(G,N,Xs);
+
+preproc(G,N,[_X|Xs]) ->
+ preproc(G,N,Xs);
+
+preproc(_G, _N, []) ->
+ ok.
+
+
+%% Returns a tuple / list of tuples { Mod, Type }
+%% Does not check overridence because it is the
+%% top scope for the module to be produced and
+%% cannot be overriden.
+getBrokerData(G,X,Scope) ->
+ S = ic_genobj:pragmatab(G),
+ cleanup_codeOptions(G,S,Scope),
+
+ %% Check if it is an operation denoted
+ case isOperation(S,Scope) of
+ %% Yes, check options
+ true ->
+ %% Look if there is a specific code option on top file
+ case hasSpecificCodeoptionOnTopFile(S,ic_genobj:idlfile(G),Scope) of
+ true ->
+ %% Yes, let it work
+ getBrokerData(G,S,X,Scope,[Scope],[]);
+ false ->
+ %% No, try to see if there is codeoption on top file
+ case hasNonSpecificCodeoptionOnTopFile(S,ic_genobj:idlfile(G)) of
+ true ->
+ %% Yes, override every other specific code option
+ [_H|T] = Scope,
+ getBrokerData(G,S,X,Scope,[T],[]);
+ false ->
+ %% No, let inherited specific code options work
+ getBrokerData(G,S,X,Scope,[Scope],[])
+ end
+ end;
+ %% No, continue
+ false ->
+ getBrokerData(G,S,X,Scope,[Scope],[])
+ end.
+
+%% Returns a tuple / list of tuples { Mod, Type }
+%% Inside loop, uses overridence.
+getBrokerData(G,X,RS,Scope,CSF) ->
+ S = ic_genobj:pragmatab(G),
+ cleanup_codeOptions(G,S,Scope),
+ OvScope = overridedFrom(S,RS,Scope),
+ getBrokerData(G,S,X,RS,[OvScope],[OvScope|CSF]).
+
+
+
+getBrokerData(G,S,X,RS,[[[First]|Rest]],CSF) when is_integer(First) ->
+ Scope = [[First]|Rest],
+ case ets:match(S,{codeopt,Scope,'$1','_','_','_'}) of
+ [] ->
+ case ets:match(S,{inherits,Scope,'$1'}) of
+ [] -> %% No inheritence, no pragma codeopt
+ defaultBrokerData(G); %% Default
+ [InhScope] ->
+ getBrokerData(G,S,X,RS,InhScope,CSF);
+ InhList ->
+ getBrokerDataInh(G,S,X,RS,Scope,CSF,InhList)
+ end;
+ [[{broker,{Module,Type}}]] -> %% A branch only, with pragma codeopt
+ {Module,Type};
+ List -> %% Multiple branches with pragma codeopt
+ flatten(List)
+ end;
+
+getBrokerData(G,S,X,RS,[[[First]|Rest]],CSF) ->
+ getBrokerDataLoop(G,S,X,RS,[[First]|Rest],CSF);
+
+getBrokerData(G,S,X,RS,[Scope],CSF) ->
+ %io:format(" 1"),
+ case ets:match(S,{codeopt,Scope,'$1','_','_','_'}) of
+ [] ->
+ %io:format(" 2"),
+ case ets:match(S,{inherits,Scope,'$1'}) of
+ [] -> %% No inheritence, no pragma codeopt
+ %io:format(" 5"),
+ defaultBrokerData(G); %% Default
+ [InhScope] ->
+ %io:format(" 6"),
+ getBrokerData(G,S,X,RS,InhScope,CSF);
+ InhList ->
+ %io:format(" 7"),
+ getBrokerDataInh(G,S,X,RS,Scope,CSF,InhList)
+ end;
+ [[{broker,{Module,Type}}]] -> %% A branch only, with pragma codeopt
+ %io:format(" 3"),
+ {Module,Type};
+ List -> %% Multiple branches with pragma codeopt
+ %io:format(" 4"),
+ flatten(List)
+ end.
+
+
+%% Special treatment when X is an operation
+getBrokerDataInh(G,S,X,RS,Scope,CSF,InhList) when is_record(X,op)->
+ %io:format(" 8"),
+ case ets:match(S,{op,get_id2(X),'$1','_','_'}) of
+ [] ->
+ %io:format(" 10"),
+ CleanList = remove_inherited(S,InhList),
+ getBrokerDataLoop(G,S,X,RS,CleanList,CSF);
+
+ [[Scope]] ->
+ %io:format(" 11"),
+ CleanList = remove_inherited(S,InhList),
+ getBrokerDataLoop(G,S,X,RS,CleanList,CSF);
+
+ [[OpScope]] ->
+ %io:format(" 12"),
+ case member([OpScope],InhList) of
+ true ->
+ %io:format(" 14"),
+ %% No inherited scopes
+ getBrokerData(G,X,RS,OpScope,CSF);
+ false ->
+ %io:format(" 15"),
+ %% Inherited scopes
+ CleanList = remove_inherited(S,InhList),
+ getBrokerDataLoop(G,S,X,RS,CleanList,CSF)
+ end;
+
+ ListOfOpScopes ->
+ %io:format(" 13"),
+ case get_inherited(S,Scope,ListOfOpScopes) of
+ [[OpScope]] ->
+ case member([OpScope],InhList) of
+ true ->
+ getBrokerData(G,X,RS,OpScope,CSF);
+ false ->
+ CleanList = remove_inherited(S,InhList),
+ getBrokerDataLoop(G,S,X,RS,CleanList,CSF)
+ end;
+ _ ->
+ CleanList = remove_inherited(S,InhList),
+ getBrokerDataLoop(G,S,X,RS,CleanList,CSF)
+ end
+ end;
+%% Just add InhList after removing all inherited
+getBrokerDataInh(G,S,X,RS,_Scope,CSF,InhList) ->
+ %io:format(" 9"),
+ CleanList = remove_inherited(S,InhList),
+ getBrokerDataLoop(G,S,X,RS,CleanList,CSF).
+
+
+
+
+%% Loops over a list of scopes
+getBrokerDataLoop(G,S,X,RS,List,CSF) ->
+ getBrokerDataLoop(G,S,X,RS,List,[],CSF).
+
+getBrokerDataLoop(G,_,_X,_RS,[],BrokerDataList,_CSF) ->
+ case no_doubles(BrokerDataList) of
+ [BrokerData] -> %% No pragma codeopt / Multiple branches with pragma codeopt
+ BrokerData;
+ List ->
+ DefaultBD = defaultBrokerData(G),
+ case member(DefaultBD,List) of
+ true ->
+ %% Remove default, choose codeoption
+ NewList = delete(DefaultBD,List),
+ case NewList of
+ [BData] -> %% A branch only, with pragma codeopt
+ BData;
+ _Other -> %% Multiple branches with pragma codeopt
+ %%io:format("Multiple branches ~p~n",[Other]),
+ NewList
+ end;
+ false -> %% Multiple branches with pragma codeopt
+ flatten(List)
+ end
+ end;
+
+getBrokerDataLoop(G,S,X,RS,[[Scope]|Scopes],_Found,CSF) when is_integer(Scope) ->
+ getBrokerData(G,S,X,RS,[[Scope]|Scopes],CSF);
+
+getBrokerDataLoop(G,S,X,RS,[[Scope]|Scopes],Found,CSF) ->
+ %% Start from the beginning, check for overridings
+ case member(overridedFrom(S,RS,Scope),CSF) of %% Avoid infinite loops
+ true ->
+ getBrokerDataLoop(G,S,X,RS,Scopes,Found,CSF);
+ false ->
+ BrokerData = getBrokerData(G,X,RS,Scope,CSF),
+ getBrokerDataLoop(G,S,X,RS,Scopes,[BrokerData|Found],[Scope|CSF])
+ end.
+
+
+
+
+%%%--------------------------------------
+%%% Finds out the overrider of a scope
+%%%--------------------------------------
+overridedFrom(S,RS,Scope) ->
+ overridedFrom(S,RS,Scope,Scope).
+
+overridedFrom(S,RS,Last,Scope) ->
+ case ets:match(S,{inherits,'$0',Scope}) of
+ [] ->
+ %% No inheritence, no pragma codeopt,
+ %% choose the last scope.
+ Last;
+
+ [[RS]] ->
+ %% Garbage, unused interface with pragma
+ %% code option ! Danger !
+ Last;
+
+ [[InhScope]] ->
+ case ets:match(S,{codeopt,InhScope,'$1','_','_','_'}) of
+ [] ->
+ %% InhScope has no code options, keep Last.
+ overridedFrom(S,RS,Scope,InhScope);
+ _ ->
+ %% InhScope has code option, Last = InhScope.
+ overridedFrom(S,RS,InhScope,InhScope)
+ end;
+ List ->
+ %% Several inherit from Scope, choose the one feeseble,
+ %% the one DIRECTLY inherited by Scope and not through
+ %% other interface.
+ case remove_inheriters(S,RS,List) of
+ [] ->
+ Scope;
+ Removed ->
+ Removed
+ end
+ end.
+
+%%%------------------------------------------------------
+%%% Removes all the scopes that inherit from others
+%%%------------------------------------------------------
+remove_inheriters(S,RS,InheriterList) ->
+ DominantList =
+ dominantList(S,InheriterList),
+ ReducedInhList =
+ [X || X <- InheriterList,
+ member(X,DominantList)],
+
+ case ReducedInhList of
+ [] ->
+ [];
+ [_OneOnly] ->
+ ReducedInhList;
+ _Other ->
+ EtsList = ets:tab2list(S),
+ CleanList =
+ [X || X <- EtsList, element(1,X) == inherits],
+% CodeOptList =
+% [X || X <- EtsList, element(1,X) == codeopt],
+ NoInheriters =remove_inheriters2(S,ReducedInhList,CleanList),
+
+ [ [X] || [X] <- NoInheriters,
+ inherits(RS,X,CleanList)]
+ end.
+
+remove_inheriters2(_,[A],_) ->
+ [A];
+remove_inheriters2(_S,[A,B],EtsList) ->
+ case remove_inh(A,B,[A,B],EtsList) of
+ [[X]] ->
+ X;
+ List ->
+ List
+ end;
+remove_inheriters2(S,[A,B|Rest],EtsList) ->
+ case remove_inh(A,B,[A,B|Rest],EtsList) of
+ [A,B|Rest] ->
+ [A,B|Rest];
+ NewList ->
+ remove_inheriters2(S,NewList,EtsList)
+ end.
+
+remove_inh([X],[Y],List,EtsList) ->
+ case inherits(X,Y,EtsList) of
+ true ->
+ delete([X],List);
+ false ->
+ case inherits(Y,X,EtsList) of
+ true ->
+ delete([Y],List);
+ false ->
+ List
+ end
+ end.
+
+
+
+%%%----------------------------------------------
+%%% Should remove all scope links that inherit
+%%% from others in the list
+%%%----------------------------------------------
+remove_inherited(S,InheriterList) ->
+ EtsList = ets:tab2list(S),
+ CleanList =
+ [X || X <- EtsList, element(1,X) == inherits],
+ remove_inherited(S,InheriterList,CleanList).
+
+
+remove_inherited(_S,[A,B],EtsList) ->
+ case remove_inhed(A,B,[A,B],EtsList) of
+ [[X]] ->
+ [[X]];
+ List ->
+ List
+ end;
+remove_inherited(S,[A,B|Rest],EtsList) ->
+ case remove_inhed(A,B,[A,B|Rest],EtsList) of
+ [A,B|Rest] ->
+ [A,B|Rest];
+ NewList ->
+ remove_inherited(S,NewList,EtsList)
+ end.
+
+
+remove_inhed([X],[Y],List,EtsList) ->
+ case inherits(X,Y,EtsList) of
+ true ->
+ delete([Y],List);
+ false ->
+ case inherits(Y,X,EtsList) of
+ true ->
+ delete([X],List);
+ false ->
+ List
+ end
+ end.
+
+
+
+
+
+
+
+%%%----------------------------------------------
+%%% Should return all scope links that is
+%% are inherited from scope in the list
+%%%----------------------------------------------
+get_inherited(S,Scope,OpScopeList) ->
+ EtsList = ets:tab2list(S),
+ [[element(3,X)] || X <- EtsList,
+ element(1,X) == inherits,
+ element(2,X) == Scope,
+ member([element(3,X)],OpScopeList)].
+
+
+
+
+
+
+
+%%%---------------------------------------------------
+%%% Returns a the list of scopes that have codeoption
+%%% from a list of scopes
+%%%---------------------------------------------------
+dominantList(S,IL) ->
+ dominantList(S,IL,[]).
+
+dominantList(_S,[],Found) ->
+ Found;
+dominantList(S,[[X]|Xs],Found) ->
+ case ets:match(S,{codeopt,X,'$1','_','_','_'}) of
+ [] ->
+ dominantList(S,Xs,Found);
+ _ ->
+ dominantList(S,Xs,[[X]|Found])
+ end.
+
+
+
+
+%%%---------------------------------------------------
+%%% Returns true if X direct or indirect inherits Y
+%%%---------------------------------------------------
+inherits(X,Y,EtsList) ->
+ case member({inherits,X,Y},EtsList) of
+ true ->
+ %% Direct inherited
+ true;
+ false ->
+ %% Indirectly inherited
+ AllInh = [ B || {inherits,A,B} <- EtsList, A == X ],
+ inherits(X,Y,AllInh,EtsList)
+ end.
+
+inherits(_X,_Y,[],_EtsList) ->
+ false;
+inherits(X,Y,[Z|Zs],EtsList) ->
+ case inherits2(X,Y,Z,EtsList) of
+ true ->
+ true;
+ false ->
+ inherits(X,Y,Zs,EtsList)
+ end.
+
+inherits2(_X,Y,Z,EtsList) ->
+ case member({inherits,Z,Y},EtsList) of
+ true ->
+ true;
+ false ->
+ inherits(Z,Y,EtsList)
+ end.
+
+
+
+%%
+%% is_inherited_by/3
+%%
+%% Returns :
+%%
+%% true if the first parameter is
+%% inherited by the second one
+%%
+%% false otherwise
+%%
+is_inherited_by(Interface1,Interface2,PragmaTab) ->
+ FullList = ets:tab2list(PragmaTab),
+ InheritsList =
+ [X || X <- FullList, element(1,X) == inherits],
+ inherits(Interface2,Interface1,InheritsList).
+
+
+
+
+%% Filters all pragma prefix from list not in same file
+%% the object
+
+filter_pragma_prefix_list(PragmaTab, Name, Scope, List) ->
+ IdlFile = scoped_names_idl_file(PragmaTab, Name, Scope),
+ filter_pragma_prefix_list2(PragmaTab,IdlFile,List,[]).
+
+
+filter_pragma_prefix_list2(_,_,[],Found) ->
+ Found;
+filter_pragma_prefix_list2(PT, IdlFile, [PP|PPs], Found) ->
+ case PP of
+ {prefix,_,_,_,IdlFile,_} -> %% Same file as the Object, keep
+ filter_pragma_prefix_list2(PT, IdlFile, PPs, [PP|Found]);
+
+ _Other -> %% NOT in same file as the Object, throw away
+ filter_pragma_prefix_list2(PT, IdlFile, PPs, Found)
+ end.
+
+scoped_names_idl_file(PragmaTab, Name, Scope) ->
+ case ets:match(PragmaTab,{'_','$0','_','$2',Scope,Name,'_','_','_'}) of
+ [[IdlFile, _Type]] -> %% Usual case
+ IdlFile;
+ [[_File,module]|_Files] -> %% Multiple modules, get LOCAL file
+ case ets:match(PragmaTab,{file_data_local,'$0','_',module,Scope,Name,'_','_','_'}) of
+ [[LocalIdlFile]] ->
+ LocalIdlFile;
+ _ -> %% Should NEVER occur
+ error
+ end;
+
+ _ ->
+ error %% Should NEVER occur
+ end.
+
+
+
+
+
+
+%%-------------------------------------------------
+%%
+%% Register specific pragma code options
+%%
+%% If there is an operation with that
+%% scope, denote this as {codeopt_specific,Scope}
+%%
+%%-------------------------------------------------
+denote_specific_code_opts(G) ->
+ case ic_options:get_opt(G, be) of
+ noc ->
+ S = ic_genobj:pragmatab(G),
+ COList = ets:match(S,{codeopt,'$0','_','_','_','_'}),
+ OPList = ets:match(S,{op,'$0','$1','_','_'}),
+ denote_specific_code_opts(S,COList,OPList);
+ _ ->
+ ok
+ end.
+
+denote_specific_code_opts(_,_,[]) ->
+ ok;
+denote_specific_code_opts(S,COList,[[OpN,OpS]|OPSs]) ->
+ case lists:member([[OpN|OpS]],COList) of
+ true ->
+ insert(S, {codeopt_specific,[OpN|OpS]});
+ false ->
+ ok
+ end,
+ denote_specific_code_opts(S,COList,OPSs).
+
+
+
+%%---------------------------------------------
+%%
+%% Returns true/false if it denotes an operation
+%%
+%%---------------------------------------------
+isOperation(_S,[]) ->
+ false;
+isOperation(_S,[_]) ->
+ false;
+isOperation(S,[H|T]) ->
+ case ets:match(S,{op,H,T,'$2','$3'}) of
+ [] ->
+ false;
+ _ ->
+ true
+ end.
+
+
+hasSpecificCodeoptionOnTopFile(S,File,Scope) ->
+ case ets:match(S,{codeopt,Scope,'_','$2',File,[File]}) of
+ [] ->
+ false;
+ _ ->
+ true
+ end.
+
+
+hasNonSpecificCodeoptionOnTopFile(S,File) ->
+ case ets:match(S,{codeopt,'_','_','$2',File,[File]}) of
+ [] ->
+ false;
+ _ ->
+ true
+ end.
+
+
+
+%%---------------------------------------------
+%%
+%% Returns {ok,IfrId}/error when searching a random local type
+%%
+%%---------------------------------------------
+
+
+fetchRandomLocalType(G) ->
+
+ S = ic_genobj:pragmatab(G),
+
+ case ets:match(S,{file_data_local,'_','_','$2','$3','$4','_','_','_'}) of
+ [] ->
+ false;
+
+ List ->
+ fetchRandomLocalType(S,List)
+ end.
+
+
+fetchRandomLocalType(_,[]) ->
+ false;
+fetchRandomLocalType(S,[[module|_]|Tail]) ->
+ fetchRandomLocalType(S,Tail);
+fetchRandomLocalType(S,[[_,Scope,Name]|Tail]) ->
+ case ets:match(S,{alias,[Name|Scope],'$1'}) of
+ [] ->
+ fetchRandomLocalType(S,Tail);
+ [[IfrId]] ->
+ {ok,IfrId}
+ end.
+
+
+
+%%---------------------------------------------
+%%
+%% Returns A list of local operation mapping
+%% for a given scope
+%%
+%%---------------------------------------------
+
+
+fetchLocalOperationNames(G,I) ->
+ S = ic_genobj:pragmatab(G),
+ case ets:match(S,{file_data_local,'_','_',op,I,'$4','_','_','_'}) of
+ [] ->
+ [];
+ List ->
+ fetchLocalOperationNames2(List,[])
+ end.
+
+fetchLocalOperationNames2([],Found) ->
+ lists:reverse(Found);
+fetchLocalOperationNames2([[Name]|Names],Found) ->
+ fetchLocalOperationNames2(Names,[Name|Found]).
+
+
+
+%%------------------------------------------------
+%%
+%% Returns a true if this scoped id is a local
+%% one, false otherwise
+%%
+%%------------------------------------------------
+is_local(G,ScopedId) ->
+ S = ic_genobj:pragmatab(G),
+ Name = ic_util:to_undersc(ScopedId),
+ case ets:match(S,{file_data_local,'_','_','_',tl(ScopedId),'_',Name,'_','_'}) of
+ [[]] ->
+ true;
+ _ ->
+ false
+ end.