sofs.erl

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

is_no_lists(_T, 0, Sz, L) ->
   {Sz, L};
is_no_lists(T, I, Sz, L) when ?IS_ATOM_TYPE(?REL_TYPE(I, T)) ->
   is_no_lists(T, I-1, Sz, L);
is_no_lists(T, I, Sz, L) ->
   is_no_lists(T, I-1, Sz, [{I,is_no_lists(?REL_TYPE(I, T))} | L]).

create([E | Es], T, T0, L) ->
    {NT, S} = make_element(E, T, T0),
    create(Es, NT, T0, [S | L]);
create([], T, _T0, L) ->
    {?SET_OF(T), usort(L)}.

make_element(C, ?ANYTYPE, _T0) ->
    make_element(C);
make_element(C, Atom, ?ANYTYPE) when ?IS_ATOM_TYPE(Atom), 
                                     not is_list(C), not is_tuple(C) ->
    {Atom, C};
make_element(C, Atom, Atom) when ?IS_ATOM_TYPE(Atom) ->
    {Atom, C};
make_element(T, TT, ?ANYTYPE) when is_tuple(T), is_tuple(TT), 
                                   size(T) =:= size(TT) ->
    make_tuple(tuple_to_list(T), tuple_to_list(TT), [], [], ?ANYTYPE);
make_element(T, TT, T0) when is_tuple(T), is_tuple(TT), 
                             size(T) =:= size(TT) ->
    make_tuple(tuple_to_list(T), tuple_to_list(TT), [], [], tuple_to_list(T0));
make_element(L, [LT], ?ANYTYPE) when is_list(L) ->
    create(L, LT, ?ANYTYPE, []);
make_element(L, [LT], [T0]) when is_list(L) ->
    create(L, LT, T0, []).

make_tuple([E | Es], [T | Ts], NT, L, T0) when T0 =:= ?ANYTYPE ->
    {ET, ES} = make_element(E, T, T0),
    make_tuple(Es, Ts, [ET | NT], [ES | L], T0);
make_tuple([E | Es], [T | Ts], NT, L, [T0 | T0s]) ->
    {ET, ES} = make_element(E, T, T0),
    make_tuple(Es, Ts, [ET | NT], [ES | L], T0s);
make_tuple([], [], NT, L, _T0s) when NT =/= [] ->
    {list_to_tuple(reverse(NT)), list_to_tuple(reverse(L))}.

%% Derive type.
make_element(C) when not is_list(C), not is_tuple(C) ->
    {?ATOM_TYPE, C};
make_element(T) when is_tuple(T) ->
    make_tuple(tuple_to_list(T), [], []);
make_element(L) when is_list(L) ->
    create(L, ?ANYTYPE, ?ANYTYPE, []).

make_tuple([E | Es], T, L) ->
    {ET, ES} = make_element(E),
    make_tuple(Es, [ET | T], [ES | L]);
make_tuple([], T, L) when T =/= [] ->
    {list_to_tuple(reverse(T)),  list_to_tuple(reverse(L))}.

make_oset([T | Ts], Szs, L, Type) ->
    true = test_oset(Szs, T, T),
    make_oset(Ts, Szs, L, Type);
make_oset([], _Szs, L, Type) ->
    ?SET(usort(L), Type).

%% Optimization. Avoid re-building (nested) tuples.
test_oset({Sz,Args}, T, T0) when is_tuple(T), size(T) =:= Sz ->
    test_oset_args(Args, T, T0);
test_oset(Sz, T, _T0) when is_tuple(T), size(T) =:= Sz ->
    true.

test_oset_args([{Arg,Szs} | Ss], T, T0) ->
    true = test_oset(Szs, ?REL_TYPE(Arg, T), T0),
    test_oset_args(Ss, T, T0);
test_oset_args([], _T, _T0) ->
    true.

list_of_sets([S | Ss], Type, L) ->
    list_of_sets(Ss, Type, [?SET(S, Type) | L]);
list_of_sets([], _Type, L) ->
    reverse(L).

