Newsgroup: it.comp.lang.c++
Titolo: Un timido passo verso Scheme

Sono veramente stanco, quindi mi fermo qui e da domani ricomincio a
_lavorare_. Questo è l'ultimo dei miei post bizzarri :)
 >>>>>
/*
Non è difficile eliminare i num() in modo da supportare direttamente i 
valori numerici.
Si possono anche supportare i floating point.
Questo codice è stato scritto estemporaneamente quindi non è organizzato 
coerentemente
ed è molto eterogeneo ed inconsistente. Nel realizzarlo non ho 
intravisto limiti tecnici
che impediscano di andare oltre, ma io mi fermi qui.
*/
// Compilate, se volete, solo con VC8 (MSVC 2005).
// Scorrete il codice e leggete i commenti. E' più che sufficiente.
#include <iostream>
using namespace std;
// VC8
#define	ID(x)			x
#define	CAT(x,y)		ID(x)ID(y)
//#define	id__(x)			Identity< typename x >			/* riservato */
#define	strict(x)		Identity< typename x::res >
#define	val(x)			x::res
#define	define(x,...)	typedef __VA_ARGS__ x
#define	let(x,...)		typedef typename __VA_ARGS__ x
#define	cons(h,t)		Cons< Identity< typename h >, Identity < typename t > >
#define	car(l)			Car< typename l >
#define	cdr(l)			Cdr< typename l >
#define	cddr(l)			cdr(cdr(l))
#define	cdddr(l)		cddr(cdr(l))
#define	cadr(l)			car(cdr(l))
#define	caddr(l)		car(cddr(l))
#define	cadddr(l)		car(cdddr(l))
#define symbol(s)		struct s { typedef s res; };
#define eq(s1,s2)		IsEq< typename s1, typename s2 >::res
#define empty(l)		IsEq< typename l, nil >::res
#define	num(n)			Num< n >
#define	type(t)			Identity< typename t >
#define	_if(c,t,e)		If< typename c, typename t, typename e >
#define	not(c)			If< typename c, Num<0>, int >
#define is_even(x)		eq(mod(x,num(2)),num(0))
#define	ret(c)			typedef typename c::res res
#define	get1(p1,...)		p1
#define	get2(p1,p2,...)		p2
#define	get3(p1,p2,p3,...)	p3
#define	call0(f)			f<>
#define	call1(f,p1)			f< typename p1 >
#define	call2(f,p1,p2)		f< typename p1, typename p2 >
#define	call3(f,p1,p2,p3)	f< typename p1, typename p2, typename p3 >
// Dentro a defun? NON usare "define", ma "let"!
#define	defun0(name, ...)			\
template<class dummy = nil>			\
struct name							\
{									\
	__VA_ARGS__						\
}
#define	defun1(name, params, ...)		\
	template<class get1##params>		\
	struct name							\
	{ __VA_ARGS__ }
#define	defun2(name, params, ...)		\
	template<class get1##params,		\
			 class get2##params>		\
	struct name							\
	{ __VA_ARGS__ }
#define	defun3(name, params, ...)		\
	template<class get1##params,		\
			 class get2##params,		\
			 class get3##params>		\
	struct name							\
	{ __VA_ARGS__ }
symbol(nil);
template <int i>
struct Num
{
	static const int val = i;
	typedef typename Num<i> res;
};
template <class H, class T>
struct Cons
{
	typedef typename H::res Head;
	typedef typename T::res Tail;
	typedef typename Cons< typename H, typename T > res;
};
template <class L>
struct Car
{
	typedef typename L::res::Head res;
};
template <class L>
struct Cdr
{
	typedef typename L::res::Tail res;
};
template <class S1, class S2>
struct IsEq_helper
{
	typedef Num<0> res;
};
template <class S>
struct IsEq_helper<S, S>
{
	typedef Num<1> res;
};
template <class S1, class S2>
struct IsEq
{
	typedef typename IsEq_helper<typename S1::res,
								 typename S2::res
							>::res res;
};
template <class x>
struct Identity
{
	typedef typename x res;
};
template <class c, class t, class e>
struct If_helper
{
	typedef typename t::res res;
};
template <class t, class e>
struct If_helper<Num<0>, t, e>
{
	typedef typename e::res res;
};
template <class c, class t, class e>
struct If
{
	typedef typename If_helper<typename c::res,
							   typename t,
							   typename e
							>::res res;
};
// Perché non uso direttamente Num<>::val? Perché così in futuro potrò 
implementare
// l'overloading degli operatori :)
#define	make_bin_op(name, op)								\
	template <class x, class y>								\
	struct name##_helper;									\
															\
	template <int i, int j>									\
	struct name##_helper< Num<i>,Num<j> >					\
	{														\
		typedef Num< i op j > res;							\
	};														\
															\
	template <class x, class y, class z = nil>				\
	struct name												\
	{														\
		typedef typename name##_helper<						\
			typename x::res, typename y::res >::res res;	\
	}
