;; ============================================================================
;; Calendrical calculations for Islamic, Christian and Jewish Holidays.
;; ============================================================================
;; Created:  1990.10.09: by Abdelsalam Heddaya <heddaya@cs.bu.edu>; 
;;                       copied from message received from Reingold.
;; Modified: 1990.10.09: added functions for specific Islamic holidays,
;;			 reordered functions to make sense, and added
;;			 sectioning comments.
;; Modified: 1990.10.10: added more comments, including execution instructions.
;; Modified: 1990.10.12: added comment listing Hijri months.
;; Modified: 1990.10.17: added Hijri to Gregorian conversion functions.
;; Modified: 1991.02.06: improved transliteration to agree with
;;                       current version of Qalam.
;; 
;; -----------------------
;; The following Common Lisp code is a superset of that in

;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M.
;; Reingold, Software---Practice & Experience, vol. 20, no. 9
;; (September, 1990), pp. 899--928.

;; The original program has been obtained by sending a message to
;; Ed Reingold <reingold@cs.uiuc.edu> with the subject "send-calendar"
;; or something like that.

;; To run it, you must have a Common Lisp interpreter.  Here's an
;; example session conducted on a machine in the Boston University CS
;; Dept.

;; -----------------------------
;; cs: ~ <101> lisp
;; AKCL (Austin Kyoto Common Lisp)  Version(1.492) Thu Aug 23 12:44:29 EDT 1990
;; Contains Enhancements by W. Schelter
;; Changes in version 1-455 definitely require recompilation of user files.
;; 
;; >(load "src/calendrical.l")
;; Loading src/calendrical.l
;; Finished loading src/calendrical.l
;; T
;; 
;; >(islamic-holidays 1991)
;; ((HIJRI_NEW_YEAR (7 13 1991)) (MAWLIDU_ELNABY (9 21 1991))
;;  (RAMADAAN (3 17 1991)) (IYDU_ELFIT-R (4 16 1991))
;;  (IYDU_ELAD-HAE (6 23 1991)))
;; 
;; >(hijri-from-gregorian '(2 6 1991))
;; (7 21 1411)
;; 
;; >(bye)
;; Bye.
;; cs: ~ <102>
;; -----------------------------

;; ============================================================================
;; Secular Holidays:
;; ================

(defun daylight-savings-start (year)
;; Absolute date of the start of American daylight savings time
;; in Gregorian $year$.
  (Nth-Kday 1 0 4 year));; First Sunday in April.

(defun daylight-savings-end (year)
;; Absolute date of the end of American daylight savings time
;; in Gregorian $year$.
  (Nth-Kday -1 0 10 year));; Last Sunday in October.

(defun labor-day (year)
;; Absolute date of American Labor Day in Gregorian $year$.
  (Nth-Kday 1 1 9 year));; First Monday in September.

(defun memorial-day (year)
;; Absolute date of American Memorial Day in Gregorian $year$.
  (Nth-Kday -1 1 5 year));; Last Monday in May.

(defun independence-day (year)
;; Absolute date of American Independence Day in Gregorian $year$.
  (absolute-from-gregorian (list 7 4 year)))


;; =============================================================================
;; Islamic Holidays:
;; ================

(defun islamic-holidays (year)
;; List of lists of absolute dates of each Islamic holiday occurring
;; in Gregorian $year$.
;; Added by Abdelsalam Heddaya, 1990.10.09
  (append (list (cons 'hijri_new_year
		      (mapcar 'gregorian-from-absolute (hijri-new-year year))))
          (list (cons 'mawlidu_elnaby
		      (mapcar 'gregorian-from-absolute (mawlidu_elnaby year))))
	  (list (cons 'ramadaan
		      (mapcar 'gregorian-from-absolute (ramadaan year))))
	  (list (cons 'iydu_elfit-r
		      (mapcar 'gregorian-from-absolute (iydu_elfit-r year))))
	  (list (cons 'iydu_elad-hae
		      (mapcar 'gregorian-from-absolute (iydu_elad-hae year))))))

;; ----------------------------------------------------------------------------
;; Hijri Months: (number of days in parentheses)
;; ------------
;; The Lunar Hijri year contains 354 or 355 (leap) days.

;; 1-Muharram	(30)	5- Jumaada I	(30)	 9-Ramadan	(30)
;; 2-Safar	(29)	6- Jumaada II	(29)	10-Shawwaal	(29)
;; 3-Rabi` I	(30)	7- Rajab	(30)	11-Dhu al-Qe`da	(30)
;; 4-Rabi` II	(29)	8- Sha`baan	(29)	12-Dhu al-Hejja	(29 or 30)

;; ---------------------------------------------------------------------------

(defun mawlidu_elnaby (year)
;; List of absolute dates of <mawlid elnaby> occurring in
;; Gregorian $year$.
;; Modified 1990.10.09 by Heddaya: changed name from mulad-al-nabi
  (islamic-date 3 12 year))

(defun ramadaan (year)
;; List of absolute dates of beginning of <ramad.aan> occurring in
;; Gregorian $year$.
;; Added by Abdelsalam Heddaya, 1990.10.09
  (islamic-date 9 1 year))

(defun iydu_elfit-r (year)
;; List of absolute dates of <`ydu elfeTr> occurring in
;; Gregorian $year$.
;; Added by Abdelsalam Heddaya, 1990.10.09
  (islamic-date 10 1 year))

(defun iydu_elad-hae (year)
;; List of absolute dates of <`ydu el'aD-Hae> occurring in
;; Gregorian $year$.
;; Added by Abdelsalam Heddaya on 1990.10.09.
  (islamic-date 12 10 year))

(defun hijri-new-year (year)
;; List of absolute dates of <ra`s alsanah alhijreyah> occurring in
;; Gregorian $year$.
;; Added by Abdelsalam Heddaya on 1990.11.28.
  (islamic-date 1 1 year))

;; =============================================================================
;; Christian Holidays:
;; =================

(defun christmas (year)
;; Absolute date of Christmas in Gregorian $year$.
  (absolute-from-gregorian (list 12 25 year)))

(defun advent (year)
;; Absolute date of Advent in Gregorian $year$.
  (Kday-on-or-before (absolute-from-gregorian (list 12 3 year)) 0))

(defun epiphany (year)
;; Absolute date of Epiphany in Gregorian $year$.
  (+ 12 (christmas year)))

(defun eastern-orthodox-christmas (year)
;; List of zero or one absolute dates of Eastern Orthodox
;; Christmas in Gregorian $year$.
  (let* ((jan1 (absolute-from-gregorian (list 1 1 year)))
         (dec31 (absolute-from-gregorian (list 12 31 year)))
         (y (extract-year (julian-from-absolute jan1)))
         (c1 (absolute-from-julian (list 12 25 y)))
         (c2 (absolute-from-julian (list 12 25 (1+ y)))))
   (append
    (if ;; c1 occurs in current year
        (<= jan1 c1 dec31)
;;   Then that date; otherwise, none
        (list c1) nil)
    (if ;; c2 occurs in current year
        (<= jan1 c2 dec31)
;;   Then that date; otherwise, none
        (list c2) nil))))

(defun nicaean-rule-easter (year)
;; Absolute date of Easter in Julian $year$, according to the rule
;; of the Council of Nicaea.
  (let* ((shifted-epact ;; Age of moon for April 5.
          (mod (+ 14
                  (* 11 (mod year 19)))
               30))
         (paschal-moon  ;; Day after full moon on or after March 21.
          (- (absolute-from-julian (list 4 19 year))
             shifted-epact)))
;; Return the Sunday following the Paschal moon
    (Kday-on-or-before (+ paschal-moon 7) 0)))

(defun easter (year)
;; Absolute date of Easter in Gregorian $year$.
  (let* ((century (1+ (quotient year 100)))
         (shifted-epact        ;; Age of moon for April 5...
          (mod
           (+ 14 (* 11 (mod year 19));;     ...by Nicaean rule
              (-      ;; ...corrected for the Gregorian century rule
               (quotient (* 3 century) 4))
              (quotient;; ...corrected for Metonic cycle inaccuracy.
               (+ 5 (* 8 century)) 25)
              (* 30 century));;              Keeps value positive.
           30))
         (adjusted-epact       ;;  Adjust for 29.5 day month.
          (if (or (= shifted-epact 0)
                  (and (= shifted-epact 1) (< 10 (mod year 19))))
        ;; Then
              (1+ shifted-epact)
        ;; Else
            shifted-epact))
         (paschal-moon;; Day after full moon on or after March 21.
          (- (absolute-from-gregorian (list 4 19 year))
             adjusted-epact)))
;; Return the Sunday following the Paschal moon.
    (Kday-on-or-before (+ paschal-moon 7) 0)))

(defun pentecost (year)
;; Absolute date of Pentecost in Gregorian $year$.
  (+ 49 (easter year)))


;; ============================================================================
;; Jewish Holidays:
;; ==============

(defun yom-kippur (year)
;; Absolute date of Yom Kippur occurring in Gregorian $year$.
  (absolute-from-hebrew (list 7 10 (+ year 3761))))

(defun passover (year)
;; Absolute date of Passover occurring in Gregorian $year$.
  (absolute-from-hebrew (list 1 15 (+ year 3760))))

(defun purim (year)
;; Absolute date of Purim occurring in Gregorian $year$.
  (absolute-from-hebrew
    (list
      (last-month-of-hebrew-year (+ year 3760));; Adar or Adar II
      14
      (+ year 3760))))

(defun ta-anit-esther (year)
;; Absolute date of Ta'anit Esther occurring in Gregorian $year$.
  (let* ((purim-date (purim year)))
    (if ;; Purim is on Sunday
        (= (mod purim-date 7) 0)
  ;; Then return prior Thursday
        (- purim-date 3)
  ;; Else return previous day
      (1- purim-date))))

(defun tisha-b-av (year)
;; Absolute date of Tisha B'Av occurring in Gregorian $year$.
  (let* ((ninth-of-av
          (absolute-from-hebrew (list 5 9 (+ year 3760)))))
    (if ;; Ninth of Av is Saturday
        (= (mod ninth-of-av 7) 6)
  ;; Then return the next day
        (1+ ninth-of-av) 
  ;; Else return
      ninth-of-av)))

(defun hebrew-birthday (birthdate year)
;; Absolute date of the anniversary of Hebrew $birthdate$
;; occurring in Hebrew $year$.
  (let* ((birth-day (extract-day birthdate))
         (birth-month (extract-month birthdate))
         (birth-year (extract-year birthdate)))
    (if ;; It's Adar in a normal year or Adar II in a leap year,
        (= birth-month (last-month-of-hebrew-year birth-year))
  ;; Then use the same day in last month of $year$.
        (absolute-from-hebrew
         (list (last-month-of-hebrew-year year) birth-day year))
  ;; Else use the normal anniversary of the birth date,
  ;; or the corresponding day in years without that date
      (absolute-from-hebrew (list birth-month birth-day year)))))

(defun yahrzeit (death-date year)
;; Absolute date of the anniversary of Hebrew $death$-$date$
;; occurring in Hebrew $year$.
  (let* ((death-day (extract-day death-date))
         (death-month (extract-month death-date))
         (death-year (extract-year death-date)))
    (cond
     ;; If it's Heshvan 30 it depends on the first anniversary; if
     ;; that was not Heshvan 30, use the day before Kislev 1.
     ((and (= death-month 8)
           (= death-day 30)
           (not (long-heshvan (1+ death-year))))
      (1- (absolute-from-hebrew (list 9 1 year))))
     ;; If it's Kislev 30 it depends on the first anniversary; if
     ;; that was not Kislev 30, use the day before Teveth 1.
     ((and (= death-month 9)
           (= death-day 30)
           (short-kislev (1+ death-year)))
      (1- (absolute-from-hebrew (list 10 1 year))))
     ;; If it's Adar II, use the same day in last month of
     ;; year (Adar or Adar II).
     ((= death-month 13)
      (absolute-from-hebrew
       (list (last-month-of-hebrew-year year) death-day year)))
     ;; If it's the 30th in Adar I and $year$ is not a leap year
     ;; (so Adar has only 29 days), use the last day in Shevat.
     ((and (= death-day 30)
           (= death-month 12)
           (not (hebrew-leap-year death-year)))
      (absolute-from-hebrew (list 11 30 year)))
     ;; In all other cases, use the normal anniversary of the
     ;; date of death.
     (t (absolute-from-hebrew
         (list death-month death-day year))))))


;; ============================================================================
;; Date Conversion functions:
;; ========================

(defun date-text-from-numbers (calendar date)
;; Convert date format of $date$ belonging to $calendar$ from
;; (month day year) in numbers to (day month year) where month
;; is the text name of the month.
;; For example, (date-text-from-numbers 'hijri '(2 27 1411)) should return 
;; (27 Safar 1411)
;; 
;; Written by Abdelsalam Heddaya, BU, 1990.10.17.
;; To be defined later.
  ())

(defun hijri-from-gregorian (date)
;; Lunar Hijri (Islamic) equivalent to Gregorian $date$.
;; Both argument and result are in the form (month day year),
;; e.g., (9 18 1990) represents the Gregorian September 18, 1990.
;; Written by Abdelsalam Heddaya, BU, 1990.10.17.
  (islamic-from-absolute (absolute-from-gregorian date)))

(defun gregorian-from-hijri (date)
;; Gregorian equivalent to Lunar Hijri (Islamic) $date$.
;; Both argument and result are in the form (month day year),
;; e.g., (9 18 1990) represents the Gregorian September 18, 1990.
;; Written by Abdelsalam Heddaya, BU, 1990.10.17.
  (islamic-from-absolute (absolute-from-gregorian date)))

(defun absolute-from-gregorian (date)
;; Absolute date equivalent to the Gregorian $date$.
  (let* ((month (extract-month date))
         (year (extract-year date)))
;;  Return
    (+ (extract-day date)    ;; Days so far this month.
       (sum                  ;; Days in prior months this year.
        (last-day-of-gregorian-month m year) m 1 (< m month))
       (* 365 (1- year))     ;; Days in prior years.
       (quotient (1- year) 4);; Julian leap days in prior years...
       (-                    ;; ...minus prior century years...
        (quotient (1- year) 100))
       (quotient             ;; ...plus prior years divisible...
        (1- year) 400))))    ;; ...by 400.

(defun gregorian-from-absolute (date)
;; Gregorian (month day year) corresponding absolute $date$.
  (let* ((approx (quotient date 366));; Approximation from below.
         (year          ;; Search forward from the approximation.
          (+ approx
             (sum 1 y approx
                  (>= date
                      (absolute-from-gregorian
                       (list 1 1 (1+ y)))))))
         (month         ;; Search forward from January.
          (1+ (sum 1 m 1
                   (> date
                      (absolute-from-gregorian
                       (list m
                             (last-day-of-gregorian-month m year)
                             year))))))
         (day           ;; Calculate the day by subtraction.
          (- date (1- (absolute-from-gregorian
                       (list month 1 year))))))
;;  Return
    (list month day year)))

(defun absolute-from-julian (date)
;; Absolute date equivalent to Julian $date$.
  (let* ((month (extract-month date))
         (year (extract-year date)))
;;  Return
    (+ (extract-day date)    ;; Days so far this month.
       (sum                  ;; Days in prior months this year.
        (last-day-of-julian-month m year) m 1 (< m month))
       (* 365 (1- year))     ;; Days in prior years.
       (quotient (1- year) 4);; Leap days in prior years.
       -2)))                 ;; Days elapsed before absolute date 1.

(defun julian-from-absolute (date)
;; Julian (month day year) corresponding to absolute $date$.
  (let*
      ((approx      ;; Approximation from below.
        (quotient (+ date 2) 366))
       (year        ;; Search forward from the approximation.
        (+ approx
           (sum 1 y approx
                (>= date
                    (absolute-from-julian (list 1 1 (1+ y)))))))
       (month       ;; Search forward from January.
        (1+ (sum 1 m 1
                 (> date
                    (absolute-from-julian
                     (list m
                           (last-day-of-julian-month m year)
                           year))))))
       (day         ;; Calculate the day by subtraction.
        (- date (1- (absolute-from-julian (list month 1 year))))))
;;  Return
    (list month day year)))

(defun absolute-from-iso (date)
;; Absolute date equivalent to ISO $date$ = (week day year).
  (let* ((week (first date))
         (day (second date))
         (year (third date)))
;;  Return
    (+ (Kday-on-or-before
        (absolute-from-gregorian (list 1 4 year))
        1)                       ;;  Days in prior years.
       (* 7 (1- week))           ;;  Days in prior weeks this year.
       (1- day))))               ;;  Prior days this week.

(defun iso-from-absolute (date)
;; ISO (week day year) corresponding to the absolute $date$.
  (let* ((approx
          (extract-year (gregorian-from-absolute (- date 3))))
         (year (if (>= date
                       (absolute-from-iso (list 1 1 (1+ approx))))
                ;; Then
                   (1+ approx)
                ;; Else
                   approx))
         (week (1+ (quotient
                    (- date (absolute-from-iso (list 1 1 year)))
                    7)))
         (day (if (= 0 (mod date 7))
               ;; Then
                  7
               ;; Else
                  (mod date 7))))
;;  Return
    (list week day year)))


(defun absolute-from-islamic (date)
;; Absolute date equivalent to Islamic $date$.
  (let* ((month (extract-month date))
         (year (extract-year date)))
    (+ (extract-day date)     ;; Days so far this month.
       (* 29 (1- month))      ;; Days so far...
       (quotient month 2)     ;;            ...this year.
       (* (1- year) 354)      ;; Non-leap days in prior years.
       (quotient              ;; Leap days in prior years.
        (+ 3 (* 11 year)) 30)
       227014)))              ;; Days before start of calendar.

(defun islamic-from-absolute (date)
;; Islamic date (month day year) corresponding to absolute $date$.
  (if ;; Pre-Islamic date.
      (<= date 227014)
;; Then return 
      (list 0 0 0)
;; Else
    (let* ((approx         ;; Approximation from below.
            (quotient (- date 227014) 355))
           (year           ;; Search forward from the approximation.
            (+ approx
               (sum 1 y approx
                    (>= date
                        (absolute-from-islamic
                         (list 1 1 (1+ y)))))))
           (month          ;; Search forward from Muharram.
            (1+ (sum 1 m 1
                     (> date
                        (absolute-from-islamic
                         (list m
                               (last-day-of-islamic-month m year)
                               year))))))
           (day            ;; Calculate the day by subtraction.
            (- date (1- (absolute-from-islamic
                         (list month 1 year))))))
      ;; Return
        (list month day year))))

(defun absolute-from-hebrew (date)
;; Absolute date of Hebrew $date$.
  (let* ((month (extract-month date))
         (day (extract-day date))
         (year (extract-year date)))
;; Return
    (+ day                            ;; Days so far this month.
       (if ;; before Tishri
           (< month 7)
     ;; Then add days in prior months this year before and
     ;; after Nisan.
           (+ (sum (last-day-of-hebrew-month m year)
                   m 7 (<= m (last-month-of-hebrew-year year)))
              (sum (last-day-of-hebrew-month m year)
                   m 1 (< m month)))
     ;; Else add days in prior months this year
         (sum (last-day-of-hebrew-month m year) m 7 (< m month)))
    (hebrew-calendar-elapsed-days year);; Days in prior years.
    -1373429)))              ;; Days elapsed before absolute date 1.

(defun hebrew-from-absolute (date)
;; Hebrew (month day year) corresponding to absolute $date$.
  (let* ((approx    ;; Approximation from below.
          (quotient (+ date 1373429) 366))
         (year      ;; Search forward from the approximation.
          (+ approx (sum 1 y approx
                         (>= date
                             (absolute-from-hebrew
                              (list 7 1 (1+ y)))))))
         (start      ;; Starting month for search for month.
          (if (< date (absolute-from-hebrew (list 1 1 year)))
              ;; Then start at Tishri
                    7
              ;; Else start at Nisan
                  1))
         (month      ;; Search forward from either Tishri or Nisan.
          (+ start
             (sum 1 m start
                  (> date
                     (absolute-from-hebrew
                      (list m
                            (last-day-of-hebrew-month m year)
                            year))))))
         (day        ;; Calculate the day by subtraction.
          (- date (1- (absolute-from-hebrew (list month 1 year))))))
;; Return
    (list month day year)))


;; ============================================================================
;; Basic Date Arithmetic:
;; ====================

(defun Kday-on-or-before (date k)
;; Absolute date of the $k$day on or before $date$.
;; $k=0$ means Sunday, $k=1$ means Monday, and so on.
  (- date (mod (- date k) 7)))

(defun Nth-Kday (n k month year)
;; Absolute date of the $n$th $k$day in Gregorian $month$, $year$.
;; If $n$<0, the $n$th $k$day from the end of month is returned
;; (that is, -1 is the last $k$day, -2 is the penultimate $k$day,
;; and so on).  $k=0$ means Sunday, $k=1$ means Monday, and so on.
  (if (> n 0)
;; Then return
      (+ (Kday-on-or-before             ;; First $k$day in month.
          (absolute-from-gregorian
           (list month 7 year)) k)
         (* 7 (1- n)))                  ;; Advance $n-1$ $k$days.
;; Else return
      (+ (Kday-on-or-before             ;; Last $k$day in month.
          (absolute-from-gregorian
           (list month
                 (last-day-of-gregorian-month month year)
                 year))
          k)
         (* 7 (1+ n)))))                ;; Go back $-n-1$ $k$days.


;; ------------------
;; Christian Calendar:
;; ------------------

(defun last-day-of-gregorian-month (month year)
;; Last day in Gregorian $month$ during $year$.
  (if ;; February in a leap year
      (and (= month 2)
           (= (mod year 4) 0)
           (not (member (mod year 400) (list 100 200 300))))
;; Then return
      29
;; Else return
    (nth (1- month)
         (list 31 28 31 30 31 30 31 31 30 31 30 31))))

(defun last-day-of-julian-month (month year)
;; Last day in Julian $month$ during $year$.
  (if ;; February in a leap year
      (and (= month 2) (= (mod year 4) 0))
;; Then return
      29
;; Else return
    (nth (1- month) (list 31 28 31 30 31 30 31 31 30 31 30 31))))


;; ----------------
;; Islamic Calendar:
;; ----------------

(defun islamic-leap-year (year)
;; True if $year$ is an Islamic leap year.
  (< (mod (+ 14 (* 11 year)) 30) 11))

(defun last-day-of-islamic-month (month year)
;; Last day in $month$ during $year$ on the Islamic calendar.
  (if (or (oddp month)
          (and (= month 12) (islamic-leap-year year)))
;; Then return
      30
;; Else return
    29))

(defun islamic-date (month day year)
;; List of the absolute dates of Islamic $month$, $day$
;; that occur in Gregorian $year$.
  (let* ((jan1 (absolute-from-gregorian (list 1 1 year)))
         (dec31 (absolute-from-gregorian (list 12 31 year)))
         (y (extract-year (islamic-from-absolute jan1)))
;; The possible occurrences in one year are
         (date1 (absolute-from-islamic (list month day y)))
         (date2 (absolute-from-islamic (list month day (1+ y))))
         (date3 (absolute-from-islamic (list month day (+ 2 y)))))
;; Combine in one list those that occur in current year
    (append
      (if (<= jan1 date1 dec31)
          (list date1) nil)
      (if (<= jan1 date2 dec31)
          (list date2) nil)
      (if (<= jan1 date3 dec31)
          (list date3) nil))))        


;; ---------------
;; Jewish Calendar:
;; ---------------

(defun hebrew-leap-year (year)
;; True if $year$ is a leap year.
  (< (mod (1+ (* 7 year)) 19) 7))

(defun last-month-of-hebrew-year (year)
;; Last month of Hebrew $year$.
  (if (hebrew-leap-year year)
;; Then return
      13
;; Else return
    12))

(defun last-day-of-hebrew-month (month year)
;; Last day of $month$ in Hebrew $year$.
  (if (or (member month (list 2 4 6 10 13))
          (and (= month 12) (not (hebrew-leap-year year)))
          (and (= month 8) (not (long-heshvan year)))
          (and (= month 9) (short-kislev year)))
;; Then return
      29
;; Else return
    30))

(defun hebrew-calendar-elapsed-days (year)
;; Number of days elapsed from the Sunday prior to the start of the
;; Hebrew calendar to the mean conjunction of Tishri of Hebrew $year$.
  (let*
      ((months-elapsed
        (+
         (* 235            ;; Months in complete cycles so far.
            (quotient (1- year) 19))
         (* 12             ;; Regular months in this cycle.
            (mod (1- year) 19))
         (quotient         ;; Leap months this cycle
          (1+ (* 7 (mod (1- year) 19)))
          19)))
;;     (parts-elapsed (+ 5604 (* 13753 months-elapsed)))
;;     (day                                    ;; Conjunction day
;;      (+ 1 (* 29 months-elapsed) (quotient parts-elapsed 25920)))
;;     (parts (mod parts-elapsed 25920))       ;; Conjunction parts
;;
;;  The above lines of code are correct, but can have intermediate
;;  values that are too large for a 32-bit machine.  The following
;;  lines of code that replace them are equivalent, but avoid the
;;  problem.
;;
       (parts-elapsed
        (+ 204
           (* 793 (mod months-elapsed 1080))))
       (hours-elapsed
        (+ 5
           (* 12 months-elapsed)
           (* 793 (quotient months-elapsed 1080))
           (quotient parts-elapsed 1080)))
       (day                                    ;; Conjunction day
        (+ 1
           (* 29 months-elapsed)
           (quotient hours-elapsed 24)))
       (parts                                  ;; Conjunction parts
        (+ (* 1080 (mod hours-elapsed 24))
           (mod parts-elapsed 1080)))
       (alternative-day
        (if (or
             (>= parts 19440)  ;; If new moon is at or after midday,
             (and
               (= (mod day 7) 2);; ...or is on a Tuesday...
               (>= parts 9924)  ;; at 9 hours, 204 parts or later...
               (not (hebrew-leap-year year)));; of a common year,
             (and
               (= (mod day 7) 1);; ...or is on a Monday at...
               (>= parts 16789) ;; 15 hours, 589 parts or later...
               (hebrew-leap-year;; at the end of a leap year
                (1- year))))
          ;; Then postpone Rosh HaShanah one day
            (1+ day)
          ;; Else
            day)))
    (if ;; If Rosh HaShanah would occur on Sunday, Wednesday,
        ;; or Friday
        (member (mod alternative-day 7) (list 0 3 5))
  ;; Then postpone it one (more) day and return        
        (1+ alternative-day)
  ;; Else return        
      alternative-day)))

(defun days-in-hebrew-year (year)
;; Number of days in Hebrew $year$.
  (- (hebrew-calendar-elapsed-days (1+ year))
     (hebrew-calendar-elapsed-days year)))

(defun long-heshvan (year)
;; True if Heshvan is long in Hebrew $year$.
  (= (mod (days-in-hebrew-year year) 10) 5))

(defun short-kislev (year)
;; True if Kislev is short in Hebrew $year$.
  (= (mod (days-in-hebrew-year year) 10) 3))


;; ============================================================================
;; Simple arithmetic on dates:
;; =========================

(defun quotient (m n)
   (floor (/ m n)))

(defun extract-month (date)
;; Month field of $date$ = (month day year).
  (first date))

(defun extract-day (date)
;; Day field of $date$ = (month day year).
  (second date))
  
(defun extract-year (date)
;; Year field of $date$ = (month day year).
  (third date))

(defmacro sum (expression index initial condition)
;; Sum $expression$ for $index$ = $initial$ and successive integers,
;; as long as $condition$ holds.
  (let* ((temp (gensym)))
    `(do ((,temp 0 (+ ,temp ,expression))
          (,index ,initial (1+ ,index)))
         ((not ,condition) ,temp))))