From 40ba694ea68451f4d5f330ee2c26ba04d7c1a30c Mon Sep 17 00:00:00 2001
From: Lassi Kortela <lassi@lassi.io>
Date: Wed, 28 Aug 2019 12:49:10 +0300
Subject: [PATCH] Make environment variable procedures match R7RS

---
 c/builtins.c  | 41 ++++++++++++++++++++++++++++++++---------
 c/libraries.c |  7 +++++++
 c/scheme.h    |  4 ++++
 3 files changed, 43 insertions(+), 9 deletions(-)

diff --git a/c/builtins.c b/c/builtins.c
index c71487f..12cc322 100644
--- a/c/builtins.c
+++ b/c/builtins.c
@@ -17,6 +17,8 @@
 
 #include "scheme.h"
 
+extern char **environ;
+
 size_t llength(value_t v)
 {
     size_t n = 0;
@@ -357,13 +359,35 @@ static value_t fl_path_exists(value_t *args, uint32_t nargs)
     return os_path_exists(str) ? FL_T : FL_F;
 }
 
-static value_t fl_os_getenv(value_t *args, uint32_t nargs)
+value_t builtin_get_environment_variables(value_t *args, uint32_t nargs)
+{
+    struct accum acc = ACCUM_EMPTY;
+    char **pairs;
+    const char *pair;
+    const char *pivot;
+    value_t name, value;
+
+    (void)args;
+    argcount("get-environment-variables", nargs, 0);
+    for (pairs = environ; (pair = *pairs); pairs++) {
+        pivot = strchr(pair, '=');
+        if (!pivot) {
+            continue;
+        }
+        name = string_from_cstrn(pair, pivot - pair);
+        value = string_from_cstr(pivot + 1);
+        accum_pair(&acc, name, value);
+    }
+    return acc.list;
+}
+
+value_t builtin_get_environment_variable(value_t *args, uint32_t nargs)
 {
     char *name;
     char *val;
 
-    argcount("os.getenv", nargs, 1);
-    name = tostring(args[0], "os.getenv");
+    argcount("get-environment-variable", nargs, 1);
+    name = tostring(args[0], "get-environment-variable");
     val = getenv(name);
     if (val == NULL)
         return FL_F;
@@ -372,17 +396,17 @@ static value_t fl_os_getenv(value_t *args, uint32_t nargs)
     return cvalue_static_cstring(val);
 }
 
-static value_t fl_os_setenv(value_t *args, uint32_t nargs)
+value_t builtin_set_environment_variable(value_t *args, uint32_t nargs)
 {
     const char *name;
     const char *value;
 
-    argcount("os.setenv", nargs, 2);
-    name = tostring(args[0], "os.setenv");
+    argcount("set-environment-variable", nargs, 2);
+    name = tostring(args[0], "set-environment-variable");
     if (args[1] == FL_F) {
         value = 0;
     } else {
-        value = tostring(args[1], "os.setenv");
+        value = tostring(args[1], "set-environment-variable");
     }
     os_setenv(name, value);
     return FL_T;
@@ -511,8 +535,7 @@ static struct builtinspec builtin_info[] = {
     { "path.cwd", fl_path_cwd },
     { "path.exists?", fl_path_exists },
 
-    { "os.getenv", fl_os_getenv },
-    { "os.setenv", fl_os_setenv },
+    { "os.getenv", builtin_get_environment_variable },  // TODO: remove
 
     { "import-procedure", builtin_import },
 
diff --git a/c/libraries.c b/c/libraries.c
index 2bb5d2a..65d9811 100644
--- a/c/libraries.c
+++ b/c/libraries.c
@@ -84,6 +84,13 @@ static struct builtin_procedure builtin_procedures[] = {
     { "read-directory", builtin_os_read_directory, SRFI_170 | UP_2019 },
     { "close-directory", builtin_os_close_directory, SRFI_170 | UP_2019 },
 
+    { "get-environment-variables", builtin_get_environment_variables,
+      R7RS_PROCESS_CONTEXT | UP_2019 },
+    { "get-environment-variable", builtin_get_environment_variable,
+      R7RS_PROCESS_CONTEXT | UP_2019 },
+    { "set-environment-variable", builtin_set_environment_variable,
+      R7RS_PROCESS_CONTEXT | UP_2019 },
+
     { 0, 0, 0 },
 };
 
diff --git a/c/scheme.h b/c/scheme.h
index 3f40a38..7e59e5e 100644
--- a/c/scheme.h
+++ b/c/scheme.h
@@ -996,6 +996,10 @@ value_t builtin_read_ini_file(value_t *args, uint32_t nargs);
 
 value_t builtin_color_name_to_rgb24(value_t *args, uint32_t nargs);
 
+value_t builtin_get_environment_variables(value_t *args, uint32_t nargs);
+value_t builtin_get_environment_variable(value_t *args, uint32_t nargs);
+value_t builtin_set_environment_variable(value_t *args, uint32_t nargs);
+
 //// #include "stringfuncs.h"
 
 value_t fl_stringp(value_t *args, uint32_t nargs);