1/* Part of plml
    2	Copyright 2014-2015 Samer Abdallah, University of London
    3	 
    4	This program is free software; you can redistribute it and/or
    5	modify it under the terms of the GNU General Public License
    6	as published by the Free Software Foundation; either version 2
    7	of the License, or (at your option) any later version.
    8
    9	This program is distributed in the hope that it will be useful,
   10	but WITHOUT ANY WARRANTY; without even the implied warranty of
   11	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   12	GNU General Public License for more details.
   13
   14	You should have received a copy of the GNU General Public
   15	License along with this library; if not, write to the Free Software
   16	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
   17*/
   18
   19:- module(mlserver,
   20		[	start_matlab/0
   21      ,  start_matlab/1
   22      ,  stop_matlab/0
   23      ,  ml_interrupt/0
   24      ,  ml_async/2
   25      ,  ml_async/3
   26      ,  (??)/1
   27      ,  (???)/1
   28      ,  (===)/2
   29		]).   30
   31% !!! when should we garbage_collect_atoms?
   32:- set_prolog_flag(double_quotes,string).   33
   34:- reexport(library(plml), except([(??)/1, (???)/1, (===)/2])).   35:- use_module(library(settings)).   36:- use_module(library(memo)).   37
   38:- initialization catch(mutex_create(_,[alias(mlclient)]),Ex,print_message(warning,Ex)).   39
   40:- setting(exec_timeout,number,1800,'Matlab command execution timeout in seconds').   41:- setting(eval_timeout,number,1800,'Matlab expression evaluation timeout in seconds').   42
   43:- dynamic current_matlab_thread/2.   44
   45start_matlab :- start_matlab([]).
   46start_matlab(Opts) :-
   47   (  current_thread(matlab,running) 
   48   -> debug(mlserver(control),'Matlab server thread already running',[])
   49   ;  (current_thread(matlab,_) -> thread_join(matlab,_); true),
   50      thread_create(ml_server(Opts),_,[alias(matlab)])
   51   ).
   52
   53stop_matlab :-
   54   (  current_matlab_thread(TID,_) -> kill_thread(TID)
   55   ;  debug(mlserver(control),'No Matlab thread running.',[])
   56   ).
   57
   58
   59%% +Returns:ml_vals(A) === +Expr:ml_expr(A) is det.
   60%  Asynchronous Matlab evaluation. Anything printed by Matlab code is output
   61%  to the current_output stream of the Matlab server thread.
   62[X1|Xs]===Expr :- !, setting(eval_timeout,T), ml_async(eval(Expr,[X1|Xs]),T).
   63X===Expr :- !, setting(eval_timeout,T), ml_async(eval(Expr,[X]),T).
   64
   65%% ??(+Cmd:ml_stmt) is det.
   66%  Asynchronous Matlab execution. Anything printed by Matlab code is captured
   67%  and printed to the current output of this thread (in blue).
   68?? Cmd :- 
   69   setting(exec_timeout,T), 
   70   ml_async(exec(Cmd),T,O), 
   71   ansi_format([fg(blue)],'~s',[O]).
   72
   73%% ???(+Expr:ml_expr(bool)) is det.
   74%  Asynchronous Matlab test. Equivalent to bool(1)===Expr.
   75??? Expr :- bool(1)===Expr.
   76
   77   
   78kill_thread(Thread) :-
   79   (  current_thread(Thread,running)
   80   -> thread_send_message(Thread,quit),
   81      debug(mlserver(control),'waiting for thread ~w to die.\n',[Thread]),
   82      catch( call_with_time_limit(5,
   83         (thread_join(Thread,RC), writeln(exit_code(RC)))),
   84         time_limit_exceeded,
   85         debug(mlserver(control),'timeout waiting for thread ~w.\n',[Thread]))
   86   ;  true
   87   ).
 ml_server(Opts) is det
   91ml_server(Opts) :-
   92   setup_call_cleanup(ml_open(ml,localhost,Opts), ml_run, ml_close(ml)).
   93   
   94ml_run :- 
   95   thread_self(Self),
   96   ml_eval(ml,feature("getpid"),[int],[PID]),
   97   setup_call_cleanup( 
   98      assert(current_matlab_thread(Self,PID)),
   99      ml_server_loop,
  100      retract(current_matlab_thread(Self,PID))).
  101
  102ml_server_loop :-
  103	thread_get_message(Msg),
  104	(	Msg=quit -> debug(mlserver(server),'Matlab server thread terminating.', [])
  105	;	Msg=req(Client,ID,Req,Reply)
  106   -> debug(mlserver(server),'handling ~w: ~W',[ID,Req,[quoted(true),max_depth(8)]]),
  107      memo:reify(mlserver:handle_request(Req),Status), !,
  108      debug(mlserver(server),'result is ~q',[Status]),
  109      thread_send_message(Client,resp(ID,Status,Reply)),
  110		ml_server_loop
  111	).
  112
  113handle_request(exec(Cmd))     :- ml_exec(ml,Cmd).
  114handle_request(eval(E,Ts,Vs)) :- ml_eval(ml,E,Ts,Vs).
  115handle_request(output(R,O))   :- with_output_to(string(O),handle_request(R)).
 ml_async(+Req, +Timeout:float, -Output:string) is det
 ml_async(+Req, +Timeout:float) is det
