日付関数の日本語化、解説編．．．または、2038年問題対応？

　今回実装した関数 jdate, jdate:list, jdate:parse, jdate:value, jdate:now の内、list, parse, now は newLISP 組込関数と名前が同じです。通常、組込関数名は変数名にも関数名にも使えませんが、コンテキスト内でコンテキスト名を先付けして

jdate:list, jdate:parse, jdate:now

　とすれば、定義できます。
　また、これらを定義した場合、同名の newLISP 組込関数の呼び出しには、

MAIN:list, MAIN:parse, MAIN:now

　と書く必要もあります。
　それさえ気を付ければ、使いたい変数名や関数名が newLISP 組込関数名と同じだと嘆く必要はありません。まあ、そんなことは、無いでしょうけど（笑）
　この点が今回実装のポイントの一つです。
　さて、日付間の日本語化、前にも実装したことがあります。
　今回、敢えて実装したのは、前述のようにコンテキストにまとめたかったのと、2038年問題にも対応しておこうと思ったからです。
　newLISP は標準ライブラリを使って、あらゆるプラットフォームでの互換性を維持しています。そのため、日付に関する経過秒数を表現する型 time_t は、符号つき 32 ビットで 2038年1月19日3時14分7秒 までしか表現できません。これは、 64 ビット版 newLISP でも同じで、互換性維持のためだと思いますが、敢えて符号つき 32 ビットを使っています。
　だから、これは仕様です。まあ、あと20年はありますから、それまでに解決されるでしょうけど、、、
　それでも、20年くらい先はまだ生きていると思うので、その頃の予定を立てることがあるかもしれません。だから、取り敢えず、符号なし 32 ビット （2106年2月7日6時28分15秒相当）で実装してみました。本来なら、64 ビットで定義すべきですが、2100 年以降の予定なんて考えないから、これで十分かと（笑）
　calcDateValue と gmtime が、そのための関数です。
　一応、

> (jdate:value 2038 1 8)
2146489200
> (jdate:value 2106 2 6)
4294825200
> (jdate:parse "2106.2.6 6:28" "%Y.%m.%d %H:%M")
4294848480
> (jdate:list (jdate:parse "2106.2.6 6:28" "%Y.%m.%d %H:%M"))
(2106 2 6 6 28 0 37 6)
> 

　こんな感じで、使えます。

　以上、如何でしょうか？

追記：
　V10.7.0 の windoows 版で now を実行すると

> (now)
(2016 3 16 8 54 40 297940 76 3 600 -60)
> 

　このように、タイムゾーンのオフセット（分単位）が 600 となります。
　日本では 540 のはずなので、V10.7.0 の windoows 版のバグです。
　この点については Lutz氏 もわかっていて、次回、訂正されるそうです。
　それまで、ご注意を。

日付関数の日本語化

　newLISP の日付関数には、date, date-list, date-parse, date-value, now 等がありますが、date 以外はグリニッジ標準時なので、日本時間で使うには補正が必要です。
　また、date も

> (date)
"Tue Mar 15 16:00:19 2016"
> 

　こんな風に、英語表記です。
　そこで、日本語表記、日本時間用の日付関数を定義してみました。

