modules/ml-time.cc

   1 #include "ml-time.h"
   2 #include "ml.h"
   3 #include "mlenv.h"
   4 #include "motorenv.h"
   5 #include "expr.h"
   6 #include "util_const.h"
   7 #include "util_time.h"
   8 #include <exception>
   9 #include <time.h>
  10 #include <string.h>
  11
  12 /*DOC:
  13 ==time function==
  14
  15 */
  16 static MNode*  timeval6 (struct tm* v) {
  17     MNodeList  ans;
  18
  19     ans.append (newMNode_num (v->tm_year + 1900));
  20     ans.append (newMNode_num (v->tm_mon + 1));
  21     ans.append (newMNode_num (v->tm_mday));
  22     ans.append (newMNode_num (v->tm_hour));
  23     ans.append (newMNode_num (v->tm_min));
  24     ans.append (newMNode_num (v->tm_sec));
  25
  26     return ans.release ();
  27 }
  28
  29 static MNode*  dateval7 (struct tm* v) {
  30     MNodeList  ans;
  31
  32     ans.append (newMNode_num (v->tm_year + 1900));
  33     ans.append (newMNode_num (v->tm_mon + 1));
  34     ans.append (newMNode_num (v->tm_mday));
  35     ans.append (newMNode_num (v->tm_wday));
  36     ans.append (newMNode_num (v->tm_hour));
  37     ans.append (newMNode_num (v->tm_min));
  38     ans.append (newMNode_num (v->tm_sec));
  39
  40     return ans.release ();
  41 }
  42
  43 static MNode*  timeval3 (struct tm* v) {
  44     MNodeList  ans;
  45
  46     ans.append (newMNode_num (v->tm_hour));
  47     ans.append (newMNode_num (v->tm_min));
  48     ans.append (newMNode_num (v->tm_sec));
  49
  50     return ans.release ();
  51 }
  52
  53 /*DOC:
  54 ===now===
  55  (now) -> INTEGER
  56
  57 */
  58 //#AFUNC        now     ml_now
  59 //#WIKIFUNC     now
  60 MNode*  ml_now (MNode* cell, MlEnv* mlenv) {
  61     MNode*  arg = cell->cdr ();
  62     time_t  tm;
  63
  64     if (arg)
  65         throw (uErrorWrongNumber);
  66
  67     tm = now ();
  68     return newMNode_num (tm);
  69 }
  70
  71 /*DOC:
  72 ===now-microsec===
  73  (now-microsec) -> SECOND.MICROSECOND
  74
  75 */
  76 //#AFUNC        now-microsec    ml_now_microsec
  77 //#WIKIFUNC     now-microsec
  78 MNode*  ml_now_microsec (MNode* cell, MlEnv* mlenv) {
  79     MNode*  arg = cell->cdr ();
  80
  81     if (arg)
  82         throw (uErrorWrongNumber);
  83
  84     return newMNode_num (now_microsec ());
  85 }
  86
  87 /*DOC:
  88 ===to-date===
  89  (to-date INTEGER) -> (YEAR MONTH DAY HOUR MINUTE SECOND)
  90
  91 */
  92 //#AFUNC        to-date ml_datetime3
  93 //#WIKIFUNC     to-date
  94 MNode*  ml_datetime3 (MNode* cell, MlEnv* mlenv) {
  95     MNode*  arg = cell->cdr ();
  96     time_t  tm;
  97     struct tm  v;
  98
  99     if (!arg)
 100         throw (uErrorWrongNumber);
 101     tm = (time_t)eval_double (arg->car (), mlenv);
 102     nextNode (arg);
 103     if (arg)
 104         throw (uErrorWrongNumber);
 105
 106     localtime_r (&tm, &v);
 107
 108     return timeval6 (&v);
 109 }
 110
 111 /*DOC:
 112 ===to-date4===
 113  (to-date4 INTEGER) -> (YEAR MONTH DAY WEEK HOUR MINUTE SECOND)
 114
 115 */
 116 //#AFUNC        to-date4        ml_date4
 117 //#WIKIFUNC     to-date4
 118 MNode*  ml_date4 (MNode* cell, MlEnv* mlenv) {
 119     MNode*  arg = cell->cdr ();
 120     time_t  tm;
 121     struct tm  v;
 122
 123     if (!arg)
 124         throw (uErrorWrongNumber);
 125     tm = (time_t)eval_double (arg->car (), mlenv);
 126     nextNode (arg);
 127     if (arg)
 128         throw (uErrorWrongNumber);
 129
 130     localtime_r (&tm, &v);
 131
 132     return dateval7 (&v);
 133 }
 134
 135 /*DOC:
 136 ===to-time===
 137  (to-time INTEGER) -> (HOUR MINUTE SECOND)
 138
 139 */
 140 //#AFUNC        to-time ml_time3
 141 //#WIKIFUNC     to-time
 142 MNode*  ml_time3 (MNode* cell, MlEnv* mlenv) {
 143     MNode*  arg = cell->cdr ();
 144     MNodePtr  ans;
 145     time_t  tm;
 146     struct tm  v;
 147     MNode*  c;
 148
 149     if (!arg)
 150         throw (uErrorWrongNumber);
 151     tm = (time_t)eval_double (arg->car (), mlenv);
 152     nextNode (arg);
 153     if (arg)
 154         throw (uErrorWrongNumber);
 155
 156     localtime_r (&tm, &v);
 157
 158     return timeval3 (&v);
 159 }
 160
 161 /*DOC:
 162 ===date-to-time===
 163  (date-to-time YEAR MONTH DAY [HOUR [MINUTE [SECOND]]]) -> NUMBER
 164  (date-to-time (YEAR MONTH DAY [HOUR [MINUTE [SECOND]]])) -> NUMBER
 165
 166 */
 167 //#AFUNC        date-to-time    ml_datetotime
 168 //#WIKIFUNC     date-to-time
 169 MNode*  ml_datetotime (MNode* cell, MlEnv* mlenv) {
 170     MNode*  arg = cell->cdr ();
 171     struct tm  tm;
 172     MNodePtr  v;
 173
 174     memset (&tm, 0, sizeof (tm));
 175
 176     if (!arg)
 177         throw (uErrorWrongNumber);
 178
 179     v = eval (arg->car (), mlenv);
 180     nextNode (arg);
 181     if (v () && v ()->isCons ()) {
 182         if (arg)
 183             throw (uErrorWrongNumber);
 184         arg = v ();
 185         tm.tm_year = eval_int (arg->car (), mlenv) - 1900;
 186         nextNodeNonNil (arg);
 187     } else {
 188         tm.tm_year = to_int (v ()) - 1900;
 189         if (!arg)
 190             throw (uErrorWrongNumber);
 191     }
 192     tm.tm_mon = eval_int (arg->car (), mlenv) - 1;
 193     nextNodeNonNil (arg);
 194     tm.tm_mday = eval_int (arg->car (), mlenv);
 195     nextNode (arg);
 196     if (arg) {
 197         tm.tm_hour = eval_int (arg->car (), mlenv);
 198         nextNode (arg);
 199     }
 200     if (arg) {
 201         tm.tm_min = eval_int (arg->car (), mlenv);
 202         nextNode (arg);
 203     }
 204     if (arg) {
 205         tm.tm_sec = eval_int (arg->car (), mlenv);
 206         nextNode (arg);
 207     }
 208     if (arg)
 209         throw (uErrorWrongNumber);
 210
 211     return newMNode_num (mktime (&tm));
 212 }
 213
 214 /*DOC:
 215 ===to-gmdate===
 216  (to-gmdate INTEGER) -> (YEAR MONTH DAY HOUR MINUTE SECOND)
 217
 218 */
 219 //#AFUNC        to-gmdate       ml_gmdatetime3
 220 //#WIKIFUNC     to-gmdate
 221 MNode*  ml_gmdatetime3 (MNode* cell, MlEnv* mlenv) {
 222     MNode*  arg = cell->cdr ();
 223     MNodePtr  ans;
 224     time_t  tm;
 225     struct tm  v;
 226     MNode*  c;
 227
 228     if (!arg)
 229         throw (uErrorWrongNumber);
 230     tm = (time_t)eval_double (arg->car (), mlenv);
 231     nextNode (arg);
 232     if (arg)
 233         throw (uErrorWrongNumber);
 234
 235     gmtime_r (&tm, &v);
 236
 237     return timeval6 (&v);
 238 }
 239
 240 /*DOC:
 241 ===to-gmdate4===
 242  (to-gmdate4 INTEGER) -> (YEAR MONTH DAY WEEK HOUR MINUTE SECOND)
 243
 244 */
 245 //#AFUNC        to-gmdate4      ml_gmdate4
 246 //#WIKIFUNC     to-gmdate4
 247 MNode*  ml_gmdate4 (MNode* cell, MlEnv* mlenv) {
 248     MNode*  arg = cell->cdr ();
 249     time_t  tm;
 250     struct tm  v;
 251
 252     if (!arg)
 253         throw (uErrorWrongNumber);
 254     tm = (time_t)eval_double (arg->car (), mlenv);
 255     nextNode (arg);
 256     if (arg)
 257         throw (uErrorWrongNumber);
 258
 259     gmtime_r (&tm, &v);
 260
 261     return dateval7 (&v);
 262 }
 263
 264 /*DOC:
 265 ===to-gmtime===
 266  (to-gmtime INTEGER) -> (HOUR MINUTE SECOND)
 267
 268 */
 269 //#AFUNC        to-gmtime       ml_gmtime3
 270 //#WIKIFUNC     to-gmtime
 271 MNode*  ml_gmtime3 (MNode* cell, MlEnv* mlenv) {
 272     MNode*  arg = cell->cdr ();
 273     MNodePtr  ans;
 274     time_t  tm;
 275     struct tm  v;
 276     MNode*  c;
 277
 278     if (!arg)
 279         throw (uErrorWrongNumber);
 280     tm = (time_t)eval_double (arg->car (), mlenv);
 281     nextNode (arg);
 282     if (arg)
 283         throw (uErrorWrongNumber);
 284
 285     gmtime_r (&tm, &v);
 286
 287     return timeval3 (&v);
 288 }
 289
 290 /*DOC:
 291 ===gmdate-to-time===
 292  (gmdate-to-time YEAR MONTH DAY [HOUR [MINUTE [SECOND]]]) -> NUMBER
 293  (gmdate-to-time (YEAR MONTH DAY [HOUR [MINUTE [SECOND]]])) -> NUMBER
 294
 295 */
 296 //#AFUNC        gmdate-to-time  ml_gmdatetotime
 297 //#WIKIFUNC     gmdate-to-time
 298 MNode*  ml_gmdatetotime (MNode* cell, MlEnv* mlenv) {
 299     MNode*  arg = cell->cdr ();
 300     struct tm  tm;
 301     MNodePtr  v;
 302
 303     memset (&tm, 0, sizeof (tm));
 304
 305     if (!arg)
 306         throw (uErrorWrongNumber);
 307
 308     v = eval (arg->car (), mlenv);
 309     nextNode (arg);
 310     if (v () && v ()->isCons ()) {
 311         if (arg)
 312             throw (uErrorWrongNumber);
 313         arg = v ();
 314         tm.tm_year = eval_int (arg->car (), mlenv) - 1900;
 315         nextNodeNonNil (arg);
 316     } else {
 317         tm.tm_year = to_int (v ()) - 1900;
 318         if (!arg)
 319             throw (uErrorWrongNumber);
 320     }
 321     tm.tm_mon = eval_int (arg->car (), mlenv) - 1;
 322     nextNodeNonNil (arg);
 323     tm.tm_mday = eval_int (arg->car (), mlenv);
 324     nextNode (arg);
 325     if (arg) {
 326         tm.tm_hour = eval_int (arg->car (), mlenv);
 327         nextNode (arg);
 328     }
 329     if (arg) {
 330         tm.tm_min = eval_int (arg->car (), mlenv);
 331         nextNode (arg);
 332     }
 333     if (arg) {
 334         tm.tm_sec = eval_int (arg->car (), mlenv);
 335         nextNode (arg);
 336     }
 337     if (arg)
 338         throw (uErrorWrongNumber);
 339
 340     return newMNode_num (timegm (&tm));
 341 }
 342