SetDirectory["G:\CompassGraphics"];
in:=StringJoin[#," "]&/@ReadList["PDP200.clg",String] ;
inBis:=StringJoin[in];
inBisBis:=StringSplit[inBis];

(* "mini-logo (lg) with turtle graphics, 
    syntactic categories cmnds, cmnd, expr etc.
    var of type CV has a colon, eg :x, var of type QV has a double quote instead of the colon,
    the QV version first in an assignment, then the CV eg MAKE (quoted)x (coloned)x + 1
    a proc name has neither : nor double quote, eg koch  
    limitations: at most two parameters for procedures, spaces needed between all(!) tokens, 
    operator precendces messy
    expr ::=  N | CV | expr + expr | expr - expr | expr / expr | expr = expr | expr > expr
    cmnds ::= empty | action cmnds | proc cmnds 
    action := NORTH expr | EAST expr | SOUTH expr | WEST expr 
             | MAKE QV expr | IF expr [ cmnds ] | STOP | P | P expr | P expr expr
    proc ::= TO P cmnds END | TO P CV cmnds END | TO P CV CV cmnds END  
*)

exprQ[{NN_}]:=True/;StringMatchQ[NN,NumberString];
exprQ[{CV_}]:=True /;StringQ[CV]∧ StringLength[CV]>1∧StringTake[CV,1]==":";
exprQ[{expr1__,"+",expr2__}]:=True /; exprQ[{expr1}]∧exprQ[{expr2}];
exprQ[{expr1__,"-",expr2__}]:=True/; exprQ[{expr1}]∧exprQ[{expr2}];
exprQ[{expr1__,"/",expr2__}]:=True/; exprQ[{expr1}]∧exprQ[{expr2}];
exprQ[{expr1__,"*",expr2__}]:=True/; exprQ[{expr1}]∧exprQ[{expr2}];
exprQ[{expr1__,"=",expr2__}]:=True/; exprQ[{expr1}]∧exprQ[{expr2}];
exprQ[{expr1__,"<",expr2__}]:=True/; exprQ[{expr1}]∧exprQ[{expr2}];
exprQ[{expr1__,">",expr2__}]:=True/; exprQ[{expr1}]∧exprQ[{expr2}];
exprQ[otherwise_]:=False;

Clear[cmndsQ]
$RecursionLimit=2000;
cmndsQ[{}]:=True;
cmndsQ[{action__,cmnds___}]:=True /; actionQ[{action}]∧cmndsQ[{cmnds}];
cmndsQ[{proc__,cmnds__}]:=True /; procQ[{proc}]∧cmndsQ[{cmnds}];
cmndsQ[{proc__,cmnds__}]:=True/; proccvQ[{proc}]∧cmndsQ[{cmnds}];
cmndsQ[{proc__,cmnds__}]:=True /; proccvcvQ[{proc}]∧cmndsQ[{cmnds}];
cmndsQ[otherwise_]:=False;

reserved:={"NORTH","EAST","SOUTH","WEST","MAKE","IF","TO","END","[","]"};
cvQ[CV_]:=True /; StringQ[CV]∧ StringLength[CV]>1∧StringTake[CV,1]==":";
cvQ[otherwise_]:=False;
qvQ[QV_]:=True /; StringQ[QV]∧ StringLength[QV]>1∧StringTake[QV,1]=="\"";
qvQ[otherwise_]:=False;
pQ[P_]:=True /; StringQ[P]∧ StringLength[P]≥1∧StringMatchQ[P,LetterCharacter ..]∧¬MemberQ[reserved,P];
pQ[otherwise_]:=False;

Clear[procQ];
procQ[{"TO" ,P_,cmnds__,"END"}]:=True  /; pQ[P]∧cmndsQ[{cmnds}];
proccvQ[{"TO" ,P_,CV_,cmnds__,"END"}]:=True  /; pQ[P]∧cvQ[CV]∧cmndsQ[{cmnds}];
proccvcvQ[{"TO" ,P_,CV1__,CV2__,cmnds__,"END"}]:=True  /; pQ[P]∧cvQ[CV1]∧cvQ[CV2]∧cmndsQ[{cmnds}];
procQ[otherwise_]:=False;
proccvQ[otherwise_]:=False;
proccvcvQ[otherwise_]:=False;

actionQ[{"NORTH",expr__}]:=True/;exprQ[{expr}];
actionQ[{"EAST",expr__}]:=True/;exprQ[{expr}];
actionQ[{"SOUTH",expr__}]:=True/;exprQ[{expr}];
actionQ[{"WEST",expr__}]:=True/;exprQ[{expr}];
actionQ[{"MAKE",qv_, expr__}]:=True/;qvQ[qv]∧exprQ[{expr}];
actionQ[{"IF",expr__,"[",cmnds__,"]"}]:=True/;exprQ[{expr}]∧ cmndsQ[{cmnds}];
actionQ[{"STOP"}]:=True;
actionQ[{P_, expr1__,expr2__}]:=True/;pQ[P]∧exprQ[{expr1}]∧exprQ[{expr2}];
actionQ[{P_, expr__}]:=True/;pQ[P]∧exprQ[{expr}];
actionQ[{P_}]:=True/;pQ[P];
actionQ[otherwise_]:=False;

(*" whereas cmndsQ tests for syntax, cmndsM, actionM etc are the meaning function, etc.
    conditions after if are as in C ie nonzero means true, stop implemented with stop-bit,
    (poor-mens continuation semantics), the = sign is comparison, not assignment, 
    equation yields 1 if both sides equal, so booleans are integers,
    exprM[{expr},{trace,cur,dir,vars,procs,stopbit}] = value
    procM[{proc},{trace,cur,dir,vars,procs,stopbit}] = newprocs
    actionM[{action},{trace,cur,dir,vars,procs,stopbit}] = {newtrace,newcur,newdir,newvars,newprocs,newstopbit}
    cmndsM[{cmnds},{trace,cur,dir,vars,procs,stopbit}] = {newtrace,newcur,newdir,newvars,newprocs,newstopbit}
"*)

Clear[popvar];
fndvar[{},CV_]:="VARIABLE NOT FOUND";
fndvar[{{CV_,n_},rest___},CV_]:=n;
fndvar[{{CVO_,n_},rest___},CV_]:=fndvar[{rest},CV];
addvar[CV_,n_,vars_]:={{CV,n}}~Join~vars;
popvar[{},CV_]:={};
popvar[{{CV_,n_},rest___},CV_]:={rest};
popvar[{{CVO_,n_},rest___},CV_]:=addvar[CVO,n,popvar[{rest},CV]];
popvartcdvp[{t_,c_,d_,vars_,p_,s_},CV_]:={t,c,d,popvar[vars,CV],p,s};

Clear[exprM];
exprM[{expr1__,"+",expr2__},tcdvps_]:=
exprM[{expr1},tcdvps]+exprM[{expr2},tcdvps]/; exprQ[{expr1}]∧exprQ[{expr2}];
exprM[{expr1__,"-",expr2__},tcdvps_]:=
exprM[{expr1},tcdvps]-exprM[{expr2},tcdvps]/; exprQ[{expr1}]∧exprQ[{expr2}];
exprM[{expr1__,"/",expr2__},tcdvps_]:=
exprM[{expr1},tcdvps]/exprM[{expr2},tcdvps]/; exprQ[{expr1}]∧exprQ[{expr2}];
exprM[{expr1__,"*",expr2__},tcdvps_]:=
exprM[{expr1},tcdvps] × exprM[{expr2},tcdvps]/; exprQ[{expr1}]∧exprQ[{expr2}];
exprM[{expr1__,"=",expr2__},tcdvps_]:=
If[exprM[{expr1},tcdvps]==exprM[{expr2},tcdvps],1,0]/; exprQ[{expr1}]∧exprQ[{expr2}];
exprM[{expr1__,"<",expr2__},tcdvps_]:=
If[exprM[{expr1},tcdvps]<exprM[{expr2},tcdvps],1,0]/; exprQ[{expr1}]∧exprQ[{expr2}];
exprM[{expr1__,">",expr2__},tcdvps_]:=
If[exprM[{expr1},tcdvps]>exprM[{expr2},tcdvps],1,0]/; exprQ[{expr1}]∧exprQ[{expr2}];
exprM[{NN_},{t_,c_,d_,v_,p_,s_}]:=
N[ToExpression[NN]]/;StringMatchQ[NN,NumberString];
exprM[{CV_},{t_,c_,d_,vars_,p_,s_}]:=fndvar[vars,CV]/;StringQ[CV]∧ StringLength[CV]>1∧StringTake[CV,1]==":";

Clear[cmndsM];
tststopbit[{t_,c_,d_,v_,p_,s_}]:=s;
clrstopbit[{t_,c_,d_,v_,p_,s_}]:={t,c,d,v,p,False};
cmndsM[{},tcdvps_]:=tcdvps;
cmndsM[{action__,cmnds___},{t_,c_,d_,v_,p_,s_}]:=With[{newtcdvps=actionM[{action},{t,c,d,v,p,s}]},If[tststopbit[newtcdvps]==True,newtcdvps,cmndsM[{cmnds},newtcdvps]]]/; actionQ[{action}]∧cmndsQ[{cmnds}];
cmndsM[{proc__,cmnds__},{t_,c_,d_,v_,p_,s_}]:=
With[{newprocs=procM[{proc},{t,c,d,v,p,s}]},cmndsM[{cmnds},{t,c,d,v,newprocs,s}]]/; (procQ[{proc}]∨proccvQ[{proc}]∨proccvcvQ[{proc}])∧cmndsQ[{cmnds}];

fndproc[{{P_,cmnds_},rest___},P_]:={cmnds};
fndproc[{{PO_,cmnds_},rest___},P_]:=fndproc[{rest},P];
fndproc[{{P_,cv_,cmnds_},rest___},P_]:={cv,cmnds};
fndproc[{{PO_,cv_,cmnds_},rest___},P_]:=fndproc[{rest},P];
fndproc[{{P_,cv1_,cv2_,cmnds_},rest___},P_]:={cv1,cv2,cmnds};
fndproc[{{PO_,cv1_,cv2_,cmnds_},rest___},P_]:=fndproc[{rest},P];
fndproc[{},P_]:="PROCEDURE NOT FOUND";
addproc[P_,cmnds_,procs_]:={{P,cmnds}}~Join~procs;
addproc[P_,cv_,cmnds_,procs_]:={{P,cv,cmnds}}~Join~procs;
addproc[P_,cv1_,cv2_,cmnds_,procs_]:={{P,cv1,cv2,cmnds}}~Join~procs;

(* for example test the above  symbol table for procedures as follows, myprocs:=addproc["koch",":size",":super",66,addproc["spiral",":length",77,{}]];
fndproc[myprocs,"koch"] *)

Clear[procM];
procM[{"TO" ,P_,cmnds__,"END"},{t_,c_,d_,v_,p_,s_}]:=
addproc[P,{cmnds},p]/;procQ[{"TO" ,P,cmnds,"END"}];
procM[{"TO" ,P_,cv_,cmnds__,"END"},{t_,c_,d_,v_,p_,s_}]:=addproc[P,cv,{cmnds},p]/;proccvQ[{"TO" ,P,cv,cmnds,"END"}];
procM[{"TO" ,P_,cv1_,cv2_,cmnds__,"END"},{t_,c_,d_,v_,p_,s_}]:=addproc[P,cv1,cv2,{cmnds},p]/;proccvcvQ[{"TO" ,P,cv1,cv2,cmnds,"END"}];

rot90[xy_]:=(({{0, -1}, {1, 0}})).xy;
rot180[xy_]:=(({{-1, 0}, {0, -1}})).xy;
Rot[a_]:=Which[a==90,(({{0, -1}, {1, 0}})),a==-90,(({{0, 1}, {-1, 0}})),a==180∨a==-180,(({{-1, 0}, {0, -1}})),True,(({{Cos[((2π a)/360)], -Sin[((2π a)/360)]}, {Sin[((2π a)/360)], Cos[((2π a)/360)]}}))];

Clear[actionM];
actionM[{"NORTH",expr__},{t_,c_,d_,v_,p_,s_}]:=With[{newc=c+exprM[{expr},{t,c,d,v,p,s}]*{0,1}},{t~Join~{newc},newc,d,v,p,s}]/;actionQ[{"NORTH",expr}];
actionM[{"EAST",expr__},{t_,c_,d_,v_,p_,s_}]:=With[{newc=c+exprM[{expr},{t,c,d,v,p,s}]*{1,0}},{t~Join~{newc},newc,d,v,p,s}]/;actionQ[{"EAST",expr}];
actionM[{"SOUTH",expr__},{t_,c_,d_,v_,p_,s_}]:=With[{newc=c+exprM[{expr},{t,c,d,v,p,s}]*{0,-1}},{t~Join~{newc},newc,d,v,p,s}]/;actionQ[{"SOUTH",expr}];
actionM[{"WEST",expr__},{t_,c_,d_,v_,p_,s_}]:=With[{newc=c+exprM[{expr},{t,c,d,v,p,s}]*{-1,0}},{t~Join~{newc},newc,d,v,p,s}]/;actionQ[{"WEST",expr}];
actionM[{"MAKE",qv_, expr__},{t_,c_,d_,v_,p_,s_}]:=With[{newvars=addvar[StringReplace[qv,"\""->":"],exprM[{expr},{t,c,d,v,p,s}], v]},{t,c,d,newvars,p,s}]/;actionQ[{"MAKE",qv, expr}];
actionM[{"IF",expr__,"[",cmnds__,"]"},tcdvps_]:=
With[{tst=exprM[{expr},tcdvps]}, If[tst==1, cmndsM[{cmnds},tcdvps],tcdvps]]/;actionQ[{"IF",expr,"[",cmnds,"]"}];
actionM[{"STOP"},{t_,c_,d_,v_,p_,s_}]:=
{t,c,d,v,p,True};
actionM[{P_,expr1__,expr2__},{t_,c_,d_,v_,p_,s_}]:= 
With[{cv1=fndproc[p,P][[1]],cv2=fndproc[p,P][[2]],cmnds=fndproc[p,P][[3]],
n1=exprM[{expr1},{t,c,d,v,p,False}],n2=exprM[{expr2},{t,c,d,v,p,False}]},clrstopbit[popvartcdvp[popvartcdvp[cmndsM[cmnds,{t,c,d,addvar[cv2,n2,addvar[cv1,n1,v]],p,False} ],cv1],cv2]]]/;exprQ[{expr1}]∧exprQ[{expr2}]∧actionQ[{P, expr1,expr2}]∧Length[fndproc[p,P]]==3;
actionM[{P_,expr__},{t_,c_,d_,v_,p_,s_}]:= 
With[{cv=fndproc[p,P][[1]],cmnds=fndproc[p,P][[2]],
n=exprM[{expr},{t,c,d,v,p,False}]},
clrstopbit[popvartcdvp[cmndsM[cmnds,{t,c,d,addvar[cv,n,v],p,False} ],cv]]]/;actionQ[{P, expr}]∧Length[fndproc[p,P]]==2;
actionM[{P_},{t_,c_,d_,v_,p_,s_}]:= 
With[{cmnds=fndproc[p,P][[1]]},clrstopbit[cmndsM[cmnds,{t,c,d,v,p,False}]]] /;actionQ[{P}]∧Length[fndproc[p,P]]==1;

tst:=inBisBis;
tst
cmndsQ[tst]
tstM:=cmndsM[tst,{{{0,0}},{0,0},{0,1},{},{},False}];
(*tstM*)
Show[Graphics[Line[tstM[[1]]]]]