Add a proper list accumulator utility in C
This commit is contained in:
parent
0e723587e5
commit
b33f6c9d76
80
c/env_unix.c
80
c/env_unix.c
|
@ -32,50 +32,40 @@ static const struct utsname *get_global_uname(void)
|
||||||
|
|
||||||
const char *env_get_os_name(void) { return get_global_uname()->sysname; }
|
const char *env_get_os_name(void) { return get_global_uname()->sysname; }
|
||||||
|
|
||||||
static void push(value_t *tailp, value_t elt)
|
|
||||||
{
|
|
||||||
value_t new_tail;
|
|
||||||
|
|
||||||
new_tail = cdr_(*tailp) = fl_cons(elt, FL_NIL);
|
|
||||||
*tailp = new_tail;
|
|
||||||
}
|
|
||||||
|
|
||||||
static void push_pair(value_t *tailp, const char *name, value_t value)
|
|
||||||
{
|
|
||||||
push(tailp, fl_cons(symbol(name), value));
|
|
||||||
}
|
|
||||||
|
|
||||||
static value_t envst_language(void)
|
static value_t envst_language(void)
|
||||||
{
|
{
|
||||||
value_t head, tail;
|
struct accum acc = ACCUM_EMPTY;
|
||||||
|
|
||||||
head = tail = fl_cons(symbol("language"), FL_NIL);
|
accum_elt(&acc, symbol("language"));
|
||||||
push_pair(&tail, "implementation-name", string_from_cstr("Up Scheme"));
|
accum_name_value(&acc, "implementation-name",
|
||||||
push_pair(&tail, "implementation-version", string_from_cstr("0.1.0"));
|
string_from_cstr("Up Scheme"));
|
||||||
return head;
|
accum_name_value(&acc, "implementation-version",
|
||||||
|
string_from_cstr("0.1.0"));
|
||||||
|
return acc.list;
|
||||||
}
|
}
|
||||||
|
|
||||||
static value_t envst_language_c(void)
|
static value_t envst_language_c(void)
|
||||||
{
|
{
|
||||||
value_t head, tail;
|
struct accum acc = ACCUM_EMPTY;
|
||||||
|
|
||||||
head = tail = fl_cons(symbol("language"), FL_NIL);
|
accum_elt(&acc, symbol("language"));
|
||||||
push_pair(&tail, "implementation-name",
|
accum_name_value(&acc, "implementation-name",
|
||||||
string_from_cstr(SCHEME_C_COMPILER_NAME));
|
string_from_cstr(SCHEME_C_COMPILER_NAME));
|
||||||
push_pair(&tail, "implementation-version",
|
accum_name_value(&acc, "implementation-version",
|
||||||
string_from_cstr(SCHEME_C_COMPILER_VERSION));
|
string_from_cstr(SCHEME_C_COMPILER_VERSION));
|
||||||
return head;
|
return acc.list;
|
||||||
}
|
}
|
||||||
|
|
||||||
static value_t envst_os(void)
|
static value_t envst_os(void)
|
||||||
{
|
{
|
||||||
value_t head, tail;
|
struct accum acc = ACCUM_EMPTY;
|
||||||
|
|
||||||
head = tail = fl_cons(symbol("os"), FL_NIL);
|
accum_elt(&acc, symbol("os"));
|
||||||
push_pair(&tail, "implementation-name",
|
accum_name_value(&acc, "implementation-name",
|
||||||
string_from_cstr(get_global_uname()->sysname));
|
string_from_cstr(get_global_uname()->sysname));
|
||||||
push_pair(&tail, "implementation-version",
|
accum_name_value(&acc, "implementation-version",
|
||||||
string_from_cstr(get_global_uname()->release));
|
string_from_cstr(get_global_uname()->release));
|
||||||
return head;
|
return acc.list;
|
||||||
}
|
}
|
||||||
|
|
||||||
static const char endianness[] =
|
static const char endianness[] =
|
||||||
|
@ -89,25 +79,25 @@ static const char endianness[] =
|
||||||
|
|
||||||
static value_t envst_computer(void)
|
static value_t envst_computer(void)
|
||||||
{
|
{
|
||||||
value_t head, tail;
|
struct accum acc = ACCUM_EMPTY;
|
||||||
|
|
||||||
head = tail = fl_cons(symbol("computer"), FL_NIL);
|
accum_elt(&acc, symbol("computer"));
|
||||||
push_pair(&tail, "architecture",
|
accum_name_value(&acc, "architecture",
|
||||||
string_from_cstr(get_global_uname()->machine));
|
string_from_cstr(get_global_uname()->machine));
|
||||||
push_pair(&tail, "cpu-bits", fixnum(sizeof(uintptr_t) * CHAR_BIT));
|
accum_name_value(&acc, "cpu-bits", fixnum(sizeof(uintptr_t) * CHAR_BIT));
|
||||||
push_pair(&tail, "byte-order", symbol(endianness));
|
accum_name_value(&acc, "byte-order", symbol(endianness));
|
||||||
return head;
|
return acc.list;
|
||||||
}
|
}
|
||||||
|
|
||||||
value_t builtin_environment_stack(value_t *args, uint32_t nargs)
|
value_t builtin_environment_stack(value_t *args, uint32_t nargs)
|
||||||
{
|
{
|
||||||
value_t head, tail;
|
struct accum acc = ACCUM_EMPTY;
|
||||||
|
|
||||||
(void)args;
|
(void)args;
|
||||||
argcount("environment-stack", nargs, 0);
|
argcount("environment-stack", nargs, 0);
|
||||||
head = tail = fl_cons(envst_language(), FL_NIL);
|
accum_elt(&acc, envst_language());
|
||||||
push(&tail, envst_language_c());
|
accum_elt(&acc, envst_language_c());
|
||||||
push(&tail, envst_os());
|
accum_elt(&acc, envst_os());
|
||||||
push(&tail, envst_computer());
|
accum_elt(&acc, envst_computer());
|
||||||
return head;
|
return acc.list;
|
||||||
}
|
}
|
||||||
|
|
16
c/scheme.h
16
c/scheme.h
|
@ -1002,6 +1002,22 @@ value_t fl_stringp(value_t *args, uint32_t nargs);
|
||||||
value_t fl_string_reverse(value_t *args, uint32_t nargs);
|
value_t fl_string_reverse(value_t *args, uint32_t nargs);
|
||||||
value_t fl_string_sub(value_t *args, uint32_t nargs);
|
value_t fl_string_sub(value_t *args, uint32_t nargs);
|
||||||
|
|
||||||
|
// util.c
|
||||||
|
|
||||||
|
struct accum {
|
||||||
|
value_t list;
|
||||||
|
value_t tail;
|
||||||
|
};
|
||||||
|
|
||||||
|
#define ACCUM_EMPTY \
|
||||||
|
{ \
|
||||||
|
.list = FL_NIL, .tail = FL_NIL \
|
||||||
|
}
|
||||||
|
|
||||||
|
void accum_elt(struct accum *accum, value_t elt);
|
||||||
|
void accum_pair(struct accum *accum, value_t a, value_t d);
|
||||||
|
void accum_name_value(struct accum *accum, const char *name, value_t value);
|
||||||
|
|
||||||
// boot_image.c
|
// boot_image.c
|
||||||
|
|
||||||
extern char boot_image[];
|
extern char boot_image[];
|
||||||
|
|
|
@ -37,6 +37,7 @@ o_files="$o_files table.o"
|
||||||
o_files="$o_files text_ini.o"
|
o_files="$o_files text_ini.o"
|
||||||
o_files="$o_files time_unix.o"
|
o_files="$o_files time_unix.o"
|
||||||
o_files="$o_files utf8.o"
|
o_files="$o_files utf8.o"
|
||||||
|
o_files="$o_files util.o"
|
||||||
default_cflags="-Wall -O2 -D NDEBUG -D USE_COMPUTED_GOTO -Wextra -std=gnu99 -Wno-strict-aliasing"
|
default_cflags="-Wall -O2 -D NDEBUG -D USE_COMPUTED_GOTO -Wextra -std=gnu99 -Wno-strict-aliasing"
|
||||||
default_lflags="-lm"
|
default_lflags="-lm"
|
||||||
case "$os" in
|
case "$os" in
|
||||||
|
@ -120,6 +121,7 @@ $CC $CFLAGS -c ../c/table.c
|
||||||
$CC $CFLAGS -c ../c/text_ini.c
|
$CC $CFLAGS -c ../c/text_ini.c
|
||||||
$CC $CFLAGS -c ../c/time_unix.c
|
$CC $CFLAGS -c ../c/time_unix.c
|
||||||
$CC $CFLAGS -c ../c/utf8.c
|
$CC $CFLAGS -c ../c/utf8.c
|
||||||
|
$CC $CFLAGS -c ../c/util.c
|
||||||
|
|
||||||
$CC $CFLAGS -c ../c/boot_image.c
|
$CC $CFLAGS -c ../c/boot_image.c
|
||||||
$CC -o upscheme $o_files $LFLAGS
|
$CC -o upscheme $o_files $LFLAGS
|
||||||
|
|
Loading…
Reference in New Issue