-- | The optimizations a process can switch on or off, all under one
-- environment variable, @UNISON_OPTIMIZATIONS@: a comma-separated list of
-- names, each on its own or after @+@ (on) or @-@ (off), and the words
-- @all@ and @none@. Later entries override earlier ones, so
-- @none,explode_returns@ keeps only the return workers. A name the variable
-- does not mention keeps its default, which may depend on the JIT mode
-- (the wide convention and the replacements follow @UNISON_JIT@). An
-- unknown name is an error, so a misspelling cannot pass as a measurement.
--
-- Read once, on first use, like the settings it feeds ('Unison.Runtime.Wide',
-- 'Unison.Runtime.JIT.Config', 'Unison.Runtime.MCode.Explode'). Every
-- optimization here changes only the code the runtime runs, never a stored
-- value or hash, which is why a stray setting is allowed to take effect
-- (the debugging switches that weaken the runtime stay under
-- @UNISON_JIT_DISABLE@, read only with @UNISON_JIT_DEBUG@).
module Unison.Runtime.Optimizations
  ( Optimization (..),
    optimizationName,
    optimizationSetting,
    parseOptimizations,
  )
where

import Data.Char (isSpace, toLower)
import Data.List (intercalate)
import Data.Map.Strict qualified as M
import System.Environment (lookupEnv)
import System.IO.Unsafe (unsafePerformIO)

