This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/swi/library/prolog_clause.pl

677 lines
20 KiB
Perl
Raw Normal View History

2012-02-13 09:42:57 +00:00
/* $Id$
Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: J.Wielemaker@vu.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2011, University of Amsterdam
VU University Amsterdam
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
As a special exception, if you link this library with other files,
compiled with a Free Software compiler, to produce an executable, this
library does not by itself cause the resulting executable to be covered
by the GNU General Public License. This exception does not however
invalidate any other reasons why the executable file might be covered by
the GNU General Public License.
*/
:- module(prolog_clause,
[ clause_info/4, % +ClauseRef, -File, -TermPos, -VarNames
predicate_name/2, % +Head, -Name
clause_name/2 % +ClauseRef, -Name
]).
:- use_module(library(lists), [append/3]).
:- use_module(library(occurs), [sub_term/2]).
:- use_module(library(debug)).
:- use_module(library(listing)).
:- use_module(library(prolog_source)).
:- public % called from library(trace/clause)
unify_term/2,
make_varnames/5,
do_make_varnames/3.
:- multifile
make_varnames_hook/5.
/** <module> Get detailed source-information about a clause
2014-09-11 20:06:57 +01:00
@ingroup SWILibrary
2012-02-13 09:42:57 +00:00
This module started life as part of the GUI tracer. As it is generally
useful for debugging purposes it has moved to the general Prolog
library.
The tracer library library(trace/clause) adds caching and dealing with
dynamic predicates using listing to XPCE objects to this. Note that
clause_info/4 as below can be slow.
*/
%% clause_info(+ClauseRef, -File, -TermPos, -VarNames)
%
% Fetches source information for the given clause. File is the
% file from which the clause was loaded. TermPos describes the
% source layout in a format compatible to the subterm_positions
% option of read_term/2. VarNames provides access to the variable
% allocation in a stack-frame. See make_varnames/5 for details.
clause_info(ClauseRef, File, TermPos, NameOffset) :-
( debugging(clause_info)
-> clause_name(ClauseRef, Name),
debug(clause_info, 'clause_info(~w) (~w)... ',
[ClauseRef, Name])
; true
),
clause_property(ClauseRef, file(File)),
'$clause'(Head, Body, ClauseRef, VarOffset),
( Body == true
-> DecompiledClause = Head
; DecompiledClause = (Head :- Body)
),
File \== user, % loaded using ?- [user].
clause_property(ClauseRef, line_count(LineNo)),
( module_property(Module, file(File))
-> true
; strip_module(user:Head, Module, _)
),
debug(clause_info, 'from ~w:~d ... ', [File, LineNo]),
read_term_at_line(File, LineNo, Module, Clause, TermPos0, VarNames),
debug(clause_info, 'read ...', []),
unify_clause(Clause, DecompiledClause, Module, TermPos0, TermPos),
debug(clause_info, 'unified ...', []),
make_varnames(Clause, DecompiledClause, VarOffset, VarNames, NameOffset),
debug(clause_info, 'got names~n', []), !.
%% unify_term(+T1, +T2)
%
% Unify the two terms, where T2 is created by writing the term and
% reading it back in, but be aware that rounding problems may
% cause floating point numbers not to unify. Also, if the initial
% term has a string object, it is written as "..." and read as a
% code-list. We compensate for that.
%
% NOTE: Called directly from library(trace/clause) for the GUI
% tracer.
unify_term(X, X) :- !.
unify_term(X1, X2) :-
compound(X1),
compound(X2),
functor(X1, F, Arity),
functor(X2, F, Arity), !,
unify_args(0, Arity, X1, X2).
unify_term(X, Y) :-
float(X), float(Y), !.
unify_term(X, Y) :-
string(X),
is_list(Y),
string_to_list(X, Y), !.
unify_term(_, Y) :-
Y == '...', !. % elipses left by max_depth
unify_term(_:X, Y) :-
unify_term(X, Y), !.
unify_term(X, _:Y) :-
unify_term(X, Y), !.
unify_term(X, Y) :-
format('[INTERNAL ERROR: Diff:~n'),
portray_clause(X),
format('~N*** <->~n'),
portray_clause(Y),
break.
unify_args(N, N, _, _) :- !.
unify_args(I, Arity, T1, T2) :-
A is I + 1,
arg(A, T1, A1),
arg(A, T2, A2),
unify_term(A1, A2),
unify_args(A, Arity, T1, T2).
%% read_term_at_line(+File, +Line, +Module,
%% -Clause, -TermPos, -VarNames) is semidet.
%
% Read a term from File at Line.
read_term_at_line(File, Line, Module, Clause, TermPos, VarNames) :-
catch(open(File, read, In), _, fail),
call_cleanup(
read_source_term_at_location(
In, Clause,
[ line(Line),
module(Module),
subterm_positions(TermPos),
variable_names(VarNames)
]),
close(In)).
%% make_varnames(+ReadClause, +DecompiledClause,
%% +Offsets, +Names, -Term) is det.
%
% Create a Term varnames(...) where each argument contains the name
% of the variable at that offset. If the read Clause is a DCG rule,
% name the two last arguments <DCG_list> and <DCG_tail>
%
% This predicate calles the multifile predicate
% make_varnames_hook/5 with the same arguments to allow for user
% extensions. Extending this predicate is needed if a compiler
% adds additional arguments to the clause head that must be made
% visible in the GUI tracer.
%
% @param Offsets List of Offset=Var
% @param Names List of Name=Var
make_varnames(ReadClause, DecompiledClause, Offsets, Names, Term) :-
make_varnames_hook(ReadClause, DecompiledClause, Offsets, Names, Term), !.
make_varnames((Head --> _Body), _, Offsets, Names, Bindings) :- !,
functor(Head, _, Arity),
In is Arity,
memberchk(In=IVar, Offsets),
Names1 = ['<DCG_list>'=IVar|Names],
Out is Arity + 1,
memberchk(Out=OVar, Offsets),
Names2 = ['<DCG_tail>'=OVar|Names1],
make_varnames(xx, xx, Offsets, Names2, Bindings).
make_varnames(_, _, Offsets, Names, Bindings) :-
length(Offsets, L),
functor(Bindings, varnames, L),
do_make_varnames(Offsets, Names, Bindings).
do_make_varnames([], _, _).
do_make_varnames([N=Var|TO], Names, Bindings) :-
( find_varname(Var, Names, Name)
-> true
; Name = '_'
),
AN is N + 1,
arg(AN, Bindings, Name),
do_make_varnames(TO, Names, Bindings).
find_varname(Var, [Name = TheVar|_], Name) :-
Var == TheVar, !.
find_varname(Var, [_|T], Name) :-
find_varname(Var, T, Name).
%% unify_clause(+Read, +Decompiled, +Module, +ReadTermPos,
%% -RecompiledTermPos).
%
% What you read isn't always what goes into the database. The task
% of this predicate is to establish the relation between the term
% read from the file and the result from decompiling the clause.
%
% This predicate calls the multifile predicate unify_clause_hook/5
% with the same arguments to support user extensions.
%
% @tbd This really must be more flexible, dealing with much
% more complex source-translations, falling back to a
% heuristic method locating as much as possible.
:- multifile
unify_clause_hook/5.
unify_clause(Read, Read, _, TermPos, TermPos) :- !.
% XPCE send-methods
unify_clause(Read, Decompiled, Module, TermPoso, TermPos) :-
unify_clause_hook(Read, Decompiled, Module, TermPoso, TermPos), !.
unify_clause(:->(Head, Body), (PlHead :- PlBody), _, TermPos0, TermPos) :- !,
pce_method_clause(Head, Body, PlHead, PlBody, TermPos0, TermPos).
% XPCE get-methods
unify_clause(:<-(Head, Body), (PlHead :- PlBody), _, TermPos0, TermPos) :- !,
pce_method_clause(Head, Body, PlHead, PlBody, TermPos0, TermPos).
% Unit test clauses
unify_clause((TH :- Body),
(_:'unit body'(_, _) :- !, Body), _,
TP0, TP) :-
( TH = test(_,_)
; TH = test(_)
), !,
TP0 = term_position(F,T,FF,FT,[HP,BP]),
TP = term_position(F,T,FF,FT,[HP,term_position(0,0,0,0,[FF-FT,BP])]).
% module:head :- body
unify_clause((Head :- Read),
(Head :- _M:Compiled), Module, TermPos0, TermPos) :-
unify_clause((Head :- Read), (Head :- Compiled), Module, TermPos0, TermPos1),
TermPos1 = term_position(TA,TZ,FA,FZ,[PH,PB]),
TermPos = term_position(TA,TZ,FA,FZ,
[ PH,
term_position(0,0,0,0,[0-0,PB])
]).
unify_clause(Read, Compiled1, Module, TermPos0, TermPos) :-
Read = (_ --> List, _),
is_list(List),
ci_expand(Read, Compiled2, Module),
Compiled2 = (DH :- _),
functor(DH, _, Arity),
DArg is Arity - 1,
arg(DArg, DH, List),
nonvar(List),
TermPos0 = term_position(F,T,FF,FT,[ HP,
term_position(_,_,_,_,[_,BP])
]), !,
TermPos1 = term_position(F,T,FF,FT,[ HP, BP ]),
match_module(Compiled2, Compiled1, TermPos1, TermPos).
% general term-expansion
unify_clause(Read, Compiled1, Module, TermPos0, TermPos) :-
ci_expand(Read, Compiled2, Module),
match_module(Compiled2, Compiled1, TermPos0, TermPos).
% I don't know ...
unify_clause(_, _, _, _, _) :-
debug(clause_info, 'Could not unify clause', []),
fail.
unify_clause_head(H1, H2) :-
strip_module(H1, _, H),
strip_module(H2, _, H).
ci_expand(Read, Compiled, Module) :-
catch(setup_call_cleanup('$set_source_module'(Old, Module),
expand_term(Read, Compiled),
'$set_source_module'(_, Old)),
E,
expand_failed(E, Read)).
match_module((H1 :- B1), (H2 :- B2), Pos0, Pos) :- !,
unify_clause_head(H1, H2),
unify_body(B1, B2, Pos0, Pos).
match_module(H1, H2, Pos, Pos) :- % deal with facts
unify_clause_head(H1, H2).
%% expand_failed(+Exception, +Term)
%
% When debugging, indicate that expansion of the term failed.
expand_failed(E, Read) :-
debugging(clause_info),
message_to_string(E, Msg),
debug(clause_info, 'Term-expand ~p failed: ~w', [Read, Msg]),
fail.
%% unify_body(+Read, +Decompiled, +Pos0, -Pos)
%
% Deal with translations implied by the compiler. For example,
% compiling (a,b),c yields the same code as compiling a,b,c.
%
% Pos0 and Pos still include the term-position of the head.
unify_body(B, B, Pos, Pos) :-
does_not_dcg_after_binding(B, Pos), !.
unify_body(R, D,
term_position(F,T,FF,FT,[HP,BP0]),
term_position(F,T,FF,FT,[HP,BP])) :-
ubody(R, D, BP0, BP).
%% does_not_dcg_after_binding(+ReadBody, +ReadPos) is semidet.
%
% True if ReadPos/ReadPos does not contain DCG delayed
% unifications.
%
% @tbd We should pass that we are in a DCG; if we are not there
% is no reason for this test.
does_not_dcg_after_binding(B, Pos) :-
acyclic_term(B), % X = call(X)
\+ sub_term(brace_term_position(_,_,_), Pos),
\+ (sub_term((Cut,_=_), B), Cut == !), !.
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Some remarks.
a --> { x, y, z }.
This is translated into "(x,y),z), X=Y" by the DCG translator, after
which the compiler creates "a(X,Y) :- x, y, z, X=Y".
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
%% ubody(+Read, +Decompiled, +TermPosRead, -TermPosForDecompiled)
%
% @param Read Clause read _after_ expand_term/2
% @param Decompiled Decompiled clause
% @param TermPosRead Sub-term positions of source
ubody(B, B, P, P) :-
does_not_dcg_after_binding(B, P), !.
ubody(X, call(X), % X = call(X)
From-To,
term_position(From, To, From, To, [From-To])) :- !.
ubody(B0, B,
brace_term_position(F,T,A0),
Pos) :-
B0 = (_,_=_), !,
T1 is T - 1,
ubody(B0, B,
term_position(F,T,
F,T,
[A0,T1-T]),
Pos).
ubody(B0, B,
brace_term_position(F,T,A0),
term_position(F,T,F,T,[A])) :- !,
ubody(B0, B, A0, A).
ubody(C0, C, P0, P) :-
nonvar(C0), nonvar(C),
C0 = (_,_), C = (_,_), !,
conj(C0, P0, GL, PL),
mkconj(C, P, GL, PL).
ubody(X0, X,
term_position(F,T,FF,TT,PA0),
term_position(F,T,FF,TT,PA)) :-
meta(X0), !,
X0 =.. [_|A0],
X =.. [_|A],
ubody_list(A0, A, PA0, PA).
% 5.7.X optimizations
ubody(_=_, true, % singleton = Any
term_position(F,T,_FF,_TT,_PA),
F-T) :- !.
ubody(_==_, fail, % singleton/firstvar == Any
term_position(F,T,_FF,_TT,_PA),
F-T) :- !.
ubody(A1=B1, B2=A2, % Term = Var --> Var = Term
term_position(F,T,FF,TT,[PA1,PA2]),
term_position(F,T,FF,TT,[PA2,PA1])) :-
(A1==B1) =@= (B2==A2), !,
A1 = A2, B1=B2.
ubody(A1==B1, B2==A2, % const == Var --> Var == const
term_position(F,T,FF,TT,[PA1,PA2]),
term_position(F,T,FF,TT,[PA2,PA1])) :-
(A1==B1) =@= (B2==A2), !,
A1 = A2, B1=B2.
ubody(A is B - C, A is B + C2, Pos, Pos) :-
integer(C),
C2 =:= -C, !.
ubody_list([], [], [], []).
ubody_list([G0|T0], [G|T], [PA0|PAT0], [PA|PAT]) :-
ubody(G0, G, PA0, PA),
ubody_list(T0, T, PAT0, PAT).
conj(Goal, Pos, GoalList, PosList) :-
conj(Goal, Pos, GoalList, [], PosList, []).
conj((A,B), term_position(_,_,_,_,[PA,PB]), GL, TG, PL, TP) :- !,
conj(A, PA, GL, TGA, PL, TPA),
conj(B, PB, TGA, TG, TPA, TP).
conj((A,B), brace_term_position(_,T,PA), GL, TG, PL, TP) :-
B = (_=_), !,
conj(A, PA, GL, TGA, PL, TPA),
T1 is T - 1,
conj(B, T1-T, TGA, TG, TPA, TP).
conj((!,(S=SR)), F-T, [!,S=SR|TG], TG, [F-T,F1-T1|TP], TP) :-
F1 is F+1,
T1 is T+1.
conj(A, P, [A|TG], TG, [P|TP], TP).
mkconj(Goal, Pos, GoalList, PosList) :-
mkconj(Goal, Pos, GoalList, [], PosList, []).
mkconj(Conj, term_position(0,0,0,0,[PA,PB]), GL, TG, PL, TP) :-
nonvar(Conj),
Conj = (A,B), !,
mkconj(A, PA, GL, TGA, PL, TPA),
mkconj(B, PB, TGA, TG, TPA, TP).
mkconj(A0, P0, [A|TG], TG, [P|TP], TP) :-
ubody(A, A0, P, P0).
/*******************************
* PCE STUFF (SHOULD MOVE) *
*******************************/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
<method>(Receiver, ... Arg ...) :->
Body
mapped to:
send_implementation(Id, <method>(...Arg...), Receiver)
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
pce_method_clause(Head, Body, _:PlHead, PlBody, TermPos0, TermPos) :- !,
pce_method_clause(Head, Body, PlBody, PlHead, TermPos0, TermPos).
pce_method_clause(Head, Body,
send_implementation(_Id, Msg, Receiver), PlBody,
TermPos0, TermPos) :- !,
debug(clause_info, 'send method ...', []),
arg(1, Head, Receiver),
functor(Head, _, Arity),
pce_method_head_arguments(2, Arity, Head, Msg),
debug(clause_info, 'head ...', []),
pce_method_body(Body, PlBody, TermPos0, TermPos).
pce_method_clause(Head, Body,
get_implementation(_Id, Msg, Receiver, Result), PlBody,
TermPos0, TermPos) :- !,
debug(clause_info, 'get method ...', []),
arg(1, Head, Receiver),
debug(clause_info, 'receiver ...', []),
functor(Head, _, Arity),
arg(Arity, Head, PceResult),
debug(clause_info, '~w?~n', [PceResult = Result]),
pce_unify_head_arg(PceResult, Result),
Ar is Arity - 1,
pce_method_head_arguments(2, Ar, Head, Msg),
debug(clause_info, 'head ...', []),
pce_method_body(Body, PlBody, TermPos0, TermPos).
pce_method_head_arguments(N, Arity, Head, Msg) :-
N =< Arity, !,
arg(N, Head, PceArg),
PLN is N - 1,
arg(PLN, Msg, PlArg),
pce_unify_head_arg(PceArg, PlArg),
debug(clause_info, '~w~n', [PceArg = PlArg]),
NextArg is N+1,
pce_method_head_arguments(NextArg, Arity, Head, Msg).
pce_method_head_arguments(_, _, _, _).
pce_unify_head_arg(V, A) :-
var(V), !,
V = A.
pce_unify_head_arg(A:_=_, A) :- !.
pce_unify_head_arg(A:_, A).
% pce_method_body(+SrcBody, +DbBody, +TermPos0, -TermPos
%
% Unify the body of an XPCE method. Goal-expansion makes this
% rather tricky, especially as we cannot call XPCE's expansion
% on an isolated method.
%
% TermPos0 is the term-position term of the whole clause!
%
% Further, please note that the body of the method-clauses reside
% in another module than pce_principal, and therefore the body
% starts with an I_CONTEXT call. This implies we need a
% hypothetical term-position for the module-qualifier.
pce_method_body(A0, A, TermPos0, TermPos) :-
TermPos0 = term_position(F, T, FF, FT,
[ HeadPos,
BodyPos0
]),
TermPos = term_position(F, T, FF, FT,
[ HeadPos,
term_position(0,0,0,0, [0-0,BodyPos])
]),
pce_method_body2(A0, A, BodyPos0, BodyPos).
pce_method_body2(::(_,A0), A, TermPos0, TermPos) :- !,
TermPos0 = term_position(_, _, _, _, [_Cmt,BodyPos0]),
TermPos = BodyPos,
expand_goal(A0, A, BodyPos0, BodyPos).
pce_method_body2(A0, A, TermPos0, TermPos) :-
A0 =.. [Func,B0,C0],
control_op(Func), !,
A =.. [Func,B,C],
TermPos0 = term_position(F, T, FF, FT,
[ BP0,
CP0
]),
TermPos = term_position(F, T, FF, FT,
[ BP,
CP
]),
pce_method_body2(B0, B, BP0, BP),
expand_goal(C0, C, CP0, CP).
pce_method_body2(A0, A, TermPos0, TermPos) :-
expand_goal(A0, A, TermPos0, TermPos).
control_op(',').
control_op((;)).
control_op((->)).
control_op((*->)).
/*******************************
* EXPAND_GOAL SUPPORT *
*******************************/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
With the introduction of expand_goal, it is increasingly hard to relate
the clause from the database to the actual source. For one thing, we do
not know the compilation module of the clause (unless we want to
decompile it).
Goal expansion can translate goals into control-constructs, multiple
clauses, or delete a subgoal.
To keep track of the source-locations, we have to redo the analysis of
the clause as defined in init.pl
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
expand_goal(G, call(G), P, term_position(0,0,0,0,[P])) :-
var(G), !.
expand_goal(G, G, P, P) :-
var(G), !.
expand_goal(M0, M, P0, P) :-
meta(M0), !,
P0 = term_position(F,T,FF,FT,PL0),
P = term_position(F,T,FF,FT,PL),
functor(M0, Functor, Arity),
functor(M, Functor, Arity),
expand_meta_args(PL0, PL, 1, M0, M).
expand_goal(A, B, P0, P) :-
goal_expansion(A, B0, P0, P1), !,
expand_goal(B0, B, P1, P).
expand_goal(A, A, P, P).
expand_meta_args([], [], _, _, _).
expand_meta_args([P0|T0], [P|T], I, M0, M) :-
arg(I, M0, A0),
arg(I, M, A),
expand_goal(A0, A, P0, P),
NI is I + 1,
expand_meta_args(T0, T, NI, M0, M).
meta((_ , _)).
meta((_ ; _)).
meta((_ -> _)).
meta((_ *-> _)).
meta((\+ _)).
meta((not(_))).
meta((call(_))).
meta((once(_))).
meta((ignore(_))).
meta((forall(_, _))).
goal_expansion(send(R, Msg), send_class(R, _, SuperMsg), P, P) :-
compound(Msg),
Msg =.. [send_super, Selector | Args], !,
SuperMsg =.. [Selector|Args].
goal_expansion(get(R, Msg, A), get_class(R, _, SuperMsg, A), P, P) :-
compound(Msg),
Msg =.. [get_super, Selector | Args], !,
SuperMsg =.. [Selector|Args].
goal_expansion(send_super(R, Msg), send_class(R, _, Msg), P, P).
goal_expansion(get_super(R, Msg, V), get_class(R, _, Msg, V), P, P).
goal_expansion(SendSuperN, send_class(R, _, Msg), P, P) :-
compound(SendSuperN),
SendSuperN =.. [send_super, R, Sel | Args],
Msg =.. [Sel|Args].
goal_expansion(SendN, send(R, Msg), P, P) :-
compound(SendN),
SendN =.. [send, R, Sel | Args],
atom(Sel), Args \== [],
Msg =.. [Sel|Args].
goal_expansion(GetSuperN, get_class(R, _, Msg, Answer), P, P) :-
compound(GetSuperN),
GetSuperN =.. [get_super, R, Sel | AllArgs],
append(Args, [Answer], AllArgs),
Msg =.. [Sel|Args].
goal_expansion(GetN, get(R, Msg, Answer), P, P) :-
compound(GetN),
GetN =.. [get, R, Sel | AllArgs],
append(Args, [Answer], AllArgs),
atom(Sel), Args \== [],
Msg =.. [Sel|Args].
goal_expansion(G0, G, P, P) :-
user:goal_expansion(G0, G), % TBD: we need the module!
G0 \== G. % \=@=?
/*******************************
* PRINTABLE NAMES *
*******************************/
:- module_transparent
predicate_name/2.
:- multifile
user:prolog_predicate_name/2,
user:prolog_clause_name/2.
hidden_module(user).
hidden_module(system).
hidden_module(pce_principal). % should be config
hidden_module(Module) :- % SWI-Prolog specific
import_module(Module, system).
thaffix(1, st) :- !.
thaffix(2, nd) :- !.
thaffix(_, th).
%% predicate_name(:Head, -PredName:string) is det.
%
% Describe a predicate as [Module:]Name/Arity.
predicate_name(Predicate, PName) :-
strip_module(Predicate, Module, Head),
( user:prolog_predicate_name(Module:Head, PName)
-> true
; functor(Head, Name, Arity),
( hidden_module(Module)
-> format(string(PName), '~q/~d', [Name, Arity])
; format(string(PName), '~q:~q/~d', [Module, Name, Arity])
)
).
%% clause_name(+Ref, -Name)
%
% Provide a suitable description of the indicated clause.
clause_name(Ref, Name) :-
user:prolog_clause_name(Ref, Name), !.
clause_name(Ref, Name) :-
nth_clause(Head, N, Ref), !,
predicate_name(Head, PredName),
thaffix(N, Th),
format(string(Name), '~d-~w clause of ~w', [N, Th, PredName]).
clause_name(_, '<meta-call>').