os-envs primitive to get current environment

core/bootstrap/primitives.factor

@@ -272,6 +272,7 @@ H{ } clone update-map set
     { "set-innermost-frame-quot" "kernel.private" }
     { "call-clear" "kernel" }
     { "strip-compiled-quotations" "quotations" }
+    { "(os-envs)" "system" }
 }
 dup length [ >r first2 r> make-primitive ] 2each
 

core/inference/known-words/known-words.factor

@@ -577,3 +577,5 @@ t over set-effect-terminated?
 \ innermost-frame-scan { callstack } { fixnum } <effect> "inferred-effect" set-word-prop
 
 \ set-innermost-frame-quot { quotation callstack } { } <effect> "inferred-effect" set-word-prop
+
+\ (os-envs) { } { array } <effect> "inferred-effect" set-word-prop

core/system/system.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: system
-USING: kernel kernel.private sequences math namespaces ;
+USING: kernel kernel.private sequences math namespaces
+splitting assocs ;
 
 : cell ( -- n ) 7 getenv ; foldable
 
@@ -55,3 +56,6 @@ USING: kernel kernel.private sequences math namespaces ;
 : bootstrap-cells bootstrap-cell * ; inline
 
 : bootstrap-cell-bits 8 bootstrap-cells ; inline
+
+: os-envs ( -- assoc )
+    (os-envs) [ "=" split1 ] H{ } map>assoc ;

vm/os-macosx.h

@@ -11,3 +11,8 @@ const char *vm_executable_path(void);
 const char *default_image_path(void);
 
 DLLEXPORT void c_to_factor_toplevel(CELL quot);
+
+#ifndef environ
+	extern char ***_NSGetEnviron(void);
+	#define environ (*_NSGetEnviron())
+#endif

vm/os-unix.c

@@ -128,6 +128,24 @@ DEFINE_PRIMITIVE(cd)
 	chdir(unbox_char_string());
 }
 
+DEFINE_PRIMITIVE(os_envs)
+{
+	GROWABLE_ARRAY(result);
+	char **env = environ;
+
+	while(*env)
+	{
+		REGISTER_UNTAGGED(result);
+		CELL string = tag_object(from_char_string(*env));
+		UNREGISTER_UNTAGGED(result);
+		GROWABLE_ADD(result,string);
+		env++;
+	}
+
+	GROWABLE_TRIM(result);
+	dpush(tag_object(result));
+}
+
 F_SEGMENT *alloc_segment(CELL size)
 {
 	int pagesize = getpagesize();

vm/os-windows.c

@@ -207,3 +207,8 @@ void sleep_millis(DWORD msec)
 {
 	Sleep(msec);
 }
+
+DEFINE_PRIMITIVE(os_envs)
+{
+	not_implemented_error();
+}

vm/primitives.c

@@ -195,4 +195,5 @@ void *primitives[] = {
 	primitive_set_innermost_stack_frame_quot,
 	primitive_call_clear,
 	primitive_strip_compiled_quotations,
+	primitive_os_envs,
 };

vm/run.h

@@ -235,6 +235,7 @@ DECLARE_PRIMITIVE(getenv);
 DECLARE_PRIMITIVE(setenv);
 DECLARE_PRIMITIVE(exit);
 DECLARE_PRIMITIVE(os_env);
+DECLARE_PRIMITIVE(os_envs);
 DECLARE_PRIMITIVE(eq);
 DECLARE_PRIMITIVE(millis);
 DECLARE_PRIMITIVE(sleep);