qute

 1-- SPDX-FileCopyrightText: 2025 Sören Tempel <soeren+git@soeren-tempel.net>
 2--
 3-- SPDX-License-Identifier: GPL-3.0-only
 4
 5module Language.QBE.Simulator.Default.Funcs (lookupSimFunc) where
 6
 7import Control.Monad.Error.Class (throwError)
 8import Control.Monad.IO.Class (MonadIO, liftIO)
 9import Language.QBE.Simulator.Error (EvalError (FuncArgsMismatch))
10import Language.QBE.Simulator.Expression qualified as E
11import Language.QBE.Simulator.State (Simulator, readNullArray, toAddress)
12import Language.QBE.Types qualified as QBE
13import System.Exit (ExitCode (ExitFailure), exitWith)
14
15-- TODO: remove this
16puts :: (MonadIO m, E.ValueRepr v, Simulator m v) => QBE.GlobalIdent -> [v] -> m (Maybe v)
17puts _ [strPtr] = do
18  bytes <- toAddress strPtr >>= readNullArray
19  liftIO $ putStrLn (E.toString bytes)
20  pure (Just $ E.fromLit (QBE.Base QBE.Word) 0)
21puts ident _ = throwError $ FuncArgsMismatch ident
22
23exit :: (MonadIO m, E.ValueRepr v, Simulator m v) => QBE.GlobalIdent -> [v] -> m (Maybe v)
24exit _ [status] =
25  let code = fromIntegral $ E.toWord64 status
26   in liftIO $ exitWith (ExitFailure code)
27exit ident _ = throwError $ FuncArgsMismatch ident
28
29------------------------------------------------------------------------
30
31-- TODO: Register functions dynamically.
32lookupSimFunc ::
33  (MonadIO m, E.ValueRepr v, Simulator m v) =>
34  QBE.GlobalIdent ->
35  Maybe ([v] -> m (Maybe v))
36lookupSimFunc i@(QBE.GlobalIdent "puts") = Just (puts i)
37lookupSimFunc i@(QBE.GlobalIdent "qute_exit") = Just (exit i)
38lookupSimFunc _ = Nothing