Implement (features) and (version-alist)

c/libraries.c

@@ -45,6 +45,7 @@ struct builtin_library {
 #define SRFI_13 (1 << 9)    // String Libraries
 #define SRFI_170 (1 << 10)  // POSIX API
 #define SRFI_175 (1 << 11)  // ASCII character library
+#define SRFI_176 (1 << 11)  // Version flag
 
 // Up Scheme libraries
 #define UP_2019 (1 << 20)
@@ -57,6 +58,9 @@ static struct builtin_procedure builtin_procedures[] = {
     { "make-string", string_make_string, SRFI_13 | UP_2019 },
 #endif
 
+    { "features", builtin_features, R7RS_BASE | UP_2019 },
+    { "version-alist", builtin_version_alist, SRFI_176 | UP_2019 },
+
     { "string?", fl_stringp, SRFI_13 | R7RS_BASE | UP_2019 },
     { "string-reverse", fl_string_reverse, SRFI_13 | UP_2019 },
     { "string-split", builtin_string_split, UP_2019 },
@@ -144,6 +148,7 @@ static struct builtin_library builtin_libraries[] = {
     { "srfi/13", SRFI_13 },
     { "srfi/170", SRFI_170 },
     { "srfi/175", SRFI_175 },
+    { "srfi/176", SRFI_176 },
     { "upscheme/2019/unstable", UP_2019 },
     { 0, 0 },
 };

c/main.c

@@ -15,6 +15,59 @@
 #define BOOT_ENV_R7RS 1
 #define BOOT_ENV_UNSTABLE 2
 
+static value_t get_features_list(void)
+{
+    static struct accum acc;
+    static int initialized;
+
+    if (!initialized) {
+        initialized = 1;
+        accum_init(&acc);
+#ifdef BITS64
+        accum_elt(&acc, symbol("64-bit"));
+#endif
+#if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__
+        accum_elt(&acc, symbol("big-endian"));
+#endif
+#if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__
+        accum_elt(&acc, symbol("little-endian"));
+#endif
+        accum_elt(&acc, symbol("r7rs"));
+    }
+    return acc.list;
+}
+
+static value_t get_version_alist(void)
+{
+    static struct accum acc;
+    static int initialized;
+
+    if (!initialized) {
+        initialized = 1;
+        accum_init(&acc);
+        accum_name_value1(&acc, "command", string_from_cstr("upscheme"));
+        accum_name_value1(&acc, "scheme-id", symbol("upscheme"));
+        accum_name_value(
+        &acc, "language",
+        fl_cons(symbol("scheme"), fl_cons(symbol("r7rs"), FL_NIL)));
+        accum_name_value(&acc, "features", get_features_list());
+    }
+    return acc.list;
+}
+
+value_t builtin_features(value_t *args, uint32_t nargs)
+{
+    (void)args;
+    argcount("features", nargs, 0);
+    return get_features_list();
+}
+
+value_t builtin_version_alist(value_t *args, uint32_t nargs)
+{
+    (void)args;
+    argcount("version-alist", nargs, 0);
+    return get_version_alist();
+}
 
 static value_t argv_list(int argc, char *argv[])
 {
@@ -82,14 +135,14 @@ static void generic_runtime_usage(FILE *out, int status)
 
 static void runtime_usage(void) { generic_runtime_usage(stderr, 2); }
 
-#define VERSION_STRING "0.1.0"
-
 static void version(void)
 {
-    printf("(version \"%s\")\n", VERSION_STRING);
+    value_t list;
-    printf("(canonical-command \"upscheme\")\n");
+
-    printf("(scheme-id upscheme)\n");
+    for (list = get_version_alist(); iscons(list); list = cdr_(list)) {
-    printf("(languages scheme r7rs)\n");
+        write_simple_defaults(ios_stdout, car_(list));
+        ios_putc('\n', ios_stdout);
+    }
     exit(0);
 }
 
@@ -216,13 +269,14 @@ int main(int argc, char **argv)
     parse_command_line_flags(argv + 1);
     if (helpflag) {
         generic_usage(stdout, 0);
-    } else if (versionflag) {
-        version();
     }
     fl_init(512 * 1024);
     {
         FL_TRY_EXTERN
         {
+            if (versionflag) {
+                version();
+            }
             if (fl_load_boot_image())
                 return 1;
 

c/scheme.h

@@ -1010,6 +1010,9 @@ value_t builtin_import(value_t *args, uint32_t nargs);
 
 //// #include "builtins.h"
 
+value_t builtin_features(value_t *args, uint32_t nargs);
+value_t builtin_version_alist(value_t *args, uint32_t nargs);
+
 value_t builtin_pid(value_t *args, uint32_t nargs);
 value_t builtin_parent_pid(value_t *args, uint32_t nargs);
 value_t builtin_process_group(value_t *args, uint32_t nargs);