list_of_ordsets([S | Ss], Type, L) ->
    list_of_ordsets(Ss, Type, [?ORDSET(S, Type) | L]);
list_of_ordsets([], _Type, L) ->
    reverse(L).

tuple_of_sets([S | Ss], [?SET_OF(Type) | Types], L) ->
    tuple_of_sets(Ss, Types, [?SET(S, Type) | L]);
tuple_of_sets([S | Ss], [Type | Types], L) ->
    tuple_of_sets(Ss, Types, [?ORDSET(S, Type) | L]);
tuple_of_sets([], [], L) ->
    list_to_tuple(reverse(L)).

spec([E | Es], Fun, Type, L) ->
    case Fun(term2set(E, Type)) of
        true ->
            spec(Es, Fun, Type, [E | L]);
        false ->
            spec(Es, Fun, Type, L);
	_ ->
	    badarg
    end;
spec([], _Fun, _Type, L) ->
    reverse(L).

specification([E | Es], Fun, L) ->
    case Fun(E) of
        true ->
            specification(Es, Fun, [E | L]);
        false ->
            specification(Es, Fun, L);
	_ ->
	    badarg
    end;
specification([], _Fun, L) ->
    reverse(L).

%% Elements from the first list are kept.
intersection([H1 | T1], [H2 | T2], L) when H1 < H2 ->
    intersection1(T1, T2, L, H2);
intersection([H1 | T1], [H2 | T2], L) when H1 == H2 ->
    intersection(T1, T2, [H1 | L]);
intersection([H1 | T1], [_H2 | T2], L) ->
    intersection2(T1, T2, L, H1);
intersection(_, _, L) ->
    reverse(L).

intersection1([H1 | T1], T2, L, H2) when H1 < H2 ->
    intersection1(T1, T2, L, H2);
intersection1([H1 | T1], T2, L, H2) when H1 == H2 ->
    intersection(T1, T2, [H1 | L]);
intersection1([H1 | T1], T2, L, _H2) ->
    intersection2(T1, T2, L, H1);
intersection1(_, _, L, _) ->
    reverse(L).

intersection2(T1, [H2 | T2], L, H1) when H1 > H2 ->
    intersection2(T1, T2, L, H1);
intersection2(T1, [H2 | T2], L, H1) when H1 == H2 ->
    intersection(T1, T2, [H1 | L]);
intersection2(T1, [H2 | T2], L, _H1) ->
    intersection1(T1, T2, L, H2);
intersection2(_, _, L, _) ->
    reverse(L).

difference([H1 | T1], [H2 | T2], L) when H1 < H2 ->
    diff(T1, T2, [H1 | L], H2);
difference([H1 | T1], [H2 | T2], L) when H1 == H2 ->
    difference(T1, T2, L);
difference([H1 | T1], [_H2 | T2], L) ->
    diff2(T1, T2, L, H1);
difference(L1, _, L) ->
    reverse(L, L1).

diff([H1 | T1], T2, L, H2) when H1 < H2 ->
    diff(T1, T2, [H1 | L], H2);
diff([H1 | T1], T2, L, H2) when H1 == H2 ->
    difference(T1, T2, L);
diff([H1 | T1], T2, L, _H2) ->
    diff2(T1, T2, L, H1);
diff(_, _, L, _) ->
    reverse(L).

diff2(T1, [H2 | T2], L, H1) when H1 > H2 ->
    diff2(T1, T2, L, H1);
diff2(T1, [H2 | T2], L, H1) when H1 == H2 ->
    difference(T1, T2, L);
diff2(T1, [H2 | T2], L, H1) ->
    diff(T1, T2, [H1 | L], H2);
diff2(T1, _, L, H1) ->
    reverse(L, [H1 | T1]).

symdiff([H1 | T1], T2, L) ->
    symdiff2(T1, T2, L, H1);
symdiff(_, T2, L) ->
    reverse(L, T2).

symdiff1([H1 | T1], T2, L, H2) when H1 < H2 ->
    symdiff1(T1, T2, [H1 | L], H2);
