1/* Part of SWI-Prolog 2 3 Author: Tom Schrijvers, Bart Demoen, Jan Wielemaker 4 E-mail: Tom.Schrijvers@cs.kuleuven.be 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2008-2015, K.U. Leuven 7 All rights reserved. 8 9 Redistribution and use in source and binary forms, with or without 10 modification, are permitted provided that the following conditions 11 are met: 12 13 1. Redistributions of source code must retain the above copyright 14 notice, this list of conditions and the following disclaimer. 15 16 2. Redistributions in binary form must reproduce the above copyright 17 notice, this list of conditions and the following disclaimer in 18 the documentation and/or other materials provided with the 19 distribution. 20 21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 POSSIBILITY OF SUCH DAMAGE. 33*/ 34 35:- module(hprolog, 36 [ substitute_eq/4, % +OldVal, +OldList, +NewVal, -NewList 37 memberchk_eq/2, % +Val, +List 38 intersect_eq/3, % +List1, +List2, -Intersection 39 list_difference_eq/3, % +List, -Subtract, -Rest 40 take/3, % +N, +List, -FirstElements 41 drop/3, % +N, +List, -LastElements 42 split_at/4, % +N, +List, -FirstElements, -LastElements 43 max_go_list/2, % +List, -Max 44 or_list/2, % +ListOfInts, -BitwiseOr 45 sublist/2, % ?Sublist, +List 46 bounded_sublist/3, % ?Sublist, +List, +Bound 47 chr_delete/3, 48 init_store/2, 49 get_store/2, 50 update_store/2, 51 make_get_store_goal/3, 52 make_get_store_goal_no_error/3, 53 make_update_store_goal/3, 54 make_init_store_goal/3, 55 56 empty_ds/1, 57 ds_to_list/2, 58 get_ds/3, 59 put_ds/4, 60 61 time/3 62% lookup_ht1/4 63 ]). 64:- use_module(library(assoc)). 65 66:- meta_predicate 67 time(, , ). 68 69/** <module> hProlog compatibility library 70 71This library has been developed mainly for porting the CHR package. 72 73@author Tom Schrijvers 74@author Bart Demoen 75@author Jan Wielemaker 76@tbd Ultimately, this must disappear. Generally useful predicates 77 must be moved to their appropriate library. Others must be moved 78 into the CHR utilities. 79*/ 80 81 /******************************* 82 * LIBRARY SETUP * 83 *******************************/ 84 85%% push_hprolog_library 86% 87% Pushes searching for dialect/hprolog in front of every 88% library directory that contains such as sub-directory. 89 90push_hprolog_library :- 91 ( absolute_file_name(library(dialect/hprolog), Dir, 92 [ file_type(directory), 93 access(read), 94 solutions(all), 95 file_errors(fail) 96 ]), 97 asserta((user:file_search_path(library, Dir) :- 98 prolog_load_context(dialect, hprolog))), 99 fail 100 ; true 101 ). 102 103 104:- push_hprolog_library. 105 106 107empty_ds(DS) :- empty_assoc(DS). 108ds_to_list(DS,LIST) :- assoc_to_list(DS,LIST). 109get_ds(A,B,C) :- get_assoc(A,B,C). 110put_ds(A,B,C,D) :- put_assoc(A,B,C,D). 111 112 113init_store(Name,Value) :- nb_setval(Name,Value). 114 115get_store(Name,Value) :- nb_getval(Name,Value). 116 117update_store(Name,Value) :- b_setval(Name,Value). 118 119make_init_store_goal(Name,Value,Goal) :- Goal = nb_setval(Name,Value). 120 121make_get_store_goal(Name,Value,Goal) :- Goal = nb_getval(Name,Value). 122 123make_get_store_goal_no_error(Name,Value,Goal) :- Goal = nb_current(Name,Value). 124 125make_update_store_goal(Name,Value,Goal) :- Goal = b_setval(Name,Value). 126 127 128 /******************************* 129 * MORE LIST OPERATIONS * 130 *******************************/ 131 132%% substitute_eq(+OldVal, +OldList, +NewVal, -NewList) 133% 134% Substitute OldVal by NewVal in OldList and unify the result 135% with NewList. 136 137substitute_eq(_, [], _, []) :- ! . 138substitute_eq(X, [U|Us], Y, [V|Vs]) :- 139 ( X == U 140 -> V = Y, 141 substitute_eq(X, Us, Y, Vs) 142 ; V = U, 143 substitute_eq(X, Us, Y, Vs) 144 ). 145 146%% memberchk_eq(+Val, +List) 147% 148% Deterministic check of membership using == rather than 149% unification. 150 151memberchk_eq(X, [Y|Ys]) :- 152 ( X == Y 153 -> true 154 ; memberchk_eq(X, Ys) 155 ). 156 157% :- load_foreign_library(chr_support). 158 159%% list_difference_eq(+List, -Subtract, -Rest) 160% 161% Delete all elements of Subtract from List and unify the result 162% with Rest. Element comparision is done using ==/2. 163 164list_difference_eq([],_,[]). 165list_difference_eq([X|Xs],Ys,L) :- 166 ( memberchk_eq(X,Ys) 167 -> list_difference_eq(Xs,Ys,L) 168 ; L = [X|T], 169 list_difference_eq(Xs,Ys,T) 170 ). 171 172%% intersect_eq(+List1, +List2, -Intersection) 173% 174% Determine the intersection of two lists without unifying values. 175 176intersect_eq([], _, []). 177intersect_eq([X|Xs], Ys, L) :- 178 ( memberchk_eq(X, Ys) 179 -> L = [X|T], 180 intersect_eq(Xs, Ys, T) 181 ; intersect_eq(Xs, Ys, L) 182 ). 183 184 185%% take(+N, +List, -FirstElements) 186% 187% Take the first N elements from List and unify this with 188% FirstElements. The definition is based on the GNU-Prolog lists 189% library. Implementation by Jan Wielemaker. 190 191take(0, _, []) :- !. 192take(N, [H|TA], [H|TB]) :- 193 N > 0, 194 N2 is N - 1, 195 take(N2, TA, TB). 196 197%% drop(+N, +List, -ListMinFirstN) is semidet. 198% 199% Drop the first N elements from List and unify the remainder with 200% LastElements. 201 202drop(0,LastElements,LastElements) :- !. 203drop(N,[_|Tail],LastElements) :- 204 N > 0, 205 N1 is N - 1, 206 drop(N1,Tail,LastElements). 207 208%% split_at(+N, +List, +FirstN, -Rest) is semidet. 209% 210% Combines take/3 and drop/3. 211 212split_at(0,L,[],L) :- !. 213split_at(N,[H|T],[H|L1],L2) :- 214 M is N -1, 215 split_at(M,T,L1,L2). 216 217%% max_go_list(+List, -Max) 218% 219% Return the maximum of List in the standard order of terms. 220 221max_go_list([H|T], Max) :- 222 max_go_list(T, H, Max). 223 224max_go_list([], Max, Max). 225max_go_list([H|T], X, Max) :- 226 ( H @=< X 227 -> max_go_list(T, X, Max) 228 ; max_go_list(T, H, Max) 229 ). 230 231%% or_list(+ListOfInts, -BitwiseOr) 232% 233% Do a bitwise disjuction over all integer members of ListOfInts. 234 235or_list(L, Or) :- 236 or_list(L, 0, Or). 237 238or_list([], Or, Or). 239or_list([H|T], Or0, Or) :- 240 Or1 is H \/ Or0, 241 or_list(T, Or1, Or). 242 243 244%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 245 246%% sublist(?Sub, +List) is nondet. 247% 248% True if all elements of Sub appear in List in the same order. 249 250sublist(L, L). 251sublist(Sub, [H|T]) :- 252 '$sublist1'(T, H, Sub). 253 254'$sublist1'(Sub, _, Sub). 255'$sublist1'([H|T], _, Sub) :- 256 '$sublist1'(T, H, Sub). 257'$sublist1'([H|T], X, [X|Sub]) :- 258 '$sublist1'(T, H, Sub). 259 260%% bounded_sublist(?Sub, +List, +Bound:integer) 261% 262% As sublist/2, but Sub has at most Bound elements. E.g. the call 263% below generates all 21 sublists of length =< 2 from the second 264% argument. 265% 266% == 267% ?- bounded_sublist(List, [a,b,c,d], 2). 268% X = [] ; 269% X = [a] ; 270% X = [a, b] ; 271% X = [a] ; 272% ... 273% == 274 275bounded_sublist(Sublist,_,_) :- 276 Sublist = []. 277bounded_sublist(Sublist,[H|List],Bound) :- 278 Bound > 0, 279 ( 280 Sublist = [H|Rest], 281 NBound is Bound - 1, 282 bounded_sublist(Rest,List,NBound) 283 ; 284 bounded_sublist(Sublist,List,Bound) 285 ). 286 287 288%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 289 290%% chr_delete(+List, +Element, -Rest) is det. 291% 292% Rest is a copy of List without elements matching Element using 293% ==. 294 295chr_delete([], _, []). 296chr_delete([H|T], X, L) :- 297 ( H==X -> 298 chr_delete(T, X, L) 299 ; L=[H|RT], 300 chr_delete(T, X, RT) 301 ). 302 303%% time(:Goal, -CPU, -Wall) 304% 305% hProlog compatible predicate to for statistical purposes 306 307time(Goal, CPU, Wall) :- 308 get_time(T0), 309 statistics(cputime, CPU0), 310 call(Goal), 311 statistics(cputime, CPU1), 312 get_time(T1), 313 Wall is T1-T0, 314 CPU is CPU1-CPU0