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

/ verbs

K:(,/+{.:'(x,":";x)}'K_:"~!@#$%^&*_-+=|:<,>.?";-&0 20 20)              / (F1,F2;V)

/ apply

A:{:[~#y;(x;y);F@*y;A_[x;*y;y];(x,,Q_@*y;1_ y)]}                       / apply if program-stack not empty
A_:{:[(#*K)>i:K[0]?y;((K[1;i]_ x),,y . K[1;i]#x;1_ z);y[x;1_ z]]}      / apply k or tck program
F:{:[7=t:4:x;1;~4=t;0;~(*$x)_in"{(",K_]}                               / function or function-name

/ quotation

Q:{:[7=4:x;`$$x;x]}                                                     / quote
Q_:{:[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 y on x
T:T_[()]                                                                / trace 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 y on x
S:S_[()]                                                                / step y on ()

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

D:{:[@y;x;(y;x,z)]}                                                     / x or push x onto program stack

/ define shuffle P:L[("xyz";(..))]

L:{(((-i)_ y),L_[(i:#*x)#y]. x;z)}                                      / (argument-template;result-template)
L_:{:[@z;z;_f[x;y]'@[z;i;:;x y?/:z i:&z _lin y]]}

/ word-formation

W:{[n;f]{f[(-n)_ x;y].(-n)#x}}                                          / word:W[n]{[x;y;..;v;..]..}

/ operators

pop:            W[1]{[x;y;z](x;y)}                                      /      A ->
dup:            W[1]{[x;y;a](x,(a;a);y)}                                /      A -> A A
swap:           W[2]{[x;y;a;b](x,(b;a);y)}                              /    A B -> B A
pick:           W[3]{[x;y;a;b;c](x,(a;b;c;a);y)}                        /  A B C -> A B C A
rot:            W[3]{[x;y;a;b;c](x,(b;c;a);y)}                          /  A B C -> B C A
nip:            W[2]{[x;y;a;b](x,,b;y)}                                 /    A B -> B
tuck:           W[2]{[x;y;a;b](x,(b;a;b);y)}                            /    A B -> B A B
jump:           W[2]{[x;y;a;b](x,(a;b;a);y)}                            /    A B -> A B A (over)

/ stack

stack:          {(,x;y)}                                                /   .. -> [..]
unstack:        W[1]{[x;y;a]((),a;y)}                                   / .. X -> X
clear:          {(();y)}                                                /   .. -> ()
z:              W[1]{[x;y;a]\a;(x;y)}                                   /    X -> => \X
Z:              {\x;(x;y)}                                              /   .. -> .. => \..

/ get, set

set:            W[2]{[x;y;a;b].[:[-3=4:b;`$b;*b];();:;D[a]];(x;y)}      / val [`name]|"name" set => name:d[val]
get:            W[1]{[x;y;a](x,,:[-3=4:a;`$a;*a][_n;_n];y)}             / [`name]|"name get -> [val]

/ callcc (parameterized)

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

/ read, print, error, stop

read:           {(x,,0:`;y)}                                            / read
print:          W[1]{[x;y;a]`0:(:[4:a;$a;5:a]),"\n";(x;y)}              / print w/ newline
write:          W[1]{[x;y;a]`0::[4:a;$a;5:a];(x;y)}                     / print
error:          W[1]{[x;y;a]'a;(x;y)}                                   / error
stop:           {stop_[];(x;y)}                                         / stop
stop_:          {'"stopped - ':' to continue"}                          / signal

/ result-stack <-> input-stack

r:              {(-1_ x;y,,*-1#x)}                                      / X A : Y -> X : Y A
r_:             {(x,,*-1#y;-1_ y)}                                      / X : Y A -> X A : Y

/ combinators

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

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

cond:           W[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_:          W[4]{[x;y;b;t;e;s](s;:[b~0;(e;`cond);t],y)}                             / "loop": t if b else (e;cond)

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

/ adverbs

over:           W[2]{[x;y;a;p](x;(*a;1_ a;p;`over_),y)}                                 / X f2 -> f2/X
over_:          W[3]{[x;y;r;a;p](x;:[#a;(r;*a),p,(1_ a;p;`over_);,r],y)}

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

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