diff --git a/include/xo/procedure2/ObjectPrimitives.hpp b/include/xo/procedure2/ObjectPrimitives.hpp index e7dc312..ee2dfae 100644 --- a/include/xo/procedure2/ObjectPrimitives.hpp +++ b/include/xo/procedure2/ObjectPrimitives.hpp @@ -21,6 +21,9 @@ namespace xo { using AAllocator = xo::mm::AAllocator; public: + /** create primitive: report current working directory **/ + static DPrimitive_gco_0 * make_cwd_pm(obj mm); + /** create primitive: fetch nth element of a sequence **/ static DPrimitive_gco_2_gco_gco * make_nth_pm(obj mm); diff --git a/src/procedure2/ObjectPrimitives.cpp b/src/procedure2/ObjectPrimitives.cpp index 1cd0086..f5d7ab1 100644 --- a/src/procedure2/ObjectPrimitives.cpp +++ b/src/procedure2/ObjectPrimitives.cpp @@ -10,6 +10,7 @@ #include #include #include +#include // for getcwd() namespace xo { using xo::scm::ASequence; @@ -21,6 +22,23 @@ namespace xo { namespace scm { + // ----- cwd ----- + + obj + xfer_cwd(obj rcx) + { + char buf[PATH_MAX]; + ::getcwd(buf, sizeof(buf)); + + return obj(DString::from_cstr(rcx.allocator(), buf)); + } + + DPrimitive_gco_0 * + ObjectPrimitives::make_cwd_pm(obj mm) + { + return DPrimitive_gco_0::_make(mm, "cwd", &xfer_cwd); + } + // ----- nth ----- // TODO: seq_gc -> obj diff --git a/src/procedure2/procedure2_register_primitives.cpp b/src/procedure2/procedure2_register_primitives.cpp index c13dd4d..a5502d6 100644 --- a/src/procedure2/procedure2_register_primitives.cpp +++ b/src/procedure2/procedure2_register_primitives.cpp @@ -61,6 +61,7 @@ namespace xo { bool ok = true; + ok = ok & install_aux(sink, ObjectPrimitives::make_cwd_pm(mm), flags); ok = ok & install_aux(sink, ObjectPrimitives::make_nth_pm(mm), flags); ok = ok & install_aux(sink, ObjectPrimitives::make_cons_pm(mm), flags); ok = ok & install_aux(sink, ObjectPrimitives::make_dict_make_pm(mm), flags);