From 93f0e3d10580b0a8126018d0a05dd46b1aa84bf6 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 4 Apr 2017 00:08:01 -0700
Subject: New time-parse-local and time-parse-utc functions.

* eval.c (eval_init): Register intrinsic functions
time-parse-local and time-parse-utc.

* lib.c (strptime_wrap): New static function.
(time_parse): Now implemented as by call to strptime_wrap.
(time_parse_local, time_parse_utc): New functions.
These get the time_t time from struct tm without
constructing the intermediate Lisp structure.

* lib.h (time_parse_local, time_parse_utc): Declared.

* txr.1: Documented new functions.
---
 eval.c |  2 ++
 lib.c  | 32 +++++++++++++++++++++++++++++---
 lib.h  |  2 ++
 txr.1  | 26 +++++++++++++++++++++++---
 4 files changed, 56 insertions(+), 6 deletions(-)

diff --git a/eval.c b/eval.c
index 1584bd94..4b2f32f9 100644
--- a/eval.c
+++ b/eval.c
@@ -6133,6 +6133,8 @@ void eval_init(void)
   reg_fun(intern(lit("make-time"), user_package), func_n7(make_time));
   reg_fun(intern(lit("make-time-utc"), user_package), func_n7(make_time_utc));
   reg_fun(intern(lit("time-parse"), user_package), func_n2(time_parse));
+  reg_fun(intern(lit("time-parse-local"), user_package), func_n2(time_parse_local));
+  reg_fun(intern(lit("time-parse-utc"), user_package), func_n2(time_parse_utc));
 
   reg_fun(intern(lit("source-loc"), user_package), func_n1(source_loc));
   reg_fun(intern(lit("source-loc-str"), user_package), func_n2o(source_loc_str, 1));
diff --git a/lib.c b/lib.c
index e578b308..172a39d8 100644
--- a/lib.c
+++ b/lib.c
@@ -10657,17 +10657,23 @@ static struct tm epoch_tm(void)
   return ep;
 }
 
-val time_parse(val format, val string)
+static int strptime_wrap(val string, val format, struct tm *ptms)
 {
-  struct tm tms = epoch_tm();
   const wchar_t *w_str = c_str(string);
   const wchar_t *w_fmt = c_str(format);
   char *str = utf8_dup_to(w_str);
   char *fmt = utf8_dup_to(w_fmt);
-  char *ptr = strptime(str, fmt, &tms);
+  char *ptr = strptime(str, fmt, ptms);
   int ret = ptr != 0;
   free(fmt);
   free(str);
+  return ret;
+}
+
+val time_parse(val format, val string)
+{
+  struct tm tms = epoch_tm();
+  int ret = strptime_wrap(string, format, &tms);
   return ret ? broken_time_struct(&tms) : nil;
 }
 
@@ -10787,6 +10793,26 @@ static val time_parse_meth(val time_struct, val format, val string)
   return ret;
 }
 
+val time_parse_local(val format, val string)
+{
+  struct tm tms = epoch_tm();
+  if (!strptime_wrap(string, format, &tms))
+    return nil;
+  return num(mktime(&tms));
+}
+
+val time_parse_utc(val format, val string)
+{
+  struct tm tms = epoch_tm();
+  if (!strptime_wrap(string, format, &tms))
+    return nil;
+#if HAVE_TIMEGM
+  return num(timegm(&tms));
+#else
+  return num(timegm_hack(&tms));
+#endif
+}
+
 #endif
 
 static void time_init(void)
diff --git a/lib.h b/lib.h
index 4d359f60..c9456cca 100644
--- a/lib.h
+++ b/lib.h
@@ -1038,6 +1038,8 @@ val make_time_utc(val year, val month, val day,
                   val isdst);
 #if HAVE_STRPTIME
 val time_parse(val format, val string);
+val time_parse_local(val format, val string);
+val time_parse_utc(val format, val string);
 #endif
 
 void init(mem_t *(*oom_realloc)(mem_t *, size_t), val *stack_bottom);
diff --git a/txr.1 b/txr.1
index 4125f9a8..31f3d468 100644
--- a/txr.1
+++ b/txr.1
@@ -43587,9 +43587,11 @@ function or from the
 .code time-usec
 function.
 
-.coNP Function @ time-parse
+.coNP Functions @, time-parse @ time-parse-local and @ time-parse-utc
 .synb
 .mets (time-parse < format << string )
+.mets (time-parse-local < format << string )
+.mets (time-parse-utc < format << string )
 .syne
 .desc
 The
@@ -43620,8 +43622,26 @@ if interpreted in the UTC timezone as by the
 .meta time-utc
 method.
 
-Note: the availability of
-.code time-parse
+The
+.code time-parse-local
+and
+.code time-parse-utc
+functions return an integer time value: the same value
+that would be returned by the
+.code time-local
+and
+.code time-utc
+methods, respectively, when applied to the structure
+object returned by
+.codn time-parse .
+Thus, these equivalences hold:
+
+.cblk
+  (time-parse-local f s)  <-->  (time-parse f s).(time-local)
+  (time-parse-utc f s)  <-->  (time-parse f s).(time-utc)
+.cble
+
+Note: the availability of these three functions
 depends on the availability of
 .codn strptime .
 
-- 
cgit v1.2.3