/*
   gensym(X, Y) - X is a symbol, and Y is a brand new symbol obtained
   from X by appending an integer.  "New" means not returned from a
   previous call to this routine.
*/

gensym(X, Y) :-
   getnum(X, Z),
   name(X, W),
   integername(Z, [], V),
   append(W, V, Y1),
   name(Y, Y1),
   !.

getnum(X, Y) :-
   retract(currentnum(X, Y1)),
   !,
   Y is Y1 + 1,
   asserta(currentnum(X, Y)).
getnum(X, 1) :-
   !,
   asserta(currentnum(X, 1)).

integername(I, Sofar, [C|Sofar]) :-
    I < 10 ,
    !,
    C is I + 48.
integername(I, Sofar, List) :-
    !,
    Top is I // 10,
    Bottom is I mod 10,
    C is Bottom + 48,
    integername(Top, [C|Sofar], List).

/*
    subst(T1, Fin, T2, Fout) - Replace T1 with T2 in Fin, resulting
    in Fout.
*/

subst(T1, Fin, T2, T2) :-
    T1 == Fin,
    !.
subst(_, Fin, _, Fin) :-
    atomic(Fin),
    !.
subst(_, Fin, _, Fin) :-
    var(Fin),
    !.
subst(T1, Fin, T2, Fout) :-
    Fin =.. Lin,
    substrec(T1, Lin, T2, Lout),
    Fout =.. Lout,
    !.

substrec(T1, [Hin|Tin], T2, [Hout|Tout]) :-
    subst(T1, Hin, T2, Hout),
    substrec(T1, Tin, T2, Tout).
substrec(_, [], _, []).

/*
   simsub(L1, Fin, L2, Fout) - simlutaneous substitution of members
   of L1 in F1 with corresponding members of L2.  Example:
   simsub([1, 2, 3], f(1, 2), [a, b, c], f(a, b)).
   Members of L1 must be atomic.
*/

simsub(L1, F, L2, X) :-
    atomic(F),
    !,
    map(L1, F, L2, X),
    !.
simsub(L1, F, L2, X) :-
    F =.. F2,
    simsubrec(L1, F2, L2, X2),
    X =.. X2,
    !.

simsubrec(L1, [X1|X2], L2, [Y1|Y2]) :-
    simsub(L1, X1, L2, Y1),
    simsubrec(L1, X2, L2, Y2),
    !.
simsubrec(_, [], _, []).


/*
   simsub2(L1, Fin, L2, Fout) - simlutaneous substitution of members
   of L1 in F1 with corresponding members of L2.  Example:
   simsub([1, 2, 3], f(1, 2), [a, b, c], f(a, b)).
   Members of L1   NEED NOT BE   be atomic.
*/

simsub2(L1, F, L2, X) :-
    map(L1, F, L2, X),
    X \== F,
    !.
simsub2(_, F, _, F) :-
    atomic(F),
    !.
simsub2(L1, F, L2, X) :-
    F =.. F2,
    simsubrec2(L1, F2, L2, X2),
    X =.. X2,
    !.

simsubrec2(L1, [X1|X2], L2, [Y1|Y2]) :-
    simsub2(L1, X1, L2, Y1),
    simsubrec2(L1, X2, L2, Y2),
    !.
simsubrec2(_, [], _, []).

/*
    map(L1, X, L2, Y) - If X is in L1, then Y is corresponding member
    of L2.  Otherwise, Y = X.
*/

map([X|_], X, [Y|_], Y) :-
    !.
map([_|X], Zin, [_|Y], Zout) :-
    map(X, Zin, Y, Zout),
    !.
map([], Z, [], Z) :-
    !.
map(_, Y, _, Y) :-
    write('map: lists different sizes.'), nl.

/*
    member - deterministic
*/

member(X, [X|_]) :-
    !.
member(X, [_|Z]) :-
    member(X, Z).

/*
    append - the standard append procedure
*/

append([], X, X).
append([X|Y], Z, [X|W]) :-
    append(Y, Z, W).

/*
    tpvar(F) - Succeeds iff F is an atom starting with a letter
    in varstart(VS).
*/

tpvar(F) :-
    atomic(F),
    name(F, [H|_]),
    name(V, [H]),
    varstart(VS),
    member(V, VS),
    !.

