Haskell-Features in C++

gistfile1.cpp

//============================================================================
// Name        : FunctionalCPP.cpp
// Author      : 
// Version     :
// Copyright   : Your copyright notice
// Description : Hello World in C++, Ansi-style
//============================================================================
#include <functional>
#include <iostream>
#include <string>
#include <sstream>
#include <vector>
#include <utility>

////////////////////////// LEAST FIX POINT ////////////////////////////////////

template<typename A, typename B>
std::function<B(A)> fix(std::function<B(std::function<B(A)>, A)> f) {
	return [f](A x) { return f(fix(f), x); };
}

long factabs(std::function<long(long)> fact, long n) {
	if(n < 0) {
		return 0;
	} else if(n == 0) {
		return 1;
	} else {
		return n * fact(n-1);
	}
}
////////////////////////// CURRYING ///////////////////////////////////////////

template<typename R,typename... Args>
class C;

template<typename R>
class C<R>
{
public:
	typedef R Ret;
	static Ret curry(std::function<R()> func)
	{
		return func();
	}
};

template<typename R, typename H, typename... T>
class C<R, H,T...>
{
public:
	typedef std::function<typename C<R,T...>::Ret(H)> Ret;

	static Ret curry(std::function<R(H,T...)> func)
	{
		return [func](H x)
		{
			std::function<R(T...)> lambda = [func,x](T... args) { return func(x, args...); };
			return C<R,T...>::curry(lambda);
		};
	}
};

/////////////////////////// MAYBE DATA TYPE ///////////////////////////////////////

typedef enum { Nothing, Just } MaybeTag;
template<typename A>
struct Maybe
{
	MaybeTag tag;
	union {
		char nothing[0];
		A just;
	} con;
};

/////////////////////////// TYPECLASSES ///////////////////////////////////////

// Haskell: class Show a where ...
// CPP:
template<typename A>
class Show;

// Haskell: instance Show Int where ...
// CPP:
template<>
class Show<int>
{
public:
	static std::string show(int x) {
		std::stringstream str;
		str << x;
		return str.str();
	}
};

template<class A>
class Show<Maybe<A>>
{
public:
	static std::string show(Maybe<A> m) {
		if(m.tag == Nothing) {
			return "Nothing";
		} else {
			return "Just " + Show<A>::show(m.con.just);
		}
	}
};

template<template<typename> class M>
class Monad;

template<>
class Monad<Maybe>
{
public:
	template<typename A>
	static Maybe<A> pure(A x) {
		Maybe<A> m;
		m.tag = Just;
		m.con.just = x;
		return m;
	}

	template<typename A, typename B>
	static std::function<Maybe<B>(std::function<Maybe<B>(A)>)> bind(Maybe<A> x) {
		return [x](std::function<Maybe<B>(A)> f) {
			if(x.tag == Nothing) {
				Maybe<A> m;
				m.tag = Nothing;
				return m;
			} else {
				return f(x.con.just);
			}
		};
	}
};


/////////////////////////// USAGE ///////////////////////////////////////

// Haskell: print :: Show a => a -> IO ()
// CPP:
template<typename A>
void print(A x) {
	std::cout << Show<A>::show(x) << std::endl;
}

template<template<typename> class M, class A, class B>
std::function<M<B>(M<A>)> liftM(std::function<B(A)> f) {
	return [f](M<A> m) {
		return Monad<M>::template bind<A,B>(m)([f](A x) {
			return Monad<M>::template pure(f(x));
		});
	};
}

Maybe<int> divide(int a, int b) {
	Maybe<int> m;
	if(b == 0) {
		m.tag = Nothing;
	} else {
		m.tag = Just;
		m.con.just = a / b;
	}
	return m;
}


int main()
{
	// Haskell: add a b = a + b
	auto add    = C<int,int,int>::curry([](int a, int b) { return a + b; });

	// currying
	// Haskell: addOne = add 1
	auto addOne = add (1);

	auto maybeAddOne = liftM<Maybe,int,int>(addOne);
	// typeclasses
	// Haskell: print (addOne 41)
	print (addOne (41) );

	print (maybeAddOne(divide(10, 2)));

	std::function<long(long)> fact = fix<long,long>(factabs);
	std::cout << "5! = " << fact(5) << std::endl;
	return 0;
}