Skip to content

Instantly share code, notes, and snippets.

@ap29600
Last active September 26, 2024 09:52
Show Gist options
  • Save ap29600/64ccb7ba7d976742f1df827033d3a75a to your computer and use it in GitHub Desktop.
Save ap29600/64ccb7ba7d976742f1df827033d3a75a to your computer and use it in GitHub Desktop.
a small k-like calculator in Whitney C
#include<stdio.h>
#include<stdlib.h>
#include<string.h>
#include<ctype.h>
#include<math.h>
typedef char c; typedef size_t s; typedef double f; typedef struct A{f s; struct A*r;}A; static const A y={0},r={0};
#define D(f) A f(A x,A y)
#define M(f) A f(A x)
#define i(...) for(s i=0;i<n;++i){__VA_ARGS__;}
#define j(...) for(s j=0;j<m;++j){__VA_ARGS__;}
#define a(n) (A){n,(A*)calloc((n)+1,sizeof(A))+1}
A in(A x){if(x.r){x.r[-1].s++;} return x;}
A de(A x){if(x.r&&!x.r[-1].s--){s n=x.s;i(de(x.r[i]));free(&x.r[-1]);}return x;}
#define req(c,...) if(!(c)){printf("\e[31m"__VA_ARGS__);puts("\e[0m");de(x);de(y);de(r);return (A){NAN,NULL};}
#define trim(s) while(isspace(*(s)))++(s);
#define Ds(me,op) f me##_(f x,f y){return op;} \
D(me){A r={0}; \
if(x.r&&y.r){req(x.s==y.s,"`"#me"`: expected equal shape prefix");s n=x.s;r=a(n);i(r.r[i]=me(in(x.r[i]),in(y.r[i])))} \
else if(x.r){s n=x.s;r=a(n);i(r.r[i]=me(in(x.r[i]),in(y)))} \
else if(y.r){s n=y.s;r=a(n);i(r.r[i]=me(in(x),in(y.r[i])))} \
else{r.s=me##_(x.s,y.s);} \
de(x);de(y); \
return r;}
Ds(add,x+y) Ds(sub,x-y) Ds(mul,x*y) Ds(over,x/y) Ds(min,x<=y?x:y) Ds(max,x>=y?x:y) Ds(less,x<y) Ds(greater,x>y) Ds(power,pow(x,y))
M(solo){A r=a(1);r.r[0]=x;return r;}
M(iota){x=x.r?x:solo(x);s n=x.s,k=1;A r={0.0};
i(req(!x.r[i].r,"`iota`: expected scalar dimensions");s m=x.r[n-i-1].s;A y=a(m);j(y.r[j]=add((A){j*k},in(r)));de(r);k*=m;r=y);de(x);return r;}
#define Ms(me,op) f me##_(f x){return op;}M(me){A r={0};if(x.r){s n=x.s;r=a(n);i(r.r[i]=me(in(x.r[i])));}else{r.s=me##_(x.s);}de(x);return r;}
Ms(flr,floor(x)) Ms(cil,ceil(x)) Ms(neg,-x) Ms(recip,1/x) Ms(compl,1-x);
M(count){de(x);return (A){x.r?x.s:1};}
D(cat){x=x.r?x:solo(x);y=y.r?y:solo(y);s n=x.s,m=y.s;A r=a(n+m);i(r.r[i]=in(x.r[i]));j(r.r[n+j]=in(y.r[j]));de(x);de(y);return r;}
M(first){req(x.r,"`first`: expected non-empty array");A r=in(x.r[0]);de(x);return r;}
D(at){req(x.r,"`at`: expected array x");A r;if(y.r){r=a(y.s);s n=y.s;i(r.r[i]=at(in(x),in(y.r[i])))}else{if(y.s<0){y.s+=x.s;}req(y.s>=0&&x.s>y.s,"`at`: index out of bounds");r=in(x.r[(s)y.s]);};de(x);de(y);return(r);}
A v[256]={0}; M((*m[256]))={0}; D((*d[256]))={0};
A eval(c*l,c**e){A x={0};trim(l);
if(*l=='('){x=eval(l+1,&l);}else if(isdigit(*l)){x.s=strtod(l,&l);}else if(isalpha(*l)){x=in(v[*l++]);}else{req(0,"no operand");}
while(*l){
trim(l);if(!*l){break;}if(*l==':'){++l;trim(l);req(isalpha(*l),"`:%c`: binding should be alphabetic",*l);de(v[*l]);v[*l++]=in(x);continue;}
if (*l==')'){*e=++l;return x;}
c*ll=l+1;trim(ll);
if(*ll=='('){req(d[*l],"`%c`: unbound dyad",*l);x=d[*l](x,eval(ll+1,&ll));l=ll;}
else if(isalpha(*ll)){req(d[*l],"`%c`: unbound dyad",*l);x=d[*l](x,in(v[*ll++]));l=ll;}
else if(isdigit(*ll)){req(d[*l],"`%c`: unbound dyad",*l);x=d[*l](x,(A){strtod(ll,&ll),0});l=ll;}
else{req(m[*l],"`%c`: unbound monad",*l);x=m[*(l++)](x);}
};
*e=l;
return x;
}
s show(A x){if(!x.r){return printf("%g",x.s);}s n=x.s,r=2;printf("( ");i(r+=show(x.r[i]);putchar(' '));putchar(')');return r;}
int main(void){
{c mn[]="_^-%!~#,@"; M((*mf[]))={flr,cil,neg,recip,iota,compl,count,solo,first};s n=sizeof mn-1;i(m[mn[i]]=mf[i]);}
{c dn[]="+-*%^&|<>,@"; D((*df[]))={add,sub,mul,over,power,min,max,less,greater,cat,at};s n=sizeof dn-1;i(d[dn[i]]=df[i]);}
char l[1024],*e;while(putchar('\t'),fgets(l,sizeof l,stdin)){A x=eval(l,&e);show(x);de(x);putchar('\n');}
s n=256;i(de(v[i]));
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment