Paste: vocab platform suffixes

! Copyright (c) 2007, 2010 slava pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs classes continuations init io kernel
kernel.private make math.parser namespaces sequences splitting ;
IN: system

PRIMITIVE: (exit) ( n -- * )
PRIMITIVE: disable-ctrl-break ( -- )
PRIMITIVE: enable-ctrl-break ( -- )
PRIMITIVE: nano-count ( -- ns )

SINGLETONS: x86.32 x86.64 arm.32 arm.64 ppc.32 ppc.64 ;

UNION: x86 x86.32 x86.64 ;
UNION: arm arm.32 arm.64 ;
UNION: ppc ppc.32 ppc.64 ;

: cpu ( -- class ) \ cpu get-global ; foldable

SINGLETONS: windows macosx linux freebsd ;

UNION: bsd freebsd ;
UNION: unix macosx linux freebsd bsd ;

CONSTANT: all-oses { unix bsd windows macosx linux freebsd }
CONSTANT: all-cpus { x86.32 x86.64 arm.32 arm.64 ppc.32 ppc.64 }

: os ( -- class ) \ os get-global ; foldable

: vm-version ( -- string ) \ vm-version get-global ;

: vm-git-label ( -- string ) \ vm-git-label get-global ;

: vm-git-ref ( -- string )
    vm-git-label "-" split1-last drop ;

: vm-git-id ( -- string )
    vm-git-label "-" split1-last nip ;

: vm-compiler ( -- string ) \ vm-compiler get-global ;

: vm-compile-time ( -- string ) \ vm-compile-time get-global ;

<PRIVATE

CONSTANT: string>cpu-hash H{
    { "x86.32" x86.32 }
    { "x86.64" x86.64 }
    { "arm.32" arm.32 }
    { "arm.64" arm.64 }
    { "ppc.32" ppc.32 }
    { "ppc.64" ppc.64 }
}

CONSTANT: string>os-hash H{
    { "windows" windows }
    { "macosx" macosx }
    { "freebsd" freebsd }
    { "linux" linux }
}

: string>cpu ( str -- class )
    string>cpu-hash at ;

: string>os ( str -- class )
    string>os-hash at ;

PRIVATE>

: make-platform-suffixes ( oses cpus -- seq )
    [ [ name>> ] map ] bi@
    [ ]
    [ [ [ "-" glue ] curry map ] with map concat ] 2bi 3append ;

MEMO: all-platform-suffixes ( -- seq )
    all-oses all-cpus make-platform-suffixes ;

MEMO: my-os-suffixes ( -- seq )
    all-oses [ os swap instance? ] filter ;

MEMO: my-cpu-suffixes ( -- seq )
    all-cpus [ cpu swap instance? ] filter ;

MEMO: my-platform-suffixes ( -- seq )
    my-os-suffixes my-cpu-suffixes make-platform-suffixes ;

: image-path ( -- path ) \ image-path get-global ;

: vm-path ( -- path ) \ vm-path get-global ;

: embedded? ( -- ? ) OBJ-EMBEDDED special-object ;

: version-info ( -- str )
    ! formatting vocab not available in this context.
    [
        "Factor " % vm-version %
        " " % cpu name>> %
        " (" % build # ", " %
        vm-git-ref % "-" %
        vm-git-id 10 short head % ", " %
        vm-compile-time % ")\n[" %
        vm-compiler % "] on " % os name>> %
    ] "" make ;

: exit ( n -- * )
    [ do-shutdown-hooks (exit) ] ignore-errors
    [ "Unexpected error during shutdown!" print flush ] ignore-errors
    255 (exit) ;


! macosx 64
my-platform-suffixes ...
{ "unix" "macosx" "x86.64" "unix-x86.64" "macosx-x86.64" }