VM: Three new special objects added to keep track of the builds version number, git...

[factor.git] / core / system / system.factor

diff --git a/core/system/system.factor b/core/system/system.factor
index 595c439f0cc6fe7e76cf01442a840b26dff185e2..f59bf7ff5533261cf65ae49a7750d0ca12f53864 100644 (file)
--- a/core/system/system.factor
+++ b/core/system/system.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2007, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: assocs init kernel.private namespaces ;
+USING: assocs init kernel kernel.private namespaces strings sequences ;
 IN: system
 
 SINGLETONS: x86.32 x86.64 arm ppc.32 ppc.64 ;
@@ -16,25 +16,44 @@ UNION: unix macosx linux ;
 
 : os ( -- class ) \ os get-global ; foldable
 
+: version ( -- string ) \ version get-global ; foldable
+
+: git-label ( -- string ) \ git-label get-global ; foldable
+
 : vm-compiler ( -- string ) \ vm-compiler get-global ; foldable
 
+: vm-compile-time ( -- string ) \ vm-compile-time get-global ; foldable
+
 <PRIVATE
 
+CONSTANT: string>cpu-hash H{
+    { "x86.32" x86.32 }
+    { "x86.64" x86.64 }
+    { "arm" arm }
+    { "ppc.32" ppc.32 }
+    { "ppc.64" ppc.64 }
+}
+
+CONSTANT: string>os-hash H{
+    { "windows" windows }
+    { "macosx" macosx }
+    { "linux" linux }
+}
+
+: key-for-value ( key hash -- val )
+    >alist [ first2 nip = ] with filter first first ;
+
 : string>cpu ( str -- class )
-    H{
-        { "x86.32" x86.32 }
-        { "x86.64" x86.64 }
-        { "arm" arm }
-        { "ppc.32" ppc.32 }
-        { "ppc.64" ppc.64 }
-    } at ;
+    string>cpu-hash at ;
+
+: cpu>string ( class -- str )
+    string>cpu-hash key-for-value ;
 
 : string>os ( str -- class )
-    H{
-        { "windows" windows }
-        { "macosx" macosx }
-        { "linux" linux }
-    } at ;
+    string>os-hash at ;
+
+: os>string ( class -- str )
+    string>os-hash key-for-value ;
 
 PRIVATE>
 
@@ -45,3 +64,9 @@ PRIVATE>
 : embedded? ( -- ? ) OBJ-EMBEDDED special-object ;
 
 : exit ( n -- * ) do-shutdown-hooks (exit) ;
+
+: version-info ( -- str )
+    ! formatting vocab not available in this context.
+    "Factor " version append " (" append git-label append ", " append
+    vm-compile-time append ") [" append vm-compiler append
+    " " append cpu cpu>string append "] on " append os os>string append ;