# a.c -rw-r--r-- 5.0 KiB View raw 
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
long write(),read(),strlen();void*malloc(),*memchr(),*memcpy(),*strchr();void free();
#define A(c) ((s)memchr(a,c,na)?:a+na)-a

//-------------- a.h
typedef char*s,c;s Q=(s)128;
#define _(e...) ({e;})
#define x(a,e...) _(s x=a;e)
#define $(a,b) if(a)b;else
#define i(n,e) {int $n=n;int i=0;for(;i<$n;++i){e;}}

#define Q(e) if(Q==(e))return Q;
#define Qs(e,s) if(e)return err(__func__,s);
#define Qz(e) Qs(e,"nyi")
#define Qr(e) Qs(e,"rank")
#define Qd(e) Qs(e,"domain")

#define _s(f,e,x...) s f(x){return _(e);}
#define _i(f,e) _s(f,e,c x)
#define f(f,e)  _s(f,e,s x)
#define F(f,e)  _s(f,e,s a,s x)

#define ax (256>x)
#define ix (c)x
#define rx x[-2]
#define nx x[-1]
#define xi x[i]

#define aa x(a,ax)
#define ia x(a,ix)
#define na x(a,nx)

#define _a(e) r(e,_r(a))
#define _x(e) r(e,_r(x))
#define r(a,e) _(s r=a;e;r)
#define s(e) (s)(255&(e))

#define oo w("oo\n")
//------------- end of a.h

// malloc an (x+2)-byte buffer for an object
// 0th byte is reference count
// 1st byte is its length, which is x
_i(m,s a=malloc(2+x);*a++=0;*a++=x;a)

// deallocate object x
f(_m,free(x-2);0)

// increase reference count for vector
f(r_,ax?x:(++rx,x))

// decrease reference count for vector if it's not zero
// otherwise, deallocate the object
f(_r,ax?x:rx?(--rx,x):_m(x))

// write array x to fd 1
f(w,write(1,ax?&x:x,ax?1:strlen(x));x)

// write error in following format a:Ex
// return Q (the global error identifier)
F(err,w(a);w((s)58);w(x);w((s)10);Q)

// generate array of size n with expression e
#define n(n,e) r(m(n),i(n,r[i]=e))

// iota: when 0 > x ? [-x-1..0] : [0..x-1]
f(z,Qr(!ax)0>ix?n(-ix,-ix-1-i):n(ix,i))

// formatted output
c b[6]="???? ";
// format the absolute value of x to global buffer b
// then output the result with `-` appended if x < 0
_i(wi,c n=0>x;x=n?-x:x;s s=b+4;do*--s=48+x%10;while(x/=10);w(n?(*--s='-',s):s))

// write out an array followed by a linefeed
f(W,Q(x)$(ax,wi(ix))i(nx,wi(xi))w((s)10);x)

// nyi functions
f(qz,Qz(1)x)
f(srt,Qz(1)x)
f(uni,Qz(1)x)
F(Cut,Qz(1)x)
F(Drp,Qz(1)x)

// if a is atom, it's a, otherwise it's a vector of the same length of x, generated by v
#define g(a,v) ax?s(a):_x(n(nx,v))

// not
f(not,g(!ix,!xi))

// negate
f(sub,g(-ix,-xi))

// indexing the vector a with x
F(At,Qr(aa)_a(g(a[ix],a[xi])))

// index of x in the vector a
F(_A,Qr(aa)_a(g(A(ix),A(xi))))

// vector x in Z_a
F(Z,Qr(!aa)Qd(1>ia)g(ix%ia,xi%ia))

// define a function f to do operation o between array a and array x.
// It broadcasts the atom when one of a or x is an atom and the other one is a vector
// It dispatches (vector, atom) to (atom, vector) so Ltn need special care (a<x <-> -x<-a)
#define G(f,o) F(f,ax?aa?s(ia o ix):Ltn==f?f(sub(x),sub(a)):f(x,a):_a(_x(n(nx,(aa?ia:a[i])o xi))))
/*
F(f,
		ax?
			aa? s(ia o ix)                     # (atom, atom)
				: Ltn==f? f(sub(x),sub(a))       # (vector, atom)
				        : f(x,a)
			: _a(_x(n(nx,(aa?ia                # (atom, vector)
			                :a[i])o xi))))     # (vector, vector)
*/

G(Ltn,<)G(Eql,==)G(Not,!=)G(Sum,+)G(Prd,*)G(And,&)G(Or,|)

// An vector contains the 0th item in array x
f(cat,Qr(!ax)n(1,ix))

// Concatenate array a with array x
// It copies x first as it needs access to na which could be deallocate after _a decreased the ref count
F(Cat,a=aa?cat(a):a;x=ax?cat(x):x;s r=m(na+nx);_x(memcpy(r+na,x,nx));_a(memcpy(r,a,na)))

// head: the first item in array x
f(at,At(x,0))

// reverse: indexing vector x with [nx-1,nx-2..1,0]
f(rev,Qr(ax)At(x,z(s(-nx))))

// length: length of vector x
f(cnt,Qr(ax)_x(s(nx)))

// take: take the first a items from vector x
F(Tak,Qr(!aa||ax)Qd(0>ia||ia>nx)At(x,z(a)))

// subtraction: subtract array x from array a
F(Sub,Sum(a,sub(x)))

// more than: array a > array x
F(Mtn,Ltn(x,a))

// e is the ith char in symbol vector V
#define v(e) (((s)strchr(V,e)?:V)-V)
// U stores global variables. It supports up to 26 variables
s U[26],V=" +-*&|<>=~!@?#_^,",

// monadic functions and dyadic functions
//          +   -   *   &  |   <   >   =   ~   ! @  ?   #   _   ^   ,
(*f[])()={0,qz ,sub,qz ,qz,rev,qz ,qz, qz ,not,z,at,uni,cnt,qz ,srt,cat},
(*F[])()={0,Sum,Sub,Prd,And,Or,Ltn,Mtn,Eql,Not,Z,At,_A ,Tak,Drp,Cut,Cat};

// resolve a value
// 0~9: atoms
// a~z: global variables (stored in U)
// otherwise: zero
_i(u,10u>x-48?x-48:26u>x-97?r_(U[x-97]):0)

// evaluate expression
f(e,s z=x;c i=*z++;!*z?u(i):v(i)?x(e(z),Q(x)f[v(i)](x)):x(e(z+1),Q(x)58==*z?U[i-97]=r_(x):_(c f=v(*z);Qd(!f)F[f](u(i),x))))
/* x is ".................................."
 *       iz
f(e,s z=x;      // z is the expr
    c i=*z++;   // first char in expr
		!*z?u(i)    // expr has length 1 <-> it consists of a single value
		   :v(i)?x(e(z),Q(x)f[v(i)](x))                   // expr starts with a monadic function
			      :x(e(z+1),Q(x)58==*z?U[i-97]=r_(x)        //             with a dyadic function, is assignment
						                    :_(c f=v(*z);Qd(!f)F[f](u(i),x))))   //                         not assignment
*/

/* valid expressions
 * u
 * fe
 * u:e
 * uFe
 */

// the interpreter
// it does not output for assignment
int main(){c b[99];while(1)if(w((s)32),b[read(0,b,99)-1]=0,*b)58==b[1]?e(b):W(e(b));}