diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Prolog dialect support

Browse Source
This commit is contained in:
Vitor Santos Costa 2009-03-06 10:59:02 +00:00
parent f01fd0fbee
commit 66931e6518
3 changed files with 696 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
library/dialect/commons.yap Normal file
View File

@ -0,0 +1,9 @@
%
% support for commons file.
%
:- style_check(all).
:- yap_flag(unknown,error).

265
library/dialect/hprolog.yap Normal file
View File

@ -0,0 +1,265 @@
/* Part of SWI-Prolog
Author: Tom Schrijvers, Bart Demoen, Jan Wielemaker
E-mail: Tom.Schrijvers@cs.kuleuven.be
WWW: http://www.swi-prolog.org
Copyright (C): 2004-2008, K.U. Leuven
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
As a special exception, if you link this library with other files,
compiled with a Free Software compiler, to produce an executable, this
library does not by itself cause the resulting executable to be covered
by the GNU General Public License. This exception does not however
invalidate any other reasons why the executable file might be covered by
the GNU General Public License.
*/
:- module(hprolog,
[ substitute_eq/4, % +OldVal, +OldList, +NewVal, -NewList
memberchk_eq/2, % +Val, +List
intersect_eq/3, % +List1, +List2, -Intersection
list_difference_eq/3, % +List, -Subtract, -Rest
take/3, % +N, +List, -FirstElements
drop/3, % +N, +List, -LastElements
split_at/4, % +N, +List, -FirstElements, -LastElements
max_go_list/2, % +List, -Max
or_list/2, % +ListOfInts, -BitwiseOr
chr_sublist/2, % ?Sublist, +List
bounded_sublist/3, % ?Sublist, +List, +Bound
chr_delete/3,
init_store/2,
get_store/2,
update_store/2,
make_get_store_goal/3,
make_update_store_goal/3,
make_init_store_goal/3,
empty_ds/1,
ds_to_list/2,
get_ds/3,
put_ds/4
% lookup_ht1/4
]).
:- use_module(library(lists)).
:- use_module(library(assoc)).
/** <module> hProlog compatibility library
This library has been developed mainly for porting the CHR package.
@author Tom Schrijvers
@author Bart Demoen
@author Jan Wielemaker
@tbd Ultimately, this must disappear. Generally useful predicates
must be moved to their appropriate library. Others must be moved
into the CHR utilities.
*/
empty_ds(DS) :- empty_assoc(DS).
ds_to_list(DS,LIST) :- assoc_to_list(DS,LIST).
get_ds(A,B,C) :- get_assoc(A,B,C).
put_ds(A,B,C,D) :- put_assoc(A,B,C,D).
init_store(Name,Value) :- nb_setval(Name,Value).
get_store(Name,Value) :- nb_getval(Name,Value).
update_store(Name,Value) :- b_setval(Name,Value).
make_init_store_goal(Name,Value,Goal) :- Goal = nb_setval(Name,Value).
make_get_store_goal(Name,Value,Goal) :- Goal = nb_getval(Name,Value).
make_update_store_goal(Name,Value,Goal) :- Goal = b_setval(Name,Value).
/*******************************
* MORE LIST OPERATIONS *
*******************************/
%% substitute_eq(+OldVal, +OldList, +NewVal, -NewList)
%
% Substitute OldVal by NewVal in OldList and unify the result
% with NewList.
substitute_eq(_, [], _, []) :- ! .
substitute_eq(X, [U|Us], Y, [V|Vs]) :-
( X == U
-> V = Y,
substitute_eq(X, Us, Y, Vs)
; V = U,
substitute_eq(X, Us, Y, Vs)
).
%% memberchk_eq(+Val, +List)
%
% Deterministic check of membership using == rather than
% unification.
memberchk_eq(X, [Y|Ys]) :-
( X == Y
-> true
; memberchk_eq(X, Ys)
).
% :- load_foreign_library(chr_support).
%% list_difference_eq(+List, -Subtract, -Rest)
%
% Delete all elements of Subtract from List and unify the result
% with Rest. Element comparision is done using ==/2.
list_difference_eq([],_,[]).
list_difference_eq([X|Xs],Ys,L) :-
( memberchk_eq(X,Ys)
-> list_difference_eq(Xs,Ys,L)
; L = [X|T],
list_difference_eq(Xs,Ys,T)
).
%% intersect_eq(+List1, +List2, -Intersection)
%
% Determine the intersection of two lists without unifying values.
intersect_eq([], _, []).
intersect_eq([X|Xs], Ys, L) :-
( memberchk_eq(X, Ys)
-> L = [X|T],
intersect_eq(Xs, Ys, T)
; intersect_eq(Xs, Ys, L)
).
%% take(+N, +List, -FirstElements)
%
% Take the first N elements from List and unify this with
% FirstElements. The definition is based on the GNU-Prolog lists
% library. Implementation by Jan Wielemaker.
take(0, _, []) :- !.
take(N, [H|TA], [H|TB]) :-
N > 0,
N2 is N - 1,
take(N2, TA, TB).
%% drop(+N, +List, -ListMinFirstN) is semidet.
%
% Drop the first N elements from List and unify the remainder with
% LastElements.
drop(0,LastElements,LastElements) :- !.
drop(N,[_|Tail],LastElements) :-
N > 0,
N1 is N - 1,
drop(N1,Tail,LastElements).
%% split_at(+N, +List, +FirstN, -Rest) is semidet.
%
% Combines take/3 and drop/3.
split_at(0,L,[],L) :- !.
split_at(N,[H|T],[H|L1],L2) :-
M is N -1,
split_at(M,T,L1,L2).
%% max_go_list(+List, -Max)
%
% Return the maximum of List in the standard order of terms.
max_go_list([H|T], Max) :-
max_go_list(T, H, Max).
max_go_list([], Max, Max).
max_go_list([H|T], X, Max) :-
( H @=< X
-> max_go_list(T, X, Max)
; max_go_list(T, H, Max)
).
%% or_list(+ListOfInts, -BitwiseOr)
%
% Do a bitwise disjuction over all integer members of ListOfInts.
or_list(L, Or) :-
or_list(L, 0, Or).
or_list([], Or, Or).
or_list([H|T], Or0, Or) :-
Or1 is H \/ Or0,
or_list(T, Or1, Or).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% sublist(?Sub, +List) is nondet.
%
% True if all elements of Sub appear in List in the same order.
chr_sublist(L, L).
chr_sublist(Sub, [H|T]) :-
'$sublist1'(T, H, Sub).
'$sublist1'(Sub, _, Sub).
'$sublist1'([H|T], _, Sub) :-
'$sublist1'(T, H, Sub).
'$sublist1'([H|T], X, [X|Sub]) :-
'$sublist1'(T, H, Sub).
%% bounded_sublist(?Sub, +List, +Bound:integer)
%
% As sublist/2, but Sub has at most Bound elements. E.g. the call
% below generates all 21 sublists of length =< 2 from the second
% argument.
%
% ==
% ?- bounded_sublist(List, [a,b,c,d], 2).
% X = [] ;
% X = [a] ;
% X = [a, b] ;
% X = [a] ;
% ...
% ==
bounded_sublist(Sublist,_,_) :-
Sublist = [].
bounded_sublist(Sublist,[H|List],Bound) :-
Bound > 0,
(
Sublist = [H|Rest],
NBound is Bound - 1,
bounded_sublist(Rest,List,NBound)
;
bounded_sublist(Sublist,List,Bound)
).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% chr_delete(+List, +Element, -Rest) is det.
%
% Rest is a copy of List without elements matching Element using
% ==.
chr_delete([], _, []).
chr_delete([H|T], X, L) :-
( H==X ->
chr_delete(T, X, L)
; L=[H|RT],
chr_delete(T, X, RT)
).

