mnemosyne_lc.erl

OTP是开放电信平台的简称

			       args	    = [Arg],
			       original_args_vars = OrigVars
			      },
	      {[{rule,Head,Body} | Accu], S3}
      end, {Accu0, S1}, Clauses1).


rule_check_arity_type (Name, [H], S) ->
    {A,T,S1,H1} = rule_check_arity_type1 (Name, H, S),
    {A,T,S1, [H1]};
rule_check_arity_type (Name, [H|T], S) ->
    {Arity1, Type1, S1, H1} = rule_check_arity_type1 (Name, H, S),
    {Arity2, Type2, S2, T1} = rule_check_arity_type  (Name, T, S1),
    case {Arity1, Type1} of
	{Arity2, Type2} ->
	    {Arity1, Type2, S2, [H1 | T1]};
	{Arity2, X} ->
	    throw({error, {S#s.line, ?MODULE, 
			   {rule_type_error, Name, Type1, Type2}}});
	_ ->
	    throw({error, {S#s.line, ?MODULE, 
			   {rule_arity_error, Name, Arity1, Arity2}}})
    end.


rule_check_arity_type1 (Name, {clause,L, [A0,{atom,L2,Type}], [], Body}, S) ->
    S1 = add_argtype (Name, Type, S, L),
    {2, Type, S1, {clause, L, [A0], [], Body}}
