Jerzy Karczmarczuk ([EMAIL PROTECTED]) wrote:

: But in Haskell, where the beasts are not mutable:
: 
: ... Actually, has anybody really used them for practical purposes?

I have used doubly linked lists in Haskell about four
years ago to implement a queue from which objects could
be added at front/back and deleted anywhere.

A mutable array was used to see if objects were in the queue.
If they were then (Just Ix) to them would be returned
and if they weren't Nothing. The index could then be used
to find the possible previous and next elements in the queue
and change their representations. I cheated a bit because I used
the fact that the possible indices were know in advance so that
I could use an array to represent the member in the queue as
well. It worked well.

I've appended (what I think are the most important) code-fragments
at the end. I don't know if I would do it the same way again; this
was years ago.

Regards,


Marc van Dongen

> initQueue :: Ix i => (LinkedList s i v) -> [(i,v)] -> ST s (Maybe i,Maybe i)
> initQueue _     []
>   = return (Nothing,Nothing)
> initQueue marks ((i,v):ivs)
>   = writeArray marks i (Nothing,Nothing,Just v) >>
>     a2q marks i i ivs

> addToQueue :: Ix i =>
>   (LinkedList s i v)
>      -> (Maybe i)
>      -> (Maybe i)
>      -> [(i,v)]
>      -> ST s (Maybe i,Maybe i)
> addToQueue marks fst     lst  []
>   = return (fst,lst)
> addToQueue marks Nothing    _          ijrs
>   = initQueue marks ijrs
> addToQueue marks (Just fst) (Just lst) ijrs
>   = a2q marks fst lst ijrs

> a2q :: Ix i =>
>   (LinkedList s i v)
>       -> i
>       -> i
>       -> [(i,v)]
>       -> ST s (Maybe i,Maybe i)
> a2q _     fst lst []
>   = return (Just fst,Just lst)
> a2q marks fst lst ((i,v):ivs)
>   = readArray marks i                                         >>= \(_,_,mbv) ->
>     case mbv of
>       Nothing -> readArray marks lst                          >>= \(jpred,_,jv) ->
>                  writeArray marks lst (jpred,Just i,jv)       >>
>                  writeArray marks i (Just lst,Nothing,Just v) >>
>                  a2q marks fst i ivs
>       _       -> a2q marks fst lst ivs

> delFromQueue :: Ix i =>
>   (LinkedList s i v)
>       -> (Maybe i)
>       -> (Maybe i)
>       -> [i]
>       -> ST s (Maybe i,Maybe i)
> delFromQueue _      jfst            jlst            []
>   = return (jfst,jlst)
> delFromQueue marks  jfst@(Just fst) jlst@(Just lst) (i:is)
>   = readArray marks i                                              >>= 
>\(jpred,jsucc,_) ->
>     writeArray marks i (Nothing,Nothing,Nothing)                   >>
>     case jpred of
>       Nothing  -> case jsucc of
>                     Nothing  -> return (Nothing,Nothing)
>                     (Just s) -> readArray marks s                  >>= \(_,s',r') ->
>                                 writeArray marks s (Nothing,s',r') >>
>                                 delFromQueue marks jsucc jlst is
>       (Just p) -> case jsucc of
>                     Nothing  -> readArray marks p                  >>= \(p',_,r') ->
>                                 writeArray marks p (p',Nothing,r') >>
>                                 delFromQueue marks jfst jpred is
>                     (Just s) -> readArray marks p                  >>= \(p',_,r') ->
>                                 writeArray marks p (p',jsucc,r')   >>
>                                 readArray marks s                  >>= \(_,s',r') ->
>                                 writeArray marks s (jpred,s',r')   >>
>                                 delFromQueue marks jfst jlst is

Reply via email to