sofs.erl

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

			    [L1 | L2] = partition3(?LIST(S2), R1),
			    {?SET(sort(L1), Type1), ?SET(sort(L2), Type1)};
			false ->
			    erlang:fault(type_mismatch, [SetFun, S1, S2])
		    end;
		Bad ->
		    erlang:fault(Bad, [SetFun, S1, S2])
	    end;
	_ when Type1 =:= ?ANYTYPE ->
	    {S1, S1};
	_XFun when ?IS_SET_OF(Type1) ->
            erlang:fault(badarg, [SetFun, S1, S2]);
	XFun ->
	    FunT = XFun(Type1),
	    case catch check_fun(Type1, XFun, FunT) of
		{'EXIT', _} ->
		    erlang:fault(badarg, [SetFun, S1, S2]);
		Sort ->
		    case match_types(FunT, Type2) of
			true ->
			    R1 = inverse_substitution(SL1, XFun, Sort),
			    [L1 | L2] = partition3(?LIST(S2), R1),
			    {?SET(sort(L1), Type1), ?SET(sort(L2), Type1)};
			false ->
			    erlang:fault(type_mismatch, [SetFun, S1, S2])
		    end
	    end
    end.

multiple_relative_product(T, R) when is_tuple(T), ?IS_SET(R) ->
    case test_rel(R, size(T), eq) of
	true when ?TYPE(R) =:= ?ANYTYPE ->
	    empty_set();
        true -> 
	    MProd = mul_relprod(tuple_to_list(T), 1, R),
	    relative_product(list_to_tuple(MProd));
        false -> 
	    erlang:fault(badarg, [T, R])
    end.

join(R1, I1, R2, I2) 
  when ?IS_SET(R1), ?IS_SET(R2), is_integer(I1), is_integer(I2) ->
    case test_rel(R1, I1, lte) and test_rel(R2, I2, lte) of
        false -> 
	    erlang:fault(badarg, [R1, I1, R2, I2]);
        true when ?TYPE(R1) =:= ?ANYTYPE -> R1;
        true when ?TYPE(R2) =:= ?ANYTYPE -> R2;
        true ->
	    L1 = ?LIST(raise_element(R1, I1)),
	    L2 = ?LIST(raise_element(R2, I2)),
	    T = relprod1(L1, L2),
	    F = case (I1 =:= 1) and (I2 =:= 1)  of
		    true ->
			fun({X,Y}) -> join_element(X, Y) end;
		    false ->
			fun({X,Y}) -> 
				list_to_tuple(join_element(X, Y, I2)) 
			end
		end,
	    ?SET(replace(T, F, []), F({?TYPE(R1), ?TYPE(R2)}))
    end.

%% Inlined.
test_rel(R, I, C) ->
    case ?TYPE(R) of
        Rel when ?IS_RELATION(Rel), C =:= eq, I =:= ?REL_ARITY(Rel) -> true;
        Rel when ?IS_RELATION(Rel), C =:= lte, I>=1, I =< ?REL_ARITY(Rel) ->
            true;
        ?ANYTYPE -> true;
        _ -> false
    end.

%%%
%%% Family functions
%%%

fam2rel(F) ->
    family_to_relation(F).

%% Inlined.
family_to_relation(F) when ?IS_SET(F) ->
    case ?TYPE(F) of
        ?FAMILY(DT, RT) ->
	    ?SET(family2rel(?LIST(F), []), ?BINREL(DT, RT));
        ?ANYTYPE -> F;
        _ -> erlang:fault(badarg, [F])
    end.

family_specification(Fun, F) when ?IS_SET(F) ->
    case ?TYPE(F) of
        ?FAMILY(_DT, Type) = FType ->
	    R = case external_fun(Fun) of
		    false ->
			fam_spec(?LIST(F), Fun, Type, []);
		    XFun ->
			fam_specification(?LIST(F), XFun, [])
		end,
	    case R of
		SL when is_list(SL) ->
		    ?SET(SL, FType);
		Bad ->
		    erlang:fault(Bad, [Fun, F])
	    end;
        ?ANYTYPE -> F;
        _ -> erlang:fault(badarg, [Fun, F])
    end.

union_of_family(F) when ?IS_SET(F) ->
    case ?TYPE(F) of
        ?FAMILY(_DT, Type) ->
	    ?SET(un_of_fam(?LIST(F), []), Type);
        ?ANYTYPE -> F;
        _ -> erlang:fault(badarg, [F])
    end.

