From 4d01f20d6e7bd7ce4397227d577a6f54ec063853 Mon Sep 17 00:00:00 2001
From: Laria Carolin Chabowski <laria@laria.me>
Date: Tue, 4 Apr 2023 22:46:22 +0200
Subject: [PATCH] Implement first try of a module system

Very much inspired by lua, as so often: The module system maintains a list
of searchers that will be called with the requested module name. They can
then return a loader function, which will then be called again with the
module name. That loader then returns the actual module, which is then
cached. We also add a goofy "foo" module in main.c to test this.
---
 src/apfl.h       |  2 +
 src/builtins.c   | 36 ++++++++++++++++++
 src/globals.apfl | 98 ++++++++++++++++++++++++++++++++++++++++++++++++
 src/main.c       | 12 ++++++
 4 files changed, 148 insertions(+)

diff --git a/src/apfl.h b/src/apfl.h
index 0ac3f60..9880dec 100644
--- a/src/apfl.h
+++ b/src/apfl.h
@@ -835,6 +835,8 @@ void apfl_registry_set(apfl_ctx, void *key_major, size_t key_minor, apfl_stackid
 void apfl_registry_delete(apfl_ctx, void *key_major, size_t key_minor);
 bool apfl_registry_try_get(apfl_ctx, void *key_major, size_t key_minor);
 
+void apfl_modules_register(apfl_ctx ctx, const char *name, apfl_stackidx modloader);
+
 enum apfl_call_stack_entry_type {
     APFL_CSE_FUNCTION,
     APFL_CSE_CFUNCTION,
diff --git a/src/builtins.c b/src/builtins.c
index d1a9224..954224e 100644
--- a/src/builtins.c
+++ b/src/builtins.c
@@ -700,6 +700,41 @@ add_builtin(apfl_ctx ctx, const char *name, apfl_cfunc func)
     apfl_dict_set(ctx, -3, -2, -1);
 }
 
+static int cmod_searcher_registry_key;
+
+static void
+cmod_searcher(apfl_ctx ctx)
+{
+    ONE_ARG(ctx, "cmod-searcher");
+    if (!apfl_registry_try_get(ctx, &cmod_searcher_registry_key, 0)) {
+        apfl_drop(ctx, -1);
+        apfl_push_nil(ctx);
+        return;
+    }
+
+    if (apfl_get_member_if_exists(ctx, -1, -2)) {
+        apfl_sym_some(ctx);
+        apfl_push_pair(ctx, -1, -2);
+    } else {
+        apfl_push_nil(ctx);
+    }
+}
+
+void
+apfl_modules_register(apfl_ctx ctx, const char *name, apfl_stackidx modloader)
+{
+    apfl_move_to_top_of_stack(ctx, modloader);
+
+    if (!apfl_registry_try_get(ctx, &cmod_searcher_registry_key, 0)) {
+        apfl_dict_create(ctx);
+    }
+
+    apfl_push_const_string(ctx, name);
+    apfl_dict_set(ctx, -2, -1, -3);
+
+    apfl_registry_set(ctx, &cmod_searcher_registry_key, 0, -1);
+}
+
 void
 apfl_builtins(apfl_ctx ctx)
 {
@@ -744,4 +779,5 @@ apfl_builtins(apfl_ctx ctx)
     add_builtin(ctx, "raise", impl_raise);
     add_builtin(ctx, "getsym-Some", apfl_sym_some);
     add_builtin(ctx, "get-argv", get_argv);
+    add_builtin(ctx, "cmod-searcher", cmod_searcher);
 }
diff --git a/src/globals.apfl b/src/globals.apfl
index 83a74e3..e11883b 100644
--- a/src/globals.apfl
+++ b/src/globals.apfl
@@ -188,6 +188,45 @@
         }
     }
 
+    andalso := {
+    f ->
+        (f)
+    f ~fs ->
+        result := (f)
+        if result { andalso ~fs } { result }
+    }
+
+    orelse := {
+    f ->
+        (f)
+    f ~fs ->
+        result := (f)
+        if result { result } { orelse ~fs }
+    }
+
+    find-first := { l f ->
+        out := nil
+        i := 0
+        n := len l
+        while {andalso {== out nil} {< i n}} {
+            {
+            Some:x ->
+                out = Some::x
+            nil ->
+            } (f l@i)
+
+            i = ++ i
+        }
+
+        out
+    }
+
+    unwrap-some := {
+    Some:x then _ -> then x
+    x _ else -> else x
+    x then -> unwrap-some x then identity
+    }
+
     has-key := { k container ->
         {
             Some: _ -> true
@@ -199,6 +238,60 @@
         ((load-file f))
     }
 
+    modules := ({
+        loaded-modules := [->]
+        searchers := []
+
+        ImportError := symbol 'ImportError
+
+        add-searcher := { s ->
+            searchers = [~searchers s]
+        }
+
+        add-searcher { m ->
+            unwrap-some (get-optional m loaded-modules) { mod ->
+                { Some::mod }
+            }
+        }
+
+        add-searcher { m ->
+            unwrap-some (builtins.cmod-searcher m) { loader ->
+                Some::(loader)
+            }
+        }
+
+        import := { name ->
+            maybe-mod := find-first searchers { s ->
+                unwrap-some (s name) { loader ->
+                    loader name
+                }
+            }
+
+            {
+                Some:mod ->
+                    loaded-modules@name = mod
+                    mod
+                nil ->
+                    raise ImportError::(& "Module " name " not found")
+            } maybe-mod
+        }
+
+        add-preloaded-module := { name mod ->
+            loaded-modules@name = mod
+        }
+
+        modules := [
+            'import -> import
+            'add-searcher -> add-searcher
+            'add-preloaded-module -> add-preloaded-module
+            'ImportError -> ImportError
+        ]
+
+        add-preloaded-module 'modules modules
+
+        modules
+    })
+
     # Dictionary of exported functions
     [
         'if -> if
@@ -257,5 +350,10 @@
         'symbol -> symbol
         'Some -> Some
         'get-argv -> builtins.get-argv
+        'andalso -> andalso
+        'orelse -> orelse
+        'find-first -> find-first
+        'unwrap-some -> unwrap-some
+        'import -> modules.import
     ]
 }
diff --git a/src/main.c b/src/main.c
index c427042..4465ad9 100644
--- a/src/main.c
+++ b/src/main.c
@@ -166,6 +166,15 @@ eval_whole_file(apfl_ctx ctx, void *opaque)
 
 #define FMT_TRY(x) if (!(x)) { rv = 1; goto err; }
 
+static void
+foomod(apfl_ctx ctx)
+{
+    apfl_dict_create(ctx);
+    apfl_push_const_string(ctx, "bar");
+    apfl_push_const_string(ctx, "baz");
+    apfl_dict_set(ctx, -3, -2, -1);
+}
+
 static int
 eval(
     struct apfl_source_reader source_reader,
@@ -193,6 +202,9 @@ eval(
     }
     apfl_argv_set(ctx, -1);
 
+    apfl_push_cfunc(ctx, foomod, 0);
+    apfl_modules_register(ctx, "foo", -1);
+
     int rv = 0;
     if (run_as_repl) {
         apfl_iterative_runner runner = apfl_iterative_runner_new(ctx, source_reader);