<div dir="ltr">Ugly, maybe not, but I read somewhere that the class restriction should be on the functions definitions than in the datatype definition... That is, the datatype is usually defined without class restriction, instead the necessary class restriction is added latter on in the functions signatures that work on that datatype.<br>
<div><div class="gmail_extra"><br><br><div class="gmail_quote">On Sat, Feb 1, 2014 at 7:02 PM, Richard Eisenberg <span dir="ltr"><<a href="mailto:eir@cis.upenn.edu" target="_blank">eir@cis.upenn.edu</a>></span> wrote:<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div style="word-wrap:break-word"><div>This seems reasonable to me. What's ugly about it? As I see it, casting really is necessary, because there's no way to know whether the type of the head variable in the list is correct without it.</div>
<div><br></div><div>Richard</div><br><div><div><div class="h5"><div>On Feb 1, 2014, at 10:55 AM, Corentin Dupont <<a href="mailto:corentin.dupont@gmail.com" target="_blank">corentin.dupont@gmail.com</a>> wrote:</div>
<br></div></div><blockquote type="cite"><div><div class="h5"><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></div></div>
_______________________________________________<br>Haskell-Cafe mailing list<br><a href="mailto:Haskell-Cafe@haskell.org" target="_blank">Haskell-Cafe@haskell.org</a><br><a href="http://www.haskell.org/mailman/listinfo/haskell-cafe" target="_blank">http://www.haskell.org/mailman/listinfo/haskell-cafe</a><br>
</blockquote></div><br></div></blockquote></div><br></div></div></div>