symdiff1([H1 | T1], T2, L, H2) when H1 == H2 ->
    symdiff(T1, T2, L);
symdiff1([H1 | T1], T2, L, H2) ->
    symdiff2(T1, T2, [H2 | L], H1);
symdiff1(_, T2, L, H2) ->
    reverse(L, [H2 | T2]).

symdiff2(T1, [H2 | T2], L, H1) when H1 > H2 ->
    symdiff2(T1, T2, [H2 | L], H1);
symdiff2(T1, [H2 | T2], L, H1) when H1 == H2 ->
    symdiff(T1, T2, L);
symdiff2(T1, [H2 | T2], L, H1) ->
    symdiff1(T1, T2, [H1 | L], H2);
symdiff2(T1, _, L, H1) ->
    reverse(L, [H1 | T1]).

sympart([H1 | T1], [H2 | T2], L1, L12, L2, T) when H1 < H2 ->
    sympart1(T1, T2, [H1 | L1], L12, L2, T, H2);
sympart([H1 | T1], [H2 | T2], L1, L12, L2, T) when H1 == H2 ->
    sympart(T1, T2, L1, [H1 | L12], L2, T);
sympart([H1 | T1], [H2 | T2], L1, L12, L2, T) ->
    sympart2(T1, T2, L1, L12, [H2 | L2], T, H1);
sympart(S1, [], L1, L12, L2, T) ->
    {?SET(reverse(L1, S1), T), 
     ?SET(reverse(L12), T), 
     ?SET(reverse(L2), T)};
sympart(_, S2, L1, L12, L2, T) ->
    {?SET(reverse(L1), T), 
     ?SET(reverse(L12), T), 
     ?SET(reverse(L2, S2), T)}.

sympart1([H1 | T1], T2, L1, L12, L2, T, H2) when H1 < H2 ->
    sympart1(T1, T2, [H1 | L1], L12, L2, T, H2);
sympart1([H1 | T1], T2, L1, L12, L2, T, H2) when H1 == H2 ->
    sympart(T1, T2, L1, [H1 | L12], L2, T);
sympart1([H1 | T1], T2, L1, L12, L2, T, H2) ->
    sympart2(T1, T2, L1, L12, [H2 | L2], T, H1);
sympart1(_, T2, L1, L12, L2, T, H2) ->
    {?SET(reverse(L1), T), 
     ?SET(reverse(L12), T), 
     ?SET(reverse(L2, [H2 | T2]), T)}.

sympart2(T1, [H2 | T2], L1, L12, L2, T, H1) when H1 > H2 ->
    sympart2(T1, T2, L1, L12, [H2 | L2], T, H1);
sympart2(T1, [H2 | T2], L1, L12, L2, T, H1) when H1 == H2 ->
    sympart(T1, T2, L1, [H1 | L12], L2, T);
sympart2(T1, [H2 | T2], L1, L12, L2, T, H1) ->
    sympart1(T1, T2, [H1 | L1], L12, L2, T, H2);
sympart2(T1, _, L1, L12, L2, T, H1) ->
    {?SET(reverse(L1, [H1 | T1]), T), 
     ?SET(reverse(L12), T), 
     ?SET(reverse(L2), T)}.

prod([[E | Es] | Xs], T, L) ->
    prod(Es, Xs, T, prod(Xs, [E | T], L));
prod([], T, L) ->
    [list_to_tuple(reverse(T)) | L].

prod([E | Es], Xs, T, L) ->
    prod(Es, Xs, T, prod(Xs, [E | T], L));
prod([], _Xs, _E, L) ->
    L.

constant_function([E | Es], X, L) ->
    constant_function(Es, X, [{E,X} | L]);
constant_function([], _X, L) ->
    reverse(L).

subset([H1 | T1], [H2 | T2]) when H1 > H2 ->
    subset(T1, T2, H1);
subset([H1 | T1], [H2 | T2]) when H1 == H2 ->
    subset(T1, T2);
subset(L1, _) ->
    L1 =:= [].

subset(T1, [H2 | T2], H1) when H1 > H2 ->
    subset(T1, T2, H1);