;
rule_check_arity_type1 (Name, {clause, L, [A0], [], Body}, S) ->
    case lists:keysearch (Name, 1, S#s.recdefs) of
	{value, _} ->
	    S1 = add_argtype (Name, Name, S, L),
	    {1, Name, S1, {clause, L, [A0], [], Body}};
	_ ->
	    case lists:keysearch (Name, 1, S#s.argtypes) of
		{value, {_, Type}} ->
		    {1, Type, S, {clause, L, [A0], [], Body}};
		_ ->
		    throw ({error, {S#s.line, ?MODULE, 
				    {undefined, record, Name}}})
	    end
	end;
rule_check_arity_type1 (Name, {clause, L, Args, _, _}, S) ->
    throw ({error, {L, ?MODULE, {illegal_rule_clause_header, Args}}}).

add_argtype (Name, Type, S, L) ->
    case lists:keysearch (Name, 1, S#s.argtypes) of
	{value, {_, Type}} ->
	    S;
	{value, {_, OtherType}} ->
	    throw ({error, {L, ?MODULE, 
			    {rule_type_error, Name, Type, OtherType}}});
	false ->
	    S#s{argtypes=[{Name, Type} | S#s.argtypes]}
    end.

arg_record_def(What, Name, S) when is_record(S,s) ->
    arg_record_def(What, Name, Name, S#s.argtypes, S#s.recdefs, S#s.line).

arg_record_def(rule, Name, Type, ArgTypes, RecDefs, Line) ->
    arg_record_def(table,
		   Type,
		   case lists:keysearch(Name,1,ArgTypes) of
		       {value,{Name,R_name}} -> R_name;
		       false -> Name
		   end, ArgTypes, RecDefs, Line);

arg_record_def(table, Name, Type, ArgTypes, RecDefs, Line) ->
    arg_record_def(get_def, Name, Type, ArgTypes, RecDefs, Line);

arg_record_def(get_def, Name, Type, ArgTypes, RecDefs, Line) ->
    case lists:keysearch(Type,1,RecDefs) of
	{value,Def} -> Def;
	false -> throw({error, {Line,?MODULE,{undefined,record,Type}}})
    end.



mk_data_clauses(S) ->
    lists:map(fun({Name,Val}) ->
		      {clause, 
		       0, 
		       [abstract_keep_vars({data,Name})], 
		       [], 
		       [abstract_keep_vars(Val)]}
	      end, [{record_defs,  S#s.recdefs},
		    {argtypes, S#s.argtypes}]).



mk_fn_clauses(Rs) -> mk_fn_clauses(Rs, '', [], []).


mk_fn_clauses([{rule,Head,Body}|Rs], Doing, Acc, BigAcc) 
					when Head#pred_sym.functor == Doing ->
    mk_fn_clauses(Rs, Doing, [{rule,Head,Body}|Acc], BigAcc);

mk_fn_clauses([{rule,Head,Body}|Rs], _, Acc, BigAcc) -> %% New functor
    mk_fn_clauses([{rule,Head,Body}|Rs], Head#pred_sym.functor, [], 
	       new_bigacc(Acc,BigAcc));

mk_fn_clauses([], _, Acc, BigAcc) ->
    new_bigacc(Acc,BigAcc).
    


new_bigacc([], BigAcc) -> 
    BigAcc;

new_bigacc(Acc,BigAcc) ->
    [{rule,Head,_}|_] = Acc,
    [{clause, 
      Head#pred_sym.line, 
      [abstract_keep_vars(Head#pred_sym.functor)], 
      [],
      [abstract_keep_vars(Acc)]} 
     | BigAcc].

%%%----------------------------------------------------------------
fn_clauses(Cs, S) ->
    lists:mapfoldl(fun({clause,Line,H,G,B0}, S1) ->
			   {Form, S2} = 
			       replace_lcs(B0,S1#s{line=Line, 
						   erl_vars=vars(H)}),
			   {{clause,Line,H,G,Form}, S2}
		   end, S, Cs).

the_query(Data) ->
    case catch the_query1(Data) of
	{'EXIT', Cause} ->
	    case Cause of
		{undef,{Module,'MNEMOSYNE RULE',[_]}} ->
		    throw({'EXIT', {mnemosyne, 
				    {no_rules_in_module,Module}}});
		{undef,[{Module,'MNEMOSYNE RULE',[_]}|_]} ->
		    throw({'EXIT', {mnemosyne, 
				    {no_rules_in_module,Module}}});

		{function_clause,{Module,'MNEMOSYNE RULE',[RuleName]}} ->
		    throw({'EXIT', {mnemosyne, 
				    {no_such_rule,Module,RuleName}}});

		{function_clause,[{Module,'MNEMOSYNE RULE',[RuleName]}|_]} ->
		    throw({'EXIT', {mnemosyne, 
				    {no_such_rule,Module,RuleName}}});

		Others ->
		    throw({'EXIT',Others})
	    end;
	Others ->
	    Others
    end.

the_query1({Pattern,Goal0,S}) ->
    ?debugmsg(2, 
	      "Calling mnemosyne_compiler:lc_query1 line ~w\n"
	      "   Pattern : ~s\n   Goal    : ~s\n", 
	      [S#s.line,
	       mnemosyne_pp:e(Pattern),
	       mnemosyne_pp:body(Goal0)]),
    Goal = runtime_resolve_tables(Goal0, S),
    Call = mnemosyne_compiler:lc_query1(Pattern,Goal,S#s.recdefs,S#s.module),
    ?debugmsg(1, "Call line ~w = ~s\n", [S#s.line,mnemosyne_pp:body(Call)]),
    Opt = mnemosyne_optimizer:phase2(Call),
    ?debugmsg(1, "Optimized call: ~s\n", [mnemosyne_pp:body(Opt)]),
    {call,Call,Opt}.


vars(X) -> vars(X,ordsets:new()).

vars({var,_,V}, S) -> ordsets:add_element(V,S);
vars({cons,_,H,T}, S) -> vars(T, vars(H,S));
vars({tuple,_,As}, S) -> vars(As, S);
vars(L, S) when is_list(L) -> lists:foldr(fun vars/2, S, L);
vars(T, S) when is_tuple(T) -> vars(tuple_to_list(T), S);
vars(_, S) -> S.


runtime_resolve_tables(Goal, S) ->
    lists:map(
      fun
	  (P) when is_record(P,pred_sym), P#pred_sym.record_def == ?UNKNOWN ->
	      P#pred_sym{record_def = 
			 arg_record_def(P#pred_sym.type,
					P#pred_sym.functor,
					P#pred_sym.record_type,
					mnemosyne_lib:db_data(
					  argtypes,  P#pred_sym.module),
					mnemosyne_lib:db_data(
					  record_defs, P#pred_sym.module),
					P#pred_sym.line)};
	  (Other) ->
	      Other
      end, Goal).




replace_lcs({'query',_,{lc,Line,E0,Qs0}}, S0) ->
    %% dynamically compiled query
    DbVars = db_vars(Qs0),
    S = S0#s{erl_vars = ordsets:subtract(S0#s.erl_vars, DbVars),
	     db_vars = DbVars,
	     var_types = []},
    Pattern0 = tr_pattern(E0, S#s{line=Line}),
    {Goal0, S1} = tr_body(Qs0, S#s{line=Line}),
    MkGetRecDefs = fun() ->
			   {call,0,{atom,0,'MNEMOSYNE RULE'},
			    [erl_parse:abstract({data,record_defs})]}
		   end,
    S_temp = S#s{mquery=[],options=[],recdefs=MkGetRecDefs},
    {mk_call(?MODULE, the_query, [{Pattern0,Goal0,S_temp}], Line), S1};

replace_lcs({var,L,V}, S) ->
    {{var,L,V}, S#s{erl_vars=ordsets:add_element(V,S#s.erl_vars)}};

replace_lcs([H|T], S0) -> %% mapfoldl doesn't handle non-proper lists
    {H1,S1} = replace_lcs(H, S0),
    {T1,S2} = replace_lcs(T, S1),
    {[H1|T1], S2};

replace_lcs(T, S0) when is_tuple(T) -> 
    {F, S} = replace_lcs(tuple_to_list(T), S0),
    {list_to_tuple(F), S};

replace_lcs(F, S) ->
    {F, S}.

mk_call(Mod, Fun, Args, Line) ->
    Call = {call,Line,{remote,Line,
		       {atom,Line,Mod},
		       {atom,Line,Fun}},
	    lists:map(fun abstract_keep_vars/1, Args)},
    ?debugmsg(3, "mk_call = ~p\n", [Call]),
    Call.
    


abstract_keep_vars(X) ->
    element(1, abstract_keep_vars(X, {[],0})).


abstract_keep_vars({'#erl', X}, L) -> 
    {X, L};

abstract_keep_vars(Fun, L) when is_function(Fun) ->
    {Fun(), L};
    
abstract_keep_vars([H0|T0], L0) ->
    {H, L1} = abstract_keep_vars(H0, L0),
    {T, L} = abstract_keep_vars(T0, L1),
    {{cons,0,H,T}, L};

abstract_keep_vars(Tuple, L0) when is_tuple(Tuple) ->
    {T,L} = lists:mapfoldl(
	      fun(A,B)->
		      abstract_keep_vars(A,B) 
	      end, L0, tuple_to_list(Tuple)),
    {{tuple,0,T}, L};

abstract_keep_vars(R0, {L0,N0}) when is_reference(R0) ->
  case lists:keysearch(R0,1,L0) of
	{value,{R0,R}} ->
	    {erl_parse:abstract(R), {L0,N0}};
	false ->
	    {erl_parse:abstract(N0), {[{R0,N0}|L0], N0+1}}
    end;

abstract_keep_vars(X, L0) ->
    {erl_parse:abstract(X), L0}.



tr_body(L, S0) when is_list(L) ->
    {Body, NewS} = 
	lists:mapfoldl (
	  fun
	      %% DbVar <- Expr
	      ({generate,Line,Left, Right}, S) ->
		  generate_generator(Left, Right, S#s{line=Line});
	      
	      %% Expr Op Expr
	      ({op,Line,Op,Left,Right}, S) ->
		  generate_constraint(Left, Right, Op, S#s{line=Line});

	      %% Expr = Expr
	      ({match,Line,Left,Right}, S) ->
		  generate_constraint(Left, Right, '=', S#s{line=Line});
	      
	      %% Fn(Args)
	      ({call,Line,B,Args}, S) ->
		  generate_constraint({atom,Line,true}, 
				      {call,Line,B,Args},
				      '=',
				      S#s{line=Line});

	      (Others,S) ->
		  case is_compilable (Others, S) of
		      {true, Expr} ->
			  generate_general_constraint (Expr, S);
		      {false, _} ->
			  throw({error, {S#s.line,?MODULE,
					 {illegal_lc_body,Others}}})
		  % XXX
		  end
	  end, S0, L).


db_vars(L) ->
    lists:foldl(
      fun
	  ({generate,_,{var,_,V},_}, VarSet) -> ordsets:add_element(V, VarSet);
	  (_, VarSet) -> VarSet
      end, ordsets:new(), L).
      

generate_constraint(Left, Right, Op, S0) ->
    S = S0#s{allow_erl_vars=true,
	     allow_fun_calls=true},

    NewOp = 
	case Op of 
	    '=' -> '==';
	    _   -> Op 
	end,

    {IsComp, {L2,R2}} = is_compilable({Left, Right}, S),

    case {is_simple_expr (L2), is_simple_expr (R2)} of
	{true, true} ->
	    { #constraint{exprL = expr(L2,S),
			  exprR = expr(R2,S),
			  op    = constr_op(Op,S#s.line),
			  line  = S#s.line},
	      S};
	_ ->
	    case IsComp of
		true ->
		    generate_general_constraint ({op, S#s.line,
						  NewOp,
						  L2, R2}, S);
		false ->
		    {#constraint{exprL = expr(L2,S),
				 exprR = expr(R2,S),
				 op    = constr_op(Op,S#s.line),
				 line  = S#s.line},
			 S}
	    end
    end.

generate_general_constraint (Constr, S) ->
    Vars = all_vars (Constr, ordsets:new()),
    Vars2 = make_replacements (Vars),
    Code  = exchange_vars (Constr, 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)),
    {#constraint{exprL = expr({atom, S1#s.line, true}, S1),
		 exprR = 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}),
		 op = '=',
		 line = S1#s.line},
     S1}.

is_simple_expr ({var, L, Var}) -> 
    true;
is_simple_expr ({record_field, Line,{var,L1,Var},Name,{atom,L3,Field}}) ->
    true;
is_simple_expr ({record_field, Line,{var,L1,Var},{atom,L3,Field}}) ->
    true;
is_simple_expr({integer,_,I}) -> 
    true;
is_simple_expr({float,_,F}) -> 
    true;
is_simple_expr({atom,_,A}) -> 
    true;
is_simple_expr({string,_,Str}) -> 
    true;
is_simple_expr (_) ->
    false.

    

generate_generator({var,VLL,VL}, {var,VRL,VR}, S) ->
    S1 = 
	case {lists:keysearch (VL, 1, S#s.var_types),
	      lists:keysearch (VR, 1, S#s.var_types)} of
	    {false, false} ->
		S;
	    {false, {value, {_, Type}}} ->
		S#s{var_types = [{VL, Type} | S#s.var_types]};
	    {{value, {_, Type}}, false} ->
		S#s{var_types = [{VR, Type} | S#s.var_types]};
	    {{value, {_, Type}}, {value, {_, Type}}} ->
		S;
	    _ ->
		throw({error, {S#s.line, S#s.module, 
			       {variable_types_dont_match, VR, VL}}})
	end,
    {#erl_expr{alias_var = expr_var({var,VLL,VL}, S#s{allow_erl_vars=true,
						      line=VLL}),
	       expr = expr_var({var,VRL,VR}, S#s{allow_erl_vars=true,
						 allow_db_vars=false,
						 line=VRL})},
     S1};


generate_generator({var,VLL,VL}, Right, S) ->
    Var = expr_var({var,VLL,VL}, S#s{line=VLL}),
    
    {IsCompilable, NewExpr} = is_compilable (Right, S),
    
    {Generator, S3} = 
    case Right of
	%% Var <- table(Name) 
	{call,_,{atom,_,table}, Args} ->
	    generate_table_generator (Var, VL, Args, S);

	%% Var <- rule(Name)  (i.e. locally defined rule)
	{call,_,{atom,_,rule}, [{atom,LineP,PredName}]}->
	    Args = [Var],
	    RecDef = arg_record_def(rule,PredName,S),
	    {#pred_sym{module = S#s.module,
		       functor = PredName,
		       line = LineP,
		       type = rule,
		       record_def = RecDef,
		       recursive = non_recursive, % Hypothesis
		       args = Args,
		       original_args_vars = 
		             mnemosyne_unify:variables_and_annonymous(Args)
		      },
	     add_var_type (VL, RecDef, S)};

	%% Var <- rule(Mod:Name)
	{call,_,{atom,_,rule}, [{remote,LineP,{atom,_,Mod},{atom,_,PredName}}]}->
	    Args = [Var],
	    RecDef = if 
			 Mod == S#s.module -> 
			     arg_record_def(rule,PredName,S);