-- | Settings for the JIT, read from the environment by 'readConfig' when ucm
-- starts, and carried in the JIT handle from then on (see JIT.hs). The mode
-- also has a command-line option, @--jit@, which overrides the variable.
-- How to use these is in development.md next to this module.
module Unison.Runtime.JIT.Config
  ( Mode (..),
    Replacements (..),
    ReplacementUse (..),
    Config (..),
    replacements,
    setReplacements,
    replacementActive,
    readConfig,
    jitLog,
    jitDump,
  )
where

import Control.Exception (throwIO)
import Data.Char (toLower)
import Data.IORef
import Data.List (stripPrefix)
import Data.Maybe (fromMaybe, isJust, mapMaybe)
import System.Environment (lookupEnv)
import System.IO (hFlush, hPutStrLn, stderr)
import System.IO.Unsafe (unsafePerformIO)
import Text.Read (readMaybe)

data Mode
  = -- | never compile
    Off
  | -- | compile what gets hot, in the background (LLVM is loaded at startup)
    On
  | -- | compile everything as it is loaded (for testing)
    Eager
  deriving (Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> [Char]
(Int -> Mode -> ShowS)
-> (Mode -> [Char]) -> ([Mode] -> ShowS) -> Show Mode
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mode -> ShowS
showsPrec :: Int -> Mode -> ShowS
$cshow :: Mode -> [Char]
show :: Mode -> [Char]
$cshowList :: [Mode] -> ShowS
showList :: [Mode] -> ShowS
Show, Mode -> Mode -> Bool
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
/= :: Mode -> Mode -> Bool
Eq)

-- | Which of the Haskell replacements of base library definitions
-- (@Unison.Runtime.Foreign.Function.functionReplacementList@) the runtime
-- applies when it loads code.
data Replacements
  = -- | every entry of the list
    AllReplacements
  | -- | the entries tagged 'Always'; the ones tagged 'InterpreterOnly' are
    -- left as the Unison code they would replace, for the JIT to compile
    TaggedReplacements
  | -- | none (for measuring an 'Always' entry against native code)
    NoReplacements
  deriving (Int -> Replacements -> ShowS
[Replacements] -> ShowS
Replacements -> [Char]
(Int -> Replacements -> ShowS)
-> (Replacements -> [Char])
-> ([Replacements] -> ShowS)
-> Show Replacements
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Replacements -> ShowS
showsPrec :: Int -> Replacements -> ShowS
$cshow :: Replacements -> [Char]
show :: Replacements -> [Char]
$cshowList :: [Replacements] -> ShowS
showList :: [Replacements] -> ShowS
Show, Replacements -> Replacements -> Bool
(Replacements -> Replacements -> Bool)
-> (Replacements -> Replacements -> Bool) -> Eq Replacements
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Replacements -> Replacements -> Bool
== :: Replacements -> Replacements -> Bool
$c/= :: Replacements -> Replacements -> Bool
/= :: Replacements -> Replacements -> Bool
Eq)

-- | The tag on an entry of the replacement list: whether it is applied
-- under 'TaggedReplacements', the JIT's default.
data ReplacementUse = Always | InterpreterOnly
  deriving (Int -> ReplacementUse -> ShowS
[ReplacementUse] -> ShowS
ReplacementUse -> [Char]
(Int -> ReplacementUse -> ShowS)
-> (ReplacementUse -> [Char])
-> ([ReplacementUse] -> ShowS)
-> Show ReplacementUse
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReplacementUse -> ShowS
showsPrec :: Int -> ReplacementUse -> ShowS
$cshow :: ReplacementUse -> [Char]
show :: ReplacementUse -> [Char]
$cshowList :: [ReplacementUse] -> ShowS
showList :: [ReplacementUse] -> ShowS
Show, ReplacementUse -> ReplacementUse -> Bool
(ReplacementUse -> ReplacementUse -> Bool)
-> (ReplacementUse -> ReplacementUse -> Bool) -> Eq ReplacementUse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReplacementUse -> ReplacementUse -> Bool
== :: ReplacementUse -> ReplacementUse -> Bool
$c/= :: ReplacementUse -> ReplacementUse -> Bool
/= :: ReplacementUse -> ReplacementUse -> Bool
Eq)