subset(T1, [H2 | T2], H1) when H1 == H2 ->
    subset(T1, T2);
subset(_, _, _) ->
    false.

disjoint([B | Bs], A, As) when A < B ->
    disjoint(As, B, Bs);
disjoint([B | _Bs], A, _As) when A == B ->
    false;
disjoint([_B | Bs], A, As) ->
    disjoint(Bs, A, As);
disjoint(_Bs, _A, _As) ->
    true.

%% Append sets that come in order, then "merge".
lunion([[_] = S]) -> % optimization
    S;
lunion([[] | Ls]) ->
    lunion(Ls);
lunion([S | Ss]) ->
    umerge(lunion(Ss, last(S), [S], []));
lunion([]) -> 
    [].

lunion([[E] = S | Ss], Last, SL, Ls) when E > Last -> % optimization
    lunion(Ss, E, [S | SL], Ls);
lunion([S | Ss], Last, SL, Ls) when hd(S) > Last ->
    lunion(Ss, last(S), [S | SL], Ls);
lunion([S | Ss], _Last, SL, Ls) ->
    lunion(Ss, last(S), [S], [append(reverse(SL)) | Ls]);
lunion([], _Last, SL, Ls) -> 
    [append(reverse(SL)) | Ls].

%% The empty list is always the first list, if present.
lintersection(_, []) ->
    [];
lintersection([S | Ss], S0) ->
    lintersection(Ss, intersection(S, S0, []));
lintersection([], S) ->
    S.

can_rel([S | Ss], L) ->
    can_rel(Ss, L, S, S);
can_rel([], L) ->
    sort(L).

can_rel(Ss, L, [E | Es], S) ->
    can_rel(Ss, [{E, S} | L], Es, S);
can_rel(Ss, L, _, _S) ->
    can_rel(Ss, L).

rel2family([{X,Y} | S]) ->
    rel2fam(S, X, [Y], []);
rel2family([]) ->
    [].

rel2fam([{X,Y} | S], X0, YL, L) when X0 == X ->
    rel2fam(S, X0, [Y | YL], L);
rel2fam([{X,Y} | S], X0, [A,B | YL], L) -> % optimization
    rel2fam(S, X, [Y], [{X0,reverse(YL,[B,A])} | L]);
rel2fam([{X,Y} | S], X0, YL, L) ->
    rel2fam(S, X, [Y], [{X0,YL} | L]);
rel2fam([], X, YL, L) ->
    reverse([{X,reverse(YL)} | L]).

dom([{X,_} | Es]) ->
    dom([], X, Es);
dom([] = L) ->
    L.

dom(L, X, [{X1,_} | Es]) when X == X1 ->
    dom(L, X, Es);
dom(L, X, [{Y,_} | Es]) ->
    dom([X | L], Y, Es);
dom(L, X, []) ->
    reverse(L, [X]).

ran([{_,Y} | Es], L) ->
    ran(Es, [Y | L]);
ran([], L) ->
    usort(L).

relprod(A, B) ->
    usort(relprod1(A, B)).

relprod1([{Ay,Ax} | A], B) ->
    relprod1(B, Ay, Ax, A, []);
relprod1(_A, _B) ->
    [].

relprod1([{Bx,_By} | B], Ay, Ax, A, L) when Ay > Bx ->
    relprod1(B, Ay, Ax, A, L);
relprod1([{Bx,By} | B], Ay, Ax, A, L) when Ay == Bx ->
    relprod(B, Bx, By, A, [{Ax,By} | L], Ax, B, Ay);
relprod1([{Bx,By} | B], _Ay, _Ax, A, L) ->
    relprod2(B, Bx, By, A, L);
relprod1(_B, _Ay, _Ax, _A, L) ->
    L.

relprod2(B, Bx, By, [{Ay, _Ax} | A], L) when Ay < Bx ->
    relprod2(B, Bx, By, A, L);
relprod2(B, Bx, By, [{Ay, Ax} | A], L) when Ay == Bx ->
    relprod(B, Bx, By, A, [{Ax,By} | L], Ax, B, Ay);