intersection_of_family(F) when ?IS_SET(F) ->
    case ?TYPE(F) of
        ?FAMILY(_DT, Type) ->
            case int_of_fam(?LIST(F)) of
                FU when is_list(FU) ->
                    ?SET(FU, Type);
                Bad ->
                    erlang:fault(Bad, [F])
            end;
        _ -> erlang:fault(badarg, [F])
    end.

family_union(F) when ?IS_SET(F) ->
    case ?TYPE(F) of
        ?FAMILY(DT, ?SET_OF(Type)) ->
	    ?SET(fam_un(?LIST(F), []), ?FAMILY(DT, Type));
        ?ANYTYPE -> F;
        _ -> erlang:fault(badarg, [F])
    end.

family_intersection(F) when ?IS_SET(F) ->
    case ?TYPE(F) of
        ?FAMILY(DT, ?SET_OF(Type)) ->
            case fam_int(?LIST(F), []) of
                FU when is_list(FU) ->
                    ?SET(FU, ?FAMILY(DT, Type));
                Bad ->
                    erlang:fault(Bad, [F])
            end;
        ?ANYTYPE -> F;
        _ -> erlang:fault(badarg, [F])
    end.

family_domain(F) when ?IS_SET(F) ->
    case ?TYPE(F) of
        ?FAMILY(FDT, ?BINREL(DT, _)) ->
            ?SET(fam_dom(?LIST(F), []), ?FAMILY(FDT, DT));
        ?ANYTYPE -> F;
        ?FAMILY(_, ?ANYTYPE) -> F;
        _ -> erlang:fault(badarg, [F])
    end.

family_range(F) when ?IS_SET(F) ->
    case ?TYPE(F) of
        ?FAMILY(DT, ?BINREL(_, RT)) ->
            ?SET(fam_ran(?LIST(F), []), ?FAMILY(DT, RT));
        ?ANYTYPE -> F;
        ?FAMILY(_, ?ANYTYPE) -> F;
        _ -> erlang:fault(badarg, [F])
    end.

family_field(F) ->
    family_union(family_domain(F), family_range(F)).

family_union(F1, F2) ->
    fam_binop(F1, F2, fun fam_union/3).

family_intersection(F1, F2) ->
    fam_binop(F1, F2, fun fam_intersect/3).

family_difference(F1, F2) ->
    fam_binop(F1, F2, fun fam_difference/3).

%% Inlined.
fam_binop(F1, F2, FF) when ?IS_SET(F1), ?IS_SET(F2) ->
    case unify_types(?TYPE(F1), ?TYPE(F2)) of
        [] ->
            erlang:fault(type_mismatch, [F1, F2]);
        ?ANYTYPE -> 
            F1;
        Type = ?FAMILY(_, _) -> 
	    ?SET(FF(?LIST(F1), ?LIST(F2), []), Type);
        _ ->  erlang:fault(badarg, [F1, F2])
    end.

partition_family(I, Set) when is_integer(I), ?IS_SET(Set) ->
    Type = ?TYPE(Set),
    case check_for_sort(Type, I) of
        empty ->
            Set;
        error ->
            erlang:fault(badarg, [I, Set]);
	false -> % when I =:= 1
	    ?SET(fam_partition_n(I, ?LIST(Set)),
		 ?BINREL(?REL_TYPE(I, Type), ?SET_OF(Type)));
        true ->
	    ?SET(fam_partition_n(I, keysort(I, ?LIST(Set))),
		 ?BINREL(?REL_TYPE(I, Type), ?SET_OF(Type)))
    end;
partition_family(SetFun, Set) when ?IS_SET(Set) ->
    Type = ?TYPE(Set),
    SL = ?LIST(Set),
    case external_fun(SetFun) of
	false when SL =/= [] ->
	    case subst(SL, SetFun, element_type(Type)) of
		{NSL, NewType} ->
		    P = fam_partition(converse(NSL, []), true),
		    ?SET(reverse(P), ?BINREL(NewType, ?SET_OF(Type)));
		Bad ->
		    erlang:fault(Bad, [SetFun, Set])
	    end;
	false ->
	    empty_set();
	_ when Type =:= ?ANYTYPE ->
	    empty_set();
	_XFun when ?IS_SET_OF(Type) ->
            erlang:fault(badarg, [SetFun, Set]);
	XFun ->
	    DType = XFun(Type),
	    case catch check_fun(Type, XFun, DType) of
		{'EXIT', _} ->
		    erlang:fault(badarg, [SetFun, Set]);
		Sort ->
		    Ts = inverse_substitution(?LIST(Set), XFun, Sort),
		    P = fam_partition(Ts, Sort),
		    ?SET(reverse(P), ?BINREL(DType, ?SET_OF(Type)))
	    end
    end.

