Fast impertive pointers (static, unboxing, etc.) with Struct library

Question

I am interested in using more efficient pointers for a project implementing an imperative language in Haskell. There is already a library for that: Struct. There is a blog post on it and brief documentation.

The problem is there is only a quite sophisticated example of linkcut trees. For someone like me who doesn't use Haskell on a daily basis, it is quite exhausting to battle little documented code, template haskell, etc.

I would need a simpler example to get started, along the lines of expressing either of those two data types:

import Data.IORef

data DLL a = DLL a (Maybe (IORef (DLL a))) (Maybe (IORef (DLL a)))

data DLLINT = DLLINT Int (Maybe (IORef DLLINT)) (Maybe (IORef DLLINT))

This should be just a few simple lines for someone who is fluent in Haskell/GHC.

How do I express one of the data types above with the Struct library?

Answer 1

I managed to get your DLL type working with Structs as follows:

{-# LANGUAGE TemplateHaskell, RoleAnnotations #-}
module DubLiList where

import Control.Monad.Primitive
import Data.Struct.TH
import Data.Struct
import Data.Struct.Internal


makeStruct [d|
  data DLL a s = DLL
    { prev :: !(DLL a s)
    , value :: a
    , next :: !(DLL a s)
    }
  |]

new :: (PrimMonad m) => a -> m (DLL a (PrimState m))
new x = st $ newDLL Nil x Nil

insert :: (PrimMonad m) => a -> DLL a (PrimState m) -> m (DLL a (PrimState m))
insert x this = st $ do
    prev' <- get prev this
    new <- newDLL prev' x this
    set prev this new
    set next prev' new
    return new

delete :: (PrimMonad m) => DLL a (PrimState m) -> m ()
delete this = st $ do
    prev' <- get prev this
    next' <- get next this
    set next prev' next'
    set prev next' prev'

toList :: (PrimMonad m) => DLL a (PrimState m) -> m [a]
toList this = st $ do
    if isNil this then return [] else do
        x <- getField value this
        that <- get next this
        (x:) <$> toList that

Here's an example of using it:

main :: IO ()
main = do
    dll <- new "foo"           -- [foo]
    dll' <- insert "bar" dll   -- [bar, foo]
    insert "baz" dll           -- [bar, baz, foo]

    xs <- toList dll'
    print xs