-- | Which replacements apply, decided once. This is the one setting that
-- is not carried in the JIT handle: it decides how a @Map@ value is
-- represented, which the value decoder (Stack.hs) and the foreign function
-- table (Foreign.Function) have to agree on, and neither has a handle in
-- reach. It is a property of the process, so a single decision is right.
-- A compiled program chooses it before any code loads, from the mode it
-- was compiled under ('setReplacements'; the file carries it, since its
-- MCode has the replacements of that mode baked in); otherwise the
-- environment decides: @UNISON_REPLACEMENTS@ if set, else it follows
-- @UNISON_JIT@.
replacements :: Replacements
replacements :: Replacements
replacements = IO Replacements -> Replacements
forall a. IO a -> a
unsafePerformIO (IO Replacements -> Replacements)
-> IO Replacements -> Replacements
forall a b. (a -> b) -> a -> b
$ do
  Maybe Replacements
chosen <- IORef (Maybe Replacements) -> IO (Maybe Replacements)
forall a. IORef a -> IO a
readIORef IORef (Maybe Replacements)
replacementsRef
  Replacements
r <- IO Replacements
-> (Replacements -> IO Replacements)
-> Maybe Replacements
-> IO Replacements
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO Replacements
replacementsFromEnvironment Replacements -> IO Replacements
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Replacements
chosen
  IORef (Maybe Replacements) -> Maybe Replacements -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Replacements)
replacementsRef (Replacements -> Maybe Replacements
forall a. a -> Maybe a
Just Replacements
r)
  IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
replacementsUsed Bool
True
  pure Replacements
r
{-# NOINLINE replacements #-}

replacementsFromEnvironment :: IO Replacements
replacementsFromEnvironment :: IO Replacements
replacementsFromEnvironment = do
  Maybe [Char]
mode <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"UNISON_JIT"
  Maybe [Char]
repl <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"UNISON_REPLACEMENTS"
  pure $ case ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> Maybe [Char] -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Char]
