/*
Calendar program:

This algorithm was published in comp.programming and comes from
    Andy Lowry, lowry@watson.ibm.com, (914) 784-7925
    IBM Research, P.O. Box 704, Yorktown Heights, NY 10598

% Original Prolog version by Peter Ludemann,
% optimized for BinProlog by Paul Tarau.

*/


% Last 10000 FoolsDays arithmetic benchmark:


:- main.

q:- 	go(10000), 
	halt_or_else(0,true).




go(N):-
	day_of_week(1993,4,9,Day),
	statistics,
	write('April 9, 1993 is: '),
	write(Day), nl,
	statistics(runtime,_),
	empty_loop(N),
	statistics(runtime,[_,T1]),
	full_loop(N),
	statistics(runtime,[_,T2]),
	T is T2-T1,
	write([fools_days=N,time=T]), nl.




range(Min,Min,Max):-
	Min=<Max.

range(I,Min,Max):-
	Min<Max,
	Min1 is Min+1,
	range(I,Min1,Max).




empty_loop(Y):-
	range(_,1,Y),
	true,
	fail.

empty_loop(_).




full_loop(Max):-
	range(Year,1,Max),
	day_of_week(Year,4,1,_FoolsDay),
	fail.

full_loop(_).




% We associate a number with each day of the week:

dow(0, sun).
dow(1, mon).
dow(2, tue).
dow(3, wed).
dow(4, thu).
dow(5, fri).
dow(6, sat).




% The day of week computation is rather arcane, but it works.
% Note the correction for leap years.

day_of_week(Year,Month,Day, DayOfWeek):-
	cal_key(Month, Key, LeapC),
	compute_it(Year,Day,Key,LeapC,DayOfWeek).




compute_it(Year,Day,Key,LeapC,DayOfWeek):-
	Century is Year // 100,
	YearInCentury is Year - Century * 100,
	DOW0 is (Century * 5 + Century // 4 +
	         YearInCentury + YearInCentury // 4 +
	         Day + Key) 
	         mod 7,
	leap_year(Year,DOW0,LeapC,DayOfWeek).




% A leap year is any year which is divisible by 4; if it is also
% divisible by 100 then it must also be divisible by 400 (thus,
% 1600 and 2000 are leap years; 1700, 1800, and 1900 are not).

leap_year(Year,DOW0,_,DayOfWeek):-
	0 =\= Year mod 4,
	!,
	dow(DOW0,DayOfWeek).

leap_year(Year,DOW0,LeapC,DayOfWeek):-
	0 =\= Year mod 100,
	!,
	DOW is DOW0-LeapC,
	dow(DOW,DayOfWeek).

leap_year(Year,DOW0,_,DayOfWeek):-
	0 =\= Year mod 400,
	!,
	dow(DOW0,DayOfWeek).

leap_year(_,DOW0,LeapC,DayOfWeek):-
	DOW is DOW0-LeapC,
	dow(DOW,DayOfWeek).




/*
There is a special key value for each month and a
correction factor for January and February in leap years.
*/

cal_key( 1, 6, 1).
cal_key( 2, 2, 1).
cal_key( 3, 2, 0).
cal_key( 4, 5, 0).
cal_key( 5, 0, 0).
cal_key( 6, 3, 0).
cal_key( 7, 5, 0).
cal_key( 8, 1, 0).
cal_key( 9, 4, 0).
cal_key(10, 6, 0).
cal_key(11, 2, 0).
cal_key(12, 4, 0).
cal_key(jan, 6, 1).
cal_key(feb, 2, 1).
cal_key(mar, 2, 0).
cal_key(apr, 5, 0).
cal_key(may, 0, 0).
cal_key(jun, 3, 0).
cal_key(jul, 5, 0).
cal_key(aug, 1, 0).
cal_key(sep, 4, 0).
cal_key(oct, 6, 0).
cal_key(nov, 2, 0).
cal_key(dec, 4, 0).
cal_key('January', 6, 1).
cal_key('February', 2, 1).
cal_key('March', 2, 0).
cal_key('April', 5, 0).
cal_key('May', 0, 0).
cal_key('June', 3, 0).
cal_key('July', 5, 0).
cal_key('August', 1, 0).
cal_key('September',4, 0).
cal_key('October', 6, 0).
cal_key('November',2, 0).
cal_key('December', 4, 0).


:- q.


/* -----------------------------------------------------------------

Comparison with some standard and improved WAM implementations:

	      On Sparc ELC (23.7 Mips)      Sparc 2 (28.5 Mips)

Sicstus 0.6 (consult) -------->                   8650

SbProlog 3.1 -----------------> 1820    /1.2      1516

C-emulated Sicstus 2.1 -------> 1440              1200

Sicstus 0.6 (compile) -------->                   730

BinProlog 1.71 --------------->  800              666

Quintus 3.1.1  --------------->  584              486

wamcc ------------------------>                   300

Native Sicstus 2.1 ----------->  350              291

------------------------------------------------------------------- */