I cannot add a number to a Char; the following will fail to compile 'a' + 1. But yet, ['a'..'z'] successfully creates a string in which each of the character value is incremented. Is there a special function that can increment a Char?
I know that I can do chr (ord c + 1).
How does the ['a'..'z'] or the underlying enumFromTo function increment the characters in the resulting String?
Yes, there is a special function that can add to a Char, from the same Enum class that enumFromTo is from, named succ. Beware that it is partial: succ maxBound is undefined, so take care to check the value of the character before you apply succ. succ is indeed the same as \c -> chr (ord c + 1), as you can verify with the universe package:
> let avoidMaxBound f x = if x == maxBound then Nothing else Just (f x)
> avoidMaxBound succ == avoidMaxBound (\c -> chr (ord c + 1))
True
In fact the implementation of succ in GHC is quite close to the function you suggested:
instance Enum Char where
succ (C# c#)
| isTrue# (ord# c# /=# 0x10FFFF#) = C# (chr# (ord# c# +# 1#))
| otherwise = error ("Prelude.Enum.Char.succ: bad argument")
However, succ is not used in the implementation of enumFromTo in GHC:
instance Enum Char where
{-# INLINE enumFromTo #-}
enumFromTo (C# x) (C# y) = eftChar (ord# x) (ord# y)
{-# RULES
"eftChar" [~1] forall x y. eftChar x y = build (\c n -> eftCharFB c n x y)
#-}
-- We can do better than for Ints because we don't
-- have hassles about arithmetic overflow at maxBound
{-# INLINE [0] eftCharFB #-}
eftCharFB :: (Char -> a -> a) -> a -> Int# -> Int# -> a
eftCharFB c n x0 y = go x0
where
go x | isTrue# (x ># y) = n
| otherwise = C# (chr# x) `c` go (x +# 1#)
{-# NOINLINE [1] eftChar #-}
eftChar :: Int# -> Int# -> String
eftChar x y | isTrue# (x ># y ) = []
| otherwise = C# (chr# x) : eftChar (x +# 1#) y
If you can squint past the nastiness that exists primarily for efficiency reasons, you can see that eftChar is essentially using succ, but an inlined version of it rather than an actual call to succ (here, to avoid boxing and re-boxing the Char being manipulated).
I think you're after the pred and succ methods, which return the predecessor or successor of Enum a. The problem is that for a Bounded Enum, if you apply succ on the maximum member of the set you will get an error.
Bearing this in mind, you can define enumFromTo recursively as so (avoiding dangerous succ calls):
eftEnum :: (Enum a, Eq a, Ord a) => a -> a -> [a]
eftEnum a b
| a > b = []
| a == b = [a]
| otherwise = a : rest
where rest = eftEnum (succ a) b
Related
I have a closed set of values:
data Value = A | B | C | D | E ...
deriving (Eq, Ord, Show)
And a data structure that represents their order:
order :: [[Value]]
order = [
[ B ],
[ A, D ],
[ C ],
...
]
I need to convert a Value's order into an Int. I could do it like this:
prec' :: [[Value]] -> Value -> Int
prec' [] _ = 0
prec' (vs : rest) v = if v `elem` vs
then 1 + length rest
else prec' rest v
prec :: Value -> Int
prec = prec' order
However this prec has complexity O(n).
What I would want, is a very lightweight and optimized function like this one:
prec :: Value -> Int
prec = \case
A -> 2
B -> 3
C -> 1
D -> 2
E -> 0
...
But of course I don't want to write it manually, otherwise it risks being inconsistent with the information stored in order. The Haskell compiler should be able to derive that function on its own easily, since its input is a closed set.
How can I get GHC to generate a function like the latest definition of prec?
Solution 1: Use Template Haskell to generate the code you want.
Solution 2 (expanded below): (Ab)use the simplifier.
The main obstacle to simplification is that GHC will not inline recursive functions. One workaround is to do the recursion through type classes.
-- Intuitively unroll :: Nat -> (a -> a) -> (a -> a)
-- but the nat is now a type-level parameter.
class Unroll (n :: Nat) where
unroll :: (a -> a) -> (a -> a)
instance Unroll 0 where
unroll = id
instance {-# OVERLAPPABLE #-} Unroll (n-1) => Unroll n where
unroll f = f . unroll #(n-1) f
This lets you define the following fixpoint operator that unfolds the first n iterations:
unrollfix :: forall n a. Unroll n => (a -> a) -> a
unrollfix f = unroll #n f (fix f)
You then need to write all recursive functions using fix, and replace fix with unrollfix. You have to sprinkle some INLINE pragmas around too.
elem with fix:
elem :: forall a. Eq a => a -> [a] -> Bool
elem = fix go
where
go elem_ x [] = False
go elem_ x (y : ys) = x == y || elem_ x ys
elem with unrollfix:
{-# INLINE uelem #-}
uelem :: forall n a. (Unroll n, Eq a) => a -> [a] -> Bool
uelem = unrollfix #n go
where
go elem_ x [] = False
go elem_ x (y : ys) = x == y || elem_ x ys
Also length (omitted), and prec'.
prec' with fix:
prec' :: forall a. Eq a => [[a]] -> a -> Int
prec' = fix go
where
go prec_ [] v = 0
go prec_ (vs : rest) v = if elem v vs
then 1 + length rest
else prec_ rest v
prec' with unrollfix:
prec' :: forall n a. (Unroll n, Eq a) => [[a]] -> a -> Int
prec' = unrollfix #n go
where
go prec_ [] v = 0
go prec_ (vs : rest) v = if uelem #n v vs
then 1 + ulength #n rest
else prec_ rest v
{-# INLINE go #-}
Finally, set the n parameter to a high enough value to enable simplification.
prec :: Value -> Int
prec v = prec' #5 order v
Full code:
{-# LANGUAGE AllowAmbiguousTypes, DataKinds, MultiParamTypeClasses, ScopedTypeVariables, TypeApplications, UndecidableInstances #-}
{-# OPTIONS_GHC -ddump-simpl #-}
module A (Value(..), prec) where
import GHC.TypeNats
import Data.Function (fix)
import GHC.Exts
class Unroll (n :: Nat) where
unroll :: (a -> a) -> (a -> a)
instance Unroll 0 where
unroll = id
instance {-# OVERLAPPABLE #-} Unroll (n-1) => Unroll n where
unroll f = f . unroll #(n-1) f
unrollfix :: forall n a. Unroll n => (a -> a) -> a
unrollfix f = unroll #n f (fix f)
data Value = A | B | C | D | E
deriving Eq
order :: [[Value]]
order = [[A], [B, C], [D], [E]]
{-# INLINE uelem #-}
uelem :: forall n a. (Unroll n, Eq a) => a -> [a] -> Bool
uelem = unrollfix #n go
where
go elem_ x [] = False
go elem_ x (y : ys) = x == y || elem_ x ys
{-# INLINE go #-}
{-# INLINE ulength #-}
ulength :: forall n a. Unroll n => [a] -> Int
ulength = unrollfix #n go
where
go length_ [] = 0
go length_ (_ : xs) = 1 + length_ xs
{-# INLINE go #-}
prec' :: forall n a. (Unroll n, Eq a) => [[a]] -> a -> Int
prec' = unrollfix #n go
where
{-# INLINE go #-}
go prec_ [] v = 0
go prec_ (vs : rest) v = if uelem #n v vs
then 1 + ulength #n rest
else prec_ rest v
prec :: Value -> Int
prec v = prec' #5 order v
Generated Core (using the -ddump-simpl option) (look at the unfolding, instead of the main definition):
\ (v_aQC [Occ=Once1!] :: Value) ->
case v_aQC of {
__DEFAULT -> GHC.Types.I# 3#;
A -> GHC.Types.I# 4#;
D -> GHC.Types.I# 2#;
E -> GHC.Types.I# 1#
}
I would just wrap a general-purpose memoization tool around the function, like MemoTrie or memoize or fastmemo.
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
import Data.Function.FastMemo
data Value = A | B | C | D | E ...
deriving (Eq, Ord, Show, Generic, Memoizable)
prec :: Value -> Int
prec = memoize $ prec' order
This may not be as optimized as a direct TH solution, but the Generic-derived Memoizable instance should result something reasonably similar. Not sure which of these packages do it best.
Define prec first, then generate order using prec.
prec :: Value -> Int
prec = \case
A -> 2
B -> 3
C -> 1
D -> 2
E -> 0
order :: [[Value]]
order = go [A, B, C, D, E]
where eqPrec = (==) `on` prec
ordPrec = compare `on` prec
go = reverse . groupBy eqPrec . sortBy ordPrec
Perhaps one simple solution would be to do by hand what you want the compiler to do automatically once it has the case statement you describe -- compute a jump table.
import Data.Array
-- deriving Enum makes a compiler-written case statement like what you want
data Foo = A | B | C | D | E deriving (Bounded, Enum)
orderArray :: Array Int Int
orderArray = listArray
(0, fromEnum (maxBound :: Foo) - 1)
(orderSlow <$> [minBound..maxBound])
prec :: Foo -> Int
prec = unsafeAt orderArray . fromEnum
This will have to run orderSlow once for each possible value, but second accesses will be fast O(1) lookups.
For completeness, here is a TH solution (template-haskell-2.19.0):
{-# LANGUAGE TemplateHaskell #-}
module PrecTH where
import Language.Haskell.TH
import Data.List (nub)
prec' :: Ord a => [[a]] -> a -> Int
prec' [] _ = 0
prec' (vs : rest) v = if v `elem` vs
then 1 + length rest
else prec' rest v
mkPrecValueDataType :: String -> [[String]] -> DecsQ
mkPrecValueDataType dtName order = pure [
DataD [] dtName' [] Nothing
[ NormalC (mkName c) []
| c <- cstrs ]
[DerivClause Nothing $ ConT <$> [''Eq, ''Ord, ''Show ]]
, SigD (mkName "prec")
$ ArrowT `AppT` ConT dtName' `AppT` ConT ''Int
, FunD (mkName "prec")
[ Clause [ConP (mkName c) [] []]
(NormalB . LitE . IntegerL $ slowPrec c)
[]
| c <- cstrs ]
]
where slowPrec = fromIntegral . prec' order
cstrs = concat order -- apply `sort` here if you like the constructors in alphabetical order
dtName' = mkName dtName
To be used thus
{-# LANGUAGE TemplateHaskell #-}
module PrecValues where
import PrecTH
mkPrecValueDataType "Value" [["B"], ["A","D"], ["C"]]
and producing
ghci> :browse
prec :: Value -> Int
type Value :: *
data Value = B | A | D | C
ghci> prec<$>[A,B,C,D]
[2,3,1,2]
As part of my journey in understanding singletons I have tried to bridge the gap between compile time safety, and lifting runtime values into that dependent type safety.
I think though that a minimal example of "runtime" values is a function that takes an unbounded list, and converts it to a size-indexed vector. The following skeleton provides length-indexed vectors, but I can't quite determine how to write fromList.
I have considered making the function take a size parameter, but I suspect it's possible to keep that implicit.
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE UndecidableInstances #-}
import Data.Singletons
import Data.Singletons.TH
$(singletons
[d|
data Nat = Z | S Nat deriving (Show)
|])
data Vec a n where
Nil :: Vec a Z
Cons :: a -> Vec a n -> Vec a (S n)
instance Show a => Show (Vec a n) where
show Nil = "Nil"
show (Cons x xs) = show x ++ " :< " ++ show xs
fromListExplicit :: forall (n :: Nat) a. SNat n -> [a] -> Vec a n
fromListExplicit SZ _ = Nil
fromListExplicit (SS n) (x : xs) = Cons x (fromListExplicit n xs)
ex1 = fromListExplicit (SS (SS (SS SZ))) [1..99]
-- 1 :< 2 :< 3 :< Nil
fromListImplicit :: (?????) => [a] -> Vec a n
fromListImplicit = ?????
main :: IO ()
main = do
xs <- readLn :: IO [Int]
print $ fromListImplicit xs
This is not possible using Haskell because Haskell does not yet have full dependent types (although GHC might in the future). Notice that
fromList :: [a] -> Vec a n
Has both a and n quantified universally, which means that the user should be able to pick their n and get back a Vec of the right size. That makes no sense! The trick is that n is not really for the user to choose - it has to be the length of the input list. (For the same reason, fromList :: Integer -> [a] -> Vec a n would not be any more useful - the size hint has to be something type-level.)
Looking to a dependently typed language like Idris, you can define
fromList : (l : List elem) -> Vec (length l) elem
And in fact they define this in the standard library.
So, what can you do? Short of saying that Vec has the length equal to the size of the input list (which requires lifting "length of the input list" to the type level), you can say it has some length.
data SomeVec a where { SomeVec :: Vec a n -> SomeVec a }
list2SomeVec :: [a] -> SomeVec a
list2SomeVec [] = SomeVec Nil
list2SomeVec (x:xs) = case list2SomeVec xs of
SomeVec ys -> SomeVec (x `Cons` ys)
That isn't spectacularly useful, but it is better than nothing.
You can do this with an existentially quantified type variable, as in #Alec’s answer, or equivalently by rewriting in continuation-passing style. The trick is to give fromList a continuation (function) that’s polymorphic in the size of the Vec; then, within the continuation, you have access to a type variable representing the size:
data Vec n a where
Nil :: Vec Z a
Cons :: a -> Vec n a -> Vec (S n) a
deriving instance (Show a) => Show (Vec n a)
fromList :: [a] -> (forall n. Vec n a -> r) -> r
fromList [] k = k Nil
fromList (x : xs) k = fromList xs $ \ xs' -> k (Cons x xs')
-- fromList [1, 2, 3] show == "Cons 1 (Cons 2 (Cons 3 Nil))"
You can’t know the actual value of n, because it’s not available at compile time.
If you replace your Nat with the one from GHC.TypeLits, I think you can get a KnownNat constraint for n by creating a SomeNat from the runtime length using fromJust (someNatVal (fromIntegral (length xs))), then get back the actual length value at runtime with natVal. I’m not really familiar with how to do it, and it might require the ghc-typelits-natnormalise plugin, but it might be a starting point.
As part of my journey in understanding singletons I have tried to bridge the gap between compile time safety, and lifting runtime values into that dependent type safety.
I think though that a minimal example of "runtime" values is a function that takes an unbounded list, and converts it to a size-indexed vector. The following skeleton provides length-indexed vectors, but I can't quite determine how to write fromList.
I have considered making the function take a size parameter, but I suspect it's possible to keep that implicit.
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE UndecidableInstances #-}
import Data.Singletons
import Data.Singletons.TH
$(singletons
[d|
data Nat = Z | S Nat deriving (Show)
|])
data Vec a n where
Nil :: Vec a Z
Cons :: a -> Vec a n -> Vec a (S n)
instance Show a => Show (Vec a n) where
show Nil = "Nil"
show (Cons x xs) = show x ++ " :< " ++ show xs
fromListExplicit :: forall (n :: Nat) a. SNat n -> [a] -> Vec a n
fromListExplicit SZ _ = Nil
fromListExplicit (SS n) (x : xs) = Cons x (fromListExplicit n xs)
ex1 = fromListExplicit (SS (SS (SS SZ))) [1..99]
-- 1 :< 2 :< 3 :< Nil
fromListImplicit :: (?????) => [a] -> Vec a n
fromListImplicit = ?????
main :: IO ()
main = do
xs <- readLn :: IO [Int]
print $ fromListImplicit xs
This is not possible using Haskell because Haskell does not yet have full dependent types (although GHC might in the future). Notice that
fromList :: [a] -> Vec a n
Has both a and n quantified universally, which means that the user should be able to pick their n and get back a Vec of the right size. That makes no sense! The trick is that n is not really for the user to choose - it has to be the length of the input list. (For the same reason, fromList :: Integer -> [a] -> Vec a n would not be any more useful - the size hint has to be something type-level.)
Looking to a dependently typed language like Idris, you can define
fromList : (l : List elem) -> Vec (length l) elem
And in fact they define this in the standard library.
So, what can you do? Short of saying that Vec has the length equal to the size of the input list (which requires lifting "length of the input list" to the type level), you can say it has some length.
data SomeVec a where { SomeVec :: Vec a n -> SomeVec a }
list2SomeVec :: [a] -> SomeVec a
list2SomeVec [] = SomeVec Nil
list2SomeVec (x:xs) = case list2SomeVec xs of
SomeVec ys -> SomeVec (x `Cons` ys)
That isn't spectacularly useful, but it is better than nothing.
You can do this with an existentially quantified type variable, as in #Alec’s answer, or equivalently by rewriting in continuation-passing style. The trick is to give fromList a continuation (function) that’s polymorphic in the size of the Vec; then, within the continuation, you have access to a type variable representing the size:
data Vec n a where
Nil :: Vec Z a
Cons :: a -> Vec n a -> Vec (S n) a
deriving instance (Show a) => Show (Vec n a)
fromList :: [a] -> (forall n. Vec n a -> r) -> r
fromList [] k = k Nil
fromList (x : xs) k = fromList xs $ \ xs' -> k (Cons x xs')
-- fromList [1, 2, 3] show == "Cons 1 (Cons 2 (Cons 3 Nil))"
You can’t know the actual value of n, because it’s not available at compile time.
If you replace your Nat with the one from GHC.TypeLits, I think you can get a KnownNat constraint for n by creating a SomeNat from the runtime length using fromJust (someNatVal (fromIntegral (length xs))), then get back the actual length value at runtime with natVal. I’m not really familiar with how to do it, and it might require the ghc-typelits-natnormalise plugin, but it might be a starting point.
Does GHC ever unpack sum types when passing them to functions? For example, let's say that we have the following type:
data Foo
= Foo1 {-# UNPACK #-} !Int {-# UNPACK #-} !Word
| Foo2 {-# UNPACK #-} !Int
| Foo3 {-# UNPACK #-} !Word
Then I define a function that is strict in its Foo argument:
consumeFoo :: Foo -> Int
consumeFoo x = case x of ...
At runtime, when I call consumeFoo, what can I expect to happen? The GHC calling convention is to pass arguments in registers (or on the stack once there are too many). I can see two ways that the argument passing could go:
A pointer to a Foo on the heap gets passed in as one argument.
A three-argument representation of Foo is used, one argument representing the data constructor that was used and the other two representing the possible Int and Word values in the data constructor.
I would prefer the second representation, but I don't know if it is actually what happens. I am aware of UnpackedSumTypes landing in GHC 8.2, but it's unclear if it does what I want. If I had instead written the function as:
consumeFooAlt :: (# (# Int#, Word# #) | Int# | Word# #) -> Int
Then I would expect that evaluation (2) would be what happens. And the Unpacking section of the unpacked sums page indicates that I could do this as well:
data Wrap = Wrap {-# UNPACK #-} !Foo
consumeFooAlt2 :: Wrap -> Int
And that should also have the representation I want, I think.
So my question is, without using a wrapper type or a raw unpacked sum, how can I guarentee that a sum is unpacked into registers (or onto the stack) when I pass it as an argument to a function? If it is possible, is it something that GHC 8.0 can already do, or is it something that will only be available in GHC 8.2?
First: Guaranteed optimization and GHC don't mix well. Due to the high level it is very hard to predict the code that GHC will generate in every case. The only way to be sure is to look at the Core. If you're developing an extremely performance dependent application with GHC, then you need to become familar with Core I.
I am not aware of any optimization in GHC that does exactly what you describe. Here is an example program:
module Test where
data Sum = A {-# UNPACK #-} !Int | B {-# UNPACK #-} !Int
consumeSum :: Sum -> Int
consumeSum x = case x of
A y -> y + 1
B y -> y + 2
{-# NOINLINE consumeSumNoinline #-}
consumeSumNoinline = consumeSum
{-# INLINE produceSumInline #-}
produceSumInline :: Int -> Sum
produceSumInline x = if x == 0 then A x else B x
{-# NOINLINE produceSumNoinline #-}
produceSumNoinline :: Int -> Sum
produceSumNoinline x = if x == 0 then A x else B x
test :: Int -> Int
--test x = consumeSum (produceSumInline x)
test x = consumeSumNoinline (produceSumNoinline x)
Let's first look at what happens if we don't inline consumeSum nor produceSum. Here is the core:
test :: Int -> Int
test = \ (x :: Int) -> consumeSumNoinline (produceSumNoinline x)
(produced with ghc-core test.hs -- -dsuppress-unfoldings -dsuppress-idinfo -dsuppress-module-prefixes -dsuppress-uniques)
Here, we can see that GHC (8.0 in this case) does not unbox the sum type passed as a function argument. Nothing changes if we inline either consumeSum or produceSum.
If we inline both however, then the following code is generated:
test :: Int -> Int
test =
\ (x :: Int) ->
case x of _ { I# x1 ->
case x1 of wild1 {
__DEFAULT -> I# (+# wild1 2#);
0# -> lvl1
}
}
What happened here is that through inlining, GHC ends up with:
\x -> case (if x == 0 then A x else B x) of
A y -> y + 1
B y -> y + 2
Which through the case-of-case (if is just a special case) is turned into:
\x -> if x == 0 then case (A x) of ... else case (B x) of ...
Now that is a case with a known constructor, so GHC can reduce the case at compile time ending up with:
\x -> if x == 0 then x + 1 else x + 2
So it completely eliminated the constructor.
In summary, I believe that GHC does not have any concept of an "unboxed sum" type prior to version 8.2, which also applies to function arguments. The only way to get "unboxed" sums is to get the constructor eliminated completely through inlining.
If you need such an optimization, your simplest solution is to do it yourself.
I think there are actually many ways to achieve this, but one is:
data Which = Left | Right | Both
data Foo = Foo Which Int Word
The unpacking of any fields of this type is completely irrelevant to the question of the 'shape of the representation', which is what you are really asking about. Enumerations are already highly optimized - only one value for every constructor is ever created - so the addition of this field doesn't affect performance. The unpacked representation of this type is precisely what you want - one word for Which constructor and one for each field.
If you write your functions in the proper way, you get the proper code:
data Which = Lft | Rgt | Both
data Foo = Foo Which {-# UNPACK #-} !Int {-# UNPACK #-} !Word
consumeFoo :: Foo -> Int
consumeFoo (Foo w l r) =
case w of
Lft -> l
Rgt -> fromIntegral r
Both -> l + fromIntegral r
The generated core is quite obvious:
consumeFoo :: Foo -> Int
consumeFoo =
\ (ds :: Foo) ->
case ds of _ { Foo w dt dt1 ->
case w of _ {
Lft -> I# dt;
Rgt -> I# (word2Int# dt1);
Both -> I# (+# dt (word2Int# dt1))
}
}
However, for simple programs such as:
consumeFoos = foldl' (+) 0 . map consumeFoo
This optimization makes no difference. As is indicated in the other answer, the inner function consumeFoo is just inlined:
Rec {
$wgo :: [Foo] -> Int# -> Int#
$wgo =
\ (w :: [Foo]) (ww :: Int#) ->
case w of _ {
[] -> ww;
: y ys ->
case y of _ {
Lft dt -> $wgo ys (+# ww dt);
Rgt dt -> $wgo ys (+# ww (word2Int# dt));
Both dt dt1 -> $wgo ys (+# ww (+# dt (word2Int# dt1)))
}
}
end Rec }
vs.
Rec {
$wgo :: [Foo] -> Int# -> Int#
$wgo =
\ (w :: [Foo]) (ww :: Int#) ->
case w of _ {
[] -> ww;
: y ys ->
case y of _ { Foo w1 dt dt1 ->
case w1 of _ {
Lft -> $wgo ys (+# ww dt);
Rgt -> $wgo ys (+# ww (word2Int# dt1));
Both -> $wgo ys (+# ww (+# dt (word2Int# dt1)))
}
}
}
end Rec }
Which, in almost every case when working with low-level, unpacked data, is the goal anyways, as most of your functions are small and cost little to inline.
Mind the following Haskell term:
callNTimes :: forall a . Int -> (a -> a) -> a -> a
callNTimes n f 0 = x
callNTimes n f x = f (callNTimes (n-1) f x)
firstOf :: ??????
firstOf n = callNTimes n (\ x y -> x)
If we ignore the types and normalize the functions by hand, firstOf is a function that receives an N, then N arguments, discards all but the first and returns it. firstOf 3 10 20 30 returns 3. Is it possible to type that function in GHC 8.0 with the new dependent typing features?
I finally managed to get a working version - it's not exactly what you asked for but it demonstrates what I was commenting about and I think it's quite close
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Variadic where
data Z a = Z
data S t a = S (t a)
class Var n where
type El n :: *
type Res n :: *
firstOf :: n -> El n -> Res n
instance Var (Z a) where
type El (Z a) = a
type Res (Z a) = a
firstOf Z a = a
instance (El (n a) ~ a, Var (n a)) => Var (S n a) where
type El (S n a) = a
type Res (S n a) = a -> Res (n a)
firstOf (S n) a _ = firstOf n a
here are a few examples:
λ> firstOf Z 5
5
λ> firstOf (S Z) 5 9
5
λ> firstOf (S (S Z)) 5 8 9
5
λ> firstOf (S (S Z)) "Hi" "World" "Uhu"
"Hi"
if you are interested in how I got there you can check the edit-history
remarks
it uses the S and Z as a poor-mansreplacement* for type-level literals and you can probably get it working with this
the version firstOf (S (S Z)) which you would expect to want 2 arguments is waiting for 3 - that's because I start with Z = 1 argument
I just saw that you wanted firstOf 3 10 20 30 = 3 which this will not do (this will give 10) - which is probably doable with type-level literals and an obvious overload too
{-# LANGUAGE GADTs, DataKinds, TypeFamilies, TypeOperators #-}
type family Fun as b where
Fun '[] b = b
Fun (a ': as) b = a -> Fun as b
data SL as where
Sn :: SL '[]
Sc :: SL as -> SL (a ': as)
constN :: SL as -> b -> Fun as b
constN Sn y = y
constN (Sc s) y = \_ -> constN s y
-- 1
main = print $ constN (Sc (Sc (Sc Sn))) 1 "a" [3] True
E.g. Fun [Int, Bool] [Int] = Int -> Bool -> [Int]. SL is a singleton that allows to lift lists to the type level. Pattern matching on SL as reveals that as is either [] or a:as. In the first case the goal has type Fun [] b which is just b. In the second case the goal has type a -> Fun as b, hence the lambda.
And a simple solution with just GADTs:
{-# LANGUAGE GADTs #-}
data T z a where
Tz :: T z z
Ts :: T z b -> T z (a -> b)
constN :: T z a -> z -> a
constN Tz y = y
constN (Ts s) y = \x -> constN s y
-- 1
main = print $ constN (Ts (Ts (Ts Tz))) 1 "a" [3] True