1:- use_module(library(logicmoo_utils)).    2
    3:- multifile file_search_path/2.    4:- dynamic file_search_path/2.    5
    6ensure_loaded_if_exists(X):- exists_source(X)->system:ensure_loaded(X);dmsg(ensure_loaded_if_exists(X)).
    7use_module_if_exists(X):- exists_source(X)->system:use_module(X);dmsg(use_module_if_exists(X)).
    8use_module_if_exists(X,Y):- exists_source(X)->system:use_module(X,Y);dmsg(use_module_if_exists(X,Y)).
    9
   10:- prolog_load_context(directory,Dir), 
   11asserta((
   12user:file_search_path(home, Dir) %%%%set appropriately!
   13)).   14
   15rev(A,B):-
   16    rev(A,B,[]).
   17
   18rev([],B,B):-!.
   19rev([X|A],B,C):-
   20    rev(A,B,[X|C]).
   21
   22nonmember(Arg,[Arg|_]) :-
   23        !,
   24        fail.
   25nonmember(Arg,[_|Tail]) :-
   26        !,
   27        nonmember(Arg,Tail).
   28nonmember(_,[]).
   29
   30
   31%writes Question (using write/1) to the terminal, regardless of the current output stream, and reads an answer. The prompt is followed by ? , so you should not put a question mark in the question yourself. The answer is the first character typed in response; anything following on the same line will be thrown away. If the answer is y or Y, yesno/1 succeeds. If the answer is n or N, yesno/1 fails. Otherwise it repeats the question. The user has to explicitly type a y or n before it will stop. Because the rest of the line is thrown away, the user can type yes, Yes, You'd better not, and so forth with exactly the same effect as a plain y. If the user just presses <RET>, that is not taken as yes.
   32yesno(Question):- yesno(Question,no).
   33yesno(Question, Default):- format('~N~w? (~w): ',[Question,Default]),get_single_char(YN), (YN = 13 -> Default==yes; member(YN, `yY`)).
   34%is like yesno/1 except that
   35%Default may be an atom (the first character of whose name will be used), a string (whose first character will be used) or an ASCII code, and will be written in brackets before the question mark; and
   36%if the user just presses <RET>, Default will be used as the answer.
   37%For example, yesno('Do you want an extended trace', yes)         
   38%prints Do you want an extended trace [yes]? _
   39/*
   40
   41ask_chars(+Prompt, +MinLength, +MaxLength, -Answer)
   42writes Prompt to the terminal, and reads a line of characters from it. This response must contain between MinLength and MaxLength characters inclusive, otherwise the question will be repeated until an answer of satisfactory length is obtained. Leading and/or trailing layout characters are retained in the result, and are counted when determining the length of the answer. The list of character codes read is unified with Answer. Note that a colon and a space (: ) are added to the Prompt, so don't add such punctuation yourself. The end-user can find out what sort of input is required by typing a line that starts with a question mark. Therefore it is not possible to read such a line as data. See prompted_line/2 in library(prompt).
   43Examples:
   44
   45          | ?- ask_chars('Label', 1, 8, Answer).
   46          Label: 213456789
   47          Please enter between 1 and 8 characters.
   48          Do not add a full stop unless it is part of the answer.
   49          Label: four
   50          
   51          Answer = "four"
   52          
   53          | ?- ask_chars('Heading', 1, 30, Answer).
   54          Heading: ?
   55          Please enter between 1 and 30 characters.
   56          Do not add a full stop unless it is part of the answer.
   57          Heading:    three leading spaces
   58          
   59          Answer = "   three leading spaces"
   60          
   61*/         
   62ask_chars(Label, S, E, Answer):- 
   63  repeat, 
   64   format('~N~w: ?',[Label]), 
   65   read_line_to_string_echo(current_input,Answer),atom_length(Answer,Len),
   66   (between(S,E,Len) -> ! ; (format("~NPlease enter between ~w and ~w characters.~n",[S,E]),fail)).
   67
   68unify(X, Y):- unify_with_occurs_check(X,Y).
   69
   70:- use_module_if_exists(library(ordsets)).   71
   72union(X,Y):- ord_union(X,Y).
   73%subseq(X,Y,Z):- ord_union(X,Y).
   74
   75'$list_skel'(V) :- var(V), !, fail.
   76'$list_skel'([]).
   77'$list_skel'([_|L]) :-
   78    '$list_skel'(L).
   79
   80% subseq(Sequence1, SubSequence2, Complement):- 
   81subseq(AB, A, B) :- '$list_skel'(AB), !,
   82    '$subseq'(AB, A, B).
   83subseq(AB, A, B) :- '$list_skel'(A), '$list_skel'(B), !,
   84    '$subseq'(AB, A, B).
   85subseq(AB, A, _B) :-
   86    throw('instantiation error'(AB,A)).
   87
   88'$subseq'([], [], []).
   89'$subseq'([X|AB], A, [X|B]) :-
   90    '$subseq'(AB, A, B).
   91'$subseq'([X|AB], [X|A], B) :-
   92    '$subseq'(AB, A, B).
   93
   94subseq0(AB, A) :- '$list_skel'(AB), !,
   95    '$subseq'(AB, A, _).
   96subseq0(AB, A) :-
   97    throw('instantiation error'(AB,A)).
   98
   99subseq1(AB, A) :- '$list_skel'(AB), !,
  100    '$subseq'(AB, A, _),
  101    A \== AB.
  102subseq1(AB, A) :-
  103    throw('instantiation error'(AB,A)).
  104
  105
  106string_append( A , B , C):- string_concat(A,B,C).
  107
  108save_predicates(List,Filename):- tell(Filename),listing(List),told.
  109
  110%basics
  111%Succeeds when SubSequence and Complement are both subsequences of the list Sequence (the order of corresponding elements being preserved) and every element of Sequence which is not in SubSequence is in the Complement and vice versa. That is,
  112
  113
  114
  115
  116prompt(X):- format('~N~w ',[X]). 
  117
  118:- expects_dialect(sicstus).  119
  120do_full_kb(KB):- 
  121 clear_kb, init_kb(KB),
  122 nth_clause(do_full_kb1,Index,_),
  123 do_full_kb(_,Index).
  124
  125do_full_kb(KB,Index):-
  126 nth_clause(do_full_kb1,Index,Ref),
  127 clause(do_full_kb1,Goal,Ref),
  128 do_full_kb(KB,Index,Goal).
  129
  130do_full_kb(KB,Index,Goal):-
  131 once((
  132 ignore((nonvar(KB),clear_kb, init_kb(KB))),
  133  format('~N===================',[]),
  134  format('~N======= Nth: ~w  ~p  =======',[Index,Goal]),
  135  format('~N===================~n',[]),
  136   show_kb, 
  137   catch(do_full_call_each(Goal),E,(dumpST,throw(E))),
  138   show_kb,   
  139   format('~N==== DONE: ~w ========~n~n',[Index]))).
  140
  141do_full_call_each((G1,G2)):- !, do_full_call_each(G1),do_full_call_each(G2).
  142do_full_call_each((G1->G2)):- 
  143 \+ \+ (( 
  144   wdmsg(do_call((G1->G2=Vars))), 
  145  my_do_call(G1),!,term_variables(G2,Vars),my_do_call(G2),!, 
  146  wdmsg(did_call((+Vars))))), !.
  147do_full_call_each(G1):- G2 = true,
  148 \+ \+ (( 
  149   wdmsg(do_call((G1->G2=Vars))), 
  150  my_do_call(G1),!,term_variables(G2,Vars),my_do_call(G2),!, 
  151  wdmsg(did_call((+Vars))))),!.
  152
  153% my_do_call(G):- !, must_or_rtrace(G).
  154my_do_call(G):- notrace(ignore(catch(G,_,true))).
  155
  156do_full_kb1:- 
  157 argument_types,
  158 show_kb,
  159 complete_chk,

  160 ip(A),

  161 clause_heads, eval_examples,
  162 show_kb,
  163 complete_chk,

  164 correct_chk,
  165 fp(A),

  166                    

  167 refinement(_ID,_),

  168                        

  169 flatten_kb

  169.    

  171do_full_kb1:- 
  172 intra_construct1(1,2,A,B,C) -> show_clauses([1,2,A,B,C]),
  173 g2_op(1,2,A,B,C),

  174 show_kb,
  175 identify(4,3,J) -> show_clause(J),
  176 identify(5,_I,J) -> show_clause(J),
  177 apply_g2([4,5,10],_A,_BB)

  177.
  178
  179do_full_kb1:- 
  180 intra_construct1(10,11,_A,_B,_C),
  181 show_clauses([10,11,13,14,15]),
  182 g1_op(5,1,I),
  183 g1_op(5,3,I),
  184 absorb(5,1,I),
  185 elem_saturate(5,1,I),
  186 saturate(5,I,10),
  187 most_spec_v(5,I,J),
  188 inv_derivate(5,J),
  189 show_kb,
  190 lgg(7,9,J) -> show_clause(J).
  191
  192do_full_kb1:-  
  193  nr_lgg(7,9,J) -> show_clause(J),
  194  get_clause(J,_,_,CL,_),reduce_complete(CL,CL1),
  195  store_clause(_,CL1,nrlgg,I), show_clause(I).
  196
  197do_full_kb1:-  
  198 gen_msg(5,6,J,10) -> show_clause(J),
  199 gti(8,9,J) -> show_clause(J).
  200
  201do_full_kb1:- 
  202 rlgg(5,6,J) -> show_clause(J).
  203
  204
  205do_full_kb1:- 
  206 lgg(1,2,J) -> show_clause(J),
  207 nr_lgg(1,2,J) -> show_clause(J),
  208 lgg(3,4,J) -> show_clause(J),
  209 nr_lgg(3,4,J) -> show_clause(J),
  210 gti(3,4,J) -> show_clause(J),  % erlaubt backtracking!
  211 lgti(3,4,C,_,_),
  212 lgg(8,9,J) -> show_clause(J),
  213 rlgg(8,9,J) -> show_clause(J),
  214 rlgg(8,9,cuddly_pet(_),J) -> show_clause(J),
  215 gen_msg(8,9,J) -> show_clause(J),
  216 rlgg(10,11,J) -> show_clause(J),
  217 intra_construct1(14,15,A,B,C) -> show_clauses([14,15,A,B,C]),
  218 intra_construct2(16,17,A,B,C) -> show_clauses([16,17,A,B,C]).

  228% Dann teste:
  229do_full_kb1:- 
  230 absorb(ID1,ID2,J) -> show_clause(J),
  231 elem_saturate(ID1,ID2,J1) -> show_clause(J1),
  232 saturate(ID1,J2,5) -> show_clause(J2),
  233 unflatten_kb,
  234 !