relprod2(B, _Bx, _By, [{Ay, Ax} | A], L) ->
    relprod1(B, Ay, Ax, A, L);
relprod2(_, _, _, _, L) ->
    L.

relprod(B0, Bx0, By0, A0, L, Ax, [{Bx,By} | B], Ay) when Ay == Bx ->
    relprod(B0, Bx0, By0, A0, [{Ax,By} | L], Ax, B, Ay);
relprod(B0, Bx0, By0, A0, L, _Ax, _B, _Ay) ->
    relprod2(B0, Bx0, By0, A0, L).

relprod_n({}, _R, _EmptyG, _IsR) ->
    {error, badarg};
relprod_n(RT, R, EmptyR, IsR) ->
    RL = tuple_to_list(RT),
    case domain_type(RL, ?ANYTYPE) of
        Error = {error, _Reason} -> 
            Error;
        DType ->
            Empty = any(fun is_empty_set/1, RL) or EmptyR,
            RType = range_type(RL, []),
            Type = ?BINREL(DType, RType),
            Prod = 
                case Empty of
                    true when DType =:= ?ANYTYPE; RType =:= ?ANYTYPE ->
                        empty_set();
                    true ->
                        ?SET([], Type);
                    false ->
                        TL = ?LIST((relprod_n(RL))),
                        Sz = size(RT),
                        Fun = fun({X,A}) -> {X, flat(Sz, A, [])} end,
                        ?SET(map(Fun, TL), Type)
                end,
            case IsR of
                true  -> relative_product(Prod, R);
                false -> Prod
            end
    end.

relprod_n([R | Rs]) ->
    relprod_n(Rs, R).

relprod_n([], R) ->
    R;
relprod_n([R | Rs], R0) ->
    T = raise_element(R0, 1),
    R1 = relative_product1(T, R),
    NR = projection({external, fun({{X,A},AS}) -> {X,{A,AS}} end}, R1),
    relprod_n(Rs, NR).

flat(1, A, L) ->
    list_to_tuple([A | L]);
flat(N, {T,A}, L) ->
    flat(N-1, T, [A | L]).

domain_type([T | Ts], T0) when ?IS_SET(T) ->
    case ?TYPE(T) of
        ?BINREL(DT, _RT) -> 
            case unify_types(DT, T0) of
                [] -> {error, type_mismatch};
                T1 -> domain_type(Ts, T1)
            end;
        ?ANYTYPE -> 
            domain_type(Ts, T0);
        _ -> {error, badarg}
    end;
domain_type([], T0) ->
    T0.

range_type([T | Ts], L) ->
    case ?TYPE(T) of
        ?BINREL(_DT, RT) -> 
            range_type(Ts, [RT | L]);
        ?ANYTYPE -> 
            ?ANYTYPE
    end;
range_type([], L) -> 
    list_to_tuple(reverse(L)).

converse([{A,B} | X], L) ->
    converse(X, [{B,A} | L]);
converse([], L) ->
    sort(L).

strict([{E1,E2} | Es], L) when E1 == E2 ->
    strict(Es, L);
strict([E | Es], L) ->
    strict(Es, [E | L]);
strict([], L) ->
    reverse(L).

weak(Es) ->
    %% Not very efficient...
    weak(Es, ran(Es, []), []).

weak(Es=[{X,_} | _], [Y | Ys], L) when X > Y ->
    weak(Es, Ys, [{Y,Y} | L]);
weak(Es=[{X,_} | _], [Y | Ys], L) when X == Y ->
    weak(Es, Ys, L);
weak([E={X,Y} | Es], Ys, L) when X > Y ->
    weak1(Es, Ys, [E | L], X);
weak([E={X,Y} | Es], Ys, L) when X == Y ->
    weak2(Es, Ys, [E | L], X);
weak([E={X,_Y} | Es], Ys, L) -> % when X < _Y
    weak2(Es, Ys, [E, {X,X} | L], X);
weak([], [Y | Ys], L) ->
    weak([], Ys, [{Y,Y} | L]);
weak([], [], L) ->