(context 'MAIN:jdate)
(setq YEAR0 1900 EPOCH_YR 1970 SECS_DAY (* 24 60 60))
(define (calcDateValue year month day (hour 0) (int-min 0) (sec 0))
; Algorithm quoting from newLISP source.
  (let (dateValue)
    (setq dateValue (+ (* 367 year) (- (/ (* 7 (+ year (/ (+ month 9) 12))) 4)) (/ (* 275 month) 9) day 1721013))
    (setq dateValue (+ (* dateValue 24 3600) (* hour 3600) (* int-min 60) sec -413319296)) 
    (setq dateValue (& dateValue 0xFFFFFFFF))
    (if (>= dateValue 4107596400) (-- dateValue 86400) dateValue)))
(define (leap (y ((now) 0)))
  (if (and (zero? (% y 4))
       (or (zero? (% y 400))
           (not (zero? (% y 100))))) 1 0))
(define (yearsize year) (+ (leap year) 365))
(define _ytab '((31 28 31 30 31 30 31 31 30 31 30 31)(31 29 31 30 31 30 31 31 30 31 30 31)))
(define (gmtime tm)
; Algorithm quoting from common C-library source.
  (letn (year EPOCH_YR
         dayclock (% tm SECS_DAY)
         dayno (/ tm SECS_DAY)
         tm_sec (% dayclock 60)
         tm_min (/ (% dayclock 3600) 60)
         tm_hour (/ dayclock 3600)
         tm_wday (% (+ 4 dayno) 7))
    (while (>= dayno (yearsize year)) 
      (-- dayno (yearsize year))
      (++ year))
    (let (tm_year (- year 0); YEAR0
          tm_yday dayno
          tm_mon 0
          tm_mday 1)
       (while (>= dayno (_ytab (leap year) tm_mon))
         (-- dayno (_ytab (leap year) tm_mon))
         (++ tm_mon))
       (++ tm_mday dayno)
       (if (= tm_wday 0) (++ tm_wday 7))
       (list tm_year (++ tm_mon) tm_mday tm_hour tm_min tm_sec (++ tm_yday) tm_wday))))
(define (jdate:now (offset 540) idx)
  (if idx (MAIN:now offset idx) (MAIN:now offset)))
(define (jdate:value)
  (if (args) (- (apply calcDateValue (args)) (* 9 60 60))
    (date-value)))
(define (jdate:list (sec (jdate:value)) idx)
  (letn (offset (* 9 60 60)
         lst (gmtime (+ sec offset)))
    (if idx (idx lst) lst)))
(define (jdate:jdate (value (jdate:value)))
  (let (lst (jdate:list value)
        str (if utf8 '(227 128 63 230 156 136 231 129 171 230 176 180 230 156 168 233 135 145 229 156 159 
 230 151 165)
                     '(129 64 140 142 137 206 144 133 150 216 139 224 147 121 147 250)))
    (append (join (map string (0 3 lst)) "/") " "
            (join (map string (3 3 lst)) ":") " "
            (if utf8 ((* 3 (lst 7)) 3 (pack (dup "b" (length str)) str))
                     ((* 2 (lst 7)) 2 (pack (dup "b" (length str)) str))))))
(define (jdate:parse dateStr formatStr , res)
  (if (= formatStr "%c") (setq formatStr "%m/%d/%y %H:%M:%S"))
  (let (specs (find-all "(%.)" formatStr)
        regStr (replace "(%.)" (replace "." formatStr "\\.") "(.+)" 0)
        months '("" "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")
        Months '("" "January" "February" "March" "April" "May" "June" 
                 "July" "August" "September" "October" "November" "December")
        dateLst '(1900 1 1 0 0 0))
    (setq res (regex regStr dateStr))
    (when res 
       (setq res (rest (filter string? res)))
       (when (= (length specs) (length res))
          (dolist (i (transpose (MAIN:list specs res)))
             (case (i 0) 
               ("%b" (setf (dateLst 1) (find (i 1) months 1)))
               ("%B" (setf (dateLst 1) (find (i 1) Months 1)))
               ("%d" (setf (dateLst 2) (int (i 1) 0 10)))
               ("%H" (setf (dateLst 3) (int (i 1) 0 10)))
               ("%m" (setf (dateLst 1) (int (i 1) 0 10)))
               ("%M" (setf (dateLst 4) (int (i 1) 0 10)))
               ("%S" (setf (dateLst 5) (int (i 1) 0 10)))
               ("%Y" (setf (dateLst 0) (int (i 1) 0 10)))
               ("%y" (setf (dateLst 0) (int (string "20" (i 1)))))
               (true )))))
  (if-not (find nil dateLst) (apply jdate:value dateLst))))
(context MAIN)

　使える関数は、jdate, jdate:list, jdate:parse, jdate:value, jdate:now で、それぞれ date, date-list, date-parse, date-value, now に対応します。
　使い方は、

> (jdate)
"2016/3/16 17:8:15 火"
> (jdate:list)
(2016 3 16 17 8 23 75 2)
> (jdate:value 2016 3 16)
1458054000
> (jdate:now)
(2016 3 15 17 8 48 630885 75 2 600 -60)
> (jdate:parse "2010.10.18 7:00" "%Y.%m.%d %H:%M")
1287352800
> (jdate:list (jdate:parse "2010.10.18 7:00" "%Y.%m.%d %H:%M"))
(2010 10 18 7 0 0 291 1)
> 

　こんな感じ、解説は次回に、、、

追記：2020/ 7/13
関数 gmatime 修正(tm_wday)
関数 parse 修正(months)