module Control.Monad.MultiPass.Example.StringInterning
( internStringArray )
where
import Control.Monad ( liftM2 )
import Control.Monad.ST2
import Control.Monad.MultiPass
import Control.Monad.MultiPass.Instrument.CreateST2Array
import Control.Monad.MultiPass.Instrument.OrdCons
newtype InternArray r w p1 p2 tc
= InternArray (InternArrayType r w p1 p2 tc)
type InternArrayType r w p1 p2 tc
= OrdCons String r w p1 p2 tc
-> CreateST2Array r w p2 tc
-> MultiPassMain r w tc
(p2 (ST2Array r w Int Int, OrdConsTable String))
instance MultiPassAlgorithm
(InternArray r w p1 p2 tc)
(InternArrayType r w p1 p2 tc)
where
unwrapMultiPassAlgorithm (InternArray f) = f
internStringArray
:: NumThreads
-> ST2Array r w Int String
-> ST2 r w (ST2Array r w Int Int, OrdConsTable String)
internStringArray n xs =
run $ PassS $ PassS $ PassZ $ InternArray $ \pool cr ->
mkMultiPassMain
(return ())
(\() -> internStringArrayElems pool cr n xs)
(\xs' ->
do table <- getOrdConsTable pool
return (liftM2 (,) xs' table))
internStringArrayElems
:: (Monad p1, Monad p2)
=> OrdCons String r w p1 p2 tc
-> CreateST2Array r w p2 tc
-> NumThreads
-> ST2Array r w Int String
-> MultiPass r w tc (p2 (ST2Array r w Int Int))
internStringArrayElems pool cr n xs =
pmapST2ArrayMP cr n xs $ \x ->
ordCons pool (return x)