All pastes #891750 Raw Edit

Original J source code, commente

public c v1 · immutable
#891750 ·published 2008-02-04 21:48 UTC
rendered paste body
  typedef char C;typedef long I;   typedef struct a{I t,r,d[3],p[2];}*A;  // array: boxed? rank dims contents  #define P printf  #define R return  #define V1(f) A f(w)A w;  // monadic op  #define V2(f) A f(a,w)A a,w;  // dyadic op  #define DO(n,x) {I i=0,_n=(n);for(;i<_n;++i){x;}}   I *ma(n){R(I*)malloc(n*4);}mv(d,s,n)I *d,*s;{DO(n,d[i]=s[i]);}  // alloc, move  tr(r,d)I *d;{I z=1;DO(r,z=z*d[i]);R z;}  // product of array  A ga(t,r,d)I *d;{A z=(A)ma(5+tr(r,d));z->t=t,z->r=r,mv(z->d,d,r);R z;}  // alloc array: type, rank, dims  V1(iota){I n=*w->p;A z=ga(0,1,&n);DO(n,z->p[i]=i);R z;}  // fill: 0,1,2,3,4,...  V2(plus){I r=w->r,*d=w->d,n=tr(r,d);A z=ga(0,r,d);  // new RHS  DO(n,z->p[i]=a->p[i]+w->p[i]);R z;}  // z = a + w (vector add)  V2(from){I r=w->r-1,*d=w->d+1,n=tr(r,d);  // lose first dimension  A z=ga(w->t,r,d);mv(z->p,w->p+(n**a->p),n);R z;}  // result = RHS[LHS]  V1(box){A z=ga(1,0,0);*z->p=(I)w;R z;}  // box an array  V2(cat){I an=tr(a->r,a->d),wn=tr(w->r,w->d),n=an+wn;  // find sizes  A z=ga(w->t,1,&n);mv(z->p,a->p,an);mv(z->p+an,w->p,wn);R z;}  // concatenate  V2(find){}  // ?!  V2(rsh){I r=a->r?*a->d:1,n=tr(r,a->p),wn=tr(w->r,w->d);  // r = len(a) or 1, n = prod(a), wn = size(w)  A z=ga(w->t,r,a->p);mv(z->p,w->p,wn=n>wn?wn:n);  // w with shape of a  if(n-=wn)mv(z->p+wn,z->p,n);R z;}  // "overlapping move" to fill rest  V1(sha){A z=ga(0,1,&w->r);mv(z->p,w->d,w->r);R z;}  // get shape  V1(id){R w;}V1(size){A z=ga(0,0,0);*z->p=w->r?*w->d:1;R z;}  // identity, first dim  pi(i){P("%d ",i);}nl(){P("\n");}  // print int, newline  pr(w)A w;{I r=w->r,*d=w->d,n=tr(r,d);DO(r,pi(d[i]));nl();  // print dimensions  if(w->t)DO(n,P("< ");pr(w->p[i]))else DO(n,pi(w->p[i]));nl();}  // print contents  C vt[]="+{~<#,";  // operators  A(*vd[])()={0,plus,from,find,0,rsh,cat},  // diadic meanings  (*vm[])()={0,id,size,iota,box,sha,0};  // monadic meanings  I st[26]; qp(a){R a>='a'&&a<='z';}qv(a){R a<'a';}  // vars, isVar, isOp  A ex(e)I *e;{I a=*e;  // exec list  if(qp(a)){if(e[1]=='=')R st[a-'a']=ex(e+2);a= st[ a-'a'];}  // handle var  R qv(a)?(*vm[a])(ex(e+1)):e[1]?(*vd[e[1]])(a,ex(e+2)):(A)a;}  // monadic op, dyadic op, itself  noun(c){A z;if(c<'0'||c>'9')R 0;z=ga(0,0,0);*z->p=c-'0';R z;}  // 1-digit num  verb(c){I i=0;for(;vt[i];)if(vt[i++]==c)R i;R 0;}  // verb lookup  I *wd(s)C *s;{I a,n=strlen(s),*e=ma(n+1);C c;  // to compile: make room...  DO(n,e[i]=(a=noun(c=s[i]))?a:(a=verb(c))?a:c);e[n]=0;R e;}  // compile each char  main(){C s[99];while(gets(s))pr(ex(wd(s)));}  // REPL// compiled form: array of tokens, \0...=op index, a-z=var, else=0-dim array