repl, (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ([Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"off" Maybe [Char]
mode)) of
    (Just [Char]
"on", [Char]
_) -> Replacements
AllReplacements
    (Just [Char]
"off", [Char]
_) -> Replacements
NoReplacements
    (Maybe [Char]
_, [Char]
"on") -> Replacements
TaggedReplacements
    (Maybe [Char]
_, [Char]
"eager") -> Replacements
TaggedReplacements
    (Maybe [Char], [Char])
_ -> Replacements
AllReplacements

replacementsRef :: IORef (Maybe Replacements)
replacementsRef :: IORef (Maybe Replacements)
replacementsRef = IO (IORef (Maybe Replacements)) -> IORef (Maybe Replacements)
forall a. IO a -> a
unsafePerformIO (Maybe Replacements -> IO (IORef (Maybe Replacements))
forall a. a -> IO (IORef a)
newIORef Maybe Replacements
forall a. Maybe a
Nothing)
{-# NOINLINE replacementsRef #-}

replacementsUsed :: IORef Bool
replacementsUsed :: IORef Bool
replacementsUsed = IO (IORef Bool) -> IORef Bool
forall a. IO a -> a
unsafePerformIO (Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False)
{-# NOINLINE replacementsUsed #-}

-- | Chooses the setting, for a compiled program from the mode stored in
-- its file. It has to happen before any code has used the setting (before
-- the cache is restored): code already loaded under another mode can't be
-- redone, so a late choice that differs is an error.
setReplacements :: Replacements -> IO ()
setReplacements :: Replacements -> IO ()
setReplacements Replacements
r = do
  Bool
used <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
replacementsUsed
  Maybe Replacements
chosen <- IORef (Maybe Replacements) -> IO (Maybe Replacements)
forall a. IORef a -> IO a
readIORef IORef (Maybe Replacements)
replacementsRef
  case Maybe Replacements
chosen of
    Just Replacements
r' | Bool
used Bool -> Bool -> Bool
&& Replacements
r' Replacements -> Replacements -> Bool
forall a. Eq a => a -> a -> Bool
/= Replacements
r -> IOError -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO ([Char] -> IOError
userError ([Char]
"the replacement setting is " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Replacements -> [Char]
forall a. Show a => a -> [Char]
show Replacements
r' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" and already in use; it cannot be changed to " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Replacements -> [Char]
forall a. Show a => a -> [Char]
show Replacements
r))
    Maybe Replacements
_ -> IORef (Maybe Replacements) -> Maybe Replacements -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Replacements)
replacementsRef (Replacements -> Maybe Replacements
forall a. a -> Maybe a
Just Replacements
r)

-- | Whether an entry with this tag is applied under the current settings.
replacementActive :: ReplacementUse -> Bool
replacementActive :: ReplacementUse -> Bool
replacementActive ReplacementUse
use = case Replacements
replacements of
  Replacements
AllReplacements -> Bool
True
  Replacements
NoReplacements -> Bool
False
  Replacements
TaggedReplacements -> ReplacementUse
use ReplacementUse -> ReplacementUse -> Bool
forall a. Eq a => a -> a -> Bool
== ReplacementUse
Always

data Config = Config
  { Config -> Mode
mode :: Mode,
    -- | with 'On': interpreted calls before a definition is compiled
    -- (@UNISON_JIT_THRESHOLD@)
    Config -> Int
threshold :: Int,
    -- | with 'On': the most definitions compiled together as one module
    -- (@UNISON_JIT_BATCH@)
    Config -> Int
batch :: Int,
    -- | with 'On': the estimated calls between a definition and the batch
    -- being formed that make it join the batch (@UNISON_JIT_BATCH_GATE@;
    -- a quarter of the threshold by default). See JIT.formBatch.
    Config -> Int
batchGate :: Int,
    -- | with 'On': the size of a typical definition, in units of its frame
    -- size times its call sites (the generated code grows with both). A
    -- candidate's estimated calls are divided by its size in these units,
    -- so that a large definition needs proportionally more calls across its
    -- edges to join a batch (@UNISON_JIT_SIZE_UNIT@). See JIT.formBatch.
    Config -> Int
sizeUnit :: Int,
    -- | the LLVM pass pipeline a module is optimized with
    -- (@UNISON_JIT_PASSES@; the empty string runs none). The default is
    -- 'defaultPasses', the parts of @default<O2>@ that matter for our
    -- code; @default<O2>@ itself and @UNISON_JIT_CODEGEN_LEVEL@ (which
    -- jit_llvm.c reads itself) are there for comparison.
    Config -> [Char]
passes :: String,
    -- | exits and unwinds write the frame back through one call to the C
    -- routine @unison_jit_exit_frame@ per site, the live slots as its
    -- arguments, rather than through generated write-back blocks
    -- (@UNISON_JIT_EXITS=call@, the default, or @blocks@). See
    -- Codegen.joinShared.
    Config -> Bool
exitCall :: Bool,
    -- | with 'On': a compiled callee of a definition being compiled is
    -- compiled again as a private copy in the new module, so that calls to
    -- it are direct and LLVM can inline it, when the callee's estimated
    -- work per call (JIT.Estimate's saving) is at most this
    -- (@UNISON_JIT_COPY@; 0 turns copies off)
    Config -> Double
copyBound :: Double,
    -- | with 'On': milliseconds the compile thread waits for more re-entry
    -- function requests before compiling the ones it holds as one module
    -- (@UNISON_JIT_REENTRY_WAIT@; 0 compiles each at once)
    Config -> Int
reentryWait :: Int,
    -- | with 'On': how many re-entry functions a group may get because of
    -- exits the code didn't cause, the poll and stack growth
    -- (@UNISON_JIT_REENTRY_ADHOC@; see JIT.noteAdHocExit)
    Config -> Int
reentryAdHoc :: Int,
    -- | what leaving native code and coming back costs, in units of the
    -- interpreter's overhead for one simple instruction: a function is
    -- left interpreted when its certain exits times this exceed what
    -- compiling it saves (@UNISON_JIT_EXIT_COST@; 0 compiles everything).
    -- See JIT.Estimate.
    Config -> Double
exitCost :: Double,
    -- | what entering native code from the interpreter costs, in the same
    -- units: a compiled function that saves less than this per call is
    -- still interpreted when the interpreter calls it
    -- (@UNISON_JIT_ENTRY_COST@; 0 always enters)
    Config -> Double
entryCost :: Double,
    -- | log each compiled module to stderr
    Config -> Bool
logging :: Bool,
    -- | directory to write each module's IR into, with the MCode of each
    -- function as a comment; @-@ prints it to stderr instead
    Config -> Maybe [Char]
dumpIR :: Maybe FilePath,
    -- | print the MCode of every loaded definition to stderr
    Config -> Bool
dumpMCode :: Bool,
    -- | log every transition between native code and the interpreter
    Config -> Bool
trace :: Bool,
    -- | print exit counts after each evaluation (@UNISON_JIT_STATS@)
    Config -> Bool
stats :: Bool,
    -- | with stats: print the exits taken since the last time whenever
    -- the program writes output, and start counting again
    -- (@UNISON_JIT_STATS=each@), so that a program that prints a line per
    -- phase gets its exits listed per phase
    Config -> Bool
statsEach :: Bool,
    -- | with stats: also print the counts every this many exits (for
    -- evaluations that never finish)
    Config -> Int
statsEvery :: Int,
    -- | fire the entry poll every N entries (stress mode @poll=N@)
    Config -> Int
stressPoll :: Int,
    -- | initial Unison stack size in slots (stress mode @ustack=N@)
    Config -> Maybe Int
stressStack :: Maybe Int,
    -- | treat every Nth callee as not compiled (stress mode @callee=N@)
    Config -> Int
stressCallee :: Int,
    -- | C stack budget for native calls, in bytes (stress mode @cstack=N@)
    Config -> Int
stressCStack :: Int,
    -- | allocation budget between polls, in words (stress mode @alloc=N@)
    Config -> Int
stressAlloc :: Int,
    -- | milliseconds to sleep between installing each function of a
    -- module (stress mode @install=N@)
    Config -> Int
stressInstall :: Int,
    -- | size of the constant pool before it has to grow (stress mode @pool=N@)
    Config -> Maybe Int
stressPool :: Maybe Int,
    -- | random operations to run through the list helpers at startup,
    -- each checked against the interpreter's (stress mode @lists=N@)
    Config -> Int
stressLists :: Int,
    -- | the same for the text helpers (stress mode @texts=N@)
    Config -> Int
stressTexts :: Int,
    -- | and for the bytes helpers (stress mode @bytes=N@)
    Config -> Int
stressBytes :: Int,
    -- | features turned off for debugging, from @UNISON_JIT_DISABLE@
    -- (comma separated): @app@ (closure calls), @apply@ (the interpreter
    -- entering native code for a closure), @ref@, @array@, @cmp@
    -- (universal comparison), @list@, @text@, @bytes@ (the C helpers for
    -- those), @callout@ (call-outs become resumes), @direct@ (calls within a
    -- module go through cells), @worker@ (no workers with register arguments),
    -- @copy@ (no private copies of compiled callees), @hash@ (the murmur hash),
    -- @irhelpers@ (the helpers compiled from IR: generated code calls the C
    -- copies instead), @requests@ (ability requests and the affine handler
    -- instructions: every request exits), @ptr@ (the FFI pointer reads and
    -- writes), @records@ (the record instructions: every one exits)
    Config -> [[Char]]
disabled :: [String]
  }
  deriving (Int -> Config -> ShowS
[Config] -> ShowS
Config -> [Char]
(Int -> Config -> ShowS)
-> (Config -> [Char]) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Config -> ShowS
showsPrec :: Int -> Config -> ShowS
$cshow :: Config -> [Char]
show :: Config -> [Char]
$cshowList :: [Config] -> ShowS
showList :: [Config] -> ShowS
Show)

-- | Reads the settings from the environment. Called once, by ucm at
-- startup, after the @--jit@ options have been put in the environment.
readConfig :: IO Config
readConfig :: IO Config
readConfig = do
  -- The settings that change what code is generated or make the runtime
  -- weaker (the stress modes, the disabled features, the pass pipeline, the
  -- dumps and traces) are read only when UNISON_JIT_DEBUG is also set, so
  -- that a stray variable in the environment of a program's user does
  -- nothing. jit_llvm.c and jit_rt.c read the
  -- same gate for theirs; --jit-dump-ir sets it.
  Bool
debug <- Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [Char] -> Bool) -> IO (Maybe [Char]) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"UNISON_JIT_DEBUG"
  let gated :: [Char] -> IO (Maybe [Char])
gated [Char]
name = if Bool
debug then [Char] -> IO (Maybe [Char])
lookupEnv [Char]
name else Maybe [Char] -> IO (Maybe [Char])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [Char]
forall a. Maybe a
Nothing
  Maybe [Char]
mode <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"UNISON_JIT"
  Maybe [Char]
logging <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"UNISON_JIT_LOG"
  Maybe [Char]
dump <- [Char] -> IO (Maybe [Char])
gated [Char]
"UNISON_JIT_DUMP_IR"
  Maybe [Char]
stats <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"UNISON_JIT_STATS"
  Maybe [Char]
every <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"UNISON_JIT_STATS_EVERY"
  Maybe [Char]
thresh <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"UNISON_JIT_THRESHOLD"
  Maybe [Char]
batchSize <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"UNISON_JIT_BATCH"
  Maybe [Char]
gate <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"UNISON_JIT_BATCH_GATE"
  Maybe [Char]
sizeU <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"UNISON_JIT_SIZE_UNIT"
  Maybe [Char]
pipeline <- [Char] -> IO (Maybe [Char])
gated [Char]
"UNISON_JIT_PASSES"
  Maybe [Char]
exits <- [Char] -> IO (Maybe [Char])
gated [Char]
"UNISON_JIT_EXITS"
  Maybe [Char]
copyB <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"UNISON_JIT_COPY"
  Maybe [Char]
reWait <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"UNISON_JIT_REENTRY_WAIT"
  Maybe [Char]
reAdHoc <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"UNISON_JIT_REENTRY_ADHOC"
  Maybe [Char]
cost <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"UNISON_JIT_EXIT_COST"
  Maybe [Char]
entry <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"UNISON_JIT_ENTRY_COST"
  Maybe [Char]
mcode <- [Char] -> IO (Maybe [Char])
gated [Char]
"UNISON_JIT_DUMP_MCODE"
  Maybe [Char]
tr <- [Char] -> IO (Maybe [Char])
gated [Char]
"UNISON_JIT_TRACE"
  [[Char]]
stress <- [[Char]] -> ([Char] -> [[Char]]) -> Maybe [Char] -> [[Char]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Char -> [Char] -> [[Char]]
forall {t}. Eq t => t -> [t] -> [[t]]
splitOn Char
',') (Maybe [Char] -> [[Char]]) -> IO (Maybe [Char]) -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Maybe [Char])
gated [Char]
"UNISON_JIT_STRESS"
  [[Char]]
disabledFeatures <- [[Char]] -> ([Char] -> [[Char]]) -> Maybe [Char] -> [[Char]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Char -> [Char] -> [[Char]]
forall {t}. Eq t => t -> [t] -> [[t]]
splitOn Char
',') (Maybe [Char] -> [[Char]]) -> IO (Maybe [Char]) -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Maybe [Char])
gated [Char]
"UNISON_JIT_DISABLE"
  let setting :: [Char] -> Maybe Int
