{-# LANGUAGE CPP #-} -------------------------------------------------- {-# LANGUAGE PackageImports #-} {-# LANGUAGE NamedFieldPuns, RecordWildCards #-} -------------------------------------------------- {-# LANGUAGE DeriveDataTypeable, DeriveGeneric, DeriveAnyClass #-} {-# LANGUAGE PatternSynonyms #-} -------------------------------------------------- -------------------------------------------------- {-| Information about the current system: * operating system — 'currentOperatingSystem'. * architecture — 'currentArchitecture'. * endianness — 'currentEndianness'. * processor — 'currentProcessorBits', 'currentNumberOfCPUs'. **TODO: respect cross-compilation, i.e. the target/runtime system.** And information about the current compiler: * haskell compiler — 'currentCompiler'. (This module is similar to the @Foundation.System@ module in the @foundation@ package.) -} module Prelude.Spiros.System ( module Prelude.Spiros.System -- , module System.Info ) where -------------------------------------------------- #include -------------------------------------------------- -- Imports --------------------------------------- -------------------------------------------------- import Prelude.Spiros.Compatibility() import Prelude.Spiros.Reexports import Prelude.Spiros.Utilities -------------------------------------------------- -------------------------------------------------- import qualified "cpuinfo" System.CPU as CPU -------------------------------------------------- import qualified "base" System.Info as Base import qualified "base" GHC.Conc as GHC -------------------------------------------------- -- Types ----------------------------------------- -------------------------------------------------- -- | Enumeration of the known GHC supported operating systems. -- data KnownOperatingSystem = Linux | Windows | OSX | Android | BSD deriving ( Enum,Bounded,Ix,Show,Read,Eq,Ord,Generic #if HAS_EXTENSION_DeriveAnyClass , NFData, Hashable #endif #if HAS_EXTENSION_DerivingLift , Lift #endif ) -------------------------------------------------- -- | get the operating system on which the program is running. -- -- Either return the known `OS` or a strict `String` of the OS name. -- -- This function uses the `base`'s `System.Info.os` function. -- currentOperatingSystem :: Either String KnownOperatingSystem currentOperatingSystem = case Base.os of "linux" -> Right Linux --TODO-- more linux strings. "mingw32" -> Right Windows "mingw64" -> Right Windows "darwin" -> Right OSX "linux-android" -> Right Android "openbsd" -> Right BSD "netbsd" -> Right BSD "freebsd" -> Right BSD s -> Left s -------------------------------------------------- -------------------------------------------------- -- | Enumeration of the known GHC supported architecture. -- data KnownArchitecture = KnownArchitecture { architectureManufacturer :: KnownManufacturer , architectureProcessorBits :: ProcessorBits -- vs « Maybe ProcessorBits » } deriving ( Show,Read,Eq,Ord,Generic #if HAS_EXTENSION_DeriveAnyClass , NFData, Hashable #endif #if HAS_EXTENSION_DerivingLift , Lift #endif ) -------------------------------------------------- -- | @'IntelManufacturer'@ and @'Processor64Bit'@. instance Default KnownArchitecture where def = KnownArchitecture{..} where architectureManufacturer = def architectureProcessorBits = def -------------------------------------------------- pattern I386 :: KnownArchitecture pattern I386 = KnownArchitecture { architectureManufacturer = Intel_Manufacturer, architectureProcessorBits = Processor32Bit } pattern X86_64 :: KnownArchitecture pattern X86_64 = KnownArchitecture { architectureManufacturer = Intel_Manufacturer, architectureProcessorBits = Processor64Bit } pattern PowerPC :: KnownArchitecture pattern PowerPC = KnownArchitecture { architectureManufacturer = PowerPC_Manufacturer, architectureProcessorBits = Processor32Bit } pattern PowerPC64 :: KnownArchitecture pattern PowerPC64 = KnownArchitecture { architectureManufacturer = PowerPC_Manufacturer, architectureProcessorBits = Processor64Bit } pattern Sparc :: KnownArchitecture pattern Sparc = KnownArchitecture { architectureManufacturer = Sparc_Manufacturer, architectureProcessorBits = Processor32Bit } pattern Sparc64 :: KnownArchitecture pattern Sparc64 = KnownArchitecture { architectureManufacturer = Sparc_Manufacturer, architectureProcessorBits = Processor64Bit } pattern ARM :: KnownArchitecture pattern ARM = KnownArchitecture { architectureManufacturer = ARM_Manufacturer, architectureProcessorBits = Processor32Bit } pattern ARM64 :: KnownArchitecture pattern ARM64 = KnownArchitecture { architectureManufacturer = ARM_Manufacturer, architectureProcessorBits = Processor64Bit } -------------------------------------------------- allKnownArchitectures :: [KnownArchitecture] allKnownArchitectures = do architectureManufacturer <- constructors' architectureProcessorBits <- constructors' return KnownArchitecture{..} -------------------------------------------------- -- | Get the machine architecture on which the program is running. -- -- Either return the known architecture or a Strict `String` of the -- architecture name. -- -- This function uses the `base`'s `System.Info.arch` function. -- currentArchitecture :: Either String KnownArchitecture currentArchitecture = case Base.arch of "i386" -> Right I386 "x86_64" -> Right X86_64 "powerpc" -> Right PowerPC "powerpc64" -> Right PowerPC64 "powerpc64le" -> Right PowerPC64 "sparc" -> Right Sparc "sparc64" -> Right Sparc64 "arm" -> Right ARM "aarch64" -> Right ARM64 s -> Left s -------------------------------------------------- -------------------------------------------------- data KnownManufacturer = Intel_Manufacturer | PowerPC_Manufacturer | Sparc_Manufacturer | ARM_Manufacturer deriving ( Enum,Bounded,Ix,Show,Read,Eq,Ord,Generic #if HAS_EXTENSION_DeriveAnyClass , NFData, Hashable #endif #if HAS_EXTENSION_DerivingLift , Lift #endif ) -------------------------------------------------- -- | @≡ 'Intel_Manufacturer'@ instance Default KnownManufacturer where def = Intel_Manufacturer -------------------------------------------------- -- | Get the manufacturer (if known) of the architecture on which the program is running. -- -- Uses `base`'s `System.Info.arch` function. -- currentManufacturer :: Maybe KnownManufacturer currentManufacturer = case currentArchitecture of Left _ -> Nothing Right KnownArchitecture{ architectureManufacturer } -> Just architectureManufacturer -------------------------------------------------- -------------------------------------------------- {-| Whether the processor is little-endian or big-endian. : "Endianness is the sequential order in which bytes are arranged into larger numerical values when stored in memory or when transmitted over digital links." -} data Endianness = LittleEndian | BigEndian deriving ( Enum,Bounded,Ix,Show,Read,Eq,Ord,Generic #if HAS_EXTENSION_DeriveAnyClass , NFData, Hashable #endif #if HAS_EXTENSION_DerivingLift , Lift #endif ) -------------------------------------------------- -- | @≡ 'LittleEndian'@ instance Default Endianness where def = LittleEndian -------------------------------------------------- {- | The endianness of the current machine's architecture. @Nothing@ represents: * unknown endianness. These endiannesses aren't represented: * Bi-endianness. (the endianness, if swapped before the haskell program starts up, may differ). For example, PowerPC processors start in big-endian, but PowerPC itself is bi-endian. -} currentEndianness :: Maybe Endianness currentEndianness = case currentArchitecture of Left _ -> Nothing Right KnownArchitecture{ architectureManufacturer } -> case architectureManufacturer of Intel_Manufacturer -> Just LittleEndian PowerPC_Manufacturer -> Just BigEndian Sparc_Manufacturer -> Just BigEndian ARM_Manufacturer -> Just BigEndian -------------------------------------------------- -------------------------------------------------- {- | Whether the processor is @64-bit@ or @32-bit@. : "In computer architecture, 64-bit computing is the use of processors that have datapath widths, integer size, and memory address widths of 64 bits (eight octets)." -} data ProcessorBits = Processor32Bit | Processor64Bit deriving ( Enum,Bounded,Ix,Show,Read,Eq,Ord,Generic #if HAS_EXTENSION_DeriveAnyClass , NFData, Hashable #endif #if HAS_EXTENSION_DerivingLift , Lift #endif ) -------------------------------------------------- -- | @≡ 'Processor64Bit'@ instance Default ProcessorBits where def = Processor64Bit -------------------------------------------------- -- | Get the number of bits (if known) of the processor on which the program is running. -- -- Uses `base`'s `System.Info.arch` function. -- currentProcessorBits :: Maybe ProcessorBits currentProcessorBits = case currentArchitecture of Left _ -> Nothing Right KnownArchitecture{ architectureProcessorBits } -> Just architectureProcessorBits -------------------------------------------------- -------------------------------------------------- -- | Enumeration of the known GHC-based compilers. -- data KnownHaskellCompiler = GHC -- ^ C @FFI@. | GHCJS -- ^ Javascript @FFI@. | GHCETA -- ^ Java @FFI@. deriving ( Enum,Bounded,Ix,Show,Read,Eq,Ord,Generic #if HAS_EXTENSION_DeriveAnyClass , NFData, Hashable #endif #if HAS_EXTENSION_DerivingLift , Lift #endif ) -------------------------------------------------- -- | get the compiler name -- -- This function uses the `base`'s `System.Info.compilerName` function. -- currentCompiler :: Either String KnownHaskellCompiler currentCompiler = case Base.compilerName of "ghc" -> Right GHC "ghcjs" -> Right GHCJS "eta" -> Right GHCETA s -> Left s -------------------------------------------------- -- | @≡ 'GHC'@ instance Default KnownHaskellCompiler where def = GHC -------------------------------------------------- -------------------------------------------------- data CPUsSummary = CPUsSummary { isHyperthreading :: IsHyperthreading , physicalCores :: Natural , logicalCores :: Natural } deriving ( Show,Read,Eq,Ord,Generic --TODO CPP for Generic #if HAS_EXTENSION_DeriveAnyClass , NFData, Hashable #endif #if HAS_EXTENSION_DerivingLift , Lift #endif ) -------------------------------------------------- instance Default CPUsSummary where def = CPUsSummary{..} where isHyperthreading = def physicalCores = 0 logicalCores = 0 -------------------------------------------------- -------------------------------------------------- {-| Whether the system is currently using any Hyperthreading. -} data IsHyperthreading = HyperthreadingIsDisabled | HyperthreadingIsEnabled deriving ( Enum,Bounded,Ix,Show,Read,Eq,Ord,Generic --TODO CPP for Generic #if HAS_EXTENSION_DeriveAnyClass , NFData, Hashable #endif #if HAS_EXTENSION_DerivingLift , Lift #endif ) -- deriving stock (Enum,Bounded,Ix) -- deriving stock (Show,Read,Eq,Ord,Lift,Generic) -- deriving anyclass (Enumerable) -- deriving anyclass (NFData,Hashable) -------------------------------------------------- -- | @≡ 'HyperthreadingIsDisabled'@ instance Default IsHyperthreading where def = HyperthreadingIsDisabled -------------------------------------------------- -- Functions ------------------------------------- -------------------------------------------------- -- | returns the number of CPUs the machine has currentNumberOfCPUs :: IO Natural currentNumberOfCPUs = unsafeNatural <$> GHC.getNumProcessors -------------------------------------------------- getCPUsVerbose :: IO [CPU.CPU] getCPUsVerbose = do allCpuInfo <- CPU.tryGetCPUs return $ (allCpuInfo & maybe [] id) -------------------------------------------------- getCPUsSummary :: IO CPUsSummary getCPUsSummary = do cpus <- getCPUsVerbose go cpus where go [] = return def go cpus = do let isHyperthreading = if CPU.hyperthreadingInUse cpus then HyperthreadingIsEnabled else HyperthreadingIsDisabled let physicalCores = CPU.physicalCores cpus & fromIntegral let logicalCores = CPU.logicalCores cpus & fromIntegral return CPUsSummary{..} -------------------------------------------------- -- Notes ----------------------------------------- -------------------------------------------------- {- -------------------------------------------------- TODO port « nixpkgs.platforms.* » e.g.: nix-repl> :p pkgs.platforms { aarch64 = [ { cpu = { bits = 64; family = "arm"; }; } ]; all = [ { } ]; arm = [ { cpu = { bits = 32; family = "arm"; }; } ]; cygwin = [ { abi = { _type = "abi"; name = "cygnus"; }; kernel = { _type = "kernel"; execFormat = { _type = "exec-format"; name = "pe"; }; families = { }; name = "windows"; }; } ]; darwin = [ { kernel = { families = { darwin = { _type = "exec-format"; name = "darwin"; }; }; }; } ]; freebsd = [ { kernel = { _type = "kernel"; execFormat = { _type = "exec-format"; name = "elf"; }; families = { bsd = { _type = "exec-format"; name = "bsd"; }; }; name = "freebsd"; }; } ]; gnu = [ { abi = { _type = "abi"; name = "gnu"; }; kernel = { _type = "kernel"; execFormat = { _type = "exec-format"; name = "elf"; }; families = { }; name = "linux"; }; } { abi = { _type = "abi"; float = "soft"; name = "gnueabi"; }; kernel = { _type = "kernel"; execFormat = «repeated»; families = «repeated»; name = "linux"; }; } { abi = { _type = "abi"; float = "hard"; name = "gnueabihf"; }; kernel = { _type = "kernel"; execFormat = «repeated»; families = «repeated»; name = "linux"; }; } ]; i686 = [ { cpu = { _type = "cpu-type"; bits = 32; family = "x86"; name = "i686"; significantByte = { _type = "significant-byte"; name = "littleEndian"; }; }; } ]; illumos = [ { kernel = { _type = "kernel"; execFormat = «repeated»; families = { }; name = "solaris"; }; } ]; linux = [ { kernel = { _type = "kernel"; execFormat = «repeated»; families = { }; name = "linux"; }; } ]; mesaPlatforms = [ "i686-linux" "x86_64-linux" "x86_64-darwin" "armv5tel-linux" "armv6l-linux" "armv7l-linux" "aarch64-linux" "powerpc64le-linux" ]; mips = [ { cpu = { family = "mips"; }; } ]; netbsd = [ { kernel = { _type = "kernel"; execFormat = «repeated»; families = { bsd = «repeated»; }; name = "netbsd"; }; } ]; none = [ ]; openbsd = [ { kernel = { _type = "kernel"; execFormat = «repeated»; families = { bsd = «repeated»; }; name = "openbsd"; }; } ]; riscv = [ { cpu = { family = "riscv"; }; } ]; unix = [ { kernel = { families = { bsd = { _type = "exec-format"; name = "bsd"; }; }; }; } { kernel = «repeated»; } { kernel = «repeated»; } { kernel = «repeated»; } { abi = «repeated»; kernel = «repeated»; } ]; windows = [ { kernel = { _type = "kernel"; execFormat = «repeated»; families = «repeated»; name = "windows"; }; } ]; x86 = [ { cpu = { family = "x86"; }; } ]; x86_64 = [ { cpu = { bits = 64; family = "x86"; }; } ]; } -------------------------------------------------- physicalProcessors :: [CPU] -> Int Counts the number of physical processors in the system. A physical processor corresponds to a single CPU unit in a single socket, i.e. unless you have a multi-socket motherboard, this number will be one. physicalCores :: [CPU] -> Int Counts the number of physical cores in the system. A physical core is an independent processing unit that reads and executes instructions on its own, but potentially shares its die (and other resources) with other cores. logicalCores :: [CPU] -> Int Counts the number of logical cores in the system. A logical core is a virtual processing unit exposed to the operating system, that may or may not directly correspond with an independent physical processing unit, e.g. a hyperthread appears as an independent processing unit to the operating system, but has no physically dedicated execution resources. hyperthreadingFactor :: [CPU] -> Rational The hyperthreading factor is the number of logical cores divided by the number of physical cores. This quantity indicates the degree to which physical execution resources are shared among logical processors, and may be used to tune parallel applications. hyperthreadingInUse :: [CPU] -> Bool If hyperthreading is in use, the hyperthreadingFactor will be greater than 1. https://guide.aelve.com/haskell/cpp-vww0qd72 Cpphs handles single quotes and /**/ correctly, doesn't mangle Haddock comments and knows about Haskell's multiline strings. To use cpphs, you need to add these options to all sections of your .cabal file: library ... build-tools: cpphs >= 1.19 ghc-options: -pgmP cpphs -optP --cpp The base-feature-macros package lets you write some macros more conveniently – e.g. instead of #if MIN_VERSION_base(4,8,0) you can write #if HAVE_FOLDABLE_TRAVERSABLE_IN_PRELUDE, which is much more understandable to a casual reader. Detect OS other move item up move item down edit item info delete item Summary edit summary The following variables are defined depending on OS: mingw32_HOST_OS – Windows darwin_HOST_OS – macOS ghcjs_HOST_OS – Javascript (when compiling with GHCJS) linux_HOST_OS – Linux (shouldn't be needed most of the time) freebsd_HOST_OS – FreeBSD netbsd_HOST_OS – NetBSD openbsd_HOST_OS – OpenBSD solaris_HOST_OS – Solaris For instance, here's how you can detect macOS: #ifdef darwin_HOST_OS ... #endif Note that despite lots of libraries using #if defined(mingw32_HOST_OS) || defined(__MINGW32__) for detecting Windows, you don't need to do it – just mingw32_HOST_OS will suffice. See this Trac ticket. Detect architecture other move item up move item down edit item info delete item Summary edit summary There are variables for detecting architecture: i386_HOST_ARCH – x86 x86_64_HOST_ARCH – x64 arm_HOST_ARCH – ARM (there's also arm_HOST_ARCH_PRE_ARMv7) powerpc_HOST_ARCH sparc_HOST_ARCH -}