reference-counting-0.1.0.0: test/Main.hs

{-# LANGUAGE NoImplicitPrelude, LinearTypes, QualifiedDo, DerivingStrategies, DeriveAnyClass, BlockArguments #-}
module Main (main) where

import GHC.Generics
import qualified Prelude
import System.IO.Linear as Linear (withLinearIO, IO, fromSystemIO, fromSystemIOU)
import Prelude.Linear hiding (IO)
import Control.Functor.Linear as Linear
import qualified Data.Functor.Linear as DL
import qualified Unsafe.Linear as Unsafe

-- reference-counting
import qualified Data.Linear.Alias as A

--------------------------------------------------------------------------------
-- Test 1
--------------------------------------------------------------------------------

data SomeResource where
  UnsafeCreateResource :: Int -> SomeResource

newResource :: Int %1 -> IO SomeResource
freeResource :: SomeResource %1 -> IO ()

test1 :: IO ()
test1 = Linear.do
  res <- newResource 0
  ref <- A.newAlias freeResource res
  (ref1, ref2) <- A.share ref
  A.forget ref1
  A.forget ref2

--------------------------------------------------------------------------------
-- Test 2
--------------------------------------------------------------------------------

test2 :: IO ()
test2 = Linear.do
  let list = [1..200]
  refs <- DL.forM list \i -> Linear.do
    newResource i >>= A.newAlias freeResource
  case refs of
    [] -> ok
    (x:xs) -> Linear.do
      (x1, x2) <- A.share x
      A.forget x1
      A.forget (x2:xs)
      -- sort | uniq -c of the stdin should have 1 entry for i=1 to i=200 freed
  where
    ok = fromSystemIO $ putStrLn "ok"

--------------------------------------------------------------------------------
-- Main
--------------------------------------------------------------------------------

main :: Prelude.IO ()
main = withLinearIO $ Linear.do
  () <- test1
  () <- test2
  pure (Ur ())


--------------------------------------------------------------------------------
-- Internal
--------------------------------------------------------------------------------

{-# OPAQUE newResource #-}
{-# OPAQUE freeResource #-}
newResource = Unsafe.toLinear \i -> Linear.do
  () <- fromSystemIO $ Prelude.putStrLn $ "initialising linear resource " ++ Prelude.show i
  return $ UnsafeCreateResource i
freeResource (UnsafeCreateResource i) = Linear.do
  () <- fromSystemIO $ Prelude.putStrLn $ "freeing linear resource " ++ Prelude.show i
  return ()