setting [Char]
key = [[Char]] -> Maybe [Char]
forall {a}. [a] -> Maybe a
listToMaybe' (([Char] -> Maybe [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix ([Char]
key [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"=")) [[Char]]
stress) Maybe [Char] -> ([Char] -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe
  pure
    Config
      { mode :: Mode
mode = case (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ([Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"off" Maybe [Char]
mode) of
          [Char]
"eager" -> Mode
Eager
          [Char]
"on" -> Mode
On
          [Char]
_ -> Mode
Off,
        threshold :: Int
threshold = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
100 (Maybe [Char]
thresh Maybe [Char] -> ([Char] -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe)),
        batch :: Int
batch = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
32 (Maybe [Char]
batchSize Maybe [Char] -> ([Char] -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe)),
        batchGate :: Int
batchGate = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
100 (Maybe [Char]
thresh Maybe [Char] -> ([Char] -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4) (Maybe [Char]
gate Maybe [Char] -> ([Char] -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe)),
        sizeUnit :: Int
sizeUnit = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
500 (Maybe [Char]
sizeU Maybe [Char] -> ([Char] -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe)),
        passes :: [Char]
passes = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
defaultPasses Maybe [Char]
pipeline,
        exitCall :: Bool
exitCall = ShowS -> Maybe [Char] -> Maybe [Char]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower) Maybe [Char]
exits Maybe [Char] -> Maybe [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"blocks",
        copyBound :: Double
copyBound = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
40 (Maybe [Char]
copyB Maybe [Char] -> ([Char] -> Maybe Double) -> Maybe Double
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Maybe Double
forall a. Read a => [Char] -> Maybe a
readMaybe)),
        reentryWait :: Int
reentryWait = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
20 (Maybe [Char]
reWait Maybe [Char] -> ([Char] -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe)),
        reentryAdHoc :: Int
reentryAdHoc = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
3 (Maybe [Char]
reAdHoc Maybe [Char] -> ([Char] -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe)),
        exitCost :: Double
exitCost = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
7 (Maybe [Char]
cost Maybe [Char] -> ([Char] -> Maybe Double) -> Maybe Double
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Maybe Double
forall a. Read a => [Char] -> Maybe a
readMaybe)),
        entryCost :: Double
entryCost = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
3 (Maybe [Char]
entry Maybe [Char] -> ([Char] -> Maybe Double) -> Maybe Double
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Maybe Double
forall a. Read a => [Char] -> Maybe a
readMaybe)),
        logging :: Bool
logging = Bool -> ([Char] -> Bool) -> Maybe [Char] -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) Maybe [Char]
logging,
        dumpIR :: Maybe [Char]
dumpIR = Maybe [Char]
dump,
        dumpMCode :: Bool
dumpMCode = Bool -> ([Char] -> Bool) -> Maybe [Char] -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) Maybe [Char]
mcode,
        trace :: Bool
