Implementation in Common Lisp of the algorithms for calendrical calculations from the book ¨Calendrical Calculations" by Dershowitz and Rheingold, 3rd edition, Cambridge University Press, 2007.

calendar.lisp

;; The following Lisp code is from ``Calendrical
;; Calculations'' by Nachum Dershowitz and Edward
;; M. Reingold, Software---Practice & Experience, vol. 20,
;; no. 9 (September, 1990), pp. 899--928 and from
;; ``Calendrical Calculations, II: Three Historical
;; Calendars'' by Edward M.  Reingold, Nachum Dershowitz,
;; and Stewart M. Clamen, Software---Practice & Experience,
;; vol. 23, no. 4 (April, 1993), pp. 383--404.

;; This code is in the public domain, but any use of it
;; should publically acknowledge its source.

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

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

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

(defun extract-day (date)
  ;; Day field of $date$ = (year month day).
  (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))))

(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 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+ y) 1 1))))))
         (month         ;; Search forward from January.
          (1+ (sum 1 m 1
                   (> date (absolute-from-gregorian
                            (list year
                                  m
                                  (last-day-of-gregorian-month m year)))))))
         (day           ;; Calculate the day by subtraction.
          (- date (1- (absolute-from-gregorian
                       (list year month 1))))))
    ;;  Return
    (list year month day)))

(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 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 year 1 4))
        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 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))))

(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 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 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 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))

(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)))

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

(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 year month 7)) k)
         (* 7 (1- n)))                  ;; Advance $n-1$ $k$days.
      ;; Else return
      (+ (Kday-on-or-before             ;; Last $k$day in month.
          (absolute-from-gregorian
           (list year
                 month
                 (last-day-of-gregorian-month month year)))
          k)
         (* 7 (1+ n)))))                ;; Go back $-n-1$ $k$days.

(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 year 5));; Last Monday in May.

(defun daylight-savings-start (year)
  ;; Absolute date of the start of American daylight savings time
  ;; in Gregorian $year$.
  (Nth-Kday 1 0 year 4));; 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 year 10));; Last Sunday in October.

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

(defun advent (year)
  ;; Absolute date of Advent in Gregorian $year$.
  (Kday-on-or-before (absolute-from-gregorian (list year 12 3)) 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 year 1 1)))
         (dec31 (absolute-from-gregorian (list year 12 31)))
         (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 year 4 19))
             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)))

(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))))

(defun mulad-al-nabi (year)
  ;; List of absolute dates of Mulad-al-Nabi occurring in
  ;; Gregorian $year$.
  (islamic-date 3 12 year))

(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 year)));; Corrected 5/19/93 by EMR
       (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))))))

(defconstant mayan-days-before-absolute-zero
  ;; Number of days of the Mayan calendar epoch before absolute day 0,
  ;; according to the Goodman-Martinez-Thompson correlation.
  1137140)

(defun absolute-from-mayan-long-count (count)
  ;; Absolute date corresponding to the Mayan long count $count$,
  ;; which is a list ($baktun$ $katun$ $tun$ $uinal$ $kin$).
  (+ (* (first count)  144000);; Baktun.
     (* (second count) 7200)  ;; Katun.
     (* (third count)  360)   ;; Tun.
     (* (fourth count) 20)    ;; Uinal.
     (fifth count)            ;; Kin (days).
     (-                       ;; Days before absolute date 0.
      mayan-days-before-absolute-zero)))

(defun mayan-long-count-from-absolute (date)
  ;; Mayan long count date of absolute date $date$.
  (let* ((long-count (+ date mayan-days-before-absolute-zero))
         (baktun (quotient long-count 144000))
         (day-of-baktun (mod long-count 144000))
         (katun (quotient day-of-baktun 7200))
         (day-of-katun (mod day-of-baktun 7200))
         (tun (quotient day-of-katun 360))
         (day-of-tun (mod day-of-katun 360))
         (uinal (quotient day-of-tun 20))
         (kin (mod day-of-tun 20)))
    (list baktun katun tun uinal kin)))

;; (defun quotient (m n)
;;    (floor m n))

