1:- module(medikit, [
    2                      % More operations on lists
    3                      list_sum/2,
    4                      list_product/2,
    5                      list_lcm/2,
    6                      difs/1,
    7                      fold_op/4,
    8                      fold_op/3,
    9                      maplist_op/3,
   10                      maplist_op/4,
   11                      maplist_op/5,
   12                      maplist_op/6,
   13                      enumerate/2,
   14                      compare_like/4,
   15
   16                      % Operation on subterms
   17                      subterms/3,
   18
   19                      % Utilities for local knowledgebases
   20                      set_knowledge/2,
   21
   22                      % Utilities for the chr store
   23                      find_constraint/2,
   24                      local_chr/3,
   25
   26                      % Function expansion clauses for ξ
   27                      function_expansion/3,
   28
   29                      % For debugging DCGs
   30                      phrase_from_file_debug/3
   31                  ]).   32
   33:- use_module(library(chr)).   34:- use_module(library(function_expansion)).   35
   36
   37% More list-related utilities
   38
   39list_product(L, Prod) :-
   40    foldl([A,B,C] >> (C is A*B), L, 1, Prod).
   41
   42list_sum(L, Sum) :- sum_list(L, Sum).
   43
   44list_lcm([X|Xs], LCM) :-
   45    foldl([A,B,C]>>(C is lcm(A,B)), Xs, X, LCM).
   46
   47difs([]).
   48difs([Var|Vars]) :- maplist(dif(Var), Vars), difs(Vars).
   49
   50:- meta_predicate fold_op(+, +, +, -).   51fold_op(Op, Ls, Init, Res) :-
   52    foldl({Op}/[X,A,R]>>(R =.. [Op, A, X]), Ls, Init, Res).
   53
   54:- meta_predicate fold_op(+, +, -).   55fold_op(Op, [L|Ls], Res) :- fold_op(Op, Ls, L, Res).
   56
   57maplist_op(Op, A, R) :-
   58    maplist({Op}/[X, Y] >> (Y =.. [Op, X]), A, R).
   59maplist_op(Op, A1, A2, R) :-
   60    maplist({Op}/[X1, X2, Y] >> (Y =.. [Op, X1, X2]), A1, A2, R).
   61maplist_op(Op, A1, A2, A3, R) :-
   62    maplist({Op}/[X1, X2, X3, Y] >> (Y =.. [Op, X1, X2, X3]), A1, A2, A3, R).
   63maplist_op(Op, A1, A2, A3, A4, R) :-
   64    maplist({Op}/[X1, X2, X3, X4, Y] >> (Y =.. [Op, X1, X2, X3, X4]), A1, A2, A3, A4, R).
   65
   66enumerate(Xs, EXs) :-
   67    length(Xs, L), numlist(1, L, Nums),
   68    maplist_op(-, Nums, Xs, EXs).
   69
   70compare_like(List, Cmp, X1, X2) :-
   71    enumerate(List, Enumerated),
   72    member(I1-X1, Enumerated),
   73    member(I2-X2, Enumerated),
   74    compare(Cmp, I1, I2).
   75
   76
   77% Subterms matching a given predicate
   78
   79subterms(Whole, Goal, Subterms) :-
   80    foldsubterms({Goal}/[A,S0,S1] >> (call(Goal,A), S1=[A|S0]),
   81                 Whole, [], Subterms).
   82
   83
   84% Local knowledgebases
   85:- meta_predicate set_knowledge(+, :).   86set_knowledge(Knowledge, Module:Predicates) :-
   87    maplist({Module}/[P]>>retractall(Module:P), Predicates),
   88    abolish_all_tables,
   89    mapsubterms({Module}/[Subterm,_]>>(member(P, Predicates), subsumes_term(P, Subterm), assertz(Module:Subterm)),
   90                Knowledge, _).
   91
   92
   93% CHR utilities
   94
   95find_constraint(Goal, Cs) :-
   96    findall(Goal, find_chr_constraint(Goal), Cs).
   97
   98local_chr(Facts, Result, Res) :-
   99    thread_create((maplist(call, Facts),
  100                   find_constraint(Result, Ns),
  101                   thread_exit(Ns)), Id),
  102    thread_join(Id, exited(Res)).
  103
  104
  105% Macros for writing arithmetic
  106
  107user:function_expansion(ξ(X), Y, Y #= X).
  108
  109
  110% The missing phrase_from_file/3
  111
  112:- meta_predicate phrase_from_file_debug(:, +, -).  113phrase_from_file_debug(Dcg, File, R) :-
  114    read_file_to_codes(File, Cs, []),
  115    once(phrase(Dcg, Cs, R))