If you want to defer the choice of 's' you've to make it appear in the type signature of test1, so you've to introduce an artificial parameter even if we're interested only in its type. e.g.:
data Proxy (s :: * -> * -> *)  -- useful because we can't have an argument of type 's' directly, since it's higher-kinded,
                                  -- and to document that we're using a phantom argument
proxy :: Proxy s
proxy = undefined

test1 :: Stack s => Proxy s -> Integer
test1 pr = first . p 2 . p 3 $ empty `asTypeOf` toStack pr
   where toStack :: Proxy s -> s a b
testTuple = test1 (proxy :: Proxy (,))

enabling LANGUAGE ScopedTypeVars you can rewrite test1 in a more direct fashion:

test1 :: forall s. Stack s => Proxy s -> Integer
test1 _ = fist . p 2 . p 3 $ (empty :: s () Void)


On Mon, Nov 24, 2008 at 5:09 AM, Jacques Carette <carette@mcmaster.ca> wrote:
I was trying to create a typeclass for an abstract Stack class, and ran into some problems.  The following 'works' fine:

{-# OPTIONS_GHC -XEmptyDataDecls -XFlexibleContexts -fno-monomorphism-restriction #-}
module Stack where

data Void

class Stack s where
  push_ :: s a r -> b -> s b (s a r)
  empty :: s () Void
  top   :: s a (s b r) -> (a, s b r)
  first :: s a r -> a

instance Stack (,) where
  push_ s a = (a,s)
  empty     = ((),undefined::Void)
  top       = id
  first     = fst

p = flip push_
test0 = top  . p 2 . p 3 $ empty

-- But the following doesn't - I get an "Ambiguous type variable `s' in the contraint `Stack s' arising from the use of `first':
test1 = first . p 2 . p 3 $ empty
-- 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.
-- So I listen to the "probable fix" and add a type signature:
test1 :: Stack (,) => Integer

-- This does not however help at all!  The only way I have found of 'fixing' 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.  But GHC 6.8.2 does not want to let me do this.

What are my options?

Jacques
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe