// tcK - 2 stacks, no recursion, symbols are quotations

/ verbs

k:,/+{.:'(x,":";x)}'j:"~!@#$%^&*_-+=|:<,>.?"					/ F1,F2 = (~:;!:;..;~;!;..)
v:-&0 20 20									/ valences
n:{[n;f]{f[(-n)_ x;y].(-n)#x}}							/ n-ary application

/ stack operators

pop:n[1]{[x;y;z](x;y)}								/      A ->
dup:n[1]{[x;y;a](x,(a;a);y)}							/      A -> A A
cons:n[2]{[x;y;a;b](x,,(,a),b;y)}						/ A [..] -> [A ..]
swap:n[2]{[x;y;a;b](x,(b;a);y)}							/    A B -> B A
pick:n[3]{[x;y;a;b;c](x,(a;b;c;a);y)}						/  A B C -> A B C A
rot:n[3]{[x;y;a;b;c](x,(b;c;a);y)}						/  A B C -> B C A
uncons:n[1]{[x;y;a](x,(*a;1_ a);y)}						/  [A | B] -> A B

/ combinators

i:n[1]{[x;y;p](x;p,y)}								/ [..] -> ..
dip:n[2]{[x;y;a;p](x;p,(,q a),y)}						/ X Y [P] -> X P Y 

linrec:n[4]{[x;y;i;t;e;f](x;i,(i;t;e;f;x;`linrec_),y)}				/ t if i else: e, "recurse", f
linrec_:n[6]{[x;y;b;i;t;e;f;s](s;:[b;t;e,(i;t;e;f;`linrec),f],y)}		/ "recursion"

cond:n[1]{:[1=#z;(x;(*z),y);(x;z[0;0],(z[0;1];1_ z;x;`cond_),y)]}		/ [.. [X Y] .. Z] -> Y if X else Z
cond_:n[4]{[x;y;b;t;e;s](s;:[b;t;(e;`cond)],y)}					/ "loop": t if b else (e;cond)

ifte:n[3]{[x;y;b;t;f](x;:[b;t;f],y)}						/ X B [T] [F] -> T if B else F

/ adverbs (k combinators)

over:n[2]{[x;y;a;p]if[~#a;'"length error"];(x;(*a;1_ a;p;`over_),y)}		/ X f2 -> f2/X
over_:n[3]{[x;y;r;a;p](x;:[#a;(r;*a),p,(1_ a;p;`over_);,r],y)}

converge:n[2]{[x;y;a;p](x;(a;a),p,`dup,p,(p;`converge_),y)}			/ X f1 -> f1/X
converge_:n[4]{[x;y;a;r;s;p](x;:[s _in(a;r);,s;(a;s;s),p,(p;`converge_)],y)}

right:n[3]{[x;y;a;b;p](x;(();a;b;p;`right_),y)}					/ X Y f2 -> X f2/:Y
right_:n[3]{[x;y;a;b;p](x;:[#b;(a;*b),p,(,:;,),(a;1_ b;p;`right_);()],y)} 

/ get/set

set:n[2]{[x;y;a;b].[*b;();:;d[a]];(x;y)}					/ val [`name] set => name:d[val]
get:n[1]{[x;y;b](x;(,b),y)}							/ [`name] get -> [val]

/ callcc (parameterized)

callcc:n[2]{[x;y;q;n](x,,(x;y;n;`callcc_);q,y)}					/ capture continuation
callcc_:n[3]{[x;y;X;Y;n](X,(-n)#x;Y)}						/ evaluate continuation

/ print, error

print:n[1]{[x;y;a]`0:($a),"\n";(x;y)}						/ print w/ newline
write:n[1]{[x;y;a]`0:$a;(x;y)}							/ print
error:n[1]{[x;y;a]'a;(x;y)}							/ error

/ apply

a:{:[~#y;(x;y);g@*y;f[x;*y;y];(x,,u@*y;1_ y)]}					/ apply if program-stack not empty
g:{:[7=t:4:x;1;~4=t;0;~(*$x)_in"{}()",j]}					/ function or function-name
f:{:[(#k)>i:k?y;((v[i]_ x),,y . v[i]#x;1_ z);y[x;1_ z]]}			/ apply k or tck program

/ quotation

q:{:[7=4:x;`$$x;x]}								/ quote
u:{:[4=4:x;.$x;x]}								/ unquote

/ eval

E:{*(a .)/(x;y)}								/ evaluate y on x
e:E[()]										/ evaluate y on ()

/ trace

T:{(a .)\(x;y)}									/ trace evaluation of y on x
t:T[()]										/ trace evaluation of y on ()

/ step

S:{while[~(X;Y)~t:A[x;y];x:X:t 0;y:Y:t 1;\X;\Y;if[#0:`;:_n]]}			/ step evaluation of y on x
s:S[()]										/ step evaluation of y on ()

/ define program P:d[(..)] (metalinguistic)

d:{(y;x,z)}									/ push x onto program-stack