Ursala/lib/cli.fun

#import std
#import nat
#import flo
#import stt

#comment -[
some routines to interface with command line interpreters
Copyright (C) 2007-2010 Dennis Furey]-

#library+

-------------------------------------------------------- constants ---------------------------------------------------------

eof        = 4%cOi&   # end of file character

---------------------------------------------------- data structures --------------------------------------------------------

#optimize+

shell ::    # interface specification of a command line interpreter

opener      %s                   # command to invoke the shell
login       %sLWL                # password negotiation protocol, if required
prompt      %scLU                # shell prompt to expect
settings    %sL                  # commands to be executed when the shell opens
declarer    %fOZ  ~declarer||0!! # takes an assignment (n: m) to a client that binds the value of m to the symbol n
releaser    %fOZ  ~releaser||0!! # takes an assignment (n: m) to a client that releases the storage for the symbol n
closers     %sL                  # commands to close the shell
answerer    %fOZ  ~answerer||~&! # postprocessor for answers returned by the ask function, taking %ssLA
nop         %s                   # shell command that does nothing, used by ask, usually just the empty string
wrapper     %fOZ  ~wrapper||~&!  # postprocessor to the client generated by sh for anything not covered above

------------------------------------------- functions pertaining to protocols ------------------------------------------------

(# A protocol is represented as a list of pairs of lists of strings <(<command..>,<prompt..>)..>, such that the client sends
the commands and waits for the prompts. If the last list of prompts is <<eof>>, the client will wait until the server closes
the connection. If the last list of prompts is <''>, the client will close the connection upon sending the last command.
Otherwise, the client will close the connection when the last prompt is received. This semantics is a consequence of the
virtual machine's interact combinator calling conventions. #)

handshake  = ^|DrlXS(:/''+ ~&iNC,* --<''>+ ~&iNC)  # takes a prompt string and a list of command strings to a protocol
completing = ~&i&& ^lrNCT/~&y ~&\<<eof>>+ ~&zl     # takes a protocol to one that waits for the server to close the connection
closing    = ~&i&& ^lrNCT/~&y ~&\<''>+ ~&zl        # takes a protocol to one that ends with the client closing the connection

-------------------------------------------------- functions of clients -----------------------------------------------------

watch = ~&iNHiF+ interact                # takes a client to a verbose trace of type %scLULL
exec  = ~&Z&&+ !+ ~&NiX\<<eof>>+ ~&iNC   # takes a string to a client that executes only one command

expect = # takes a protocol to a client usable as an argument to the interact combinator

%scLULWLMk; ~&i&& (~&?^\!+~&hr ~&l?\0!+ ~&l;+ =:+ ~&t)+ -+
   %aaZscLULWXXLMk+ ~&a^& :^\~&fatPR ^/~&ahl ^\~&ahr ~&atihlPB,
   %ascLULWXLMk+ ^p\~& %aLMk+ ~&aahPNfatPRXfatPRNXQaaXqS+ ~&xrSPS+ zipp0*+ ~&ziD+ iol+-

(# seq takes a prompt p to a function that takes a list of clients to their sequential composition in a shell with prompt
p. If any client closes the connection, interaction with the next one starts immediately. If any client waits for the server
to close the connection (with <<eof>>), the prompt <'',p> is expected instead (i.e., p preceded by a line break), any
accompanying command from the client has a line break appended, and the interaction of the next client commences when <'',p>
is received. If the initial output of the next client is a single string, a line break is appended to the command, and if its
initial prompt is a single string, a line break is inserted in the prompt. #)

seq =

"p". :-0 ~&l?\~&r ~&r?\~&l ~&lNH?\~&r ~&rNH?\~&l ("f","g"). -!~&Z,~&ll==&l!-?(
   "f"+~&ilrPrXB; ~&?(
      <<eof>>?=rr(~&/&+ ~&\<'',"p">+ ~&rl,^|\~& ~&/&l),
      ! ^|(~&/&r,^|(~&t?/~& --<''>,-!~&ZtY,==<<eof>>!-?/~& ~&NiC)) "g" 0),
   &?=l(! ^|(~&/&r,^|(~&t?/~& --<''>,-!~&ZtY,==<<eof>>!-?/~& ~&NiC)) "g" 0,(~&i&& ^|\~& ~&/&r)+ "g"+ ~&lrPrX))

(# When used as a wrapper in a shell, prompt_counter substitutes \n in prompt strings with a count that's incremented each
time starting from 1. #)

prompt_counter =

"f". -+
   ~&r&& (~&i&& ~&r; any substring/'\n')?rr\~&lrlPXrrPX -+
      %ngXsLWXMk+ ^/~&lrlPX ^/~&rrl ^H\~&rrr '\n'%=*+ ~&h+ %nP+ ~&l,
      %ngsLWXXMk+ ^\~&r ~&rrlihtYB?/successor+~&l ~&l+-,
   %ngsLWXXMk+ ~&?(^/~&ll "f"+ ~&lrPrX,! ~&NiX "f" 0)+-


------------------------------------------------------- specific shells ----------------------------------------------------

#optimize-

bash = # system command line interpreter

shell[
   opener: 'bash --noediting',
   prompt: '$ ',
   settings: <'export PS1="$ " PS2="$ "','set +H'>,
   declarer: %sI?m(
      ("n","m"). exec 'export '--"n"--'="'--"m"--'"',
      ("n","m"). seq'$ ' <
         exec 'touch '--"n",
         (sh shell[opener: 'ed '--"n",settings: <'%d','a'>,closers: <'.','wq'>])/<> ~='.'*~ "m">),
   releaser: %sI?m/0! exec+ 'rm '--+ ~&n,
   closers: <'exit'>]

psh = shell opener:='psh'! bash

R = # statistical package

shell[
   opener: 'R -q',
   prompt: '> ',
   declarer: expect+ completing+ handshake/'> '+ -?
      %eLI+~&m: :^(
         ^T/~&n '=rep(0,'--+ --')'+ ~&h+ %nP+ length+ ~&m,
         ^D(~&n,num+~&m); * ^T/~&l ~&r; ^T('['--+ --']='+ ~&h+ %nP+ successor+ ~&l,printf/'%0.20e'+ ~&r)),
      %eLLI+~&m: :^(
         ^T/~&n '=matrix(0,'--+ --')'+ ^T(~&l,:/`,+ ~&r)+ ~&bh+ %nP~~+ length~~+ ~&m; ^/~& ~&z+ leql-<,
         ^D(~&n,num+~&m); *= -+
            * ^T/~&l ~&r; ^T('['--+ --']'+ ^T/~&l :/`,+ ~&h+ %nP+ successor+ ~&rl,:/`=+ printf/'%0.20e'+ ~&rr),
            ^D/~&l ~&r; ^D\num+~&r ~&h+ %nP+ successor+~&l+-),
      %eI+~&m: ^TNC/~&n :/`=+ printf/'%0.20e'+ ~&m,
      -&~&,%sLI&-+~&m: :^(~&lrhPX; ^|T/~& ' <- '--,~&rt)+ ^lrNCT(~&y,--';'+ ~&z)+ ~&m,
      <'unknown R type'>!%?-,
   closers: <'q()'>]

octave = # numerical package

shell[
   opener: 'octave --q --no-line-editing',
   prompt: '> ',
   settings: <'PS1=''> ''','PS2='' > ''','split_long_rows=0','format hex','PAGER="cat"'>,
   declarer: expect+ completing+ handshake/'> '+ -?
      %eLLI+~&m: :^/(^T/~&n '=eye('--+ --');'+ ^|T(~&,:/`,)+ ~&bh+ %nP~~+ length~~+ ~&mmhPX) ^D(~&n,num+~&m); *= -+
         * ^T(
            ^T/~&l ~&r; '('--+ --')'+ ^T/~&l :/`,+ ~&h+ %nP+ successor+ ~&rl,
            ~&r; :/`=+ --';'+ printf/'%0.20e'+ ~&rr),
         ^D/~&l ~&r; ^D\num+~&r ~&h+ %nP+ successor+~&l+-,
      %eLI+~&m: :^/(^T/~&n '=(1:'--+ --')'';'+ ~&h+ %nP+ length+ ~&m) ^D(~&n,num+~&m); * ^T(
         ^|T/~& '('--+ --')'+ ~&h+ %nP+ successor+ ~&l,
         :/`=+ --';'+ printf/'%0.20e'+ ~&rr),
      %eI+~&m: ^TNC/~&n :/`=+ --';'+ printf/'%0.20e'+ ~&m,
      -&~&,%sLI&-+~&m: :^(~&nmhPX; ^|T/~& ' = '--,~&mt),
      <'unknown octave type'>!%?-,
   closers: <'quit'>,
   answerer: ||~& (substring/' ='+ ~&ihB)&& ~&itZBhiQ+ ~&F+ * sep` ; -+
      ~&itZBhiQ+ octhex*,
      *~ eql/'0000000000000000'&& subset\digits--'abcdef'+-]

gap = # group theory package

shell[
   opener: 'gap -b -n',
   prompt: 'gap> ',
   settings: <'ColorPrompt(false);'>,
   declarer: expect+ completing+ handshake/'> '+ -+
      ^lrNCT(~&y,--';'+ ~&z)+ '<'%=*'['+ '>'%=*']',
      :^(~&lrhPX; ^|T/~& ':='--,~&rt)^/~&n ~&m; -|
         -|%nI&& %nP,%nLI&& %nLP,%nLLI&& %nLLP|-,
         -&%sLI,any substring/'function',~&i&-,
         ''''%=*'"'+ '"'%=*'\"'+ -|%sI&& %sP,%sLI&& %sLP,%sLLI&& %sLLP|-,
         ~&l?('/1'%=*''+ ~&r,~&r)+ -?
            %qI: ^\%qP ~&rr=='1',
            %qLI: ^\%qLP all ~&rr=='1',
            %qLLI: ^\%qLLP all all ~&rr=='1',
            <'unknown gap type'>!%?-|-+-,
   wrapper: //+ ||~& -&
      -&~&,~&r,~&rr==<'','gap> '>&-&& ~&rl; -&~&,~&t,~&ttZ,~&thZ&-&& ~&h; -&~&,~&z~=`;&-,
      &rlh:= --';'+ ~&rlh&-,
   closers: <'quit;'>]

gp = # number theoretic computer algebra system

shell[
   opener: 'gp -q',
   prompt: '? ',
   settings: 'default'--* <'(colors,no)','(output,0)','(readline,0)','(prompt_cont,"? ")','(format,"e0.28")'>,
   declarer: expect+ completing+ handshake/''+ ^lrNCT(--'\'*+ ~&y,--';'+ ~&z)^C(^|T/~& ' = '--+ ~&h,~&rt)^/~&n ~&m; -|
      -?%nI: %nP,%qI: %qP,%eI: ~&iNC+ printf/'%0.20e',%EI: ~&iNC+ mpfr..mp2str,%sI: ~&iNC,0!?-,
      -?%nLI: ~&hS+ %nP*,%qLI: ~&hS+ %qP*,%eLI: printf/*'%0.20e',%ELI: * mpfr..mp2str,-&%sLI,all ~&wZ/`=&-: ~&,0!?-; ~&i&& -+
         ^C\~&t '['--+ ~&h,
         ^lrNCT(--','*+ ~&y,--']'+ ~&z)+-,
      -?%nLLI: ~&hSS+ %nP**,%qLLI: ~&hSS+ %qP**,%eLLI: printf/**'%0.20e',%ELLI: mpfr..mp2str**,%sLLI: ~&,0!?-; ~&i&& -+
         ^C('['--+ ~&h,~&t)+ ~&L+ ^lrNCT(~&y; * ^lrNCT/~&y --';'+ ~&z,~&z; ^lrNCT/~&y --']'+ ~&z),
         * ^lrNCT(--','*+ ~&y,~&z)+-,
      %sLI?/~& <'unknown gp type'>!%|-,
   closers: <'\q'>]

maxima = # computer algebra

shell[
   opener: 'maxima --quiet --disable-readline',
   prompt: '(%i\n) ',
   settings: <'display2d: false;'>,
   declarer: expect+ completing+ handshake/''+ -+
      ^lrNCT(~&y,--'$'+ ~&z)^C\~&rt ^|T/~& ': '--+ ~&h,
      ^/~&n ~&m; %sI?/~&iNC %sLI?/~& <'unknown maxima type'>!%+-,
   closers: <'quit();'>,
   nop: '0$',
   wrapper: prompt_counter; //+ ||~& -&
      -&~&,~&r,~&rr; -&~&,~&hZ,~&t,~&ttZ,~&t=]'(%i'&-&-&& ~&rl; -&~&,~&t,~&ttZ,~&thZ&-&& ~&h; -&~&,~&z~<';$'&-,
      &rlh:= --';'+ ~&rlh&-,
   answerer: ~&ihZBtiQ; =]'(%o'?ihB\~& :^\~&t ~&ritB+ ~=` -~+ ~&h]

axiom = # computer algebra

shell[
   opener: 'axiom -noht -nogr -nogr -nox',
   prompt: '(\n) -> ',
   settings: <')set quit unprotected'>,
   declarer: expect+ completing+ handshake/''+ ^lrNCT(--'_'*+ ~&y,--';'+ ~&z)^C(^|T/~& ' := '--+ ~&h,~&rt)^/~&n ~&m; -|
      -?%nI: %nP,%qI: %qP,%eI: ~&iNC+ printf/'%0.20e',%EI: ~&iNC+ mpfr..mp2str,%sI: ~&iNC,0!?-,
      -?%nLI: ~&hS+ %nP*,%qLI: ~&hS+ %qP*,%eLI: printf/*'%0.20e',%ELI: * mpfr..mp2str,-&%sLI,all ~&wZ/`=&-: ~&,0!?-; ~&i&& -+
         ^C\~&t '['--+ ~&h,
         ^lrNCT(--','*+ ~&y,--']'+ ~&z)+-,
      -?%nLLI: ~&hSS+ %nP**,%qLLI: ~&hSS+ %qP**,%eLLI: printf/**'%0.20e',%ELLI: mpfr..mp2str**,%sLLI: ~&,0!?-; ~&i&& -+
         ^C('matrix['--+ ~&h,~&t)+ ~&L+ ^lrNCT(~&y; * ^lrNCT/~&y --','+ ~&z,~&z; ^lrNCT/~&y --']'+ ~&z),
         * ^C('['--+ ~&h,~&t)^lrNCT(--','*+ ~&y,--']'+ ~&z)+-,
      %sLI?/~& <'unknown axiom type'>!%|-,
   closers: <')quit'>,
   wrapper: "f". -+
      ~&r&& (~&i&& ~&r; any substring/'\n')?rr\~&lrlPXrrPX -+
         %ngXscLULWXMk+ ^/~&lrlPX ^/~&rrl ^H\~&rrr '\n'%=*+ ~&h+ %nP+ ~&l,
         %ngscLULWXXMk+ -!~&lZ,~&rrlihtihBPYB&& ~&rrlh; not -!=]')',=]'--',=]'++'!-!-?(
            ^/successor+~&l ~&r,
            ^/~&l ~&r; ^/~&l ~&r; ^/~&l ~&r; ~&i&& :^/~&h ~&t; ~&i&& ^llTrC\~&t :/13%cOi&+ ~&h)+-,
      %ngscLULWXXMk+ ~&?(^/~&ll "f"+ ~&lrPrX,! ~&NiX "f" 0)+-,
   answerer: -+
      ~&a^& =]'   Loading'?ah\~&a `.?=ahz/~&fatPR ~&fatitB2R,
      ~=13%cOi&*~*+ ~&rihZtiQB+ -~ ~&+-]

scilab = # numerical package

shell[
   opener: 'scilab -nb -nw -nwni -nogui',
   prompt: '-->',
   declarer: expect+ completing+ handshake/'-->'+ ^C(^|T/~& ' = '--+ ~&h,~&rt)^/~&n ~&m; -|
      -?
         %nI: %nP,
         %qI: %qP,
         %eI: ~&iNC+ printf/'%0.20e',
         %EI: ~&iNC+ mpfr..mp2str,
         %bI: ~&?/<'%t'>! <'%f'>!,
         %sI: ~&iNC+ :/`'+ --'''',
         0!?-,
      (~&i&& :/'['+ --<']'>)+ -?
         %nLI: ~&hS+ %nP*,
         %qLI: ~&hS+ %qP*,
         %eLI: printf/*'%0.20e',
         %ELI: * mpfr..mp2str,
         %bLI: * ~&?/'%t'! '%f'!,
         -&%sLI,all ~&wZ/`=&-: * :/`'+ --'''',
         0!?-,
      (~&i&& ~&K7; :/'[['+ --<']]'>+ mat'][')+ -?
         %nLLI: ~&hSS+ %nP**,
         %qLLI: ~&hSS+ %qP**,
         %eLLI: printf/**'%0.20e',
         %ELLI: mpfr..mp2str**,
         %bLLI: * * ~&?/'%t'! '%f'!,
         %sLLI: * * :/`'+ --'''',
         0!?-,
      %sLI?/~& <'unknown scilab type'>!%|-,
   answerer: ~=' '*~; `=?=ihBz\~& ~&t,
   closers: <'quit'>]

---------------------------------------------- functions operating on shells ------------------------------------------------

#optimize+

ssh       = sh++ hop
sask      = ask++ hop
sopen     = open++ hop
multihop  = -++-+ hop*
su        = ("u","p"). shell$i[opener: ! 'su'-- (~&i&& :/` ) "u",login: ! <(<''>,<'word: '>),(<"p",''>,<' '>)>] bash

hop = # takes a hostname ho and password p to a nestable function that makes a shell remote

("ho","p"). shell$i[
   opener: ! 'ssh'-- (~&i&& :/` ) "ho",
   login: -+
      //~&T <(<''>,<'word: '>),(<"p",''>,<=]'root@'?(':~# '!,':~$ '!) "ho">)>,
      "s". :/(<~opener "s",''>,<''>) ~login "s"+-]

sh = # takes a shell specification to a function that takes an environment and a list of command strings to a client

"s". ("e","c"). (~&?(~&,~&!) ~wrapper "s") (seq ~prompt "s") <
   expect :\~login"s" ^biNC(~opener,~login.&Z&& ~prompt) "s",
   expect completing handshake ~(prompt,settings) "s",
   (seq ~prompt "s") ~declarer"s"* "e",
   expect completing handshake (~prompt "s","c"),
   (seq ~prompt "s") ~releaser"s"* "e",
   expect closing handshake ~(prompt,closers) "s">

open = # takes a shell specification to a function taking an environment and a list of clients to a client

"s". ("e","c"). (~&?(~&,~&!) ~wrapper "s") (seq ~prompt "s") <
   expect :\~login"s" ^biNC(~opener,~login.&Z&& ~prompt) "s",
   expect completing handshake ~(prompt,settings) "s",
   (seq ~prompt "s") ~&L <~declarer"s"* "e","c",~releaser"s"* "e">,
   expect closing handshake ~(prompt,closers) "s">

ask = # takes a shell to a function that takes an environment and a list of command strings to a result of type %sLm

"s". -+
   ^p(~&nS,~answerer"s"*+ ~&mS)+ ~&mF+ rlc~&rititZBPBZ; %sLLLMk; * %sLLCk ~&hihBPtihiyBPBPX; ^A/~&l ~&lrihBPEritBPrQ,
   %sLLMk+ ~&ritBitB+ ~=<~nop "s",''>-~+ ~&liyB+ ~=<~nop "s",''>~-+ watch+ sh"s"^|/~& :/~nop"s"+ --<~nop "s">+-

------------------------------------------------- functions using shells ----------------------------------------------------

(# now ignores its argument, octhex takes a hexadecimal string to a floating point number, choleski takes a positive
definite matrix to a matrix, and eigen takes a symmetric matrix to a list of vectors and values. #)

now      = ~&hmh+ (ask bash)/<>+ <'date -R'>!
octhex   = block2; ~&x+ * -$characters ~&iiK0lrNCCS '0123456789abcdef'
eigen    = ~&itBthm2hmPpBx+ (ask octave)\<'[v,d]=eig(a);','diag(d)','v'>+ ~&ANC/'a'
choleski = -|~&ihimitBiK7BPBPB,~&ihmPB&& ~&hm%|-+ (ask octave)\<'chol(a)'>+ ~&ANC/'a'

stdmvnorm = # takes (<lower..>,<upper..>,<<sigma..>..>) to a standard multivariate normal probability using R

-&~&,~&r,eql+~&lrlPX,eql+~&lrrPX,~&rr,eql+~&lrrh2X,~&rr; all_same length&-?\<'abnormal'>!% -+
   math..strtod+ (~&i&& ~&z; substring/'Normal Completion')?/~&httt <'abnormal completion'>!%,
   =]'[1]'*~+ ~&zm+ (ask R)^/<.'lower':+ ~&l,'upper':+ ~&rl,'sigma':+ ~&rr> -+
      :/'library(mvtnorm)'+ ~&iNC+ 'print(digits=16,pmvnorm(mean=rep(0,'--+ --'),lower,upper,sigma))',
      ~&h+ %nP+ length+ ~&l+-+-

mvnorm = # takes (<lower..>,<upper..>,<mean..>,<<sigma..>..>) to a multivariate normal probability using R

-&~&,~&r,eql+~&lrlPX,eql+~&lrrl2X,~&rrr,eql+~&lrrrh3X,~&rrr; all_same length&-?\<'abnormal'>!% -+
   math..strtod+ (~&i&& ~&z; substring/'Normal Completion')?/~&httt <'abnormal completion'>!%,
   =]'[1]'*~+ ~&zm+ -+
      (ask R)\<'library(mvtnorm)','print(digits=16,pmvnorm(mean=means,lower,upper,sigma))'>,
      <.'lower':+ ~&l,'upper':+ ~&rl,'means':+ ~&rrl,'sigma':+ ~&rrr>+-+-

axparse = # parses a list of strings returned by an axiom command of the form expression::InputForm to a tree of strings

-&~&r==<'Type:','InputForm'>,~&l&-+ -+
   ~&a^?\<'bad S-exp'>!% ')'?=ah/~&NaX '('?=ah\~&ahNVtX ~&NfatPJX; ~&rah~=')'->lxhdPtV2rat2X ~&lrffaRJPX; ~&ral2lCrfarPJPX,
   ~&itB+ ~&itB+ ~&itB+ ~&L; sep` ; *= rlc neither -='()'+-