(defconstant mayan-haab-at-epoch '(8 18))

(defun mayan-haab-from-absolute (date)
  ;; Mayan haab date of absolute date $date$.
  (let* ((long-count (+ date mayan-days-before-absolute-zero))
         (day-of-haab
          (mod (+ long-count
                  (first mayan-haab-at-epoch)
                  (* 20 (1- (second mayan-haab-at-epoch))))
               365))
         (day (mod day-of-haab 20))
         (month (1+ (quotient day-of-haab 20))))
    (list day month)))

(defun mayan-haab-difference (date1 date2)
  ;; Number of days from Mayan haab date $date1$ to the next
  ;; occurrence of Mayan haab date $date2$.
  (mod (+ (* 20 (- (second date2) (second date1)))
          (- (first date2) (first date1)))
       365))

(defun mayan-haab-on-or-before (haab date)
  ;; Absolute date of latest date on or before absolute date $date$
  ;; that is Mayan haab date $haab$.
  (- date
     (mod (- date
             (mayan-haab-difference
              (mayan-haab-from-absolute 0) haab))
          365)))

(defun adjusted-mod (m n)
  ;; Positive remainder of $m/n$ with $n$ instead of 0.
  (1+ (mod (1- m) n)))

(defconstant mayan-tzolkin-at-epoch '(4 20))

(defun mayan-tzolkin-from-absolute (date)
  ;; Mayan tzolkin date of absolute date $date$.
  (let* ((long-count (+ date mayan-days-before-absolute-zero))
         (number
          (adjusted-mod (+ long-count
                           (first mayan-tzolkin-at-epoch))
                        13))
         (name
          (adjusted-mod (+ long-count
                           (second mayan-tzolkin-at-epoch))
                        20)))
    (list number name)))

(defun mayan-tzolkin-difference (date1 date2)
  ;; Number of days from Mayan tzolkin date $date1$ to the next
  ;; occurrence of Mayan tzolkin date $date2$.
  (let* ((number-difference (- (first date2) (first date1)))
         (name-difference (- (second date2) (second date1))))
    (mod (+ number-difference
            (* 13 (mod (* 3 (- number-difference name-difference))
                       20)))
         260)))

(defun mayan-tzolkin-on-or-before (tzolkin date)
  ;; Absolute date of latest date on or before absolute date $date$
  ;; that is Mayan tzolkin date $tzolkin$.
  (- date
     (mod (- date (mayan-tzolkin-difference
                   (mayan-tzolkin-from-absolute 0)
                   tzolkin))
          260)))

(defun mayan-haab-tzolkin-on-or-before (haab tzolkin date)
  ;; Absolute date of latest date on or before $date$ that is Mayan
  ;; haab date $haab$ and tzolkin date $tzolkin$; returns nil if such
  ;; a haab-tzolkin combination is impossible.
  (let* ((haab-difference
          (mayan-haab-difference (mayan-haab-from-absolute 0)
                                 haab))
         (tzolkin-difference
          (mayan-tzolkin-difference (mayan-tzolkin-from-absolute 0)
                                    tzolkin))
         (difference (- tzolkin-difference haab-difference)))
    (if (= (mod difference 5) 0)
        (- date
           (mod (- date
                   (+ haab-difference (* 365 difference)))
                18980))
        nil)));;  haab-tzolkin combination is impossible.

(defun french-last-day-of-month (month year)
  ;; Last day of {\em month, year} on the French Revolutionary calendar.
  (if (< month 13)
      30
      (if (french-leap-year year)
          6
          5)))

(defun french-leap-year (year)
  ;; True if {\em year} is a leap year on the French Revolutionary calendar.
  (or (member year '(3 7 11));; Actual.
      (member year '(15 20)) ;; Anticipated.
      (and (> year 20)       ;; Proposed.
           (= 0 (mod year 4))
           (not (member (mod year 400) '(100 200 300)))
           (not (= 0 (mod year 4000))))))

(defun absolute-from-french (date)
  ;; Absolute date of French Revolutionary {\em date}.
  (let* ((month (first date))
         (day (second date))
         (year (third date)))
    (+ 654414;; Days before start of calendar.
       (* 365 (1- year));; Days in prior years.
       ;; Leap days in prior years.
       (if (< year 20)
           (quotient year 4);; Actual and anticipated practice,
           ;; that is, years 3, 7, 11, and 15.
           ;; Proposed rule--there were 4 leap years before year 20.
           (+ (quotient (1- year) 4)
              (- (quotient (1- year) 100))
              (quotient (1- year) 400)
              (- (quotient (1- year) 4000))))
       (* 30 (1- month));; Days in prior months this year.
       day)));; Days so far this month.

(defun french-from-absolute (date)
  ;; French Revolutionary date (month day year) of absolute {\em date};
  ;; returns nil if $date$ is before the French Revolution.
  (if (< date 654415)
      nil;; pre-French Revolutionary date.
      (let* ((approx       ;; Approximate year from below.
              (quotient (- date 654414) 366))
             (year         ;; Search forward from the approximation.
              (+ approx
                 (sum 1 y approx
                      (>= date
                          (absolute-from-french (list 1 1 (1+ y)))))))
             (month        ;; Search forward from Vendemiaire.
              (1+ (sum 1 m 1
                       (> date
                          (absolute-from-french
                           (list m
                                 (french-last-day-of-month m year)
                                 year))))))
             (day          ;; Calculate the day by subtraction.
              (- date
                 (1- (absolute-from-french (list month 1 year))))))
        (list month day year))))

(defconstant solar-sidereal-year (+ 365 279457/1080000))
(defconstant solar-month (/ solar-sidereal-year 12))
(defconstant lunar-sidereal-month (+ 27 4644439/14438334))
(defconstant lunar-synodic-month (+ 29 7087771/13358334))

(defun solar-longitude (days)
  ;; Mean sidereal longitude of the sun, in degrees,
  ;; at date and fraction of day $days$.
  (* (mod (/ days solar-sidereal-year) 1) 360))

(defun zodiac (days)
  ;; Zodiacal sign of the sun, as integer in range 1..12,
  ;; for date and fraction of day $days$.
  (1+ (quotient (solar-longitude days) 30)))

(defun old-hindu-solar-from-absolute (date)
  ;; Hindu solar month, day, and year of absolute date $date$.
  (let* ((hdate (+ date 1132959 1/4));;   Sunrise on Hindu date.
         (year (quotient hdate solar-sidereal-year))
         (month (zodiac hdate))
         (day (1+ (floor (mod hdate solar-month)))))
    (list month day year)))

(defun absolute-from-old-hindu-solar (date)
  ;; Absolute date corresponding to Hindu solar date $date$.
  (let* ((month (first date))
         (day (second date))
         (year (third date)))
    (floor (+ (* year solar-sidereal-year);; Days in elapsed years.
              (* (1- month) solar-month)  ;; In months.
              day -1/4              ;; Whole days until midnight.
              -1132959))))          ;; Days before absolute day 0.

(defun lunar-longitude (days)
  ;; Mean sidereal longitude of the moon, in degrees,
  ;; at date and fraction of day $days$.
  (* (mod (/ days lunar-sidereal-month) 1) 360))

(defun lunar-phase (days)
  ;; Longitudinal distance between the sun and the moon, as an integer
  ;; in the range 1..30, at date and fraction of day $days$.
  (1+ (quotient
       (mod (- (lunar-longitude days) (solar-longitude days))
            360)
       12)))

(defun new-moon (days)
  ;; Time of the most recent mean conjunction at or before
  ;; date and fraction of day $days$.
  (- days (mod days lunar-synodic-month)))

(defun old-hindu-lunar-from-absolute (date)
  ;; Hindu lunar month, day, and year of absolute date $date$.
  (let* ((hdate (+ date 1132959))      ;; Hindu date.
         (sunrise (+ hdate 1/4))       ;; Sunrise on that day.
         (last-new-moon                ;; Last new moon.
          (new-moon sunrise))
         (next-new-moon                ;; Next new moon.
          (+ last-new-moon lunar-synodic-month))
         (day (lunar-phase sunrise))   ;; Day of month.
         (month                        ;; Month of lunar year.
          (adjusted-mod (1+ (zodiac last-new-moon)) 12))
         (leapmonth                    ;; If next month the same.
          (= (zodiac last-new-moon)
             (zodiac next-new-moon)))
         (next-month                   ;; Beginning of next month.
          (+ next-new-moon
             (if leapmonth lunar-synodic-month 0)))
         (year                         ;; Solar year of next month.
          (quotient next-month solar-sidereal-year)))
    (list month leapmonth day year)))

(defun old-hindu-lunar-precedes (date1 date2)
  ;; True if Hindu lunar $date1$ precedes $date2$.
  (let* ((month1 (first date1))
         (month2 (first date2))
         (leap1 (second date1))
         (leap2 (second date2))
         (day1 (third date1))
         (day2 (third date2))
         (year1 (fourth date1))
         (year2 (fourth date2)))
    (or (< year1 year2)
        (and (= year1 year2)
             (or (< month1 month2)
                 (and (= month1 month2)
                      (or (and leap1 (not leap2))
                          (and (equal leap1 leap2)
                               (< day1 day2)))))))))

(defun absolute-from-old-hindu-lunar (date)
  ;; Absolute date corresponding to Hindu lunar date $date$;
  ;; returns nil if no such date exists.
  (let* ((years (fourth date))      ;; Elapsed years.
         (months (- (first date) 2));; Elapsed whole months,
         ;; minus a month's possible difference between the
         ;; solar and lunar year.
         (approx;;  Approximate date from below by adding days...
          (+ (floor (* years solar-sidereal-year)) ;;  in years,
             (floor (* months lunar-synodic-month));;  in months,
             -1132959))            ;; and before absolute date 0.
         (try
          (+ approx             ;; Search forward to correct date,
             (sum 1 i approx    ;; or just past it.
                  (old-hindu-lunar-precedes
                   (old-hindu-lunar-from-absolute i)
                   date)))))
    (if (equal (old-hindu-lunar-from-absolute try) date)
        try
        nil))) ;; $date$ non-existent on Hindu lunar calendar.

Hi

I tried to run this code on online LISP compiler at https://www.tutorialspoint.com/execute_lisp_online.php

But unfortunately it did not work.

Am I missing something?