From f17e0f85ea51986705b9caab95defda48d8ead38 Mon Sep 17 00:00:00 2001 From: Jan Wielemaker Date: Wed, 27 Aug 2008 11:59:00 +0200 Subject: [PATCH] Replaced loading hprolog by loading library(dialect/hprolog) --- a_star.pl | 2 +- builtins.pl | 4 +- chr_hashtable_store.pl | 2 +- chr_integertable_store.pl | 2 +- chr_runtime.pl | 2 +- chr_translate.chr | 2 +- chr_translate_bootstrap.pl | 2 +- chr_translate_bootstrap1.chr | 2 +- chr_translate_bootstrap2.chr | 2 +- clean_code.pl | 2 +- guard_entailment.chr | 2 +- hprolog.pl | 192 ------------------------------------------- 12 files changed, 12 insertions(+), 204 deletions(-) delete mode 100644 hprolog.pl diff --git a/a_star.pl b/a_star.pl index 73f822e..b8b8d14 100644 --- a/a_star.pl +++ b/a_star.pl @@ -12,7 +12,7 @@ :- use_module(find). -:- use_module(hprolog). +:- use_module(library(dialect/hprolog)). a_star(DataIn,FinalData,ExpandData,DataOut) :- a_star_node(DataIn,0,InitialNode), diff --git a/builtins.pl b/builtins.pl index fb9bea4..f70cd9c 100644 --- a/builtins.pl +++ b/builtins.pl @@ -11,7 +11,7 @@ builtin_binds_b/2 ]). -:- use_module(hprolog). +:- use_module(library(dialect/hprolog)). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% negate_b(A,B) :- once(negate(A,B)). @@ -52,7 +52,7 @@ entails_b(A,B) :- entails(A,A,_). entails(A,C,History) :- entails_(A,B), - \+ hprolog:memberchk_eq(B,History), + \+ memberchk_eq(B,History), entails(B,C,[B|History]). entails_(X > Y, X >= Y). diff --git a/chr_hashtable_store.pl b/chr_hashtable_store.pl index 82d2e84..c5e6b5d 100644 --- a/chr_hashtable_store.pl +++ b/chr_hashtable_store.pl @@ -48,7 +48,7 @@ ]). :- use_module(pairlist). -:- use_module(hprolog). +:- use_module(library(dialect/hprolog)). :- use_module(library(lists)). :- multifile user:goal_expansion/2. diff --git a/chr_integertable_store.pl b/chr_integertable_store.pl index 1a9b0e0..d04a2ed 100644 --- a/chr_integertable_store.pl +++ b/chr_integertable_store.pl @@ -40,7 +40,7 @@ value_iht/2 ]). :- use_module(library(lists)). -:- use_module(hprolog). +:- use_module(library(dialect/hprolog)). %initial_capacity(65536). %initial_capacity(1024). diff --git a/chr_runtime.pl b/chr_runtime.pl index 9688449..e1a06e5 100644 --- a/chr_runtime.pl +++ b/chr_runtime.pl @@ -138,7 +138,7 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -:- use_module(hprolog). +:- use_module(library(dialect/hprolog)). :- include(chr_op). %% SICStus begin diff --git a/chr_translate.chr b/chr_translate.chr index 2f33c76..f96dcf1 100644 --- a/chr_translate.chr +++ b/chr_translate.chr @@ -139,10 +139,10 @@ :- use_module(library(apply_macros)). :- use_module(library(occurs)). :- use_module(library(assoc)). +:- use_module(library(dialect/hprolog)). %% SWI end }}} % imports and operators {{{ -:- use_module(hprolog). :- use_module(pairlist). :- use_module(a_star). :- use_module(listmap). diff --git a/chr_translate_bootstrap.pl b/chr_translate_bootstrap.pl index f901b64..b64a51b 100644 --- a/chr_translate_bootstrap.pl +++ b/chr_translate_bootstrap.pl @@ -125,7 +125,7 @@ :- use_module(library(lists),[member/2,append/3,permutation/2,reverse/2]). :- use_module(library(ordsets)). %% SWI end -:- use_module(hprolog). +:- use_module(library(dialect/hprolog)). :- use_module(pairlist). :- include(chr_op). :- if(current_prolog_flag(dialect, swi)). diff --git a/chr_translate_bootstrap1.chr b/chr_translate_bootstrap1.chr index db9af80..612c2af 100644 --- a/chr_translate_bootstrap1.chr +++ b/chr_translate_bootstrap1.chr @@ -19,7 +19,7 @@ reverse/2 ]). :- use_module(library(ordsets)). -:- use_module(hprolog). +:- use_module(library(dialect/hprolog)). :- use_module(pairlist). :- include(chr_op2). chr_translate(A, C) :- diff --git a/chr_translate_bootstrap2.chr b/chr_translate_bootstrap2.chr index 8d68276..9366d9d 100644 --- a/chr_translate_bootstrap2.chr +++ b/chr_translate_bootstrap2.chr @@ -117,7 +117,7 @@ :- use_module(library(ordsets)). %% SWI end -:- use_module(hprolog). +:- use_module(library(dialect/hprolog)). :- use_module(pairlist). :- use_module(a_star). :- use_module(clean_code). diff --git a/clean_code.pl b/clean_code.pl index 7548bab..551e43b 100644 --- a/clean_code.pl +++ b/clean_code.pl @@ -19,7 +19,7 @@ clean_clauses/2 ]). -:- use_module(hprolog). +:- use_module(library(dialect/hprolog)). clean_clauses(Clauses,NClauses) :- clean_clauses1(Clauses,Clauses1), diff --git a/guard_entailment.chr b/guard_entailment.chr index 680b08b..6338cd6 100644 --- a/guard_entailment.chr +++ b/guard_entailment.chr @@ -3,7 +3,7 @@ simplify_guards/5 ]). :- include(chr_op). -:- use_module(hprolog). +:- use_module(library(dialect/hprolog)). :- use_module(builtins). :- use_module(chr_compiler_errors). :- chr_option(debug, off). diff --git a/hprolog.pl b/hprolog.pl deleted file mode 100644 index 45f02a0..0000000 --- a/hprolog.pl +++ /dev/null @@ -1,192 +0,0 @@ -:- 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 - 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)). - -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 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(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(L, L). -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(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([], _, []). -chr_delete([H|T], X, L) :- - ( H==X -> - chr_delete(T, X, L) - ; L=[H|RT], - chr_delete(T, X, RT) - ). - -- 2.11.4.GIT