-- SPDX-FileCopyrightText: 2025 Sören Tempel <soeren+git@soeren-tempel.net>
--
-- SPDX-License-Identifier: GPL-3.0-only

module Language.QBE.Simulator.Default.Funcs (lookupSimFunc) where

import Control.Monad.Error.Class (throwError)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Language.QBE.Simulator.Error (EvalError (FuncArgsMismatch))
import Language.QBE.Simulator.Expression qualified as E
import Language.QBE.Simulator.State (Simulator, readNullArray, toAddress)
import Language.QBE.Types qualified as QBE

puts :: (MonadIO m, E.ValueRepr v, Simulator m v) => QBE.GlobalIdent -> [v] -> m (Maybe v)
puts :: forall (m :: * -> *) v.
(MonadIO m, ValueRepr v, Simulator m v) =>
GlobalIdent -> [v] -> m (Maybe v)
puts GlobalIdent
_ [v
strPtr] = do
  [v]
bytes <- v -> m Word64
forall (m :: * -> *) v. Simulator m v => v -> m Word64
toAddress v
strPtr m Word64 -> (Word64 -> m [v]) -> m [v]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word64 -> m [v]
forall (m :: * -> *) v. Simulator m v => Word64 -> m [v]
readNullArray
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn ([v] -> String
forall v. ValueRepr v => [v] -> String
E.toString [v]
bytes)
  Maybe v -> m (Maybe v)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (v -> Maybe v
forall a. a -> Maybe a
Just (v -> Maybe v) -> v -> Maybe v
forall a b. (a -> b) -> a -> b
$ ExtType -> Word64 -> v
forall v. ValueRepr v => ExtType -> Word64 -> v
E.fromLit (BaseType -> ExtType
QBE.Base BaseType
QBE.Word) Word64
0)
puts GlobalIdent
ident [v]
_ = EvalError -> m (Maybe v)
forall a. EvalError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EvalError -> m (Maybe v)) -> EvalError -> m (Maybe v)
forall a b. (a -> b) -> a -> b
$ GlobalIdent -> EvalError
FuncArgsMismatch GlobalIdent
ident

------------------------------------------------------------------------

-- TODO: Register functions dynamically.
lookupSimFunc ::
  (MonadIO m, E.ValueRepr v, Simulator m v) =>
  QBE.GlobalIdent ->
  Maybe ([v] -> m (Maybe v))
lookupSimFunc :: forall (m :: * -> *) v.
(MonadIO m, ValueRepr v, Simulator m v) =>
GlobalIdent -> Maybe ([v] -> m (Maybe v))
lookupSimFunc i :: GlobalIdent
i@(QBE.GlobalIdent String
"puts") = ([v] -> m (Maybe v)) -> Maybe ([v] -> m (Maybe v))
forall a. a -> Maybe a
Just (GlobalIdent -> [v] -> m (Maybe v)
forall (m :: * -> *) v.
(MonadIO m, ValueRepr v, Simulator m v) =>
GlobalIdent -> [v] -> m (Maybe v)
puts GlobalIdent
i)
lookupSimFunc GlobalIdent
_ = Maybe ([v] -> m (Maybe v))
forall a. Maybe a
Nothing