[Haskell-cafe] Open mutable records
Einar Karttunen
ekarttun at cs.helsinki.fi
Sun May 22 17:06:20 EDT 2005
Hello
I recently ended up hacking a quite concise implementation of
mutable open (extensible) records in Haskell. Most of the ideas
came from the HList-paper, but this seems like a very simple way of
doing things.
Run with ghci -fglasgow-exts -fallow-overlapping-instances.
Import some stuff we are going to need later:
> import Control.Monad.Reader
> import Data.IORef
> import System
Monad for mutable record calculations - to get implisit this/self in the
OO sense.
> newtype OO t r = OO (ReaderT t IO r) deriving(Monad, MonadReader t, MonadIO)
>
> with :: s -> OO s a -> OO b a
> with this (OO c) = liftIO (runReaderT c this)
>
> ooToIO :: OO s a -> IO a
> ooToIO (OO c) = runReaderT c undefined
Records
First the record constructor - followed by the terminator.
> data a :.: r = RC !a !r
> infixr :.:
> data END = END
Next we define a field access method.
> class Select r f t | r f -> t where (!) :: r -> f -> Ref t
> instance Select (Field f t :.: r) f t where (!) (RC (F x) _) _ = x
> instance Select r f t => Select (a :.: r) f t where (!) (RC _ t) = (!) t
And finally the type of mutable fields.
> type Ref a = IORef a
> newtype Field name rtype = F (Ref rtype)
Next we define a way to construct record values.
> infixr ##
> (##) :: v -> OO s r -> OO s ((Field f v) :.: r)
> (##) v r = do { h <- liftIO (newIORef v); t <- r; return (RC (F h) t) }
> end = return END :: OO s END
Get the value of a field.
> value :: Select s f t => f -> OO s t
> value a = do x <- asks (\s -> s!a)
> liftIO (readIORef x)
Or set the value of a field.
> (<-:) :: Select s f t => f -> t -> OO s ()
> a <-: b = do x <- asks (\s -> s!a)
> liftIO (writeIORef x b)
And as a convenience add value to an int field.
> (+=) :: Select s f Int => f -> Int -> OO s Int
> a += b = do x <- asks (\s -> s!a)
> val <- liftIO (readIORef x)
> let z = val+b
> z `seq` liftIO (writeIORef x z)
> return z
Now implement the classic ocaml OO tutorial:
> data X = X
> type Point = Field X Int :.: END
>
> newPoint :: OO s Point
> newPoint = 0 ## end
>
> getX :: Select s X t => OO s t
> getX = value X
>
> move d = X += d
> data Color = Color
> type ColoredPoint = Field Color String :.: Point
>
> newColoredPoint :: String -> OO s ColoredPoint
> newColoredPoint c = c ## 0 ## end
>
> color :: Select s Color t => OO s t
> color = value Color
The code looks in more complex examples like this:
((~=) is prepending into list fields.)
newArrival :: Patient -> OO Hospital ()
newArrival patient = do
with patient (HospitalVisits += 1)
staff <- value FreeStaff
if staff > 0 then do FreeStaff += (-1)
Examination ~= patient
with patient (do HospitalTime += 3
RemainingTime <-: 3)
else do Triage ~= patient
> main = ooToIO (do c1 <- newPoint
> c2 <- newColoredPoint "green"
> with c1 $ move 7
> with c2 $ move 4
> let p x = liftIO (print x)
> p =<< with c1 getX
> p =<< with c2 getX)
- Einar Karttunen
More information about the Haskell-Cafe
mailing list