yap-6.3/pl/os.yap

 /*************************************************************************
 *									 *
 *	 YAP Prolog 							 *
 *									 *
 *	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
 *									 *
 * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
 *									 *
 *************************************************************************/


:- system_module( '$os', [
	       cd/0,
	       cd/1,
	       getcwd/1,
	       ls/0,
	       pwd/0,
	       unix/1,
	       putenv/2,
	       getenv/2,
	       setenv/2
	 ], [] ).
:- use_system_module( '$_errors', ['$do_error'/2]).

%% @{

/**
@defgroup YAPOS Access to Operating System Functionality
@ingroup builtins

The following built-in predicates allow access to underlying
Operating System functionality.

 */

/** @pred  cd

Changes the current directory (on UNIX environments) to the user's home directory.


*/
cd :-
	cd('~').

/** @pred  cd(+ _D_)


Changes the current directory (on UNIX environments).


*/
cd(F) :-
      absolute_file_name(F, Dir, [file_type(directory),file_errors(fail),access(execute),expand(true)]),
      working_directory(_, Dir).

/** @pred  getcwd(- _D_)


Unify the current directory, represented as an atom, with the argument
 _D_.


*/
getcwd(Dir) :- working_directory(Dir, Dir).

/** @pred  ls


Prints a list of all files in the current directory.


*/
ls :-
	getcwd(X),
	'$load_system_ls'(X,L),
	'$do_print_files'(L).

'$load_system_ls'(X,L) :-
	'$undefined'(directory_files(X, L), system),
	load_files(library(system),[silent(true)]),
	fail.
'$load_system_ls'(X,L) :-
	system:directory_files(X, L).


'$do_print_files'([]) :-
	nl.
'$do_print_files'([F| Fs]) :-
	'$do_print_file'(F),
	'$do_print_files'(Fs).

'$do_print_file'('.') :- !.
'$do_print_file'('..') :- !.
'$do_print_file'(F) :- atom_concat('.', _, F), !.
'$do_print_file'(F) :-
	write(F), write('  ').

/** @pred  pwd


Prints the current directory.


*/
pwd :-
	getcwd(X),
	write(X), nl.

/** @pred  unix(+ _S_)


Access to Unix-like functionality:

+ argv/1
Return a list of arguments to the program. These are the arguments that
follow a `--`, as in the usual Unix convention.
+ cd/0
Change to home directory.
+ cd/1
Change to given directory. Acceptable directory names are strings or
atoms.
+ environ/2
If the first argument is an atom, unify the second argument with the
value of the corresponding environment variable.
+ getcwd/1
Unify the first argument with an atom representing the current directory.
+ putenv/2
Set environment variable  _E_ to the value  _S_. If the
environment variable  _E_ does not exist, create a new one. Both the
environment variable and the value must be atoms.
+ shell/1
Execute command under current shell. Acceptable commands are strings or
atoms.
+ system/1
Execute command with `/bin/sh`. Acceptable commands are strings or
atoms.
+ shell/0
Execute a new shell.



*/
unix(V) :- var(V), !,
	'$do_error'(instantiation_error,unix(V)).
unix(argv(L)) :-
	current_prolog_flag(argv, L).
unix(cd) :- cd('~').
unix(cd(A)) :- cd(A).
unix(environ(X,Y)) :- '$do_environ'(X,Y).
unix(getcwd(X)) :- getcwd(X).
unix(shell(V)) :- var(V), !,
	'$do_error'(instantiation_error,unix(shell(V))).
unix(shell(A)) :- atom(A), !, '$shell'(A).
unix(shell(A)) :- string(A), !, '$shell'(A).
unix(shell(V)) :-
	'$do_error'(type_error(atomic,V),unix(shell(V))).
unix(system(V)) :- var(V), !,
	'$do_error'(instantiation_error,unix(system(V))).
unix(system(A)) :- atom(A), !, system(A).
unix(system(A)) :- string(A), !, system(A).
unix(system(V)) :-
	'$do_error'(type_error(atom,V),unix(system(V))).
unix(shell) :- sh.
unix(putenv(X,Y)) :- '$putenv'(X,Y).


'$is_list_of_atoms'(V,_) :- var(V),!.
'$is_list_of_atoms'([],_) :- !.
'$is_list_of_atoms'([H|L],L0) :- !,
	'$check_if_head_may_be_atom'(H,L0),
	'$is_list_of_atoms'(L,L0).
'$is_list_of_atoms'(H,L0) :-
	'$do_error'(type_error(list,H),unix(argv(L0))).

'$check_if_head_may_be_atom'(H,_) :-
	var(H), !.
'$check_if_head_may_be_atom'(H,_) :-
	atom(H), !.
'$check_if_head_may_be_atom'(H,L0) :-
	'$do_error'(type_error(atom,H),unix(argv(L0))).


'$do_environ'(X, Y) :-
	var(X), !,
	'$do_error'(instantiation_error,unix(environ(X,Y))).
'$do_environ'(X, Y) :- atom(X), !,
	'$getenv'(X,Y).
'$do_environ'(X, Y) :-
	'$do_error'(type_error(atom,X),unix(environ(X,Y))).


/** @pred  putenv(+ _E_,+ _S_)


Set environment variable  _E_ to the value  _S_. If the
environment variable  _E_ does not exist, create a new one. Both the
environment variable and the value must be atoms.


*/
putenv(Na,Val) :-
	'$putenv'(Na,Val).

getenv(Na,Val) :-
	'$getenv'(Na,Val).

/** @pred setenv(+ _Name_,+ _Value_)


Set environment variable.   _Name_ and  _Value_ should be
instantiated to atoms or integers.  The environment variable will be
passed to `shell/[0-2]` and can be requested using `getenv/2`.
They also influence expand_file_name/2.


*/
setenv(Na,Val) :-
	'$putenv'(Na,Val).

/**
@}
*/