trace = Bool -> ([Char] -> Bool) -> Maybe [Char] -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) Maybe [Char]
tr,
        stats :: Bool
stats = Bool -> ([Char] -> Bool) -> Maybe [Char] -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) Maybe [Char]
stats,
        statsEach :: Bool
statsEach = Maybe [Char]
stats Maybe [Char] -> Maybe [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"each",
        stressPoll :: Int
stressPoll = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 ([Char] -> Maybe Int
setting [Char]
"poll"),
        stressStack :: Maybe Int
stressStack = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Maybe Int
setting [Char]
"ustack",
        stressCallee :: Int
stressCallee = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 ([Char] -> Maybe Int
setting [Char]
"callee"),
        stressCStack :: Int
stressCStack = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 ([Char] -> Maybe Int
setting [Char]
"cstack"),
        stressAlloc :: Int
stressAlloc = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 ([Char] -> Maybe Int
setting [Char]
"alloc"),
        stressInstall :: Int
stressInstall = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 ([Char] -> Maybe Int
setting [Char]
"install"),
        stressPool :: Maybe Int
stressPool = [Char] -> Maybe Int
setting [Char]
"pool",
        stressLists :: Int
stressLists = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 ([Char] -> Maybe Int
setting [Char]
"lists"),
        stressTexts :: Int
stressTexts = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 ([Char] -> Maybe Int
setting [Char]
"texts"),
        stressBytes :: Int
stressBytes = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 ([Char] -> Maybe Int
setting [Char]
"bytes"),
        statsEvery :: Int
statsEvery = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe [Char]
every Maybe [Char] -> ([Char] -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe),
        disabled :: [[Char]]
disabled = [[Char]]
disabledFeatures
      }
  where
    splitOn :: t -> [t] -> [[t]]
