Add concept of built-in libraries and (import) statement

R7RS syntax is: (import (library name here))

We translate this into the internal path "library/name/here". This will allow
us to easily load libraries from files later on by appending the ".sld" file
name extension.

c/builtins.c

@@ -34,6 +34,7 @@
 #include "flisp.h"
 
 #include "argcount.h"
+#include "libraries.h"
 
 size_t llength(value_t v)
 {
@@ -501,6 +502,9 @@ static struct builtinspec builtin_info[] = {
 
     { "os.getenv", fl_os_getenv },
     { "os.setenv", fl_os_setenv },
+
+    { "import", builtin_import },
+
     { NULL, NULL }
 };
 

c/libraries.c

@@ -0,0 +1,183 @@
+// Copyright 2019 Lassi Kortela
+// SPDX-License-Identifier: BSD-3-Clause
+
+#include <sys/types.h>
+
+#include <assert.h>
+#include <ctype.h>
+#include <errno.h>
+#include <limits.h>
+#include <locale.h>
+#include <math.h>
+#include <setjmp.h>
+#include <stdarg.h>
+#include <stdint.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <wctype.h>
+
+#include "dtypes.h"
+#include "utils.h"
+#include "utf8.h"
+#include "ios.h"
+#include "socket.h"
+#include "timefuncs.h"
+#include "hashing.h"
+#include "htable.h"
+#include "htableh_inc.h"
+#include "bitvector.h"
+#include "fs.h"
+#include "random.h"
+#include "llt.h"
+
+#include "ieee754.h"
+
+#include "flisp.h"
+
+#include "buf.h"
+#include "env.h"
+#include "opcodes.h"
+
+#include "stringfuncs.h"
+#include "libraries.h"
+
+struct builtin_procedure {
+    char *name;
+    builtin_t fptr;
+    uint32_t lib_id_mask;
+};
+
+struct builtin_library {
+    char *path;
+    uint32_t lib_id;
+};
+
+// R7RS libraries
+#define R7RS_BASE (1 << 0)
+#define R7RS_CHAR (1 << 1)
+#define R7RS_CXR (1 << 2)
+#define R7RS_FILE (1 << 3)
+#define R7RS_INEXACT (1 << 4)
+#define R7RS_PROCESS_CONTEXT (1 << 5)
+#define R7RS_READ (1 << 6)
+#define R7RS_WRITE (1 << 7)
+
+// SRFI libraries
+#define SRFI_0 (1 << 8)
+#define SRFI_13 (1 << 9)    // String Libraries
+#define SRFI_170 (1 << 10)  // POSIX API
+
+// Up Scheme libraries
+#define UP_2019 (1 << 11)
+
+static struct builtin_procedure builtin_procedures[] = {
+#if 0
+    { "create-directory", fs_create_directory, SRFI_170 | UP_2019 },
+    { "file-info", fs_file_info, SRFI_170 | UP_2019 },
+    { "string-null?", string_null_p, SRFI_13, UP_2019 },
+    { "make-string", string_make_string, SRFI_13 | UP_2019 },
+#endif
+
+    { "string?", fl_stringp, SRFI_13 | R7RS_BASE | UP_2019 },
+    { "string-reverse", fl_string_reverse, SRFI_13 | UP_2019 },
+    { "substring", fl_string_sub, R7RS_BASE | UP_2019 },
+
+    { 0, 0, 0 },
+};
+
+static struct builtin_library builtin_libraries[] = {
+    { "scheme/base", R7RS_BASE }, { "scheme/char", R7RS_CHAR },
+    { "scheme/cxr", R7RS_CXR },   { "scheme/file", R7RS_FILE },
+    { "srfi/13", SRFI_13 },       { "srfi/170", SRFI_170 },
+    { "upscheme/2019", UP_2019 }, { 0, 0 },
+};
+
+static struct builtin_library *builtin_library_by_path(const char *path)
+{
+    struct builtin_library *lib;
+
+    for (lib = builtin_libraries; lib->path; lib++) {
+        if (!strcmp(lib->path, path)) {
+            return lib;
+        }
+    }
+    return 0;
+}
+
+static void parse_library_name(struct buf *path, value_t libname, int pathsep)
+{
+    value_t part;
+
+    if (libname == FL_NIL) {
+        lerror(ArgError, "library name is the empty list");
+    }
+    for (;;) {
+        if (!iscons(libname)) {
+            lerror(ArgError, "library name is not a proper list");
+        }
+        part = car_(libname);
+        if (issymbol(part)) {
+            buf_puts(path, symbol_name(part));
+        } else if (isfixnum(part)) {
+            buf_putu(path, tofixnum(part, "library name part"));
+        } else {
+            lerror(ArgError, "library name part is not a symbol or a fixnum");
+        }
+        if ((libname = cdr_(libname)) == FL_NIL) {
+            break;
+        }
+        buf_putc(path, pathsep);
+    }
+}
+
+static void import_set(value_t impset)
+{
+    value_t head;
+    struct buf *path;
+    const char *name;
+    struct builtin_library *lib;
+    struct builtin_procedure *proc;
+
+    if (impset == FL_NIL) {
+        lerror(ArgError, "import: empty list given");
+    } else if (!iscons(impset)) {
+        lerror(ArgError, "import: non-list argument given");
+    }
+    head = car_(impset);
+    if (issymbol(head)) {
+        name = symbol_name(head);
+        if (!strcmp(name, "only")) {
+            lerror(ArgError, "import: not implemented: only");
+        } else if (!strcmp(name, "except")) {
+            lerror(ArgError, "import: not implemented: except");
+        } else if (!strcmp(name, "prefix")) {
+            lerror(ArgError, "import: not implemented: prefix");
+        } else if (!strcmp(name, "rename")) {
+            lerror(ArgError, "import: not implemented: rename");
+        }
+    }
+    path = buf_new();
+    parse_library_name(path, impset, '/');
+    // buf_puts(path, ".sld");
+    buf_putc(path, 0);
+    if (!(lib = builtin_library_by_path(path->bytes))) {
+        lerror(ArgError, "import: library not found");
+    }
+    for (proc = builtin_procedures; proc->name; proc++) {
+        if (proc->lib_id_mask & lib->lib_id) {
+            // fprintf(stderr, "Importing %s\n", proc->name);
+            setc(symbol(proc->name), cbuiltin(proc->name, proc->fptr));
+        }
+    }
+}
+
+value_t builtin_import(value_t *args, uint32_t nargs)
+{
+    uint32_t i;
+
+    for (i = 0; i < nargs; i++) {
+        import_set(args[i]);
+    }
+    return FL_NIL;
+}

c/libraries.h

@@ -0,0 +1 @@
+value_t builtin_import(value_t *args, uint32_t nargs);

c/stringfuncs.h

@@ -0,0 +1,3 @@
+value_t fl_stringp(value_t *args, uint32_t nargs);
+value_t fl_string_reverse(value_t *args, uint32_t nargs);
+value_t fl_string_sub(value_t *args, uint32_t nargs);

scripts/build.sh

@@ -50,6 +50,7 @@ set -x
 ln -s ../scheme-boot/flisp.boot flisp.boot
 $CC $CFLAGS -c ../c/bitvector-ops.c
 $CC $CFLAGS -c ../c/bitvector.c
+$CC $CFLAGS -c ../c/buf.c
 $CC $CFLAGS -c ../c/builtins.c
 $CC $CFLAGS -c ../c/dump.c
 $CC $CFLAGS -c ../c/env_unix.c
@@ -63,6 +64,7 @@ $CC $CFLAGS -c ../c/htable.c
 $CC $CFLAGS -c ../c/int2str.c
 $CC $CFLAGS -c ../c/ios.c
 $CC $CFLAGS -c ../c/iostream.c
+$CC $CFLAGS -c ../c/libraries.c
 $CC $CFLAGS -c ../c/lltinit.c
 $CC $CFLAGS -c ../c/ptrhash.c
 $CC $CFLAGS -c ../c/random.c
@@ -72,10 +74,10 @@ $CC $CFLAGS -c ../c/table.c
 $CC $CFLAGS -c ../c/time_unix.c
 $CC $CFLAGS -c ../c/utf8.c
 $CC $LFLAGS -o upscheme -lm \
-    bitvector-ops.o bitvector.o builtins.o dump.o env_unix.o \
+    bitvector-ops.o bitvector.o buf.o builtins.o dump.o env_unix.o \
     equalhash.o flisp.o flmain.o fs_"$os".o fs_unix.o \
     hashing.o htable.o int2str.o \
-    ios.o iostream.o lltinit.o ptrhash.o random.o socket.o \
+    ios.o iostream.o libraries.o lltinit.o ptrhash.o random.o socket.o \
     string.o table.o time_unix.o utf8.o
 { set +x; } 2>/dev/null
 cd ../scheme-core