[Haskell-cafe] Refactoring from State monad to ST monad,
for STUArray
Denis Bueno
dbueno at gmail.com
Sat Feb 2 17:17:00 EST 2008
Thanks for all the responses. I have never used monad transformers
before, but StateT is welcome and really cool. I didn't even think to
look them up.
I have a follow up question. I eventually get to a point where I have
a value of type (ST s (Maybe (STUArray s Int Int))), and I need
somehow to get rid of the Maybe, so I can call runSTUArray on it. The
function containing this value returns a pure type:
> data Solution = Sat (UArray Int Int) | Unsat deriving (Eq)
I've included the function body below, along with a few comments that
hopefully make my problem clear enough. Let me know if there's any
more detail needed:
> solve :: StdGen -> Cnf -> Solution
> solve rnd cnf =
> -- To solve, we simply take baby steps toward the solution using solveStep,
> -- starting with the empty assignment.
> Sat . runSTUArray $
> do solution <- -- this block, as you can see,
> -- is the (ST s (STUArray s Int Int)) value
> evalStateT (stepToSolution $ do
> initialAssignment <- lift (newArray (1, numVars cnf) 0)
> solveStep initialAssignment)
> SC{cnf=cnf, dm=Map.empty, dl=[], bad=Set.empty, rnd=rnd}
> case solution of -- `solution' is the (Maybe (STUArray s Int Int)) value
> Nothing -> error "unsat"
> Just m -> return m
Using `error' in the Nothing case is exactly what I'd like to avoid.
How should I improve this?
On Feb 2, 2008 2:57 PM, Ryan Ingram <ryani.spam at gmail.com> wrote:
> You can also do something like the following:
>
> newtype StateST st s a = StateST { internalRunStateST :: ReaderT
> (STRef st s) (ST st) a }
>
> instance MonadState s (StateST s st) where
> get = ask >>= readSTRef
> put s = ask >>= \ref -> writeSTRef ref s
>
> runStateST :: StateST st s a -> s -> ST st a
> runStateST m s = do
> ref <- newSTRef s
> runReaderT (internalRunStateST m) ref
>
> -- ryan
>
>
>
> On Feb 2, 2008 9:05 AM, Derek Elkins <derek.a.elkins at gmail.com> wrote:
> > On Sat, 2008-02-02 at 12:33 -0500, Denis Bueno wrote:
> > > Is it possible to use the ST monad as a (drop-in) replacement for the
> > > State monad in the following situation? If not, is there a "best
> > > practice" for refactoring?
> > >
> > > I have a bunch of functions that return state actions:
> > >
> > > type MyState = ...
> > >
> > > foo1 :: T1 -> State MyState a
> > > foo2 :: T2 -> State MyState a
> > > ...
> > > foon :: Tn -> State MyState a
> > >
> > > And I'd like to refactor this to use the ST monad, mechanically, if
> > > possible. All uses of the MyState inside State are single-threaded.
> > >
> > > In my application, MyState is a record with 5 or so fields. One of
> > > those fields uses a list to keep track of some information, and I'd
> > > like to change that to STUArray, because it changes my bottleneck
> > > operations from O(n) to O(1). This, of course, requires having the ST
> > > monad around, in order to achieve the proper time complexity.
> > >
> > > Is there an easy way to do this? In the future, should I *start out*
> > > with the ST monad if I suspect I'll need to use an imperative data
> > > structure for efficiency reasons? I started out with State because
> > > I'm modeling a transition system, so it seemed natural.
> > >
> > > Any advice is appreciated.
> >
> > %s/State MyState/MyMonad s/g
> >
> > type MyState s = ... s ...
> >
> > type MyMonad s = StateT (MyState s) (ST s)
> >
> >
> >
> > _______________________________________________
> > Haskell-Cafe mailing list
> > Haskell-Cafe at haskell.org
> > http://www.haskell.org/mailman/listinfo/haskell-cafe
> >
>
--
Denis
More information about the Haskell-Cafe
mailing list