[Haskell] Variable arity function (VarArg)
ChrisK
chrisk at MIT.EDU
Wed Apr 20 23:42:21 EDT 2005
And while I'm posting to the list, I'll send something I wish I had
found earlier.
I had wanted to write show several things, and writing show 10 times
was not clever.
And so I initially created an infix operator to put between everything
to do the showing, which was not much better.
But this http://okmij.org/ftp/Haskell/types.html#polyvar-fn was the
clever technique.
{-# OPTIONS -fglasgow-exts #-}
-- Techinque from http://okmij.org/ftp/Haskell/types.html#polyvar-fn
-- canShowList and ssum will take a variable number of arguments
data CanShow where { CanShow :: Show a => a -> CanShow
; CSLit::String->CanShow}
instance Show CanShow where
show (CanShow a) = show a
show (CSLit s) = s
-- The initial type is accumulator, here a simple list
class (Show a) => ShowList a r where
canShowList :: [CanShow] -> a -> r
-- After accumulating last argument, you can apply a function, e.g.
reverse
instance (Show b) => ShowList b [CanShow] where
canShowList l x = reverse $ (CanShow x):l
-- Get next argument
instance (Show a,ShowList b r) => ShowList a (b->r) where
canShowList l x = canShowList ((CanShow x):l)
-- Could eat initial fully typed arguments and make tuple with []
sL :: (ShowList a r) => a -> r
sL = canShowList []
pio :: [CanShow]->IO()
pio = putStr . unlines . (map show)
eatFirstClass :: (forall a r.(ShowList a r)=>(a->r))->[CanShow]
eatFirstClass s = s "and more"
-- Using the same technique to do more work
-- This example needs the "r->a" FunDep to work:
class (Num a)=>ScaledSum a r | r->a where
ssum' :: (a,a) -> a -> r
instance ScaledSum Double Double where
ssum' (s,t) x = (s*(t+x))
-- As an added bonus we get "context sensativity"
instance ScaledSum Double Int where
ssum' (s,t) x = floor (s*(t+x))
instance (ScaledSum a p) => ScaledSum a (a->p) where
ssum' (s,t) x = ssum' (s,t+x)
ssum a x = ssum' (a,0) x
-- This fails since ::[Int] applies to (print $ build 1 2 3)
--main = print $ build 1 2 3 ::[Int]
-- Use parenthesis to control ::[Int] syntax
main = do
let empty :: [String]
empty = []
full = [1,2,3]
efc = eatFirstClass (sL empty full)
eol = CSLit "\n"
ssI = (ssum 12) 1 (1/2) (-3.5) :: Int
ssD = (ssum 12) 1 (1/2) (-3.5) :: Double
pio (sL "Hi!" (17,'a') eol (1,CSLit ['a']) empty (CSLit
"ping\n") full efc ("ssum",ssI,ssD) "Bye!")
let
other = sL "Terminate with ::[CanShow]" full 1 eol 2 eol
3 ::[CanShow]
putStrLn $ show other
=== GHCI ===
*Main> main
"Hi!"
(17,'a')
(1,a)
[]
ping
[1,2,3]
[[],[1,2,3],"and more"]
("ssum",-24,-24.0)
"Bye!"
["Terminate with ::[CanShow]",[1,2,3],1,
,2,
,3]
More information about the Haskell
mailing list