get-environment-variable

README.md

@@ -10,10 +10,9 @@ Goldfish Scheme is implemented to overcome the defects of [S7 Scheme](https://cc
 2. Try to implement the [R7RS-small](https://small.r7rs.org) standard
 3. Try to provide the useful SRFI in R7RS library format
 
-The implementation of Goldfish aims to follow the rules of simplicity. Currently, Goldfish Scheme only depends on S7 Scheme and C++ 17 standard library.
+The implementation of Goldfish aims to follow the rules of simplicity. Currently, Goldfish Scheme only depends on S7 Scheme, tbox and C++ 17 standard library.
 
 Just like S7 Scheme, [`src/goldfish.hpp`](src/goldfish.hpp) and [`src/goldfish.cpp`](src/goldfish.cpp) are the only key source code needed to build the goldfish interpreter binary.
-If you download the `s7.c` `s7.h` by yourself, just invoke `gcc` or `clang` to build goldfish. `xmake` as a build tool is nice to have but not a requirement.
 
 
 ## Installation

goldfish/scheme/process-context.scm

@@ -0,0 +1,25 @@
+;
+; Copyright (C) 2024 The Goldfish Scheme Authors
+;
+; Licensed under the Apache License, Version 2.0 (the "License");
+; you may not use this file except in compliance with the License.
+; You may obtain a copy of the License at
+;
+; http://www.apache.org/licenses/LICENSE-2.0
+;
+; Unless required by applicable law or agreed to in writing, software
+; distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
+; WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
+; License for the specific language governing permissions and limitations
+; under the License.
+;
+
+(define-library (scheme process-context)
+(export get-environment-variable)
+(begin
+
+(define (get-environment-variable key)
+  (g_get-environment-variable key))
+
+) ; end of begin
+) ; end of define-library

src/goldfish.cpp

@@ -15,7 +15,6 @@
 //
 
 #include "goldfish.hpp"
-#include "s7.h"
 
 #include <filesystem>
 #include <iostream>
@@ -95,9 +94,13 @@ main (int argc, char** argv) {
   s7_load (sc, gf_boot.string ().c_str ());
   s7_add_to_load_path (sc, gf_lib.string ().c_str ());
 
+  // Init tbox
+  if (!tb_init (tb_null, tb_null)) exit (-1);
+
   // Glues
   glue_goldfish (sc);
   glue_scheme_time (sc);
+  glue_scheme_process_context (sc);
 
   // Command options
   vector<string> args (argv + 1, argv + argc);

src/goldfish.hpp

@@ -15,8 +15,14 @@
 //
 
 #include <chrono>
+#include <iostream>
 #include <s7.h>
 #include <string>
+#include <tbox/tbox.h>
+
+inline void glue_goldfish (s7_scheme* sc);
+inline void glue_scheme_time (s7_scheme* sc);
+inline void glue_scheme_process_context (s7_scheme* sc);
 
 const int patch_version= 0;                // Goldfish Patch Version
 const int minor_version= S7_MAJOR_VERSION; // S7 Major Version
@@ -69,3 +75,44 @@ glue_scheme_time (s7_scheme* sc) {
              s7_make_typed_function (sc, s_current_second, f_current_second, 0,
                                      0, false, d_current_second, NULL));
 }
+
+// Glues for (scheme process-context)
+static s7_pointer
+f_get_environment_variable (s7_scheme* sc, s7_pointer args) {
+#ifdef _MSC_VER
+  std::string path_sep= ";";
+#else
+  std::string path_sep= ":";
+#endif
+  std::string          ret;
+  tb_size_t            size       = 0;
+  const char*          key        = s7_string (s7_car (args));
+  tb_environment_ref_t environment= tb_environment_init ();
+  if (environment) {
+    size= tb_environment_load (environment, key);
+    if (size >= 1) {
+      tb_for_all_if (tb_char_t const*, value, environment, value) {
+        ret.append (value).append (path_sep);
+      }
+    }
+  }
+  tb_environment_exit (environment);
+  if (size == 0) { // env key not found
+    return s7_make_boolean (sc, false);
+  }
+  else {
+    return s7_make_string (sc, ret.substr (0, ret.size () - 1).c_str ());
+  }
+}
+
+inline void
+glue_scheme_process_context (s7_scheme* sc) {
+  s7_pointer  cur_env                   = s7_curlet (sc);
+  const char* s_get_environment_variable= "g_get-environment-variable";
+  const char* d_get_environment_variable=
+      "(g_get-environemt-variable string) => string";
+  s7_define (sc, cur_env, s7_make_symbol (sc, s_get_environment_variable),
+             s7_make_typed_function (sc, s_get_environment_variable,
+                                     f_get_environment_variable, 1, 0, false,
+                                     d_get_environment_variable, NULL));
+}

tests/scheme/process-context-test.scm

@@ -0,0 +1,23 @@
+;
+; Copyright (C) 2024 The Goldfish Scheme Authors
+;
+; Licensed under the Apache License, Version 2.0 (the "License");
+; you may not use this file except in compliance with the License.
+; You may obtain a copy of the License at
+;
+; http://www.apache.org/licenses/LICENSE-2.0
+;
+; Unless required by applicable law or agreed to in writing, software
+; distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
+; WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
+; License for the specific language governing permissions and limitations
+; under the License.
+;
+
+(import (srfi srfi-78)
+        (scheme process-context))
+
+(check-set-mode! 'report-failed)
+
+; (check (get-environment-variable "USER") => "da")
+; (check (get-environment-variable "HOME") => "/home/da")

xmake.lua

@@ -11,15 +11,21 @@ set_project("Goldfish Scheme")
 -- repo
 add_repositories("goldfish-repo xmake")
 
-S7_VERSION = "20240702"
+local S7_VERSION = "20240702"
 add_requires("s7 "..S7_VERSION, {system=false})
 
+local TBOX_VERSION = "1.7.5"
+tbox_configs = {["force-utf8"]=true}
+add_requires("tbox " .. TBOX_VERSION, {system=false, configs=tbox_configs})
+
 target ("goldfish") do
     set_languages("c++17")
     set_targetdir("$(projectdir)/bin/")
     add_files ("src/goldfish.cpp")
     add_packages("s7")
+    add_packages("tbox")
 
     add_installfiles("goldfish/(scheme/*.scm)", {prefixdir = "goldfish"})
     add_installfiles("goldfish/(srfi/*.scm)", {prefixdir = "goldfish"})
 end
+