1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2% 3% FILE : lib/eclipse_swi.pl 4% 5% ECLIPSE Compatibility library for SWI Prolog 6% (i.e., simulates several ECLIPSE goals in SWI) 7% 8% AUTHOR : Sebastian Sardina (2003) 9% EMAIL : ssardina@cs.toronto.edu 10% WWW : www.cs.toronto.edu/~ssardina 11% TYPE : system independent code 12% TESTED : SWI Prolog 5.0.10 http://www.swi-prolog.org 13% 14% 15%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 16% 17% DESCRIPTION : This package provides some compatibility with ECLIPSE 18% Prolog (http://www.icparc.ic.ac.uk/eclipse/). 19% 20% To load this library: 21% 22% :- use_module(eclipse_swi). % Load compatibility library with ECLIPSE 23% :- init_eclipse_lib. % Perform required replacements 24% 25% 26% The tools are divided in the following groups: 27% 28% 1 - Tools for managing sockets and streams 29% 2 - Tools for strings 30% 3 - Operating system tools 31% 4 - Other tools 32%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 33:- module(eclipse_swi,[ 34 init_eclipse_lib/0, 35 % 1 - SOCKETS AND STREAMS 36 socket/3, % +internet, +stream, ?SocketId 37 bind/2, % +SocketId, +Host/+Port 38 listen/2, % +SocketId, +Num 39 accept/3, % +SocketId, -From, ?Stream 40 connect/2, % +SocketId, +Host/+Port 41 get_socket_stream/3, 42 % 43 eclipse_read/2, 44 eclipse_write/2, 45 eclipse_read_term/3, 46 eclipse_write_term/3, 47 eclipse_close/1, % +SocketId 48 eclipse_nl/1, % +SocketId 49 eclipse_flush/1, % +SocketId 50 eclipse_select/3, % +StreamList, +Timeout, ?ReadyStreams 51 % 2 - STRINGS 52 concat_strings/3, 53 concat_string/2, 54 substring/3, 55 substring/4, 56 substring/5, % Equivalent to sub_string/5 for SWI 57 read_string/4, 58 term_string/2, 59 number_string/2, 60 split_string/4, 61 join_string/3, 62 % 3 - OS TOOLS 63 exec/2, 64 exec/3, 65 exec_group/3, 66 set_interrupt_handler/2, 67 current_interrupt/2, 68 get_interrupt_handler/3, 69 stime/1, 70 cputime/1, 71 % 4 - OTHER TOOLS 72 shuffle/2, 73 false/0, 74 type_of/2, 75 writeln/2, 76 flush/1, 77 argv/2, 78 argc/1, 79 min/2, % Minimum of a list 80 max/2 % Maximum of a list 81 ]). 82 83 84% This utility will replace every call to read/2, write/2, etc. by their 85% corresponding ECLIPSE versions eclipse_read/2, eclipse_write/2, etc. 86:- module_transparent init_eclipse_lib/0. 87init_eclipse_lib :- 88 context_module(M), 89 assert(M:goal_expansion(read(A1,A2), eclipse_read(A1,A2))), 90 assert(M:goal_expansion(write(A1,A2), eclipse_write(A1,A2))), 91 assert(M:goal_expansion(stream_select(A1,A2,A3), eclipse_select(A1,A2,A3))), 92 assert(M:goal_expansion(read_term(S,T,O), eclipse_read_term(S,T,O))), 93 assert(M:goal_expansion(write_term(S,T,O), eclipse_write_term(S,T,O))), 94 assert(M:goal_expansion(close(A1), eclipse_close(A1))), 95 assert(M:goal_expansion(flush(A1), eclipse_flush(A1))), 96 assert(M:goal_expansion(nl(A1), eclipse_nl(A1))). 97 98 99% NOTE: Library streampool is required to help providing support for 100% sigio(stream) capabilities in exec/3 and accept/3 predicates. 101:- use_module(streampool). 102:- use_module(library(socket)). % Load socket library (e.g., tcp_socket/1) 103%:- use_module(library(unix)). % Load unix library library (e.g., fork/1) 104 105 106 107%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 108%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 109% 1 - SOCKETS AND STREAMS 110% 111% In SWI a socket has 2 different streams associated, one 112% for reading and one for writing. In ECLIPSE, the stream associated with 113% a stocket can be used for input and output. 114% 115% -- socket(+Domain, +Type, ?SockStream) 116% Creates a socket of a given type and domain and associates a stream 117% with it. SO FAR ONLY IMPLEMENTED DOMAIN:internet, TYPE:stream 118% 119% -- bind(+SockStream, ?Address) 120% Associates an address with a given socket stream. 121% 122% -- listen(+SockStream, +Queue) 123% Specifies how many connections are accepted for a socket and 124% makes connections available. 125% 126% -- accept(+SockStream, ?From, ?NewStream) 127% Accepts a connection for a stream socket and creates a new 128% socket which can be used for I/O. 129% 130% -- connect(+SockStream, +Address) 131% Connects a socket with the given address. 132% 133% -- get_socket_stream(+SockStream, +Mode, -Stream) 134% Retrives the input and output streams associated with SockStream 135% Mode can be either "read" or "write" 136% 137% The main difference with ECLIPSE Prolog is taht SockStream is actually not 138% a real stream. Therefore, predicates like read/2, write/2, etc cannot be 139% used directly. 140%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 141 142 143% Stores info about sockets: 144% socket_info(SocketId, SocketCode, ReadStream, WriteStream) 145% SocketId is actually a wrapper to refer to a pair of streams since SocketId 146% is actually *not* a stream id, it should not be treated as that. 147:- dynamic socket_info/4. 148 149% Creates a socket of a given type and domain and associates a stream with it. 150% SWI does not return a stream but the socket ID so socket_info/4 implements 151% tha mapping between the socket's id and the socket's streams 152socket(internet, stream, SocketId) :- 153 % Check socket does not exist yet 154 (atom(SocketId) -> \+ socket_info(SocketId, _, _, _) ; true), 155 % Create new socket S 156 tcp_socket(S), % S of the form '$socket'(274326) 157 (atom(SocketId) -> true ; S =.. [_, SocketId]), 158 % Enter a socket_info/4 entry for new socket 159 assert(socket_info(SocketId, S, null, null)). 160 161% Associates an address with a given socket stream. 162% OBS: This bind/2 needs to be given an available fix address! 163bind(SocketId, _/Port) :- 164 retract(socket_info(SocketId, S, _, _)), 165 % (number(Port) -> true ; get_free_port(Port)), % Not yet done 166 tcp_bind(S, Port), 167 % 168 tcp_open_socket(S, R, _), % No Write Stream here 169 assert(socket_info(SocketId, S, R, null)). 170 171 172% Specifies how many connections are accepted for a socket and makes 173% connections available. 174listen(SocketId, N) :- 175 socket_info(SocketId, S, _, _), 176 tcp_listen(S, N). 177 178 179 180% accept/3: 181% Accepts a connection for a stream socket and creates a new socket which can be used for I/O. 182accept(SocketId, From, NewSock) :- % Handle the case for sigio(S) 183 \+ var(NewSock), NewSock = sigio(SocketId2), !, 184 accept(SocketId, From, SocketId2), 185 retract(socket_info(SocketId2, S, R, W)), 186 register_stream_sigio(R, R2), % Register SocketId2 for IO signal 187 assert(socket_info(SocketId2, S, R2, W)). 188 189 190% Socket is new & Read/Write Streams are still null 191accept(SocketId, Host/unknown, NewSocketId2) :- 192 retract(socket_info(SocketId, S, null, null)), !, 193 (ground(NewSocketId2) -> \+ socket_info(NewSocketId2, _, _, _) ; true), 194 % 195 tcp_open_socket(S, R, _), 196 assert(socket_info(SocketId, S, R, null)), 197 % 198 tcp_accept(R, S2, Host), 199 tcp_open_socket(S2, ReadS, WriteS), 200 (ground(NewSocketId2) -> 201 true 202 ; % Write socket has no alias 203 S2 =.. [_, NewSocketId2] % because S2= 'socket'(NewSocketId2) 204 ), 205 assert(socket_info(NewSocketId2, S2, ReadS, WriteS)). 206 207% Socket is just new but Read stream is not null 208accept(SocketId, Host/unknown, NewSocketId2) :- 209 socket_info(SocketId, _, R, _), 210 R\=null, 211 % 212 tcp_accept(R, S2, Host), 213 tcp_open_socket(S2, ReadS, WriteS), 214 (ground(NewSocketId2) -> 215 true ; 216 S2 =.. [_, NewSocketId2] 217 ), 218 assert(socket_info(NewSocketId2, S2, ReadS, WriteS)). 219 220 221 222 223% Connects a socket with the given address. 224connect(SocketId, Host/Port) :- 225 socket_info(SocketId, S, _, _), 226 tcp_connect(S, Host:Port), 227 tcp_open_socket(S, R, W), 228 retract(socket_info(SocketId, S, _, _)), 229 assert(socket_info(SocketId, S, R, W)). 230 231 232 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 233 % EXTRA PREDICATES TO DEAL WITH SOCKETS % 234 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 235 236% get_socket_stream/3 237% Retrives the input/output stream associated to a Socket (works in 2-ways) 238% socket_info(SocketId, SocketCode, ReadStream, WriteStream) 239get_socket_stream(SocketId, read, Stream) :- 240 socket_info(SocketId, _, Stream, _). 241get_socket_stream(SocketId, write, Stream) :- 242 socket_info(SocketId, _, _, Stream). 243 244% get_real_streams(StreamList, Type, StreamList2) 245% StreamList2 is StreamList with all Socket streams replaced 246% correspondingly by their stream's Type (works in 2-ways) 247get_real_streams([], _, []). 248get_real_streams([S|StreamList], Type, [RS|RealStreamList]) :- 249 get_socket_stream(S, Type, RS), !, % S is a socket! 250 get_real_streams(StreamList, Type, RealStreamList). 251get_real_streams([S|StreamList], Type, [S|RealStreamList]) :- 252 get_real_streams(StreamList, Type, RealStreamList). % S is not a socket! 253 254% Is S a socket stream? 255is_socket(S) :- socket_info(S, _, _, _). 256 257 258 259eclipse_read(S, T) :- 260 get_real_streams([S], read, [RS]), 261 read(RS, T). 262eclipse_write(S, T) :- 263 get_real_streams([S], write, [RS]), 264 write(RS, T). 265 266eclipse_close(S) :- 267 is_socket(S) -> close_socket(S) ; close(S). 268close_socket(SocketId) :- 269 retract(socket_info(SocketId, S, R, W)), 270 % unregister_stream_sigio(R, R2), % UnRegister SocketId2 for IO signal 271 (R == null -> true ; close(R)), 272 (W == null -> true ; close(W)), 273 catch(tcp_close_socket(S),_,true). 274 275eclipse_flush(S) :- 276 get_real_streams([S], write, [RS]), 277 flush_output(RS). 278eclipse_nl(S) :- 279 get_real_streams([S], write, [RS]), 280 nl(RS). 281 282eclipse_write_term(S, T, O) :- 283 get_real_streams([S], write, [RS]), 284 write_term(RS, T, O). 285 286eclipse_read_term(S, T, O) :- 287 get_real_streams([S], read, [RS]), 288 read_term(RS, T, [double_quotes(string)|O]). 289 290% -- stream_select(+StreamList, +Timeout, ?ReadyStreams) 291% Returns streams from StreamList which are ready for I/O, blocking 292% at most Timeout seconds. 293stream_select(StreamList, TimeOut, ReadyList) :- 294 eclipse_select(StreamList, TimeOut, ReadyList). 295eclipse_select(StreamList, TimeOut, ReadyList) :- 296 get_real_streams(StreamList, read, RealStreamList), 297 select_stream(RealStreamList, TimeOut, ReadyListStreams), 298 get_real_streams(ReadyList, read, ReadyListStreams). 299 300select_stream(StreamList, block, ReadyList) :- !, % block 301 wait_for_input(StreamList, ReadyList, 0). 302select_stream(StreamList, 0, ReadyList) :- !, % wait almost nothing 303 wait_for_input(StreamList, ReadyList, 0.000000000000001). 304select_stream(StreamList, TimeOut, ReadyList) :- % wait TimeOut seconds 305 wait_for_input(StreamList, ReadyList, TimeOut). 306 307 308%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 309%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 310% 2 - STRINGS 311% 312% -- concat_strings(+Src1, +Src2, ?Dest) 313% Succeeds if Dest is the concatenation of Src1 and Src2. 314% -- concat_string(+List, ?Dest) 315% Succeeds if Dest is the concatenation of the atomic terms 316% contained in List. 317% 318% -- substring(+String1, +String2, ?Position) 319% Succeeds if String2 is a substring of String1 beginning at 320% position Position. 321% -- substring(+String1, ?Position, ?Length, ?String2) 322% Succeeds if String2 is the substring of String1 starting at 323% position Position and of length Length. 324% -- substring(+String, ?Before, ?Length, ?After, ?SubString) 325% Succeeds if String2 is a substring of String, with length Length, 326% preceded by Before, and followed by After characters 327% 328% -- split_string(+String, +SepChars, +PadChars, ?SubStrings) 329% Decompose String into SubStrings according to separators SepChars 330% and padding characters PadChars. 331% -- join_string(+List, +Glue, ?String) 332% String is the string formed by concatenating the elements of 333% List with an instance of Glue beween each of them. 334% 335% 336% -- number_string(?Number, ?String) 337% -- term_string(?Term, ?String) 338%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 339%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 340 341% concat_strings/3: concatenate two strings 342concat_strings(String1, String2, String3):- 343 string_concat(String1, String2, String3). 344 345% concat_string/2 : concatenate a list of strings 346concat_string([], EmptyString):- string_to_list(EmptyString,[]). 347concat_string([String1|RS], String3):- 348 concat_string(RS, RSString2), 349 concat_strings(String1, RSString2, String3). 350 351 352% substring/3: Sub is the substring of String that starts in position Start 353% substring/4: Sub is the substring of String that starts in position Start 354% with a length of Length 355substring(String, SubString, Pos) :- substring(String, Pos, _, SubString). 356substring(String, Start, Length, SubString):- 357 var(SubString), !, 358 sub_string(String, Start, Length, _, SubString). 359substring(String, Start, Length, Sub):- 360 string_length(String, LString), 361 LString\=0, 362 string_to_atom(Sub, SubAtom), 363 sub_string(String, Start, Length, _, SubAtom). 364 365substring(String, Before, Length, After, SubString) :- 366 sub_string(String, Before, Length, After, SubString). 367 368 369% read_string/3: read_string(+Delimiters, ?Length, ?String) 370% read_string/4: read_string(+Stream, +Delimiters, ?Length, ?String) 371% 372% Reads a string from the stream Stream up to a delimiter or up to a specified length. 373% 374% If L is ground, it will be ignored as everything will be read from Stream 375% If delimeters are used, it may take a long time to read if the string is long 376 377% read_string(+Delimiter, ?Length, ?String) 378read_string(Del, L, String) :- 379 seeing(X), % Get *current* user-input stream 380 read_string(X, Del, L, String). 381 382% read_string/4: when Delimiters=end_of_line 383read_string(Stream, end_of_line, L, S) :- !, 384 get_real_streams([Stream], read, [RStream]), % Stream may be a socket 385 read_line_to_codes(RStream, Codes), 386 ( (var(L), is_list(Codes)) -> length(Codes, L) ; true), 387 string_to_list(S, Codes). 388 389% read_string/4: when Delimiters=end_of_file 390read_string(Stream, end_of_file, L, S) :- !, 391 get_real_streams([Stream], read, [RStream]), % Stream may be a socket 392 read_stream_to_codes(RStream, Codes), 393 Codes\=[], 394 ( (var(L), is_list(Codes)) -> length(Codes, L) ; true), 395 string_to_list(S, Codes). 396 397% read_string/4: when Delimiters is something else, that is, a string with delimiters 398read_string(Stream, Del, L, String) :- 399 get_real_streams([Stream], read, [RStream]), % Stream may be a socket 400 string_to_list(Del, LCharDel), 401 emptyString(EmptyString), 402 read_string2(RStream, LCharDel, L, 0, EmptyString, String), 403 \+ emptyString(String). 404 405% read_string2(Stream, Delim, L, CL, StringNow, FinalString) 406% L is the final length, CL is the current length 407% StringNow is the string read so far, FinalString is the final string 408read_string2(_, _, L, CL, StringNow, StringNow) :- L==CL, !. 409read_string2(Stream, LCharDel, L, CL, StringNow, FinalString) :- 410 wait_for_input([Stream], [Stream], 0), % Block till something in Stream 411 get_code(Stream, CharCode), % Get one char from stream 412 (member(CharCode, [-1|LCharDel]) -> 413 FinalString=StringNow, % Finalize: delimeter or end of file found 414 (var(L) -> L=CL ; true) 415 ; 416 CL2 is CL+1, 417 string_to_list(String, [CharCode]), 418 string_concat(StringNow, String, NewStringNow), 419 read_string2(Stream, LCharDel, L, CL2, NewStringNow, FinalString) 420 ). 421 422 423 424 425 426 427% split_string/4 428% Decompose String into SubStrings according to separators SepChars and 429% padding characters PadChars. 430% (This implementation should work in any other Prolog) 431split_string(String, SepChars, PadChars, SubStrings):- 432 string_to_list(SepChars, LSepChars), 433 % Find all the start positions of separators in the string 434 findall(Start, (substring(String, Start, 1, Sep), 435 string_to_list(Sep, [SepChar]), 436 member(SepChar, LSepChars)), ListStarts), 437 string_length(String, StringLength), 438 append(ListStarts,[StringLength], NListStarts), 439 divide_string(String, [-1|NListStarts], SubStrings2), 440 findall(S2, (member(S, SubStrings2), 441 remove_pad(S, PadChars, S2)), SubStrings). 442 443% join_string(+List, +Glue, -String): 444% String is the string formed by concatenating the elements of List with 445% an instance of Glue beween each of them. 446join_string([], _, String) :- !, 447 string_to_list(String,[]). 448join_string([E|R], Glue, String) :- 449% any_to_string(E, SE), 450 string_concat(E, '', SE), % Convert anything into a string 451 join_string(R, Glue, StringR), 452 string_length(StringR, LStringR), 453 (LStringR=0 -> concat_string([SE, StringR], String) ; 454 concat_string([SE, Glue, StringR], String)). 455 456 457 458 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 459 % CONVERSION TOOLS FOR STRINGS % 460 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 461 462% term_string/2: conversion between terms and strings 463term_string(S, T) :- 464 ground(S), 465 string_to_atom(S, A), 466 term_to_atom(T, A). 467term_string(S, T) :- 468 ground(T), 469 term_to_atom(T, A), 470 string_to_atom(S, A). 471 472% number_string/2: conversion between numbers and strings 473number_string(N, S):- 474 ground(N), 475 number_chars(N, L), 476 string_to_list(S, L). 477number_string(N, S) :- 478 ground(S), 479 string_to_atom(S, A), 480 atom_codes(A, CA), 481 number_codes(N, CA). 482 483 484 485 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 486 % IMPLEMENTATION DETAILS for STINGS % 487 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 488 489% divide_string(+String, +ListStarts, -LStrings) 490% String: string / ListStarts: list numbers / LStrings : List of strings 491% Decompose String into SubStrings according to separator locations 492% in ListStarts 493% padding characters PadChars. 494divide_string(_, [_], []). 495divide_string(String, [S,E|Rest], [FString|RString]) :- 496 S2 is S+1, 497 E2 is E-S-1, 498 substring(String, S2, E2, FString), 499 divide_string(String, [E|Rest], RString). 500 501 502% remove_pad(+String, +PadChars, -StringsNoPad) : 503% String, PadChars, StringNoPad: strings 504% remove any char in LPadChars appearing in the front or 505% at the end of string String 506% 507remove_pad(String, PadChars, StringsNoPad) :- 508 string_to_list(PadChars, LPadChars), 509 string_to_list(String, LString), 510 remove_front(LString, LPadChars, LString2), 511 reverse(LString2, RLString2), 512 remove_front(RLString2, LPadChars, RLStringsNoPad), 513 reverse(RLStringsNoPad, LStringsNoPad), 514 string_to_list(StringsNoPad, LStringsNoPad). 515 516 517% remove_front(+LString, +LPadChars, -LString) : 518% LString, LPadChars, LString : List of chars 519% remove any char in LPadChars appearing in the front of LString 520% 521remove_front([], _, []) :- !. 522remove_front(LString, LPadChars, LString) :- 523 LString=[C|_], \+ member(C, LPadChars), !. 524remove_front([_|LString], LPadChars, LString2) :- 525 remove_front(LString, LPadChars, LString2). 526 527 528 529% Replace one element for anotherone in a list of elements 530replace_element_list([],_,_,[]). 531replace_element_list([CE1|R],CE1,CE2,[CE2|RR]):- !, 532 replace_element_list(R,CE1,CE2,RR). 533replace_element_list([E|R],CE1,CE2,[E|RR]):- 534 replace_element_list(R,CE1,CE2,RR). 535 536 537 538%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 539%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 540% 3 - OPERATING SYSTEM TOOLS 541% 542% -- cputime(?Time) 543% -- stime(?Time) 544% Succeeds if Time is the elapsed user cpu time in seconds. 545% 546% Management of interrupts/signals as ECLIPSE does: 547% 548% -- set_interrupt_handler/2 549% -- current_interrupt/2 550% -- get_interrupt_handler/3 551% 552% Operating system EXEC utilities:from ECLIPSE 553% 554% -- exec(+Command, ?Streams) 555% A child process Command is forked, its standard streams are 556% connected to Streams and the ECLiPSe process waits until it terminates. 557% 558% -- exec(+Command, ?Streams, -Pid) 559% A child process Command is forked, its standard streams are 560% connected to Streams and its process ID is Pid. 561% 562% Description (adapted from ECLIPSE manual) 563% 564% This predicate is used to fork a child process and to set up pipes to its 565% standard streams. After the process is forked, execution continues normally, 566% without waiting for the child to terminate. 567% 568% By specifying the Streams argument it is possible to connect to the 569% process' standard streams. The form of 570% Streams is [Stdin, Stdout, Stderr]. Stderr is ignored in the current 571% implementation. 572% If some of these streams are specified and 573% not null, a pipe is opened which connects the standard stream of the child 574% process with the specified stream, e.g. Stdin must be an output stream 575% because it is connected to the standard input of the child process. 576% Specifying a null stream means that no pipe is set up for this stream. 577% 578% Stdout can also be specified as sigio(Stream) (BSD systems only). In this 579% case a pipe is set up to the stream Stream and in addition the pipe is 580% instructed to send the signal io each time new data appears in it. In this way 581% the two processes can communicate in a truly asynchronous way. When one 582% process sends data to the other one, the interrupt handler is invoked and it 583% can read and process the data. When it finishes, it can continue where it was 584% interrupted. 585% 586% If one wants to run a command with the shell, use: sh('-c', Command) 587% 588% After forking the process, Pid is unified with its process ID, which can be 589% used e.g. in wait/2 or kill/2. If the exec system call in the child process 590% failed, the child exits with status 128 + errno. 591% 592% -- exec_group(+Command, ?Streams, ?Pid) 593% A child process Command is forked in a new process group, its 594% standard streams are connected to Streams and its process ID is Pid. 595% (NOTE: currently, equivalent to exec/3) 596% 597% 598% -- system(+ShellCommand) 599% -- sh(+ShellCommand) 600% The string or atom ShellCommand is passed as a command to the 601% operating system, and the command is executed there 602%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 603%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 604 605% Returns the CPU time 606stime(T) :- T is cputime. 607cputime(T) :- T is cputime. % ECLIPSE compatibility 608 609% Interrupts managements in the way ECLIPSE does 610set_interrupt_handler(Signal, default/0) :- !, on_signal(Signal, _, default). 611set_interrupt_handler(Signal, event/1) :- !, on_signal(Signal, _, throw). 612set_interrupt_handler(Signal, N/0) :- on_signal(Signal, _, N). 613current_interrupt(Id, Name) :- current_signal(Name, Id, _). 614get_interrupt_handler(IntId, PredSpec, _) :- current_signal(_, IntId, PredSpec). 615 616 617% Implementation of exec/2, exec/3 and exec_group/3 (Compat with ECLIPSE) 618% 619% A child process Command is forked. Its standard streams are connected to 620% [StdIn, StdOut, _] and its process ID is Pid. 621% (This is a partial implementation of ECLIPSE exec_group/3) 622% Differences: does not run Command in a different process group and it 623% does not set the error channel 624 625% A - exec_group/3 626exec_group(C, S, P) :- exec(C, S, P). % For now I cannot separate the child 627 628% B - exec/2 629exec(Command, Streams) :- 630 exec(Command, Streams, Pid), 631 wait(Pid, _). 632 633% C - exec/3 634exec(Command, [], P) :- 635 exec(Command, [null, null, null], P). 636exec(Command, [ServerOut], P) :- 637 exec(Command, [ServerOut, null, null], P), 638 wait(P, _). 639exec(Command, [ServerOut, ServerIn], P) :- 640 exec(Command, [ServerOut, ServerIn, null], P). 641 642% Handle the case for sigio(S) 643exec(Command, [ServerOut, SIn, _], Pid) :- 644 \+ var(SIn), SIn = sigio(ServerIn), !, 645 exec(Command, [ServerOut, ServerIn2, _], Pid), 646 register_stream_sigio(ServerIn2, ServerIn3), 647 register_stream_name(ServerIn3, ServerIn). 648 649 650exec(sh('-c', What), SERVIO, PID):-current_prolog_flag(windows,true), 651 (atomic(What)->string_concat("/usr/bin/xterm -e /usr/bin/swipl",Rest,What);,),!,win_fork(Rest,SERVIO,PID). 652 653 654% Handle the general case 655exec(Command, [ServerOut, ServerIn, _], Pid) :- 656 (ServerOut== null -> true ; 657 pipe(CGIIn, ServerOut2), 658 register_stream_name(ServerOut2, ServerOut)), 659 (ServerIn == null -> true ; 660 pipe(ServerIn2, CGIOut), 661 register_stream_name(ServerIn2, ServerIn)), 662 fork(Pid), 663 ( Pid == child, 664 % detach_IO % may this work to detach the child ? 665 (ServerOut == null -> true ; (close(ServerOut), 666 dup(CGIIn, 0), % stdin 667 close(CGIIn))), 668 (ServerIn == null -> true ; (close(ServerIn), 669 dup(CGIOut, 1), % stdout 670 close(CGIOut))), 671% exec('/bin/sh '('-c', Command)) 672 exec(Command) 673 ; 674 (ServerOut == null -> true ; close(CGIIn)), 675 (ServerIn == null -> true ; close(CGIOut)) 676 ). 677 678 679system(ShellCommand) :- shell(ShellCommand). 680sh(ShellCommand) :- shell(ShellCommand). 681 682 683 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 684 % IMPLEMENTATION of SIGIO CAPABILITIES % 685 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 686 687:- dynamic sigio/3. % Stores streams that we are watching for IO 688 % (Source, Intermediate, Destination) 689 690register_stream_sigio(Stream1, Stream2) :- 691 pipe(Stream2, W), 692 assert(sigio(Stream1, W, Stream2)), 693 (current_thread(stream_pool_main_loop, _) -> 694 delete_stream_from_pool(Stream1), % just in case... 695 add_stream_to_pool(Stream1, sigio_action(signal)) 696 ; 697 add_stream_to_pool(Stream1, sigio_action(signal)), 698 thread_create(stream_pool_main_loop, _, [detached(true)])). 699 700unregister_stream_sigio(Stream) :- 701% sigio(Stream, _, _), % Check stream is being watched 702 %delete_stream_from_pool(Stream), 703 %add_stream_to_pool(Stream, sigio_action(justcopy)), 704 retract(sigio(Stream, W, _)), 705 close(Stream), % No use any more, no more data arriving to Stream 706 close(W). % Intermediate step not use anymore 707 708 709register_stream_name(_, Name) :- Name==user, !. 710register_stream_name(Stream, Name) :- atom(Name), !, 711 set_stream(Stream, alias(Name)). 712register_stream_name(Stream, Stream). 713 714 715sigio_action(T) :- 716 findall(S, sigio(S,_,_), LS), 717 wait_for_input(LS, [RS|_], 0), 718 (at_end_of_stream(RS) -> % Original read stream is EOF? 719 unregister_stream_sigio(RS) % Then 720 ; 721 sigio(RS, W, _), % Retrive intermediate stream W 722 copy_pipe(RS, W), % Copy from RS ----> W 723 (T == signal -> 724 current_prolog_flag(pid, Pid), 725 current_signal(io, IdSignal, _), 726 kill(Pid, IdSignal) 727 ; 728 true) 729 ). 730 731% Copy all current data in input-pipe-stream In to output-pipe-stream Out 732copy_pipe(In, Out) :- 733 wait_for_input([In],[],0.0000000001), !, % Nothing more on In 734 flush_output(Out). % Everything has been copied 735copy_pipe(In, Out) :- 736 get_char(In, CharCode), % Get one char from stream 737 (CharCode=(-1) -> 738 true 739 ; 740 write(Out, CharCode) 741 ), 742 copy_pipe(In, Out). 743 744 745%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 746%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 747% 4 - OTHER TOOLS 748% 749% -- false 750% Does not succeed (synonym of fail/0). 751% 752% -- type_of(?Term, ?Type) 753% Succeeds if Type is the data type of the term Term. 754% The types are atoms from the set: string, atom, var, integer, 755% float, compound. The rest ECLIPSE types are *not* supported. 756% 757% -- writeln(+Stream, ?Term) 758% The term Term is written on the output stream Stream according to 759% the current operator declarations. 760% 761% -- flush(+Stream) 762% Flushes the output stream Stream. 763% 764% -- argc(?Number) 765% Succeeds if Number is the number of arguments given on the command 766% -- argv(+N, ?Argument) 767% Succeeds if the Nth argument given on the command line when 768% invoking ECLiPSe is the string Argument. 769%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 770%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 771 772% false/0 is an alias for fail 773 774% :-ignore(( not(user:prolog_type(swi)), assert(false:- fail))). 775 776% X is of type TX 777type_of(X, TX):- 778 var(X) -> TX = var ; 779 integer(X) -> TX = integer ; 780 float(X) -> TX = float ; 781 atom(X) -> TX = atom ; 782 string(X) -> TX = string ; 783 atomic(X) -> TX = atomic ; 784 compound(X) -> TX = compound. 785 786% writeln/2, flush/1 are not provided in SWI 787writeln(Stream, T) :- write(Stream, T), nl(Stream). 788flush(Stream) :- flush_output(Stream). 789 790% Succeeds if N is the number of arguments given on the command line to 791% invoke Prolog . 792argc(N) :- 793 current_prolog_flag(argv, L), 794 length(L,N2), 795 N is N2+1. 796 797% Succeeds if the Nth argument given on the command line when invoking Prolog 798% is the string SA. 799argv(N, SA) :- 800 current_prolog_flag(argv, L), 801 nth1(N, L, A), 802 string_to_atom(SA, A). 803 804 805% min(+L,?X)/max(+L,?X) : minimum/maximum number in a list of numbers 806min([X], X). 807min([X|L], Y) :- min(L, ML), (X < ML -> Y=X, Y=ML). 808 809max([X], X). 810max([X|L], Y) :- min(L, ML), (X > ML -> Y=X, Y=ML). 811 812 813 814% shuffle(+List, -ShuffledList) : Shuffle a list, ie randomize the element order 815shuffle([],[]). 816shuffle(D,DR) :- get_random_element(W,D), 817 delete(D,W,D2), 818 shuffle(D2,DR2), DR=[W|DR2]. 819%get a random element from domain 820get_random_element(W,D) :- 821 length(D,L), 822 L>0, 823 I is random(L), 824 nth0(I,D,W). 825 826%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 827% EOF: lib/eclipse_swi.pl 828%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%