hspp
hspp: bring Haskell Style Programming to C++.
C++ are introducing monadic interfaces. We have compared hspp and some proposals, refer to std::optional and std::expected for more details.
Mom, can we have monadic do notation / monad comprehension in C++?
Here you are!
Sample 1 for Maybe (similar to std::optional) Monad used in do notation
The sample is originated from Learn You a Haskell for Great Good!
"Pierre has decided to take a break from his job at the fish farm and try tightrope walking. He's not that bad at it, but he does have one problem: birds keep landing on his balancing pole! Let's say that he keeps his balance if the number of birds on the left side of the pole and on the right side of the pole is within three."
Note that Pierre may also suddenly slip and fall when there is a banana.
Original Haskell version
routine :: Maybe Pole
routine = do
start <- return (0,0)
first <- landLeft 2 start
Nothing
second <- landRight 2 first
landLeft 1 second
routine = do
start <- return (0,0)
first <- landLeft 2 start
Nothing
second <- landRight 2 first
landLeft 1 second
C++ version using hspp
Id start, first, second;
auto const routine = do_(
start <= return_ | Pole{0,0}),
first <= (landLeft | 2 | start),
nothing,
second <= (landRight | 2 | first),
landLeft | 1 | second
);
auto const routine = do_(
start <= return_ | Pole{0,0}),
first <= (landLeft | 2 | start),
nothing
second <= (landRight | 2 | first),
landLeft | 1 | second
);
Sample 2 for Either (similar to std::expected) Monad used in do notation
In p0323r0, there is a proposal to add a utility class to represent expected monad.
A use case would be like
expected<int, error_condition> safe_divide(int i, int j)
{
if (j == 0) return make_unexpected(arithmetic_errc::divide_by_zero);
if (i%j != 0) return make_unexpected(arithmetic_errc::not_integer_division);
else return i / j;
}
// i / k + j / k
expected<int, error_condition> f(int i, int j, int k)
{
return safe_divide(i, k).bind([=](int q1)
{
return safe_divide(j,k).bind([=](int q2)
{
return q1+q2;
});
});
}
{
if (j == 0) return make_unexpected(arithmetic_errc::divide_by_zero);
if (i%j != 0) return make_unexpected(arithmetic_errc::not_integer_division);
else return i / j;
}
// i / k + j / k
expected<int, error_condition> f(int i, int j, int k)
{
return safe_divide(i, k).bind([=](int q1)
{
return safe_divide(j,k).bind([=](int q2)
{
return q1+q2;
});
});
}
In hspp, the codes would be like
auto safe_divide(int i, int j) -> Either
{
if (j == 0) return toLeft | arithmetic_errc::divide_by_zero;
if (i%j != 0) return toLeft | arithmetic_errc::not_integer_division;
else return toRight || i / j;
}
auto f(int i, int j, int k) -> Either
{
Id<int> q1, q2;
return do_(
q1 <= safe_divide(i, k),
q2 <= safe_divide(j, k),
return_ || q1 + q2
);
}
{
if (j == 0) return toLeft | arithmetic_errc::divide_by_zero;
if (i%j != 0) return toLeft | arithmetic_errc::not_integer_division;
else return toRight || i / j;
}
auto f(int i, int j, int k) -> Either
{
Id<int> q1, q2;
return do_(
q1 <= safe_divide(i, k),
q2 <= safe_divide(j, k),
return_ || q1 + q2
);
}
Refer to proposal sample for complete sample codes.
Sample 3 for monadic do notation for a vector monad
Filter even numbers.
using namespace hspp;
using namespace hspp::doN;
Id<int> i;
auto const result = do_(
i <= std::vector{1, 2, 3, 4},
guard | (i % 2 == 0),
return_ | i
);
using namespace hspp::doN;
Id<int> i;
auto const result = do_(
i <= std::vector{1, 2, 3, 4},
guard | (i % 2 == 0),
return_ | i
);
Sample 4 for monad comprehension for a range monad
Obtain an infinite range of Pythagorean triples.
Haskell version
triangles = [(i, j, k) | k <- [1..], i <- [1..k], j <- [i..k] , i^2 + j^2 == k^2]
using namespace hspp::doN;
using namespace hspp::data;
Id<int> i, j, k;
auto const rng = _(
makeTuple<3> | i | j | k,
k <= (enumFrom | 1),
i <= (within | 1 | k),
j <= (within | i | k),
if_ || (i*i + j*j == k*k)
);
using namespace hspp::data;
Id<int> i, j, k;
auto const rng = _(
makeTuple<3> | i | j | k,
k <= (enumFrom | 1),
i <= (within | 1 | k),
j <= (within | i | k),
if_ || (i*i + j*j == k*k)
);
Equivalent version using RangeV3 would be link
using namespace ranges;
// Lazy ranges for generating integer sequences
auto const intsFrom = view::iota;
auto const ints = [=](int i, int j)
{
return view::take(intsFrom(i), j-i+1);
};
// Define an infinite range of all the Pythagorean
// triples:
auto triples =
view::for_each(intsFrom(1), [](int z)
{
return view::for_each(ints(1, z), [=](int x)
{
return view::for_each(ints(x, z), [=](int y)
{
return yield_if(x*x + y*y == z*z,
std::make_tuple(x, y, z));
});
});
});
// Lazy ranges for generating integer sequences
auto const intsFrom = view::iota;
auto const ints = [=](int i, int j)
{
return view::take(intsFrom(i), j-i+1);
};
// Define an infinite range of all the Pythagorean
// triples:
auto triples =
view::for_each(intsFrom(1), [](int z)
{
return view::for_each(ints(1, z), [=](int x)
{
return view::for_each(ints(x, z), [=](int y)
{
return yield_if(x*x + y*y == z*z,
std::make_tuple(x, y, z));
});
});
});
Sample 5 for Function Monad used in do notation
We have two functions, plus1, and showStr. With do notation we construct a new function that will accept an integer as argument and return a tuple of results of the two functions.
auto plus1 = toFunc<> | [](int x){ return 1+x; };
auto showStr = toFunc<> | [](int x){ return show | x; };
Id<int> x;
Id y;
auto go = do_(
x <= plus1,
y <= showStr,
return_ || makeTuple<2> | x | y
);
auto result = go | 3;
std::cout << std::get<0>(result) << std::endl;
std::cout << std::get<1>(result) << std::endl;
auto showStr = toFunc<> | [](int x){ return show | x; };
Id<int> x;
Id
auto go = do_(
x <= plus1,
y <= showStr,
return_ || makeTuple<2> | x | y
);
auto result = go | 3;
std::cout << std::get<0>(result) << std::endl;
std::cout << std::get<1>(result) << std::endl;
Sample 6 for parser combinator
Original haskell version Monadic Parsing in Haskell
expr, term, factor, digit :: Parser Int
digit = do {x <- token (sat isDigit); return (ord x - ord '0')}
factor = digit +++ do {symb "("; n <- expr; symbol ")"; return n}
term = factor `chainl1` mulop
expr = term `chainl1` addop
digit = do {x <- token (sat isDigit); return (ord x - ord '0')}
factor = digit +++ do {symb "("; n <- expr; symbol ")"; return n}
term = factor `chainl1` mulop
expr = term `chainl1` addop
C++ version parse_expr
const expr;
Id n;
auto const factor =
digit
do_(
symb | "("s,
n <= expr,
symb | ")"s,
return_ | n
);
auto const term = factor mulOp;
TEParser const expr = toTEParser || (term addOp);">Id<char> x;
auto const digit = do_(
x <= (token || sat | isDigit),
return_ | (x - '0')
);
extern TEParser<int> const expr;
Id<int> n;
auto const factor =
digit
do_(
symb | "("s,
n <= expr,
symb | ")"s,
return_ | n
);
auto const term = factor mulOp;
TEParser<int> const expr = toTEParser || (term addOp);
auto const digit = do_(
x <= (token || sat | isDigit),
return_ | (x - '0')
);
extern TEParser<int> const expr;
Id<int> n;
auto const factor =
digit
do_(
symb | "("s,
n <= expr,
symb | ")"s,
return_ | n
);
auto const term = factor
TEParser<int> const expr = toTEParser || (term
Sample 7 for STM / concurrent
Transfer from one account to another one atomically.
Id from, to;
Id v1, v2;
auto io_ = do_(
from <= (newTVarIO | Integer{200}),
to <= (newTVarIO | Integer{100}),
transfer | from | to | 50,
v1 <= (showAccount | from),
v2 <= (showAccount | to),
hassert | (v1 == 150) | "v1 should be 150",
hassert | (v2 == 150) | "v2 should be 150"
);
io_.run();
Id
auto io_ = do_(
from <= (newTVarIO | Integer{200}),
to <= (newTVarIO | Integer{100}),
transfer | from | to | 50,
v1 <= (showAccount | from),
v2 <= (showAccount | to),
hassert | (v1 == 150) | "v1 should be 150",
hassert | (v2 == 150) | "v2 should be 150"
);
io_.run();
Withdraw from an account but waiting for sufficient money.
Id acc;
auto io_ = do_(
acc <= (newTVarIO | Integer{100}),
forkIO | (delayDeposit | acc | 1),
putStr | "Trying to withdraw money...\n",
atomically | (limitedWithdrawSTM | acc | 101),
putStr | "Successful withdrawal!\n"
);
io_.run();
auto io_ = do_(
acc <= (newTVarIO | Integer{100}),
forkIO | (delayDeposit | acc | 1),
putStr | "Trying to withdraw money...\n",
atomically | (limitedWithdrawSTM | acc | 101),
putStr | "Successful withdrawal!\n"
);
io_.run();
And we can also compose two STMs with orElse
// (limitedWithdraw2 acc1 acc2 amt) withdraws amt from acc1,
// if acc1 has enough money, otherwise from acc2.
// If neither has enough, it retries.
constexpr auto limitedWithdraw2 = toFunc<> | [](Account acc1, Account acc2, Integer amt)
{
return orElse | (limitedWithdrawSTM | acc1 | amt) | (limitedWithdrawSTM | acc2 | amt);
};
Id acc1, acc2;
auto io_ = do_(
acc1 <= (atomically | (newTVar | Integer{100})),
acc2 <= (atomically | (newTVar | Integer{100})),
showAcc | "Left pocket" | acc1,
showAcc | "Right pocket" | acc2,
forkIO | (delayDeposit | acc2 | 1),
print | "Withdrawing $101 from either pocket...",
atomically | (limitedWithdraw2 | acc1 | acc2 | Integer{101}),
print | "Successful withdrawal!",
showAcc | "Left pocket" | acc1,
showAcc | "Right pocket" | acc2
);
io_.run();
// if acc1 has enough money, otherwise from acc2.
// If neither has enough, it retries.
constexpr auto limitedWithdraw2 = toFunc<> | [](Account acc1, Account acc2, Integer amt)
{
return orElse | (limitedWithdrawSTM | acc1 | amt) | (limitedWithdrawSTM | acc2 | amt);
};
Id
auto io_ = do_(
acc1 <= (atomically | (newTVar | Integer{100})),
acc2 <= (atomically | (newTVar | Integer{100})),
showAcc | "Left pocket" | acc1,
showAcc | "Right pocket" | acc2,
forkIO | (delayDeposit | acc2 | 1),
print | "Withdrawing $101 from either pocket...",
atomically | (limitedWithdraw2 | acc1 | acc2 | Integer{101}),
print | "Successful withdrawal!",
showAcc | "Left pocket" | acc1,
showAcc | "Right pocket" | acc2
);
io_.run();
Sample 8 for coroutine
|| putStrLn | ("Hello, " + name),
color <= (yield | "What's your favorite color? "),
lift || putStrLn | ("I like " + color + ", too.")
);
auto const foreverKResult = foreverK | [](std::string str) -> Producing
{
return do_(
lift || putStrLn | str,
(lift | getLine) >>= yield
);
};
// coroutine for handling io
auto const stdOutIn = toConsumingPtr_ || foreverKResult;
// let the two coroutines hand over control to each other by turn.
auto io_ = example1 stdOutIn;
io_.run();
">using O = std::string;
using I = std::string;
// coroutine for handling strings
Id name, color;
auto const example1 = do_(
name <= (yield | "What's your name? "),
lift || putStrLn | ("Hello, " + name),
color <= (yield | "What's your favorite color? "),
lift || putStrLn | ("I like " + color + ", too.")
);
auto const foreverKResult = foreverK | [](std::string str) -> Producing
{
return do_(
lift || putStrLn | str,
(lift | getLine) >>= yield
);
};
// coroutine for handling io
auto const stdOutIn = toConsumingPtr_ || foreverKResult;
// let the two coroutines hand over control to each other by turn.
auto io_ = example1 stdOutIn;
io_.run();
using I = std::string;
// coroutine for handling strings
Id
auto const example1 = do_(
name <= (yield
lift
color <= (yield
lift
);
auto const foreverKResult = foreverK | [](std::string str) -> Producing
{
return do_(
lift
(lift
);
};
// coroutine for handling io
auto const stdOutIn = toConsumingPtr_
// let the two coroutines hand over control to each other by turn.
auto io_ = example1
io_.run();
The sample running would be like
> What's your name?
< Bob
> Hello, Bob
> What's your favorite color?
< Red
> I like Red, too.