mnemosyne_op.erl

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

%% ``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 via the world wide web 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.
%% 
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
%% AB. All Rights Reserved.''
%% 
%%     $Id$
%%
-module(mnemosyne_op).
-export([bindings/3, funcall/4, erl_expr/2, split/2, table/2, negation/3,
	 negation_help/0, call_recursive_op/2,
	 split_list/2, get_from_table/3, new_end_token/1, start_op/2,
	 add_tid/5, update_endc/3
	]).

%%-define(debug,3).
-define(no_not_yet, yes).

-include("mnemosyne_debug.hrl").
-include("mnemosyne_internal_form.hrl").

-record(acc, {sols=[], bss=[]}).

-ifdef(debug).
-define(trace_printout(Type,Args,Where),
	case Type of
	    negation_help when Where==1 ->
		wait_a_bit;
	    _ ->
		?debugmsg(1, "~w (~w) -> ~w. Args: ~s\n", 
			  [self(), Type, hd(Args),
			   type_dependent_args(Type, Args)])
	end).

type_dependent_args(bindings, [_,_,Bs]) ->
    [" ",mnemosyne_pp:e({'#bindings',1,Bs})];

type_dependent_args(table, [_,P]) when ?debug==2 ->
    [" line=",mnemosyne_pp:e({'#line',P#pred_sym.line}),
     " p=",mnemosyne_pp:e(P#pred_sym.pattern),
     " bp=",mnemosyne_pp:e(P#pred_sym.back_pattern),
     " idx=",io_lib:write(P#pred_sym.idx_method)
    ];

type_dependent_args(table, [_,P]) when ?debug>2 ->
    [" line=",mnemosyne_pp:e({'#line',P#pred_sym.line}),
     " goal=",mnemosyne_pp:e(P),
     " p=",mnemosyne_pp:e(P#pred_sym.pattern),
     " bp=",mnemosyne_pp:e(P#pred_sym.back_pattern),
     " idx=",io_lib:write(P#pred_sym.idx_method),
     " defvars=",io_lib:write(P#pred_sym.defvars)
    ];

type_dependent_args(negation, [_,HelpPid]) ->
    [" help=",io_lib:write(HelpPid)
    ];

type_dependent_args(negation_help, [Qpid,MainPid]) ->
    [" QueryPid=",io_lib:write(Qpid),
     " MainPid=",io_lib:write(MainPid)
    ];

type_dependent_args(Type, Args) ->
    [" ",mnemosyne_pp:e(Args)].

-else.
-define(trace_printout(Type,Args,Where),ok).
-endif.

%%%================================================================
%%% 		Exports

start_op(Type, Args) ->
    ?trace_printout(Type, Args, 1),
    %% The Type(Args) call never returns unless there is an exception:
    case catch apply(?MODULE, Type, Args) of
	{'EXIT',Cause} -> exit(Cause);
	Others -> exit({throw,Others})
    end.

new_end_token(N) ->
    {{make_ref(),erlang:now()}, N}.

%%%----------------------------------------------------------------
%%%---- Adds bindings to a set of bindings

bindings(NextPid, BCount,Bs) ->
    bindings(NextPid, BCount,Bs, Bs, {[],[],[]}).

bindings(NextPid, BCount,Bs, BsOrig, {Tid, PidL, EndC}) ->
    receive
	{bss, Bss, Max, EndCntrl, Stack, LastMarker} when Bss =/= [] ->
	    NewEndC = update_endc (PidL, EndC, LastMarker),
	    case check_lastmarker (NewEndC, BCount, LastMarker) of
		true ->
		    NextPid ! {bss, bss_union(Bss,Bs), Max, EndCntrl, Stack, {true, self()}};
		_ ->
		    NextPid ! {bss, bss_union(Bss,Bs), Max, EndCntrl, Stack, false}
	    end,
	    bindings(NextPid, BCount, [], BsOrig, {Tid, PidL, NewEndC});

	{bss, _, Max, EndCntrl, Stack, LastMarker} ->
	    NewEndC = update_endc (PidL, EndC, LastMarker),
	    case check_lastmarker (NewEndC, BCount, LastMarker) of
		true ->
		    NextPid ! {bss, [], Max, EndCntrl, Stack, {true, self()}};
		_ ->
		    NextPid ! {bss, [], Max, EndCntrl, Stack, false}
	    end,
	    bindings(NextPid, BCount, [], BsOrig, {Tid, PidL, NewEndC});
	
	{fail, SomePid, Cause} ->
	    NextPid ! {fail, self(), Cause},
	    bindings(NextPid, BCount, BsOrig);

	{tid, NTid, Pid} ->
	    NextPid ! {tid,Tid},
	    bindings(NextPid, BCount,Bs, BsOrig, add_tid (Tid, PidL, EndC, NTid, Pid))
    end.



%%%----------------------------------------------------------------
%%%---- Call an Erlang functi n

funcall (NextPid, LeftSide, FunCall, Count) ->
    funcall_loop (NextPid, LeftSide, FunCall, Count, {[], [], []}).

funcall_loop(NextPid, LeftSide, FunCall, Count, {Tid, PidL, EndC}) ->
    receive
	{bss, Bss, Max, EndCntrl, Stack, LastMarker} ->
	    NewEndC = update_endc (PidL, EndC, LastMarker),

	    case eval_funcall(Bss,LeftSide,FunCall,[]) of
		{fail, Cause} ->
		    NextPid ! {fail, self(), Cause};
		{ok, NewBss} ->
		    ?debugmsg(3,"~w: ~w ! ~w\n", 
			      [self(), NextPid, {bss, NewBss, Max, EndCntrl, Stack}]),
		    case check_lastmarker (NewEndC, Count, LastMarker) of
			true ->
			    NextPid ! {bss, NewBss, Max, EndCntrl, Stack, 
				       {true, self ()}};
			_ ->
			    NextPid ! {bss, NewBss, Max, EndCntrl, Stack, 
				       false}
		    end
	    end,
	    funcall_loop (NextPid, LeftSide, FunCall, Count, {Tid, PidL, NewEndC});
	
	{fail, SomePid, Cause} ->
	    NextPid ! {fail, self(), Cause},
	    funcall (NextPid, LeftSide, FunCall, Count);

	{tid, NTid, Pid} ->
	    NextPid ! {tid,NTid, self()},
	    funcall_loop(NextPid, LeftSide, FunCall, Count,  
			 add_tid (Tid, PidL, EndC, NTid, Pid))
    end.


	
eval_funcall([Bs|Bss], LeftSide, FunCall, Acc) ->
    {'#funcall',M,F,Args} = mnemosyne_unify:instantiate(FunCall,Bs),
    Ref = make_ref(),
    case catch {Ref, apply(M,F,Args)} of
	{Ref, Res} ->
	    case mnemosyne_unify:unify(LeftSide, apply(M,F,Args), Bs) of
		fail ->
		    eval_funcall(Bss, LeftSide, FunCall, Acc);
		NewBs ->
		    eval_funcall(Bss, LeftSide, FunCall, [NewBs|Acc])
	    end;
	{'EXIT', Cause} ->
	    {fail, Cause}; 
	Other ->
	    {fail, {throw, Other}}
    end;
    
eval_funcall([], LeftSide, FunCall, Acc) ->
    {ok, Acc}.
    

%%%----------------------------------------------------------------
%%%---- 

erl_expr(NextPid, Expr) ->
    erl_expr(NextPid, Expr, [], {[],[],[]}).

erl_expr(NextPid, Expr, Sols, {Tid, PidL, EndC}) ->
    receive
	{bss, Bss, Max, EndCntrl, Stack, LastMarker} ->
	    NewEndC = update_endc (PidL, EndC, LastMarker),

	    {First, Last} = 
		split_list(Max, get_values(Bss,Expr,Sols)),
	    
	    case {Last, check_lastmarker(NewEndC, Expr#erl_expr.rec_count, LastMarker)} of
		{[], true}  ->
		    NextPid ! {bss, First, Max, EndCntrl, Stack, {true, self ()}};
		_ ->
		    NextPid ! {bss, First, Max, EndCntrl, Stack,  false}
	    end,
	    erl_expr(NextPid, Expr, Last, {Tid, PidL, NewEndC});

	{fail, SomePid, Cause} ->
	    NextPid ! {fail, self(), Cause},
	    erl_expr (NextPid, Expr);

	{tid, NTid, Pid} ->
	    NextPid ! {tid, NTid, self()},
	    erl_expr(NextPid, Expr, [], add_tid (Tid, PidL, EndC, NTid, Pid))

    end.

get_values(Bss, Expr, Acc0) ->
    lists:foldl(
      fun(Bs,Acc) ->
	      ?debugmsg(2,"~w: Value = ~w\n",
			[self(),
			 mnemosyne_unify:instantiate(Expr#erl_expr.expr,Bs)]),
%	      case mnemosyne_unify:unify(
%		     mnemosyne_unify:instantiate(Expr#erl_expr.expr,Bs),
%		     Expr#erl_expr.alias_var,
%		     Bs) of
%		  fail -> Acc;
%		  NewBs -> [NewBs|Acc]
%	      end
	      unify_list(mnemosyne_unify:instantiate(Expr#erl_expr.expr,Bs),
			 Expr#erl_expr.alias_var, Bs, Acc)
      end, Acc0, Bss).

%%%----------------------------------------------------------------
%%%---- Multiplexes a message to many receivers

split (NextPids, Count) ->
    split_loop (NextPids, Count, {[],[],[]}).

split_loop(NextPids, Count, {Tid, PidL,EndC}) ->
    receive
	{bss, Bss, Max, EndCntrl, Stack, LastMarker} ->
	    NewEndC = update_endc (PidL, EndC, LastMarker),

	    NewEnd = new_end_token(length(NextPids)),
	    case check_lastmarker (NewEndC, Count, LastMarker) of
		true ->
		    hd(NextPids) ! {bss, Bss, Max, [NewEnd|EndCntrl], 
				    Stack, {true, self ()}},
		    send(tl(NextPids), {bss, Bss, Max, [NewEnd], 
					Stack, {true, self ()}});
		_ ->
		    hd(NextPids) ! {bss, Bss, Max, [NewEnd|EndCntrl], 
				    Stack, false},
		    send(tl(NextPids), {bss, Bss, Max, [NewEnd], 
					Stack, false})
	    end,
	    split_loop (NextPids, Count, {Tid, PidL, NewEndC});

	{fail, SomePid, Cause} ->
	    send(NextPids, {fail, self(), Cause}),
	    split (NextPids, Count);
	
	{tid, NTid,Pid} ->
	    send(NextPids, {tid,NTid, self ()}),
	    split_loop (NextPids, Count, add_tid (Tid, PidL, EndC, NTid, Pid))
    end.


%%%----------------------------------------------------------------
%%%---- Table lookup

table(NextPid, P) when is_record(P,pred_sym) ->
    table_loop(NextPid, P, #acc{}, {[], [], []}).


%%%----------------------------------------------------------------
%%%---- Negation

negation(NextPid, Count,HelpPid) ->
    negation(NextPid, Count,HelpPid, [], {[], [], []}).


negation_help() ->
    receive
	{pids, Buddie, NextPid} ->
	    ?trace_printout(negation_help, [NextPid,Buddie], 2),
	    negation_help(NextPid,Buddie,[], {[],[], []})
    end.

%%%----------------------------------------------------------------
%%---- Recursion
%% A first solution. For each binding, get ALL solutions from SLG and
%% THEN pass them on to the DestPid.