[Haskell-cafe] Data structure containing elements which are instances of the

oleg at okmij.org oleg at okmij.org
Tue Aug 14 10:02:16 CEST 2012


> It's only a test case. The real thing is for a game and will be
> something like:

> class EntityT e where
>    update      :: e -> e
>    render      :: e -> IO ()
>    handleEvent :: e -> Event -> e
>    getBound    :: e -> Maybe Bound

> data Entity = forall e. (EntityT e) => Entity e

> data Level = Level {
>    entities = [Entity],
>    ...
>    }

I suspected the real case would look like that. It is also covered on
the same web page on Eliminating existentials. Here is your example
without existentials, in pure Haskell98 (I took a liberty to fill in
missing parts to make the example running)


data Event = Event Int			-- Stubs
type Bound = Pos
type Pos  = (Float,Float)

data EntityO = EntityO{
  update      :: EntityO,
  render      :: IO (),
  handleEvent :: Event -> EntityO,
  getBound    :: Maybe Bound
  }

type Name = String

new_entity :: Name -> Pos -> EntityO
new_entity name pos@(posx,posy) =
  EntityO{update = update,
	  render = render,
	  handleEvent = handleEvent,
	  getBound = getBound}
 where
 update = new_entity name (posx+1,posy+1)
 render = putStrLn $ name ++ " at " ++ show pos
 handleEvent (Event x) = new_entity name (posx + fromIntegral x,posy)
 getBound = if abs posx + abs posy < 1.0 then Just pos else Nothing


data Level = Level {
    entities :: [EntityO]
    }

levels = Level {
  entities = [new_entity "e1" (0,0),
	      new_entity "e2" (1,1)]
  }


evolve :: Level -> Level
evolve l = l{entities = map update (entities l)}

renderl :: Level -> IO ()
renderl l = mapM_ render (entities l)

main = renderl . evolve $ levels


I think the overall pattern should look quite familiar. The
code shows off the encoding of objects as records of closures. See
	http://okmij.org/ftp/Scheme/oop-in-fp.txt
for the references and modern reconstruction of Ken Dickey's
``Scheming with Objects''.

It is this encoding that gave birth to Scheme -- after Steele and
Sussman realized that closures emulate actors (reactive
objects). Incidentally, existentials do enter the picture: the
emerge upon closure conversion:

  Yasuhiko Minamide, J. Gregory Morrisett and Robert Harper
  Typed Closure Conversion. POPL1996
  http://www.cs.cmu.edu/~rwh/papers/closures/popl96.ps

This message demonstrates the inverse of the closure conversion,
eliminating existentials and introducing closures.





More information about the Haskell-Cafe mailing list