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, -, -).

   81                 /*******************************
   82                 *          LIBRARY SETUP       *
   83                 *******************************/

 push_hprolog_library

Pushes searching for dialect/hprolog in front of every library directory that contains such as sub-directory.

   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		 *******************************/

 substitute_eq(+OldVal, +OldList, +NewVal, -NewList)

Substitute OldVal by NewVal in OldList and unify the result with NewList.

  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        ).

 memberchk_eq(+Val, +List)

Deterministic check of membership using == rather than unification.

  151memberchk_eq(X, [Y|Ys]) :-
  152   (   X == Y
  153   ->  true
  154   ;   memberchk_eq(X, Ys)
  155   ).
  156
  157% :- 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.

  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	).

 intersect_eq(+List1, +List2, -Intersection)

Determine the intersection of two lists without unifying values.

  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	).

 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.

  191take(0, _, []) :- !.
  192take(N, [H|TA], [H|TB]) :-
  193	N > 0,
  194	N2 is N - 1,
  195	take(N2, TA, TB).

 drop(+N, +List, -ListMinFirstN) is semidet

Drop the first N elements from List and unify the remainder with LastElements.

  202drop(0,LastElements,LastElements) :- !.
  203drop(N,[_|Tail],LastElements) :-
  204	N > 0,
  205	N1 is N  - 1,
  206	drop(N1,Tail,LastElements).

 split_at(+N, +List, +FirstN, -Rest) is semidet

Combines take/3 and drop/3.

  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).

 max_go_list(+List, -Max)

Return the maximum of List in the standard order of terms.

  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        ).

 or_list(+ListOfInts, -BitwiseOr)

Do a bitwise disjuction over all integer members of ListOfInts.

  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%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

 sublist(?Sub, +List) is nondet

True if all elements of Sub appear in List in the same order.

  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).

 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] ;
...

  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%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

 chr_delete(+List, +Element, -Rest) is det

Rest is a copy of List without elements matching Element using ==.

  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        ).

 time(:Goal, -CPU, -Wall)

hProlog compatible predicate to for statistical purposes

  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