-- | The wide calling convention: whether it is on, and how many field slots
-- a wide variable has. The design: JIT/design.md, "The wide calling convention".
--
-- A wide variable occupies @wideK + 1@ stack slots: its value slot on top (the
-- lowest index in the emitter's context) and @wideK@ field slots below it.
-- Every yield delivers @wideK + 1@ slots, and every variable bound by an
-- indirect let is wide, since its value arrives by a yield. Whether a
-- variable is wide is a function of the code alone, so processes in either
-- mode agree on the layout of a serialized continuation.
--
-- The convention is a property of the process, decided once, like the
-- replacements mode in JIT/Config.hs. The interpreter alone does not gain
-- from it (JIT/benchmarks/2026-10-27-wide-interpreter.md), so it is on
-- exactly when the JIT is (@UNISON_JIT=on@ or @eager@) unless
-- @UNISON_OPTIMIZATIONS=wide@ or @-wide@ (Unison.Runtime.Optimizations)
-- overrides that, for testing either combination. A
-- compiled program's MCode has the convention of the mode it was compiled
-- under baked in (its frames and the instructions that write them), so its
-- file carries the mode and 'setWide' applies it before anything loads.
module Unison.Runtime.Wide
  ( wideOn,
    setWide,
    wideK,
    wideWidth,
    widePad,
  )
where

import Control.Exception (throwIO)
import Data.Char (toLower)
import Data.IORef
import Data.Maybe (fromMaybe)
import System.Environment (lookupEnv)
import System.IO.Unsafe (unsafePerformIO)
import Unison.Runtime.Optimizations (Optimization (..), optimizationSetting)

-- | Whether the process uses the wide calling convention.
wideOn :: Bool
wideOn :: Bool
wideOn = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
  Maybe Bool
chosen <- IORef (Maybe Bool) -> IO (Maybe Bool)
forall a. IORef a -> IO a
readIORef IORef (Maybe Bool)
wideRef
  Bool
w <- IO Bool -> (Bool -> IO Bool) -> Maybe Bool -> IO Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO Bool
wideFromEnvironment Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Bool
chosen
  IORef (Maybe Bool) -> Maybe Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Bool)
wideRef (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
w)
  IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
wideUsed Bool
True
  pure Bool
w
{-# NOINLINE wideOn #-}

wideFromEnvironment :: IO Bool
wideFromEnvironment :: IO Bool
wideFromEnvironment = do
  Maybe [Char]
mode <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"UNISON_JIT"
  pure $ case (Optimization -> Maybe Bool
optimizationSetting Optimization
Wide, (Char -> Char) -> [Char] -> [Char]
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 Bool
w, [Char]
_) -> Bool
w
    (Maybe Bool
_, [Char]
"on") -> Bool
True
    (Maybe Bool
_, [Char]
"eager") -> Bool
True
    (Maybe Bool, [Char])
_ -> Bool
False

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

wideUsed :: IORef Bool
wideUsed :: IORef Bool
wideUsed = 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 wideUsed #-}

-- | Chooses the convention, for a compiled program from the mode stored in
-- its file. It has to happen before any code has used the setting: code
-- already loaded under the other convention can't be redone, so a late
-- choice that differs is an error.
setWide :: Bool -> IO ()
setWide :: Bool -> IO ()
setWide Bool
w = do
  Bool
used <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
wideUsed
  Maybe Bool
chosen <- IORef (Maybe Bool) -> IO (Maybe Bool)
forall a. IORef a -> IO a
readIORef IORef (Maybe Bool)
wideRef
  case Maybe Bool
chosen of
    Just Bool
w' | Bool
used Bool -> Bool -> Bool
&& Bool
w' Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
w -> IOError -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO ([Char] -> IOError
userError ([Char]
"the wide calling convention is " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (if Bool
w' then [Char]
"on" else [Char]
"off") [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" and already in use; it cannot be changed to " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (if Bool
w then [Char]
"on" else [Char]
"off")))
    Maybe Bool
_ -> IORef (Maybe Bool) -> Maybe Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Bool)
wideRef (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
w)

-- | The number of field slots of a wide variable.
wideK :: Int
wideK :: Int
wideK = Int
1

-- | The number of slots a wide variable occupies: 1 when the convention is
-- off, so that the layout is unchanged.
wideWidth :: Int
wideWidth :: Int
wideWidth
  | Bool
wideOn = Int
wideK Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  | Bool
otherwise = Int
1

-- | The slots below a wide variable's value slot: 'wideWidth' - 1.
widePad :: Int
widePad :: Int
widePad = Int
wideWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1