<div dir="ltr"><div>Hi again,<br></div>I have a game in which the user can create/write/read variables, using a small DSL. The type of the variable created can be whatever chooses the user, so I'm using existential types to store those variables in a heterogeneous list. <br>
This works fine, but the problem is that the "Typeable" class tag leaks into the DSL... The question is, how to get rid of it?<br><div><div><span style="font-family:courier new,monospace"><br></span></div><div><span style="font-family:courier new,monospace">> This is literate Haskell<br>
</span></div><div><span style="font-family:courier new,monospace">> {-# LANGUAGE GADTs, ScopedTypeVariables  #-}<br>> module DSLClass where<br>> import Control.Monad<br>> import Control.Monad.State<br>> import Data.Typeable<br>
></span><br><br>This is the (simplified) DSL. With it you can read a variable stored in the game state (creation/writing is not shown).<br>How can we get rid of the "Typeable a" in the ReadFirstVar constructor?<br>
<br><span style="font-family:courier new,monospace">> -- first type parameter is used to track effects<br>> data Exp a where<br>>   ReadFirstVar :: (Typeable a) => Exp a           <----- Ugly<br>>   Return       :: a -> Exp a<br>
>   Bind         :: Exp a -> (a -> Exp b) -> Exp b</span><br><br>This is the definition of a variable. The type is unknow, so I use existantial types.<br><span style="font-family:courier new,monospace"><br>> data Var = forall a . (Typeable a) => Var { v :: a}</span><br>
<br></div><div>This game state. It holds the heterogenous list.<br></div><div><br><span style="font-family:courier new,monospace">> data Game = Game { variables :: [Var]}</span><br><br>The evaluation of "Exp" can be:<br>
<br><span style="font-family:courier new,monospace">> eval :: Exp a -> State Game a<br>> eval ReadFirstVar  = do<br>>   (Game ((Var v):vs)) <- get<br>>   case cast v of<br>>      Just val -> return val<br>
>      Nothing -> error "no cast"<br>> eval (Bind exp f) = do<br>>   a <- eval exp<br>>   eval (f a)<br></span><br><br></div><div>As you can see, I'm obliged to cast the variable type to match it with the expression's type. Is that the right place to do it?<br>
<br></div><div>Thanks!!<br>Corentin<br></div></div></div>