core/system/system.factor

   1 ! Copyright (C) 2007, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: assocs init kernel kernel.private namespaces strings sequences ;
   4 IN: system
   5
   6 SINGLETONS: x86.32 x86.64 arm ppc.32 ppc.64 ;
   7
   8 UNION: x86 x86.32 x86.64 ;
   9 UNION: ppc ppc.32 ppc.64 ;
  10
  11 : cpu ( -- class ) \ cpu get-global ; foldable
  12
  13 SINGLETONS: windows macosx linux ;
  14
  15 UNION: unix macosx linux ;
  16
  17 : os ( -- class ) \ os get-global ; foldable
  18
  19 : version ( -- string ) \ version get-global ; foldable
  20
  21 : git-label ( -- string ) \ git-label get-global ; foldable
  22
  23 : vm-compiler ( -- string ) \ vm-compiler get-global ; foldable
  24
  25 : vm-compile-time ( -- string ) \ vm-compile-time get-global ; foldable
  26
  27 <PRIVATE
  28
  29 CONSTANT: string>cpu-hash H{
  30     { "x86.32" x86.32 }
  31     { "x86.64" x86.64 }
  32     { "arm" arm }
  33     { "ppc.32" ppc.32 }
  34     { "ppc.64" ppc.64 }
  35 }
  36
  37 CONSTANT: string>os-hash H{
  38     { "windows" windows }
  39     { "macosx" macosx }
  40     { "linux" linux }
  41 }
  42
  43 : key-for-value ( key hash -- val )
  44     >alist [ first2 nip = ] with filter first first ;
  45
  46 : string>cpu ( str -- class )
  47     string>cpu-hash at ;
  48
  49 : cpu>string ( class -- str )
  50     string>cpu-hash key-for-value ;
  51
  52 : string>os ( str -- class )
  53     string>os-hash at ;
  54
  55 : os>string ( class -- str )
  56     string>os-hash key-for-value ;
  57
  58 PRIVATE>
  59
  60 : image ( -- path ) \ image get-global ;
  61
  62 : vm ( -- path ) \ vm get-global ;
  63
  64 : embedded? ( -- ? ) OBJ-EMBEDDED special-object ;
  65
  66 : exit ( n -- * ) do-shutdown-hooks (exit) ;
  67
  68 : version-info ( -- str )
  69     ! formatting vocab not available in this context.
  70     "Factor " version append " (" append git-label append ", " append
  71     vm-compile-time append ") [" append vm-compiler append
  72     " " append cpu cpu>string append "] on " append os os>string append ;