diff --git a/library/dialect/commons.yap b/library/dialect/commons.yap new file mode 100644 index 000000000..fc803054f --- /dev/null +++ b/library/dialect/commons.yap @@ -0,0 +1,9 @@ + +% +% support for commons file. +% + +:- style_check(all). + +:- yap_flag(unknown,error). + diff --git a/library/dialect/hprolog.yap b/library/dialect/hprolog.yap new file mode 100644 index 000000000..572f58dec --- /dev/null +++ b/library/dialect/hprolog.yap @@ -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)). + +/** 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) + ). + diff --git a/library/dialect/swi.yap b/library/dialect/swi.yap new file mode 100644 index 000000000..3b4ebdf8c --- /dev/null +++ b/library/dialect/swi.yap @@ -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). +