1/******************************************************************/
    2/* MULTAGNT.PRO                                                   */
    3/* Brazdil's Simulation of a tutoring setting between two agents  */
    4/******************************************************************/
    5/* impl. by     : Yiu Cheung HO                                   */
    6/*                Department of Computing                         */
    7/*                King's College London                           */
    8/*                1989                                            */
    9/*                                                                */
   10/*                Thomas Hoppe                                    */
   11/*                Mommsenstr. 50                                  */
   12/*                1000 Berlin 12                                  */
   13/*                F.R.G.                                          */
   14/*                E-Mail: hoppet@db0tui11.pro                     */
   15/*                1990                                            */
   16/*                                                                */
   17/* reference    : Transfer of Knowledge between Systems,      */
   18/*        Brazdil, P., Associacao Portuguesa para a Intel-*/
   19/*        igencia Artificial, Working Paper 87-1, Uni-    */
   20/*        versity of Porto, 1987.                 */
   21/*                                                                */
   22/*        Diagnosis of Misunderstanding, Yiu Cheung HO,   */
   23/*        Project Report, Final Year One Unit Project     */
   24/*        88/89, Department of Computing, King's College  */
   25/*        London, 1989.                   */
   26/*                                                                */
   27/*  call        : diagnosis                                       */
   28/*                                                                */
   29/******************************************************************/
   30
   31:- dynamic(parent/2).   32
   33/******************************************************************/
   34/* YAP-, C- and M-Prolog specific declaration of dynamical        */
   35/* clauses.                                                       */
   36/******************************************************************/
   37:- dynamic db_entry/3.   38:- dynamic def_theory/2.   39:- dynamic digits_of_next_sym/1.   40 
   41:- op(999,xfx,:).   42:- op(998,xfx,'<-').   43
   44/******************************************************************/
   45/* User Interface                         */
   46/******************************************************************/
   47diagnosis :-
   48    init,
   49    get_teacher(teacher),
   50    nl, nl,
   51    get_learner,
   52    locate_error.
   53 
   54init :-
   55    abolish(db_entry,3),
   56    abolish(def_theory,2),
   57    multifile(db_entry/3),
   58    multifile(def_theory/2),
   59   dynamic(db_entry/3),
   60   dynamic(def_theory/2).
   61
   62:- init.   63
   64:- [teacher].   65
   66:- [learner1].   67
   68locate_error :-
   69    repeat,
   70    mode(Mode),
   71    generate_error(Mode).
   72 
   73generate_error(manual) :-
   74    repeat,
   75    get_question(Question),
   76    process_question(Question),
   77    exit_manual,
   78    !, exit.
   79generate_error(auto) :-
   80    select_question(Question),
   81    process_question(Question),
   82    exit_auto,
   83    !, exit.
   84generate_error(_) :-
   85    exit.
   86 
   87process_question(Question) :-
   88    what_cannot_do(Ls,Ts,Question <- Answer,[],FaultyStep),
   89    output_error(Ls,Ts,Question <- Answer,FaultyStep), !.
   90process_question(Question) :-
   91    write(' *** The teacher cannot answer the question: '),
   92    write(Question), nl.
   93 
   94output_error(Tl,Tt,Question <- Answer,FaultyStep) :-
   95    nl,
   96    write(' Result of Diagnosis:'), nl,
   97    write(' --------------------'), nl, nl,
   98    write(' The query is:       '), write(Question),nl,
   99    write(' Teachers answer is: '), out_answer(Answer),nl,
  100    write(' Learners theory:    '), write(Tl),nl,
  101    write(' Teachers theory:    '), write(Tt),nl,
  102    write(' Faulty Steps:       '), out_faulty(FaultyStep), nl, !.
  103
  104out_faulty([]) :-
  105    write('no faulty step'), nl.
  106out_faulty(Steps) :-
  107    out_step(Steps), nl.
  108 
  109out_step([]) :-
  110    nl.
  111out_step([Step|Steps]) :-
  112    write('                     '),
  113    write(Step), nl,
  114    write(Steps).
  115 
  116out_answer([]) :-
  117    write('true'), nl.
  118out_answer(Ans) :-
  119    out_ans(Ans).
  120 
  121out_ans([]) :-
  122    nl.
  123out_ans([val(Var,Val)|T]) :-
  124    write(Var = Val), nl,
  125    write('                     '),
  126    out_ans(T).
  127 
  128select_question(Question) :-
  129    generate_question(Question),
  130    yes_no(yes, 'confirm',Reply),
  131    Reply = yes.
  132select_question(_) :-
  133    write(' no more questions'), nl, !, fail.
  134 
  135generate_question(Question) :-
  136    db_entry(teacher:_,Question,_),
  137    make_ground_term(Question),
  138    nl,
  139    write(' Question generated: '),
  140    write(Question),
  141    nl.
  142 
  143get_question(Question) :-
  144    write(' Input question: '),
  145    read(Question).
  146 
  147mode(auto) :-
  148    nl, nl,
  149    yes_no(yes, ' Do you want the system to generate questions ? ',Reply),
  150    nl,
  151    Reply = yes,
  152    !.
  153mode(manual).
  154 
  155exit_manual :-
  156    yes_no(no, ' Exit manual mode ? ',Reply),
  157    Reply = yes.
  158 
  159exit_auto :-
  160    yes_no(no, ' Exit auto mode ? ',Reply),
  161    Reply = yes.
  162 
  163exit :-
  164    yes_no(no, ' Quit ? ',Reply),
  165    Reply = yes.
  166 
  167get_teacher(Teacher) :-
  168    yes_no(yes, ' Do you want to load the provided teacher KB ? ',Reply),
  169    load_knowledge_base(Reply,Teacher),
  170    knowledge_base_list(Reply,[],Teacher,FileList),
  171    yes_no(no, ' Do you want to load another teacher KB ? ',Reply2),
  172    more_knowledge(Reply2,FileList).
  173 
  174load_knowledge_base(no,_).
  175load_knowledge_base(yes,File) :-
  176    nl, consult(File), nl, !.
  177 
  178more_knowledge(no,[_|_]).
  179more_knowledge(no,[]) :-
  180    write(' *** You have not load any knowledge base yet !'), nl,
  181    more_knowledge(yes,[]).
  182more_knowledge(yes,FileList) :-
  183    repeat,
  184    ask_file(' Please input the filename of the KB: ',File),
  185    not_loaded(File,FileList,Load),
  186    load_knowledge_base(Load,File),
  187    knowledge_base_list(Load,FileList,File,NewList),
  188    yes_no(no, ' Do you want to consult more KBs ? ',Reply),
  189    more_knowledge(Reply,NewList).
  190 
  191not_loaded(File,List,no) :-
  192    member(File,List), !.
  193not_loaded(_,_,yes).
  194
  195%yesno(Question):- yesno(Question,no).
  196%yesno(Question, Default):- format('~N~w? (~w): ',[Question,Default]),get_single_char(YN), (YN = 13 -> Default==yes; member(YN, `yY`)).
  197
  198yes_no(Default, Message,Reply) :-
  199    repeat,
  200    write(' '),
  201    write(Message),
  202    (Default == yes -> write(' (Yes/no) ') ; write(' (yes/No) ')),
  203    get_single_char(In),
  204    ([In]=`e` -> (!,halt(4)) ; ([In]=`a` -> (!,abort) ;  (In = 13 ->  Reply = Default ; reply(In,Reply)))), !.
  205 
  206reply(Reply,yes) :-
  207    member(Reply,[yes,y,'yes.','y.'|`Yy`]).
  208reply(Reply,no) :-
  209    member(Reply,[no,n,'no.','n.'|`Nn`]).
  210 
  211ask_file(Message,File) :-
  212    repeat,
  213    write(' '),
  214    write(Message),
  215    read_in(File), !.
  216 
  217knowledge_base_list(yes,List,File,[File|List]).
  218knowledge_base_list(no,List,_,List).
  219 
  220no_knowledge([]) :-
  221    write(' *** You have not load any knowledge base yet !'), nl.
  222 
  223get_learner :-
  224    ask_file(' Please input the filename for the learner KB: ',File),
  225    load_knowledge_base(yes,File),
  226    knowledge_base_list(yes,[],File,List),
  227    yes_no(no,' Do you want to load another KB for the learner ? ',Reply),
  228    more_knowledge(Reply,List).
  229 
  230/******************************************************************/
  231/* Brazdil's predicates for evaluating the behavior of "LEARNER"  */
  232/* and "TEACHER".                         */
  233/******************************************************************/
  234can_do(learner:Tl,teacher:Tt,Question,TeachersAnswer) :-
  235    demo(learner:Tl,Question,LearnersAnswer),
  236    can_do_1(teacher:Tt,Question,TeachersAnswer,LearnersAnswer).
  237 
  238can_do_1(Teacher,Question,TeachersAnswer,LearnersAnswer) :-
  239    demo(Teacher,Question,TeachersAnswer),
  240    demo(Teacher,LearnersAnswer,TeachersAnswer),
  241    demo(Teacher,TeachersAnswer,LearnersAnswer).
  242 
  243cannot_do(learner:Tl,teacher:Tt,Question,TeachersAnswer) :-
  244    \+ demo(learner:Tl,Question,_LearnersAnswer),
  245    demo(teacher:Tt,Question,TeachersAnswer).
  246cannot_do(Learner,Teacher,Question,_) :-
  247    can_do(Learner,Teacher,Question,_), !, fail.
  248cannot_do(learner:Tl,teacher:Tt,Question,TeachersAnswer) :-
  249    demo(learner:Tl,Question,_),
  250% It seems that the condition LearnersAnswer <> TeachersAnswer is missing !
  251    demo(teacher:Tt,Question,TeachersAnswer).
  252 
  253what_cannot_do(_,_,'<-'(Q , _),_,_) :-
  254    \+ all_ground_term(Q),
  255    nl, write(' *** You asked a non ground question !'), nl, !, fail.
  256what_cannot_do(Ls,Ts,'<-'(Q , A),FaultyStep,FaultyStep) :-
  257    can_do(Ls,Ts,Q,A).
  258what_cannot_do(Ls,Ts,'<-'(Q , A),F1,['<-'(Q , A)|F1]) :-
  259    is_faulty_step(Ls,Ts,Q,A).
  260what_cannot_do(Ls,Ts,'<-'(Q , A),F1,F2) :-
  261    cannot_do(Ls,Ts,Q,A),
  262    demo_trace2(Ls,Ts,Q,A,SubSteps),
  263    what_cannot_do_list(Ls,Ts,SubSteps,F1,F3),
  264    faulty_step(Q,A,F1,F3,F2).
  265 
  266is_faulty_step(Ls,Ts,Q,A) :-
  267    cannot_do(Ls,Ts,Q,A), !,
  268    \+ demo_trace2(Ls,Ts,Q,A,_).
  269 
  270faulty_step(Q,A,F1,F1,['<-'(Q , A)|F1]).
  271faulty_step(_Q,_A,_F1,F3,F3).
  272 
  273what_cannot_do_list(_,_,[],F,F).
  274what_cannot_do_list(Ls,Ts,[Step1|RestSteps],F1,F3) :-
  275    what_cannot_do(Ls,Ts,Step1,F1,F2),
  276    what_cannot_do_list(Ls,Ts,RestSteps,F2,F3).
  277 
  278/******************************************************************/
  279/*                                                                */
  280/*  call        : demo(+Theory,+Goal,Conditions)          */
  281/*                                                                */
  282/*  arguments   : Theory     = ground term denoting a theory      */
  283/*                Goal       = ground term or list of ground terms*/
  284/*                Conditions = substitutions                      */
  285/*                                                                */
  286/*  property    : backtrackable                   */
  287/*                                                                */
  288/******************************************************************/
  289/* 'demo' is used to prove the Goal in the background of a Theory */
  290/* delivering a substitution in Conditions.                       */
  291/* Bindings of variables and values are explicitly maintained by  */
  292/* this implementation, thus any subterm of the form "variable(S)"*/
  293/* must actually be of the form "variabl(<atom>)" where <atom> is */
  294/* the name of a variable in the Goal.                            */
  295/* The substitutions in Condition may be either a variable  or a  */
  296/* list of terms which all have the form val(variable(X),Y) where */
  297/* X is the name of a variable (an atom) and Y is any term.       */
  298/* In the case Condition is uninstantiated, demo succeeds iff     */
  299/* Goal can be proven within the Theory. Condition is then instan-*/
  300/* tiated with the corresponding substitutions in the form        */
  301/* described above. On backtracking it will deliver the next      */
  302/* possible proof with the corresponding substitution, if it      */
  303/* exists.                            */
  304/* If Condition is instantiated in the form described above, demo */
  305/* succeeds, if Goal can be proven with the given substitution.   */
  306/******************************************************************/
  307demo(Theory,Goal,Conditions) :-
  308    var(Conditions),
  309    !,
  310    check_goal(Goal),
  311    copy_vars(Goal,LVars,Goal2,LVars2),
  312    !,
  313    show(Theory,Goal2),
  314    link_vals(LVars,LVars2,Conditions),
  315    make_ground_term(Conditions).
  316demo(Theory,Goal,Conditions) :-
  317    nonvar(Conditions),
  318    check_conditions(Conditions),
  319    check_goal(Goal),
  320    set_vars(Goal,Conditions,Goal2),
  321    copy_vars(Goal2,_,Goal3,LVars3),
  322    !,
  323    show(Theory,Goal3),
  324    no_new_values(LVars3),
  325    \+ identified_vars(LVars3),
  326    !.
  327 
  328/******************************************************************/
  329/* Brazdil's predicate for locating erroneous LEARNER's knowledge */
  330/******************************************************************/
  331demo_trace2(Ls,Ts,Goal,Conditions,Steps) :-
  332    set_vars(Goal,Conditions,Goal2),
  333    copy_vars(Goal2,_,Goal3,_),
  334    copy_vars(Goal2,_,Goal4,_),
  335    !,
  336    db_entry(Ls,Goal3,_),
  337    !,
  338    db_entry(Ts,Goal4,Body),
  339    make_ground_term(Body),
  340    set_vars(Body,Conditions,Body2),
  341    copy_vars(Body2,_,Body3,_),
  342    show(Ts,Body3),
  343    make_ground_term(Body3),
  344    trace_list(Body3,Steps).
  345 
  346trace_list([],[]).
  347trace_list([SubGoal|Rest],[SubGoal <- _|Steps]) :-
  348    trace_list(Rest,Steps).
  349 
  350/******************************************************************/
  351/*                                                                */
  352/*  call        : show(+Theory,+Goal)                 */
  353/*                                                                */
  354/*  arguments   : Theory     = ground term denoting a theory      */
  355/*                Goal       = ground term or list of ground terms*/
  356/*                                                                */
  357/*  property    : backtrackable                   */
  358/*                                                                */
  359/******************************************************************/
  360/* 'show' is nothing else than an Prolog meta-interpreter working */
  361/* in the traditional way, except that substitutions are explicit-*/
  362/* ly represented through terms in the form 'val(<var>,<term>)'.  */
  363/******************************************************************/
  364show(_,[]) :- !.
  365show(Th, not(G)) :-
  366    !,
  367    \+ show(Th,G).
  368show(Th, \+ G) :-
  369    !,
  370    \+ show(Th,G).
  371show(_Th,val(X,Y)) :-
  372    !,
  373    is_value(X,Y).
  374show(Th,[G|Gs]) :-
  375    !,
  376    show(Th,G),
  377    show(Th,Gs).
  378show(Th,G) :-
  379    db_entry(Th,G,B),
  380    show(Th,B).
  381show(Th,G) :-
  382    def_theory(Th,ThList),
  383    member(SubTh,ThList),
  384    show(SubTh,G).
  385show(_,G) :- predicate_property(G,built_in),!,call(G).
  386show(_,G) :- predicate_property(G,unknown),dynamic(G),fail.
  387show(_,G) :-
  388    \+ clause(G,_),    
  389    call(G), !.
  390 
  391is_value(X,Y) :-
  392    var(X), var(Y), !.
  393is_value(X,_) :-
  394    var(X), !, fail.
  395is_value(_,Y) :-
  396    var(Y), !, fail.
  397is_value(X,X) :-
  398    atomic(X), !.
  399is_value([Head1|Tail1],[Head2|Tail2]) :-
  400    !,
  401    is_value(Head1,Head2),
  402    is_value(Tail1,Tail2).
  403is_value(X,Y) :-
  404    \+ atomic(X),
  405    \+ atomic(Y),
  406    X =..[F|ArgsX],
  407    Y =..[F|ArgsY],
  408    !,
  409    is_value(ArgsX,ArgsY).
  410 
  411/******************************************************************/
  412/* Variable handling procedures                   */
  413/******************************************************************/
  414/*                                                                */
  415/*  call        : copy_vars(+G,+LVars,-G2,-LVars2)        */
  416/*                                                                */
  417/*  arguments   : G      = ground term                */
  418/*                LVars  = list of variables in G         */
  419/*                G2     = variablelized term             */
  420/*                LVars2 = list of variables in G2        */
  421/*                                                                */
  422/******************************************************************/
  423/* 'copy_vars' sets G2 to a copy of G with all variables of the   */
  424/* form 'variable(<name>)' replaced with uninstantiated Prolog    */
  425/* variables.                                                     */
  426/******************************************************************/
  427copy_vars(variable(G),[G],G2,[G2]).
  428copy_vars(G,[],G,[]) :-
  429    atomic(G).
  430copy_vars(G,LVars,G2,LVars2) :-
  431    G =.. [F|Args],
  432    copy_vars_list(Args,[],LVars,Args2,[],LVars2),
  433    G2 =.. [F|Args2].
  434 
  435copy_vars_list([],LVars,LVars,[],LVars2,LVars2).
  436copy_vars_list([A|As],PV,LV,[A2|A2s],PV2,LV2) :-
  437    copy_vars(A,AVL,A2,AVL2),
  438    join_vars(AVL,PV,PVplus,AVL2,PV2,PV2plus),
  439    copy_vars_list(As,PVplus,LV,A2s,PV2plus,LV2).
  440 
  441join_vars([],PV,PV,[],PV2,PV2).
  442join_vars([X|AVL],PVin,PVout,[X2|AVL2],PV2in,PV2out) :-
  443    twin_member(X,PVin,X2,PV2in),
  444    join_vars(AVL,PVin,PVout,AVL2,PV2in,PV2out).
  445join_vars([X|AVL],PVin,PVout,[X2|AVL2],PV2in,PV2out) :-
  446    join_vars(AVL,[X|PVin],PVout,AVL2,[X2|PV2in],PV2out).
  447 
  448twin_member(Var,[Var|_],Val,[Val|_]).
  449twin_member(Var,[_|Tail1],Val,[_|Tail2]) :-
  450    twin_member(Var,Tail1,Val,Tail2).
  451 
  452/******************************************************************/
  453/*                                                                */
  454/*  call        : link_vals(+LVars1,+LVars2,-Cond)        */
  455/*                                                                */
  456/*  arguments   : LVars1 = list of atomic ground terms        */
  457/*                LVars2 = list of terms (can be Prolog variables)*/
  458/*                Cond   = combined substitution          */
  459/*                                                                */
  460/******************************************************************/
  461/* 'link_vals' combines each corresponding varible name in LVars1 */
  462/* with its value in LVars2, to form a list of substituitions of  */
  463/* the form val(<var>,<term>).                                    */
  464/******************************************************************/
  465link_vals([X|LV],[X2|LV2],[val(variable(X),X2)|Conditions]) :-
  466    link_vals(LV,LV2,Conditions).
  467link_vals([],[],[]).
  468 
  469/******************************************************************/
  470/*                                                                */
  471/*  call        : set_vars(+Goal1,+Cond,-Goal2)           */
  472/*                                                                */
  473/*  arguments   : Goal1 = a ground goal               */
  474/*                Cond  = a substitution              */
  475/*                Goal2 = Goal1 with substituted variables        */
  476/*                                                                */
  477/******************************************************************/
  478/* 'set_vars' substitutes variables depicted by 'variable(<name>)'*/
  479/* in Goal1 by its value in Goal2, according to the substitution  */
  480/* Cond.                                                  */
  481/******************************************************************/
  482set_vars(Goal,[],Goal).
  483set_vars(Goal,[val(variable(Var),Val)|Rest],ResultGoal) :-
  484    atomic(Var),
  485    substitute(Goal,variable(Var),Val,Goal2),
  486    !,
  487    set_vars(Goal2,Rest,ResultGoal).
  488 
  489substitute(Var,Var,Val,Val).
  490substitute(Goal,_,_,Goal) :-
  491    atomic(Goal),
  492    !.
  493substitute([Arg|Tail],Var,Val,[NewArg|NewTail]) :-
  494    !,
  495    substitute(Arg,Var,Val,NewArg),
  496    substitute(Tail,Var,Val,NewTail).
  497substitute(Goal,Var,Val,FinalGoal) :-
  498    Goal =..[F|Args],
  499    substitute(Args,Var,Val,NewArgs),
  500    FinalGoal =..[F|NewArgs].
  501 
  502/******************************************************************/
  503/*                                                                */
  504/*  call        : all_ground_term(+Term)              */
  505/*                                                                */
  506/*  arguments   : Term = a Prolog term                */
  507/*                                                                */
  508/******************************************************************/
  509/* 'all_ground_term' succeeds if Term is ground, i.e. all vari-   */
  510/* ables are instantiated. Modification note: In YAP-Prolog       */
  511/*  all_ground_term(Term) :- ground(Term).            */
  512/* and in any other DEC10-Prolog dialects             */
  513/*  all_ground_term(Term) :- numbervars(Term,0,0).        */
  514/* can be used to speed up the system                 */
  515/******************************************************************/
  516all_ground_term(Variable) :-
  517    var(Variable), !, fail.
  518all_ground_term(Atomic) :-
  519    atomic(Atomic), !.
  520all_ground_term([Head|Tail]) :-
  521    !,
  522    all_ground_term(Head),
  523    all_ground_term(Tail).
  524all_ground_term(Structure) :-
  525    Structure =.. [_|Args],
  526    all_ground_term(Args).
  527 
  528check_goal(Goal) :-
  529    \+ all_ground_term(Goal),
  530    write(' *** Only ground terms in goal allowed !'), !, fail.
  531check_goal(Goal) :-
  532    \+ proper_variable(Goal),
  533    write(' *** <name> of any variable(<name>) should be atomic ground !'),
  534    !, fail.
  535check_goal(_).
  536 
  537proper_variable(Atom) :-
  538    atomic(Atom), !.
  539proper_variable(variable(Name)) :-
  540    \+ atomic(Name),
  541    write(' *** variable('), write(Name), write(') not atomic'), nl,
  542    !, fail.
  543proper_variable([Head|Tail]) :-
  544    !,
  545    proper_variable(Head),
  546    proper_variable(Tail).
  547proper_variable(Structure) :-
  548    Structure =.. [_|Args],
  549    proper_variable(Args).
  550 
  551check_conditions(Cond) :-
  552    \+ all_ground_term(Cond),
  553    write(' *** Only ground terms in conditions allowed !'), !, fail.
  554check_conditions(Cond) :-
  555    \+ proper_format(Cond),
  556    write(' *** Conditions should be either an uninstanziated variable'),
  557    nl,
  558    write('     or a list of structures, val(variable(<name>),<value>) !'),
  559    !, fail.
  560check_conditions(_).
  561 
  562proper_format([]).
  563proper_format([val(variable(Atom),_)|Tail]) :-
  564    atomic(Atom),
  565    proper_format(Tail).
  566
  567make_ground_term(Body3):- make_ground_term(10, Body3).
  568
  569make_ground_term(_D,Variable) :-
  570    var(Variable),
  571    new_symbol(X),
  572    Variable = variable(X), !.
  573make_ground_term(_D,Atom) :-
  574    atomic(Atom), !.
  575make_ground_term(D,_) :- D == 0, format(user_error,'~N~q~n',[make_ground_term(D,_)]) , !,fail.
  576make_ground_term(D,[Head|Tail]) :- % \+ is_list(Head),
  577    !, D2 is D - 1,
  578    make_ground_term(D2,Head),
  579    !,
  580    make_ground_term(D2,Tail).
  581make_ground_term(D,Structure) :- compound(Structure),!,
  582    D2 is D - 1,
  583    Structure =.. [_|Args],
  584    make_ground_term(D2,Args).
  585 
  586/******************************************************************/
  587/*                                                                */
  588/*  call        : no_new_values(+List)                */
  589/*                                                                */
  590/*  arguments   : List = a Prolog list                */
  591/*                                                                */
  592/******************************************************************/
  593/* 'no_new_values' succeeds if List is a list of uninstantiated   */
  594/* variables.                                                 */
  595/******************************************************************/
  596no_new_values([]).
  597no_new_values([X|Xs]) :-
  598    var(X),
  599    no_new_values(Xs).
  600 
  601/******************************************************************/
  602/*                                                                */
  603/*  call        : identified_vars(+List)              */
  604/*                                                                */
  605/*  arguments   : List = a list of variables              */
  606/*                                                                */
  607/******************************************************************/
  608/* 'identified_vars' succeeds if there exists at least one vari-  */
  609/* able in the List, which has been 'unified' with another vari-  */
  610/* able in the list.                                              */
  611/******************************************************************/
  612identified_vars([X|Xs]) :-
  613    member(Y,Xs),
  614    same_var(X,Y).
  615identified_vars([_|T]) :-
  616    identified_vars(T).
  617 
  618/******************************************************************/
  619/*                                                                */
  620/*  call        : same_var(+Var1,+Var2)               */
  621/*                                                                */
  622/*  arguments   : Var1 = a Prolog variable                */
  623/*                Var2 = a Prolog variable                */
  624/*                                                                */
  625/******************************************************************/
  626/* 'same_var' succeeds if Var1 and Var2 are unified, but uninstan-*/
  627/* tiated.                                                */
  628/******************************************************************/
  629same_var(dummy,Y) :-
  630    var(Y), !, fail.
  631same_var(X,Y) :-
  632    var(X), var(Y).
  633 
  634/******************************************************************/
  635/* Miscelenous predicates                     */
  636/******************************************************************/
  637digits_of_next_sym("1").
  638 
  639new_symbol(X) :-
  640    digits_of_next_sym(LN),
  641    revzap(LN,[],RLN),
  642    append("sym",RLN,LS),
  643    name(X,LS),
  644    inc_digits(LN,LN2),
  645    retract(digits_of_next_sym(LN)),
  646    assert(digits_of_next_sym(LN2)).
  647 
  648inc_digits([D1|LDT],[D2|LDT]) :-
  649    D1 <57, D2 is D1 + 1.
  650inc_digits([_|LDT],[48|LDT2]) :-
  651    inc_digits(LDT,LDT2).
  652inc_digits([],[49]).
  653 
  654revzap([H|T],V,R) :-
  655    revzap(T,[H|V],R).
  656revzap([],R,R).
  657 
  658read_in(W) :-
  659    ignore_space(C),
  660    rcl(C,L),
  661    extract_space(L,L1),
  662    convert(W,L1).
  663 
  664ignore_space(C) :-
  665    repeat,
  666    get0(C),
  667    non_space(C).
  668 
  669rcl(10,[]).
  670rcl(C1,[C1|P]) :-
  671    proper_char(C1),
  672    get0(C2),
  673    rcl(C2,P).
  674rcl(C1,[C1|P]) :-
  675    space(C1),
  676    get0(C2),
  677    rcl(C2,P).
  678rcl(_C1,L) :-
  679    put(7),
  680    get0(C2),
  681    rcl(C2,L).
  682 
  683convert([],[]).
  684convert(W,L) :-
  685    name(W,L).
  686 
  687non_space(C) :-
  688    space(C), !, fail.
  689non_space(10) :-
  690    !, fail.
  691non_space(C) :-
  692    proper_char(C).
  693non_space(_) :-
  694    put(7), !, fail.
  695 
  696space(32).
  697space(9).
  698 
  699proper_char(C) :-
  700    C > 32, C < 128.
  701 
  702extract_space(L,L2) :-
  703    reverse(L,R),
  704    delete_space(R,R2),
  705    reverse(R2,L2).
  706 
  707delete_space([S|T],L) :-
  708    space(S),
  709    delete_space(T,L).
  710delete_space(L,L).
  711
  712reverse([],[]).
  713reverse([X|Y],Z) :-
  714    reverse(Y,Y1),
  715    append(Y1,[X],Z)