[Haskell-cafe] Calling function with unknown number and type arguments

Dan Doel dan.doel at gmail.com
Sun Aug 16 21:50:01 EDT 2009


On Sunday 16 August 2009 8:35:19 pm Antoine Latter wrote:
> But with those, the number of arguments is still known at compile time,
> correct?

{-# LANGUAGE Rank2Types #-}

import Text.Printf
import System.Environment

nprintf :: PrintfType t => Int -> Int -> t
nprintf n e = aux (printf str) n
 where
 str = concat $ replicate n "%d"
 aux :: PrintfType t' => (forall t. PrintfType t => t) -> Int -> t'
 aux pf 0 = pf
 aux pf n = aux (pf e) (n-1)

main = do (n:e:_) <- map read `fmap` getArgs
          nprintf n e :: IO ()

------------------------------------------------------------------------

% ./Var 2 5
55
% ./Var 6 5
555555

Voila.

-- Dan


More information about the Haskell-Cafe mailing list