1

I was reading the answer to this question: Haskell: difference between . (dot) and $ (dollar sign) And the reply struck me as odd... What does he mean + has no input? And then I tried:

((+) 1)
((+) 1 1)
((+) 1 1 1)

Whoops... sad news. But I'm sure I saw functions that can take seemingly arbitrary or a very large number of arguments to believe that someone had defined them in a way a->b->c...->z. There must be some way to handle it! What I'm looking for is something like &rest or &optional in CL.

Community
  • 1
  • 1
  • 2
    He didn't say that `+` takes no input, but that `1 + 1` takes no input. (That is, `1 + 1` is not a function.) – Sebastian Paaske Tørholm Mar 03 '12 at 12:00
  • 1
    Maybe look at http://stackoverflow.com/questions/3467279/how-to-create-a-polyvariadic-haskell-function – phimuemue Mar 03 '12 at 12:02
  • 2
    Variadic functions are possible, but only with excessive type hackery (and language extensions, I believe). Also note that the answer (I assume you mean the accepted one) doesn't state `+` has no input - the result of `1 + 1` is not a function (accepts no parameters). `+` is an ordinary binary (as in, taking two paramters) function except that you have to write it as `(+)` for syntactical reasons. –  Mar 03 '12 at 12:02
  • 2
    I'm pretty sure there is code on Oleg Kiselyov's site for optional and rest args. However it is generally better to design your functions so you don't need them - e.g. store options in a record passed around by the Reader monad, or use Data.Default (on Hackage not in the standard libraries) when appropriate. – stephen tetley Mar 03 '12 at 12:49

2 Answers2

11

Sure, you can define a variadic addition function, with some typeclass hackery:1

{-# LANGUAGE TypeFamilies #-}

class Add r where
    add' :: (Integer -> Integer) -> r

instance Add Integer where
    add' k = k 0

instance (n ~ Integer, Add r) => Add (n -> r) where
    add' k m = add' (\n -> k (m+n))

add :: (Add r) => r
add = add' id

And so:

GHCi> add 1 2 :: Integer
3
GHCi> add 1 2 3 :: Integer
6

The same trick is used by the standard Text.Printf module. It's generally avoided for two reasons: one, the types it gives you can be awkward to work with, and you often have to specify an explicit type signature for your use; two, it's really a hack, and should be used rarely, if at all. printf has to take any number of arguments and be polymorphic, so it can't simply take a list list, but for addition, you could just use sum.

1 The language extension isn't strictly necessary here, but they make the usage easier (without them, you'd have to explicitly specify the type of each argument in the examples I gave, e.g. add (1 :: Integer) (2 :: Integer) :: Integer).

ehird
  • 40,602
  • 3
  • 180
  • 182
  • I don't see why `FlexibleInstances` is required. – is7s Mar 03 '12 at 15:54
  • @is7s: Oh, it isn't; I used it in a previous version of the code before adding `TypeFamilies`. Thanks! – ehird Mar 03 '12 at 16:07
  • @ehird You're also not really using `TypeFamilies`. – augustss Mar 03 '12 at 18:04
  • @augustss can the equality constraint be expressed without `TypeFamilies`? – is7s Mar 03 '12 at 18:08
  • @augustss: Type families give me equality constraints, which helps the type-checker realise that any given argument must be an `Integer`, eliminating errors from ambiguous overloaded literals. – ehird Mar 03 '12 at 18:33
  • I don't know if type equality can be used without TypeFamilies, but they two very different extensions to the type system. – augustss Mar 03 '12 at 22:52
  • @augustss: Type equality constraints are bundled with `TypeFamilies` and are not accessible in any other way, as far as I know. But yes, they should probably be separated. – ehird Mar 04 '12 at 15:55
2

It's a syntactical trade-off: you can't (in general) have both variable arity functions and nice Haskell-style syntax for function application at the same time. This is because it would make many expressions ambiguous.

Suppose you have a function foo that allows an arity of 1 or 2, and consider the following expression:

foo a b

Should the 1 or 2 argument version of foo be used here? No way for the compiler to know, as it could be the 2 argument version but it could equally be the result of the 1 argument version applied to b.

Hence language designers need to make a choice.

  • Haskell opts for nice function application syntax (no parentheses required)
  • Lisp opts for variable arity functions (and adds parentheses to remove the ambiguity)
mikera
  • 105,238
  • 25
  • 256
  • 415
  • 2
    "...as it could be the 2 argument version but it could equally be the result of the 1 argument version applied to `b`..." that wouldn't be any difference: _all_ Haskell functions with "multiple arguments" are in fact single-argument functions returning a function that accepts the second argument. What would be ambiguous is whether the function should return such a secondary function, or a final result – an ambiguity that _can_, as ehird demonstrates, be handled, with type classes. – leftaroundabout Mar 03 '12 at 15:01
  • Well we're discussing a hypothetical Haskell variant with variable arity overloading so it clearly could make a difference - that's what arity overloading would imply! Agree that the type classes trick is cool, but it's not such a nice intuitive syntax - the ":: Integer" is something of a hack. – mikera Mar 04 '12 at 02:27