%//
%// This example is computing the (infinite) list of all prime numbers. 
%// Each number is tested to be prime by trying it to divide by
%// other primes from this infinite list in a lazy manner. The arithmetics
%// is implemented upon numbers in peano representation (zero, suc).
%// 
%{
#include<stdio.h>
#include<malloc.h>
#include<assert.h>


#define TRUE    0
#define FALSE   1
#define ZERO 	2
#define SUC 	3
#define NIL		4
#define CONS	5
#define ILIST	6
#define ISPRIME	7
#define PFILTER	8

static char * fsnames[] = {
	"true", "false", "zero", "suc", "nil", 
	"cons", "ilist", "isprime", "pfilter"
};

struct term {
  int fs;
  int arity;
  struct term **subt;
};

struct term s_zero = {ZERO, 0, NULL};
struct term *zero = &s_zero;

struct term s_nil = {NIL, 0, NULL};
struct term *nil = &s_nil;

struct term s_true = {TRUE, 0, NULL};
struct term *true = &s_true;

struct term s_false = {FALSE, 0, NULL};
struct term *false = &s_false;

struct term *allocUnary(int fs, struct term *x) {
	struct term *res;
	res = malloc(sizeof(struct term));
	res->fs = fs;
	res->arity = 1;
	res->subt = malloc(sizeof(struct term *));
	res->subt[0] = x;
	return(res);
}

struct term *allocBinary(int fs, struct term *x,struct term *y) {
	struct term *res;
	res = malloc(sizeof(struct term));
	res->fs = fs;
	res->arity = 2;
	res->subt = malloc(2*sizeof(struct term *));
	res->subt[0] = x;
	res->subt[1] = y;
	return(res);
}

struct term *suc(struct term *x) {
	return(allocUnary(SUC, x));
}

struct term *Ilist(struct term *x) {
	return(allocUnary(ILIST, x));
}

struct term *cons(struct term *x, struct term *y) {
	return(allocBinary(CONS, x, y));
}

struct term *Isprime(struct term *x, struct term *y) {
	return(allocBinary(ISPRIME, x, y));
}

struct term *Pfilter(struct term *x, struct term *y) {
	return(allocBinary(PFILTER, x, y));
}

struct term *lazynf(struct term *t);

%}

%GET_FUN_SYM<struct term *>(xx) (xx->fs)
%GET_SUBTERM<struct term *>(xx,n) (xx->subt[n])

%// left-most innermost evaluated functions
%sym struct term *plus(struct term *, struct term *)
%sym struct term *minus(struct term *, struct term *)
%sym struct term *mul(struct term *, struct term *)
%sym struct term *mod(struct term *, struct term *)
%sym int less(struct term *, struct term *)
%sym struct term *append(struct term *, struct term *)
%sym struct term *primes

%// lazy evaluated symbols and constructors (with symbol codes)
%sym struct term *zero                                  % ZERO
%sym struct term *suc(struct term *)                    % SUC
%sym struct term *nil                                   % NIL   
%sym struct term *cons(struct term *, struct term *)    % CONS
%sym struct term *ilist(struct term *)                  % ILIST
%sym struct term *isprime(struct term *, struct term *) % ISPRIME
%sym struct term *pfilter(struct term *, struct term *) % PFILTER

%// variables
%var struct term *x, *y, *z, *i, *j, *n, *p;

%// leftmost innermost functions
%rule plus(x, zero)         %--> return(x);
%rule plus(x, suc(y))       %--> return(suc(plus(x,y)));

%rule minus(x, zero)        %--> return(x);
%rule minus(suc(x), suc(y)) %--> return(minus(x,y));
%rule minus(x,y)            %--> assert(0);

%rule less(zero, zero)      %--> return(0);
%rule less(suc(x), zero)    %--> return(0);
%rule less(zero, x)         %--> return(1);
%rule less(suc(x),suc(y))   %--> return(less(x,y));

%rule mul(x, zero)          %--> return(zero);
%rule mul(x,suc(zero))      %--> return(x);
%rule mul(x,suc(suc(y)))    %--> return(plus(x, mul(x,suc(y))));

%rule mod(x,y)              %--> if (less(x,y)) return(x);
%rule mod(x,y)              %--> return(mod(minus(x,y),y));

%rule append(nil,x)         %--> return(x);
%rule append(cons(x,y),z)   %--> return(cons(x,append(y,z)));

%//lazy functions

%rule ilist(n)              %--> return(cons(n, Ilist(suc(n))));

%rule isprime(i,nil)        %--> return(true);
%rule isprime(i,cons(j,x))  %--> if (less(i,mul(j,j))) return(true);
%rule isprime(i,cons(j,x))  %--> if (mod(i,j)==zero) return(0);
%rule isprime(i,cons(j,x))  %--> return(Isprime(i,x));
%rule isprime(x,y)          %--> return(NULL);

%rule pfilter(cons(i,x),p)  %-->    if (lazynf(Isprime(i,p))==true) {
                                        return(cons(i,Pfilter(x,
                                        append(p,cons(i,nil))
                                        )));
                                    } else {
                                        return(Pfilter(x,p));
                                    }
%rule pfilter(x,y)          %--> return(NULL);

%// the main starting symbol

%rule primes                %--> return(Pfilter(Ilist(suc(suc(zero))),nil));

%MAIN<struct term *>topReduction

%%

void printTerm(struct term *tt) {
	int i;
	//printf("%d", tt->fs);fflush(stdout);
	printf("%s", fsnames[tt->fs]);fflush(stdout);
	if (tt->arity!=0) {
		printf("(");fflush(stdout);
		for(i=0; i<tt->arity; i++) {
			printTerm(tt->subt[i]);
			if (i+1 != tt->arity) printf(",");fflush(stdout);
		}
		printf(")");fflush(stdout);
	}
}

struct term *lazystep(struct term *t) {
  int i;
  mtom_reduction_occured = 1;
  t = topReduction(t);
  for(i=0; mtom_reduction_occured==0 && i<t->arity; i++) {
    t->subt[i] = lazystep(t->subt[i]);
  }
  return(t);
}

struct term *lazynf(struct term *t) {
  do {
    while (t->fs == CONS) {
	  printTerm(t->subt[0]);
      printf("\n"); fflush(stdout);
      t = t->subt[1];
    }
    t=lazystep(t);
  } while (mtom_reduction_occured);
  return(t);
}


int main() {
	lazynf(primes());
	return(0);
}




Last modified: Mon Dec 11 17:30:13 MET 2000