improvise/scripts/kb-merge.pl

% Reads the knowledge base and a delta as DATA -- never consults either -- and
% writes their merge in canonical form. See context/code/kb-tool.md for why.

% No initialization/1: scripts/kb supplies a goal that turns a throw into
% exit 2 and a failure into exit 1. Measured on trealla 3.10.3, `-g main,halt`
% exits 0 for BOTH -- silently reporting a crash as a clean run.
main :-
    current_prolog_flag(argv, Argv),
    (  Argv = [ModeStr, KbFile, DeltaFile, OutFile], mode_atom(ModeStr, Mode)
    -> run(Mode, KbFile, DeltaFile, OutFile)
    ;  Argv = [CountStr, KbFile], CountStr == "count"
    -> count_only(KbFile)
    ;  die('usage: kb-merge.pl <add|replace> <kb> <delta> <out>  |  count <kb>')
    ).

% argv arrives as strings; every later comparison is on an atom.
mode_atom(S, add) :- S == "add", !.
mode_atom(S, replace) :- S == "replace", !.

run(Mode, KbFile, DeltaFile, OutFile) :-
    terms_of(KbFile, Old),
    terms_of(DeltaFile, New),
    check_callable(New),
    conflicts(Old, New, Clashes),
    gate(Mode, Clashes),
    foldl_merge(New, Mode, Old, Merged),
    write_terms(OutFile, Merged),
    verify(OutFile, Merged),
    length(Old, NO), length(New, NN), length(Merged, NM),
    format("kb-merge: ~w before, ~w in delta, ~w after~n", [NO, NN, NM]).

% A term can parse and still not be a clause: `42.` reads fine, is not
% callable, and reached the knowledge base as a fact whose head is a number.
% Nothing downstream objected -- kb_consistent has no opinion about stray terms.
check_callable([]).
check_callable([T|Ts]) :-
    clause_head(T, H),
    (  callable(H)
    -> check_callable(Ts)
    ;  format("kb-merge: REFUSED -- not a clause: ~q~n", [T]),
       halt(2)
    ).

clause_head((H :- _), H) :- !.
clause_head(H, H).

% A clause key is the functor plus every argument but the last, so
% doctrine(Name,_) keys on Name and decision(Id,Key,_) on the pair. Looser than
% functional/1 for crate/3; kb_consistent is the backstop for that.
clause_key((H :- _), K) :- !, head_key(H, K).
clause_key(H, K) :- head_key(H, K).

head_key(H, K) :-
    H =.. [F|Args],
    (  append(Front, [_], Args)
    -> K =.. [F|Front]
    ;  K = F
    ).

clause_pred((H :- _), F/A) :- !, functor(H, F, A).
clause_pred(H, F/A) :- functor(H, F, A).

conflicts(Old, New, Clashes) :-
    findall(K,
            ( member(T, New), clause_key(T, K),
              member(O, Old), clause_key(O, K) ),
            Clashes).

gate(add, []) :- !.
gate(add, Clashes) :-
    !,
    format("kb-merge: REFUSED -- ~w clause(s) already present:~n", [Clashes]),
    forall(member(K, Clashes), format("  ~q~n", [K])),
    die('use replace to overwrite an existing clause').
gate(replace, _).
gate(M, _) :- die(M).

foldl_merge([], _, Acc, Acc).
foldl_merge([T|Ts], Mode, Acc0, Acc) :-
    clause_key(T, K),
    exclude(has_key(K), Acc0, Acc1),
    clause_pred(T, P),
    insert_after_last(Acc1, P, T, Acc2),
    foldl_merge(Ts, Mode, Acc2, Acc).

has_key(K, T) :- clause_key(T, K).

% Keeps each predicate a contiguous block: a new clause lands after the last
% one of its own predicate, or at the end when the predicate is new.
insert_after_last([], _, T, [T]).
insert_after_last([H|Rest], P, T, Out) :-
    (  clause_pred(H, P), \+ ( member(X, Rest), clause_pred(X, P) )
    -> Out = [H, T|Rest]
    ;  Out = [H|Tail], insert_after_last(Rest, P, T, Tail)
    ).

terms_of(File, Terms) :-
    catch(open(File, read, S), _, die_file(File)),
    read_all(S, Terms),
    close(S).

% An uncaught syntax error drops trealla into its REPL, which waits on stdin --
% so a malformed delta HANGS with a terminal and exits 0 without one, reading
% as acceptance. Catching it is what makes the refusal a refusal.
read_all(S, Terms) :-
    catch(read_term(S, T, []), E, parse_died(E)),
    (  T == end_of_file
    -> Terms = []
    ;  Terms = [T|Rest], read_all(S, Rest)
    ).

parse_died(E) :-
    format("kb-merge: REFUSED -- does not parse: ~w~n", [E]),
    halt(2).

write_terms(File, Terms) :-
    open(File, write, S),
    forall(member(T, Terms), portray_clause(S, T)),
    close(S).

% The guard that matters: read the file back and require it to be exactly what
% was intended. A serializer bug is the wipe-the-KB failure with a new owner.
verify(File, Intended) :-
    terms_of(File, Written),
    canon(Written, CW),
    canon(Intended, CI),
    (  CW == CI
    -> true
    ;  length(Written, NW), length(Intended, NI),
       format("kb-merge: ROUND-TRIP FAILED -- wrote ~w terms, meant ~w~n", [NW, NI]),
       die('output does not read back as the intended clauses')
    ).

% Reading a term back yields FRESH variables, so == compares variable identity
% rather than clause content. numbervars over a copy gives variant equality.
canon(Terms, Canon) :- copy_term(Terms, Canon), numbervars(Canon, 0, _).

count_only(KbFile) :-
    terms_of(KbFile, Terms),
    forall(member(P, [doctrine/2, invariant/2, decision/3, work_done/3]),
           ( findall(x, ( member(T, Terms), clause_pred(T, P) ), L),
             length(L, N),
             P = F/A,
             format("~w/~w=~w~n", [F, A, N]) )),
    length(Terms, Total),
    format("total=~w~n", [Total]).

die(Msg) :- format("kb-merge: ~w~n", [Msg]), halt(2).
die_file(F) :- format("kb-merge: cannot read ~w~n", [F]), halt(2).