-
-
Save ap29600/64ccb7ba7d976742f1df827033d3a75a to your computer and use it in GitHub Desktop.
a small k-like calculator in Whitney C
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#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