Prolog Text relative

/**
 * Prolog code for the relative port statistics.
 *
 * The following data will be gathered:
 *    count(Fun, Arity, CallExitRedoFail).
 *
 * Copyright 2012, XLOG Technologies GmbH, Switzerland
 * Jekejeke Prolog 0.9.3 (a fast and small prolog interpreter)
 */

:- current_prolog_flag(source_file,X), set_source_property(X,sys_notrace).

:- foreign(format_float/3, 'jekdev.study.ports.RelativeAPI', formatFloat('String','Double')).
:- foreign(nano_time/1, 'jekdev.study.ports.RelativeAPI', nanoTime).

% remove_count
remove_count :-
   retract(count(_,_,_)),
   fail.
remove_count.

% add_count(+CallExitRedoFail,+CallExitRedoFail,-CallExitRedoFail)
add_count(A-B-C-D,E-F-G-H,R-S-T-U) :-
    R is A+E,
    S is B+F,
    T is C+G,
    U is D+H.

% update_count(+Fun,+Arity,+CallExitRedoFail)
update_count(F,A,D) :-
    retract(count(F,A,R)), !,
    add_count(R,D,S),
    assertz(count(F,A,S)).
update_count(F,A,D) :-
    assertz(count(F,A,D)).

% get_delta(+Port,-CallExitRedoFail)
get_delta(call,1-0-0-0).
get_delta(exit,0-1-0-0).
get_delta(redo,0-0-1-0).
get_delta(fail,0-0-0-1).

% goal_tracing(+Port,+Frame)
goal_tracing(P,Q) :-
    frame_property(Q,sys_call_indicator(F,A)),
    get_delta(P,D),
    update_count(F,A,D).

% sum_counts(+List,-CallExitRedoFail)
sum_counts([],0-0-0-0).
sum_counts([_-D|L],S) :-
    sum_counts(L,R),
    add_count(R,D,S).

% mem_counts(+Elem,+List)
mem_counts(X,[X|_]).
mem_counts(X,[_|Y]) :-
    mem_counts(X,Y).

% show
show :-
    findall(F/A-D,count(F,A,D),L),
    sum_counts(L,TR-TS-TT-TU),
    write('Pred\tCall\tExit\tRedo\tFail'), nl,
    keysort(L,M),
    mem_counts(I-(R-S-T-U),M),
    RP is R*100 / TR,
    SP is S*100 / TS,
    TP is T*100 / TT,
    UP is U*100 / TU,
    ((RP >= 0.05; SP >=0.05; TP >=0.05; UP >=0.05) ->
        write(I), write('\t'),
        format_float('0.0',RP,SR), write(SR), write(' %\t'),
        format_float('0.0',SP,SS), write(SS), write(' %\t'),
        format_float('0.0',TP,ST), write(ST), write(' %\t'),
        format_float('0.0',UP,SU), write(SU), write(' %'), nl; true),
    fail.
show.

% reset
reset :-
    remove_count.

% show(+Time)
show(T) :-
  format_float('0.0',T,U),
  write('\tin '),
  write(U),
  write(' ms'), nl.

% time(+Goal)
% Cannot be used to show time for redo/exit.
time(X) :- nano_time(T1), X, nano_time(T2), T is (T2-T1) / 1000000, write(X), show(T).

Comments