increment(_) :- !.
increment(X) :-
    retract(count(X, N)),
    M is N + 1,
    asserta(count(X, M)),
    !.
increment(X) :-
    asserta(count(X, 1)),
    !.

tpskolem(X) :-
    X =.. [Y|_],
    name(Y, [H|[N|_]]),
    number(N),
    name(Y1, [H]),
    skolemstart(SL),
    member(Y1, SL),
    !.

ground(X) :-
    atomic(X),
    !,
    \+ tpvar(X),
    !.
ground(X) :-
     X =.. L,
     groundrec(L),
     !.

groundrec([H|T]) :-
    ground(H),
    groundrec(T).
groundrec([]).

isort([H|T], Lout) :-
    isort(T, T1),
    insert(H, T1, Lout),
    !.
isort([], []).

insert(X, [Y1|Y2], [Y1|Y2]) :-
    X == Y1,
    !.
insert(X, [Y1|Y2], [Y1|Y3]) :-
    X @> Y1,
    !,
    insert(X, Y2, Y3).
insert(X, [Y1|Y2], [X|[Y1|Y2]]) :-
    X @< Y1,
    !.
insert(X, [], [X]).

sublist([H|T], X) :-
    member(H, X),
    sublist(T, X).
sublist([], _).

permute(X, [Y|Z]) :-
    append(V, [Y|W], X),
    append(V, W, U),
    permute(U, Z).
permute([], []).

occur(T, T) :-
    !.
occur(T, F) :-
    \+ atomic(F),
    F =.. L,
    occurrec(T, L),
    !.

occurrec(T, [T|_]) :-
    !.
occurrec(T, [X|_]) :-
    occur(T, X),
    !.
occurrec(T, [_|Y]) :-
    occurrec(T, Y),
    !.

bell :-
    name(X, [7]),
    write(X).

seteq([], []).
seteq([X|Y], Z) :-
    !,
    delete(X, Z, W),
    seteq(Y, W).

delete(X, [X|Y], Y) :-
    !.
delete(X, [Y|Z], [Y|W]) :-
    !,
    delete(X, Z, W).

/*
    intersect(L1, L2, L3) - L3 is the intersection of lists L1 and L2.
    The lists need not be ordered.
*/

intersect([H|T1], L, [H|T2]) :-
    member(H, L),
    !,
    intersect(T1, L, T2).
intersect([_|T1], L, T2) :-
    !,
    intersect(T1, L, T2).
intersect([], _, []).

%%%%%%%%%%%%%%%
%
%  set and clear flags, options, etc.
%
%%%%%%%%%%%%%%%

set(X) :-
    flags(FL),
    \+ member(X, FL),
    !,
    write('No such flag.'), bell, nl,
    fail.
set(X) :-
    flag(X),
    write('already set'), bell, nl,
    !,
    fail.
set(X) :-
    asserta(flag(X)),
    !.

unset(X) :-
    flags(FL),
    \+ member(X, FL),
    !,
    write('No such flag.'), bell, nl,
    fail.
unset(X) :-
    retract(flag(X)),
    !.
unset(X) :-
    write(X), write(' was not set.'), bell, nl,
    !,
    fail.

reset(Sym, Num) :-
   retract(currentnum(Sym, _)),
   !,
   assert(currentnum(Sym, Num)).
reset(Sym, Num) :-
   assert(currentnum(Sym, Num)).

set_commute(X) :-
    commutative(X),
    write('It''s already commutative.'), bell, nl,
    !,
    fail.
set_commute(X) :-
    asserta(commutative(X)),
    !.

unset_commute(S) :-
    retract(commutative(S)),
    !.
unset_commute(S) :-
    write(S), write(' was not commutative.'), bell, nl,
    !,
    fail.

%%%%%%%%%%%%%
%
%  reverse a list
%
%%%%%%%%%%%%%

reverse([H|T], Rin, Rout) :-
    !,
    reverse(T, [H|Rin], Rout).
reverse([], L, L).

%%%%%%%%%%%%%%%
%
%   clean_currentnum(Symbol)
%
%%%%%%%%%%%%%%%

clean_currentnum(S) :-
    retract(currentnum(S,_)),
    !.
clean_currentnum(_).