make_bin_op(Add, +);
make_bin_op(Sub, -);
make_bin_op(Mul, *);
make_bin_op(Div, /);
make_bin_op(Mod, %);
make_bin_op(Shl, <<);
//make_bin_op(Shr, >>);			// TO_DO
make_bin_op(Or, |);
make_bin_op(And, &);
make_bin_op(LOr, ||);
make_bin_op(LAnd, &&);
make_bin_op(Equal, ==);
make_bin_op(Less, <);
//make_bin_op(Greater, >);		// TO_DO
make_bin_op(LessE, <=);
make_bin_op(GreaterE, >=);
#define add(x,y)		call2(Add,x,y)
#define sub(x,y)		call2(Sub,x,y)
#define mul(x,y)		call2(Mul,x,y)
#define div(x,y)		call2(Div,x,y)
#define mod(x,y)		call2(Mod,x,y)
#define less(x,y)		call2(Less,x,y)
defun0(func,
	ret(type(int));
);
defun2(Lazy_div,(x,y),
	ret(_if(y,
			div(x,y),
			x));
);
#define lazy_div(x,y)	call2(Lazy_div,x,y)
// Deve trovarsi prima di FastCount (viene usato all'interno di FastCount).
#define fast_count(x)	call1(FastCount,x)
defun1(FastCount, (x),
	// E' tutto lazy! I let che non servono vengono ignorati!!!
	let(half, div(x,num(2)));
     let(minus1, sub(x,num(1)));
	defun0(fc_even,
		let(tmp, fast_count(half));
		ret(add(tmp,tmp));
	);
	defun0(fc_odd,
		let(tmp, fast_count(minus1));
		ret(add(tmp,num(1)));
	);
	ret(_if(less(x,num(2)),		// x < 2
			x,
			_if(is_even(x),
				call0(fc_even),
				call0(fc_odd))));
);
// Deve trovarsi prima di FastCount2 (viene usato all'interno di 
FastCount2).
#define fast_count2(x)	call1(FastCount2,x)
defun1(FastCount2, (x),
	// E' tutto lazy! I let che non servono vengono ignorati!!!
	// Neanche Scheme arriva a tanto!!!
	// Provate FastCountEven!!!
	let(half, div(x,num(2)));
     let(minus1, sub(x,num(1)));
	let(tmp_even, fast_count2(half));
	let(tmp_odd, fast_count2(minus1));
	ret(_if(less(x,num(2)),		// x < 2
			x,
			_if(is_even(x),
				add(tmp_even,tmp_even),
				add(tmp_odd,num(1)))));
);
// Deve trovarsi prima di FastCountEven (viene usato all'interno di 
FastCountEven).
#define fast_count_pow2(x)	call1(FastCountPow2,x)
defun1(FastCountPow2, (x),
	// E' tutto lazy! I let che non servono vengono ignorati!!!
	// Neanche Scheme arriva a tanto!!!
	// Se x non è una potenza di due, prima o poi verrà valutato x/0 e boom!
	// Se non fosse *completamente* lazy, salterebbe con qualsiasi x!
	let(half, div(x,num(2)));
	let(minus1, div(x,num(0)));		// BOOM! You divided by 0 and you aren't 
God (no black-holes for you).
	let(tmp_even, fast_count_pow2(half));
	let(tmp_odd, fast_count_pow2(minus1));
	ret(_if(less(x,num(2)),		// x < 2
			x,
			_if(is_even(x),
				add(tmp_even,tmp_even),
				add(tmp_odd,num(1)))));
);
#define slow_count(x)		call1(SlowCount,x)
// In Scheme sarebbe stata lenta, ma qui è veloce perché il C++ calcola 
slow_count(sub(x,num(1))) una sola
// volta. In caso contrario, i passi sarebbero 3^n.
defun1(SlowCount,(x),
	ret(_if(eq(x,num(0)),	// x == 0
			add(x,num(1)),
			add(add(slow_count(sub(x,num(1))),
					slow_count(sub(x,num(1)))),
				slow_count(sub(x,num(1))))));
);
// Nella seguente funzione però le cose vanno diversamente (vanno come 
in Scheme).
// Le due chiamate a fib si sovrappongono in quanto fib( sub(x,num(1)) ) 
ricalcola
// fib( sub(x,num(2)) ) al suo interno. Il numero di passi è esponenziale.
// Avevo pensato di risolvere questo "problema", ma il costo è troppo 
grande.
// La versione efficiente (anche in Scheme) è fast_fib.
#define fib(x)				call1(Fibonacci,x)
defun1(Fibonacci,(x),
	ret(_if(less(x,num(2)),		// x in {0,1}
			x,
			add(fib( sub(x,num(2)) ),
				fib( sub(x,num(1)) ))));
);
// Versione "iterativa".
// In Scheme è veramente iterativa poiché ottimizza la tail-recursion. 
Ad ogni modo
// il numero di passi è O(x).
#define fast_fib(x)			call1(FastFib,x)
defun1(FastFib,(x),
	defun3(ff_iter, (x,y,count),
		ret(_if(count,
				call3(ff_iter, add(x,y), x, sub(count,num(1))),
				y));
	);
	ret(call3( ff_iter, num(1), num(0), x ));
);
#define bind1(func,p)			Bind1< func,p >::f
#define bind2(func,p)			Bind2< func,p >::f
#define bind3(func,p)			Bind3< func,p >::f
#define bind12(func,p,q)		bind1(bind2(func,q),p)
#define bind13(func,p,q)		bind1(bind3(func,q),p)
#define bind23(func,p,q)		bind2(bind3(func,q),p)
template <template <class, class, class> class F, class P1>
struct Bind1
{
	template <class P2 = nil, class P3 = nil>
	struct f : F<P1,P2,P3>
	{};
};
template <template <class, class, class> class F, class P2>
struct Bind2
{
	template <class P1 = nil, class P3 = nil>
	struct f : F<P1,P2,P3>
	{};
};
template <template <class, class, class> class F, class P3>
struct Bind3
{
	template <class P1 = nil, class P2 = nil>
	struct f : F<P1,P2,P3>
	{};
};
int main()
{
	// Usare un debugger per vedere i tipi.
	define(list, cons(int, cons( div(num(5),num(0)) , 
cons(num(3),nil))));		// 5/0
	val(caddr(list)) a;
	// Se non si accede al secondo elemento, non viene segnalato alcun errore!
	// TO_DO: Scrivere list1, list2, list3, ... (in un'altra vita).
	define(type, cadr(list));
	type b;
	// Notare, anche qui, la laziness.
	// Notare come tutto il sistema è lazy, non solo l'espressione più 
esterna chiamata da _if.
	// Non è cioè _if a imporre la laziness; quest'ultima funzione ne trae 
solo giovamento.
	val(_if(num(0),
			mul(div(num(1),num(0)),num(5)),		// 1/0
			num(2))) asdf;
	int val = asdf.val;
	define(list2, cons(num(0), cons(num(1), nil)));
	val(_if(empty(cddr(list2)),
			type(int),
			type(double))) vediamo = 10;	// ok, è int
	// Proviamo func.
	val(call0(func)) int_type = 1;			// int_type =
	val(lazy_div(num(12),num(0))) ris1;		// num(12)
	val(lazy_div(num(12),num(3))) ris2;		// num(4)
	// Adesso qualcosa di serio.
	val(fast_count(num(100000000))) ris3;
	val(fast_count2(num(100000000))) ris4;
	val(fast_count_pow2(num(1024))) ris5;	// chiamare solo con x = 2^n
	val(slow_count(num(50))) ris6;
	val(fib(num(10))) ris7;
	val(fast_fib(num(15))) ris8;
	val(call1(bind1(Mul,num(2)),num(5))) ris9;		// ok, da 10
	// Basta, sono stanco, lambda() la farò in un'altra vita...
}
<<<<<
Kiuhnm

 _lavorare_. Questo è l'ultimo dei miei post bizzarri :)
Sei a conoscenza di questo:
http://www.prakinf.tu-ilmenau.de/~czarn/meta/metalisp.cpp
Il libro a cui si riferisce, che per altro non contiene MetaLisp, e':
http://www.generative-programming.org/
Ciao,
Nicola

 
http://www.generative-programming.org/
Chi non lo conosce?
Kiuhnm

 _lavorare_. Questo è l'ultimo dei miei post bizzarri :)
Giusto una curiosità, visto il subject.
Hai letto/conosci il SICP?
http://mitpress.mit.edu/sicp/

 
http://mitpress.mit.edu/sicp/
E' lì che sto studiando Scheme.
Kiuhnm