patch foment to respect new envar R7RS_LIBRARY_PATH

1 files changed, 126 insertions, 0 deletions

diff --git a/mcgoron/guix/patches/foment-0.4.1-library-path.patch b/mcgoron/guix/patches/foment-0.4.1-library-path.patch
new file mode 100644
index 0000000..72312d7
--- /dev/null
+++ b/mcgoron/guix/patches/foment-0.4.1-library-path.patch
@@ -0,0 +1,126 @@
+diff --git a/src/foment.cpp b/src/foment.cpp
+index bafb058..7535a03 100644
+--- a/src/foment.cpp
++++ b/src/foment.cpp
+@@ -1402,6 +1402,57 @@ FObjectType ObjectTypes[] =
+     {FreeTag, "free", 0, 0}
+ };
+ 
++void PrependPath(const char *EnvarName)
++{
++    FObject lp = Assoc(MakeStringC(EnvarName), EnvironmentVariables);
++    if (PairP(lp))
++    {
++        FAssert(StringP(First(lp)));
++
++        lp = Rest(lp);
++
++        ulong_t strt = 0;
++        ulong_t idx = 0;
++        FObject InsertionPoint = LibraryPath;
++        while (InsertionPoint != EmptyListObject &&
++               Rest(InsertionPoint) != EmptyListObject) {
++            InsertionPoint = Rest(InsertionPoint);
++        }
++
++        while (idx < StringLength(lp))
++        {
++            if (AsString(lp)->String[idx] == PathSep)
++            {
++                if (idx > strt) {
++                    FObject str = MakeString(AsString(lp)->String + strt, idx - strt);
++                    if (InsertionPoint == EmptyListObject) {
++                        InsertionPoint = List(str);
++                    } else {
++                        SetRest(InsertionPoint, List(str));
++                        InsertionPoint = Rest(InsertionPoint);
++                    }
++                }
++
++                idx += 1;
++                strt = idx;
++            }
++
++            idx += 1;
++        }
++
++        if (idx > strt) {
++            FObject str = MakeString(AsString(lp)->String + strt, idx - strt);
++
++            if (InsertionPoint == EmptyListObject) {
++                InsertionPoint = List(str);
++            } else {
++                SetRest(InsertionPoint, List(str));
++                InsertionPoint = Rest(InsertionPoint);
++            }
++        }
++    }
++}
++
+ long_t SetupFoment(FThreadState * ts)
+ {
+ #ifdef FOMENT_WINDOWS
+@@ -1548,35 +1599,6 @@ long_t SetupFoment(FThreadState * ts)
+ 
+     GetEnvironmentVariables();
+ 
+-    FObject lp = Assoc(MakeStringC("FOMENT_LIBPATH"), EnvironmentVariables);
+-    if (PairP(lp))
+-    {
+-        FAssert(StringP(First(lp)));
+-
+-        lp = Rest(lp);
+-
+-        ulong_t strt = 0;
+-        ulong_t idx = 0;
+-        while (idx < StringLength(lp))
+-        {
+-            if (AsString(lp)->String[idx] == PathSep)
+-            {
+-                if (idx > strt)
+-                    LibraryPath = MakePair(
+-                            MakeString(AsString(lp)->String + strt, idx - strt), LibraryPath);
+-
+-                idx += 1;
+-                strt = idx;
+-            }
+-
+-            idx += 1;
+-        }
+-
+-        if (idx > strt)
+-            LibraryPath = MakePair(
+-                    MakeString(AsString(lp)->String + strt, idx - strt), LibraryPath);
+-    }
+-
+     LibraryExtensions = List(MakeStringC("sld"), MakeStringC("scm"));
+ 
+     if (CheckHeapFlag)
+diff --git a/src/foment.hpp b/src/foment.hpp
+index 745d5e4..22df578 100644
+--- a/src/foment.hpp
++++ b/src/foment.hpp
+@@ -1904,4 +1904,8 @@ inline long_t PathChP(FCh ch)
+ }
+ #endif // FOMENT_WINDOWS
+ 
++// Misc
++
++void PrependPath(const char *EnvarName);
++
+ #endif // __FOMENT_HPP__
+diff --git a/src/main.cpp b/src/main.cpp
+index f333d47..da6ebd5 100644
+--- a/src/main.cpp
++++ b/src/main.cpp
+@@ -873,7 +873,10 @@ int main(int argc, FChS * argv[])
+             AddToLibraryPath(argv[pdx]);
+         else if (RunMode == InteractiveMode)
+             LibraryPath = ReverseListModify(MakePair(MakeStringC("."), LibraryPath));
++
+         LibraryPathOptions();
++	PrependPath("FOMENT_LIBPATH");
++	PrependPath("R7RS_LIBRARY_PATH");
+ 
+         if (ShowVersion != 0)
+         {