1:- module(idlists,
    2	[ member_0/2, memberchk/2,
    3	  list_insert/2, add_after/4, add_before/4, delete/3,
    4	  subtract/3, union_idlists/3
    5	]).    6
    7memberchk(X, Ys) :- member_0(X, Ys).
    8
    9member_0(X, [Y|_]) :- X == Y, !.
   10member_0(X, [_|L]) :- member_0(X, L).
   11
   12list_insert(List, Term) :-
   13	var(List), !,
   14	List=[Term|_].
   15list_insert([Term0|_], Term) :-
   16	Term0==Term, !.
   17list_insert([_|List], Term) :-
   18	list_insert(List, Term).
   19
   20add_after([], _, E, [E]).
   21add_after([E|Es], E0, E1, NEs) :-
   22        E == E0, !,
   23        NEs = [E0,E1|Es].
   24add_after([E|Es], E0, E1, [E|NEs]) :-
   25        add_after(Es, E0, E1, NEs).
   26
   27add_before(L, E0, E, NL) :-
   28        add_before_existing(L, E0, E, NL), !.
   29add_before(L, _, E, [E|L]).
   30
   31add_before_existing([E|Es], E0, E1, NEs) :-
   32        E == E0, !,
   33        NEs = [E1,E0|Es].
   34add_before_existing([E|Es], E0, E1, NEEs) :-
   35        add_before_existing(Es, E0, E1, NEs), !,
   36        NEEs = [E|NEs].
   37
   38delete([], _, []).
   39delete([Head|Tail], Element, Rest) :-
   40	Head==Element, !,
   41	delete(Tail, Element, Rest).
   42delete([Head|Tail], Element, [Head|Rest]) :-
   43	delete(Tail, Element, Rest).
   44
   45subtract([], _, []).
   46subtract([Element|Residue], Set, Difference) :-
   47	memberchk(Element, Set), !, 
   48	subtract(Residue, Set, Difference).
   49subtract([Element|Residue], Set, [Element|Difference]) :-
   50	subtract(Residue, Set, Difference).
   51
   52union_idlists([],Ys,Ys).
   53union_idlists([X|Xs],Ys,Zs) :- 
   54	( memberchk(X,Ys) ->
   55	  Zs = Ws
   56        ; Zs = [X|Ws]
   57        ),
   58	union_idlists(Xs,Ys,Ws)