family_projection(SetFun, F) when ?IS_SET(F) ->
    case ?TYPE(F) of 
        ?FAMILY(_, _) when [] =:= ?LIST(F) ->
	    empty_set();
        ?FAMILY(DT, Type) ->
	    case external_fun(SetFun) of
		false ->
		    case fam_proj(?LIST(F), SetFun, Type, ?ANYTYPE, []) of
			{SL, NewType} ->
			    ?SET(SL, ?BINREL(DT, NewType));
			Bad ->
			    erlang:fault(Bad, [SetFun, F])
		    end;
		_ -> 
		    erlang:fault(badarg, [SetFun, F])
	    end;
	?ANYTYPE -> F;
        _ -> erlang:fault(badarg, [SetFun, F])
    end.

%%%
%%% Digraph functions
%%%

family_to_digraph(F) when ?IS_SET(F) ->
    case ?TYPE(F) of
        ?FAMILY(_, _) -> fam2digraph(F, digraph:new());
        ?ANYTYPE -> digraph:new();
        _Else -> erlang:fault(badarg, [F])
    end.

family_to_digraph(F, Type) when ?IS_SET(F) ->
    G = case ?TYPE(F) of
            ?FAMILY(_, _) -> digraph:new(Type);
            ?ANYTYPE -> digraph:new(Type);
            _Else  -> erlang:fault(badarg, [F, Type])
        end,
    case G of
        {error, _} -> erlang:fault(badarg, [F, Type]);
        _ -> case catch fam2digraph(F, G) of
                 {error, Reason} ->
                     true = digraph:delete(G),
                     erlang:fault(Reason, [F, Type]);
                 _ -> 
                     G
             end
    end.

digraph_to_family(G) ->
    case catch digraph_family(G) of
        {'EXIT', _} -> erlang:fault(badarg, [G]);
        L -> ?SET(L, ?FAMILY(?ATOM_TYPE, ?ATOM_TYPE))
    end.

digraph_to_family(G, T) ->
    case {is_type(T), T} of
        {true, ?SET_OF(?FAMILY(_,_) = Type)} ->
            case catch digraph_family(G) of
                {'EXIT', _} -> erlang:fault(badarg, [G, T]);
                L -> ?SET(L, Type)
            end;
        _ ->
            erlang:fault(badarg, [G, T])
    end.

%%
%%  Local functions
%%

%% Type = OrderedSetType
%%      | SetType
%%      | atom() except '_'
%% OrderedSetType = {Type, ..., Type}
%% SetType = [ElementType]           % list of exactly one element
%% ElementType = '_'                 % any type (implies empty set)
%%             | Type

is_types(0, _T) ->
    true;
is_types(I, T) ->
    case is_type(?REL_TYPE(I, T)) of
        true -> is_types(I-1, T);
        false -> false
    end.

is_element_type(?ANYTYPE) ->
    true;
is_element_type(T) ->
    is_type(T).

set_of_sets([S | Ss], L, T0) when ?IS_SET(S) ->
    case unify_types([?TYPE(S)], T0) of
        [] -> {error, type_mismatch};
        Type ->  set_of_sets(Ss, [?LIST(S) | L], Type)
    end;
set_of_sets([S | Ss], L, T0) when ?IS_ORDSET(S) ->
    case unify_types(?ORDTYPE(S), T0) of
        [] -> {error, type_mismatch};
        Type ->  set_of_sets(Ss, [?ORDDATA(S) | L], Type)
    end;
set_of_sets([], L, T) ->
    ?SET(usort(L), T);
set_of_sets(_, _L, _T) ->
    {error, badarg}.

ordset_of_sets([S | Ss], L, T) when ?IS_SET(S) ->
    ordset_of_sets(Ss, [?LIST(S) | L], [[?TYPE(S)] | T]);
ordset_of_sets([S | Ss], L, T) when ?IS_ORDSET(S) ->
    ordset_of_sets(Ss, [?ORDDATA(S) | L], [?ORDTYPE(S) | T]);
ordset_of_sets([], L, T) ->
    ?ORDSET(list_to_tuple(reverse(L)), list_to_tuple(reverse(T)));
ordset_of_sets(_, _L, _T) ->
    error.