422
library/dialect/swi.yap Normal file
View File

@ -0,0 +1,422 @@
:- source.
:- style_check(all).
:- yap_flag(unknown,error).
:- yap_flag(open_expands_filename,false).
% redefines stuff in prolog module.
:- module(swi, []).
:- ensure_loaded(library(atts)).
:- use_module(library(charsio),[write_to_chars/2,read_from_chars/2]).
:- use_module(library(lists),[append/2,
append/3,
delete/3,
member/2,
min_list/2,
nth1/3,
nth0/3]).
:- use_module(library(system),
[datime/1,
mktime/2,
sleep/1]).
:- use_module(library(arg),
[genarg/3]).
:- use_module(library(terms),
[subsumes/2,
term_hash/2,
unifiable/3,
variant/2]).
:- unhide('$system_library_directories'),
unhide('$dir_separator').
% make sure we also use
:- user:library_directory(X),
atom(X),
atom_concat([X,'/swi'],SwiDir),
\+ user:library_directory(SwiDir),
asserta(user:library_directory(SwiDir)),
fail
;
true.
:- multifile user:term_expansion/2.
:- multifile user:goal_expansion/3.
:- multifile swi_predicate_table/4.
swi_predicate_table(_,append(X,Y),lists,append(X,Y)).
swi_predicate_table(_,append(X,Y,Z),lists,append(X,Y,Z)).
swi_predicate_table(_,member(X,Y),lists,member(X,Y)).
swi_predicate_table(_,nextto(X,Y,Z),lists,nextto(X,Y,Z)).
swi_predicate_table(_,delete(X,Y,Z),lists,delete(X,Y,Z)).
swi_predicate_table(_,select(X,Y,Z),lists,select(X,Y,Z)).
swi_predicate_table(_,selectchk(X,Y,Z),lists,selectchk(X,Y,Z)).
swi_predicate_table(_,nth0(X,Y,Z),lists,nth0(X,Y,Z)).
swi_predicate_table(_,nth1(X,Y,Z),lists,nth1(X,Y,Z)).
swi_predicate_table(_,last(X,Y),lists,last(X,Y)).
swi_predicate_table(_,reverse(X,Y),lists,reverse(X,Y)).
swi_predicate_table(_,permutation(X,Y),lists,permutation(X,Y)).
swi_predicate_table(_,flatten(X,Y),lists,flatten(X,Y)).
swi_predicate_table(_,sumlist(X,Y),lists,sumlist(X,Y)).
swi_predicate_table(_,min_list(X,Y),lists,min_list(X,Y)).
swi_predicate_table(_,max_list(X,Y),lists,max_list(X,Y)).
swi_predicate_table(_,memberchk(X,Y),lists,memberchk(X,Y)).
swi_predicate_table(_,flatten(X,Y),lists,flatten(X,Y)).
swi_predicate_table(_,select(X,Y,Z),lists,select(X,Y,Z)).
swi_predicate_table(_,sublist(X,Y),lists,sublist(X,Y)).
swi_predicate_table(_,hash_term(X,Y),terms,term_hash(X,Y)).
swi_predicate_table(_,term_hash(X,Y),terms,term_hash(X,Y)).
swi_predicate_table(_,subsumes(X,Y),terms,subsumes(X,Y)).
swi_predicate_table(_,unifiable(X,Y,Z),terms,unifiable(X,Y,Z)).
swi_predicate_table(_,genarg(X,Y,Z),arg,genarg(X,Y,Z)).
swi_predicate_table(_,tmp_file(X,Y),system,tmp_file(X,Y)).
swi_isl(X) :- lists:is_list(X).
prolog:is_list(X) :- swi_isl(X).
swi_mchk(X,Y) :- lists:memberchk(X,Y).
prolog:memberchk(X,Y) :- swi_mchk(X,Y).
:- dynamic
prolog:message/3.
:- multifile
prolog:message/3.
:- multifile
user:file_search_path/2.
:- dynamic
user:file_search_path/2.
user:file_search_path(swi, Home) :-
current_prolog_flag(home, Home).
user:file_search_path(foreign, swi(ArchLib)) :-
current_prolog_flag(arch, Arch),
atom_concat('lib/', Arch, ArchLib).
user:file_search_path(foreign, swi(lib)).
:- meta_predicate prolog:predsort(:,+,-).
prolog:plus(X, Y, Z) :-
integer(X),
integer(Y), !,
Z is X + Y.
prolog:plus(X, Y, Z) :-
integer(X),
integer(Z), !,
Y is Z - X.
prolog:plus(X, Y, Z) :-
integer(Y),
integer(Z), !,
X is Z - Y.
%% predsort(:Compare, +List, -Sorted) is det.
%
% Sorts similar to sort/2, but determines the order of two terms
% by calling Compare(-Delta, +E1, +E2). This call must unify
% Delta with one of <, > or =. If built-in predicate compare/3 is
% used, the result is the same as sort/2. See also keysort/2.
prolog:predsort(P, L, R) :-
length(L, N),
predsort(P, N, L, _, R1), !,
R = R1.
predsort(P, 2, [X1, X2|L], L, R) :- !,
call(P, Delta, X1, X2),
sort2(Delta, X1, X2, R).
predsort(_, 1, [X|L], L, [X]) :- !.
predsort(_, 0, L, L, []) :- !.
predsort(P, N, L1, L3, R) :-
N1 is N // 2,
plus(N1, N2, N),
predsort(P, N1, L1, L2, R1),
predsort(P, N2, L2, L3, R2),
predmerge(P, R1, R2, R).
sort2(<, X1, X2, [X1, X2]).
sort2(=, X1, _, [X1]).
sort2(>, X1, X2, [X2, X1]).
predmerge(_, [], R, R) :- !.
predmerge(_, R, [], R) :- !.
predmerge(P, [H1|T1], [H2|T2], Result) :-
call(P, Delta, H1, H2),
predmerge(Delta, P, H1, H2, T1, T2, Result).
predmerge(>, P, H1, H2, T1, T2, [H2|R]) :-
predmerge(P, [H1|T1], T2, R).
predmerge(=, P, H1, _, T1, T2, [H1|R]) :-
predmerge(P, T1, T2, R).
predmerge(<, P, H1, H2, T1, T2, [H1|R]) :-
predmerge(P, T1, [H2|T2], R).
%
% maybe a good idea to eventually support this in YAP.
% but for now just ignore it.
%
:- meta_predicate prolog:volatile(:).
:- op(1150, fx, 'volatile').
prolog:volatile(P) :- var(P),
throw(error(instantiation_error,volatile(P))).
prolog:volatile(M:P) :-
do_volatile(P,M).
prolog:volatile((G1,G2)) :-
prolog:volatile(G1),
prolog:volatile(G2).
prolog:volatile(P) :-
do_volatile(P,_).
prolog:load_foreign_library(P,Command) :-
absolute_file_name(P,[file_type(executable),solutions(first),file_errors(fail)],Lib),
load_foreign_files([Lib],[],Command).
prolog:load_foreign_library(P) :-
prolog:load_foreign_library(P,install).
do_volatile(_,_).
:- use_module(library(lists)).
prolog:term_to_atom(Term,Atom) :-
nonvar(Atom), !,
atom_codes(Atom,S),
read_from_chars(S,Term).
prolog:term_to_atom(Term,Atom) :-
write_to_chars(Term,S),
atom_codes(Atom,S).
prolog:concat_atom([A|List], Separator, New) :- var(List), !,
atom_codes(Separator,[C]),
atom_codes(New, NewChars),
split_atom_by_chars(NewChars,C,L,L,A,List).
prolog:concat_atom(List, Separator, New) :-
add_separator_to_list(List, Separator, NewList),
atomic_concat(NewList, New).
prolog:concat_atom(List, New) :-
atomic_concat(List, New).
split_atom_by_chars([],_,[],L,A,[]):-
atom_codes(A,L).
split_atom_by_chars([C|NewChars],C,[],L,A,[NA|Atoms]) :- !,
atom_codes(A,L),
split_atom_by_chars(NewChars,C,NL,NL,NA,Atoms).
split_atom_by_chars([C1|NewChars],C,[C1|LF],LAtom,Atom,Atoms) :-
split_atom_by_chars(NewChars,C,LF,LAtom,Atom,Atoms).
add_separator_to_list([], _, []).
add_separator_to_list([T], _, [T]) :- !.
add_separator_to_list([H|T], Separator, [H,Separator|NT]) :-
add_separator_to_list(T, Separator, NT).
prolog:setenv(X,Y) :- unix(putenv(X,Y)).
prolog:prolog_to_os_filename(X,X).
prolog:is_absolute_file_name(X) :-
absolute_file_name(X,X).
prolog:read_clause(X,Y) :-
read_term(X,Y,[singetons(warning)]).
prolog:string(_) :- fail.
slp(T) :- sleep(T).
prolog:sleep(T) :-
slp(T).
% SWI has a dynamic attribute scheme
prolog:get_attr(Var, Mod, Att) :-
AttTerm =.. [Mod,_,Att],
attributes:get_module_atts(Var, AttTerm).
prolog:put_attr(Var, Mod, Att) :-
AttTerm =.. [Mod,_,Att],
attributes:put_module_atts(Var, AttTerm).
prolog:del_attr(Var, Mod) :-
AttTerm =.. [Mod,_,_],
attributes:del_all_module_atts(Var, AttTerm).
prolog:get_attrs(AttVar, SWIAtts) :-
get_all_swi_atts(AttVar,SWIAtts).
prolog:put_attrs(_, []).
prolog:put_attrs(V, Atts) :-
cvt_to_swi_atts(Atts, YapAtts),
attributes:put_att_term(V, YapAtts).
cvt_to_swi_atts([], _).
cvt_to_swi_atts(att(Mod,Attribute,Atts), ModAttribute) :-
ModAttribute =.. [Mod, YapAtts, Attribute],
cvt_to_swi_atts(Atts, YapAtts).
bindings_message(V) -->
{ cvt_bindings(V, Bindings) },
prolog:message(query(_YesNo,Bindings)), !.
cvt_bindings([],[]).
cvt_bindings([[Name|Value]|L],[AName=Value|Bindings]) :-
atom_codes(AName, Name),
cvt_bindings(L,Bindings).
prolog:working_directory(OCWD,NCWD) :-
getcwd(OCWD),
(var(NCWD) -> true ; cd(NCWD)).
prolog:chdir(X) :- cd(X).
% Time is given as int, not as float.
prolog:get_time(Secs) :- datime(Datime), mktime(Datime, Secs).
% Time is received as int, and converted to "..."
prolog:convert_time(X,Y) :- swi:ctime(X,Y).
:- hide(atom_concat).
prolog:atom_concat(A,B) :- atomic_concat(A,B).
prolog:atom_concat(A,B,C) :- atomic_concat(A,B,C).
:- hide(create_mutable).
:- hide(get_mutable).
:- hide(update_mutable).
prolog:make.
prolog:source_location(File,Line) :-
prolog_load_context(file, File),
prolog_load_context(term_position, '$stream_position'(_,Line,_)).
% copied from SWI lists library.
lists:intersection([], _, []) :- !.
lists:intersection([X|T], L, Intersect) :-
memberchk(X, L), !,
Intersect = [X|R],
lists:intersection(T, L, R).
lists:intersection([_|T], L, R) :-
lists:intersection(T, L, R).
:- op(700, xfx, '=@=').
prolog:(Term1 =@= Term2) :-
variant(Term1, Term2), !.
% copied from SWI's boot/apply library
:- module_transparent
prolog:maplist/2,
maplist2/2,
prolog:maplist/3,
maplist2/3,
prolog:maplist/4,
maplist2/4,
prolog:maplist/5,
maplist2/5.
% maplist(:Goal, +List)
%
% True if Goal can succesfully be applied on all elements of List.
% Arguments are reordered to gain performance as well as to make
% the predicate deterministic under normal circumstances.
prolog:maplist(Goal, List) :-
maplist2(List, Goal).
maplist2([], _).
maplist2([Elem|Tail], Goal) :-
call(Goal, Elem),
maplist2(Tail, Goal).
% maplist(:Goal, ?List1, ?List2)
%
% True if Goal can succesfully be applied to all succesive pairs
% of elements of List1 and List2.
prolog:maplist(Goal, List1, List2) :-
maplist2(List1, List2, Goal).
maplist2([], [], _).
maplist2([Elem1|Tail1], [Elem2|Tail2], Goal) :-
call(Goal, Elem1, Elem2),
maplist2(Tail1, Tail2, Goal).
% maplist(:Goal, ?List1, ?List2, ?List3)
%
% True if Goal can succesfully be applied to all succesive triples
% of elements of List1..List3.
prolog:maplist(Goal, List1, List2, List3) :-
maplist2(List1, List2, List3, Goal).
maplist2([], [], [], _).
maplist2([Elem1|Tail1], [Elem2|Tail2], [Elem3|Tail3], Goal) :-
call(Goal, Elem1, Elem2, Elem3),
maplist2(Tail1, Tail2, Tail3, Goal).
% maplist(:Goal, ?List1, ?List2, ?List3, List4)
%
% True if Goal can succesfully be applied to all succesive
% quadruples of elements of List1..List4
prolog:maplist(Goal, List1, List2, List3, List4) :-
maplist2(List1, List2, List3, List4, Goal).
maplist2([], [], [], [], _).
maplist2([Elem1|Tail1], [Elem2|Tail2], [Elem3|Tail3], [Elem4|Tail4], Goal) :-
call(Goal, Elem1, Elem2, Elem3, Elem4),
maplist2(Tail1, Tail2, Tail3, Tail4, Goal).
prolog:compile_aux_clauses([]).
prolog:compile_aux_clauses([(:- G)|Cls]) :-
prolog_load_context(module, M),
once(M:G),
prolog:compile_aux_clauses(Cls).
prolog:compile_aux_clauses([Cl|Cls]) :-
prolog_load_context(module, M),
assert_static(M:Cl),
prolog:compile_aux_clauses(Cls).
% fix different semantics for arg/3.
user:goal_expansion(arg(X,Y,Z),_,arg:genarg(X,Y,Z)) :-
nonvar(X), !.
%
% convert from SWI's goal expansion to YAP/SICStus old style goal
% expansion.
%
user:term_expansion(goal_expansion(A,B),O) :-
prolog_load_context(module, user), !,
O = goal_expansion(A,user,B).
user:term_expansion(user:goal_expansion(A,B),O) :- !,
O = user:goal_expansion(A,_,B).
user:term_expansion((goal_expansion(A,B) :- G), O) :-
prolog_load_context(module, user), !,
O = (goal_expansion(A,user,B) :- G).
user:term_expansion((user:goal_expansion(A,B) :- G),O) :-
O = (user:goal_expansion(A,_,B) :- G).