splitOn t
c [t]
s = case (t -> Bool) -> [t] -> ([t], [t])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
c) [t]
s of
      ([t]
a, []) -> [[t]
a]
      ([t]
a, t
_ : [t]
rest) -> [t]
a [t] -> [[t]] -> [[t]]
forall a. a -> [a] -> [a]
: t -> [t] -> [[t]]
splitOn t
c [t]
rest
    listToMaybe' :: [a] -> Maybe a
listToMaybe' [] = Maybe a
forall a. Maybe a
Nothing
    listToMaybe' (a
x : [a]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x

jitLog :: Config -> String -> IO ()
jitLog :: Config -> [Char] -> IO ()
jitLog Config
config [Char]
msg
  | Config -> Bool
logging Config
config = Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char]
"[jit] " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
msg)
  | Bool
otherwise = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Writes diagnostic text to stderr, unconditionally.
jitDump :: String -> IO ()
jitDump :: [Char] -> IO ()
jitDump [Char]
msg = Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
msg IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hFlush Handle
stderr

-- | The pass pipeline, in LLVM's syntax. @default<O2>@ with the parts our
-- code can't use left out: it is the same shape (function simplification,
-- then the inliner over the call graph with the simplification again
-- inside it, then a clean-up), and on the suite the code it produces runs
-- the same, at 60% of @O2@'s pass time (2026-10-09, see
-- benchmarks/2026-10-09-pipeline.md for what the lighter pipelines on the
-- way lost: without @ipsccp@ and @function-attrs@ the inlined callees'
-- attributes, without @jump-threading@ and @loop-rotate@ the status
-- switch after an inlined call and the loop shape, without @loop-unroll@
-- the peeled first iteration of a loop that calls a closure).
defaultPasses :: String
defaultPasses :: [Char]
defaultPasses =
  [Char]
"function(mem2reg,sroa,early-cse,simplifycfg,instcombine),ipsccp,"
    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"cgscc(inline,function-attrs,function(sroa,early-cse<memssa>,simplifycfg,instcombine,"
    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"jump-threading,correlated-propagation,loop-mssa(loop-rotate,licm,simple-loop-unswitch),"
    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"simplifycfg,instcombine,gvn,sccp,dse,loop-unroll,instcombine,adce,simplifycfg)),"
    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"function(simplifycfg),globaldce"