View source with formatted comments or as raw
    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(0, -, -).   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