If you want to defer the choice of &#39;s&#39; you&#39;ve to make it appear in the type signature of test1, so you&#39;ve to introduce an artificial parameter even if we&#39;re interested only in its type. e.g.:<br>data Proxy (s :: * -&gt; * -&gt; *)&nbsp; -- useful because we can&#39;t have an argument of type &#39;s&#39; directly, since it&#39;s higher-kinded, <br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -- and to document that we&#39;re using a phantom argument<br>proxy :: Proxy s<br>proxy = undefined<br><br>test1 :: Stack s =&gt; Proxy s -&gt; Integer<br>test1 pr = first . p 2 . p 3 $ empty `asTypeOf` toStack pr<br>
&nbsp;&nbsp; where toStack :: Proxy s -&gt; s a b<br>testTuple = test1 (proxy :: Proxy (,))<br><br>enabling LANGUAGE ScopedTypeVars you can rewrite test1 in a more direct fashion:<br><br>test1 :: forall s. Stack s =&gt; Proxy s -&gt; Integer<br>
test1 _ = fist . p 2 . p 3 $ (empty :: s () Void)<br><br><br><div class="gmail_quote">On Mon, Nov 24, 2008 at 5:09 AM, Jacques Carette <span dir="ltr">&lt;<a href="mailto:carette@mcmaster.ca">carette@mcmaster.ca</a>&gt;</span> wrote:<br>
<blockquote class="gmail_quote" style="border-left: 1px solid rgb(204, 204, 204); margin: 0pt 0pt 0pt 0.8ex; padding-left: 1ex;">I was trying to create a typeclass for an abstract Stack class, and ran into some problems. &nbsp;The following &#39;works&#39; fine:<br>

<br>
{-# OPTIONS_GHC -XEmptyDataDecls -XFlexibleContexts -fno-monomorphism-restriction #-}<br>
module Stack where<br>
<br>
data Void<br>
<br>
class Stack s where<br>
 &nbsp; push_ :: s a r -&gt; b -&gt; s b (s a r)<br>
 &nbsp; empty :: s () Void<br>
 &nbsp; top &nbsp; :: s a (s b r) -&gt; (a, s b r)<br>
 &nbsp; first :: s a r -&gt; a<br>
<br>
instance Stack (,) where<br>
 &nbsp; push_ s a = (a,s)<br>
 &nbsp; empty &nbsp; &nbsp; = ((),undefined::Void)<br>
 &nbsp; top &nbsp; &nbsp; &nbsp; = id<br>
 &nbsp; first &nbsp; &nbsp; = fst<br>
<br>
p = flip push_<br>
test0 = top &nbsp;. p 2 . p 3 $ empty<br>
<br>
-- But the following doesn&#39;t - I get an &quot;Ambiguous type variable `s&#39; in the contraint `Stack s&#39; arising from the use of `first&#39;:<br>
test1 = first . p 2 . p 3 $ empty<br>
-- sure, that makes sense, it somehow needs to know what flavour of Stack to use even though (or perhaps because) the answer is independent of it.<br>
-- So I listen to the &quot;probable fix&quot; and add a type signature:<br>
test1 :: Stack (,) =&gt; Integer<br>
<br>
-- This does not however help at all! &nbsp;The only way I have found of &#39;fixing&#39; this requires annotating the code itself, which I most definitely do not want to do because I specifically want the code to be polymorphic in that way. &nbsp;But GHC 6.8.2 does not want to let me do this.<br>

<br>
What are my options?<br>
<br>
Jacques<br>
_______________________________________________<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>