/* vim: set filetype=prolog : */
% -*- pl -*-

:- [thrash,xml].

:- op(700,xfx,in).
:- op(2,xfx, of).
:- op(1,xfx, (..)).
%tv is equipment + [power : posint, display : any,power : any,input,format].

xpand(X in X1, [(:- discontiguous X/1),
                Head :- any(Body)]) :-
	Head =.. [X,Y,A,B],
	Body =.. [X1,Y,A,B].
xpand(X = Y + Z, [known(X),(Head  :- First,Body)|Fx]) :-
	Head  =.. [X ,-[klass=X ,super=Super |List ] ,A ,C],
	First =.. [Y,Super,A,B],
	body(Z,List,Body,[],Fx,B,C).

body(X0,L,Y,Fx0,Fx) --> {once(body1(X0,X))},body2(X,L,Y,Fx0,Fx).

body1([X],     one(X)).
body1([X,Y|T], list([X,Y|T])).
body1(X :  Min .. Max of Y,  exists(X,Y,Min,Max)).
body1(X :  Min .. Max,       exists(X,X,Min,Max)).
body1(X : Y,                 one(X,Y)).
body1(X ,                    one(X,X)).

body2(one(H0),    [H1],    H2,Fx0,Fx) -->  body(H0,H1,H2,Fx0,Fx).
body2(list([H0|T0]),[H1|T1],(H2,T2),Fx0,Fx) -->
	body(H0,H1,H2,Fx0,Fx1), 
	body(T0,T1,T2,Fx1,Fx).

body2(one(X,Y), X=Z,Goal,Fx,Fx,In,Out) :-
	Goal =.. [Y,Z,In,Out].
body2(exists(X,Y,Min,Max), X=Z,exists(Y,Min,Max,Z,In,Out),Fx,Fx,In,Out).

exists(P,Min,Max,Z,In,Out) :-
	within(Min,Max,Card),
		length(Z,Card),
		map(Z,P,In,Out).

within(Min,Max,N) :- once(within0(Min,Max,N,X)), within1(X,N).

within0(N1,N2,N3,check(N1,N2,N3)) :- ground((N1,N2,N3)).
within0(N1,N2,_, select(N1,N2))   :- ground((N1,N2)).
within0(N1,N2,N2,oops/(N1,N2,N3)).

within1(check(N1,N2,N3), N3) :- N1 =< N3, N3 =< N2.
within1(select(N1,N2),   N3) :- repeat, N3 is random(N2 - N1 + 1).
within1(oops/X,           0) :- print(X),nl.

=(X,Y,L0,[X=Y|L1])  :- without(L0,X=Y,L1).

>=(X,Y) --> X=Z, { nonvar(Z),Z >= Y }.
 >(X,Y) --> X=Z, { nonvar(Z),Z >  Y }.
\=(X,Y) --> X=Z, { nonvar(Z),Z \= Y }.
 <(X,Y) --> X=Z, { nonvar(Z),Z <  Y }.
<=(X,Y) --> X=Z, { nonvar(Z),Z <= Y }.

without([],_,[]).
without([H|T],H,T).
without([H0|T0],H,[H0|T]) :- H0 \= H, without(T0,H,T).

assume([X=Old|Rest],Y=New,[X=Old|Rest]) :- X=Y,!,Old=New. 
assume([],Y=New,[X=New]) :- X \= Y,
assume([X=Old|T0],Y=New,[X=Old|T]) :- X \= Y,
		assume(T0,X=New,T).

term_expansion(X,Y) :- xpand(X,Y).

eg1(emp is person + [name:string]).

%tv(tv is Parent + [display=D,power=P,input=I,format=T]) :-
 %     equipment(Parent),
  %    display(D).
   %   input(I)

posint(X) --> {within(1,2^16-1,X)}.

thing([id=Id]) --> {var(Id), flag(thing,Id,Id+1)}.
thing([id=Id]) --> {nonvar(Id)}.

tv = thing + [display,power,input: 1 .. 4 of posint ,formaT].

display in display1.
display1(lcd) --> []. % pow(low).
display1(crt) --> []. % :- pow(hi).

input in input1.
input1(pwr) --> [].
input1(fr)  --> [].
input1(analog) --> [].
input1(digital) --> [].

power in power1.
power1(volts(220)) --> [].
power1(volts(110)) --> [].

formaT in formaT1.
formaT1(ntsc) --> [].
formaT1(pal)  --> [].

swap(X0,X) --> {once(swap0(X0,X1))}, swap1(X1,X).

swap0(X,     noop(X)) :- var(X).
swap0([],    noop([])).
swap0([H|T], [H|T]).
swap0(X,     compound(X)) :- compound(X).
swap0(X,     atom(X)).

swap1(noop(X),     X,W,W).
swap1([H0|T0],     [H|T]) --> swap(H0,H), swap(T0,T).
swap1(compound(X0),X)     --> {X0 =.. L0}, swap(L0,L), {X =.. L}.
swap1(atom(X0),    X,W0,W) :- member(X0/X1,W0) -> swap(X1,X,W0,W) ; X0=X, W0=W.