1/* Part of LogicMOO Base Logicmoo Path Setups
    2% ===================================================================
    3    File:         'logicmoo_util_library.pl'
    4    Purpose:       To load the logicmoo libraries as needed
    5    Contact:       $Author: dmiles $@users.sourceforge.net ;
    6    Version:       'logicmoo_util_library.pl' 1.0.0
    7    Revision:      $Revision: 1.7 $
    8    Revised At:    $Date: 2002/07/11 21:57:28 $
    9    Author:        Douglas R. Miles
   10    Maintainers:   TeamSPoon
   11    E-mail:        logicmoo@gmail.com
   12    WWW:           http://www.prologmoo.com
   13    SCM:           https://github.com/TeamSPoon/PrologMUD/tree/master/pack/logicmoo_base
   14    Copyleft:      1999-2015, LogicMOO Prolog Extensions
   15    License:       Lesser GNU Public License
   16% ===================================================================
   17*/
   18:- if(\+ current_predicate(system:call_using_first_responder/1)).   19:- module(logicmoo_util_autocut, [call_using_first_responder/1]).   20:- endif.   21
   22% :- '$set_source_module'(system).
   23
   24:- if(\+ current_predicate(system:call_using_first_responder/1)).   25:- user:ensure_loaded(logicmoo_util_autocut).   26:- endif.   27
   28:- export(call_using_first_responder/1).   29:- meta_predicate(call_using_first_responder(0)).   30
   31call_using_first_responder(Call):- clause(Call, Body),
   32  Responded = responded(_), Cutted = was_cut(_),
   33  CheckCut = (ignore(deterministic(HasCut)), (HasCut=true->nb_setarg(1, Cutted, cut);true)),
   34
   35  clause(Call, Body),
   36  \+ ground(Cutted),
   37  (FakeBody = (Body;fail)),
   38
   39  ((( (call((FakeBody, CheckCut)), nb_setarg(1, Responded, answered)) *-> true ; (CheckCut, fail))
   40     ; (CheckCut, ground(Responded), ((HasCut==true->!;true)), fail))).
   41
   42
   43 % one_must(C1, one_must(C2, one_must(C3, one_must(C4, C5)))).
   44
   45
   46
   47call_using_first_responder(Goal) :-
   48	predicate_property(Goal, built_in), % <--- check for a built in predicate
   49	!, call(Goal).
   50call_using_first_responder(Goal) :-
   51        Responded = responded(_), %  Cutted = was_cut(_),
   52
   53	clause(Goal, Body), % <--- assume anything else is interpreted
   54	do_body(Body, AfterCut, HadCut),
   55	(   HadCut = yes,
   56		!,
   57		do_body(AfterCut)
   58	;   HadCut = no
   59	).
   60
   61
   62do_body(Body) :-
   63	do_body(Body, AfterCut, HadCut),
   64	(   HadCut = yes,
   65		!,
   66		do_body(AfterCut)
   67	;   HadCut = no
   68	).
   69
   70
   71do_body((!, AfterCut), AfterCut, yes) :- !.
   72do_body((Goal, Body), AfterCut, HadCut) :- !,
   73	call_using_first_responder(Goal),
   74	do_body(Body, AfterCut, HadCut).
   75do_body(!, true, yes).
   76do_body((Disj1;_), AfterCut, HadCut) :-
   77	do_body(Disj1, AfterCut, HadCut).
   78do_body((_;Disj2), AfterCut, HadCut) :- !,
   79	(do_body(Disj2, AfterCut, HadCut)*->true;AfterCut=fail).
   80do_body(Goal, TF, no) :-
   81	(call_using_first_responder(Goal)*->TF=true;TF=fail).
   82
   83
   84
   85last_clause(Any, Result):- (call(Any), deterministic(Det))*->(Det==true->Result=!;Result=true);Result=fail.
   86last_clause(Any):- call(Any), dmsg(error(cont_first_responder(Any))).
   87
   88goal_expansion(last_clause(Any), (call(Any), deterministic(yes)->!;true)).
   89
   90
   91:- fixup_exports.   92
   93:- if(true).   94% some tests
   95
   96a:- !, fail.
   97a:- throw(failed_test).
   98fr1:- \+ call_using_first_responder(a).
   99
  100
  101b:- !.
  102b:- throw(failed_test).
  103fr2:- call_using_first_responder(b).
  104
  105wa(A):-writeln(A), asserta(A).
  106
  107c:- wa(c(1)).
  108c:- !, (wa(c(2));wa(c(3))).
  109c:- throw(failed_test).
  110fr3:- call_using_first_responder(c).
  111
  112d:- wa(d(1));(wa(d(2));wa(d(3))).
  113d:- throw(failed_test).
  114fr4:- call_using_first_responder(d).
  115
  116e:- wa(c(1)).
  117e:- last_clause(wa(c(2));wa(c(3))).
  118e:- throw(failed_test).
  119
  120fr5:- \+ (e, fail).
  121
  122:- endif.  123
  124%:- break.