/* These files (monad0.cc, monad2.cc, and monad3.cc) implement monads using FC++. The monad examples are taken from the Wadler paper "Monads for Functional Programming" found at http://cm.bell-labs.com/cm/cs/who/wadler/topics/monads.html#marktoberdorf and the examples implement variations 0, 2, and 3 as described in sections 2.5-2.9 of the paper. */ #include #include #include "prelude.h" using std::cout; using std::endl; using std::pair; using std::string; using namespace fcpp; ////////////////////////////////////////////////////////////////////// // useful for variation 3 #if __GNUC__ == 2 # include template string toString( const T& x ) { std::ostrstream o; o << x << std::ends; return string(o.str()); } #else # include template string toString( const T& x ) { std::ostringstream oss; oss << x; return oss.str(); } #endif ////////////////////////////////////////////////////////////////////// class Term { int a_; // also a Ref t_, u_; enum { Con, Div } type; public: Term( int aa ) : a_(aa), type(Con) {} Term( Ref tt, Ref uu ) : t_(tt), u_(uu), type(Div) {} bool isCon() const { return type==Con; } int a() const { if( !isCon() ) throw "oops"; return a_; } Ref t() const { if( isCon() ) throw "oops"; return t_; } Ref u() const { if( isCon() ) throw "oops"; return u_; } string asString() const { if( isCon() ) return "(Con " + toString(a()) + ")"; else return "(Div " + t()->asString() + " " + u()->asString() + ")"; } }; Ref Con( int a ) { return Ref( new Term(a) ); } Ref Div( Ref t, Ref u ) { return Ref( new Term(t,u) ); } // useful for variation 3 string line( Ref t, int v ) { return t->asString() + " --> " + toString(v) + "\n"; } ////////////////////////////////////////////////////////////////////// // We have static methods (unit, star, etc.) instead of static vars // because g++ sucks. struct IdentityMonad { // We set up some handy typedefs so that // M::of::Type == M a // and // M::inv::Type == a // which enable us to "construct" and "deconstruct" the monad type. typedef IdentityMonad M; template struct of { typedef A Type; }; template struct inv { typedef Ma Type; }; struct Unit { template struct Sig : public FunType::Type> {}; template typename M::template of::Type operator()( const A& a ) const { return a; } }; static Unit unit() { return Unit(); } struct Star { // MM == M a // KK == a -> M b template struct StarHelp { typedef typename M::template inv::Type A; typedef typename M::template of::Type Tmp; // M a typedef typename KK::template Sig::ResultType K; // M b typedef typename M::template inv::Type B; typedef typename M::template of::Type R; // M b }; template struct Sig : public FunType::R> {}; template typename StarHelp::R operator()( const M& m, const K& k ) const { return k(m); } }; static Curryable2 star() { return makeCurryable2( Star() ); } }; ////////////////////////////////////////////////////////////////////// template struct Eval : CFunType,typename M::template of::Type> { // Lams are lambdas. Their constructors take any 'captured' // variables. struct Lam2 : public CFunType::Type> { int a; Lam2( int aa ) : a(aa) {} typename M::template of::Type operator()( int b ) const { return M::unit()( a/b ); } }; struct Lam1 : public CFunType::Type> { Ref u; Lam1( Ref uu ) : u(uu) {} typename M::template of::Type operator()( int a ) const { return M::star()( Eval()(u), Lam2(a) ); } }; typename M::template of::Type operator()( Ref term ) const { if( term->isCon() ) return M::unit()( term->a() ); else { Ref t = term->t(), u = term->u(); return M::star()( Eval()(t), Lam1(u) ); } } }; ////////////////////////////////////////////////////////////////////// Ref answer() { return Div( Div( Con(1972), Con(2) ), Con(23) ); } int main() { typedef IdentityMonad M; typedef Eval E; E e; M::of::Type r = e( answer() ); cout << r << endl; }