<p dir="ltr">A benefit of using type families and type classes instead of GADTs for this kind of thing when you can is they are usually cheaper. You can often write code that inlines perfectly with former but ends up being some recursive function that will never inline with the latter.</p>

<p dir="ltr">- Jake </p>
<div class="gmail_quote">On Mar 14, 2014 5:20 PM, "Eric Walkingshaw" <<a href="mailto:walkiner@eecs.oregonstate.edu">walkiner@eecs.oregonstate.edu</a>> wrote:<br type="attribution"><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">
<div dir="ltr"><div class="gmail_extra"><div>I'm not sure if this answers your questions, but I think this particular problem has a cleaner solution with GADTs:</div><div><br></div><div>    {-# LANGUAGE GADTs #-}</div>


<div>    </div><div>    data Cmd s t where</div><div>      Push :: a             -> Cmd s         (a,s)</div><div>      F1   :: (a -> b)      -> Cmd (a,s)     (b,s)</div><div>      F2   :: (a -> b -> c) -> Cmd (a,(b,s)) (c,s)</div>


<div>    </div><div>    data Prog s t where</div><div>      (:.) :: Cmd s t -> Prog t u -> Prog s u</div><div>      End  :: Prog s s</div><div>    </div><div>    infixr 5 :.</div><div>    </div><div>    cmd :: Cmd s t -> s -> t</div>


<div>    cmd (Push a) s         = (a, s)</div><div>    cmd (F1 f)   (a,s)     = (f a, s)</div><div>    cmd (F2 f)   (a,(b,s)) = (f a b, s)</div><div>    </div><div>    prog :: Prog s t -> s -> t</div><div>    prog (c :. p) s = prog p (cmd c s)</div>


<div>    prog End      s = s</div><div>    </div><div>    run :: Prog () t -> t</div><div>    run p = prog p ()</div><div><br></div><div>Then from GHCi:</div><div>    </div><div>    > run (Push 3 :. Push 4 :. F2 (+) :. F1 show :. End)</div>


<div>    ("7",())</div><div><br></div><div>Maybe you really want GADTs? :)</div><div><br></div><div>-Eric</div></div></div>
<br>_______________________________________________<br>
Haskell-Cafe mailing list<br>
<a href="mailto:Haskell-Cafe@haskell.org">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>
<br></blockquote></div>