Refactor to use continuation monad

This commit is contained in:
George Thomas 2026-02-19 21:18:37 +00:00
parent ca063b1dd6
commit 58005ee261
2 changed files with 15 additions and 14 deletions

View File

@ -11,7 +11,10 @@ module GarnetRs.Wrapped (
sumTree, sumTree,
) where ) where
import Control.Monad.Cont
import Control.Monad.Trans
import Data.ByteString import Data.ByteString
import Data.Function
import Data.Word import Data.Word
import Foreign import Foreign
import Foreign.C import Foreign.C
@ -38,20 +41,17 @@ data BTree a
= Leaf a = Leaf a
| Fork (BTree a) (BTree a) | Fork (BTree a) (BTree a)
withBTree :: BTree Int64 -> (Raw.BTreeC -> IO a) -> IO a withBTree :: BTree Int64 -> (Raw.BTreeC -> IO a) -> IO a
withBTree = flip \f -> \case withBTree =
Leaf v -> runContT . fix \f -> \case
f $ Raw.BTreeC Raw.Leaf $ Raw.set_bTreeC_body_leaf $ Raw.Leaf_Body v Leaf v -> pure $ Raw.BTreeC Raw.Leaf $ Raw.set_bTreeC_body_leaf $ Raw.Leaf_Body v
Fork l r -> Fork l r -> do
withBTree l \lRaw -> lRaw <- f l
withBTree r \rRaw -> rRaw <- f r
alloca \lPtr -> lPtr <- ContT alloca
alloca \rPtr -> do rPtr <- ContT alloca
poke lPtr lRaw lift $ poke lPtr lRaw >> poke rPtr rRaw
poke rPtr rRaw pure . Raw.BTreeC Raw.Fork . Raw.set_bTreeC_body_fork $
f Raw.Fork_Body (unsafeFromPtr lPtr) (unsafeFromPtr rPtr)
. Raw.BTreeC Raw.Fork
. Raw.set_bTreeC_body_fork
$ Raw.Fork_Body (unsafeFromPtr lPtr) (unsafeFromPtr rPtr)
hello :: ByteString -> IO () hello :: ByteString -> IO ()
hello s = useAsCString s $ Raw.hello . unsafeFromPtr hello s = useAsCString s $ Raw.hello . unsafeFromPtr

View File

@ -53,3 +53,4 @@ executable garnet
bytestring, bytestring,
garnet-generated, garnet-generated,
hs-bindgen-runtime, hs-bindgen-runtime,
mtl,