OptionalArguments from ML in Haskell - see http://mlton.org/OptionalArguments

OptionalArg.hs

-- see http://mlton.org/OptionalArguments
module OptionalArg where

data Product a b = a :& b deriving Show

end (a, f) = f a
fold (a, f) g = g (a, f)
step0 h (a, f) = fold (h a, f)
step1 h (a, f) b = fold (h (b, a), f)
                   
make z =
   fold ((id, \(f, x) -> f x),
         \(d, r) func ->
             fold ( (id, d ())
                  , \(f, d) -> let (d' :& ()) = r (id, f d)
                               in func d'))
   z

def d = step0 (\(f, r) -> (\ds -> f (d :& ds),
                           \(f, a :& b) -> r (\x -> f a :& x, b)))

o z = step1 (\(x, (f, _ :& d)) -> (\d -> f (x :& d), d)) z


-- example:
      
data Color = Red | Blue | Black deriving Show
                                         
greet' name age color = concat
                        [ "Hi, my name is "
                        , name
                        , ", I am "
                        , show age
                        , " years old and my favorite color is "
                        , show color
                        ]

greet z = make (def "anonymous") (def 42) (def Blue) end
          (\(name :& age :& color) -> greet' name age color)
          z