summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog20
-rw-r--r--eval.c14
-rw-r--r--lib.c122
-rw-r--r--lib.h19
4 files changed, 171 insertions, 4 deletions
diff --git a/ChangeLog b/ChangeLog
index de4a6333..736c351d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,25 @@
2013-11-28 Kaz Kylheku <kaz@kylheku.com>
+ Extending intrinsic functions to go up to 7 arguments.
+ Adding wrapper for mktime.
+
+ * eval.c (apply): Handle function codes N5 through N7.
+ (eval_init): Register make_time as intrinsic.
+
+ * lib.c (auto_k): New keyword symbol variable.
+ (equal, generic_funcall): Handle N5-N7.
+ (func_n5, func_n6, func_n7, func_n5v, func_n6v, func_n7v): New
+ functions.
+ (obj_init): Initialize auto_k.
+ (make_time): New function.
+
+ * lib.h (functype_t): New enum members: N5, N6, N7.
+ (struct func): New members: n5, n6, n7, n5v, n6v, n7v.
+ (auto_k, func_n5, func_n6, func_n7, func_n5v, func_n6v, func_n7v,
+ make_time): Declared.
+
+2013-11-28 Kaz Kylheku <kaz@kylheku.com>
+
* stream.c (make_stdio_stream_common): Initialize new
mode member of struct stdio_ops to nil.
diff --git a/eval.c b/eval.c
index 003a0623..defed7e9 100644
--- a/eval.c
+++ b/eval.c
@@ -317,6 +317,12 @@ val apply(val fun, val arglist, val ctx_form)
return fun->f.f.n3(arg[0], arg[1], arg[2]);
case N4:
return fun->f.f.n4(arg[0], arg[1], arg[2], arg[3]);
+ case N5:
+ return fun->f.f.n5(arg[0], arg[1], arg[2], arg[3], arg[4]);
+ case N6:
+ return fun->f.f.n6(arg[0], arg[1], arg[2], arg[3], arg[4], arg[5]);
+ case N7:
+ return fun->f.f.n7(arg[0], arg[1], arg[2], arg[3], arg[4], arg[5], arg[6]);
case FINTERP:
internal_error("unsupported function type");
}
@@ -356,6 +362,12 @@ val apply(val fun, val arglist, val ctx_form)
return fun->f.f.n3v(arg[0], arg[1], arg[2], arglist);
case N4:
return fun->f.f.n4v(arg[0], arg[1], arg[2], arg[3], arglist);
+ case N5:
+ return fun->f.f.n5v(arg[0], arg[1], arg[2], arg[3], arg[4], arglist);
+ case N6:
+ return fun->f.f.n6v(arg[0], arg[1], arg[2], arg[3], arg[4], arg[5], arglist);
+ case N7:
+ return fun->f.f.n7v(arg[0], arg[1], arg[2], arg[3], arg[4], arg[5], arg[6], arglist);
}
}
@@ -2518,7 +2530,7 @@ void eval_init(void)
reg_fun(intern(lit("time-usec"), user_package), func_n0(time_sec_usec));
reg_fun(intern(lit("time-string-local"), user_package), func_n2(time_string_local));
reg_fun(intern(lit("time-string-utc"), user_package), func_n2(time_string_utc));
-
+ reg_fun(intern(lit("make-time"), user_package), func_n7(make_time));
reg_fun(intern(lit("source-loc"), user_package), func_n1(source_loc));
reg_fun(intern(lit("source-loc-str"), user_package), func_n1(source_loc_str));
diff --git a/lib.c b/lib.c
index 35c8296b..ad5b4b94 100644
--- a/lib.c
+++ b/lib.c
@@ -80,7 +80,7 @@ val error_s, type_error_s, internal_error_s;
val numeric_error_s, range_error_s;
val query_error_s, file_error_s, process_error_s;
-val nothrow_k, args_k, colon_k;
+val nothrow_k, args_k, colon_k, auto_k;
val null_string;
val nil_string;
@@ -974,6 +974,9 @@ val equal(val left, val right)
case N2: return (left->f.f.n2 == right->f.f.n2) ? t : nil;
case N3: return (left->f.f.n3 == right->f.f.n3) ? t : nil;
case N4: return (left->f.f.n4 == right->f.f.n4) ? t : nil;
+ case N5: return (left->f.f.n5 == right->f.f.n5) ? t : nil;
+ case N6: return (left->f.f.n6 == right->f.f.n6) ? t : nil;
+ case N7: return (left->f.f.n7 == right->f.f.n7) ? t : nil;
}
return nil;
}
@@ -2664,6 +2667,45 @@ val func_n4(val (*fun)(val, val, val, val))
return obj;
}
+val func_n5(val (*fun)(val, val, val, val, val))
+{
+ val obj = make_obj();
+ obj->f.type = FUN;
+ obj->f.functype = N5;
+ obj->f.env = nil;
+ obj->f.f.n5 = fun;
+ obj->f.variadic = 0;
+ obj->f.fixparam = 5;
+ obj->f.optargs = 0;
+ return obj;
+}
+
+val func_n6(val (*fun)(val, val, val, val, val, val))
+{
+ val obj = make_obj();
+ obj->f.type = FUN;
+ obj->f.functype = N6;
+ obj->f.env = nil;
+ obj->f.f.n6 = fun;
+ obj->f.variadic = 0;
+ obj->f.fixparam = 6;
+ obj->f.optargs = 0;
+ return obj;
+}
+
+val func_n7(val (*fun)(val, val, val, val, val, val, val))
+{
+ val obj = make_obj();
+ obj->f.type = FUN;
+ obj->f.functype = N7;
+ obj->f.env = nil;
+ obj->f.f.n7 = fun;
+ obj->f.variadic = 0;
+ obj->f.fixparam = 7;
+ obj->f.optargs = 0;
+ return obj;
+}
+
val func_f0v(val env, val (*fun)(val, val))
{
val obj = make_obj();
@@ -2794,6 +2836,45 @@ val func_n4v(val (*fun)(val, val, val, val, val rest))
return obj;
}
+val func_n5v(val (*fun)(val, val, val, val, val, val rest))
+{
+ val obj = make_obj();
+ obj->f.type = FUN;
+ obj->f.functype = N5;
+ obj->f.env = nil;
+ obj->f.f.n5v = fun;
+ obj->f.variadic = 1;
+ obj->f.fixparam = 5;
+ obj->f.optargs = 0;
+ return obj;
+}
+
+val func_n6v(val (*fun)(val, val, val, val, val, val, val rest))
+{
+ val obj = make_obj();
+ obj->f.type = FUN;
+ obj->f.functype = N6;
+ obj->f.env = nil;
+ obj->f.f.n6v = fun;
+ obj->f.variadic = 1;
+ obj->f.fixparam = 6;
+ obj->f.optargs = 0;
+ return obj;
+}
+
+val func_n7v(val (*fun)(val, val, val, val, val, val, val, val rest))
+{
+ val obj = make_obj();
+ obj->f.type = FUN;
+ obj->f.functype = N7;
+ obj->f.env = nil;
+ obj->f.f.n7v = fun;
+ obj->f.variadic = 1;
+ obj->f.fixparam = 7;
+ obj->f.optargs = 0;
+ return obj;
+}
+
val func_n0o(val (*fun)(void), int reqargs)
{
val obj = func_n0(fun);
@@ -2908,6 +2989,12 @@ static val generic_funcall(val fun, val arg[], int nargs)
return fun->f.f.n3(arg[0], arg[1], arg[2]);
case N4:
return fun->f.f.n4(arg[0], arg[1], arg[2], arg[3]);
+ case N5:
+ return fun->f.f.n5(arg[0], arg[1], arg[2], arg[3], arg[4]);
+ case N6:
+ return fun->f.f.n6(arg[0], arg[1], arg[2], arg[3], arg[4], arg[5]);
+ case N7:
+ return fun->f.f.n7(arg[0], arg[1], arg[2], arg[3], arg[4], arg[5], arg[6]);
case FINTERP:
internal_error("unsupported function type");
}
@@ -2949,6 +3036,12 @@ static val generic_funcall(val fun, val arg[], int nargs)
return fun->f.f.n3v(arg[0], arg[1], arg[2], arglist);
case N4:
return fun->f.f.n4v(arg[0], arg[1], arg[2], arg[3], arglist);
+ case N5:
+ return fun->f.f.n5v(arg[0], arg[1], arg[2], arg[3], arg[4], arglist);
+ case N6:
+ return fun->f.f.n6v(arg[0], arg[1], arg[2], arg[3], arg[4], arg[5], arglist);
+ case N7:
+ return fun->f.f.n7v(arg[0], arg[1], arg[2], arg[3], arg[4], arg[5], arg[6], arglist);
}
}
@@ -4593,6 +4686,7 @@ static void obj_init(void)
args_k = intern(lit("args"), keyword_package);
nothrow_k = intern(lit("nothrow"), keyword_package);
colon_k = intern(lit(""), keyword_package);
+ auto_k = intern(lit("auto"), keyword_package);
equal_f = func_n2(equal);
eq_f = func_n2(eq);
@@ -4933,6 +5027,32 @@ val time_string_utc(val time, val format)
return timestr;
}
+val make_time(val year, val month, val day,
+ val hour, val minute, val second,
+ val isdst)
+{
+ struct tm local = { 0 };
+ time_t time;
+
+ local.tm_year = c_num(year) - 1900;
+ local.tm_mon = c_num(month) + 1;
+ local.tm_mday = c_num(day);
+ local.tm_hour = c_num(hour);
+ local.tm_min = c_num(minute);
+ local.tm_sec = c_num(second);
+
+ if (!isdst)
+ local.tm_isdst = 0;
+ else if (isdst == auto_k)
+ local.tm_isdst = -1;
+ else
+ local.tm_isdst = 1;
+
+ time = mktime(&local);
+
+ return time == -1 ? nil : num(time);
+}
+
void init(const wchar_t *pn, mem_t *(*oom)(mem_t *, size_t),
val *stack_bottom)
{
diff --git a/lib.h b/lib.h
index 231d830b..ac791ae9 100644
--- a/lib.h
+++ b/lib.h
@@ -52,7 +52,7 @@ typedef enum functype
{
FINTERP, /* Interpreted function. */
F0, F1, F2, F3, F4, /* Intrinsic functions with env. */
- N0, N1, N2, N3, N4 /* No-env intrinsics. */
+ N0, N1, N2, N3, N4, N5, N6, N7 /* No-env intrinsics. */
} functype_t;
typedef union obj obj_t;
@@ -121,6 +121,9 @@ struct func {
val (*n2)(val, val);
val (*n3)(val, val, val);
val (*n4)(val, val, val, val);
+ val (*n5)(val, val, val, val, val);
+ val (*n6)(val, val, val, val, val, val);
+ val (*n7)(val, val, val, val, val, val, val);
val (*f0v)(val, val);
val (*f1v)(val, val, val);
val (*f2v)(val, val, val, val);
@@ -131,6 +134,9 @@ struct func {
val (*n2v)(val, val, val);
val (*n3v)(val, val, val, val);
val (*n4v)(val, val, val, val, val);
+ val (*n5v)(val, val, val, val, val, val);
+ val (*n6v)(val, val, val, val, val, val, val);
+ val (*n7v)(val, val, val, val, val, val, val, val);
} f;
};
@@ -327,7 +333,7 @@ extern val error_s, type_error_s, internal_error_s;
extern val numeric_error_s, range_error_s;
extern val query_error_s, file_error_s, process_error_s;
-extern val nothrow_k, args_k, colon_k;
+extern val nothrow_k, args_k, colon_k, auto_k;
extern val null_string;
extern val null_list; /* (nil) */
@@ -557,6 +563,9 @@ val func_n1(val (*fun)(val));
val func_n2(val (*fun)(val, val));
val func_n3(val (*fun)(val, val, val));
val func_n4(val (*fun)(val, val, val, val));
+val func_n5(val (*fun)(val, val, val, val, val));
+val func_n6(val (*fun)(val, val, val, val, val, val));
+val func_n7(val (*fun)(val, val, val, val, val, val, val));
val func_f0v(val, val (*fun)(val env, val rest));
val func_f1v(val, val (*fun)(val env, val, val rest));
val func_f2v(val, val (*fun)(val env, val, val, val rest));
@@ -567,6 +576,9 @@ val func_n1v(val (*fun)(val, val rest));
val func_n2v(val (*fun)(val, val, val rest));
val func_n3v(val (*fun)(val, val, val, val rest));
val func_n4v(val (*fun)(val, val, val, val, val rest));
+val func_n5v(val (*fun)(val, val, val, val, val, val rest));
+val func_n6v(val (*fun)(val, val, val, val, val, val, val rest));
+val func_n7v(val (*fun)(val, val, val, val, val, val, val, val rest));
val func_n0o(val (*fun)(void), int reqargs);
val func_n1o(val (*fun)(val), int reqargs);
val func_n2o(val (*fun)(val, val), int reqargs);
@@ -667,6 +679,9 @@ val time_sec(void);
val time_sec_usec(void);
val time_string_local(val time, val format);
val time_string_utc(val time, val format);
+val make_time(val year, val month, val day,
+ val hour, val minute, val second,
+ val isdst);
void init(const wchar_t *progname, mem_t *(*oom_realloc)(mem_t *, size_t),
val *stack_bottom);
generated by cgit v1.2.3 (git 2.25.1) at 2025-04-09 18:03:01 +0000