data Optimization
  = -- | @explode_args@: loop state passed as fields to a specialised worker
    -- (Unison.Runtime.MCode.Explode, design.md "Loop state exploded")
    ExplodeArgs
  | -- | @explode_returns@: a product result returned as its leaves, in
    -- several values, by a product-return worker (design.md "Results
    -- exploded")
    ExplodeReturns
  | -- | @known_constructor@: a product or sum built and matched in the
    -- same body is matched where it is built, the let dropped and the
    -- arm's variables renamed to the fields; a match on the value of a
    -- match whose every tail builds a constructor is moved into those
    -- tails, as a call of a join point per arm (Unison.Runtime.MCode.Explode,
    -- design.md "Known constructors and case of case")
    KnownConstructor
  | -- | @wide@: the wide calling convention, small constructors in stack
    -- slots between a return and a match (Unison.Runtime.Wide); on by
    -- default exactly when the JIT is
    Wide
  | -- | @replacements@: the Haskell replacements of base library
    -- definitions (Unison.Runtime.JIT.Config); by default all of them
    -- under the interpreter and the tagged ones under the JIT, so @on@
    -- here is all and @off@ none
    Replacements
  deriving (Optimization -> Optimization -> Bool
(Optimization -> Optimization -> Bool)
-> (Optimization -> Optimization -> Bool) -> Eq Optimization
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Optimization -> Optimization -> Bool
== :: Optimization -> Optimization -> Bool
$c/= :: Optimization -> Optimization -> Bool
/= :: Optimization -> Optimization -> Bool
Eq, Eq Optimization
Eq Optimization =>
(Optimization -> Optimization -> Ordering)
-> (Optimization -> Optimization -> Bool)
-> (Optimization -> Optimization -> Bool)
-> (Optimization -> Optimization -> Bool)
-> (Optimization -> Optimization -> Bool)
-> (Optimization -> Optimization -> Optimization)
-> (Optimization -> Optimization -> Optimization)
-> Ord Optimization
Optimization -> Optimization -> Bool
Optimization -> Optimization -> Ordering
Optimization -> Optimization -> Optimization
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Optimization -> Optimization -> Ordering
compare :: Optimization -> Optimization -> Ordering
$c< :: Optimization -> Optimization -> Bool
< :: Optimization -> Optimization -> Bool
$c<= :: Optimization -> Optimization -> Bool
<= :: Optimization -> Optimization -> Bool
$c> :: Optimization -> Optimization -> Bool
> :: Optimization -> Optimization -> Bool
$c>= :: Optimization -> Optimization -> Bool
>= :: Optimization -> Optimization -> Bool
$cmax :: Optimization -> Optimization -> Optimization
max :: Optimization -> Optimization -> Optimization
$cmin :: Optimization -> Optimization -> Optimization
min :: Optimization -> Optimization -> Optimization
Ord, Int -> Optimization -> ShowS
[Optimization] -> ShowS
Optimization -> String
(Int -> Optimization -> ShowS)
-> (Optimization -> String)
-> ([Optimization] -> ShowS)
-> Show Optimization
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Optimization -> ShowS
showsPrec :: Int -> Optimization -> ShowS
$cshow :: Optimization -> String
show :: Optimization -> String
$cshowList :: [Optimization] -> ShowS
showList :: [Optimization] -> ShowS
Show, Int -> Optimization
Optimization -> Int
Optimization -> [Optimization]
Optimization -> Optimization
Optimization -> Optimization -> [Optimization]
Optimization -> Optimization -> Optimization -> [Optimization]
(Optimization -> Optimization)
-> (Optimization -> Optimization)
-> (Int -> Optimization)
-> (Optimization -> Int)
-> (Optimization -> [Optimization])
-> (Optimization -> Optimization -> [Optimization])
-> (Optimization -> Optimization -> [Optimization])
-> (Optimization -> Optimization -> Optimization -> [Optimization])
-> Enum Optimization
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Optimization -> Optimization
succ :: Optimization -> Optimization
$cpred :: Optimization -> Optimization
pred :: Optimization -> Optimization
$ctoEnum :: Int -> Optimization
toEnum :: Int -> Optimization
$cfromEnum :: Optimization -> Int
fromEnum :: Optimization -> Int
$cenumFrom :: Optimization -> [Optimization]
enumFrom :: Optimization -> [Optimization]
$cenumFromThen :: Optimization -> Optimization -> [Optimization]
enumFromThen :: Optimization -> Optimization -> [Optimization]
$cenumFromTo :: Optimization -> Optimization -> [Optimization]
enumFromTo :: Optimization -> Optimization -> [Optimization]
$cenumFromThenTo :: Optimization -> Optimization -> Optimization -> [Optimization]
enumFromThenTo :: Optimization -> Optimization -> Optimization -> [Optimization]
Enum, Optimization
Optimization -> Optimization -> Bounded Optimization
forall a. a -> a -> Bounded a
$cminBound :: Optimization
minBound :: Optimization
$cmaxBound :: Optimization
maxBound :: Optimization
Bounded)

optimizationName :: Optimization -> String
optimizationName :: Optimization -> String
optimizationName = \case
  Optimization
ExplodeArgs -> String
"explode_args"
  Optimization
ExplodeReturns -> String
"explode_returns"
  Optimization
KnownConstructor -> String
"known_constructor"
  Optimization
Wide -> String
"wide"
  Optimization
Replacements -> String
"replacements"

-- | What @UNISON_OPTIMIZATIONS@ says about one optimization: 'Nothing'
-- when it is not mentioned, so the default applies.
optimizationSetting :: Optimization -> Maybe Bool
optimizationSetting :: Optimization -> Maybe Bool
optimizationSetting Optimization
o = Optimization -> Map Optimization Bool -> Maybe Bool
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Optimization
o Map Optimization Bool
settings

settings :: M.Map Optimization Bool
settings :: Map Optimization Bool
settings = IO (Map Optimization Bool) -> Map Optimization Bool
forall a. IO a -> a
unsafePerformIO (IO (Map Optimization Bool) -> Map Optimization Bool)
-> IO (Map Optimization Bool) -> Map Optimization Bool
forall a b. (a -> b) -> a -> b
$ do
  Maybe String
v <- String -> IO (Maybe String)
lookupEnv String
"UNISON_OPTIMIZATIONS"
  pure $ Map Optimization Bool
-> (String -> Map Optimization Bool)
-> Maybe String
-> Map Optimization Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map Optimization Bool
forall k a. Map k a
M.empty ((String -> Map Optimization Bool)
-> (Map Optimization Bool -> Map Optimization Bool)
-> Either String (Map Optimization Bool)
-> Map Optimization Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Map Optimization Bool
forall a. HasCallStack => String -> a
error Map Optimization Bool -> Map Optimization Bool
forall a. a -> a
id (Either String (Map Optimization Bool) -> Map Optimization Bool)
-> (String -> Either String (Map Optimization Bool))
-> String
-> Map Optimization Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String (Map Optimization Bool)
parseOptimizations) Maybe String
v
{-# NOINLINE settings #-}

-- | The settings a value of the variable gives, or the complaint about it.
parseOptimizations :: String -> Either String (M.Map Optimization Bool)
parseOptimizations :: String -> Either String (Map Optimization Bool)
parseOptimizations = Map Optimization Bool
-> [String] -> Either String (Map Optimization Bool)
go Map Optimization Bool
forall k a. Map k a
M.empty ([String] -> Either String (Map Optimization Bool))
-> (String -> [String])
-> String
-> Either String (Map Optimization Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
trim) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> [String]
forall {t}. Eq t => t -> [t] -> [[t]]
splitOn Char
','
  where
    go :: Map Optimization Bool
-> [String] -> Either String (Map Optimization Bool)
go Map Optimization Bool
m [] = Map Optimization Bool -> Either String (Map Optimization Bool)
forall a b. b -> Either a b
Right Map Optimization Bool
m
    go Map Optimization Bool
m (String
"" : [String]
rest) = Map Optimization Bool
-> [String] -> Either String (Map Optimization Bool)
go Map Optimization Bool
m [String]
rest
    go Map Optimization Bool
_ (String
"all" : [String]
rest) = Map Optimization Bool
-> [String] -> Either String (Map Optimization Bool)
go (Bool -> Map Optimization Bool
forall {k} {a}. (Ord k, Bounded k, Enum k) => a -> Map k a
everything Bool
True) [String]
rest
    go Map Optimization Bool
_ (String
"none" : [String]
rest) = Map Optimization Bool
-> [String] -> Either String (Map Optimization Bool)
go (Bool -> Map Optimization Bool
forall {k} {a}. (Ord k, Bounded k, Enum k) => a -> Map k a
everything Bool
False) [String]
rest
    go Map Optimization Bool
m ((Char
'-' : String
n) : [String]
rest) = Map Optimization Bool
-> String
-> Bool
-> [String]
-> Either String (Map Optimization Bool)
named Map Optimization Bool
m String
n Bool
False [String]
rest
    go Map Optimization Bool
m ((Char
'+' : String
n) : [String]
rest) = Map Optimization Bool
-> String
-> Bool
-> [String]
-> Either String (Map Optimization Bool)
named Map Optimization Bool
m String
n Bool
True [String]
rest
    go Map Optimization Bool
m (String
n : [String]
rest) = Map Optimization Bool
-> String
-> Bool
-> [String]
-> Either String (Map Optimization Bool)
named Map Optimization Bool
m String
n Bool
True [String]
rest
    named :: Map Optimization Bool
-> String
-> Bool
-> [String]
-> Either String (Map Optimization Bool)
named Map Optimization Bool
m String
n Bool
on [String]
rest = case String -> [(String, Optimization)] -> Maybe Optimization
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
n [(String, Optimization)]
byName of
      Just Optimization
o -> Map Optimization Bool
-> [String] -> Either String (Map Optimization Bool)
go (Optimization
-> Bool -> Map Optimization Bool -> Map Optimization Bool
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Optimization
o Bool
on Map Optimization Bool
m) [String]
rest
      Maybe Optimization
Nothing ->
        String -> Either String (Map Optimization Bool)
forall a b. a -> Either a b
Left (String -> Either String (Map Optimization Bool))
-> String -> Either String (Map Optimization Bool)
forall a b. (a -> b) -> a -> b
$
          String
"UNISON_OPTIMIZATIONS: no optimization is called "
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
n
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"; the names are "
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (((String, Optimization) -> String)
-> [(String, Optimization)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Optimization) -> String
forall a b. (a, b) -> a
fst [(String, Optimization)]
byName)
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", each on its own or after '-' to switch it off, and all or none"
    byName :: [(String, Optimization)]
byName = [(Optimization -> String
optimizationName Optimization
o, Optimization
o) | Optimization
o <- [Optimization
forall a. Bounded a => a
minBound .. Optimization
forall a. Bounded a => a
maxBound]]
    everything :: a -> Map k a
everything a
on = [(k, a)] -> Map k a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(k
o, a
on) | k
o <- [k
forall a. Bounded a => a
minBound .. k
forall a. Bounded a => a
maxBound]]
    trim :: ShowS
trim = ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace
    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