1/*****************************************************************************
    2 * This file is part of the Prolog Development Tool (PDT)
    3 * 
    4 * WWW: http://sewiki.iai.uni-bonn.de/research/pdt/start
    5 * Mail: pdt@lists.iai.uni-bonn.de
    6 * Copyright (C): 2004-2012, CS Dept. III, University of Bonn
    7 * 
    8 * All rights reserved. This program is  made available under the terms
    9 * of the Eclipse Public License v1.0 which accompanies this distribution,
   10 * and is available at http://www.eclipse.org/legal/epl-v10.html
   11 * 
   12 ****************************************************************************/
   13
   14:- module(ctc_time, [
   15	time/2,
   16	performance/4,
   17	performance/3,
   18	performanceUnique/4,
   19	ctc_time/3,
   20	ctc_time/2
   21]).   22
   23:- use_module(logging).   24:- use_module(count).   25
   26:- module_transparent time/2.    
   27  
   28time(Goal0,time(UsedInf, UsedTime, Wall, Lips)) :-
   29	expand_goal(Goal0, Goal),
   30	get_time(OldWall),
   31	statistics(cputime, OldTime), 
   32	statistics(inferences, OldInferences), 
   33	(   catch(Goal, E, true)
   34	->  Result = yes
   35	;   Result = no
   36	),
   37	statistics(inferences, NewInferences), 
   38	statistics(cputime, NewTime), 
   39	get_time(NewWall),
   40	UsedTime is NewTime - OldTime, 
   41	UsedInf  is NewInferences - OldInferences - 3, 
   42	Wall     is NewWall - OldWall,
   43	(   UsedTime =:= 0
   44	->  Lips = 'Infinite'
   45	;   Lips is integer(UsedInf / UsedTime)
   46	),
   47	%TR: removed: 
   48	%print_message(informational, time(UsedInf, UsedTime, Wall, Lips)), 
   49	(   nonvar(E)
   50	->  throw(E)
   51	;   Result == yes
   52	).
   53	
   54
   55/*
   56 * Helper predicates for reporting time spent.
   57 *   - performance(Goal, Time, Count)
   58 *   - ctc_time(Goal, Time)
   59 *   - startStopwatch
   60 *   - reportRuntime(ForWhat)
   61 *   - reportRuntime(ForWhat,CPUMilisSinceLast)
   62 */
   63   
   64
   65performance(Goal, Time, CountAll, Inferences) :-
   66	ctc_time(count(Goal, CountAll), Time, Inferences).
   67	
   68/*
   69 * Measure milliseconds to find and count all results of a Goal.
   70 */ 
   71performance(Goal, Time, CountAll) :- 
   72  ctc_time(count(Goal, CountAll), Time).
   73
   74/*
   75 * Measure time to find and count all results of a Goal and
   76 * and also all unique results. 
   77 */   
   78performanceUnique(Goal, Time, CountAll,CountUnique) :- 
   79  ctc_time(count_all_and_unique(Goal,CountAll,CountUnique), Time).
   80
   81:- if(pdt_support:pdt_support(count_inferences)).   82
   83ctc_time(Call, Time, Inferences) :- 
   84   startStopwatchWithInfer(InferencesOld), 
   85     call(Call),
   86   measureRuntimeWithInfer(InferencesOld, Time, Inferences).
   87
   88startStopwatchWithInfer(InferencesOld) :-
   89    statistics(runtime, _CPU),    % Start new CPU timer
   90	statistics(inferences, InferencesOld).
   91
   92measureRuntimeWithInfer(InferencesOld, CPUMilisSinceLast, Inferences) :-
   93	statistics(inferences, InferencesNew),
   94	Inferences is InferencesNew - InferencesOld - 3,
   95	statistics(runtime, [_CPUMilisSinceStart, CPUMilisSinceLast]). 
   96
   97:- else.   98
   99ctc_time(Call, Time, unknown) :-
  100	ctc_time(Call, Time).
  101   
  102:- endif.  103    
  104ctc_time(Call, Time) :- 
  105   startStopwatch, 
  106     call(Call),
  107   measureRuntime(Time).
  108
  109startStopwatch :-
  110    statistics(runtime, _CPU).    % Start new CPU timer
  111%    statistics(real_time, _Real). % Start new real timer
  112 
  113 
  114measureRuntime(CPUMilisSinceLast) :- 
  115    statistics(runtime,    [_CPUMilisSinceStart, CPUMilisSinceLast]). 
  116
  117    
  118reportRuntime(ForWhat) :- 
  119    statistics(runtime,    [_CPUMilisSinceStart, CPUMilisSinceLast]),   
  120%    statistics(real_time,  [_RealSecsSinceStart, RealSecsSinceLast]), 
  121%    log_on_stdout('~a: CPU = ~a milliseconds, real time ca. ~a seconds~n',
  122	 log_on_stdout('~a: CPU = ~a milliseconds~n', 
  123           [ForWhat,CPUMilisSinceLast]).
  124           
  125    
  126reportRuntime(ForWhat,CPUMilisSinceLast) :- 
  127    statistics(runtime,    [_CPUMilisSinceStart, CPUMilisSinceLast]),   
  128    statistics(real_time,  [_RealSecsSinceStart, RealSecsSinceLast]), 
  129    log_on_stdout('~a: CPU = ~a milliseconds, real time ca. ~a seconds~n', 
  130           [ForWhat,CPUMilisSinceLast,RealSecsSinceLast])