%% Inlined.
rel(Ts, [Type]) ->
    case is_type(Type) and atoms_only(Type, 1) of
        true ->
            rel(Ts, size(Type), Type);
        false ->
            rel_type(Ts, [], Type)
    end;
rel(Ts, Sz) ->
    rel(Ts, Sz, erlang:make_tuple(Sz, ?ATOM_TYPE)).
    
atoms_only(Type, I) when ?IS_ATOM_TYPE(?REL_TYPE(I, Type)) ->
    atoms_only(Type, I+1);
atoms_only(Type, I) when I > size(Type), ?IS_RELATION(Type) ->
    true;
atoms_only(_Type, _I) ->
    false.

rel(Ts, Sz, Type) when Sz >= 1 ->
    SL = usort(Ts),
    rel(SL, SL, Sz, Type).

rel([T | Ts], L, Sz, Type) when is_tuple(T), size(T) =:= Sz ->
    rel(Ts, L, Sz, Type);
rel([], L, _Sz, Type) ->
    ?SET(L, Type).

rel_type([E | Ts], L, Type) ->
    {NType, NE} = make_element(E, Type, Type),
    rel_type(Ts, [NE | L], NType);
rel_type([], [], ?ANYTYPE) ->
    empty_set();
rel_type([], SL, Type) when ?IS_RELATION(Type) ->
    ?SET(usort(SL), Type).

%% Inlined.
a_func(Ts, T) ->
    case {T, is_type(T)} of
	{[?BINREL(DT, RT) = Type], true} when ?IS_ATOM_TYPE(DT), 
					      ?IS_ATOM_TYPE(RT)  ->
	    func(Ts, Type);
	{[Type], true} ->
	    func_type(Ts, [], Type, fun(?BINREL(_,_)) -> true end)
    end.

func(L0, Type) ->
    L = usort(L0),
    func(L, L, L, Type).

func([{X,_} | Ts], X0, L, Type) when X /= X0 ->
    func(Ts, X, L, Type);
func([{X,_} | _Ts], X0, _L, _Type) when X == X0 ->
    bad_function;
func([], _X0, L, Type) ->
    ?SET(L, Type).

%% Inlined.
fam(Ts, T) ->
    case {T, is_type(T)} of
	{[?FAMILY(DT, RT) = Type], true} when ?IS_ATOM_TYPE(DT), 
					      ?IS_ATOM_TYPE(RT)  ->
	    fam2(Ts, Type);
	{[Type], true} ->
	    func_type(Ts, [], Type, fun(?FAMILY(_,_)) -> true end)
    end.

fam2([], Type) -> 
    ?SET([], Type);
fam2(Ts, Type) -> 
    fam2(sort(Ts), Ts, [], Type).

fam2([{I,L} | T], I0, SL, Type) when I /= I0 ->
    fam2(T, I, [{I,usort(L)} | SL], Type);
fam2([{I,L} | T], I0, SL, Type) when I == I0 ->
    case {usort(L), SL} of
	{NL, [{_I,NL1} | _]} when NL == NL1 ->
	    fam2(T, I0, SL, Type);
	_ ->
	    bad_function
    end;
fam2([], _I0, SL, Type) ->
    ?SET(reverse(SL), Type).

func_type([E | T], SL, Type, F) ->
    {NType, NE} = make_element(E, Type, Type),
    func_type(T, [NE | SL], NType, F);
func_type([], [], ?ANYTYPE, _F) ->
    empty_set();
func_type([], SL, Type, F) ->
    true = F(Type),
    NL = usort(SL),
    check_function(NL, ?SET(NL, Type)).

setify(L, ?SET_OF(Atom)) when ?IS_ATOM_TYPE(Atom), Atom =/= ?ANYTYPE ->
    ?SET(usort(L), Atom);
setify(L, ?SET_OF(Type0)) ->
    case catch is_no_lists(Type0) of
        {'EXIT', _} ->
            {?SET_OF(Type), Set} = create(L, Type0, Type0, []),
            ?SET(Set, Type);
        N when is_integer(N) ->
             rel(L, N, Type0);
        Sizes ->
            make_oset(L, Sizes, L, Type0)
    end;
setify(E, Type0) ->
    {Type, OrdSet} = make_element(E, Type0, Type0),
    ?ORDSET(OrdSet, Type).

is_no_lists(T) when is_tuple(T) -> 
   Sz = size(T),
   is_no_lists(T, Sz, Sz, []).

is_no_lists(_T, 0, Sz, []) ->
   Sz;