Use Matlab server thread to do computation described by Req. Req can be

If the computation takes longer than Timeout seconds, Matlab is interrupted and abort(timeout) is thrown. The computation can also be interrupted by signalling the client thread with throw(abort(Reason)), where Reason can be anything. If third argument Output is supplied, anything printed by Matlab computation is captured and returned as a string.

  129ml_async(R,T) :- req(R,Req,Reply), ml_request(Req,Reply,T).  
  130ml_async(R,T,O) :- req(R,Req,Reply), ml_request(output(Req,O),Reply-O,T).  
  131
  132
  133req(exec(Cmd),exec(Cmd),_) :- !.
  134req(eval(Expr,Rets),eval(Expr,Types,Vals),Vals) :-
  135   maplist(leftval,Rets,Types,Vals), !.
  136req(R,_,_) :- throw(invalid_mlserver_request(R)).
 ml_request(+Req, ?Reply, +Timeout) is det
Send a request to Matlab server thread. When complete, the Reply term is sent back to this thread. Request can be:

Reply can be any term, possibly sharing variables with Req. This is used to pick out which valuesfrom an eval(_,_,_) request are returned. NB the mutex ensures that if we have to interrupt due to timeout, then we only interrupt our own Matlab computation, not some other one.

  151ml_request(Req,Reply,Timeout) :- 
  152   gensym(ml,ID), 
  153   with_mutex(mlclient,ml_request(ID,Req,Reply,Timeout)).
  154
  155ml_request(ID,Req,Reply,Timeout) :-
  156	thread_self(Self),
  157   (current_matlab_thread(Matlab,_) -> true; throw(matlab_not_running)),
  158   debug(mlserver(client),'Sending request ~w: ~W.',[ID,Req,[max_depth(8)]]),
  159   setup_call_catcher_cleanup(
  160      thread_send_message(Matlab,req(Self,ID,Req,Reply)),
  161      (  thread_get_message(Self,resp(ID,Status,Reply),[timeout(Timeout)])
  162      ;  throw(abort(timeout))
  163      ),
  164      exception(abort(Reason)),
  165      interrupt_cleanup(Reason,ID)
  166   ), !,
  167   debug(mlserver(client),'Got response ~w: ~w.',[ID,Status]),
  168   memo:reflect(Status).
  169
  170interrupt_cleanup(Reason,ID) :-
  171   debug(mlserver(client),'request (~w) interrupted due to: ~w.',[ID,Reason]),
  172   ml_interrupt,
  173   thread_get_message(resp(ID,Status,_)),
  174   debug(mlserver(client),'request (~w) got post-~w response: ~w.',[ID,Reason,Status]).
 ml_interrupt is det
Sends a SIGINT (interrupt) signal to the Matlab process.
  178ml_interrupt :-
  179   debug(mlserver(client),'Interrupting MATLAB.',[]),
  180   (current_matlab_thread(_,PID) -> true; throw(matlab_not_running)),
  181   process_kill(PID,int)