GoldfishStandardLibrary.tmu

<TMU|<tuple|1.0.5|1.2.9.8>>

<style|<tuple|book|chinese|literate|goldfish|reduced-margins|guile|smart-ref|preview-ref|python>>

<\body>
  <\hide-preamble>
    <assign|scm|<macro|body|<goldfish-lang|<arg|body>>>>

    <assign|scm-chunk|<\macro|name|prev|next|body>
      <\generic-chunk|<arg|name>|<arg|prev>|<arg|next>>
        <with|mode|prog|prog-language|goldfish|font-family|rm|<arg|body>>
      </generic-chunk>
    </macro>>

    <assign|subparagraph|<macro|title|<assign|subparagraph-numbered|<compound|subparagraph-display-numbers>><assign|subparagraph-prefix|<macro|<compound|the-subparagraph>.>><compound|next-subparagraph><compound|subparagraph-clean><compound|subparagraph-header|<arg|title>><compound|subparagraph-toc|<arg|title>><small|<if|<value|subparagraph-numbered>|<compound|subparagraph-numbered-title|<arg|title>>|<compound|subparagraph-unnumbered-title|<arg|title>>>>>>

    <assign|r7rs|<flag|R7RS|dark cyan>>

    <assign|srfi|<flag|SRFI|dark red>>

    <assign|goldfish-version|17.11.2>

    <assign|typehint|<macro|body|<goldfish-lang|<arg|body>>>>

    <assign|font|math=Latin Modern Math,cjk=Noto CJK SC,CMU>
  </hide-preamble>

  <chapter|C++部分开始>

  <section|许可证>

  <\cpp-chunk|src/goldfish.hpp|false|true>
    //

    // 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.

    //

    \;
  </cpp-chunk>

  <section|实现>

  <paragraph|头文件>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    #include \<less\>algorithm\<gtr\>

    #include \<less\>cstdlib\<gtr\>

    #include \<less\>cstring\<gtr\>

    #include \<less\>iostream\<gtr\>

    #include \<less\>s7.h\<gtr\>

    #include \<less\>string\<gtr\>

    #include \<less\>vector\<gtr\>

    \;

    #include \<less\>tbox/platform/file.h\<gtr\>

    #include \<less\>tbox/platform/path.h\<gtr\>

    #include \<less\>tbox/tbox.h\<gtr\>

    \;

    #ifdef TB_CONFIG_OS_WINDOWS

    #include \<less\>io.h\<gtr\>

    #include \<less\>windows.h\<gtr\>

    #elif TB_CONFIG_OS_MACOSX

    #include \<less\>limits.h\<gtr\>

    #include \<less\>mach-o/dyld.h\<gtr\>

    #else

    #include \<less\>linux/limits.h\<gtr\>

    #endif

    \;

    #if !defined(TB_CONFIG_OS_WINDOWS)

    #include \<less\>errno.h\<gtr\>

    #include \<less\>pwd.h\<gtr\>

    #include \<less\>unistd.h\<gtr\>

    #include \<less\>wordexp.h\<gtr\>

    #endif

    \;
  </cpp-chunk>

  <paragraph|GOLDFISH_VERSION>

  金鱼Scheme的版本，<todo|后续统一使用<value|goldfish-version>这个在导言区预定义的值>。文学编程的Build Buffer功能暂时不支持展开导言区预定义的值。

  <\cpp-chunk|src/goldfish.hpp|true|true>
    #define GOLDFISH_VERSION "17.11.2"

    \;
  </cpp-chunk>

  <paragraph|GOLDFISH_PATH_MAXN>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    #define GOLDFISH_PATH_MAXN TB_PATH_MAXN

    \;
  </cpp-chunk>

  <paragraph|全局变量>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static std::vector\<less\>std::string\<gtr\> command_args= std::vector\<less\>std::string\<gtr\> ();

    \;
  </cpp-chunk>

  <paragraph|goldfish命名空间的开始>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    namespace goldfish {

    using std::cerr;

    using std::cout;

    using std::endl;

    using std::string;

    using std::vector;

    \;
  </cpp-chunk>

  <section|公共辅助函数>

  <subparagraph|string_vector_to_s7_vector>

  将<cpp|std::vector>复制为S7的<scm|vector>。

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline s7_pointer

    string_vector_to_s7_vector (s7_scheme* sc, vector\<less\>string\<gtr\> v) {

    \ \ int \ \ \ \ \ \ \ N \ = v.size ();

    \ \ s7_pointer ret= s7_make_vector (sc, N);

    \ \ for (int i= 0; i \<less\> N; i++) {

    \ \ \ \ s7_vector_set (sc, ret, i, s7_make_string (sc, v[i].c_str ()));

    \ \ }

    \ \ return ret;

    }

    \;
  </cpp-chunk>

  <paragraph|glue_define>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void

    glue_define (s7_scheme *sc, const char* name, const char* desc, s7_function f, s7_int required, s7_int optional) {

    \ \ s7_pointer cur_env= s7_curlet (sc);

    \ \ s7_pointer func= s7_make_typed_function (sc, name, f, required, optional, false, desc, NULL);

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, name), func);

    }

    \;
  </cpp-chunk>

  <chapter|boot.scm><label|chapter:scheme_boot>

  S7 Scheme默认并不遵循R7RS，在启动S7 Scheme之后，我们需要做的第一件事就是加载<scm|boot.scm>，实现R7RS的<scm|define-library>和<scm|import>。

  <section|基础文件操作>

  <paragraph|version><index|g_version><typehint|=\<gtr\> string?>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_version (s7_scheme* sc, s7_pointer args) {

    \ \ return s7_make_string (sc, GOLDFISH_VERSION);

    }

    \;
  </cpp-chunk>

  \;

  <value|r7rs><paragraph|file-exists?><index|file-exists?>

  <\goldfish-chunk|goldfish/scheme/boot.scm|false|true>
    (define (file-exists? path)

    \ \ (if (string? path)

    \ \ \ \ (if (not (g_access path 0)) ; F_OK

    \ \ \ \ \ \ #f

    \ \ \ \ \ \ (if (g_access path 1) ; R_OK

    \ \ \ \ \ \ \ \ \ \ #t

    \ \ \ \ \ \ \ \ \ \ (error 'permission-error (string-append "No permission: " path))))

    \ \ \ \ (error 'type-error "(file-exists? path): path should be string")))

    \;
  </goldfish-chunk>

  <value|r7rs><paragraph|delete-file><index|delete-file><typehint|((path string?))>

  <\scm-chunk|goldfish/scheme/boot.scm|true|true>
    (define (delete-file path)

    \ \ (if (not (string? path))

    \ \ \ \ (error 'type-error "(delete-file path): path should be string")

    \ \ \ \ (if (not (file-exists? path))

    \ \ \ \ \ \ (error 'read-error (string-append path " does not exist"))

    \ \ \ \ \ \ (g_delete-file path))))

    \;
  </scm-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_delete_file (s7_scheme* sc, s7_pointer args) {

    \ \ const char* path_c= s7_string (s7_car (args));

    \ \ return s7_make_boolean (sc, tb_file_remove (path_c));

    }

    \;
  </cpp-chunk>

  <paragraph|glue_goldfish>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void

    glue_goldfish (s7_scheme* sc) {

    \ \ s7_pointer cur_env= s7_curlet (sc);

    \;

    \ \ const char* s_version \ \ \ = "version";

    \ \ const char* d_version \ \ \ = "(version) =\<gtr\> string";

    \ \ const char* s_delete_file= "g_delete-file";

    \ \ const char* d_delete_file= "(g_delete-file string) =\<gtr\> boolean";

    \;

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, s_version),

    \ \ \ \ \ \ \ \ \ \ \ \ \ s7_make_typed_function (sc, s_version, f_version, 0, 0, false,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ d_version, NULL));

    \;

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, s_delete_file),

    \ \ \ \ \ \ \ \ \ \ \ \ \ s7_make_typed_function (sc, s_delete_file, f_delete_file, 1, 0,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ false, d_delete_file, NULL));

    }

    \;
  </cpp-chunk>

  <section|R7RS函数库>

  <value|r7rs><paragraph|define-library><index|define-library>

  <\scm-chunk|goldfish/scheme/boot.scm|true|true>
    ; 0-clause BSD

    ; Adapted from S7 Scheme's r7rs.scm

    (define-macro (define-library libname . body) ; \|(lib name)\| -\<gtr\> environment

    \ \ `(define ,(symbol (object-\<gtr\>string libname))

    \ \ \ \ \ (with-let (sublet (unlet)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons 'import import)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons '*export* ())

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons 'export (define-macro (,(gensym) . names)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ `(set! *export* (append ',names *export*)))))

    \ \ \ \ \ \ \ ,@body

    \ \ \ \ \ \ \ (apply inlet

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (map (lambda (entry)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (or (member (car entry) '(*export* export import))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (and (pair? *export*)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (not (member (car entry) *export*))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (values)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ entry))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (curlet))))))

    \;

    (unless (defined? 'r7rs-import-library-filename)

    \ \ (define (r7rs-import-library-filename libs)

    \ \ \ \ (when (pair? libs)

    \ \ \ \ \ \ (let ((lib-filename (let loop ((lib (if (memq (caar libs) '(only except prefix rename))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cadar libs)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (car libs)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (name ""))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (set! name (string-append name (symbol-\<gtr\>string (car lib))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (null? (cdr lib))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (string-append name ".scm")

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (begin

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (set! name (string-append name "/"))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (cdr lib) name))))))

    \ \ \ \ \ \ \ \ (unless (member lib-filename (*s7* 'file-names))

    \ \ \ \ \ \ \ \ \ \ (load lib-filename)))

    \ \ \ \ \ \ (r7rs-import-library-filename (cdr libs)))))

    \;
  </scm-chunk>

  <value|r7rs><paragraph|import><index|import>

  <\scm-chunk|goldfish/scheme/boot.scm|true|false>
    (define-macro (import . libs)

    \ \ `(begin

    \ \ \ \ \ (r7rs-import-library-filename ',libs)

    \ \ \ \ \ (varlet (curlet)

    \ \ \ \ \ \ \ ,@(map (lambda (lib)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (case (car lib)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((only)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ `((lambda (e names)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (apply inlet

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (map (lambda (name)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons name (e name)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ names)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (symbol-\<gtr\>value (symbol (object-\<gtr\>string (cadr ',lib))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cddr ',lib)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((except)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ `((lambda (e names)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (apply inlet

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (map (lambda (entry)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (member (car entry) names)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (values)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ entry))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ e)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (symbol-\<gtr\>value (symbol (object-\<gtr\>string (cadr ',lib))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cddr ',lib)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((prefix)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ `((lambda (e prefx)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (apply inlet

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (map (lambda (entry)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (string-\<gtr\>symbol\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (string-append (symbol-\<gtr\>string prefx)\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (symbol-\<gtr\>string (car entry))))\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cdr entry)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ e)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (symbol-\<gtr\>value (symbol (object-\<gtr\>string (cadr ',lib))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (caddr ',lib)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((rename)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ `((lambda (e names)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (apply inlet

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (map (lambda (entry)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let ((info (assoc (car entry) names)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if info

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (cadr info) (cdr entry))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ entry)))\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ e)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (symbol-\<gtr\>value (symbol (object-\<gtr\>string (cadr ',lib))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cddr ',lib)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ `(let ((sym (symbol (object-\<gtr\>string ',lib))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (not (defined? sym))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (format () "~A not loaded~%" sym)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (symbol-\<gtr\>value sym))))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ libs))))

    \;
  </scm-chunk>

  <chapter|(scheme time)>

  <paragraph|g_current-second><index|g_current-second><typehint|=\<gtr\> inexact?>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_current_second (s7_scheme* sc, s7_pointer args) {

    \ \ // TODO: use std::chrono::tai_clock::now() when using C++ 20

    \ \ tb_timeval_t tp= {0};

    \ \ tb_gettimeofday (&tp, tb_null);

    \ \ s7_double res= (time_t) tp.tv_sec + (tp.tv_usec / 1000000.0);

    \ \ return s7_make_real (sc, res);

    }

    \;
  </cpp-chunk>

  <paragraph|glue_scheme_time>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void

    glue_scheme_time (s7_scheme* sc) {

    \ \ s7_pointer cur_env= s7_curlet (sc);

    \;

    \ \ const char* s_current_second= "g_current-second";

    \ \ const char* d_current_second= "(g_current-second): () =\<gtr\> double, return the "

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ "current unix timestamp in double";

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, s_current_second),

    \ \ \ \ \ \ \ \ \ \ \ \ \ s7_make_typed_function (sc, s_current_second, f_current_second, 0,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 0, false, d_current_second, NULL));

    }

    \;
  </cpp-chunk>

  <chapter|(scheme process-context)>

  <paragraph|g_get-environment-variable><index|g_get-environment-variable>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    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 \<gtr\>= 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 ());

    \ \ }

    }

    \;
  </cpp-chunk>

  <paragraph|g_command-line><index|g_command-line>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_command_line (s7_scheme* sc, s7_pointer args) {

    \ \ s7_pointer ret = s7_nil (sc);

    \ \ int \ \ \ \ \ \ \ size= command_args.size ();

    \ \ for (int i= size - 1; i \<gtr\>= 0; i--) {

    \ \ \ \ ret= s7_cons (sc, s7_make_string (sc, command_args[i].c_str ()), ret);

    \ \ }

    \ \ return ret;

    }

    \;
  </cpp-chunk>

  <paragraph|glue_scheme_process_context>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_unset_environment_variable (s7_scheme* sc, s7_pointer args) {

    \ \ const char* env_name= s7_string (s7_car (args));

    \ \ return s7_make_boolean (sc, tb_environment_remove (env_name));

    }

    \;

    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) =\<gtr\> string";

    \ \ const char* s_command_line= "g_command-line";

    \ \ const char* d_command_line= "(g_command-line) =\<gtr\> 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));

    \ \ s7_define (sc, cur_env, s7_make_symbol (sc, s_command_line),

    \ \ \ \ \ \ \ \ \ \ \ \ \ s7_make_typed_function (sc, s_command_line, f_command_line, 0, 0,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ false, d_command_line, NULL));

    }

    \;
  </cpp-chunk>

  <chapter|(liii base64)>

  <section|协议>

  <\scm-chunk|goldfish/liii/base64.scm|false|true>
    ;

    ; 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.

    ;

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/base64-test.scm|false|true>
    ;

    ; 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.

    ;

    \;
  </scm-chunk>

  <section|接口>

  <\scm-chunk|goldfish/liii/base64.scm|true|true>
    (define-library (liii base64)

    (import (liii base)

    \ \ \ \ \ \ \ \ (liii bitwise))

    (export

    \ \ string-base64-encode bytevector-base64-encode base64-encode

    \ \ string-base64-decode bytevector-base64-decode base64-decode

    )

    (begin
  </scm-chunk>

  <section|测试>

  <\scm-chunk|tests/goldfish/liii/base64-test.scm|true|true>
    (import (liii check)

    \ \ \ \ \ \ \ \ (liii base64))

    \;

    (check-set-mode! 'report-failed)

    \;
  </scm-chunk>

  <section|Base64编解码介绍>

  Base64编码是一种将任意字节序列编码为可打印字符的方式，其编码和解码的过程如下：

  <paragraph*|编码的长度计算：>

  Base64的编码长度与输入数据的长度相关，长度计算公式为：

  <equation*|<with|mode|text|length(output)>=<around*|\<lceil\>|<frac|<with|mode|text|length(input)>|3>|\<rceil\>>\<times\>4>

  其中，输入的每3个字节被转换为4个Base64字符。如果输入的字节数不是3的倍数，会在编码后用<code*|=>符号填充，保证输出长度始终是4的倍数。

  <paragraph*|输入数据的分组与填充：>

  <\big-table|<scm|<tabular|<tformat|<table|<row|<cell|b1>|<cell|b2>|<cell|b3>>|<row|<cell|0-255>|<cell|0-255>|<cell|0-255>>|<row|<cell|0-255>|<cell|0-255>|<cell|#f>>|<row|<cell|0-255>|<cell|#f>|<cell|#f>>>>>>>
    最后一组不足的元素需要设置为<scm|#f><label|table:16.1>
  </big-table>

  输入的字节流被分为每组3个字节进行编码。对于不足3个字节的最后一组，根据不同情况补充<code*|#f>（表示填充字节）。<smart-ref|table:16.1>展示了3种情况：

  <\itemize>
    <item>如果有3个字节，则正常处理。

    <item>如果有2个字节，则第三个字节补充为<code*|#f>。

    <item>如果只有1个字节，则后两个字节补充为<code*|#f>。
  </itemize>

  <paragraph*|映射规则：>

  每组3个字节 <math|<around*|[|b<rsub|1>,b<rsub|2>,b<rsub|3>|]>> 将映射为4个Base64字符 <math|<around*|[|c<rsub|1>,c<rsub|2>,c<rsub|3>,c<rsub|4>|]>>，其中，Base64字符的取值范围是字母、数字、<code*|+>、<code*|/>，以及可能的填充符号<code*|=>。映射的具体规则如下：

  <\itemize>
    <item>将3个字节（24位）按6位一组，分成4个部分，每个部分对应一个Base64字符。

    <item>如果不足3个字节（即有填充的情况），则最后一个或两个Base64字符会用<code*|=>替代。
  </itemize>

  <paragraph*|例子：>

  假设输入为"Man"，其ASCII值为<math|77,97,110>，其二进制表示为：

  <equation*|77=01001101,97=01100001,110=01101110>

  将24位二进制分为4组，每组6位：

  <equation*|010011,010110,000101,<with|mode|text|>101110>

  转换为Base64字符，分别对应<code*|T>, <code*|W>, <code*|F>, <code*|u>。因此，"Man"的Base64编码为<code*|TWFu>。

  解码时，过程反过来：将Base64字符转换为6位二进制，再拼接回原始的字节序列。

  Base64编码的特点是保持输入的可读性并使其适合传输，但相较于原始数据，会增加大约33%的大小。

  <section|实现>

  <paragraph|bytevector-base64-encode><index|bytevector-base64-encode>

  <paragraph|string-base64-encode><index|string-base64-encode>

  <paragraph|base64-encode><index|base64-encode>

  <\scm-chunk|goldfish/liii/base64.scm|true|true>
    (define-constant BYTE2BASE64_BV

    \ \ (string-\<gtr\>utf8 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"))

    \;

    (define-constant BASE64_PAD_BYTE

    \ \ (char-\<gtr\>integer #\\=))

    \;

    (define bytevector-base64-encode

    \ \ (typed-lambda ((bv bytevector?))

    \ \ \ \ (define (encode b1 b2 b3)

    \ \ \ \ \ \ (let* ((p1 b1)

    \ \ \ \ \ \ \ \ \ \ \ \ \ (p2 (if b2 b2 0))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (p3 (if b3 b3 0))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (combined (bitwise-ior (ash p1 16) (ash p2 8) p3))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (c1 (bitwise-and (ash combined -18) #x3F))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (c2 (bitwise-and (ash combined -12) #x3F))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (c3 (bitwise-and (ash combined -6) #x3F))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (c4 (bitwise-and combined #x3F)))

    \ \ \ \ \ \ \ \ (values

    \ \ \ \ \ \ \ \ \ \ (BYTE2BASE64_BV c1)

    \ \ \ \ \ \ \ \ \ \ (BYTE2BASE64_BV c2)

    \ \ \ \ \ \ \ \ \ \ (if b2 (BYTE2BASE64_BV c3) BASE64_PAD_BYTE)

    \ \ \ \ \ \ \ \ \ \ (if b3 (BYTE2BASE64_BV c4) BASE64_PAD_BYTE))))

    \ \ \ \ 

    \ \ \ \ (let* ((input-N (bytevector-length bv))

    \ \ \ \ \ \ \ \ \ \ \ (output-N (* 4 (ceiling (/ input-N 3))))

    \ \ \ \ \ \ \ \ \ \ \ (output (make-bytevector output-N)))

    \ \ \ \ \ \ (let loop ((i 0) (j 0))

    \ \ \ \ \ \ \ \ (when (\<less\> i input-N)

    \ \ \ \ \ \ \ \ \ \ (let* ((b1 (bv i))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (b2 (if (\<less\> (+ i 1) input-N) (bv (+ i 1)) #f))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (b3 (if (\<less\> (+ i 2) input-N) (bv (+ i 2)) #f)))

    \ \ \ \ \ \ \ \ \ \ \ \ (receive (r1 r2 r3 r4) (encode b1 b2 b3)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (bytevector-u8-set! output j r1)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (bytevector-u8-set! output (+ j 1) r2)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (bytevector-u8-set! output (+ j 2) r3)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (bytevector-u8-set! output (+ j 3) r4)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (+ i 3) (+ j 4))))))

    \ \ \ \ \ \ output)))

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/liii/base64.scm|true|true>
    (define string-base64-encode

    \ \ (typed-lambda ((str string?))

    \ \ \ \ (utf8-\<gtr\>string (bytevector-base64-encode (string-\<gtr\>utf8 str)))))

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/liii/base64.scm|true|true>
    (define (base64-encode x)

    \ \ (cond ((string? x)

    \ \ \ \ \ \ \ \ \ (string-base64-encode x))

    \ \ \ \ \ \ \ \ ((bytevector? x)

    \ \ \ \ \ \ \ \ \ (bytevector-base64-encode x))

    \ \ \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ \ \ (type-error "input must be string or bytevector"))))

    \;
  </scm-chunk>

  <subparagraph|测试>

  <\scm-chunk|tests/goldfish/liii/base64-test.scm|true|true>
    (check (base64-encode "") =\<gtr\> "")

    (check (base64-encode "a") =\<gtr\> "YQ==")

    (check (base64-encode "z") =\<gtr\> "eg==")

    (check (base64-encode "f") =\<gtr\> "Zg==")

    (check (base64-encode "fo") =\<gtr\> "Zm8=")

    (check (base64-encode "foo") =\<gtr\> "Zm9v")

    (check (base64-encode "foob") =\<gtr\> "Zm9vYg==")

    (check (base64-encode "fooba") =\<gtr\> "Zm9vYmE=")

    (check (base64-encode "foobar") =\<gtr\> "Zm9vYmFy")

    \;

    (check-catch 'type-error (base64-encode 1))

    \;
  </scm-chunk>

  <paragraph|bytevector-base64-decode><index|bytevector-base64-decode>

  <paragraph|string-base64-decode><index|string-base64-decode>

  <paragraph|base64-decode><index|base64-decode>

  <\scm-chunk|goldfish/liii/base64.scm|true|true>
    (define-constant BASE64_TO_BYTE_V

    \ \ (let1 byte2base64-N (bytevector-length BYTE2BASE64_BV)

    \ \ \ \ (let loop ((i 0) (v (make-vector 256 -1)))

    \ \ \ \ \ \ (if (\<less\> i byte2base64-N)

    \ \ \ \ \ \ \ \ \ \ (begin

    \ \ \ \ \ \ \ \ \ \ \ \ (vector-set! v (BYTE2BASE64_BV i) i)

    \ \ \ \ \ \ \ \ \ \ \ \ (loop (+ i 1) v))

    \ \ \ \ \ \ \ \ \ \ v))))

    \;

    (define (bytevector-base64-decode bv)

    \ \ (define (decode c1 c2 c3 c4)

    \ \ \ \ (let* ((b1 (BASE64_TO_BYTE_V c1))

    \ \ \ \ \ \ \ \ \ \ \ (b2 (BASE64_TO_BYTE_V c2))

    \ \ \ \ \ \ \ \ \ \ \ (b3 (BASE64_TO_BYTE_V c3))

    \ \ \ \ \ \ \ \ \ \ \ (b4 (BASE64_TO_BYTE_V c4)))

    \ \ \ \ \ \ (if (or (negative? b1) (negative? b2)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (and (negative? b3) (!= c3 BASE64_PAD_BYTE))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (and (negative? b4) (!= c4 BASE64_PAD_BYTE)))

    \ \ \ \ \ \ \ \ \ \ (value-error "Invalid base64 input")

    \ \ \ \ \ \ \ \ \ \ (values

    \ \ \ \ \ \ \ \ \ \ \ \ (bitwise-ior (ash b1 2) (ash b2 -4))

    \ \ \ \ \ \ \ \ \ \ \ \ (bitwise-and (bitwise-ior (ash b2 4) (ash b3 -2)) #xFF)

    \ \ \ \ \ \ \ \ \ \ \ \ (bitwise-and (bitwise-ior (ash b3 6) b4) #xFF)

    \ \ \ \ \ \ \ \ \ \ \ \ (if (negative? b3) 1 (if (negative? b4) 2 3))))))

    \ \ 

    \ \ (let* ((input-N (bytevector-length bv))

    \ \ \ \ \ \ \ \ \ (output-N (* input-N 3/4))

    \ \ \ \ \ \ \ \ \ (output (make-bytevector output-N)))

    \;

    \ \ \ \ (unless (zero? (modulo input-N 4))

    \ \ \ \ \ \ (value-error "length of the input bytevector must be 4X"))

    \ \ \ \ 

    \ \ \ \ (let loop ((i 0) (j 0))

    \ \ \ \ \ \ (if (\<less\> i input-N)

    \ \ \ \ \ \ \ \ \ \ (receive (r1 r2 r3 cnt)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (decode (bv i) (bv (+ i 1)) (bv (+ i 2)) (bv (+ i 3)))

    \ \ \ \ \ \ \ \ \ \ \ \ (bytevector-u8-set! output j r1)

    \ \ \ \ \ \ \ \ \ \ \ \ (when (\<gtr\>= cnt 2)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (bytevector-u8-set! output (+ j 1) r2))

    \ \ \ \ \ \ \ \ \ \ \ \ (when (\<gtr\>= cnt 3)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (bytevector-u8-set! output (+ j 2) r3))

    \ \ \ \ \ \ \ \ \ \ \ \ (loop (+ i 4) (+ j cnt)))

    \ \ \ \ \ \ \ \ \ \ (let ((final (make-bytevector j)))

    \ \ \ \ \ \ \ \ \ \ \ \ (vector-copy! final 0 output 0 j)

    \ \ \ \ \ \ \ \ \ \ \ \ final)))))

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/liii/base64.scm|true|true>
    (define string-base64-decode

    \ \ (typed-lambda ((str string?))

    \ \ \ \ (utf8-\<gtr\>string (bytevector-base64-decode (string-\<gtr\>utf8 str)))))

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/liii/base64.scm|true|true>
    (define (base64-decode x)

    \ \ (cond ((string? x)

    \ \ \ \ \ \ \ \ \ (string-base64-decode x))

    \ \ \ \ \ \ \ \ ((bytevector? x)

    \ \ \ \ \ \ \ \ \ (bytevector-base64-decode x))

    \ \ \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ \ \ (type-error "input must be string or bytevector"))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/base64-test.scm|true|true>
    (check (base64-decode "") =\<gtr\> "")

    \;

    (check (base64-decode "YQ==") =\<gtr\> "a")

    (check (base64-decode "eg==") =\<gtr\> "z")

    (check (base64-decode "Zg==") =\<gtr\> "f")

    (check (base64-decode "Zm8=") =\<gtr\> "fo")

    (check (base64-decode "Zm9v") =\<gtr\> "foo")

    (check (base64-decode "Zm9vYg==") =\<gtr\> "foob")

    (check (base64-decode "Zm9vYmE=") =\<gtr\> "fooba")

    (check (base64-decode "Zm9vYmFy") =\<gtr\> "foobar")

    \;
  </scm-chunk>

  <section|结尾>

  <\scm-chunk|goldfish/liii/base64.scm|true|false>
    ) ; end of begin

    ) ; end of define-library

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/base64-test.scm|true|false>
    (check-report)

    \;
  </scm-chunk>

  <chapter|(liii sys)>

  <section|许可证>

  <\goldfish-chunk|goldfish/liii/sys.scm|false|true>
    ;

    ; 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.

    ;

    \;
  </goldfish-chunk>

  <section|接口>

  <\goldfish-chunk|goldfish/liii/sys.scm|true|true>
    (define-library (liii sys)

    (export argv executable)

    (import (scheme process-context))

    (begin

    \;
  </goldfish-chunk>

  <section|测试>

  <\goldfish-chunk|tests/goldfish/liii/sys-test.scm|false|false>
    (import (liii check)

    \ \ \ \ \ \ \ \ (liii sys))

    \;

    (display (executable))

    (newline)

    \;

    (check-report)

    \;
  </goldfish-chunk>

  <section|实现>

  <paragraph|argv>

  <\goldfish-chunk|goldfish/liii/sys.scm|true|true>
    (define (argv) (command-line))

    \;
  </goldfish-chunk>

  <paragraph|executable><index|executable><typehint|() =\<gtr\> string?>

  <\goldfish-chunk|goldfish/liii/sys.scm|true|true>
    (define (executable) (g_executable))

    \;
  </goldfish-chunk>

  <subparagraph|C++实现>

  如何获得当前可执行文件对应的路径，在不同的操作系统上的实现不一样。

  <\cpp-chunk|src/goldfish.hpp|true|true>
    string

    goldfish_exe () {

    #ifdef TB_CONFIG_OS_WINDOWS

    \ \ char buffer[GOLDFISH_PATH_MAXN];

    \ \ GetModuleFileName (NULL, buffer, GOLDFISH_PATH_MAXN);

    \ \ return string (buffer);

    #elif TB_CONFIG_OS_MACOSX

    \ \ char \ \ \ \ \ \ \ buffer[PATH_MAX];

    \ \ uint32_t \ \ \ size= sizeof (buffer);

    \ \ if (_NSGetExecutablePath (buffer, &size) == 0) {

    \ \ \ \ char real_path[GOLDFISH_PATH_MAXN];

    \ \ \ \ if (realpath (buffer, real_path) != NULL) {

    \ \ \ \ \ \ return string (real_path);

    \ \ \ \ }

    \ \ }

    \ \ return "";

    #elif TB_CONFIG_OS_LINUX

    \ \ char \ \ \ buffer[GOLDFISH_PATH_MAXN];

    \ \ ssize_t len= readlink ("/proc/self/exe", buffer, sizeof (buffer) - 1);

    \ \ if (len != -1) {

    \ \ \ \ buffer[len]= '\\0';

    \ \ \ \ return std::string (buffer);

    \ \ }

    \ \ return "";

    #endif

    }

    \;
  </cpp-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_executable (s7_scheme* sc, s7_pointer args) {

    \ \ string exe_path= goldfish_exe ();

    \ \ return s7_make_string (sc, exe_path.c_str ());

    }

    \;
  </cpp-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void

    glue_executable (s7_scheme* sc) {

    \ \ const char* name= "g_executable";

    \ \ const char* desc= "(g_executable) =\<gtr\> string";

    \ \ glue_define (sc, name, desc, f_executable, 0, 0);

    }

    \;
  </cpp-chunk>

  <paragraph|glue_liii_sys>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void

    glue_liii_sys (s7_scheme* sc) {

    \ \ glue_executable (sc);

    }

    \;
  </cpp-chunk>

  <section|结尾>

  <\goldfish-chunk|goldfish/liii/sys.scm|true|false>
    ) ; end of begin

    ) ; end of define-library

    \;
  </goldfish-chunk>

  <chapter|(liii os)>

  <section|协议>

  <\goldfish-chunk|goldfish/liii/os.scm|false|true>
    ;

    ; 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.

    ;

    \;
  </goldfish-chunk>

  <\scm-chunk|tests/goldfish/liii/os-test.scm|false|true>
    ;

    ; 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.

    ;

    \;
  </scm-chunk>

  <section|接口>

  <\goldfish-chunk|goldfish/liii/os.scm|true|true>
    (define-library (liii os)

    (export

    \ \ os-arch os-type os-windows? os-linux? os-macos? os-temp-dir

    \ \ os-sep pathsep

    \ \ os-call system

    \ \ mkdir chdir rmdir getenv unsetenv getcwd listdir access getlogin getpid)

    (import (scheme process-context)

    \ \ \ \ \ \ \ \ (liii base)

    \ \ \ \ \ \ \ \ (liii error)

    \ \ \ \ \ \ \ \ (liii string))

    (begin

    \;
  </goldfish-chunk>

  <section|测试>

  <\scm-chunk|tests/goldfish/liii/os-test.scm|true|true>
    (import (liii check)

    \ \ \ \ \ \ \ \ (liii string)

    \ \ \ \ \ \ \ \ (liii os)

    \ \ \ \ \ \ \ \ (liii uuid)

    \ \ \ \ \ \ \ \ (scheme time))

    \;

    (check-set-mode! 'report-failed)

    \;
  </scm-chunk>

  <section|实现>

  <paragraph|os-arch><typehint|() =\<gtr\> boolean?>

  <\goldfish-chunk|goldfish/liii/os.scm|true|true>
    (define (os-arch)

    \ \ (g_os-arch))

    \;
  </goldfish-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_os_arch (s7_scheme* sc, s7_pointer args) {

    \ \ return s7_make_string (sc, TB_ARCH_STRING);

    }

    \;
  </cpp-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void

    glue_os_arch (s7_scheme* sc) {

    \ \ const char* name= "g_os-arch";

    \ \ const char* desc= "(g_os-arch) =\<gtr\> string";

    \ \ glue_define (sc, name, desc, f_os_arch, 0, 0);

    }

    \;
  </cpp-chunk>

  <paragraph|os-type><goldfish-lang|() =\<gtr\> boolean?>

  <\goldfish-chunk|goldfish/liii/os.scm|true|true>
    (define (os-type)

    \ \ (g_os-type))

    \;
  </goldfish-chunk>

  <subparagraph|测试用例>

  <\scm-chunk|tests/goldfish/liii/os-test.scm|true|true>
    (when (os-linux?)

    \ \ (check (os-type) =\<gtr\> "Linux"))

    \;

    (when (os-macos?)

    \ \ (check (os-type) =\<gtr\> "Darwin"))

    \;

    (when (os-windows?)

    \ \ (check (os-type) =\<gtr\> "Windows"))

    \;

    (when (not (os-windows?))

    \ \ (let ((t1 (current-second)))

    \ \ \ \ (os-call "sleep 1")

    \ \ \ \ (let ((t2 (current-second)))

    \ \ \ \ \ \ (check (\<gtr\>= (ceiling (- t2 t1)) 1) =\<gtr\> #t))))

    \;
  </scm-chunk>

  <subparagraph|C++实现>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_os_type (s7_scheme* sc, s7_pointer args) {

    #ifdef TB_CONFIG_OS_LINUX

    \ \ return s7_make_string (sc, "Linux");

    #endif

    #ifdef TB_CONFIG_OS_MACOSX

    \ \ return s7_make_string (sc, "Darwin");

    #endif

    #ifdef TB_CONFIG_OS_WINDOWS

    \ \ return s7_make_string (sc, "Windows");

    #endif

    \ \ return s7_make_boolean (sc, false);

    }

    \;
  </cpp-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void

    glue_os_type (s7_scheme* sc) {

    \ \ const char* name= "g_os-type";

    \ \ const char* desc= "(g_os-type) =\<gtr\> string";

    \ \ glue_define (sc, name, desc, f_os_type, 0, 0);

    }

    \;
  </cpp-chunk>

  <paragraph|os-linux?><goldfish-lang|() =\<gtr\> boolean?>

  <\goldfish-chunk|goldfish/liii/os.scm|true|true>
    (define (os-linux?)

    \ \ (let ((name (os-type)))

    \ \ \ \ (and name (string=? name "Linux"))))

    \;
  </goldfish-chunk>

  <paragraph|os-macos?><goldfish-lang|() =\<gtr\> boolean?>

  <\goldfish-chunk|goldfish/liii/os.scm|true|true>
    (define (os-macos?)

    \ \ (let ((name (os-type)))

    \ \ \ \ (and name (string=? name "Darwin"))))

    \;
  </goldfish-chunk>

  <paragraph|os-windows?><goldfish-lang|() =\<gtr\> boolean?>

  <\goldfish-chunk|goldfish/liii/os.scm|true|true>
    (define (os-windows?)

    \ \ (let ((name (os-type)))

    \ \ \ \ (and name (string=? name "Windows"))))

    \;
  </goldfish-chunk>

  <paragraph|os-sep>

  <\goldfish-chunk|goldfish/liii/os.scm|true|true>
    (define (os-sep)

    \ \ (if (os-windows?)

    \ \ \ \ #\\\\

    \ \ \ \ #\\/))

    \;
  </goldfish-chunk>

  <paragraph|pathsep>

  <\goldfish-chunk|goldfish/liii/os.scm|true|true>
    (define (pathsep)

    \ \ (if (os-windows?)

    \ \ \ \ #\\;

    \ \ \ \ #\\:))

    \;
  </goldfish-chunk>

  <paragraph|%check-dir-andthen>

  <\goldfish-chunk|goldfish/liii/os.scm|true|true>
    (define (%check-dir-andthen path f)

    \ \ (cond ((not (file-exists? path))

    \ \ \ \ \ \ \ \ \ (file-not-found-error

    \ \ \ \ \ \ \ \ \ \ \ (string-append "No such file or directory: '" path "'")))

    \ \ \ \ \ \ \ \ ((not (g_isdir path))

    \ \ \ \ \ \ \ \ \ (not-a-directory-error

    \ \ \ \ \ \ \ \ \ \ \ (string-append "Not a directory: '" path "'")))

    \ \ \ \ \ \ \ \ (else (f path))))

    \;
  </goldfish-chunk>

  <paragraph|os-call>

  <\goldfish-chunk|goldfish/liii/os.scm|true|true>
    (define (os-call command)

    \ \ (g_os-call command))

    \;
  </goldfish-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_os_call (s7_scheme* sc, s7_pointer args) {

    \ \ const char* \ \ \ \ \ \ cmd_c= s7_string (s7_car (args));

    \ \ tb_process_attr_t attr = {tb_null};

    \ \ attr.flags \ \ \ \ \ \ \ \ \ \ \ \ = TB_PROCESS_FLAG_NO_WINDOW;

    \ \ int ret;

    \;

    #if _MSC_VER

    \ \ ret= (int) std::system (cmd_c);

    #else

    \ \ wordexp_t p;

    \ \ ret= wordexp (cmd_c, &p, 0);

    \ \ if (ret != 0) {

    \ \ \ \ // failed after calling wordexp

    \ \ }

    \ \ else if (p.we_wordc == 0) {

    \ \ \ \ wordfree (&p);

    \ \ \ \ ret= EINVAL;

    \ \ }

    \ \ else {

    \ \ \ \ ret= (int) tb_process_run (p.we_wordv[0], (tb_char_t const**) p.we_wordv,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ &attr);

    \ \ \ \ wordfree (&p);

    \ \ }

    #endif

    \ \ return s7_make_integer (sc, ret);

    }

    \;
  </cpp-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void glue_os_call(s7_scheme* sc) {

    \ \ const char* name = "g_os-call";

    \ \ const char* desc = "(g_os-call string) =\<gtr\> int, execute a shell command and return the exit code";

    \ \ glue_define(sc, name, desc, f_os_call, 1, 0);

    }

    \;
  </cpp-chunk>

  <paragraph|system>

  <\goldfish-chunk|goldfish/liii/os.scm|true|true>
    (define (system command)

    \ \ (g_system command))

    \;
  </goldfish-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_system (s7_scheme* sc, s7_pointer args) {

    \ \ const char* cmd_c= s7_string (s7_car (args));

    \ \ int \ \ \ \ \ \ \ \ ret \ = (int) std::system (cmd_c);

    \ \ return s7_make_integer (sc, ret);

    }

    \;
  </cpp-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void glue_system(s7_scheme* sc) {

    \ \ const char* name = "g_system";

    \ \ const char* desc = "(g_system string) =\<gtr\> int, execute a shell command and return the exit code";

    \ \ glue_define(sc, name, desc, f_system, 1, 0);

    }

    \;
  </cpp-chunk>

  <paragraph|access>

  <\goldfish-chunk|goldfish/liii/os.scm|true|true>
    (define (access path mode)

    \ \ (cond ((eq? mode 'F_OK) (g_access path 0))

    \ \ \ \ \ \ \ \ ((eq? mode 'X_OK) (g_access path 128))

    \ \ \ \ \ \ \ \ ((eq? mode 'W_OK) (g_access path 2))

    \ \ \ \ \ \ \ \ ((eq? mode 'R_OK) (g_access path 1))

    \ \ \ \ \ \ \ \ (else (error 'value-error "Allowed mode 'F_OK, 'X_OK,'W_OK, 'R_OK"))))

    \;
  </goldfish-chunk>

  <\scm-chunk|tests/goldfish/liii/os-test.scm|true|true>
    (when (and (os-linux?) (not (string=? "root" (getlogin))))

    \ \ (check-true (access "/root" 'F_OK))

    \ \ (check-false (access "/root" 'R_OK))

    \ \ (check-false (access "/root" 'W_OK))

    \ \ (check-true (access "bin/goldfish" 'X_OK)))

    \;
  </scm-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_access (s7_scheme* sc, s7_pointer args) {

    \ \ const char* path_c= s7_string (s7_car (args));

    \ \ int \ \ \ \ \ \ \ \ mode \ = s7_integer ((s7_cadr (args)));

    \ \ bool ret= false;

    \ \ if (mode == 0) {

    \ \ \ \ tb_file_info_t info;

    \ \ \ \ ret= tb_file_info (path_c, &info);

    \ \ } else {

    \ \ \ \ ret= tb_file_access (path_c, mode);

    \ \ }

    \ \ 

    \ \ return s7_make_boolean (sc, ret);

    }

    \;
  </cpp-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void glue_access(s7_scheme* sc) {

    \ \ const char* name = "g_access";

    \ \ const char* desc = "(g_access string integer) =\<gtr\> boolean, check file access permissions";

    \ \ glue_define(sc, name, desc, f_access, 2, 0);

    }

    \;
  </cpp-chunk>

  <paragraph|getenv>

  <\goldfish-chunk|goldfish/liii/os.scm|true|true>
    (define (getenv key)

    \ \ (get-environment-variable key))

    \;
  </goldfish-chunk>

  <paragraph|unsetenv>

  <\goldfish-chunk|goldfish/liii/os.scm|true|true>
    (define (unsetenv key)

    \ \ (g_unsetenv key))

    \;
  </goldfish-chunk>

  <\scm-chunk|tests/goldfish/liii/os-test.scm|true|true>
    (check (string-null? (getenv "PATH")) =\<gtr\> #f)

    (unsetenv "PATH")

    (check (getenv "PATH") =\<gtr\> #f)

    \;
  </scm-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void

    glue_unsetenv (s7_scheme* sc) {

    \ \ const char* name= "g_unsetenv";

    \ \ const char* desc= "(g_unsetenv string): string =\<gtr\> boolean";

    \ \ glue_define (sc, name, desc, f_unset_environment_variable, 1, 0);

    }

    \;
  </cpp-chunk>

  <paragraph|os-temp-dir>

  <\goldfish-chunk|goldfish/liii/os.scm|true|true>
    (define (os-temp-dir)

    \ \ (let1 temp-dir (g_os-temp-dir)

    \ \ \ \ (string-remove-suffix temp-dir (string (os-sep)))))

    \;
  </goldfish-chunk>

  <subparagraph|测试用例>

  <\scm-chunk|tests/goldfish/liii/os-test.scm|true|true>
    (when (os-windows?)

    \ \ (check (string-starts? (os-temp-dir) "C:") =\<gtr\> #t))

    \;

    (when (os-linux?)

    \ \ (check (os-temp-dir) =\<gtr\> "/tmp"))

    \;
  </scm-chunk>

  <subparagraph|C++实现>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_os_temp_dir (s7_scheme* sc, s7_pointer args) {

    \ \ tb_char_t path[GOLDFISH_PATH_MAXN];

    \ \ tb_directory_temporary (path, GOLDFISH_PATH_MAXN);

    \ \ return s7_make_string (sc, path);

    }

    \;
  </cpp-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void

    glue_os_temp_dir (s7_scheme* sc) {

    \ \ const char* name= "g_os-temp-dir";

    \ \ const char* desc= "(g_os-temp-dir) =\<gtr\> string, get the temporary directory path";

    \ \ glue_define (sc, name, desc, f_os_temp_dir, 0, 0);

    }

    \;
  </cpp-chunk>

  <paragraph|mkdir>

  <\goldfish-chunk|goldfish/liii/os.scm|true|true>
    (define (mkdir path)

    \ \ (if (file-exists? path)

    \ \ \ \ (file-exists-error (string-append "File exists: '" path "'"))

    \ \ \ \ (g_mkdir path)))

    \;
  </goldfish-chunk>

  <\scm-chunk|tests/goldfish/liii/os-test.scm|true|true>
    (when (not (os-windows?))

    \ \ (check-catch 'file-exists-error

    \ \ \ \ (mkdir "/tmp"))

    \ \ (check (begin

    \ \ \ \ \ \ \ \ \ \ \ (let ((test_dir "/tmp/test_124"))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (when (file-exists? test_dir)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (rmdir "/tmp/test_124"))

    \ \ \ \ \ \ \ \ \ \ \ \ \ (mkdir "/tmp/test_124")))

    \ \ \ \ =\<gtr\> #t))

    \;
  </scm-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_mkdir (s7_scheme* sc, s7_pointer args) {

    \ \ const char* dir_c= s7_string (s7_car (args));

    \ \ return s7_make_boolean (sc, tb_directory_create (dir_c));

    }

    \;
  </cpp-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void glue_mkdir(s7_scheme* sc) {

    \ \ const char* name = "g_mkdir";

    \ \ const char* desc = "(g_mkdir string) =\<gtr\> boolean, create a directory";

    \ \ glue_define(sc, name, desc, f_mkdir, 1, 0);

    }

    \;
  </cpp-chunk>

  <paragraph|rmdir>

  <\goldfish-chunk|goldfish/liii/os.scm|true|true>
    (define (rmdir path)

    \ \ (%check-dir-andthen path delete-file))

    \;
  </goldfish-chunk>

  <paragraph|chdir>

  <\goldfish-chunk|goldfish/liii/os.scm|true|true>
    (define (chdir path)

    \ \ (if (file-exists? path)

    \ \ \ \ (g_chdir path)

    \ \ \ \ (file-not-found-error (string-append "No such file or directory: '" path "'"))))

    \;
  </goldfish-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_chdir (s7_scheme* sc, s7_pointer args) {

    \ \ const char* dir_c= s7_string (s7_car (args));

    \ \ return s7_make_boolean (sc, tb_directory_current_set (dir_c));

    }

    \;
  </cpp-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void glue_chdir(s7_scheme* sc) {

    \ \ const char* name = "g_chdir";

    \ \ const char* desc = "(g_chdir string) =\<gtr\> boolean, change the current working directory";

    \ \ glue_define(sc, name, desc, f_chdir, 1, 0);

    }

    \;
  </cpp-chunk>

  <paragraph|listdir>

  <\goldfish-chunk|goldfish/liii/os.scm|true|true>
    (define (listdir path)

    \ \ (%check-dir-andthen path g_listdir))

    \;
  </goldfish-chunk>

  <subparagraph|测试用例>

  <\scm-chunk|tests/goldfish/liii/os-test.scm|true|true>
    (when (not (os-windows?))

    \ \ (check (\<gtr\> (vector-length (listdir "/usr")) 0) =\<gtr\> #t))

    \;

    (let* ((test-dir (string-append (os-temp-dir) (string (os-sep)) (uuid4)))

    \ \ \ \ \ \ \ (test-dir2 (string-append test-dir (string (os-sep))))

    \ \ \ \ \ \ \ (dir-a (string-append test-dir2 "a"))

    \ \ \ \ \ \ \ (dir-b (string-append test-dir2 "b"))

    \ \ \ \ \ \ \ (dir-c (string-append test-dir2 "c")))

    \ \ (mkdir test-dir)

    \ \ (mkdir dir-a)

    \ \ (mkdir dir-b)

    \ \ (mkdir dir-c)

    \ \ (let1 r (listdir test-dir)

    \ \ \ \ (check-true (in? "a" r))

    \ \ \ \ (check-true (in? "b" r))

    \ \ \ \ (check-true (in? "c" r)))

    \ \ (let1 r2 (listdir test-dir2)

    \ \ \ \ (check-true (in? "a" r2))

    \ \ \ \ (check-true (in? "b" r2))

    \ \ \ \ (check-true (in? "c" r2)))

    \ \ (rmdir dir-a)

    \ \ (rmdir dir-b)

    \ \ (rmdir dir-c)

    \ \ (rmdir test-dir))

    \;

    (when (os-windows?)

    \ \ (check (\<gtr\> (vector-length (listdir "C:")) 0) =\<gtr\> #t))

    \;
  </scm-chunk>

  <subparagraph|C++实现>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static tb_long_t

    tb_directory_walk_func (tb_char_t const* path, tb_file_info_t const* info,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ tb_cpointer_t priv) {

    \ \ // check

    \ \ tb_assert_and_check_return_val (path && info, TB_DIRECTORY_WALK_CODE_END);

    \;

    \ \ vector\<less\>string\<gtr\>* p_v_result= (vector\<less\>string\<gtr\>*) priv;

    \ \ p_v_result-\<gtr\>push_back (string (path));

    \ \ return TB_DIRECTORY_WALK_CODE_CONTINUE;

    }

    \;

    static s7_pointer

    f_listdir (s7_scheme* sc, s7_pointer args) {

    \ \ const char* \ \ \ path_c= s7_string (s7_car (args));

    \ \ vector\<less\>string\<gtr\> entries;

    \ \ s7_pointer \ \ \ \ ret= s7_make_vector (sc, 0);

    \ \ tb_directory_walk (path_c, 0, tb_false, tb_directory_walk_func, &entries);

    \;

    \ \ int \ \ \ entries_N \ \ = entries.size ();

    \ \ string path_s \ \ \ \ \ = string (path_c);

    \ \ int \ \ \ path_N \ \ \ \ \ = path_s.size ();

    \ \ int \ \ \ path_slash_N= path_N;

    \ \ char \ \ last_ch \ \ \ \ = path_s[path_N - 1];

    #if defined(TB_CONFIG_OS_WINDOWS)

    \ \ if (last_ch != '/' && last_ch != '\\\\') {

    \ \ \ \ path_slash_N= path_slash_N + 1;

    \ \ }

    #else

    \ \ if (last_ch != '/') {

    \ \ \ \ path_slash_N= path_slash_N + 1;

    \ \ }

    #endif

    \ \ for (int i= 0; i \<less\> entries_N; i++) {

    \ \ \ \ entries[i]= entries[i].substr (path_slash_N);

    \ \ }

    \ \ return string_vector_to_s7_vector (sc, entries);

    }

    \;
  </cpp-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void

    glue_listdir (s7_scheme* sc) {

    \ \ const char* name= "g_listdir";

    \ \ const char* desc= "(g_listdir string) =\<gtr\> vector, list the contents of a directory";

    \ \ glue_define (sc, name, desc, f_listdir, 1, 0);

    }

    \;
  </cpp-chunk>

  <paragraph|getcwd><index|getcwd>

  <\goldfish-chunk|goldfish/liii/os.scm|true|true>
    (define (getcwd)

    \ \ (g_getcwd))

    \;
  </goldfish-chunk>

  <\scm-chunk|tests/goldfish/liii/os-test.scm|true|true>
    (check-false (string-null? (getcwd)))

    \;
  </scm-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_getcwd (s7_scheme* sc, s7_pointer args) {

    \ \ tb_char_t path[GOLDFISH_PATH_MAXN];

    \ \ tb_directory_current (path, GOLDFISH_PATH_MAXN);

    \ \ return s7_make_string (sc, path);

    }

    \;
  </cpp-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void

    glue_getcwd (s7_scheme* sc) {

    \ \ const char* name= "g_getcwd";

    \ \ const char* desc= "(g_getcwd) =\<gtr\> string, get the current working directory";

    \ \ glue_define (sc, name, desc, f_getcwd, 0, 0);

    }

    \;
  </cpp-chunk>

  <paragraph|getlogin><index|getlogin>

  <\goldfish-chunk|goldfish/liii/os.scm|true|true>
    (define (getlogin)

    \ \ (if (os-windows?)

    \ \ \ \ \ \ (getenv "USERNAME")

    \ \ \ \ \ \ (g_getlogin)))

    \;
  </goldfish-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_getlogin (s7_scheme* sc, s7_pointer args) {

    #ifdef TB_CONFIG_OS_WINDOWS

    \ \ return s7_make_boolean (sc, false);

    #else

    \ \ uid_t \ \ \ \ \ \ \ \ \ uid= getuid ();

    \ \ struct passwd* pwd= getpwuid (uid);

    \ \ return s7_make_string (sc, pwd-\<gtr\>pw_name);

    #endif

    }

    \;
  </cpp-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void

    glue_getlogin (s7_scheme* sc) {

    \ \ const char* name= "g_getlogin";

    \ \ const char* desc= "(g_getlogin) =\<gtr\> string, get the current user's login name";

    \ \ glue_define (sc, name, desc, f_getlogin, 0, 0);

    }

    \;
  </cpp-chunk>

  <paragraph|getpid><index|getpid>

  <\goldfish-chunk|goldfish/liii/os.scm|true|true>
    (define (getpid)

    \ \ (g_getpid))

    \;
  </goldfish-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_getpid (s7_scheme* sc, s7_pointer args) {

    #ifdef TB_CONFIG_OS_WINDOWS

    \ \ return s7_make_integer (sc, (int) GetCurrentProcessId ());

    #else

    \ \ return s7_make_integer (sc, getpid ());

    #endif

    }

    \;
  </cpp-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void

    glue_getpid (s7_scheme* sc) {

    \ \ const char* name= "g_getpid";

    \ \ const char* desc= "(g_getpid) =\<gtr\> integer";

    \ \ glue_define (sc, name, desc, f_getpid, 0, 0);

    }

    \;
  </cpp-chunk>

  <paragraph|glue_liii_os>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void

    glue_liii_os (s7_scheme* sc) {

    \ \ glue_os_arch (sc);

    \ \ glue_os_type (sc);

    \ \ glue_os_call (sc);

    \ \ glue_system (sc);

    \ \ glue_access (sc);

    \ \ glue_unsetenv (sc);

    \ \ glue_getcwd (sc);

    \ \ glue_os_temp_dir (sc);

    \ \ glue_mkdir (sc);

    \ \ glue_chdir (sc);

    \ \ glue_listdir (sc);

    \ \ glue_getlogin (sc);

    \ \ glue_getpid (sc);

    }

    \;
  </cpp-chunk>

  <section|结尾>

  <\goldfish-chunk|goldfish/liii/os.scm|true|false>
    ) ; end of begin

    ) ; end of define-library

    \;
  </goldfish-chunk>

  <\scm-chunk|tests/goldfish/liii/os-test.scm|true|false>
    (check-report)

    \;
  </scm-chunk>

  <chapter|(liii uuid)>

  <section|协议>

  <\goldfish-chunk|goldfish/liii/uuid.scm|false|true>
    ;

    ; 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.

    ;

    \;
  </goldfish-chunk>

  <section|实现>

  <scm|(liii uuid)>是通过C++实现的，本节是相关的胶水代码。

  <paragraph|uuid4><index|g_uuid4><typehint|=\<gtr\> string?>

  <\goldfish-chunk|goldfish/liii/uuid.scm|true|false>
    (define-library (liii uuid)

    (export uuid4)

    (begin

    \;

    (define (uuid4) (g_uuid4))

    \;

    ) ; end of begin

    ) ; end of define-library

    \;
  </goldfish-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_uuid4 (s7_scheme* sc, s7_pointer args) {

    \ \ tb_char_t \ \ \ \ \ \ \ uuid[37];

    \ \ const tb_char_t* ret= tb_uuid4_make_cstr (uuid, tb_null);

    \ \ return s7_make_string (sc, ret);

    }

    \;
  </cpp-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void

    glue_uuid4 (s7_scheme* sc) {

    \ \ const char* name= "g_uuid4";

    \ \ const char* desc= "(g_uuid4) =\<gtr\> string";

    \ \ glue_define (sc, name, desc, f_uuid4, 0, 0);

    }

    \;
  </cpp-chunk>

  <paragraph|glue_liii_uuid>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void

    glue_liii_uuid (s7_scheme* sc) {

    \ \ glue_uuid4 (sc);

    }

    \;
  </cpp-chunk>

  <chapter|(liii path)>

  <section|协议>

  <\goldfish-chunk|goldfish/liii/path.scm|false|true>
    ;

    ; 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.

    ;

    \;
  </goldfish-chunk>

  <\scm-chunk|tests/goldfish/liii/path-test.scm|false|true>
    ;

    ; 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.

    ;

    \;
  </scm-chunk>

  <section|接口>

  <\goldfish-chunk|goldfish/liii/path.scm|true|true>
    (define-library (liii path)

    (export

    \ \ make-path path-parts path-absolute?

    \ \ path-\<gtr\>string

    \ \ path-dir? path-file? path-exists?

    \ \ path-getsize path-read-text path-write-text

    )

    (import (liii error) (liii vector) (liii string) (liii list))

    (begin

    \;
  </goldfish-chunk>

  <\goldfish-chunk|goldfish/liii/path.scm|true|true>
    (define-record-type :path

    \ \ (%make-path parts type drive)

    \ \ path?

    \ \ (parts path-parts)

    \ \ (type path-type)

    \ \ (drive path-drive))

    \;
  </goldfish-chunk>

  <section|测试>

  <\scm-chunk|tests/goldfish/liii/path-test.scm|true|true>
    (import (liii path)

    \ \ \ \ \ \ \ \ (liii check)

    \ \ \ \ \ \ \ \ (liii os))

    \;

    (check-set-mode! 'report-failed)

    \;
  </scm-chunk>

  <section|实现>

  <paragraph|make-path>

  <\goldfish-chunk|goldfish/liii/path.scm|true|true>
    (define (%check-posix-parts parts)

    \ \ (when (vector-empty? parts)

    \ \ \ \ (value-error "make-path: parts must not be emtpy for posix path"))

    \ \ (let1 N (vector-length parts)

    \ \ \ \ (let loop ((i 0))

    \ \ \ \ \ \ (when (\<less\> i (- N 1))

    \ \ \ \ \ \ \ \ \ \ \ \ (when (string-null? (parts i))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (value-error "make-path: part of path must not be empty string, index" i))

    \ \ \ \ \ \ \ \ \ \ \ \ (loop (+ i 1))))

    \ \ \ \ (let loop ((i 1))

    \ \ \ \ \ \ (when (\<less\> i N)

    \ \ \ \ \ \ \ \ \ \ \ \ (when (string-index (parts i) #\\/)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (value-error "make-path: non-first part of path must not contains /"))

    \ \ \ \ \ \ \ \ \ \ \ \ (loop (+ i 1))))))

    \;

    (define* (make-path parts (type 'posix) (drive ""))

    \ \ (when (not (vector? parts))

    \ \ \ \ (type-error "make-path: parts must be a vector"))

    \;

    \ \ (case type

    \ \ \ \ ((posix) (%check-posix-parts parts)))

    \ \ 

    \ \ (case type

    \ \ \ \ ((posix)

    \ \ \ \ \ (%make-path parts type drive))

    \ \ \ \ (else (value-error "make-path: invalid type" type))))

    \;
  </goldfish-chunk>

  <paragraph|path-absolute?>

  <\goldfish-chunk|goldfish/liii/path.scm|true|true>
    (define path-absolute?

    \ \ (typed-lambda ((path path?))

    \ \ \ \ (case (path-type path)

    \ \ \ \ \ \ ((posix)

    \ \ \ \ \ \ \ (string-starts? ((path-parts path) 0) "/"))

    \ \ \ \ \ \ (else (value-error "path-absolute?: invalid type of path" (path-type path))))))

    \;
  </goldfish-chunk>

  <\scm-chunk|tests/goldfish/liii/path-test.scm|true|true>
    (check-true (path-absolute? (make-path #("/"))))

    (check-true (path-absolute? (make-path #("/" "tmp"))))

    (check-false (path-absolute? (make-path #("tmp"))))

    \;
  </scm-chunk>

  <paragraph|path-\<gtr\>string>

  <\goldfish-chunk|goldfish/liii/path.scm|true|true>
    (define path-\<gtr\>string

    \ \ (typed-lambda ((path path?))

    \ \ \ \ (case (path-type path)

    \ \ \ \ \ \ ((posix)

    \ \ \ \ \ \ \ (let1 s (string-join (vector-\<gtr\>list (path-parts path)) (string #\\/))

    \ \ \ \ \ \ \ \ \ (if (string-starts? s "//")

    \ \ \ \ \ \ \ \ \ \ \ \ \ (string-drop s 1)

    \ \ \ \ \ \ \ \ \ \ \ \ \ s)))

    \ \ \ \ \ \ (else (value-error "path-\<gtr\>string: invalid type of path" (path-type path))))))

    \;
  </goldfish-chunk>

  <\scm-chunk|tests/goldfish/liii/path-test.scm|true|true>
    (check (path-\<gtr\>string (make-path #("/" "etc" "passwd"))) =\<gtr\> "/etc/passwd")

    (check (path-\<gtr\>string (make-path #("/" "tmp" ""))) =\<gtr\> "/tmp/")

    \;
  </scm-chunk>

  <paragraph|path-dir?>

  <\goldfish-chunk|goldfish/liii/path.scm|true|true>
    (define (path-dir? path)

    \ \ (g_isdir path))

    \;
  </goldfish-chunk>

  <\scm-chunk|tests/goldfish/liii/path-test.scm|true|true>
    (check (path-dir? ".") =\<gtr\> #t)

    (check (path-dir? "..") =\<gtr\> #t)

    \;

    (when (not (os-windows?))

    \ \ (check (path-dir? "/") =\<gtr\> #t)

    \ \ (check (path-dir? "/tmp") =\<gtr\> #t)

    \ \ (check (path-dir? "/no_such_dir") =\<gtr\> #f))

    \;

    (when (os-windows?)

    \ \ (check (path-dir? "C:/") =\<gtr\> #t)

    \ \ (check (path-dir? "C:/no_such_dir/") =\<gtr\> #f))

    \;
  </scm-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_isdir (s7_scheme* sc, s7_pointer args) {

    \ \ const char* \ \ \ dir_c= s7_string (s7_car (args));

    \ \ tb_file_info_t info;

    \ \ bool \ \ \ \ \ \ \ \ \ \ ret= false;

    \ \ if (tb_file_info (dir_c, &info)) {

    \ \ \ \ switch (info.type) {

    \ \ \ \ case TB_FILE_TYPE_DIRECTORY:

    \ \ \ \ case TB_FILE_TYPE_DOT:

    \ \ \ \ case TB_FILE_TYPE_DOT2:

    \ \ \ \ \ \ ret= true;

    \ \ \ \ }

    \ \ }

    \ \ return s7_make_boolean (sc, ret);

    }

    \;
  </cpp-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void

    glue_isdir (s7_scheme* sc) {

    \ \ const char* name= "g_isdir";

    \ \ const char* desc= "(g_isdir string) =\<gtr\> boolean";

    \ \ glue_define (sc, name, desc, f_isdir, 1, 0);

    }

    \;
  </cpp-chunk>

  <paragraph|path-file?>

  <\goldfish-chunk|goldfish/liii/path.scm|true|true>
    (define (path-file? path)

    \ \ (g_isfile path))

    \;
  </goldfish-chunk>

  <\scm-chunk|tests/goldfish/liii/path-test.scm|true|true>
    (check (path-file? ".") =\<gtr\> #f)

    (check (path-file? "..") =\<gtr\> #f)

    \;

    (when (os-linux?)

    \ \ (check (path-file? "/etc/passwd") =\<gtr\> #t))

    \;
  </scm-chunk>

  <subparagraph|C++实现>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_isfile (s7_scheme* sc, s7_pointer args) {

    \ \ const char* \ \ \ dir_c= s7_string (s7_car (args));

    \ \ tb_file_info_t info;

    \ \ bool \ \ \ \ \ \ \ \ \ \ ret= false;

    \ \ if (tb_file_info (dir_c, &info)) {

    \ \ \ \ switch (info.type) {

    \ \ \ \ case TB_FILE_TYPE_FILE:

    \ \ \ \ \ \ ret= true;

    \ \ \ \ }

    \ \ }

    \ \ return s7_make_boolean (sc, ret);

    }

    \;
  </cpp-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void

    glue_isfile (s7_scheme* sc) {

    \ \ const char* name= "g_isfile";

    \ \ const char* desc= "(g_isfile string) =\<gtr\> boolean";

    \ \ glue_define (sc, name, desc, f_isfile, 1, 0);

    }

    \;
  </cpp-chunk>

  <paragraph|path-exists?>

  <\goldfish-chunk|goldfish/liii/path.scm|true|true>
    (define (path-exists? path)

    \ \ (file-exists? path))

    \;
  </goldfish-chunk>

  <paragraph|path-getsize><index|path-getsize><scm|((path string?)) =\<gtr\> integer?>

  返回当前路径的文件大小。

  <\goldfish-chunk|goldfish/liii/path.scm|true|true>
    (define path-getsize

    \ \ (typed-lambda ((path string?))

    \ \ \ \ (if (not (file-exists? path))

    \ \ \ \ \ \ (file-not-found-error

    \ \ \ \ \ \ \ \ (string-append "No such file or directory: '" path "'"))

    \ \ \ \ \ \ (g_path-getsize path))))

    \;
  </goldfish-chunk>

  \;

  <\scm-chunk|tests/goldfish/liii/path-test.scm|true|true>
    (when (not (os-windows?))

    \ \ (check-true (\<gtr\> (path-getsize "/") 0))

    \ \ (check-true (\<gtr\> (path-getsize "/etc/hosts") 0)))

    \;

    (when (os-windows?)

    \ \ (check-true (\<gtr\> (path-getsize "C:") 0))

    \ \ (check-true (\<gtr\> (path-getsize "C:/Windows") 0))

    \ \ (check-true (\<gtr\> (path-getsize "C:\\\\Windows\\\\System32\\\\drivers\\\\etc\\\\hosts") 0)))

    \;
  </scm-chunk>

  返回指定路径的文件大小，如果该文件不存在，那么返回-1。

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_path_getsize (s7_scheme* sc, s7_pointer args) {

    \ \ const char* \ \ \ path_c= s7_string (s7_car (args));

    \ \ tb_file_info_t info;

    \ \ if (tb_file_info (path_c, &info)) {

    \ \ \ \ return s7_make_integer (sc, (int) info.size);

    \ \ }

    \ \ else {

    \ \ \ \ return s7_make_integer (sc, (int) -1);

    \ \ }

    }

    \;
  </cpp-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void

    glue_path_getsize (s7_scheme* sc) {

    \ \ const char* name= "g_path-getsize";

    \ \ const char* desc= "(g_path_getsize string): string =\<gtr\> integer";

    \ \ glue_define (sc, name, desc, f_path_getsize, 1, 0);

    }

    \;
  </cpp-chunk>

  <paragraph|path-read-text>

  <\goldfish-chunk|goldfish/liii/path.scm|true|true>
    (define path-read-text

    \ \ (typed-lambda ((path string?))

    \ \ \ \ (if (not (file-exists? path))

    \ \ \ \ \ \ (file-not-found-error

    \ \ \ \ \ \ \ \ (string-append "No such file or directory: '" path "'"))

    \ \ \ \ \ \ (g_path-read-text path))))

    \;
  </goldfish-chunk>

  <\scm-chunk|tests/goldfish/liii/path-test.scm|true|true>
    (let ((file-name "中文文件名.txt")

    \ \ \ \ \ \ (file-content "你好，世界！"))

    \ \ (define temp-dir (os-temp-dir))

    \ \ (define file-path (string-append temp-dir (string (os-sep)) file-name))

    \ \ (path-write-text file-path file-content)

    \ \ (check (path-read-text file-path) =\<gtr\> file-content)

    \ \ (delete-file file-path))

    \;
  </scm-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer f_path_read_text(s7_scheme* sc, s7_pointer args) {

    \ \ const char* path = s7_string (s7_car (args));

    \ \ if (!path) {

    \ \ \ \ return s7_make_boolean(sc, false);

    \ \ }

    \;

    \ \ tb_file_ref_t file = tb_file_init(path, TB_FILE_MODE_RO);

    \ \ if (file == tb_null) {

    \ \ \ \ // TODO: warning on the tb_file_init failure

    \ \ \ \ return s7_make_boolean(sc, false);

    \ \ }

    \;

    \ \ tb_file_sync (file);

    \;

    \ \ tb_size_t size = tb_file_size(file);

    \ \ if (size == 0) {

    \ \ \ \ tb_file_exit (file);

    \ \ \ \ return s7_make_string (sc, "");

    \ \ }

    \;

    \ \ tb_byte_t* buffer = new tb_byte_t[size + 1];

    \ \ tb_size_t real_size = tb_file_read (file, buffer, size);

    \ \ buffer[real_size] = '\\0';

    \;

    \ \ tb_file_exit(file);

    \ \ std::string content (reinterpret_cast\<less\>char*\<gtr\>(buffer), real_size);

    \ \ delete[] buffer;

    \;

    \ \ return s7_make_string(sc, content.c_str());

    }

    \;
  </cpp-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void

    glue_path_read_text(s7_scheme* sc) {

    \ \ const char* name = "g_path-read-text";

    \ \ const char* desc = "(g_path-read-text path) =\<gtr\> string, read the content of the file at the given path";

    \ \ s7_define_function(sc, name, f_path_read_text, 1, 0, false, desc);

    }

    \;
  </cpp-chunk>

  <paragraph|path-write-text>

  <\goldfish-chunk|goldfish/liii/path.scm|true|true>
    (define path-write-text

    \ \ (typed-lambda ((path string?) (content string?))

    \ \ \ \ (g_path-write-text path content)))

    \;
  </goldfish-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static s7_pointer

    f_path_write_text (s7_scheme* sc, s7_pointer args) {

    \ \ const char* path = s7_string (s7_car (args));

    \ \ if (!path) {

    \ \ \ \ return s7_make_integer(sc, -1);

    \ \ }

    \;

    \ \ const char* content= s7_string (s7_cadr (args));

    \ \ if (!content) {

    \ \ \ \ return s7_make_integer(sc, -1);

    \ \ }

    \;

    \ \ tb_file_ref_t file = tb_file_init(path, TB_FILE_MODE_WO \| TB_FILE_MODE_CREAT \| TB_FILE_MODE_TRUNC);

    \ \ if (file == tb_null) {

    \ \ \ \ return s7_make_integer(sc, -1);

    \ \ }

    \;

    \ \ tb_filelock_ref_t lock = tb_filelock_init(file);

    \ \ if (tb_filelock_enter(lock, TB_FILELOCK_MODE_EX) == tb_false) {

    \ \ \ \ tb_filelock_exit(lock);

    \ \ \ \ tb_file_exit(file);

    \ \ \ \ return s7_make_integer(sc, -1);

    \ \ }

    \;

    \ \ tb_size_t content_size= strlen(content);

    \ \ tb_size_t written_size= tb_file_writ(file, reinterpret_cast\<less\>const tb_byte_t*\<gtr\>(content), content_size);

    \;

    \ \ bool release_success= tb_filelock_leave (lock);

    \ \ tb_filelock_exit (lock);

    \ \ bool exit_success= tb_file_exit(file);

    \;

    \ \ if (written_size == content_size && release_success && exit_success) {

    \ \ \ \ return s7_make_integer(sc, written_size);

    \ \ } else {

    \ \ \ \ return s7_make_integer(sc, -1);

    \ \ }

    }

    \;
  </cpp-chunk>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void glue_path_write_text(s7_scheme* sc) {

    \ \ const char* name = "g_path-write-text";

    \ \ const char* desc = "(g_path-write-text path content) =\<gtr\> integer,\\

    write content to the file at the given path and return the number of bytes written, or -1 on failure";

    \ \ s7_define_function(sc, name, f_path_write_text, 2, 0, false, desc);

    }

    \;
  </cpp-chunk>

  <paragraph|glue_path>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    inline void

    glue_liii_path (s7_scheme* sc) {

    \ \ glue_isfile (sc);

    \ \ glue_isdir (sc);

    \ \ glue_path_getsize (sc);

    \ \ glue_path_read_text (sc);

    \ \ glue_path_write_text (sc);

    }

    \;
  </cpp-chunk>

  <section|结尾>

  <\scm-chunk|tests/goldfish/liii/path-test.scm|true|false>
    (check-report)

    \;
  </scm-chunk>

  <\goldfish-chunk|goldfish/liii/path.scm|true|false>
    ) ; end of begin

    ) ; end of define-library

    \;
  </goldfish-chunk>

  <chapter|(liii argparse)>

  <section|协议>

  <\scm-chunk|goldfish/liii/argparse.scm|false|true>
    ;

    ; 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.

    ;

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/argparse-test.scm|false|true>
    ;

    ; 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.

    ;

    \;
  </scm-chunk>

  <section|接口>

  <\scm-chunk|goldfish/liii/argparse.scm|true|true>
    (define-library (liii argparse)

    (import (liii base)

    \ \ \ \ \ \ \ \ (liii error)

    \ \ \ \ \ \ \ \ (liii list)

    \ \ \ \ \ \ \ \ (liii string)

    \ \ \ \ \ \ \ \ (liii hash-table)

    \ \ \ \ \ \ \ \ (liii alist)

    \ \ \ \ \ \ \ \ (liii sys))

    (export make-argument-parser)

    (begin

    \;
  </scm-chunk>

  <section|测试>

  <\scm-chunk|tests/goldfish/liii/argparse-test.scm|true|true>
    (import (liii check)

    \ \ \ \ \ \ \ \ (liii argparse))

    \;

    (check-set-mode! 'report-failed)

    \;
  </scm-chunk>

  <subparagraph|测试命令行参数的类型>

  <\scm-chunk|tests/goldfish/liii/argparse-test.scm|true|true>
    (let ((parser (make-argument-parser)))

    \ \ (parser 'add-argument

    \ \ \ \ '((name . "name") (type . string) (short . "n") (default . "anonymous")))

    \ \ (check (parser 'name) =\<gtr\> "anonymous")

    \ \ (parser 'parse-args '("--name" "john"))

    \ \ (check (parser 'name) =\<gtr\> "john"))

    \;
  </scm-chunk>

  <subparagraph|测试命令行参数的两种形式>

  <\scm-chunk|tests/goldfish/liii/argparse-test.scm|true|true>
    (let ((parser (make-argument-parser)))

    \ \ (parser 'add-argument

    \ \ \ \ '((name . "width") (type . number) (short . "width") (default . 80)))

    \;

    \ \ (check (parser 'get-argument "width") =\<gtr\> 80)

    \;

    \ \ (parser 'parse-args '("--width" "100"))

    \ \ (check (parser 'get-argument "width") =\<gtr\> 100)

    \ \ (check (parser 'width) =\<gtr\> 100)

    \;

    \ \ (parser 'parse-args '("-width" "60"))

    \ \ (check (parser 'width) =\<gtr\> 60))

    \;

    (let ((parser (make-argument-parser)))

    \ \ (parser 'add-argument

    \ \ \ \ '((name . "height") (type . number) (default . 60))) \ ; without short name

    \ \ (parser 'parse-args '("--height" "120"))

    \ \ (check (parser 'get-argument "height") =\<gtr\> 120))

    \;
  </scm-chunk>

  <subparagraph|测试多个命令行参数多种类型>

  <\scm-chunk|tests/goldfish/liii/argparse-test.scm|true|true>
    (let ((parser (make-argument-parser)))

    \ \ (parser 'add-argument

    \ \ \ \ '((name . "width") (type . number) (short . "w") (default . 80)))

    \ \ (parser 'add-argument\ 

    \ \ \ \ '((name . "title") (type . string) (default . "Untitled")))

    \ \ (parser 'parse-args '("-w" "100" "--title" "My Document"))

    \ \ (check (parser 'get-argument "width") =\<gtr\> 100)

    \ \ (check (parser 'get-argument "title") =\<gtr\> "My Document"))

    \;
  </scm-chunk>

  <section|实现>

  <paragraph|make-arg-record>

  <todo|使用define-record-type>

  <\scm-chunk|goldfish/liii/argparse.scm|true|true>
    (define (make-arg-record name type short-name default)

    \ \ (list name type short-name default default))

    \;
  </scm-chunk>

  <paragraph|convert-value>

  将给定值转化为给定类型。

  <\scm-chunk|goldfish/liii/argparse.scm|true|true>
    (define (convert-value value type)

    \ \ (case type

    \ \ \ \ ((number)\ 

    \ \ \ \ \ (if (number? value)

    \ \ \ \ \ \ \ \ \ value

    \ \ \ \ \ \ \ \ \ (let ((num (string-\<gtr\>number value)))

    \ \ \ \ \ \ \ \ \ \ \ (if num\ 

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ num

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (error "Invalid number format" value)))))

    \ \ \ \ ((string)\ 

    \ \ \ \ \ (if (string? value)

    \ \ \ \ \ \ \ \ \ value

    \ \ \ \ \ \ \ \ \ (error "Value is not a string")))

    \ \ \ \ (else (error "Unsupported type" type))))

    \;
  </scm-chunk>

  <paragraph|arg-type?>

  命令行参数的类型必须是<scm|symbol>类型的Scheme字面量。目前命令行参数仅支持两种类型：

  <\description>
    <item*|string>如果没有指定，那么参数类型默认是字符串类型。

    <item*|number>在传入参数时，参数的值是字符串，我们会调用<scm|number-\<gtr\>string>将字符串转化为Scheme的number类型。
  </description>

  \;

  <\scm-chunk|goldfish/liii/argparse.scm|true|true>
    (define (arg-type? type)

    \ \ (unless (symbol? type)

    \ \ \ \ (type-error "type of the argument must be symbol"))

    \ \ (in? type '(string number)))

    \;
  </scm-chunk>

  <paragraph|add-argument>

  新增命令行参数。

  <\scm-chunk|goldfish/liii/argparse.scm|true|true>
    (define (%add-argument args-ht args)

    \ \ (let* ((options (car args))

    \ \ \ \ \ \ \ \ \ (name (alist-ref options 'name

    \ \ \ \ \ \ \ \ \ \ \ (lambda () (value-error "name is required for an option"))))

    \ \ \ \ \ \ \ \ \ (type (alist-ref/default options 'type 'string))

    \ \ \ \ \ \ \ \ \ (short-name (alist-ref/default options 'short #f))

    \ \ \ \ \ \ \ \ \ (default (alist-ref/default options 'default #f))

    \ \ \ \ \ \ \ \ \ (arg-record (make-arg-record name type short-name default)))

    \ \ \ \ (unless (string? name)

    \ \ \ \ \ \ (type-error "name of the argument must be string"))

    \ \ \ \ (unless (arg-type? type)

    \ \ \ \ \ \ (value-error "Invalid type of the argument" type))

    \ \ \ \ (unless (or (not short-name) (string? short-name))

    \ \ \ \ \ \ (type-error "short name of the argument must be string if given"))

    \ \ \ \ (hash-table-set! args-ht name arg-record)

    \ \ \ \ (when short-name

    \ \ \ \ \ \ \ \ \ \ (hash-table-set! args-ht short-name arg-record))))

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/argparse-test.scm|true|true>
    (let1 parser (make-argument-parser)

    \ \ (check-catch 'type-error (parser 'add-argument '((name name))))

    \ \ (check-catch 'value-error (parser 'add-argument '())))

    \;
  </scm-chunk>

  <paragraph|get-argument>

  获得命令行参数对应的值。

  <\scm-chunk|goldfish/liii/argparse.scm|true|true>
    (define (%get-argument args-ht args)

    \ \ (let ((found (hash-table-ref/default args-ht (car args) #f)))

    \ \ \ \ (if found

    \ \ \ \ \ \ \ \ (fifth found)

    \ \ \ \ \ \ \ \ (error "Argument not found" (car args)))))

    \;
  </scm-chunk>

  \;

  \;

  <paragraph|parse-args>

  解析命令行参数。

  <subparagraph|long-form?>

  判断是否形如<shell|--help>、<shell|--version>等形式。

  <\scm-chunk|goldfish/liii/argparse.scm|true|true>
    (define (long-form? arg)

    \ \ (and (string? arg)\ 

    \ \ \ \ \ \ \ (\<gtr\>= (string-length arg) 3)

    \ \ \ \ \ \ \ (string-starts? arg "--")))

    \;
  </scm-chunk>

  <subparagraph|short-form?>

  判断是否形如<shell|-w>、<shell|-help>等形式。

  <\scm-chunk|goldfish/liii/argparse.scm|true|true>
    (define (short-form? arg)

    \ \ (and (string? arg)

    \ \ \ \ \ \ \ (\<gtr\>= (string-length arg) 2)

    \ \ \ \ \ \ \ (char=? (string-ref arg 0) #\\-)))

    \;
  </scm-chunk>

  <subparagraph|retrieve-args>

  如果在代码中传入的参数是空列表，那么默认使用命令行参数。

  <\scm-chunk|goldfish/liii/argparse.scm|true|true>
    (define (retrieve-args args)

    \ \ (if (null? args)

    \ \ \ \ \ \ (cddr (argv))

    \ \ \ \ \ \ (car args)))

    \;
  </scm-chunk>

  <\scm-chunk|goldfish/liii/argparse.scm|true|true>
    (define (%parse-args args-ht prog-args)

    \ \ (let loop ((args (retrieve-args prog-args)))

    \ \ \ \ (if (null? args)

    \ \ \ \ \ \ \ \ args-ht

    \ \ \ \ \ \ \ \ (let ((arg (car args)))

    \ \ \ \ \ \ \ \ \ \ (cond

    \ \ \ \ \ \ \ \ \ \ \ \ ((long-form? arg)

    \ \ \ \ \ \ \ \ \ \ \ \ \ (let* ((name (substring arg 2))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (found (hash-table-ref args-ht name)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if found

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (null? (cdr args))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (error "Missing value for argument" name)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (begin

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let ((value (convert-value (cadr args) (cadr found))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (set-car! (cddddr found) value))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (cddr args))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (value-error (string-append "Unknown option: --" name)))))

    \ \ \ \ \ \ \ \ \ \ \ \ 

    \ \ \ \ \ \ \ \ \ \ \ \ ((short-form? arg)

    \ \ \ \ \ \ \ \ \ \ \ \ \ (let* ((name (substring arg 1))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (found (hash-table-ref args-ht name)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if found

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if (null? (cdr args))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (error "Missing value for argument" name)

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (begin

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let ((value (convert-value (cadr args) (cadr found))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (set-car! (cddddr found) value))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (cddr args))))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (value-error (string-append "Unknown option: -" name)))))

    \ \ \ \ \ \ \ \ \ \ \ \ 

    \ \ \ \ \ \ \ \ \ \ \ \ (else (loop (cdr args))))))))

    \;
  </scm-chunk>

  \;

  <paragraph|make-argument-parser><index|make-argument-parser>

  构造argparser，用于解析命令行参数。

  <\scm-chunk|goldfish/liii/argparse.scm|true|true>
    (define (make-argument-parser)

    \ \ (let ((args-ht (make-hash-table)))

    \ \ \ \ (lambda (command . args)

    \ \ \ \ \ \ (case command

    \ \ \ \ \ \ \ \ ((add) (%add-argument args-ht args))

    \ \ \ \ \ \ \ \ ((add-argument) (%add-argument args-ht args))

    \ \ \ \ \ \ \ \ ((get) (%get-argument args-ht args))

    \ \ \ \ \ \ \ \ ((get-argument) (%get-argument args-ht args))

    \ \ \ \ \ \ \ \ ((parse) (%parse-args args-ht args))

    \ \ \ \ \ \ \ \ ((parse-args) (%parse-args args-ht args))

    \ \ \ \ \ \ \ \ (else

    \ \ \ \ \ \ \ \ \ \ (if (and (null? args) (symbol? command))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (%get-argument args-ht (list (symbol-\<gtr\>string command)))

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ (error "Unknown parser command" command)))))))

    \;
  </scm-chunk>

  <section|结尾>

  <\scm-chunk|goldfish/liii/argparse.scm|true|false>
    ) ; end of begin

    ) ; end of define-library

    \;
  </scm-chunk>

  <\scm-chunk|tests/goldfish/liii/argparse-test.scm|true|false>
    (check-report)

    \;
  </scm-chunk>

  <chapter|C++部分结尾>

  <section|许可证>

  <\cpp-chunk|src/goldfish.cpp|false|true>
    //

    // 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.

    //

    \;
  </cpp-chunk>

  <section|入口>

  金鱼Scheme的入口是非常精简的，主要的逻辑在<shell|src/goldfish.hpp>里面。这样做的好处在于方便复用hpp文件中的源代码。

  <\cpp-chunk|src/goldfish.cpp|true|false>
    #include "goldfish.hpp"

    #include \<less\>string\<gtr\>

    \;

    int

    main (int argc, char** argv) {

    #ifdef TB_CONFIG_OS_WINDOWS

    \ \ SetConsoleOutputCP (65001);

    #endif

    \ \ std::string \ \ \ \ \ gf_lib_dir \ = goldfish::find_goldfish_library ();

    \ \ const char* gf_lib \ \ \ \ \ = gf_lib_dir.c_str ();

    \ \ s7_scheme* sc= goldfish::init_goldfish_scheme (gf_lib);

    \ \ return goldfish::repl_for_community_edition (sc, argc, argv);

    }
  </cpp-chunk>

  <section|胶水代码汇总接口>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    void

    glue_for_community_edition (s7_scheme* sc) {

    \ \ glue_goldfish (sc);

    \ \ glue_scheme_time (sc);

    \ \ glue_scheme_process_context (sc);

    \ \ glue_liii_sys (sc);

    \ \ glue_liii_os (sc);

    \ \ glue_liii_path (sc);

    \ \ glue_liii_uuid (sc);

    }

    \;
  </cpp-chunk>

  <section|命令行>

  <paragraph|显示帮助>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static void

    display_help () {

    \ \ cout \<less\>\<less\> "Goldfish Scheme " \<less\>\<less\> GOLDFISH_VERSION \<less\>\<less\> " by LiiiLabs" \<less\>\<less\> endl;

    \ \ cout \<less\>\<less\> "--version\\t"

    \ \ \ \ \ \ \ \<less\>\<less\> "Display version" \<less\>\<less\> endl;

    \ \ cout \<less\>\<less\> "-m default\\t"

    \ \ \ \ \ \ \ \<less\>\<less\> "Allowed mode: default, liii, sicp, r7rs, s7" \<less\>\<less\> endl;

    \ \ cout \<less\>\<less\> "-e \ \ \ \ \ \ \\t"

    \ \ \ \ \ \ \ \<less\>\<less\> "Load the scheme code on the command line" \<less\>\<less\> endl

    \ \ \ \ \ \ \ \<less\>\<less\> "\\t\\teg. -e '(begin (display ‘Hello) (+ 1 2))'" \<less\>\<less\> endl;

    \ \ cout \<less\>\<less\> "-l FILE \ \\t"

    \ \ \ \ \ \ \ \<less\>\<less\> "Load the scheme code on path" \<less\>\<less\> endl;

    \ \ cout \<less\>\<less\> "FILE \ \ \ \ \\t"

    \ \ \ \ \ \ \ \<less\>\<less\> "Load the scheme code on path and print the evaluated result" \<less\>\<less\> endl;

    }

    \;
  </cpp-chunk>

  <paragraph|显示版本>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static void

    display_version () {

    \ \ cout \<less\>\<less\> "Goldfish Scheme " \<less\>\<less\> GOLDFISH_VERSION \<less\>\<less\> " by LiiiLabs" \<less\>\<less\> endl;

    \ \ cout \<less\>\<less\> "based on S7 Scheme " \<less\>\<less\> S7_VERSION \<less\>\<less\> " (" \<less\>\<less\> S7_DATE \<less\>\<less\> ")" \<less\>\<less\> endl;

    }

    \;
  </cpp-chunk>

  <paragraph|错误的命令行选项>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static void

    display_for_invalid_options () {

    \ \ cerr \<less\>\<less\> "Invalid command line options!" \<less\>\<less\> endl \<less\>\<less\> endl;

    \ \ display_help ();

    }

    \;
  </cpp-chunk>

  <paragraph|执行文件中的代码>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static void

    goldfish_eval_file (s7_scheme* sc, string path, bool quiet) {

    \ \ s7_pointer result= s7_load (sc, path.c_str ());

    \ \ if (!result) {

    \ \ \ \ cerr \<less\>\<less\> "Failed to load " \<less\>\<less\> path \<less\>\<less\> endl;

    \ \ \ \ exit (-1);

    \ \ }

    \ \ if (!quiet) {

    \ \ \ \ cout \<less\>\<less\> path \<less\>\<less\> " =\<gtr\> " \<less\>\<less\> s7_object_to_c_string (sc, result) \<less\>\<less\> endl;

    \ \ }

    }

    \;
  </cpp-chunk>

  <paragraph|执行命令行中以字符串形式传入的代码>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    static void

    goldfish_eval_code (s7_scheme* sc, string code) {

    \ \ s7_pointer x= s7_eval_c_string (sc, code.c_str ());

    \ \ cout \<less\>\<less\> s7_object_to_c_string (sc, x) \<less\>\<less\> endl;

    }

    \;
  </cpp-chunk>

  <paragraph|金鱼Scheme的初始化>

  <\enumerate>
    <item>初始化S7 Scheme

    <item>为S7 Scheme设置load path

    <item>初始化tbox

    <item>初始化胶水代码
  </enumerate>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    s7_scheme*

    init_goldfish_scheme (const char* gf_lib) {

    \ \ s7_scheme* sc= s7_init ();

    \ \ s7_add_to_load_path (sc, gf_lib);

    \;

    \ \ if (!tb_init (tb_null, tb_null)) exit (-1);

    \;

    \ \ glue_for_community_edition (sc);

    \ \ return sc;

    }

    \;
  </cpp-chunk>

  <paragraph|金鱼Scheme的运行模式>

  <code*|-m>帮助您指定预加载的标准库。

  <\description>
    <item*|default><code*|-m default>等价于<code*|-m liii>

    <item*|liii>预加载<code*|(liii base)>和<code*|(liii error)>的金鱼Scheme

    <item*|sicp>预加载<code*|(srfi sicp)>和<code*|(scheme base)>的S7 Scheme

    <item*|r7rs>预加载<code*|(scheme base)>的S7 Scheme

    <item*|s7>无任何无加载库的S7 Scheme
  </description>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    void

    customize_goldfish_by_mode (s7_scheme* sc, string mode,

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ const char* boot_file_path) {

    \ \ if (mode != "s7") {

    \ \ \ \ s7_load (sc, boot_file_path);

    \ \ }

    \;

    \ \ if (mode == "default" \|\| mode == "liii") {

    \ \ \ \ s7_eval_c_string (sc, "(import (liii base) (liii error) (liii lang))");

    \ \ }

    \ \ else if (mode == "scheme") {

    \ \ \ \ s7_eval_c_string (sc, "(import (liii base) (liii error))");

    \ \ }

    \ \ else if (mode == "sicp") {

    \ \ \ \ s7_eval_c_string (sc, "(import (scheme base) (srfi sicp))");

    \ \ }

    \ \ else if (mode == "r7rs") {

    \ \ \ \ s7_eval_c_string (sc, "(import (scheme base))");

    \ \ }

    \ \ else if (mode == "s7") {

    \ \ }

    \ \ else {

    \ \ \ \ cerr \<less\>\<less\> "No such mode: " \<less\>\<less\> mode \<less\>\<less\> endl;

    \ \ \ \ exit (-1);

    \ \ }

    }

    \;
  </cpp-chunk>

  <paragraph|REPL>

  <subparagraph|find_goldfish_library>

  定位Goldfish的函数库的目录，如果不存在，直接以-1为返回值退出，如果存在，则返回目录对应的完整路径。

  <\description>
    <item*|开发者模式>在这种模式下，Goldfish的可执行文件的路径是<shell|$(projectdir)/bin/goldfish>，而函数库的路径是<shell|$(projectdir)/goldfish)>。这种情况仅用于开发或者集成Goldfish。

    <item*|Linux>

    <\description>
      <item*|/usr/bin/goldfish>

      <item*|/usr/local/goldfish>

      这两种情况可以通过相对路径分别定位到Goldfish的函数库目录是<shell|/usr/share/goldfish>和<shell|/usr/local/share/goldfish>。

      <item*|/bin/goldfish>

      在这种情况下，我们直接将函数库目录设置为<shell|/usr/share/goldfish>。
    </description>
  </description>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    string

    find_goldfish_library () {

    \ \ string exe_path= goldfish_exe ();

    \;

    \ \ tb_char_t \ \ \ \ \ \ \ data_bin[TB_PATH_MAXN]= {0};

    \ \ tb_char_t const* ret_bin=

    \ \ \ \ \ \ tb_path_directory (exe_path.c_str (), data_bin, sizeof (data_bin));

    \;

    \ \ tb_char_t \ \ \ \ \ \ \ data_root[TB_PATH_MAXN]= {0};

    \ \ tb_char_t const* gf_root=

    \ \ \ \ \ \ tb_path_directory (ret_bin, data_root, sizeof (data_root));

    \;

    \ \ tb_char_t \ \ \ \ \ \ \ data_lib[TB_PATH_MAXN]= {0};

    \ \ tb_char_t const* gf_lib= tb_path_absolute_to (gf_root, "share/goldfish",

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ data_lib, sizeof (data_lib));

    #ifdef TB_CONFIG_OS_LINUX

    \ \ if (strcmp (gf_root, "/") == 0) {

    \ \ \ \ gf_lib= "/usr/share/goldfish";

    \ \ }

    #endif

    \;

    \ \ if (!tb_file_access (gf_lib, TB_FILE_MODE_RO)) {

    \ \ \ \ gf_lib=

    \ \ \ \ \ \ \ \ tb_path_absolute_to (gf_root, "goldfish", data_lib, sizeof (data_lib));

    \ \ \ \ if (!tb_file_access (gf_lib, TB_FILE_MODE_RO)) {

    \ \ \ \ \ \ cerr \<less\>\<less\> "The load path for Goldfish standard library does not exist"

    \ \ \ \ \ \ \ \ \ \ \ \<less\>\<less\> endl;

    \ \ \ \ \ \ exit (-1);

    \ \ \ \ }

    \ \ }

    \;

    \ \ return string (gf_lib);

    }

    \;
  </cpp-chunk>

  <subparagraph|find_goldfish_boot>

  定位Goldfish用于启动的Scheme脚本文件，如果不存在，直接以-1为返回值退出，如果存在，则返回改文件对应的完整路径。关于<shell|boot.scm>的具体细节，见<smart-ref|chapter:scheme_boot>。

  <\cpp-chunk|src/goldfish.hpp|true|true>
    string

    find_goldfish_boot (const char* gf_lib) {

    \ \ tb_char_t \ \ \ \ \ \ \ data_boot[TB_PATH_MAXN]= {0};

    \ \ tb_char_t const* gf_boot= tb_path_absolute_to (gf_lib, "scheme/boot.scm",

    \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ data_boot, sizeof (data_boot));

    \;

    \ \ if (!tb_file_access (gf_boot, TB_FILE_MODE_RO)) {

    \ \ \ \ cerr \<less\>\<less\> "The boot.scm for Goldfish Scheme does not exist" \<less\>\<less\> endl;

    \ \ \ \ exit (-1);

    \ \ }

    \ \ return string (gf_boot);

    }

    \;
  </cpp-chunk>

  <subparagraph|repl_for_community_edition>

  <\cpp-chunk|src/goldfish.hpp|true|true>
    int

    repl_for_community_edition (s7_scheme* sc, int argc, char** argv) {

    \ \ string \ \ \ \ \ gf_lib_dir \ = find_goldfish_library ();

    \ \ const char* gf_lib \ \ \ \ \ = gf_lib_dir.c_str ();

    \ \ string \ \ \ \ \ gf_boot_path= find_goldfish_boot (gf_lib);

    \ \ const char* gf_boot \ \ \ \ = gf_boot_path.c_str ();

    \;

    \ \ vector\<less\>string\<gtr\> all_args (argv, argv + argc);

    \ \ int \ \ \ \ \ \ \ \ \ \ \ all_args_N= all_args.size ();

    \ \ for (int i= 0; i \<less\> all_args_N; i++) {

    \ \ \ \ command_args.push_back (all_args[i]);

    \ \ }

    \;

    \ \ // zero args

    \ \ vector\<less\>string\<gtr\> args (argv + 1, argv + argc);

    \ \ if (args.size () == 0) {

    \ \ \ \ display_help ();

    \ \ \ \ exit (0);

    \ \ }

    \;

    \ \ const char* errmsg= NULL;

    \ \ s7_pointer \ old_port=

    \ \ \ \ \ \ s7_set_current_error_port (sc, s7_open_output_string (sc));

    \ \ int gc_loc= -1;

    \ \ if (old_port != s7_nil (sc)) gc_loc= s7_gc_protect (sc, old_port);

    \;

    \ \ // -m: Load the standard library by mode

    \ \ string mode_flag= "-m";

    \ \ string mode \ \ \ \ = "default";

    \ \ int \ \ \ args_N \ \ = args.size ();

    \ \ int \ \ \ i;

    \ \ for (i= 0; i \<less\> args_N; i++) {

    \ \ \ \ if (args[i] == mode_flag) {

    \ \ \ \ \ \ break;

    \ \ \ \ }

    \ \ }

    \ \ if (i \<less\> args_N && i + 1 \<gtr\>= args_N) {

    \ \ \ \ cerr \<less\>\<less\> "No mode specified after -m" \<less\>\<less\> endl;

    \ \ \ \ exit (-1);

    \ \ }

    \ \ if (i \<less\> args_N) {

    \ \ \ \ mode= args[i + 1];

    \ \ \ \ args.erase (args.begin () + i);

    \ \ \ \ args.erase (args.begin () + i);

    \ \ }

    \;

    \ \ customize_goldfish_by_mode (sc, mode, gf_boot);

    \;

    \ \ // Command options

    \ \ if (args.size () == 1 && args[0].size () \<gtr\> 0 && args[0][0] == '-') {

    \ \ \ \ if (args[0] == "--version") {

    \ \ \ \ \ \ display_version ();

    \ \ \ \ }

    \ \ \ \ else {

    \ \ \ \ \ \ display_for_invalid_options ();

    \ \ \ \ }

    \ \ }

    \ \ else if (args.size () \<gtr\>= 2 && args[0] == "-e") {

    \ \ \ \ goldfish_eval_code (sc, args[1]);

    \ \ }

    \ \ else if (args.size () \<gtr\>= 2 && args[0] == "-l") {

    \ \ \ \ goldfish_eval_file (sc, args[1], true);

    \ \ }

    \ \ else if (args.size () \<gtr\>= 1 && args[0].size () \<gtr\> 0 && args[0][0] != '-') {

    \ \ \ \ goldfish_eval_file (sc, args[0], false);

    \ \ }

    \ \ else {

    \ \ \ \ display_for_invalid_options ();

    \ \ }

    \;

    \ \ errmsg= s7_get_output_string (sc, s7_current_error_port (sc));

    \ \ if ((errmsg) && (*errmsg)) cout \<less\>\<less\> errmsg;

    \ \ s7_close_output_port (sc, s7_current_error_port (sc));

    \ \ s7_set_current_error_port (sc, old_port);

    \ \ if (gc_loc != -1) s7_gc_unprotect_at (sc, gc_loc);

    \;

    \ \ if ((errmsg) && (*errmsg)) return -1;

    \ \ else return 0;

    }

    \;
  </cpp-chunk>

  <paragraph|goldfish命名空间的结束>

  <\cpp-chunk|src/goldfish.hpp|true|false>
    } // namespace goldfish
  </cpp-chunk>

  \;

  \;
</body>

<\initial>
  <\collection>
    <associate|font-base-size|12>
    <associate|info-flag|paper>
    <associate|page-height|auto>
    <associate|page-medium|papyrus>
    <associate|page-orientation|landscape>
    <associate|page-screen-margin|false>
    <associate|page-type|a4>
    <associate|page-width|auto>
    <associate|par-columns|1>
    <associate|par-par-sep|0.3333fn>
    <associate|save-aux|false>
  </collection>
</initial>