mnemosyne_lc.erl

OTP是开放电信平台的简称

			 true ->
			     ?UNKNOWN
		     end,
	    {#pred_sym{module = Mod,
		       functor = PredName,
		       line = LineP,
		       type = rule,
		       record_def = RecDef,
		       recursive = non_recursiv, % Hypothesis
		       args = Args,
		       original_args_vars = 
		       mnemosyne_unify:variables_and_annonymous(Args)
		      },
	     if 
		 RecDef == ?UNKNOWN -> S;
		 true -> add_var_type (VL, RecDef, S)
	     end
	    };

	%% Var <- rule(Others)  ** Illegal
	{call,Line,{atom,_,rule}, _}->
	    throw({error, {Line,?MODULE,
			   {illegal_lc_generator,right,Right}}});


	%% all other remaining cases: try to generate a function
	%% with the given code. put the current line as line numbers
	%% for the given code so compilation errors in the expression
	%% will be reported at correct place

	SomeExpr when IsCompilable == true ->
	    
	    Vars = all_vars (NewExpr, ordsets:new()),
	    Vars2 = make_replacements (Vars),
	    Code  = exchange_vars (NewExpr, Vars2),
	    QueryNo = S#s.mquery_next,
	    S1 = add_query (Code, Vars2, S),
	    FunVars = lists:map (fun(X) -> {var, S#s.line, X} end, 
				 var_names(Vars)),
	    {#erl_expr{alias_var = Var,
		       expr= expr ({call,
				    S1#s.line,
				    {atom, S1#s.line, 'MNEMOSYNE QUERY'},
				    [{integer, S1#s.line, QueryNo}, 
				     {tuple, S1#s.line, 
				       FunVars}]},
				   S1#s{allow_erl_vars=true,
					allow_fun_calls=true})},
	     S1};


	%% Var <- Name(Args)
	{call,FL,F,Args} ->
	    #erl_expr{alias_var = Var,
		      expr = expr(Right,
				  S#s{allow_erl_vars = true,
				      allow_fun_calls = true})};
	%% Var <- List
	{cons,Line,H,T} ->
	    #erl_expr{alias_var = Var,
		      expr = expr(Right,
				  S#s{allow_erl_vars = true,
				      allow_fun_calls=true})};
	X ->
	    throw({error, 
		   {S#s.line,?MODULE, {illegal_lc_generator,right,X}}})
    end,
    {Generator, S3};

generate_generator({op,NL,'not',{var,VLL,VL}}, Right, S) ->
    {G, S1} = generate_generator({var,VLL,VL}, Right, S#s{line=NL}),
    {{'#not', 1, [G]}, S1};

generate_generator(Left, _, S) ->
    throw({error, {S#s.line,?MODULE, {illegal_lc_generator,left,Left}}}).
    

generate_table_generator (Var, VL, Right, S) ->
    {NameField, TypeField} = 
	case length(Right) of
	    0 ->
		throw({error, 
		       {S#s.line,?MODULE, 
			{illegal_lc_generator,table,too_few_arguments}}});
	    1 ->
		{hd(Right), []};
	    2 ->
		{hd(Right), hd(tl(Right))};
	    _ ->
		throw({error, 
		       {S#s.line,?MODULE, 
			{illegal_lc_generator,table,too_many_arguments}}})
	end,
    
    Name = 
	case NameField of
	    {atom, VTL, Name1} ->
		Name1;
	    {var,VTL, VName} ->
		{'#erl', {var,VTL,VName}};
	    Other1 ->
		throw ({error, 
			{S#s.line,?MODULE, 
			 {illegal_lc_generator,
			  table, "first",
			  Other1}}})
	end,
    
    {RecDef, Type} = 
	case TypeField of
	    [] when is_atom(Name) ->			% one arg only
		{arg_record_def(table,Name,S), Name};
	    []  ->			                % one arg only
		{[], Name};
	    {atom, TL, TypeName} ->
		{arg_record_def(table,TypeName,S), TypeName};
	    {var, TL, TypeName} ->
		{[], {'#erl', {var, TL,TypeName}}};
	    Other2 ->
		throw ({error, 
			{S#s.line,?MODULE, 
			 {illegal_lc_generator,
			  table, "second",
			  Other2}}})
	end,

    Args = [Var],
    P = #pred_sym{module      = S#s.module,
		  functor     = Name,
		  line	      = S#s.line,
		  type	      = table,
		  record_type = Type,
		  recursive   = non_recursive,
		  args	      = Args,
		  original_args_vars = 
		  mnemosyne_unify:variables_and_annonymous(Args)
		 },
    case RecDef of
	[] ->
	    {P, S};
	_  ->
	    { P#pred_sym{record_def = RecDef},
	      add_var_type(VL, RecDef, S)}
    end.

%%% The <pattern> part in a list comprehension
tr_pattern(P, S) ->
    expr(P, S#s{allow_erl_vars=true,
		allow_fun_calls=false}).

%%% data without function calls like {a,X,[#r{},1]}. Not: NOT 1+4.

expr({record_field,Line,{var,L1,Var},Name,{atom,L3,Field}},
     S)->
    %% X#r.a
    case expr_var(L1,Var,S) of
	{'#erl', V} ->
	    {'#erl', 
	     {record_field,Line,V,Name,{atom,L3,Field}}};
	V ->
	    #rec_f{var = V,
		   name = Name,
		   line = Line,
		   field = Field}
    end;	    

expr({record_field,Line,{var,L1,Var},{atom,L2,Field}}, S) ->
    %% X.a
    case expr_var(L1,Var,S) of
	{'#erl', V} ->
	    {'#erl', {record_field,Line,V,{atom,L2,Field}}};

	V ->
	    #rec_f{var = V,
		   line = Line,
		   field = Field}
    end;	    

expr({record,Line,Name,Fields}, S) ->
    %% #r{a=..., ...}
    Fs = lists:map(fun({record_field,Lf,{atom,_,Nf},Vf}) ->
			   {Nf,Lf,expr(Vf,S#s{line=Lf})};
		       (Other) ->
			   throw({error,
				  {Line,?MODULE,{illegal_field,Name}}})
		   end, Fields),
    #rec_c{line=Line,
	   name=Name,
	   fields=Fs};

expr({var,Line,Name}, S) -> expr_var(Line, Name, S);
expr({integer,_,I}, S) -> I;
expr({float,_,F}, S) -> F;
expr({atom,_,A}, S) -> 
    case atom_to_list(A) of
	[$#|T] -> list_to_atom([$#,$#|T]);
	_ -> A
    end;
expr({string,_,Str}, S) -> Str;
expr({nil,_}, S) -> [];

expr({cons,Line,H0,T0}, S0) -> 
    S = S0#s{line=Line},
    [expr(H0,S) | expr(T0,S)];

expr({tuple,Line,Es0}, S0) -> 
    S = S0#s{line=Line},
    list_to_tuple( lists:map(fun (E) ->
				     expr(E,S)
			     end,
			     Es0) );
expr({call,Line,B,Args}, S0) when S0#s.allow_fun_calls==true ->
    Exp = {call,Line,B,Args},
    case B of
	{remote, _, M, F} -> f_call(M,F,Args,S0#s{line=Line});
	{atom,_,F} -> f_call({atom,0,S0#s.module},B,Args,S0#s{line=Line});
	{var,_,F} -> f_call({atom,0,S0#s.module},B,Args,S0#s{line=Line});
	_ ->
	    ?debugmsg(2, "B=~w\n", [B]),
	    throw({error, {S0#s.line,?MODULE,{illegal_expr,Exp}}})
    end;

expr(X, S) ->
    ?debugmsg(2, "~p\n~p\n", [X,S]),
    throw({error, {S#s.line,?MODULE,{illegal_expr,X}}}).



expr_var({var,Line,Name}, S) -> expr_var(Line,Name,S).

expr_var(Line, Name, S) ->
    case ordsets:is_element(Name,S#s.erl_vars) of
	true when S#s.allow_erl_vars==true ->
	    {'#erl',{var,Line,Name}};
	true when S#s.allow_erl_vars==false ->
	    throw({error, {Line,?MODULE,{no_erl_var,Name}}});
	false ->
	    {'#var',Name}
    end.


f_call(M, F, Args0, S0) ->
    C = {'#funcall', 
	 expr(M,S0),
	 expr(F,S0),
	 lists:map(fun (A) ->
			   expr(A, S0)
		   end, Args0)
	},
    ?debugmsg(2, "~p\n", [C]),
    C.



constr_op('=',_) -> '=';
constr_op('/=',_) -> '!=';
constr_op('<',_) -> '<';
constr_op('>',_) -> '>';
constr_op('=<',_) -> '=<';
constr_op('>=',_) -> '>=';
constr_op(Op, Line) -> throw({error, {Line,?MODULE,{illegal_op,Op}}}).



%% Help functions for function generation (especially creation
%% of 'MNEMOSYNE QUERY' functions).

all_vars ({var, _, '_'}, Res) ->
    Res
;
all_vars ({var, Line, Name}, Res) ->
    ordsets:add_element ({var, '_', Name}, Res)
;
all_vars (X, Res) when is_tuple (X) ->
    all_vars (tuple_to_list (X), Res)
;
all_vars ([H|T], Res) ->
    ordsets:union ([all_vars (H, ordsets:new()), 
		    all_vars (T, ordsets:new()), Res])
;
all_vars (_, Res) ->
    Res.

make_replacements (Vars) ->
    make_replacements (Vars, 0, []).

make_replacements ([], _, Res) ->
    Res;
make_replacements ([H|T], Next, Res) ->
    make_replacements (T, Next+1, [make_new_var (H, Next) | Res]).

make_new_var (Var, Next) ->
    {Var, {var, 0, list_to_atom ("MNEMOSYNE VAR " ++ io_lib:write (Next))}}.


exchange_vars ([H|T], Vars) ->
    [exchange_vars(H, Vars) | exchange_vars (T, Vars)];

exchange_vars ([], _) ->
    [];
exchange_vars ({record_field,Line,Var,Type,Field}, Vars) ->
    {record_field, Line, exchange_vars (Var, Vars), Type, Field};
exchange_vars ({record_field,Line, Field, Var}, Vars) ->
    {record_field, Line, exchange_vars(Field, Vars), exchange_vars (Var, Vars)};

exchange_vars ({var, L, '_'}, Vars) ->
    {var, L, '_'};
exchange_vars ({var, Line, Name}, Vars) ->
    case exchange_var (Name, Vars) of
	false ->
	    {var, Line, Name};
	NewVar ->
	    NewVar
    end
;
exchange_vars (X, Vars) when is_tuple (X) ->
    list_to_tuple (exchange_vars (tuple_to_list (X), Vars))
;
exchange_vars (X, _) ->
    X.

exchange_var (Name, VarList) ->
    case lists:keysearch ({var, '_', Name}, 1, VarList) of
	{value, {_, NewVar}} ->
	    NewVar;
	false ->
	    false
    end.



add_query (Code, Vars, S) when is_tuple (Code) ->
    add_query ([Code], Vars, S)
;
add_query (Code, Vars, S) ->
    [{function, Line, Name, Arity, PrevClauses}] =  S#s.mquery,
    Clause = {clause, Line, [{integer, Line, S#s.mquery_next},
			     {tuple, Line, variables (Vars, [])}],
			     [], 
			     Code},
    S2 = S#s{mquery = [{function, Line, Name, Arity, [Clause | PrevClauses]}],
	     mquery_next = S#s.mquery_next + 1}.
	     
    

variables ([], Res) -> Res
;
variables ([{Orig, Transformed}|T], Res) ->
    variables (T, [Transformed|Res]).

var_names([]) -> []
;
var_names([{var,_,Name}|T]) ->
    [Name | var_names (T)].


%% contain_db_var ({record_field, L, Var, Type, Field}, DBvars) ->
%%     contain_db_var (Var, DBvars);
%% contain_db_var ({var, L, Name}, DBvars) ->
%%     ordsets:is_element ({var, '_', Name}, DBvars);
%% contain_db_var (X, DBvars) when tuple (X) ->
%%     contain_db_var (tuple_to_list (X), DBvars);
%% contain_db_var ([H|T], DBvars) ->
%%     case contain_db_var (H, DBvars) of
%% 	true ->
%% 	    true;
%% 	false ->
%% 	    contain_db_var (T, DBvars)
%%     end;
%% contain_db_var (_, _) ->
%%     false.

mk_initial_mquery () ->
    [{function,0,'MNEMOSYNE QUERY',2,
      [mk_mquery_catch ()]}].


mk_mquery_catch () ->
    {clause, 
     0, 
     [{var, 0, '_'}, {var, 0, '_'}],
     [], 
     [{atom, 0, true}]}.


add_var_type (Name, Def, S) when is_atom(Name), is_tuple(Def) ->
    Type = element (1, Def),
    case lists:keysearch (Name, 1, S#s.var_types) of
	{value, {_, Type}} ->
	    S;
	{value, {_, OtherType}} ->
	    throw ({error, {S#s.line, S#s.module, 
			    {type_error, Name, Type, OtherType}}});
	false ->
	    S#s{var_types=[{Name, Type} | S#s.var_types]}
    end.

is_compilable(Expr0, S) ->
    case catch is_compilable2(Expr0, S) of
	{true,Expr} -> {true,Expr};
	unknown_record -> {false,Expr0};
	{error,E} -> throw({error,E})
    end.

is_compilable2 ({var, L, '_'}, S) ->
    {true, {var, L, '_'}};
is_compilable2 ({var, L, Name}, S) ->
    case lists:member (Name, S#s.erl_vars) of
	true ->
	    {true, {var, L, Name}};
	false ->
	    case lists:member (Name, S#s.db_vars) of
		true ->
		    {true, {var, L, Name}};
		false ->
		    throw(unknown_record)
	    end
    end;
is_compilable2({record_field,Line,{var,L1,Var},{atom,L2,Field}}, S) ->
    %% X.a
    is_compilable2({var,L1,Var}, S),  %% might throw
    case lists:keysearch (Var, 1, S#s.var_types) of
	{value, {_, Type}} ->
	    case lists:keysearch(Type, 1, S#s.recdefs) of
		{value, {Type, FList}} ->
		    case lists:member(Field, FList) of
			true ->
			    {true, {record_field,Line,{var,L1,Var},Type,
				    {atom,L2,Field}}};
			false ->
			    throw({error, {Line, ?MODULE, {undefined_field,Type,Field}}})
		    end
	    end;
	false ->
	    throw(unknown_record)
    end;	    
is_compilable2(X,S) when is_tuple(X) ->
    {true, NewExp} = is_compilable2 (tuple_to_list (X), S),
    {true, list_to_tuple(NewExp)};
is_compilable2 ([H|T], S) ->
    {true, NewH} = is_compilable2 (H,S),
    {true, NewT} = is_compilable2 (T,S),
    {true, [NewH|NewT]};
is_compilable2 (X,S) ->
    {true, X}.