check for mistypes
This commit is contained in:
Vitor Santos Costa
parent
a6c115b248
commit
cc84cd8cb5
208
pl/absf.yap
208
pl/absf.yap
@ -15,7 +15,40 @@
|
||||
* *
|
||||
*************************************************************************/
|
||||
|
||||
absolute_file_name(V,Out) :- var(V), !,
|
||||
:- module( absolute_file_name, [ absolute_file_name/2,
|
||||
absolute_file_name/3,
|
||||
'$full_filename'/3,
|
||||
'$system_library_directories'/2,
|
||||
path/1,
|
||||
add_to_path/1,
|
||||
remove_from_path/1] ).
|
||||
|
||||
/**
|
||||
*
|
||||
*
|
||||
* @mainpage Index YAP Main Page
|
||||
*
|
||||
* These are a few Prolog Built-ins
|
||||
*
|
||||
* @subsection sub:AbsFileName File Name Resolution in Prolog
|
||||
|
||||
Support for file name resolution through absolute_file_name/3 and
|
||||
friends. These utility built-ins are used by load_files/2 to search
|
||||
in the library directories. They use pre-compiled paths plus
|
||||
environment variables and registry information to search for files.
|
||||
|
||||
*/
|
||||
|
||||
:- use_module( library(lists) , [member/2] ).
|
||||
|
||||
|
||||
/**
|
||||
@predicate absolute_file_name(+<var>Name</var>:atom,+<var>Options</var>:list) is nondet
|
||||
|
||||
Converts the given file specification into an absolute path, using default options. See absolute_file_name/3 for details on the options.
|
||||
*/
|
||||
|
||||
absolute_file_name(V,Out) :- var(V), !, % absolute_file_name needs commenting.
|
||||
'$do_error'(instantiation_error, absolute_file_name(V, Out)).
|
||||
absolute_file_name(user,user) :- !.
|
||||
absolute_file_name(File0,File) :-
|
||||
@ -24,7 +57,73 @@ absolute_file_name(File0,File) :-
|
||||
'$full_filename'(F0,F,G) :-
|
||||
'$absolute_file_name'(F0,[access(read),file_type(source),file_errors(fail),solutions(first),expand(true)],F,G).
|
||||
|
||||
% fix wrong argument order, TrueFileName should be last.
|
||||
|
||||
/**
|
||||
@predicate absolute_file_name(+File:atom, +Options:list, +Path:atom) is nondet
|
||||
@predicate absolute_file_name(-File:atom, +Path:atom, +Options:list) is nondet
|
||||
|
||||
<var>Option</var> is a list of options to guide the conversion:
|
||||
|
||||
- extensions(+<var>ListOfExtensions</var>)
|
||||
|
||||
List of file-extensions to try. Default is `''`. For each
|
||||
extension, absolute_file_name/3 will first add the extension and then
|
||||
verify the conditions imposed by the other options. If the condition
|
||||
fails, the next extension of the list is tried. Extensions may be
|
||||
specified both as `.ext` or plain `ext`.
|
||||
|
||||
- relative_to(+<var>FileOrDir</var>)
|
||||
|
||||
Resolve the path relative to the given directory or directory the
|
||||
holding the given file. Without this option, paths are resolved
|
||||
relative to the working directory (see [working_directory/2](@ref working_directory/2)) or,
|
||||
if <var>Spec</var> is atomic and `absolute_file_name/[2,3]` is executed
|
||||
in a directive, it uses the current source-file as reference.
|
||||
|
||||
- access(+<var>Mode</var>)
|
||||
|
||||
Imposes the condition access_file(<var>File</var>, <var>Mode</var>). <var>Mode</var> is one of `read`, `write`, `append`, `exist` or
|
||||
`none` (default).
|
||||
|
||||
See also `access_file/2`.
|
||||
|
||||
- file_type(+<var>Type</var>)
|
||||
|
||||
Defines extensions. Current mapping: `txt` implies `['']`,
|
||||
`prolog` implies `['.yap', '.pl', '.prolog', '']`, `executable`
|
||||
implies `['.so', '']`, `qlf` implies `['.qlf', '']` and
|
||||
`directory` implies `['']`. The file-type `source`
|
||||
is an alias for `prolog` for compatibility to SICStus Prolog.
|
||||
See also `prolog_file_type/2`.
|
||||
|
||||
Notice also that this predicate only
|
||||
returns non-directories, unless the option `file_type(directory)` is
|
||||
specified, or unless `access(none)`.
|
||||
|
||||
- file_errors(`fail`/`error`)
|
||||
|
||||
If `error` (default), throw and `existence_error` exception
|
||||
if the file cannot be found. If `fail`, stay silent.
|
||||
|
||||
- solutions(`first`/`all`)
|
||||
|
||||
If `first` (default), the predicates leaves no choice-point.
|
||||
Otherwise a choice-point will be left and backtracking may yield
|
||||
more solutions.
|
||||
|
||||
- expand(`true`/`false`)
|
||||
|
||||
If `true` (default is `false`) and <var>Spec</var> is atomic,
|
||||
call [expand_file_name/2](@ref expand_file_name2) followed by [member/2](@ref member2) on <var>Spec</var> before
|
||||
proceeding. This is originally a SWI-Prolog extension.
|
||||
|
||||
Compatibility considerations to common argument-order in ISO as well
|
||||
as SICStus absolute_file_name/3 forced us to be flexible here.
|
||||
If the last argument is a list and the 2nd not, the arguments are
|
||||
swapped, making the call `absolute_file_name`(+<var>Spec</var>, -<var>Path</var>,
|
||||
+<var>Options</var>) valid as well.
|
||||
*/
|
||||
|
||||
absolute_file_name(File,TrueFileName,Opts) :-
|
||||
( var(TrueFileName) -> true ; atom(TrueFileName), TrueFileName \= [] ),
|
||||
!,
|
||||
@ -253,7 +352,7 @@ absolute_file_name(File,Opts,TrueFileName) :-
|
||||
'$system_library_directories'(foreign, Dir) :-
|
||||
getenv('YAPLIBDIR', Dirs),
|
||||
'$split_by_sep'(0, 0, Dirs, Dir).
|
||||
'$system_commons_directories'(commons, Dir) :-
|
||||
'$system_library_directories'(commons, Dir) :-
|
||||
getenv('YAPCOMMONSDIR', Dirs),
|
||||
'$split_by_sep'(0, 0, Dirs, Dir).
|
||||
% windows has stuff installed in the registry
|
||||
@ -356,4 +455,107 @@ absolute_file_name(File,Opts,TrueFileName) :-
|
||||
'$add_file_to_dir'(P0,A,Atoms,NFile) :-
|
||||
atom_concat([P0,A,Atoms],NFile).
|
||||
|
||||
/** @predicate path(-Directories:list) is det [DEPRECATED]
|
||||
|
||||
YAP specific procedure that returns a list of user-defined directories
|
||||
in the library search-path.
|
||||
*/
|
||||
path(Path) :- findall(X,'$in_path'(X),Path).
|
||||
|
||||
'$in_path'(X) :- recorded('$path',Path,_),
|
||||
atom_codes(Path,S),
|
||||
( S = "" -> X = '.' ;
|
||||
atom_codes(X,S) ).
|
||||
|
||||
/** @predicate add_to_path(+Directory:atom) is det [DEPRECATED]
|
||||
|
||||
*/
|
||||
add_to_path(New) :- add_to_path(New,last).
|
||||
|
||||
add_to_path(New,Pos) :-
|
||||
atom(New), !,
|
||||
'$check_path'(New,Str),
|
||||
atom_codes(Path,Str),
|
||||
'$add_to_path'(Path,Pos).
|
||||
|
||||
'$add_to_path'(New,_) :- recorded('$path',New,R), erase(R), fail.
|
||||
'$add_to_path'(New,last) :- !, recordz('$path',New,_).
|
||||
'$add_to_path'(New,first) :- recorda('$path',New,_).
|
||||
|
||||
/** @predicate remove_from_path(+Directory:atom) is det [DEPRECATED]
|
||||
|
||||
*/
|
||||
remove_from_path(New) :- '$check_path'(New,Path),
|
||||
recorded('$path',Path,R), erase(R).
|
||||
|
||||
'$check_path'(At,SAt) :- atom(At), !, atom_codes(At,S), '$check_path'(S,SAt).
|
||||
'$check_path'([],[]).
|
||||
'$check_path'([Ch],[Ch]) :- '$dir_separator'(Ch), !.
|
||||
'$check_path'([Ch],[Ch,A]) :- !, integer(Ch), '$dir_separator'(A).
|
||||
'$check_path'([N|S],[N|SN]) :- integer(N), '$check_path'(S,SN).
|
||||
|
||||
/** @predicate user:library_directory(Directory:atom)
|
||||
|
||||
*/
|
||||
|
||||
:- multifile user:library_directory/1.
|
||||
|
||||
:- dynamic user:library_directory/1.
|
||||
|
||||
/** @predicate user:commons_directory(Directory:atom)
|
||||
|
||||
*/
|
||||
|
||||
:- multifile user:commons_directory/1.
|
||||
|
||||
:- dynamic user:commons_directory/1.
|
||||
|
||||
/** @predicate user:prolog_file_type(Suffix:atom, Handler:atom)
|
||||
|
||||
*/
|
||||
|
||||
:- multifile user:prolog_file_type/2.
|
||||
|
||||
:- dynamic user:prolog_file_type/2.
|
||||
|
||||
user:prolog_file_type(yap, prolog).
|
||||
user:prolog_file_type(pl, prolog).
|
||||
user:prolog_file_type(prolog, prolog).
|
||||
user:prolog_file_type(A, prolog) :-
|
||||
current_prolog_flag(associate, A),
|
||||
A \== prolog,
|
||||
A \==pl,
|
||||
A \== yap.
|
||||
%user:prolog_file_type(qlf, prolog).
|
||||
%user:prolog_file_type(qlf, qlf).
|
||||
user:prolog_file_type(A, executable) :-
|
||||
current_prolog_flag(shared_object_extension, A).
|
||||
|
||||
/** @predicate user:file_search_path(+Type:atom, -Directory:atom)
|
||||
|
||||
*/
|
||||
|
||||
:- multifile user:file_search_path/2.
|
||||
|
||||
:- dynamic user:file_search_path/2.
|
||||
|
||||
user:file_search_path(library, Dir) :-
|
||||
library_directory(Dir).
|
||||
user:file_search_path(commons, Dir) :-
|
||||
commons_directory(Dir).
|
||||
user:file_search_path(swi, Home) :-
|
||||
current_prolog_flag(home, Home).
|
||||
user:file_search_path(yap, Home) :-
|
||||
current_prolog_flag(home, Home).
|
||||
user:file_search_path(system, Dir) :-
|
||||
prolog_flag(host_type, Dir).
|
||||
user:file_search_path(foreign, yap('lib/Yap')).
|
||||
user:file_search_path(path, C) :-
|
||||
( getenv('PATH', A),
|
||||
( current_prolog_flag(windows, true)
|
||||
-> atomic_list_concat(B, ;, A)
|
||||
; atomic_list_concat(B, :, A)
|
||||
),
|
||||
lists:member(C, B)
|
||||
).
|
||||
|
||||
|
||||
166
pl/arith.yap
166
pl/arith.yap
@ -15,6 +15,16 @@
|
||||
* *
|
||||
*************************************************************************/
|
||||
|
||||
/*
|
||||
:- module( '$arithmetic' , [ expand_exprs/2,
|
||||
compile_expressions/0,
|
||||
do_not_compile_expressions/0,
|
||||
'$c_built_in'/3,
|
||||
succ/3,
|
||||
plus/3] ).
|
||||
|
||||
*/
|
||||
|
||||
% the default mode is on
|
||||
|
||||
expand_exprs(Old,New) :-
|
||||
@ -32,96 +42,96 @@ do_not_compile_expressions :- set_value('$c_arith',[]).
|
||||
|
||||
'$c_built_in'(IN, M, OUT) :-
|
||||
get_value('$c_arith',true), !,
|
||||
'$do_c_built_in'(IN, M, OUT).
|
||||
do_c_built_in(IN, M, OUT).
|
||||
'$c_built_in'(IN, _, IN).
|
||||
|
||||
|
||||
'$do_c_built_in'(G, M, OUT) :- var(G), !,
|
||||
'$do_c_built_metacall'(G, M, OUT).
|
||||
'$do_c_built_in'(Mod:G, _, OUT) :-
|
||||
do_c_built_in(G, M, OUT) :- var(G), !,
|
||||
do_c_built_metacall(G, M, OUT).
|
||||
do_c_built_in(Mod:G, _, OUT) :-
|
||||
strip_module(Mod:G, M, G1),
|
||||
( var(G1) -> M = M2, G1 = G2 ; G1 = M2:G2), !,
|
||||
'$do_c_built_metacall'(G2, M2, OUT).
|
||||
'$do_c_built_in'(\+ G, _, OUT) :-
|
||||
do_c_built_metacall(G2, M2, OUT).
|
||||
do_c_built_in(\+ G, _, OUT) :-
|
||||
nonvar(G),
|
||||
G = (A = B),
|
||||
!,
|
||||
OUT = (A \= B).
|
||||
'$do_c_built_in'(call(G), _, OUT) :-
|
||||
do_c_built_in(call(G), _, OUT) :-
|
||||
nonvar(G),
|
||||
G = (Mod:G1), !,
|
||||
'$do_c_built_metacall'(G1, Mod, OUT).
|
||||
'$do_c_built_in'(call(G), Mod, OUT) :-
|
||||
do_c_built_metacall(G1, Mod, OUT).
|
||||
do_c_built_in(call(G), Mod, OUT) :-
|
||||
var(G), !,
|
||||
'$do_c_built_metacall'(G, Mod, OUT).
|
||||
'$do_c_built_in'(depth_bound_call(G,D), M, OUT) :- !,
|
||||
'$do_c_built_in'(G, M, NG),
|
||||
do_c_built_metacall(G, Mod, OUT).
|
||||
do_c_built_in(depth_bound_call(G,D), M, OUT) :- !,
|
||||
do_c_built_in(G, M, NG),
|
||||
% make sure we don't have something like (A,B) -> $depth_next(D), A, B.
|
||||
( '$composed_built_in'(NG) ->
|
||||
OUT = depth_bound_call(NG,D)
|
||||
;
|
||||
OUT = ('$set_depth_limit_for_next_call'(D),NG)
|
||||
).
|
||||
'$do_c_built_in'(once(G), M, (yap_hacks:current_choice_point(CP),NG,'$$cut_by'(CP))) :- !,
|
||||
'$do_c_built_in'(G,M,NG0),
|
||||
do_c_built_in(once(G), M, (yap_hacks:current_choice_point(CP),NG,'$$cut_by'(CP))) :- !,
|
||||
do_c_built_in(G,M,NG0),
|
||||
'$clean_cuts'(NG0, NG).
|
||||
'$do_c_built_in'(forall(Cond,Action), M, \+((NCond, \+(NAction)))) :- !,
|
||||
'$do_c_built_in'(Cond,M,ICond),
|
||||
'$do_c_built_in'(Action,M,IAction),
|
||||
do_c_built_in(forall(Cond,Action), M, \+((NCond, \+(NAction)))) :- !,
|
||||
do_c_built_in(Cond,M,ICond),
|
||||
do_c_built_in(Action,M,IAction),
|
||||
'$clean_cuts'(ICond, NCond),
|
||||
'$clean_cuts'(IAction, NAction).
|
||||
'$do_c_built_in'(ignore(Goal), M, (NGoal -> true ; true)) :- !,
|
||||
'$do_c_built_in'(Goal,M,IGoal),
|
||||
do_c_built_in(ignore(Goal), M, (NGoal -> true ; true)) :- !,
|
||||
do_c_built_in(Goal,M,IGoal),
|
||||
'$clean_cuts'(IGoal, NGoal).
|
||||
'$do_c_built_in'(if(G,A,B), M, (yap_hacks:current_choicepoint(DCP),NG,yap_hacks:cut_at(DCP),NA; NB)) :- !,
|
||||
'$do_c_built_in'(G,M,NG0),
|
||||
do_c_built_in(if(G,A,B), M, (yap_hacks:current_choicepoint(DCP),NG,yap_hacks:cut_at(DCP),NA; NB)) :- !,
|
||||
do_c_built_in(G,M,NG0),
|
||||
'$clean_cuts'(NG0, NG),
|
||||
'$do_c_built_in'(A,M,NA),
|
||||
'$do_c_built_in'(B,M,NB).
|
||||
'$do_c_built_in'((G*->A;B), M, (yap_hacks:current_choicepoint(DCP),NG,yap_hacks:cut_at(DCP),NA; NB)) :- !,
|
||||
'$do_c_built_in'(G,M,NG0),
|
||||
do_c_built_in(A,M,NA),
|
||||
do_c_built_in(B,M,NB).
|
||||
do_c_built_in((G*->A;B), M, (yap_hacks:current_choicepoint(DCP),NG,yap_hacks:cut_at(DCP),NA; NB)) :- !,
|
||||
do_c_built_in(G,M,NG0),
|
||||
'$clean_cuts'(NG0, NG),
|
||||
'$do_c_built_in'(A,M,NA),
|
||||
'$do_c_built_in'(B,M,NB).
|
||||
'$do_c_built_in'((G*->A), M, (NG,NA)) :- !,
|
||||
'$do_c_built_in'(G,M,NG0),
|
||||
do_c_built_in(A,M,NA),
|
||||
do_c_built_in(B,M,NB).
|
||||
do_c_built_in((G*->A), M, (NG,NA)) :- !,
|
||||
do_c_built_in(G,M,NG0),
|
||||
'$clean_cuts'(NG0, NG),
|
||||
'$do_c_built_in'(A,M,NA).
|
||||
'$do_c_built_in'('C'(A,B,C), _, (A=[B|C])) :- !.
|
||||
'$do_c_built_in'(X is Y, M, P) :-
|
||||
do_c_built_in(A,M,NA).
|
||||
do_c_built_in('C'(A,B,C), _, (A=[B|C])) :- !.
|
||||
do_c_built_in(X is Y, M, P) :-
|
||||
primitive(X), !,
|
||||
'$do_c_built_in'(X =:= Y, M, P).
|
||||
'$do_c_built_in'(X is Y, M, (P,A=X)) :-
|
||||
do_c_built_in(X =:= Y, M, P).
|
||||
do_c_built_in(X is Y, M, (P,A=X)) :-
|
||||
nonvar(X), !,
|
||||
'$do_c_built_in'(A is Y, M, P).
|
||||
'$do_c_built_in'(X is Y, _, P) :-
|
||||
do_c_built_in(A is Y, M, P).
|
||||
do_c_built_in(X is Y, _, P) :-
|
||||
nonvar(Y), % Don't rewrite variables
|
||||
!,
|
||||
(
|
||||
number(Y) ->
|
||||
P = ( X = Y); % This case reduces to an unification
|
||||
'$expand_expr'(Y, P0, X0),
|
||||
expand_expr(Y, P0, X0),
|
||||
'$drop_is'(X0, X, P0, P)
|
||||
).
|
||||
'$do_c_built_in'(Comp0, _, R) :- % now, do it for comparisons
|
||||
do_c_built_in(Comp0, _, R) :- % now, do it for comparisons
|
||||
'$compop'(Comp0, Op, E, F),
|
||||
!,
|
||||
'$compop'(Comp, Op, U, V),
|
||||
'$expand_expr'(E, P, U),
|
||||
'$expand_expr'(F, Q, V),
|
||||
expand_expr(E, P, U),
|
||||
expand_expr(F, Q, V),
|
||||
'$do_and'(P, Q, R0),
|
||||
'$do_and'(R0, Comp, R).
|
||||
'$do_c_built_in'(P, _, P).
|
||||
do_c_built_in(P, _, P).
|
||||
|
||||
'$do_c_built_metacall'(G1, Mod, '$execute_wo_mod'(G1,Mod)) :-
|
||||
do_c_built_metacall(G1, Mod, '$execute_wo_mod'(G1,Mod)) :-
|
||||
var(Mod), !.
|
||||
'$do_c_built_metacall'(G1, Mod, '$execute_in_mod'(G1,Mod)) :-
|
||||
do_c_built_metacall(G1, Mod, '$execute_in_mod'(G1,Mod)) :-
|
||||
var(G1), atom(Mod), !.
|
||||
'$do_c_built_metacall'(Mod:G1, _, OUT) :- !,
|
||||
'$do_c_built_metacall'(G1, Mod, OUT).
|
||||
'$do_c_built_metacall'(G1, Mod, '$execute_in_mod'(G1,Mod)) :-
|
||||
do_c_built_metacall(Mod:G1, _, OUT) :- !,
|
||||
do_c_built_metacall(G1, Mod, OUT).
|
||||
do_c_built_metacall(G1, Mod, '$execute_in_mod'(G1,Mod)) :-
|
||||
atom(Mod), !.
|
||||
'$do_c_built_metacall'(G1, Mod, call(Mod:G1)).
|
||||
do_c_built_metacall(G1, Mod, call(Mod:G1)).
|
||||
|
||||
'$do_and'(true, P, P) :- !.
|
||||
'$do_and'(P, true, P) :- !.
|
||||
@ -163,34 +173,34 @@ do_not_compile_expressions :- set_value('$c_arith',[]).
|
||||
% first argument is the expression not expanded,
|
||||
% second argument the expanded expression
|
||||
% third argument unifies with the result from the expression
|
||||
'$expand_expr'(V, true, V) :-
|
||||
expand_expr(V, true, V) :-
|
||||
var(V), !.
|
||||
'$expand_expr'([T], E, V) :- !,
|
||||
'$expand_expr'(T, E, V).
|
||||
'$expand_expr'(String, _E, V) :-
|
||||
expand_expr([T], E, V) :- !,
|
||||
expand_expr(T, E, V).
|
||||
expand_expr(String, _E, V) :-
|
||||
string( String ), !,
|
||||
string_codes(String, [V]).
|
||||
'$expand_expr'(A, true, A) :-
|
||||
expand_expr(A, true, A) :-
|
||||
atomic(A), !.
|
||||
'$expand_expr'(T, E, V) :-
|
||||
expand_expr(T, E, V) :-
|
||||
T =.. [O, A], !,
|
||||
'$expand_expr'(A, Q, X),
|
||||
'$expand_expr'(O, X, V, Q, E).
|
||||
'$expand_expr'(T, E, V) :-
|
||||
expand_expr(A, Q, X),
|
||||
expand_expr(O, X, V, Q, E).
|
||||
expand_expr(T, E, V) :-
|
||||
T =.. [O, A, B], !,
|
||||
'$expand_expr'(A, Q, X),
|
||||
'$expand_expr'(B, R, Y),
|
||||
'$expand_expr'(O, X, Y, V, Q, S),
|
||||
expand_expr(A, Q, X),
|
||||
expand_expr(B, R, Y),
|
||||
expand_expr(O, X, Y, V, Q, S),
|
||||
'$do_and'(R, S, E).
|
||||
|
||||
% expanding an expression of the form:
|
||||
% O is Op(X),
|
||||
% after having expanded into Q
|
||||
% and giving as result P (the last argument)
|
||||
'$expand_expr'(Op, X, O, Q, Q) :-
|
||||
expand_expr(Op, X, O, Q, Q) :-
|
||||
number(X), !,
|
||||
is( O, Op, X).
|
||||
'$expand_expr'(Op, X, O, Q, P) :-
|
||||
expand_expr(Op, X, O, Q, P) :-
|
||||
'$unary_op_as_integer'(Op,IOp),
|
||||
'$do_and'(Q, is( O, IOp, X), P).
|
||||
|
||||
@ -201,58 +211,58 @@ do_not_compile_expressions :- set_value('$c_arith',[]).
|
||||
% included is some optimization for:
|
||||
% incrementing and decrementing,
|
||||
% the elementar arithmetic operations [+,-,*,//]
|
||||
'$expand_expr'(Op, X, Y, O, Q, Q) :-
|
||||
expand_expr(Op, X, Y, O, Q, Q) :-
|
||||
number(X), number(Y), !,
|
||||
is( O, Op, X, Y).
|
||||
'$expand_expr'(+, X, Y, O, Q, P) :- !,
|
||||
expand_expr(+, X, Y, O, Q, P) :- !,
|
||||
'$preprocess_args_for_commutative'(X, Y, X1, Y1, E),
|
||||
'$do_and'(E, '$plus'(X1,Y1,O), F),
|
||||
'$do_and'(Q, F, P).
|
||||
'$expand_expr'(-, X, Y, O, Q, P) :-
|
||||
expand_expr(-, X, Y, O, Q, P) :-
|
||||
var(X), number(Y),
|
||||
Z is -Y, !,
|
||||
'$expand_expr'(+, Z, X, O, Q, P).
|
||||
'$expand_expr'(-, X, Y, O, Q, P) :- !,
|
||||
expand_expr(+, Z, X, O, Q, P).
|
||||
expand_expr(-, X, Y, O, Q, P) :- !,
|
||||
'$preprocess_args_for_non_commutative'(X, Y, X1, Y1, E),
|
||||
'$do_and'(E, '$minus'(X1,Y1,O), F),
|
||||
'$do_and'(Q, F, P).
|
||||
'$expand_expr'(*, X, Y, O, Q, P) :- !,
|
||||
expand_expr(*, X, Y, O, Q, P) :- !,
|
||||
'$preprocess_args_for_commutative'(X, Y, X1, Y1, E),
|
||||
'$do_and'(E, '$times'(X1,Y1,O), F),
|
||||
'$do_and'(Q, F, P).
|
||||
'$expand_expr'(//, X, Y, O, Q, P) :-
|
||||
expand_expr(//, X, Y, O, Q, P) :-
|
||||
nonvar(Y), Y == 0, !,
|
||||
'$binary_op_as_integer'(//,IOp),
|
||||
'$do_and'(Q, is(O,IOp,X,Y), P).
|
||||
'$expand_expr'(//, X, Y, O, Q, P) :- !,
|
||||
expand_expr(//, X, Y, O, Q, P) :- !,
|
||||
'$preprocess_args_for_non_commutative'(X, Y, X1, Y1, E),
|
||||
'$do_and'(E, '$div'(X1,Y1,O), F),
|
||||
'$do_and'(Q, F, P).
|
||||
'$expand_expr'(/\, X, Y, O, Q, P) :- !,
|
||||
expand_expr(/\, X, Y, O, Q, P) :- !,
|
||||
'$preprocess_args_for_commutative'(X, Y, X1, Y1, E),
|
||||
'$do_and'(E, '$and'(X1,Y1,O), F),
|
||||
'$do_and'(Q, F, P).
|
||||
'$expand_expr'(\/, X, Y, O, Q, P) :- !,
|
||||
expand_expr(\/, X, Y, O, Q, P) :- !,
|
||||
'$preprocess_args_for_commutative'(X, Y, X1, Y1, E),
|
||||
'$do_and'(E, '$or'(X1,Y1,O), F),
|
||||
'$do_and'(Q, F, P).
|
||||
'$expand_expr'(<<, X, Y, O, Q, P) :-
|
||||
expand_expr(<<, X, Y, O, Q, P) :-
|
||||
var(X), number(Y), Y < 0,
|
||||
Z is -Y, !,
|
||||
'$expand_expr'(>>, X, Z, O, Q, P).
|
||||
'$expand_expr'(<<, X, Y, O, Q, P) :- !,
|
||||
expand_expr(>>, X, Z, O, Q, P).
|
||||
expand_expr(<<, X, Y, O, Q, P) :- !,
|
||||
'$preprocess_args_for_non_commutative'(X, Y, X1, Y1, E),
|
||||
'$do_and'(E, '$sll'(X1,Y1,O), F),
|
||||
'$do_and'(Q, F, P).
|
||||
'$expand_expr'(>>, X, Y, O, Q, P) :-
|
||||
expand_expr(>>, X, Y, O, Q, P) :-
|
||||
var(X), number(Y), Y < 0,
|
||||
Z is -Y, !,
|
||||
'$expand_expr'(<<, X, Z, O, Q, P).
|
||||
'$expand_expr'(>>, X, Y, O, Q, P) :- !,
|
||||
expand_expr(<<, X, Z, O, Q, P).
|
||||
expand_expr(>>, X, Y, O, Q, P) :- !,
|
||||
'$preprocess_args_for_non_commutative'(X, Y, X1, Y1, E),
|
||||
'$do_and'(E, '$slr'(X1,Y1,O), F),
|
||||
'$do_and'(Q, F, P).
|
||||
'$expand_expr'(Op, X, Y, O, Q, P) :-
|
||||
expand_expr(Op, X, Y, O, Q, P) :-
|
||||
'$binary_op_as_integer'(Op,IOp),
|
||||
'$do_and'(Q, is(O,IOp,X,Y), P).
|
||||
|
||||
|
||||
@ -15,6 +15,12 @@
|
||||
* *
|
||||
*************************************************************************/
|
||||
|
||||
:- module( '$arrays',
|
||||
[array/2,
|
||||
'$c_arrays'/2,
|
||||
static_array_properties/3] ).
|
||||
|
||||
|
||||
%
|
||||
% These are the array built-in predicates. They will only work if
|
||||
% YAP_ARRAYS is defined in Yap.h.m4.
|
||||
|
||||
124
pl/atoms.yap
Normal file
124
pl/atoms.yap
Normal file
@ -0,0 +1,124 @@
|
||||
/*************************************************************************
|
||||
* *
|
||||
* YAP Prolog *
|
||||
* *
|
||||
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
||||
* *
|
||||
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-2014 *
|
||||
* *
|
||||
*************************************************************************/
|
||||
|
||||
/**
|
||||
* @short: Atom, and Atomic manipulation predicates in YAP
|
||||
*
|
||||
*/ *
|
||||
|
||||
:- module( '$atoms', [ atom_concat/2,
|
||||
atomic_list_concat/2,
|
||||
atomic_list_concat/3,
|
||||
current_atom/1 ] ).
|
||||
|
||||
atom_concat(Xs,At) :-
|
||||
( var(At) ->
|
||||
'$atom_concat'(Xs, At )
|
||||
;
|
||||
'$atom_concat_constraints'(Xs, 0, At, Unbound),
|
||||
'$process_atom_holes'(Unbound)
|
||||
).
|
||||
|
||||
% the constraints are of the form hole: HoleAtom, Begin, Atom, End
|
||||
'$atom_concat_constraints'([At], 0, At, []) :- !.
|
||||
'$atom_concat_constraints'([At0], mid(Next, At), At, [hole(At0, Next, At, end)]) :- !.
|
||||
% just slice first atom
|
||||
'$atom_concat_constraints'([At0|Xs], 0, At, Unbound) :-
|
||||
atom(At0), !,
|
||||
sub_atom(At, 0, Sz, L, At0 ),
|
||||
sub_atom(At, _, L, 0, Atr ), %remainder
|
||||
'$atom_concat_constraints'(Xs, 0, Atr, Unbound).
|
||||
% first hole: Follow says whether we have two holes in a row, At1 will be our atom
|
||||
'$atom_concat_constraints'([At0|Xs], 0, At, [hole(At0, 0, At, Next)|Unbound]) :-
|
||||
'$atom_concat_constraints'(Xs, mid(Next,At1), At, Unbound).
|
||||
% end of a run
|
||||
'$atom_concat_constraints'([At0|Xs], mid(end, At1), At, Unbound) :-
|
||||
atom(At0), !,
|
||||
sub_atom(At, Next, Sz, L, At0),
|
||||
sub_atom(At, 0, Next, Next, At1),
|
||||
sub_atom(At, _, L, 0, Atr), %remainder
|
||||
'$atom_concat_constraints'(Xs, 0, Atr, Unbound).
|
||||
'$atom_concat_constraints'([At0|Xs], mid(Next,At1), At, Next, [hole(At0, Next, At, Follow)|Unbound]) :-
|
||||
'$atom_concat_constraints'(Xs, mid(NextFollow, At1), At, Unbound).
|
||||
|
||||
'$process_atom_holes'([]).
|
||||
'$process_atom_holes'([hole(At0, Next, At1, End)|Unbound]) :- End == end, !,
|
||||
sub_atom(At1, Next, _, 0, At0),
|
||||
'$process_atom_holes'(Unbound).
|
||||
'$process_atom_holes'([hole(At0, Next, At1, Follow)|Unbound]) :-
|
||||
sub_atom(At1, Next, Sz, _Left, At0),
|
||||
Follow is Next+Sz,
|
||||
'$process_atom_holes'(Unbound).
|
||||
|
||||
|
||||
atomic_list_concat(L,At) :-
|
||||
atomic_concat(L, At).
|
||||
|
||||
atomic_list_concat(L, El, At) :-
|
||||
var(El), !,
|
||||
'$do_error'(instantiation_error,atom_list_concat(L,El,At)).
|
||||
atomic_list_concat(L, El, At) :-
|
||||
nonvar(L), !,
|
||||
'$add_els'(L,El,LEl),
|
||||
atomic_concat(LEl, At).
|
||||
atomic_list_concat(L, El, At) :-
|
||||
nonvar(At), !,
|
||||
atom_codes(At, S),
|
||||
atom_codes(El, [ElS]),
|
||||
'$split_elements'(S, ElS, SubS),
|
||||
'$atomify_list'(SubS, L).
|
||||
|
||||
'$add_els'([A,B|L],El,[A,El|NL]) :- !,
|
||||
'$add_els'([B|L],El,NL).
|
||||
'$add_els'(L,_,L).
|
||||
|
||||
'$split_elements'(E.S, E, SubS) :- !,
|
||||
'$split_elements'(S, E, SubS).
|
||||
'$split_elements'(E1.S, E, [E1|L].SubS) :- !,
|
||||
'$split_elements'(S, E, L, SubS).
|
||||
'$split_elements'([], _, []).
|
||||
|
||||
'$split_elements'([], _, [], []).
|
||||
'$split_elements'(E.S, E, [], SubS) :- !,
|
||||
'$split_elements'(S, E, SubS).
|
||||
'$split_elements'(E1.S, E, E1.L, SubS) :-
|
||||
'$split_elements'(S, E, L, SubS).
|
||||
|
||||
'$atomify_list'([], []).
|
||||
'$atomify_list'(S.SubS, A.L) :-
|
||||
atom_codes(A, S),
|
||||
'$atomify_list'(SubS, L).
|
||||
|
||||
|
||||
%
|
||||
% small compatibility hack
|
||||
|
||||
'$singletons_in_term'(T,VL) :-
|
||||
'$variables_in_term'(T,[],V10),
|
||||
'$sort'(V10, V1),
|
||||
'$non_singletons_in_term'(T,[],V20),
|
||||
'$sort'(V20, V2),
|
||||
'$subtract_lists_of_variables'(V2,V1,VL).
|
||||
|
||||
'$subtract_lists_of_variables'([],VL,VL).
|
||||
'$subtract_lists_of_variables'([_|_],[],[]) :- !.
|
||||
'$subtract_lists_of_variables'([V1|VL1],[V2|VL2],VL) :-
|
||||
V1 == V2, !,
|
||||
'$subtract_lists_of_variables'(VL1,VL2,VL).
|
||||
'$subtract_lists_of_variables'([V1|VL1],[V2|VL2],[V2|VL]) :-
|
||||
'$subtract_lists_of_variables'([V1|VL1],VL2,VL).
|
||||
|
||||
current_atom(A) :- % check
|
||||
atom(A), !.
|
||||
current_atom(A) :- % generate
|
||||
'$current_atom'(A).
|
||||
current_atom(A) :- % generate
|
||||
'$current_wide_atom'(A).
|
||||
|
||||
33
pl/boot.yap
33
pl/boot.yap
@ -270,11 +270,6 @@ true :- true.
|
||||
'$repeat'.
|
||||
'$repeat' :- '$repeat'.
|
||||
|
||||
'$start_corouts' :-
|
||||
recorded('$corout','$corout'(Name,_,_),R),
|
||||
Name \= main,
|
||||
finish_corout(R),
|
||||
fail.
|
||||
'$start_corouts' :-
|
||||
eraseall('$corout'),
|
||||
eraseall('$result'),
|
||||
@ -547,7 +542,7 @@ true :- true.
|
||||
|
||||
'$out_neg_answer' :-
|
||||
( '$undefined'(print_message(_,_),prolog) ->
|
||||
'$present_answer'(user_error,'false.~n', [])
|
||||
'$present_answer'(user_error,'false.~n')
|
||||
;
|
||||
print_message(help,false)
|
||||
),
|
||||
@ -1046,6 +1041,7 @@ bootstrap(F) :-
|
||||
),
|
||||
'$loop'(Stream,consult),
|
||||
working_directory(_, OldD),
|
||||
'$current_module'(_, prolog),
|
||||
'$end_consult',
|
||||
(
|
||||
'$swi_current_prolog_flag'(verbose_load, silent)
|
||||
@ -1101,6 +1097,29 @@ bootstrap(F) :-
|
||||
'$abort_loop'(Stream) :-
|
||||
'$do_error'(permission_error(input,closed_stream,Stream), loop).
|
||||
|
||||
system_module(M, SysExps, Decls) :-
|
||||
'$current_module'(prolog, M), !,
|
||||
'$export_preds'(SysExps, prolog),
|
||||
'$export_preds'(Decls, M).
|
||||
|
||||
'$export_preds'([], _).
|
||||
'$export_preds'([N/A|Decls], M) :-
|
||||
functor(S, N, A),
|
||||
'$sys_export'(S, M),
|
||||
'$export_preds'(Decls, M).
|
||||
|
||||
|
||||
import_system_module(M, SysExps) :-
|
||||
'$current_module'(M0, _M),
|
||||
'$import_system'(SysExps, M0, M).
|
||||
|
||||
'$import_system'([], _, _).
|
||||
'$import_system'([N/A|Decls], M0, M) :-
|
||||
functor(S, N, A),
|
||||
'$assert_static'((G :- M0:G), M, last, _, assert_static((M:G :- M0:G))),
|
||||
'$import_system'(Decls, M0, M).
|
||||
|
||||
|
||||
/* General purpose predicates */
|
||||
|
||||
'$head_and_body'((H:-B),H,B) :- !.
|
||||
@ -1162,7 +1181,7 @@ expand_term(Term,Expanded) :-
|
||||
%
|
||||
'$expand_array_accesses_in_term'(Expanded0,ExpandedF) :-
|
||||
'$array_refs_compiled',
|
||||
'$c_arrays'(Expanded0,ExpandedF), !.
|
||||
'$arrays':'$c_arrays'(Expanded0,ExpandedF), !.
|
||||
'$expand_array_accesses_in_term'(Expanded,Expanded).
|
||||
|
||||
|
||||
|
||||
@ -241,84 +241,5 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
|
||||
'$multiple_has_been_defined'(Fil,P,M) :-
|
||||
print_message(warning,defined_elsewhere(M:P,Fil)).
|
||||
|
||||
multifile(P) :-
|
||||
'$current_module'(OM),
|
||||
'$multifile'(P, M).
|
||||
|
||||
'$multifile'(V, _) :- var(V), !,
|
||||
'$do_error'(instantiation_error,multifile(V)).
|
||||
'$multifile'((X,Y), M) :- !, '$multifile'(X, M), '$multifile'(Y, M).
|
||||
'$multifile'(Mod:PredSpec, _) :- !,
|
||||
'$multifile'(PredSpec, Mod).
|
||||
'$multifile'(N//A, M) :- !,
|
||||
integer(A),
|
||||
A1 is A+2,
|
||||
'$multifile'(N/A1, M).
|
||||
'$multifile'(N/A, M) :-
|
||||
'$add_multifile'(N,A,M),
|
||||
fail.
|
||||
'$multifile'(N/A, M) :-
|
||||
functor(S,N,A),
|
||||
'$is_multifile'(S, M), !.
|
||||
'$multifile'(N/A, M) :- !,
|
||||
'$new_multifile'(N,A,M).
|
||||
'$multifile'([H|T], M) :- !,
|
||||
'$multifile'(H,M),
|
||||
'$multifile'(T,M).
|
||||
'$multifile'(P, M) :-
|
||||
'$do_error'(type_error(predicate_indicator,P),multifile(M:P)).
|
||||
|
||||
discontiguous(V) :-
|
||||
var(V), !,
|
||||
'$do_error'(instantiation_error,discontiguous(V)).
|
||||
discontiguous(M:F) :- !,
|
||||
'$discontiguous'(F,M).
|
||||
discontiguous(F) :-
|
||||
'$current_module'(M),
|
||||
'$discontiguous'(F,M).
|
||||
|
||||
'$discontiguous'(V,M) :- var(V), !,
|
||||
'$do_error'(instantiation_error,M:discontiguous(V)).
|
||||
'$discontiguous'((X,Y),M) :- !,
|
||||
'$discontiguous'(X,M),
|
||||
'$discontiguous'(Y,M).
|
||||
'$discontiguous'(M:A,_) :- !,
|
||||
'$discontiguous'(A,M).
|
||||
'$discontiguous'(N//A1, M) :- !,
|
||||
integer(A1), !,
|
||||
A is A1+2,
|
||||
'$discontiguous'(N/A, M).
|
||||
'$discontiguous'(N/A, M) :- !,
|
||||
( recordzifnot('$discontiguous_defs','$df'(N,A,M),_) ->
|
||||
true
|
||||
;
|
||||
true
|
||||
).
|
||||
'$discontiguous'(P,M) :-
|
||||
'$do_error'(type_error(predicate_indicator,P),M:discontiguous(P)).
|
||||
|
||||
%
|
||||
% did we declare multifile properly?
|
||||
%
|
||||
'$check_multifile_pred'(Hd, M, _) :-
|
||||
functor(Hd,Na,Ar),
|
||||
source_location(F, _),
|
||||
recorded('$multifile_defs','$defined'(F,Na,Ar,M),_), !.
|
||||
% oops, we did not.
|
||||
'$check_multifile_pred'(Hd, M, Fl) :-
|
||||
% so this is not a multi-file predicate any longer.
|
||||
functor(Hd,Na,Ar),
|
||||
NFl is \(0x20000000) /\ Fl,
|
||||
'$flags'(Hd,M,Fl,NFl),
|
||||
'$warn_mfile'(Na,Ar).
|
||||
|
||||
'$warn_mfile'(F,A) :-
|
||||
write(user_error,'% Warning: predicate '),
|
||||
write(user_error,F/A), write(user_error,' was a multifile predicate '),
|
||||
write(user_error,' (line '),
|
||||
'$start_line'(LN), write(user_error,LN),
|
||||
write(user_error,')'),
|
||||
nl(user_error).
|
||||
|
||||
|
||||
|
||||
|
||||
@ -194,7 +194,7 @@ load_files(Files,Opts) :-
|
||||
Val == false -> true ;
|
||||
'$do_error'(domain_error(unimplemented_option,must_be_module(Val)),Call) ).
|
||||
'$process_lf_opt'(stream, Val, Call) :-
|
||||
( current_stream(Val) -> true ;
|
||||
( current_stream(_,_,Val) -> true ;
|
||||
'$do_error'(type_error(stream,Val),Call) ).
|
||||
'$process_lf_opt'(register, Val, Call) :-
|
||||
( Val == false -> true ;
|
||||
@ -303,12 +303,21 @@ exo_files(Fs) :-
|
||||
db_files(Fs) :-
|
||||
'$load_files'(Fs, [consult(db), if(not_loaded)], exo_files(Fs)).
|
||||
|
||||
use_module(F) :-
|
||||
'$load_files'(F, [if(not_loaded),must_be_module(true)], use_module(F)).
|
||||
%
|
||||
% stub to prevent modules defined within the prolog module.
|
||||
%
|
||||
module(Mod, Decls) :-
|
||||
'$current_module'(prolog, Mod), !,
|
||||
'$export_preds'(Decls).
|
||||
|
||||
use_module(F,Is) :-
|
||||
'$load_files'(F, [if(not_loaded),must_be_module(true),imports(Is)], use_module(F,Is)).
|
||||
'$export_preds'([]).
|
||||
'$export_preds'([N/A|Decls]) :-
|
||||
functor(S, N, A),
|
||||
'$sys_export'(S, prolog),
|
||||
'$export_preds'(Decls).
|
||||
|
||||
|
||||
% prevent modules within the kernel module...
|
||||
use_module(M,F,Is) :-
|
||||
'$use_module'(M,F,Is).
|
||||
|
||||
@ -650,7 +659,7 @@ prolog_load_context(source, F0) :-
|
||||
'$input_context'(Context),
|
||||
'$top_file'(Context, F0, F) */.
|
||||
prolog_load_context(stream, Stream) :-
|
||||
'$nb_setval'('$consulting_file', _, fail),
|
||||
'$nb_getval'('$consulting_file', _, fail),
|
||||
'$current_loop_stream'(Stream).
|
||||
% return this term for SWI compatibility.
|
||||
prolog_load_context(term_position, '$stream_position'(0,Line,0,0,0)) :-
|
||||
@ -697,35 +706,6 @@ prolog_load_context(term_position, '$stream_position'(0,Line,0,0,0)) :-
|
||||
( (Age == CurrentAge ; Age = -1) -> true; erase(R), fail).
|
||||
|
||||
|
||||
|
||||
path(Path) :- findall(X,'$in_path'(X),Path).
|
||||
|
||||
'$in_path'(X) :- recorded('$path',Path,_),
|
||||
atom_codes(Path,S),
|
||||
( S = "" -> X = '.' ;
|
||||
atom_codes(X,S) ).
|
||||
|
||||
add_to_path(New) :- add_to_path(New,last).
|
||||
|
||||
add_to_path(New,Pos) :-
|
||||
atom(New), !,
|
||||
'$check_path'(New,Str),
|
||||
atom_codes(Path,Str),
|
||||
'$add_to_path'(Path,Pos).
|
||||
|
||||
'$add_to_path'(New,_) :- recorded('$path',New,R), erase(R), fail.
|
||||
'$add_to_path'(New,last) :- !, recordz('$path',New,_).
|
||||
'$add_to_path'(New,first) :- recorda('$path',New,_).
|
||||
|
||||
remove_from_path(New) :- '$check_path'(New,Path),
|
||||
recorded('$path',Path,R), erase(R).
|
||||
|
||||
'$check_path'(At,SAt) :- atom(At), !, atom_codes(At,S), '$check_path'(S,SAt).
|
||||
'$check_path'([],[]).
|
||||
'$check_path'([Ch],[Ch]) :- '$dir_separator'(Ch), !.
|
||||
'$check_path'([Ch],[Ch,A]) :- !, integer(Ch), '$dir_separator'(A).
|
||||
'$check_path'([N|S],[N|SN]) :- integer(N), '$check_path'(S,SN).
|
||||
|
||||
% add_multifile_predicate when we start consult
|
||||
'$add_multifile'(Name,Arity,Module) :-
|
||||
source_location(File,_),
|
||||
|
||||
@ -194,9 +194,6 @@ garbage_collect_atoms :-
|
||||
'$good_character_code'(X) :- var(X), !.
|
||||
'$good_character_code'(X) :- integer(X), X > -2, X < 256.
|
||||
|
||||
(initialization) :-
|
||||
'$initialisation_goals'.
|
||||
|
||||
prolog_initialization(G) :- var(G), !,
|
||||
'$do_error'(instantiation_error,initialization(G)).
|
||||
prolog_initialization(T) :- callable(T), !,
|
||||
|
||||
@ -657,7 +657,7 @@ debugging :-
|
||||
fail.
|
||||
'$action'(0'A,_,_,_,_,_) :- !, % 'b break
|
||||
'$skipeol'(0'A),
|
||||
'$stack_dump',
|
||||
'$hacks':'$stack_dump',
|
||||
fail.
|
||||
'$action'(0'c,_,_,_,_,on) :- !, % 'c creep
|
||||
'$skipeol'(0'c),
|
||||
|
||||
@ -86,6 +86,7 @@
|
||||
'$set_encoding'(Enc).
|
||||
'$exec_directive'(include(F), Status, _, _, _) :-
|
||||
'$include'(F, Status).
|
||||
% don't declare modules into Prolog Module
|
||||
'$exec_directive'(module(N,P), Status, _, _, _) :-
|
||||
'$module'(Status,N,P).
|
||||
'$exec_directive'(module(N,P,Op), Status, _, _, _) :-
|
||||
@ -120,13 +121,13 @@
|
||||
'$exec_directive'(consult(Fs), _, M, _, _) :-
|
||||
'$load_files'(M:Fs, [consult(consult)], consult(Fs)).
|
||||
'$exec_directive'(use_module(F), _, M, _, _) :-
|
||||
'$load_files'(M:F, [if(not_loaded),must_be_module(true)],use_module(F)).
|
||||
use_module(M:F).
|
||||
'$exec_directive'(reexport(F), _, M, _, _) :-
|
||||
'$load_files'(M:F, [if(not_loaded), silent(true), reexport(true),must_be_module(true)], reexport(F)).
|
||||
'$exec_directive'(reexport(F,Spec), _, M, _, _) :-
|
||||
'$load_files'(M:F, [if(changed), silent(true), imports(Spec), reexport(true),must_be_module(true)], reexport(F, Spec)).
|
||||
'$exec_directive'(use_module(F,Is), _, M, _, _) :-
|
||||
'$load_files'(M:F, [if(not_loaded),imports(Is),must_be_module(true)],use_module(F,Is)).
|
||||
'$exec_directive'(use_module(F, Is), _, M, _, _) :-
|
||||
use_module(M:F, Is).
|
||||
'$exec_directive'(use_module(Mod,F,Is), _, _, _, _) :-
|
||||
'$use_module'(Mod,F,Is).
|
||||
'$exec_directive'(block(BlockSpec), _, _, _, _) :-
|
||||
|
||||
@ -20,9 +20,10 @@
|
||||
[display_stack_info/4,
|
||||
display_stack_info/6,
|
||||
display_pc/3,
|
||||
code_location/3]).
|
||||
code_location/3,
|
||||
'$stack_dump'/0]).
|
||||
|
||||
prolog:'$stack_dump' :-
|
||||
'$stack_dump' :-
|
||||
yap_hacks:current_choicepoints(CPs),
|
||||
yap_hacks:current_continuations([Env|Envs]),
|
||||
yap_hacks:continuation(Env,_,ContP,_),
|
||||
|
||||
@ -29,12 +29,6 @@
|
||||
the GNU General Public License.
|
||||
*/
|
||||
|
||||
:- module('$history',
|
||||
[ %read_history/6,
|
||||
'$clean_history'/0,
|
||||
'$save_history'/1
|
||||
]).
|
||||
|
||||
%% read_history(+History, +Help, +DontStore, +Prompt, -Term, -Bindings)
|
||||
%
|
||||
% Give a prompt using Prompt. The sequence '%w' is substituted with the
|
||||
@ -49,7 +43,7 @@
|
||||
% call Goal and pretend it has not seen anything. This hook is used
|
||||
% by the GNU-Emacs interface to for communication between GNU-EMACS
|
||||
% and SWI-Prolog.
|
||||
prolog:read_history(History, Help, DontStore, Prompt, Term, Bindings) :-
|
||||
read_history(History, Help, DontStore, Prompt, Term, Bindings) :-
|
||||
repeat,
|
||||
prompt_history(Prompt),
|
||||
catch('$raw_read'(user_input, Raw), E,
|
||||
|
||||
60
pl/init.yap
60
pl/init.yap
@ -15,6 +15,8 @@
|
||||
* *
|
||||
*************************************************************************/
|
||||
|
||||
'prolog_booting'.
|
||||
|
||||
% This is yap's init file
|
||||
% should be consulted first step after booting
|
||||
|
||||
@ -67,13 +69,17 @@ otherwise.
|
||||
:- bootstrap('errors.yap').
|
||||
:- bootstrap('lists.yap').
|
||||
:- bootstrap('consult.yap').
|
||||
:- bootstrap('preddecls.yap').
|
||||
:- bootstrap('atoms.yap').
|
||||
:- bootstrap('os.yap').
|
||||
:- bootstrap('absf.yap').
|
||||
|
||||
:- [ 'utils.yap',
|
||||
'control.yap',
|
||||
'arith.yap',
|
||||
'directives.yap',
|
||||
'flags.yap'].
|
||||
'flags.yap'
|
||||
].
|
||||
|
||||
:- compile_expressions.
|
||||
|
||||
@ -156,14 +162,6 @@ yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
|
||||
:- '$swi_set_prolog_flag'(generate_debug_info,true).
|
||||
|
||||
|
||||
:- multifile user:library_directory/1.
|
||||
|
||||
:- dynamic user:library_directory/1.
|
||||
|
||||
:- multifile user:commons_directory/1.
|
||||
|
||||
:- dynamic user:commons_directory/1.
|
||||
|
||||
:- recorda('$dialect',yap,_).
|
||||
|
||||
%
|
||||
@ -200,24 +198,6 @@ yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
|
||||
|
||||
:- dynamic system:goal_expansion/2.
|
||||
|
||||
:- multifile user:prolog_file_type/2.
|
||||
|
||||
:- dynamic user:prolog_file_type/2.
|
||||
|
||||
user:prolog_file_type(yap, prolog).
|
||||
user:prolog_file_type(pl, prolog).
|
||||
user:prolog_file_type(prolog, prolog).
|
||||
user:prolog_file_type(A, prolog) :-
|
||||
current_prolog_flag(associate, A),
|
||||
A \== prolog,
|
||||
A \==pl,
|
||||
A \== yap.
|
||||
%user:prolog_file_type(qlf, prolog).
|
||||
%user:prolog_file_type(qlf, qlf).
|
||||
user:prolog_file_type(A, executable) :-
|
||||
current_prolog_flag(shared_object_extension, A).
|
||||
|
||||
|
||||
:- multifile goal_expansion/2.
|
||||
|
||||
:- dynamic goal_expansion/2.
|
||||
@ -230,10 +210,6 @@ user:prolog_file_type(A, executable) :-
|
||||
|
||||
:- dynamic system:term_expansion/2.
|
||||
|
||||
:- multifile file_search_path/2.
|
||||
|
||||
:- dynamic file_search_path/2.
|
||||
|
||||
:- multifile swi:swi_predicate_table/4.
|
||||
|
||||
:- multifile user:message_hook/3.
|
||||
@ -248,27 +224,9 @@ user:prolog_file_type(A, executable) :-
|
||||
|
||||
:- dynamic user:exception/3.
|
||||
|
||||
file_search_path(library, Dir) :-
|
||||
library_directory(Dir).
|
||||
file_search_path(commons, Dir) :-
|
||||
commons_directory(Dir).
|
||||
file_search_path(swi, Home) :-
|
||||
current_prolog_flag(home, Home).
|
||||
file_search_path(yap, Home) :-
|
||||
current_prolog_flag(home, Home).
|
||||
file_search_path(system, Dir) :-
|
||||
prolog_flag(host_type, Dir).
|
||||
file_search_path(foreign, yap('lib/Yap')).
|
||||
file_search_path(path, C) :-
|
||||
( getenv('PATH', A),
|
||||
( current_prolog_flag(windows, true)
|
||||
-> atomic_list_concat(B, ;, A)
|
||||
; atomic_list_concat(B, :, A)
|
||||
),
|
||||
lists:member(C, B)
|
||||
).
|
||||
|
||||
:- yap_flag(user:unknown,error).
|
||||
|
||||
:- stream_property(user_input, tty(true)) -> set_prolog_flag(readline, true) ; true.
|
||||
|
||||
|
||||
|
||||
|
||||
@ -20,9 +20,10 @@
|
||||
[system_message/4,
|
||||
prefix/6,
|
||||
prefix/5,
|
||||
file_location/3]).
|
||||
file_location/3,
|
||||
message/3]).
|
||||
|
||||
:- multifile prolog:message/3.
|
||||
:- multifile message/3.
|
||||
|
||||
:- multifile user:generate_message_hook/3.
|
||||
|
||||
@ -36,7 +37,6 @@ file_position(user_input,LN) -->
|
||||
file_position(FileName,LN) -->
|
||||
[ 'at line ~d in ~a,' - [LN,FileName] ].
|
||||
|
||||
|
||||
translate_message(Term) -->
|
||||
generate_message(Term), !.
|
||||
translate_message(Term) -->
|
||||
|
||||
@ -16,6 +16,20 @@
|
||||
*************************************************************************/
|
||||
% module handling
|
||||
|
||||
:- '$purge_clauses'(module(_,_), prolog).
|
||||
:- '$purge_clauses'('$module'(_,_), prolog).
|
||||
:- '$purge_clauses'(use_module(_), prolog).
|
||||
:- '$purge_clauses'(use_module(_,_), prolog).
|
||||
%
|
||||
% start using default definition of module.
|
||||
%
|
||||
|
||||
use_module(F) :-
|
||||
'$load_files'(F, [if(not_loaded),must_be_module(true)], use_module(F)).
|
||||
|
||||
use_module(F,Is) :-
|
||||
'$load_files'(F, [if(not_loaded),must_be_module(true),imports(Is)], use_module(F,Is)).
|
||||
|
||||
'$module'(_,N,P) :-
|
||||
'$module_dec'(N,P).
|
||||
|
||||
|
||||
122
pl/os.yap
Normal file
122
pl/os.yap
Normal file
@ -0,0 +1,122 @@
|
||||
/*************************************************************************
|
||||
* *
|
||||
* YAP Prolog *
|
||||
* *
|
||||
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
||||
* *
|
||||
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
||||
* *
|
||||
*************************************************************************/
|
||||
|
||||
:- module( '$os', [
|
||||
cd/0,
|
||||
cd/1,
|
||||
getcwd/1,
|
||||
ls/0,
|
||||
pwd/0,
|
||||
unix/1,
|
||||
putenv/2,
|
||||
getenv/2,
|
||||
setenv/2
|
||||
] ).
|
||||
|
||||
/**
|
||||
* @short YAP core Operating system interface.
|
||||
*
|
||||
*/
|
||||
|
||||
cd :-
|
||||
cd('~').
|
||||
|
||||
cd(F) :-
|
||||
absolute_file_name(F, Dir, [file_type(directory),file_errors(fail),access(execute),expand(true)]),
|
||||
working_directory(_, Dir).
|
||||
|
||||
getcwd(Dir) :- working_directory(Dir, Dir).
|
||||
|
||||
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(' ').
|
||||
|
||||
pwd :-
|
||||
getcwd(X),
|
||||
write(X), nl.
|
||||
|
||||
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).
|
||||
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(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))).
|
||||
|
||||
|
||||
putenv(Na,Val) :-
|
||||
'$putenv'(Na,Val).
|
||||
|
||||
getenv(Na,Val) :-
|
||||
'$getenv'(Na,Val).
|
||||
|
||||
setenv(Na,Val) :-
|
||||
'$putenv'(Na,Val).
|
||||
|
||||
149
pl/preddecls.yap
Normal file
149
pl/preddecls.yap
Normal file
@ -0,0 +1,149 @@
|
||||
/*************************************************************************
|
||||
* *
|
||||
* YAP Prolog *
|
||||
* *
|
||||
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
||||
* *
|
||||
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
||||
* *
|
||||
**************************************************************************
|
||||
* *
|
||||
* File: preds.yap *
|
||||
* Last rev: 8/2/88 *
|
||||
* mods: *
|
||||
* comments: Predicate Manipulation for YAP: declaration support *
|
||||
* *
|
||||
*************************************************************************/
|
||||
|
||||
%
|
||||
% can only do as goal in YAP mode.
|
||||
%
|
||||
dynamic(X) :- '$access_yap_flags'(8, 0), !,
|
||||
'$current_module'(M),
|
||||
'$dynamic'(X, M).
|
||||
dynamic(X) :-
|
||||
'$do_error'(context_error(dynamic(X),declaration),query).
|
||||
|
||||
'$dynamic'(X,M) :- var(X), !,
|
||||
'$do_error'(instantiation_error,dynamic(M:X)).
|
||||
'$dynamic'(Mod:Spec,_) :- !,
|
||||
'$dynamic'(Spec,Mod).
|
||||
'$dynamic'([], _) :- !.
|
||||
'$dynamic'([H|L], M) :- !, '$dynamic'(H, M), '$dynamic'(L, M).
|
||||
'$dynamic'((A,B),M) :- !, '$dynamic'(A,M), '$dynamic'(B,M).
|
||||
'$dynamic'(X,M) :-
|
||||
'$dynamic2'(X,M).
|
||||
|
||||
'$dynamic2'(X, Mod) :- '$log_upd'(Stat), Stat\=0, !,
|
||||
'$logical_updatable'(X, Mod).
|
||||
'$dynamic2'(A//N1, Mod) :-
|
||||
integer(N1),
|
||||
N is N1+2,
|
||||
'$dynamic2'(A/N, Mod).
|
||||
'$dynamic2'(A/N, Mod) :-
|
||||
integer(N), atom(A), !,
|
||||
functor(T,A,N), '$flags'(T,Mod,F,F),
|
||||
% LogUpd,BinaryTest,Safe,C,Dynamic,Compiled,Standard,Asm,
|
||||
( F/\ 0x19D1FA80 =:= 0, '$undefined'(T,Mod) -> NF is F \/ 0x00002000, '$flags'(T, Mod, F, NF), '$mk_d'(T,Mod);
|
||||
F /\ 0x00002000 =:= 0x00002000 -> '$mk_d'(T,Mod); % dynamic
|
||||
F /\ 0x08000000 =:= 0x08000000 -> '$mk_d'(T,Mod) ; % LU
|
||||
F /\ 0x00000400 =:= 0x00000400, '$undefined'(T,Mod) -> F1 is F /\ \(0x400), N1F is F1 \/ 0x00002000, NF is N1F /\ \(0x00400000), '$flags'(T,Mod,F,NF), '$mk_d'(T,Mod);
|
||||
'$do_error'(permission_error(modify,static_procedure,A/N),dynamic(Mod:A/N))
|
||||
).
|
||||
'$dynamic2'(X,Mod) :-
|
||||
'$do_error'(type_error(callable,X),dynamic(Mod:X)).
|
||||
|
||||
'$logical_updatable'(A//N,Mod) :- integer(N), !,
|
||||
N1 is N+2,
|
||||
'$logical_updatable'(A/N1,Mod).
|
||||
'$logical_updatable'(A/N,Mod) :- integer(N), atom(A), !,
|
||||
functor(T,A,N), '$flags'(T,Mod,F,F),
|
||||
(
|
||||
F/\ 0x19D1FA80 =:= 0, '$undefined'(T,Mod) -> NF is F \/ 0x08000400, '$flags'(T,Mod,F,NF), '$mk_d'(T,Mod);
|
||||
F /\ 0x08000000 =:= 0x08000000 -> '$mk_d'(T,Mod) ; % LU
|
||||
F /\ 0x00002000 =:= 0x00002000 -> '$mk_d'(T,Mod); % dynamic
|
||||
F /\ 0x00000400 =:= 0x00000400 , '$undefined'(T,Mod) -> N1F is F \/ 0x08000000, NF is N1F /\ \(0x00400000), '$flags'(T,Mod,F,NF), '$mk_d'(T,Mod);
|
||||
'$do_error'(permission_error(modify,static_procedure,A/N),dynamic(Mod:A/N))
|
||||
).
|
||||
'$logical_updatable'(X,Mod) :-
|
||||
'$do_error'(type_error(callable,X),dynamic(Mod:X)).
|
||||
|
||||
multifile(P) :-
|
||||
'$current_module'(OM),
|
||||
'$multifile'(P, M).
|
||||
|
||||
'$multifile'(V, _) :- var(V), !,
|
||||
'$do_error'(instantiation_error,multifile(V)).
|
||||
'$multifile'((X,Y), M) :- !, '$multifile'(X, M), '$multifile'(Y, M).
|
||||
'$multifile'(Mod:PredSpec, _) :- !,
|
||||
'$multifile'(PredSpec, Mod).
|
||||
'$multifile'(N//A, M) :- !,
|
||||
integer(A),
|
||||
A1 is A+2,
|
||||
'$multifile'(N/A1, M).
|
||||
'$multifile'(N/A, M) :-
|
||||
'$add_multifile'(N,A,M),
|
||||
fail.
|
||||
'$multifile'(N/A, M) :-
|
||||
functor(S,N,A),
|
||||
'$is_multifile'(S, M), !.
|
||||
'$multifile'(N/A, M) :- !,
|
||||
'$new_multifile'(N,A,M).
|
||||
'$multifile'([H|T], M) :- !,
|
||||
'$multifile'(H,M),
|
||||
'$multifile'(T,M).
|
||||
'$multifile'(P, M) :-
|
||||
'$do_error'(type_error(predicate_indicator,P),multifile(M:P)).
|
||||
|
||||
discontiguous(V) :-
|
||||
var(V), !,
|
||||
'$do_error'(instantiation_error,discontiguous(V)).
|
||||
discontiguous(M:F) :- !,
|
||||
'$discontiguous'(F,M).
|
||||
discontiguous(F) :-
|
||||
'$current_module'(M),
|
||||
'$discontiguous'(F,M).
|
||||
|
||||
'$discontiguous'(V,M) :- var(V), !,
|
||||
'$do_error'(instantiation_error,M:discontiguous(V)).
|
||||
'$discontiguous'((X,Y),M) :- !,
|
||||
'$discontiguous'(X,M),
|
||||
'$discontiguous'(Y,M).
|
||||
'$discontiguous'(M:A,_) :- !,
|
||||
'$discontiguous'(A,M).
|
||||
'$discontiguous'(N//A1, M) :- !,
|
||||
integer(A1), !,
|
||||
A is A1+2,
|
||||
'$discontiguous'(N/A, M).
|
||||
'$discontiguous'(N/A, M) :- !,
|
||||
( recordzifnot('$discontiguous_defs','$df'(N,A,M),_) ->
|
||||
true
|
||||
;
|
||||
true
|
||||
).
|
||||
'$discontiguous'(P,M) :-
|
||||
'$do_error'(type_error(predicate_indicator,P),M:discontiguous(P)).
|
||||
|
||||
%
|
||||
% did we declare multifile properly?
|
||||
%
|
||||
'$check_multifile_pred'(Hd, M, _) :-
|
||||
functor(Hd,Na,Ar),
|
||||
source_location(F, _),
|
||||
recorded('$multifile_defs','$defined'(F,Na,Ar,M),_), !.
|
||||
% oops, we did not.
|
||||
'$check_multifile_pred'(Hd, M, Fl) :-
|
||||
% so this is not a multi-file predicate any longer.
|
||||
functor(Hd,Na,Ar),
|
||||
NFl is \(0x20000000) /\ Fl,
|
||||
'$flags'(Hd,M,Fl,NFl),
|
||||
'$warn_mfile'(Na,Ar).
|
||||
|
||||
'$warn_mfile'(F,A) :-
|
||||
write(user_error,'% Warning: predicate '),
|
||||
write(user_error,F/A), write(user_error,' was a multifile predicate '),
|
||||
write(user_error,' (line '),
|
||||
'$start_line'(LN), write(user_error,LN),
|
||||
write(user_error,')'),
|
||||
nl(user_error).
|
||||
|
||||
80
pl/preds.yap
80
pl/preds.yap
@ -311,31 +311,6 @@ clause(V,Q,R) :-
|
||||
'$do_error'(permission_error(access,private_procedure,Name/Arity),
|
||||
clause(M:P,Q,R)).
|
||||
|
||||
% just create a choice-point
|
||||
% the 6th argument marks the time-stamp.
|
||||
'$do_log_upd_clause'(_,_,_,_,_,_).
|
||||
'$do_log_upd_clause'(A,B,C,D,E,_) :-
|
||||
'$continue_log_update_clause'(A,B,C,D,E).
|
||||
'$do_log_upd_clause'(_,_,_,_,_,_).
|
||||
|
||||
|
||||
'$do_log_upd_clause_erase'(_,_,_,_,_,_).
|
||||
'$do_log_upd_clause_erase'(A,B,C,D,E,_) :-
|
||||
'$continue_log_update_clause_erase'(A,B,C,D,E).
|
||||
'$do_log_upd_clause_erase'(_,_,_,_,_,_).
|
||||
|
||||
'$do_log_upd_clause0'(_,_,_,_,_,_).
|
||||
'$do_log_upd_clause0'(A,B,C,D,_,_) :-
|
||||
'$continue_log_update_clause'(A,B,C,D).
|
||||
'$do_log_upd_clause0'(_,_,_,_,_,_).
|
||||
|
||||
|
||||
'$do_static_clause'(_,_,_,_,_).
|
||||
'$do_static_clause'(A,B,C,D,E) :-
|
||||
'$continue_static_clause'(A,B,C,D,E).
|
||||
'$do_static_clause'(_,_,_,_,_).
|
||||
|
||||
|
||||
'$init_preds' :-
|
||||
once('$handle_throw'(_,_,_)),
|
||||
fail.
|
||||
@ -663,61 +638,6 @@ abolish(X) :-
|
||||
'$purge_clauses'(G, M), fail.
|
||||
'$abolishs'(_, _).
|
||||
|
||||
%
|
||||
% can only do as goal in YAP mode.
|
||||
%
|
||||
dynamic(X) :- '$access_yap_flags'(8, 0), !,
|
||||
'$current_module'(M),
|
||||
'$dynamic'(X, M).
|
||||
dynamic(X) :-
|
||||
'$do_error'(context_error(dynamic(X),declaration),query).
|
||||
|
||||
'$dynamic'(X,M) :- var(X), !,
|
||||
'$do_error'(instantiation_error,dynamic(M:X)).
|
||||
'$dynamic'(Mod:Spec,_) :- !,
|
||||
'$dynamic'(Spec,Mod).
|
||||
'$dynamic'([], _) :- !.
|
||||
'$dynamic'([H|L], M) :- !, '$dynamic'(H, M), '$dynamic'(L, M).
|
||||
'$dynamic'((A,B),M) :- !, '$dynamic'(A,M), '$dynamic'(B,M).
|
||||
'$dynamic'(X,M) :-
|
||||
'$dynamic2'(X,M).
|
||||
|
||||
'$dynamic2'(X, Mod) :- '$log_upd'(Stat), Stat\=0, !,
|
||||
'$logical_updatable'(X, Mod).
|
||||
'$dynamic2'(A//N1, Mod) :-
|
||||
integer(N1),
|
||||
N is N1+2,
|
||||
'$dynamic2'(A/N, Mod).
|
||||
'$dynamic2'(A/N, Mod) :-
|
||||
integer(N), atom(A), !,
|
||||
functor(T,A,N), '$flags'(T,Mod,F,F),
|
||||
% LogUpd,BinaryTest,Safe,C,Dynamic,Compiled,Standard,Asm,
|
||||
( F/\ 0x19D1FA80 =:= 0, '$undefined'(T,Mod) -> NF is F \/ 0x00002000, '$flags'(T, Mod, F, NF), '$mk_d'(T,Mod);
|
||||
F /\ 0x00002000 =:= 0x00002000 -> '$mk_d'(T,Mod); % dynamic
|
||||
F /\ 0x08000000 =:= 0x08000000 -> '$mk_d'(T,Mod) ; % LU
|
||||
F /\ 0x00000400 =:= 0x00000400, '$undefined'(T,Mod) -> F1 is F /\ \(0x400), N1F is F1 \/ 0x00002000, NF is N1F /\ \(0x00400000), '$flags'(T,Mod,F,NF), '$mk_d'(T,Mod);
|
||||
'$do_error'(permission_error(modify,static_procedure,A/N),dynamic(Mod:A/N))
|
||||
).
|
||||
'$dynamic2'(X,Mod) :-
|
||||
'$do_error'(type_error(callable,X),dynamic(Mod:X)).
|
||||
|
||||
|
||||
'$logical_updatable'(A//N,Mod) :- integer(N), !,
|
||||
N1 is N+2,
|
||||
'$logical_updatable'(A/N1,Mod).
|
||||
'$logical_updatable'(A/N,Mod) :- integer(N), atom(A), !,
|
||||
functor(T,A,N), '$flags'(T,Mod,F,F),
|
||||
(
|
||||
F/\ 0x19D1FA80 =:= 0, '$undefined'(T,Mod) -> NF is F \/ 0x08000400, '$flags'(T,Mod,F,NF), '$mk_d'(T,Mod);
|
||||
F /\ 0x08000000 =:= 0x08000000 -> '$mk_d'(T,Mod) ; % LU
|
||||
F /\ 0x00002000 =:= 0x00002000 -> '$mk_d'(T,Mod); % dynamic
|
||||
F /\ 0x00000400 =:= 0x00000400 , '$undefined'(T,Mod) -> N1F is F \/ 0x08000000, NF is N1F /\ \(0x00400000), '$flags'(T,Mod,F,NF), '$mk_d'(T,Mod);
|
||||
'$do_error'(permission_error(modify,static_procedure,A/N),dynamic(Mod:A/N))
|
||||
).
|
||||
'$logical_updatable'(X,Mod) :-
|
||||
'$do_error'(type_error(callable,X),dynamic(Mod:X)).
|
||||
|
||||
|
||||
dynamic_predicate(P,Sem) :-
|
||||
'$bad_if_is_semantics'(Sem, dynamic(P,Sem)).
|
||||
dynamic_predicate(P,Sem) :-
|
||||
|
||||
@ -238,9 +238,16 @@ writeln(M:B),
|
||||
retractall(user:library_directory(_)),
|
||||
% make sure library_directory is open.
|
||||
\+ clause(user:library_directory(_),_),
|
||||
'$system_library_directories'(D),
|
||||
'$system_library_directories'(library,D),
|
||||
assert(user:library_directory(D)),
|
||||
fail.
|
||||
'$init_path_extensions' :-
|
||||
retractall(user:library_directory(_)),
|
||||
% make sure library_directory is open.
|
||||
\+ clause(user:library_directory(_),_),
|
||||
'$system_library_directories'(commons,D),
|
||||
assert(user:commons_directory(D)),
|
||||
fail.
|
||||
'$init_path_extensions'.
|
||||
|
||||
% then we can execute the programs.
|
||||
|
||||
@ -16,7 +16,7 @@
|
||||
*************************************************************************/
|
||||
|
||||
%%% Saving and restoring a computation
|
||||
|
||||
/*
|
||||
save(A) :- save(A,_).
|
||||
|
||||
save(A,_) :- var(A), !,
|
||||
@ -81,3 +81,4 @@ restore(A) :- var(A), !,
|
||||
restore(A) :- atom(A), !, name(A,S), '$restore'(S).
|
||||
restore(S) :- '$restore'(S).
|
||||
|
||||
*/
|
||||
|
||||
@ -63,7 +63,7 @@
|
||||
fail.
|
||||
'$do_signal'(sig_stack_dump, [M|G]) :-
|
||||
'$continue_signals',
|
||||
'$stack_dump',
|
||||
'$hacks':'$stack_dump',
|
||||
'$execute0'(G,M).
|
||||
% Unix signals
|
||||
'$do_signal'(sig_alarm, G) :-
|
||||
|
||||
201
pl/utils.yap
201
pl/utils.yap
@ -213,103 +213,6 @@ current_op(X,Y,Z) :-
|
||||
).
|
||||
|
||||
|
||||
%%% Operating System utilities
|
||||
|
||||
cd :-
|
||||
cd('~').
|
||||
|
||||
cd(F) :-
|
||||
absolute_file_name(F, Dir, [file_type(directory),file_errors(fail),access(execute),expand(true)]),
|
||||
working_directory(_, Dir).
|
||||
|
||||
getcwd(Dir) :- working_directory(Dir, Dir).
|
||||
|
||||
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(' ').
|
||||
|
||||
pwd :-
|
||||
getcwd(X),
|
||||
write(X), nl.
|
||||
|
||||
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).
|
||||
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(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))).
|
||||
|
||||
|
||||
putenv(Na,Val) :-
|
||||
'$putenv'(Na,Val).
|
||||
|
||||
getenv(Na,Val) :-
|
||||
'$getenv'(Na,Val).
|
||||
|
||||
setenv(Na,Val) :-
|
||||
'$putenv'(Na,Val).
|
||||
|
||||
prolog :-
|
||||
'$live'.
|
||||
|
||||
@ -331,113 +234,9 @@ recordzifnot(K,T,R) :-
|
||||
recordzifnot(K,T,R) :-
|
||||
recordz(K,T,R).
|
||||
|
||||
current_atom(A) :- % check
|
||||
atom(A), !.
|
||||
current_atom(A) :- % generate
|
||||
'$current_atom'(A).
|
||||
current_atom(A) :- % generate
|
||||
'$current_wide_atom'(A).
|
||||
|
||||
atom_concat(Xs,At) :-
|
||||
( var(At) ->
|
||||
'$atom_concat'(Xs, At )
|
||||
;
|
||||
'$atom_concat_constraints'(Xs, 0, At, Unbound),
|
||||
'$process_atom_holes'(Unbound)
|
||||
).
|
||||
|
||||
% the constraints are of the form hole: HoleAtom, Begin, Atom, End
|
||||
'$atom_concat_constraints'([At], 0, At, []) :- !.
|
||||
'$atom_concat_constraints'([At0], mid(Next, At), At, [hole(At0, Next, At, end)]) :- !.
|
||||
% just slice first atom
|
||||
'$atom_concat_constraints'([At0|Xs], 0, At, Unbound) :-
|
||||
atom(At0), !,
|
||||
sub_atom(At, 0, Sz, L, At0 ),
|
||||
sub_atom(At, _, L, 0, Atr ), %remainder
|
||||
'$atom_concat_constraints'(Xs, 0, Atr, Unbound).
|
||||
% first hole: Follow says whether we have two holes in a row, At1 will be our atom
|
||||
'$atom_concat_constraints'([At0|Xs], 0, At, [hole(At0, 0, At, Next)|Unbound]) :-
|
||||
'$atom_concat_constraints'(Xs, mid(Next,At1), At, Unbound).
|
||||
% end of a run
|
||||
'$atom_concat_constraints'([At0|Xs], mid(end, At1), At, Unbound) :-
|
||||
atom(At0), !,
|
||||
sub_atom(At, Next, Sz, L, At0),
|
||||
sub_atom(At, 0, Next, Next, At1),
|
||||
sub_atom(At, _, L, 0, Atr), %remainder
|
||||
'$atom_concat_constraints'(Xs, 0, Atr, Unbound).
|
||||
'$atom_concat_constraints'([At0|Xs], mid(Next,At1), At, Next, [hole(At0, Next, At, Follow)|Unbound]) :-
|
||||
'$atom_concat_constraints'(Xs, mid(NextFollow, At1), At, Unbound).
|
||||
|
||||
'$process_atom_holes'([]).
|
||||
'$process_atom_holes'([hole(At0, Next, At1, End)|Unbound]) :- End == end, !,
|
||||
sub_atom(At1, Next, _, 0, At0),
|
||||
'$process_atom_holes'(Unbound).
|
||||
'$process_atom_holes'([hole(At0, Next, At1, Follow)|Unbound]) :-
|
||||
sub_atom(At1, Next, Sz, _Left, At0),
|
||||
Follow is Next+Sz,
|
||||
'$process_atom_holes'(Unbound).
|
||||
|
||||
|
||||
callable(A) :-
|
||||
( var(A) -> fail ; number(A) -> fail ; true ).
|
||||
|
||||
atomic_list_concat(L,At) :-
|
||||
atomic_concat(L, At).
|
||||
|
||||
atomic_list_concat(L, El, At) :-
|
||||
var(El), !,
|
||||
'$do_error'(instantiation_error,atom_list_concat(L,El,At)).
|
||||
atomic_list_concat(L, El, At) :-
|
||||
nonvar(L), !,
|
||||
'$add_els'(L,El,LEl),
|
||||
atomic_concat(LEl, At).
|
||||
atomic_list_concat(L, El, At) :-
|
||||
nonvar(At), !,
|
||||
atom_codes(At, S),
|
||||
atom_codes(El, [ElS]),
|
||||
'$split_elements'(S, ElS, SubS),
|
||||
'$atomify_list'(SubS, L).
|
||||
|
||||
'$add_els'([A,B|L],El,[A,El|NL]) :- !,
|
||||
'$add_els'([B|L],El,NL).
|
||||
'$add_els'(L,_,L).
|
||||
|
||||
'$split_elements'(E.S, E, SubS) :- !,
|
||||
'$split_elements'(S, E, SubS).
|
||||
'$split_elements'(E1.S, E, [E1|L].SubS) :- !,
|
||||
'$split_elements'(S, E, L, SubS).
|
||||
'$split_elements'([], _, []).
|
||||
|
||||
'$split_elements'([], _, [], []).
|
||||
'$split_elements'(E.S, E, [], SubS) :- !,
|
||||
'$split_elements'(S, E, SubS).
|
||||
'$split_elements'(E1.S, E, E1.L, SubS) :-
|
||||
'$split_elements'(S, E, L, SubS).
|
||||
|
||||
'$atomify_list'([], []).
|
||||
'$atomify_list'(S.SubS, A.L) :-
|
||||
atom_codes(A, S),
|
||||
'$atomify_list'(SubS, L).
|
||||
|
||||
|
||||
%
|
||||
% small compatibility hack
|
||||
|
||||
'$singletons_in_term'(T,VL) :-
|
||||
'$variables_in_term'(T,[],V10),
|
||||
'$sort'(V10, V1),
|
||||
'$non_singletons_in_term'(T,[],V20),
|
||||
'$sort'(V20, V2),
|
||||
'$subtract_lists_of_variables'(V2,V1,VL).
|
||||
|
||||
'$subtract_lists_of_variables'([],VL,VL).
|
||||
'$subtract_lists_of_variables'([_|_],[],[]) :- !.
|
||||
'$subtract_lists_of_variables'([V1|VL1],[V2|VL2],VL) :-
|
||||
V1 == V2, !,
|
||||
'$subtract_lists_of_variables'(VL1,VL2,VL).
|
||||
'$subtract_lists_of_variables'([V1|VL1],[V2|VL2],[V2|VL]) :-
|
||||
'$subtract_lists_of_variables'([V1|VL1],VL2,VL).
|
||||
|
||||
simple(V) :- var(V), !.
|
||||
simple(A) :- atom(A), !.
|
||||
simple(N) :- number(N).
|
||||
|
||||
Reference in New Issue
Block a user