This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/pl/os.yap

224 lines
4.9 KiB
Plaintext
Raw Normal View History

2014-04-06 17:05:17 +01:00
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
*************************************************************************/
2014-09-11 20:06:57 +01:00
2014-04-24 14:24:50 +01:00
:- system_module( '$os', [
2014-04-06 17:05:17 +01:00
cd/0,
cd/1,
getcwd/1,
ls/0,
pwd/0,
unix/1,
putenv/2,
getenv/2,
setenv/2
2014-04-24 14:24:50 +01:00
], [] ).
2014-04-09 12:39:29 +01:00
:- use_system_module( '$_errors', ['$do_error'/2]).
2014-04-06 17:05:17 +01:00
2015-01-04 23:58:23 +00:00
%% @{
2014-09-11 20:06:57 +01:00
2015-01-04 23:58:23 +00:00
/** @defgroup YAPOS Access to Operating System Functionality
@ingroup builtins
2014-09-11 20:06:57 +01:00
The following built-in predicates allow access to underlying
Operating System functionality.
2014-04-06 17:05:17 +01:00
*/
2014-09-11 20:06:57 +01:00
/** @pred cd
Changes the current directory (on UNIX environments) to the user's home directory.
*/
2014-04-06 17:05:17 +01:00
cd :-
cd('~').
2014-09-11 20:06:57 +01:00
/** @pred cd(+ _D_)
Changes the current directory (on UNIX environments).
*/
2014-04-06 17:05:17 +01:00
cd(F) :-
absolute_file_name(F, Dir, [file_type(directory),file_errors(fail),access(execute),expand(true)]),
working_directory(_, Dir).
2014-09-11 20:06:57 +01:00
/** @pred getcwd(- _D_)
Unify the current directory, represented as an atom, with the argument
_D_.
*/
2014-04-06 17:05:17 +01:00
getcwd(Dir) :- working_directory(Dir, Dir).
2014-09-11 20:06:57 +01:00
/** @pred ls
Prints a list of all files in the current directory.
*/
2014-04-06 17:05:17 +01:00
ls :-
getcwd(X),
'$load_system_ls'(X,L),
'$do_print_files'(L).
'$load_system_ls'(X,L) :-
'$undefined'(directory_files(X, L), operating_system_support),
load_files(library(system),[silent(true)]),
fail.
'$load_system_ls'(X,L) :-
operating_system_support: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(' ').
2014-09-11 20:06:57 +01:00
/** @pred pwd
Prints the current directory.
*/
2014-04-06 17:05:17 +01:00
pwd :-
getcwd(X),
write(X), nl.
2014-09-11 20:06:57 +01:00
/** @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.
*/
2014-04-06 17:05:17 +01:00
unix(V) :- var(V), !,
'$do_error'(instantiation_error,unix(V)).
unix(argv(L)) :- '$is_list_of_atoms'(L,L), !, '$argv'(L).
unix(argv(V)) :-
'$do_error'(type_error(atomic,V),unix(argv(V))).
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).
2014-04-09 12:39:29 +01:00
unix(shell(A)) :- string(A), !, '$shell'(A).
2014-04-06 17:05:17 +01:00
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).
2014-04-09 12:39:29 +01:00
unix(system(A)) :- string(A), !, system(A).
2014-04-06 17:05:17 +01:00
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))).
2014-09-11 20:06:57 +01:00
/** @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.
*/
2014-04-06 17:05:17 +01:00
putenv(Na,Val) :-
'$putenv'(Na,Val).
getenv(Na,Val) :-
'$getenv'(Na,Val).
2014-09-11 20:06:57 +01:00
/** @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.
*/
2014-04-06 17:05:17 +01:00
setenv(Na,Val) :-
'$putenv'(Na,Val).
2014-09-11 20:06:57 +01:00
/**
@}
*/