1:- module(julian_calendar_gregorian,
    2          [ gregorian/3
    3          , month_number/2
    4          ]
    5         ).    6:- use_module(library(clpfd)).    7:- use_module(library(delay), [delay/1]).    8
    9%%	gregorian(?Year, ?Month, ?Day) is semidet.
   10%
   11%	Constrain Year, Month and Day to a valid date in the Gregorian
   12%	calendar.  For example, one could iterate all leap years
   13%	since 1950 with this:
   14%
   15%	==
   16%	gregorian(Y, 2, 29), Y #> 1950, indomain(Y).
   17%	==
   18%
   19%	Because it just constrains Year, Month and Day to have the
   20%	proper relation one to another, one can bind as many or
   21%	as few of the arguments as desired.
   22gregorian(Y,M,D) :-
   23    Y in -4713..3267,
   24    M in 1..12,
   25    (   (D in 1..28)
   26    #\/ (M #\= 2 #/\ D in 29..30)
   27    #\/ (M in 1 \/ 3 \/ 5 \/ 7 \/ 8 \/ 10 \/ 12 #/\ D #= 31)
   28    #\/ (M #= 2 #/\ D #= 29 #/\ Y mod 400 #= 0)
   29    #\/ (M #= 2 #/\ D #= 29 #/\ Y mod 4 #= 0 #/\ Y mod 100 #\= 0)
   30    ).
   31
   32
   33%%	month_number(+Month:atom, -Number:integer) is semidet.
   34%%	month_number(-Month:atom, +Number:integer) is semidet.
   35%%	month_number(-Month:atom, -Number:integer) is multi.
   36%
   37%   True if Number is the number for Month. 1 is January, 12 is
   38%   December. Month is an atom like `march`, `august`, etc.
   39%
   40%   This predicate supports `library(delay)`.
   41:- multifile delay:mode/1.
   42delay:mode(julian_calendar_gregorian:month_number(ground,_)).
   43delay:mode(julian_calendar_gregorian:month_number(_,ground)).
   44month_number(january,   1).
   45month_number(february,  2).
   46month_number(march,     3).
   47month_number(april,     4).
   48month_number(may,       5).
   49month_number(june,      6).
   50month_number(july,      7).
   51month_number(august,    8).
   52month_number(september, 9).
   53month_number(october,  10).
   54month_number(november, 11).
   55month_number(december, 12)