1:- module(term_diff, [term_diff/3]).    2:- use_module(library(lcs), [lcs/3, lcs/5]).    3:- use_module(library(when), [when/2]).    4
    5term_diff(A, name(NameA,NameB), B) :-
    6    lazy_callable(A),
    7    lazy_callable(B),
    8    dif(NameA, NameB),
    9    lazy_univ(A, NameA, Arguments),
   10    lazy_univ(B, NameB, Arguments),
   11    !.
   12term_diff(A, drop_arg(N,Arg), B) :-
   13    term_nth1(A, N, Arg, B),
   14    !.
   15term_diff(A, add_arg(N,Arg), B) :-
   16    term_nth1(B, N, Arg, A),
   17    !.
   18term_diff(A, [], A) :-
   19    !.
   20term_diff(A, Diffs, B) :-
   21    % defer patch application until we have a target
   22    nonvar(Diffs),
   23    var(A),
   24    var(B),
   25    !,
   26    when((nonvar(A);nonvar(B)), term_diff(A,Diffs,B)).
   27term_diff(A, Diffs, B) :-
   28    % apply a list of diffs
   29    nonvar(Diffs),
   30    Diffs = [Diff|Rest],
   31    !,
   32    term_diff(A, Diff, Z),
   33    term_diff(Z, Rest, B).
   34term_diff(A, Diffs, B) :-
   35    % calculate a list of diffs
   36    var(Diffs),
   37    callable(A),
   38    callable(B),
   39    A =.. ListA,
   40    B =.. ListB,
   41    lcs(ListA, ListB, LCS),
   42    LCS \= [],
   43    !,
   44    lcs_diff(LCS, 0, ListA, ListB, Diffs).
   45term_diff(A, alter(A,B), B) :-
   46    dif(A,B).
   47
   48% construct a diff for two lists given one of their longest common
   49% subsequences
   50lcs_diff([], _, [], [], []) :-
   51    % left and right sides empty
   52    !.
   53lcs_diff([], N0, [], [H|T], [add_arg(N0,H)|Diffs]) :-
   54    % nothing in common; left side empty
   55    succ(N0, N),
   56    lcs_diff([], N, [], T, Diffs),
   57    !.
   58lcs_diff([], N, [H|T], Right, [drop_arg(N,H)|Diffs]) :-
   59    % nothing in common; left not empty
   60    lcs_diff([], N, T, Right, Diffs).
   61lcs_diff([X|LCS], N0, [X|Left], [X|Right], Diffs) :-
   62    % left and right start with common element
   63    !,
   64    succ(N0, N),
   65    lcs_diff(LCS, N, Left, Right, Diffs).
   66lcs_diff([X|LCS], N, [L|Left], Right, [drop_arg(N,L)|Diffs]) :-
   67    % common element is not on the left
   68    dif(X, L),
   69    !,
   70    lcs_diff([X|LCS], N, Left, Right, Diffs).
   71lcs_diff([X|LCS], N0, [X|Left], [R|Right], [add_arg(N0,R)|Diffs]) :-
   72    % common element is on the left, but not the right
   73    dif(X, R),
   74    succ(N0, N),
   75    lcs_diff([X|LCS], N, [X|Left], Right, Diffs).
   76
   77
   78% generalization for drop_arg/2 and add_arg/2 patches
   79term_nth1(A, N, Arg, B) :-
   80    lazy_callable(A),
   81    lazy_callable(B),
   82    lazy_univ(A, Name, ArgsA),
   83    lazy_univ(B, Name, ArgsB),
   84    nth1(N, ArgsA, Arg, ArgsB).
   85
   86
   87lazy_callable(X) :-
   88    when(nonvar(X), callable(X)).
   89
   90
   91% lazy_univ(Term, Name, Arguments)
   92%
   93% True if Term is a callable term with the given Name and Arguments.
   94% It's just like =../2 but defers computation until Term or Name and
   95% Arguments is nonvar.
   96lazy_univ(Term, Name, Args) :-
   97    var(Term),
   98    !,
   99    when(
  100        ( nonvar(Name), nonvar(Args) ),
  101        when_proper_list(Args, Term=..[Name|Args])
  102    ).
  103lazy_univ(Term, Name, Args) :-
  104    % nonvar(Term)
  105    Term =.. [Name|Args].
  106
  107
  108when_proper_list(List, Goal) :-
  109    var(List),
  110    !,
  111    when(nonvar(List), when_proper_list(List, Goal)).
  112when_proper_list([], Goal) :-
  113    call(Goal).
  114when_proper_list([_|T], Goal) :-
  115    when_proper_list(T, Goal)