SWI and module fixes
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2290 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
dc53522604
commit
75c72d7b7d
16
C/cdmgr.c
16
C/cdmgr.c
@ -11,8 +11,11 @@
|
||||
* File: cdmgr.c *
|
||||
* comments: Code manager *
|
||||
* *
|
||||
* Last rev: $Date: 2008-06-02 17:20:28 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2008-07-22 23:34:44 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.230 2008/06/02 17:20:28 vsc
|
||||
* fix abolish bug
|
||||
*
|
||||
* Revision 1.229 2008/05/28 17:18:35 vsc
|
||||
* thread fixes
|
||||
*
|
||||
@ -4785,6 +4788,13 @@ p_all_system_pred(void)
|
||||
return FALSE;
|
||||
if (EndOfPAEntr(pe))
|
||||
return FALSE;
|
||||
if (pe->ModuleOfPred) {
|
||||
if (!Yap_unify(ARG3,pe->ModuleOfPred))
|
||||
return FALSE;
|
||||
} else {
|
||||
if (!Yap_unify(ARG3,TermProlog))
|
||||
return FALSE;
|
||||
}
|
||||
return(!pe->ModuleOfPred || /* any predicate in prolog module */
|
||||
/* any C-pred */
|
||||
pe->PredFlags & (UserCPredFlag|CPredFlag|BinaryTestPredFlag|AsmPredFlag|TestPredFlag) ||
|
||||
@ -4829,7 +4839,7 @@ p_hide_predicate(void)
|
||||
} else
|
||||
return (FALSE);
|
||||
if (EndOfPAEntr(pe))
|
||||
return(FALSE);
|
||||
return FALSE;
|
||||
pe->PredFlags |= HiddenPredFlag;
|
||||
return(TRUE);
|
||||
}
|
||||
@ -6160,7 +6170,7 @@ Yap_InitCdMgr(void)
|
||||
Yap_InitCPred("$set_pred_module", 2, p_set_pred_module, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$parent_pred", 3, p_parent_pred, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$system_predicate", 2, p_system_pred, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$all_system_predicate", 2, p_all_system_pred, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$all_system_predicate", 3, p_all_system_pred, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$hide_predicate", 2, p_hide_predicate, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$hidden_predicate", 2, p_hidden_predicate, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$pred_for_code", 5, p_pred_for_code, SyncPredFlag|HiddenPredFlag);
|
||||
|
||||
1
C/exec.c
1
C/exec.c
@ -664,6 +664,7 @@ p_execute0(void)
|
||||
}
|
||||
}
|
||||
pe = PredPropByFunc(f, mod);
|
||||
// Yap_DebugPlWrite(mod);fprintf(stderr,"\n");
|
||||
arity = ArityOfFunctor(f);
|
||||
/* I cannot use the standard macro here because
|
||||
otherwise I would dereference the argument and
|
||||
|
||||
1
C/init.c
1
C/init.c
@ -1212,6 +1212,7 @@ InitCodes(void)
|
||||
Yap_heap_regs->functor_arrow = Yap_MkFunctor(AtomArrow, 2);
|
||||
Yap_heap_regs->functor_assert = Yap_MkFunctor(AtomAssert, 2);
|
||||
Yap_heap_regs->functor_at_found_one = Yap_MkFunctor(AtomFoundVar, 2);
|
||||
Yap_heap_regs->functor_atom = Yap_MkFunctor(Yap_LookupAtom("atom"), 1);
|
||||
#ifdef COROUTINING
|
||||
Yap_heap_regs->functor_att_goal = Yap_MkFunctor(Yap_FullLookupAtom("$att_do"),2);
|
||||
#endif
|
||||
|
||||
61
C/iopreds.c
61
C/iopreds.c
@ -2781,21 +2781,29 @@ open_buf_write_stream(char *nbuf, UInt sz)
|
||||
return sno;
|
||||
}
|
||||
|
||||
static int
|
||||
OpenBufWriteStream(void)
|
||||
{
|
||||
char *nbuf;
|
||||
extern int Yap_page_size;
|
||||
|
||||
|
||||
while ((nbuf = (char *)Yap_AllocAtomSpace(Yap_page_size*sizeof(char))) == NULL) {
|
||||
if (!Yap_growheap(FALSE, Yap_page_size*sizeof(char), NULL)) {
|
||||
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
|
||||
return -1;
|
||||
}
|
||||
}
|
||||
return open_buf_write_stream(nbuf, Yap_page_size);
|
||||
}
|
||||
|
||||
static Int
|
||||
p_open_mem_write_stream (void) /* $open_mem_write_stream(-Stream) */
|
||||
{
|
||||
Term t;
|
||||
int sno;
|
||||
char *nbuf;
|
||||
extern int Yap_page_size;
|
||||
|
||||
while ((nbuf = (char *)Yap_AllocAtomSpace(Yap_page_size*sizeof(char))) == NULL) {
|
||||
if (!Yap_growheap(FALSE, Yap_page_size*sizeof(char), NULL)) {
|
||||
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
|
||||
return(FALSE);
|
||||
}
|
||||
}
|
||||
sno = open_buf_write_stream(nbuf, Yap_page_size);
|
||||
sno = OpenBufWriteStream();
|
||||
if (sno == -1)
|
||||
return (PlIOError (SYSTEM_ERROR,TermNil, "new stream not available for open_mem_read_stream/1"));
|
||||
t = MkStream (sno);
|
||||
@ -5337,18 +5345,41 @@ static Int
|
||||
p_format2(void)
|
||||
{ /* 'format'(Stream,Control,Args) */
|
||||
int old_c_stream = Yap_c_output_stream;
|
||||
int mem_stream = FALSE;
|
||||
Int out;
|
||||
Term tin = Deref(ARG1);
|
||||
|
||||
/* needs to change Yap_c_output_stream for write */
|
||||
Yap_c_output_stream = CheckStream (ARG1, Output_Stream_f, "format/3");
|
||||
if (IsVarTerm(tin)) {
|
||||
Yap_Error(INSTANTIATION_ERROR,tin,"format/3");
|
||||
return FALSE;
|
||||
}
|
||||
if (IsApplTerm(tin) && FunctorOfTerm(tin) == FunctorAtom) {
|
||||
Yap_c_output_stream = OpenBufWriteStream();
|
||||
mem_stream = TRUE;
|
||||
} else {
|
||||
/* needs to change Yap_c_output_stream for write */
|
||||
Yap_c_output_stream = CheckStream (ARG1, Output_Stream_f, "format/3");
|
||||
}
|
||||
UNLOCK(Stream[Yap_c_output_stream].streamlock);
|
||||
if (Yap_c_output_stream == -1) {
|
||||
Yap_c_output_stream = old_c_stream;
|
||||
return(FALSE);
|
||||
return FALSE;
|
||||
}
|
||||
out = format(Deref(ARG2),Deref(ARG3),Yap_c_output_stream);
|
||||
Yap_c_output_stream = old_c_stream;
|
||||
return(out);
|
||||
if (mem_stream) {
|
||||
Term tat;
|
||||
int stream = Yap_c_output_stream;
|
||||
Yap_c_output_stream = old_c_stream;
|
||||
if (out) {
|
||||
tat = MkAtomTerm(Yap_LookupAtom(Stream[stream].u.mem_string.buf));
|
||||
CloseStream(stream);
|
||||
if (!Yap_unify(tat,ArgOfTerm(1,ARG1)))
|
||||
return FALSE;
|
||||
}
|
||||
} else {
|
||||
Yap_c_output_stream = old_c_stream;
|
||||
}
|
||||
return out;
|
||||
}
|
||||
|
||||
|
||||
@ -5421,7 +5452,7 @@ p_stream_select(void)
|
||||
|
||||
if (IsVarTerm(t1)) {
|
||||
Yap_Error(INSTANTIATION_ERROR,t1,"stream_select/3");
|
||||
return(FALSE);
|
||||
return FALSE;
|
||||
}
|
||||
if (!IsPairTerm(t1)) {
|
||||
Yap_Error(TYPE_ERROR_LIST,t1,"stream_select/3");
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
/* $Id: aggregate.pl,v 1.3 2008-03-13 14:37:58 vsc Exp $
|
||||
/* $Id: aggregate.pl,v 1.4 2008-07-22 23:34:49 vsc Exp $
|
||||
|
||||
Part of SWI-Prolog
|
||||
|
||||
@ -42,10 +42,6 @@
|
||||
:- use_module(library(error)).
|
||||
:- use_module(library(lists)).
|
||||
|
||||
:- if(current_prolog_flag(dialect, yap)).
|
||||
:- use_module(library(maplist)).
|
||||
:- endif.
|
||||
|
||||
:- module_transparent
|
||||
foreach/2,
|
||||
aggregate/3,
|
||||
|
||||
31
GPL/error.pl
31
GPL/error.pl
@ -1,4 +1,4 @@
|
||||
/* $Id: error.pl,v 1.2 2008-05-15 13:41:45 vsc Exp $
|
||||
/* $Id: error.pl,v 1.3 2008-07-22 23:34:49 vsc Exp $
|
||||
|
||||
Part of SWI-Prolog
|
||||
|
||||
@ -163,20 +163,6 @@ not_a_list(Type, X) :-
|
||||
; type_error(Type, X)
|
||||
).
|
||||
|
||||
:- if(current_prolog_flag(dialect, yap)).
|
||||
|
||||
% vsc: I hope it works like this
|
||||
'$skip_list'(_, Rest, Rest) :- var(Rest), !.
|
||||
'$skip_list'(_, [], _) :- !, fail.
|
||||
'$skip_list'(Anything, [_|More], Rest) :-
|
||||
'$skip_list'(Anything, [_|More], Rest).
|
||||
'$skip_list'(Anything, [_|More], Rest) :-
|
||||
'$skip_list'(Anything, More, Rest).
|
||||
'$skip_list'(_Anything, Rest, Rest).
|
||||
|
||||
:- endif.
|
||||
|
||||
|
||||
not_a_rational(X) :-
|
||||
( var(X)
|
||||
-> instantiation_error(X)
|
||||
@ -259,3 +245,18 @@ element_types([H|T], Type) :-
|
||||
is_list_or_partial_list(L0) :-
|
||||
'$skip_list'(_, L0,L),
|
||||
( var(L) -> true ; L == [] ).
|
||||
|
||||
:- if(current_prolog_flag(dialect, yap)).
|
||||
|
||||
% vsc: I hope it works like this
|
||||
'$skip_list'(_, Rest, Rest) :- var(Rest), !.
|
||||
'$skip_list'(_, [], _) :- !, fail.
|
||||
'$skip_list'(Anything, [_|More], Rest) :-
|
||||
'$skip_list'(Anything, [_|More], Rest).
|
||||
'$skip_list'(Anything, [_|More], Rest) :-
|
||||
'$skip_list'(Anything, More, Rest).
|
||||
'$skip_list'(_Anything, Rest, Rest).
|
||||
|
||||
:- endif.
|
||||
|
||||
|
||||
|
||||
4
H/Heap.h
4
H/Heap.h
@ -10,7 +10,7 @@
|
||||
* File: Heap.h *
|
||||
* mods: *
|
||||
* comments: Heap Init Structure *
|
||||
* version: $Id: Heap.h,v 1.132 2008-05-28 17:18:35 vsc Exp $ *
|
||||
* version: $Id: Heap.h,v 1.133 2008-07-22 23:34:49 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
/* information that can be stored in Code Space */
|
||||
@ -449,6 +449,7 @@ typedef struct various_codes {
|
||||
functor_arrow,
|
||||
functor_assert,
|
||||
functor_at_found_one,
|
||||
functor_atom,
|
||||
#ifdef COROUTINING
|
||||
functor_att_goal, /* goal that activates attributed variables */
|
||||
#endif
|
||||
@ -762,6 +763,7 @@ struct various_codes *Yap_heap_regs;
|
||||
#define FunctorArrow Yap_heap_regs->functor_arrow
|
||||
#define FunctorAssert Yap_heap_regs->functor_assert
|
||||
#define FunctorAtFoundOne Yap_heap_regs->functor_at_found_one
|
||||
#define FunctorAtom Yap_heap_regs->functor_atom
|
||||
#ifdef COROUTINING
|
||||
#define FunctorAttGoal Yap_heap_regs->functor_att_goal
|
||||
#endif
|
||||
|
||||
10
H/amidefs.h
10
H/amidefs.h
@ -11,8 +11,11 @@
|
||||
* File: amidefs.h *
|
||||
* comments: Abstract machine peculiarities *
|
||||
* *
|
||||
* Last rev: $Date: 2007-11-26 23:43:09 $ *
|
||||
* Last rev: $Date: 2008-07-22 23:34:49 $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.33 2007/11/26 23:43:09 vsc
|
||||
* fixes to support threads and assert correctly, even if inefficiently.
|
||||
*
|
||||
* Revision 1.32 2006/10/10 14:08:17 vsc
|
||||
* small fixes on threaded implementation.
|
||||
*
|
||||
@ -226,11 +229,6 @@ typedef struct yami {
|
||||
CELL d[1+SIZEOF_DOUBLE/SIZEOF_INT_P];
|
||||
CELL next;
|
||||
} d;
|
||||
struct {
|
||||
CODEADDR d;
|
||||
struct pred_entry *p;
|
||||
CELL next;
|
||||
} dp;
|
||||
struct {
|
||||
Int ClTrail;
|
||||
Int ClENV;
|
||||
|
||||
@ -11,8 +11,11 @@
|
||||
* File: rheap.h *
|
||||
* comments: walk through heap code *
|
||||
* *
|
||||
* Last rev: $Date: 2008-05-12 22:31:37 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2008-07-22 23:34:49 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.98 2008/05/12 22:31:37 vsc
|
||||
* fix previous fixes
|
||||
*
|
||||
* Revision 1.97 2008/05/12 14:04:23 vsc
|
||||
* updates to restore
|
||||
*
|
||||
@ -771,6 +774,7 @@ restore_codes(void)
|
||||
Yap_heap_regs->functor_arrow = FuncAdjust(Yap_heap_regs->functor_arrow);
|
||||
Yap_heap_regs->functor_assert = FuncAdjust(Yap_heap_regs->functor_assert);
|
||||
Yap_heap_regs->functor_at_found_one = FuncAdjust(Yap_heap_regs->functor_at_found_one);
|
||||
Yap_heap_regs->functor_atom = FuncAdjust(Yap_heap_regs->functor_atom);
|
||||
#ifdef COROUTINING
|
||||
Yap_heap_regs->functor_att_goal = FuncAdjust(Yap_heap_regs->functor_att_goal);
|
||||
#endif
|
||||
|
||||
@ -17,6 +17,11 @@
|
||||
|
||||
<h2>Yap-5.1.4:</h2>
|
||||
<ul>
|
||||
<li> NEW: format over atom/1.</li>
|
||||
<li> FIXED: clean up apply_macros in swi mode.</li>
|
||||
<li> FIXED: clean up meta-expansion.</li>
|
||||
<li> FIXED: do meta-expansion from undefined call.</li>
|
||||
<li> NEW: selectchk/3, nth1/3 and nth1/4.</li>
|
||||
<li> FIXED: YapOpcodes has wrong formats (obs from Bart Demoen).</li>
|
||||
<li> FIXED: improve format message (obs from Bart Demoen).</li>
|
||||
<li> NEW: more versions of maplist (obs from Bart Demoen).</li>
|
||||
|
||||
66
docs/yap.tex
66
docs/yap.tex
@ -6249,7 +6249,7 @@ Grammar related built-in predicates:
|
||||
|
||||
@table @code
|
||||
|
||||
@item expand_term(@var{T},-@var{X})
|
||||
@item user:expand_term(@var{T},-@var{X})
|
||||
@findex expand_term/2
|
||||
@syindex expand_term/2
|
||||
@cyindex expand_term/2
|
||||
@ -6260,7 +6260,7 @@ This predicate is used by YAP for preprocessing each top level
|
||||
term read when consulting a file and before asserting or executing it.
|
||||
It rewrites a term @var{T} to a term @var{X} according to the following
|
||||
rules: first try to use the user defined predicate
|
||||
@code{term_expansion/2}. If this call fails then the translating process
|
||||
@code{user:term_expansion/2}. If this call fails then the translating process
|
||||
for DCG rules is applied, together with the arithmetic optimizer
|
||||
whenever the compilation of arithmetic expressions is in progress.
|
||||
|
||||
@ -8525,22 +8525,28 @@ As @code{member/2}, but may only be used to test whether a known
|
||||
is more efficient when it is applicable.
|
||||
|
||||
@item nth0(?@var{N}, ?@var{List}, ?@var{Elem})
|
||||
@findex nth0/2
|
||||
@syindex nth0/2
|
||||
@cnindex nth0/2
|
||||
@findex nth0/3
|
||||
@syindex nth0/3
|
||||
@cnindex nth0/3
|
||||
True when @var{Elem} is the Nth member of @var{List},
|
||||
counting the first as element 0. (That is, throw away the first
|
||||
N elements and unify @var{Elem} with the next.) It can only be used to
|
||||
select a particular element given the list and index. For that
|
||||
task it is more efficient than @code{member/2}
|
||||
|
||||
@item nth(?@var{N}, ?@var{List}, ?@var{Elem})
|
||||
@findex nth/2
|
||||
@syindex nth/2
|
||||
@cnindex nth/2
|
||||
@item nth1(?@var{N}, ?@var{List}, ?@var{Elem})
|
||||
@findex nth1/3
|
||||
@syindex nth1/3
|
||||
@cnindex nth1/3
|
||||
The same as @code{nth0/3}, except that it counts from
|
||||
1, that is @code{nth(1, [H|_], H)}.
|
||||
|
||||
@item nth(?@var{N}, ?@var{List}, ?@var{Elem})
|
||||
@findex nth/3
|
||||
@syindex nth/3
|
||||
@cnindex nth/3
|
||||
The same as @code{nth1/3}.
|
||||
|
||||
@item nth0(?@var{N}, ?@var{List}, ?@var{Elem}, ?@var{Rest})
|
||||
@findex nth0/4
|
||||
@syindex nth0/4
|
||||
@ -8553,10 +8559,10 @@ it yields @var{List}, e.g. @code{nth0(2, List, c, [a,b,d,e])} unifies List with
|
||||
@code{[a,b,c,d,e]}. @code{nth/4} is the same except that it counts from 1. @code{nth0/4}
|
||||
can be used to insert @var{Elem} after the Nth element of @var{Rest}.
|
||||
|
||||
@item nth(?@var{N}, ?@var{List}, ?@var{Elem}, ?@var{Rest})
|
||||
@findex nth/4
|
||||
@syindex nth/4
|
||||
@cnindex nth/4
|
||||
@item nth1(?@var{N}, ?@var{List}, ?@var{Elem}, ?@var{Rest})
|
||||
@findex nth1/4
|
||||
@syindex nth1/4
|
||||
@cnindex nth1/4
|
||||
Unifies @var{Elem} with the Nth element of @var{List}, counting from 1,
|
||||
and @var{Rest} with the other elements. It can be used to select the
|
||||
Nth element of @var{List} (yielding @var{Elem} and @var{Rest}), or to
|
||||
@ -8565,6 +8571,12 @@ insert @var{Elem} before the Nth (counting from 1) element of
|
||||
[a,b,d,e])} unifies List with @code{[a,b,c,d,e]}. @code{nth/4}
|
||||
can be used to insert @var{Elem} after the Nth element of @var{Rest}.
|
||||
|
||||
@item nth(?@var{N}, ?@var{List}, ?@var{Elem}, ?@var{Rest})
|
||||
@findex nth/4
|
||||
@syindex nth/4
|
||||
@cnindex nth/4
|
||||
Same as @code{nth1/4}.
|
||||
|
||||
@item permutation(+@var{List},?@var{Perm})
|
||||
@findex permutation/2
|
||||
@syindex permutation/2
|
||||
@ -8596,12 +8608,26 @@ Modes @code{same_length(-,+)} and @code{same_length(+,-)} generate either list g
|
||||
the other; mode @code{same_length(-,-)} generates two lists of the same length,
|
||||
in which case the arguments will be bound to lists of length 0, 1, 2, ...
|
||||
|
||||
@item select(?@var{Element}, ?@var{Set}, ?@var{Residue})
|
||||
@item select(?@var{Element}, ?@var{List}, ?@var{Residue})
|
||||
@findex select/3
|
||||
@syindex select/3
|
||||
@cnindex select/3
|
||||
True when @var{Set} is a list, @var{Element} occurs in @var{Set}, and @var{Residue} is
|
||||
everything in @var{Set} except @var{Element} (things stay in the same order).
|
||||
True when @var{Set} is a list, @var{Element} occurs in @var{List}, and
|
||||
@var{Residue} is everything in @var{List} except @var{Element} (things
|
||||
stay in the same order).
|
||||
|
||||
@item selectchk(?@var{Element}, ?@var{List}, ?@var{Residue})
|
||||
@findex selectchk/3
|
||||
@snindex selectchk/3
|
||||
@cnindex selectchk/3
|
||||
Semi-deterministic selection from a list. Steadfast: defines as
|
||||
|
||||
@example
|
||||
selectchk(Elem, List, Residue) :-
|
||||
select(Elem, List, Rest0), !,
|
||||
Rest = Rest0.
|
||||
@end example
|
||||
|
||||
|
||||
@item sublist(?@var{Sublist}, ?@var{List})
|
||||
@findex sublist/2
|
||||
@ -8641,6 +8667,14 @@ True when @var{Numbers} is a list of numbers, and @var{Max} is the maximum.
|
||||
@cnindex min_list/2
|
||||
True when @var{Numbers} is a list of numbers, and @var{Min} is the minimum.
|
||||
|
||||
@item numlist(+@var{Low}, +@var{High}, +@var{List})
|
||||
@findex numlist/3
|
||||
@syindex numlist/3
|
||||
@cnindex numlist/3
|
||||
If @var{Low} and @var{High} are integers with @var{Low} @geq{}
|
||||
@var{High}, unify @var{List} to a list @code{[Low, Low+1, ...High]}. See
|
||||
also @code{between/3}.
|
||||
|
||||
@end table
|
||||
|
||||
@node matrix, MATLAB, Lists, Library
|
||||
|
||||
@ -17,12 +17,15 @@
|
||||
nth/4,
|
||||
nth0/3,
|
||||
nth0/4,
|
||||
nth1/3,
|
||||
nth1/4,
|
||||
permutation/2,
|
||||
prefix/2,
|
||||
remove_duplicates/2,
|
||||
reverse/2,
|
||||
same_length/2,
|
||||
select/3,
|
||||
selectchk/3,
|
||||
sublist/2,
|
||||
substitute/4,
|
||||
sum_list/2,
|
||||
@ -31,9 +34,12 @@
|
||||
list_concat/2,
|
||||
flatten/2,
|
||||
max_list/2,
|
||||
min_list/2
|
||||
min_list/2,
|
||||
numlist/3
|
||||
]).
|
||||
|
||||
:- ensure_loaded(library(error)).
|
||||
|
||||
|
||||
% append(Prefix, Suffix, Combined)
|
||||
% is true when all three arguments are lists, and the members of Combined
|
||||
@ -125,6 +131,14 @@ find_nth0(N, [_|Tail], Elem) :-
|
||||
find_nth0(M, Tail, Elem).
|
||||
|
||||
|
||||
nth1(V, In, Element) :- var(V), !,
|
||||
generate_nth(1, V, In, Element).
|
||||
nth1(1, [Head|_], Head) :- !.
|
||||
nth1(N, [_|Tail], Elem) :-
|
||||
nonvar(N), !,
|
||||
M is N-1, % should be succ(M, N)
|
||||
find_nth(M, Tail, Elem).
|
||||
|
||||
nth(V, In, Element) :- var(V), !,
|
||||
generate_nth(1, V, In, Element).
|
||||
nth(1, [Head|_], Head) :- !.
|
||||
@ -168,6 +182,13 @@ find_nth0(N, [Head|Tail], Elem, [Head|Rest]) :-
|
||||
|
||||
|
||||
|
||||
nth1(V, In, Element, Tail) :- var(V), !,
|
||||
generate_nth(1, V, In, Element, Tail).
|
||||
nth1(1, [Head|Tail], Head, Tail) :- !.
|
||||
nth1(N, [Head|Tail], Elem, [Head|Rest]) :-
|
||||
M is N-1,
|
||||
nth1(M, Tail, Elem, Rest).
|
||||
|
||||
nth(V, In, Element, Tail) :- var(V), !,
|
||||
generate_nth(1, V, In, Element, Tail).
|
||||
nth(1, [Head|Tail], Head, Tail) :- !.
|
||||
@ -243,6 +264,15 @@ same_length([], []).
|
||||
same_length([_|List1], [_|List2]) :-
|
||||
same_length(List1, List2).
|
||||
|
||||
%% selectchk(+Elem, +List, -Rest) is semidet.
|
||||
%
|
||||
% Semi-deterministic removal of first element in List that unifies
|
||||
% Elem.
|
||||
|
||||
selectchk(Elem, List, Rest) :-
|
||||
select(Elem, List, Rest0), !,
|
||||
Rest = Rest0.
|
||||
|
||||
|
||||
% select(?Element, ?Set, ?Residue)
|
||||
% is true when Set is a list, Element occurs in Set, and Residue is
|
||||
@ -315,6 +345,7 @@ list_concat([H|T], [H|Lf], Li) :-
|
||||
%
|
||||
flatten(X,Y) :- flatten_list(X,Y,[]).
|
||||
|
||||
flatten_list(V) --> {var(V)}, !.
|
||||
flatten_list([]) --> !.
|
||||
flatten_list([H|T]) --> !, flatten_list(H),flatten_list(T).
|
||||
flatten_list(H) --> [H].
|
||||
@ -345,3 +376,22 @@ min_list([H|L],Max0,Max) :-
|
||||
min_list(L, Max0, Max)
|
||||
).
|
||||
|
||||
%% numlist(+Low, +High, -List) is semidet.
|
||||
%
|
||||
% List is a list [Low, Low+1, ... High]. Fails if High < Low.%
|
||||
%
|
||||
% @error type_error(integer, Low)
|
||||
% @error type_error(integer, High)
|
||||
|
||||
numlist(L, U, Ns) :-
|
||||
must_be(integer, L),
|
||||
must_be(integer, U),
|
||||
L =< U,
|
||||
numlist_(L, U, Ns).
|
||||
|
||||
numlist_(U, U, [U]) :- !.
|
||||
numlist_(L, U, [L|Ns]) :-
|
||||
succ(L, L2),
|
||||
numlist_(L2, U, Ns).
|
||||
|
||||
|
||||
|
||||
134
library/swi.yap
134
library/swi.yap
@ -19,9 +19,9 @@
|
||||
append/3,
|
||||
delete/3,
|
||||
member/2,
|
||||
memberchk/2,
|
||||
min_list/2,
|
||||
nth/3]).
|
||||
nth1/3,
|
||||
nth0/3]).
|
||||
|
||||
:- use_module(library(system),
|
||||
[datime/1,
|
||||
@ -51,34 +51,40 @@
|
||||
;
|
||||
true.
|
||||
|
||||
:- use_module(library(maplist)).
|
||||
|
||||
:- multifile swi_predicate_table/4.
|
||||
|
||||
swi_predicate_table(_,maplist(X,Y),maplist,maplist(X,Y)).
|
||||
swi_predicate_table(_,maplist(X,Y,Z),maplist,maplist(X,Y,Z)).
|
||||
swi_predicate_table(_,maplist(X,Y,Z,W),maplist,maplist(X,Y,Z,W)).
|
||||
swi_predicate_table(_,append(X,Y),lists,append(X,Y)).
|
||||
swi_predicate_table(_,append(X,Y,Z),lists,append(X,Y,Z)).
|
||||
swi_predicate_table(_,member(X,Y),lists,member(X,Y)).
|
||||
swi_predicate_table(_,nextto(X,Y,Z),lists,nextto(X,Y,Z)).
|
||||
swi_predicate_table(_,is_list(X),lists,is_list(X)).
|
||||
swi_predicate_table(_,min_list(X,Y),lists,min_list(X,Y)).
|
||||
swi_predicate_table(_,nth(X,Y,Z),lists,nth(X,Y,Z)).
|
||||
swi_predicate_table(_,delete(X,Y,Z),lists,delete(X,Y,Z)).
|
||||
swi_predicate_table(_,nth1(X,Y,Z),lists,nth(X,Y,Z)).
|
||||
swi_predicate_table(_,memberchk(X,Y),lists,memberchk(X,Y)).
|
||||
swi_predicate_table(_,flatten(X,Y),lists,flatten(X,Y)).
|
||||
swi_predicate_table(_,select(X,Y,Z),lists,select(X,Y,Z)).
|
||||
swi_predicate_table(_,selectchk(X,Y,Z),lists,selectchk(X,Y,Z)).
|
||||
swi_predicate_table(_,nth0(X,Y,Z),lists,nth0(X,Y,Z)).
|
||||
swi_predicate_table(_,nth1(X,Y,Z),lists,nth1(X,Y,Z)).
|
||||
swi_predicate_table(_,last(X,Y),lists,last(X,Y)).
|
||||
swi_predicate_table(_,reverse(X,Y),lists,reverse(X,Y)).
|
||||
swi_predicate_table(_,permutation(X,Y),lists,permutation(X,Y)).
|
||||
swi_predicate_table(_,flatten(X,Y),lists,flatten(X,Y)).
|
||||
swi_predicate_table(_,sumlist(X,Y),lists,sumlist(X,Y)).
|
||||
swi_predicate_table(_,min_list(X,Y),lists,min_list(X,Y)).
|
||||
swi_predicate_table(_,max_list(X,Y),lists,max_list(X,Y)).
|
||||
swi_predicate_table(_,memberchk(X,Y),lists,memberchk(X,Y)).
|
||||
swi_predicate_table(_,hash_term(X,Y),terms,term_hash(X,Y)).
|
||||
swi_predicate_table(_,term_hash(X,Y),terms,term_hash(X,Y)).
|
||||
swi_predicate_table(_,term_variables(X,Y),terms,term_variables(X,Y)).
|
||||
swi_predicate_table(_,term_variables(X,Y,Z),terms,term_variables(X,Y,Z)).
|
||||
swi_predicate_table(_,subsumes(X,Y),terms,subsumes(X,Y)).
|
||||
swi_predicate_table(_,unifiable(X,Y,Z),terms,unifiable(X,Y,Z)).
|
||||
swi_predicate_table(_,genarg(X,Y,Z),arg,genarg(X,Y,Z)).
|
||||
swi_predicate_table(_,tmp_file(X,Y),system,tmp_file(X,Y)).
|
||||
|
||||
swi_isl(X) :- lists:is_list(X).
|
||||
|
||||
prolog:is_list(X) :- swi_isl(X).
|
||||
|
||||
swi_mchk(X,Y) :- lists:memberchk(X,Y).
|
||||
|
||||
prolog:memberchk(X,Y) :- swi_mchk(X,Y).
|
||||
|
||||
:- dynamic
|
||||
prolog:message/3.
|
||||
|
||||
@ -100,6 +106,15 @@ user:file_search_path(foreign, swi(lib)).
|
||||
|
||||
:- meta_predicate prolog:predsort(:,+,-).
|
||||
|
||||
switv(X,Y) :- term_variables(X, Y).
|
||||
switv(X,Y,Z) :- term_variables(X, Y, Z).
|
||||
|
||||
prolog:term_variables(X, Y) :-
|
||||
switv(X, Y).
|
||||
|
||||
prolog:term_variables(X, Y, Z) :-
|
||||
switv(X, Y, Z).
|
||||
|
||||
prolog:plus(X, Y, Z) :-
|
||||
integer(X),
|
||||
integer(Y), !,
|
||||
@ -318,3 +333,92 @@ prolog:intersection([_|T], L, R) :-
|
||||
prolog:(Term1 =@= Term2) :-
|
||||
variant(Term1, Term2), !.
|
||||
|
||||
% copied from SWI's boot/apply library
|
||||
:- module_transparent
|
||||
prolog:maplist/2,
|
||||
maplist2/2,
|
||||
prolog:maplist/3,
|
||||
maplist2/3,
|
||||
prolog:maplist/4,
|
||||
maplist2/4,
|
||||
prolog:maplist/5,
|
||||
maplist2/5.
|
||||
|
||||
% maplist(:Goal, +List)
|
||||
%
|
||||
% True if Goal can succesfully be applied on all elements of List.
|
||||
% Arguments are reordered to gain performance as well as to make
|
||||
% the predicate deterministic under normal circumstances.
|
||||
|
||||
prolog:maplist(Goal, List) :-
|
||||
maplist2(List, Goal).
|
||||
|
||||
maplist2([], _).
|
||||
maplist2([Elem|Tail], Goal) :-
|
||||
call(Goal, Elem),
|
||||
maplist2(Tail, Goal).
|
||||
|
||||
% maplist(:Goal, ?List1, ?List2)
|
||||
%
|
||||
% True if Goal can succesfully be applied to all succesive pairs
|
||||
% of elements of List1 and List2.
|
||||
|
||||
prolog:maplist(Goal, List1, List2) :-
|
||||
maplist2(List1, List2, Goal).
|
||||
|
||||
maplist2([], [], _).
|
||||
maplist2([Elem1|Tail1], [Elem2|Tail2], Goal) :-
|
||||
call(Goal, Elem1, Elem2),
|
||||
maplist2(Tail1, Tail2, Goal).
|
||||
|
||||
% maplist(:Goal, ?List1, ?List2, ?List3)
|
||||
%
|
||||
% True if Goal can succesfully be applied to all succesive triples
|
||||
% of elements of List1..List3.
|
||||
|
||||
prolog:maplist(Goal, List1, List2, List3) :-
|
||||
maplist2(List1, List2, List3, Goal).
|
||||
|
||||
maplist2([], [], [], _).
|
||||
maplist2([Elem1|Tail1], [Elem2|Tail2], [Elem3|Tail3], Goal) :-
|
||||
call(Goal, Elem1, Elem2, Elem3),
|
||||
maplist2(Tail1, Tail2, Tail3, Goal).
|
||||
|
||||
% maplist(:Goal, ?List1, ?List2, ?List3, List4)
|
||||
%
|
||||
% True if Goal can succesfully be applied to all succesive
|
||||
% quadruples of elements of List1..List4
|
||||
|
||||
prolog:maplist(Goal, List1, List2, List3, List4) :-
|
||||
maplist2(List1, List2, List3, List4, Goal).
|
||||
|
||||
maplist2([], [], [], [], _).
|
||||
maplist2([Elem1|Tail1], [Elem2|Tail2], [Elem3|Tail3], [Elem4|Tail4], Goal) :-
|
||||
call(Goal, Elem1, Elem2, Elem3, Elem4),
|
||||
maplist2(Tail1, Tail2, Tail3, Tail4, Goal).
|
||||
|
||||
prolog:compile_aux_clauses([]).
|
||||
prolog:compile_aux_clauses([(:- G)|Cls]) :-
|
||||
prolog_load_context(module, M),
|
||||
once(M:G),
|
||||
prolog:compile_aux_clauses(Cls).
|
||||
prolog:compile_aux_clauses([Cl|Cls]) :-
|
||||
prolog_load_context(module, M),
|
||||
assert_static(M:Cl),
|
||||
prolog:compile_aux_clauses(Cls).
|
||||
|
||||
%
|
||||
% convert from SWI's goal expansion to YAP/SICStus old style goal
|
||||
% expansion.
|
||||
%
|
||||
user:term_expansion(goal_expansion(A,B),O) :-
|
||||
prolog_load_context(module, user), !,
|
||||
O = goal_expansion(A,user,B).
|
||||
user:term_expansion(user:goal_expansion(A,B),O) :- !,
|
||||
O = user:goal_expansion(A,_,B).
|
||||
user:term_expansion((goal_expansion(A,B) :- G), O) :-
|
||||
prolog_load_context(module, user), !,
|
||||
O = (goal_expansion(A,user,B) :- G).
|
||||
user:term_expansion((user:goal_expansion(A,B) :- G),O) :-
|
||||
O = (user:goal_expansion(A,_,B) :- G).
|
||||
|
||||
|
||||
66
pl/boot.yap
66
pl/boot.yap
@ -386,28 +386,22 @@ true :- true.
|
||||
% not 100% compatible with SICStus Prolog, as SICStus Prolog would put
|
||||
% module prefixes all over the place, although unnecessarily so.
|
||||
%
|
||||
'$go_compile_clause'(Mod:G,V,N,Source) :- !,
|
||||
'$go_compile_clause'(G,V,N,Mod,Source).
|
||||
'$go_compile_clause'((M:G :- B),V,N,Source) :- !,
|
||||
'$current_module'(M1),
|
||||
(M1 = M ->
|
||||
NG = (G :- B)
|
||||
;
|
||||
'$preprocess_clause_before_mod_change'((G:-B),M1,M,NG)
|
||||
),
|
||||
'$go_compile_clause'(NG,V,N,M,Source).
|
||||
'$go_compile_clause'(G,V,N,Source) :-
|
||||
'$current_module'(Mod),
|
||||
'$go_compile_clause'(G,V,N,Mod,Source).
|
||||
'$go_compile_clause'(G,V,N,Mod,Mod,Source).
|
||||
|
||||
'$go_compile_clause'(M:G,V,N,_,_,Source) :- !,
|
||||
'$go_compile_clause'(G,V,N,M,M,Source).
|
||||
'$go_compile_clause'((M:H :- B),V,N,_,BodyMod,Source) :- !,
|
||||
'$go_compile_clause'((H :- B),V,N,M,BodyMod,Source).
|
||||
'$go_compile_clause'(G,V,N,HeadMod,BodyMod,Source) :- !,
|
||||
'$prepare_term'(G, V, G0, G1, BodyMod, HeadMod, Source),
|
||||
'$$compile'(G1, G0, N, HeadMod).
|
||||
|
||||
'$go_compile_clause'(G, V, N, Mod, Source) :-
|
||||
'$prepare_term'(G, V, G0, G1, Mod, Source),
|
||||
'$$compile'(G1, G0, N, Mod).
|
||||
|
||||
'$prepare_term'(G, V, G0, G1, Mod, Source) :-
|
||||
'$prepare_term'(G, V, G0, G1, BodyMod, SourceMod, Source) :-
|
||||
( get_value('$syntaxcheckflag',on) ->
|
||||
'$check_term'(Source, V, Mod) ; true ),
|
||||
'$precompile_term'(G, G0, G1, Mod).
|
||||
'$check_term'(Source, V, BodyMod) ; true ),
|
||||
'$precompile_term'(G, G0, G1, BodyMod, SourceMod).
|
||||
|
||||
% process an input clause
|
||||
'$$compile'(G, G0, L, Mod) :-
|
||||
@ -857,7 +851,7 @@ not(G) :- \+ '$execute'(G).
|
||||
% repeat other code.
|
||||
'$is_metapredicate'(G,CurMod) ->
|
||||
(
|
||||
'$meta_expansion'(CurMod,CurMod,G,NG,[]) ->
|
||||
'$meta_expansion'(G,CurMod,CurMod,CurMod,NG,[]) ->
|
||||
'$execute0'(NG, CurMod)
|
||||
;
|
||||
'$execute0'(G, CurMod)
|
||||
@ -900,7 +894,18 @@ not(G) :- \+ '$execute'(G).
|
||||
)
|
||||
),
|
||||
!,
|
||||
'$execute0'(Goal,NM).
|
||||
Goal \= fail,
|
||||
'$complete_goal'(M, Goal, NM, G).
|
||||
|
||||
'$complete_goal'(M, G, CurMod, G0) :-
|
||||
(
|
||||
'$is_metapredicate'(G,CurMod)
|
||||
->
|
||||
'$meta_expansion'(G, CurMod, M, M, NG,[]) ->
|
||||
'$execute0'(NG, CurMod)
|
||||
;
|
||||
'$execute0'(G, CurMod)
|
||||
).
|
||||
|
||||
'$find_undefp_handler'(G,M,NG,user) :-
|
||||
\+ '$undefined'(unknown_predicate_handler(_,_,_), user),
|
||||
@ -1052,16 +1057,18 @@ access_file(F,Mode) :-
|
||||
% return two arguments: Expanded0 is the term after "USER" expansion.
|
||||
% Expanded is the final expanded term.
|
||||
%
|
||||
'$precompile_term'(Term, Expanded0, Expanded, Mod) :-
|
||||
'$precompile_term'(Term, Expanded0, Expanded, BodyMod, SourceMod) :-
|
||||
'$module_expansion'(Term, Expanded0, ExpandedI, BodyMod, SourceMod), !,
|
||||
(
|
||||
'$access_yap_flags'(9,1) /* strict_iso on */
|
||||
'$access_yap_flags'(9,1) /* strict_iso on */
|
||||
->
|
||||
'$expand_term_modules'(Term, Expanded0, Expanded, Mod),
|
||||
'$check_iso_strict_clause'(Expanded0)
|
||||
Expanded = ExpandedI,
|
||||
'$check_iso_strict_clause'(Expanded0)
|
||||
;
|
||||
'$expand_term_modules'(Term, Expanded0, ExpandedI, Mod),
|
||||
'$expand_array_accesses_in_term'(ExpandedI,Expanded)
|
||||
'$expand_array_accesses_in_term'(ExpandedI,Expanded)
|
||||
).
|
||||
'$precompile_term'(Term, Term, Term, _, _).
|
||||
|
||||
|
||||
expand_term(Term,Expanded) :-
|
||||
( \+ '$undefined'(term_expansion(_,_), user),
|
||||
@ -1096,13 +1103,6 @@ expand_term(Term,Expanded) :-
|
||||
'$c_arrays'(Expanded0,ExpandedF), !.
|
||||
'$expand_array_accesses_in_term'(Expanded,Expanded).
|
||||
|
||||
%
|
||||
% Module system expansion
|
||||
%
|
||||
'$expand_term_modules'(A,B,C,M) :- '$module_expansion'(A,B,C,M), !.
|
||||
'$expand_term_modules'(A,A,A,_).
|
||||
|
||||
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
% catch/throw implementation
|
||||
|
||||
@ -11,8 +11,11 @@
|
||||
* File: errors.yap *
|
||||
* comments: error messages for YAP *
|
||||
* *
|
||||
* Last rev: $Date: 2008-06-12 10:55:52 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2008-07-22 23:34:50 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.89 2008/06/12 10:55:52 vsc
|
||||
* fix syntax error messages
|
||||
*
|
||||
* Revision 1.88 2008/04/04 10:02:44 vsc
|
||||
* implement thread_cancel using signals
|
||||
* use duplicate_term instead of copy_term in throw: throw may lose
|
||||
@ -224,6 +227,8 @@
|
||||
|
||||
print_message(force(_Severity), Msg) :- !,
|
||||
print(user_error,Msg).
|
||||
print_message(error, error(Msg,Info)) :- var(Info), !,
|
||||
print_message(error, error(Msg, '')).
|
||||
print_message(error, error(Msg,[Info|local_sp(P,CP,Envs,CPs)])) :- !,
|
||||
nb_setval(sp_info,local_sp(P,CP,Envs,CPs)),
|
||||
print_message(error, error(Msg, Info)),
|
||||
|
||||
297
pl/modules.yap
297
pl/modules.yap
@ -181,37 +181,22 @@ module(N) :-
|
||||
|
||||
|
||||
% expand module names in a clause
|
||||
'$module_expansion'(((Mod:H) :- B ),((Mod:H) :- B1),((Mod:H) :- BO),M) :- !,
|
||||
'$is_mt'(Mod,H,B,IB,MM),
|
||||
'$prepare_body_with_correct_modules'(IB, M, B0),
|
||||
% A1: Input Clause
|
||||
% A2: Output Class to Compiler (lives in module HM)
|
||||
% A3: Output Class to clause/2 and listing (lives in module HM)
|
||||
%
|
||||
% modules:
|
||||
% A4: module for body of clause (this is the one used in looking up predicates)
|
||||
% A5: context module (this is the current context
|
||||
% A6: head module (this is the one used in compiling and accessing).
|
||||
%
|
||||
'$module_expansion'((H:-B),(H:-B1),(H:-BO),M,HM) :- !,
|
||||
'$is_mt'(M, H, B, IB, MM),
|
||||
'$module_u_vars'(H,UVars,M), % collect head variables in
|
||||
% expanded positions
|
||||
'$module_expansion'(B0,B1,BO,M,MM,M,UVars). % expand body
|
||||
'$module_expansion'((H:-B),(H:-B1),(H:-BO),M) :-
|
||||
'$is_mt'(M,H,B,IB,MM),
|
||||
'$module_u_vars'(H,UVars,M), % collect head variables in
|
||||
% expanded positions
|
||||
'$module_expansion'(IB,B1,BO,M,MM,M,UVars).
|
||||
% $trace_module((H:-B),(H:-B1)).
|
||||
|
||||
% expand module names in a body
|
||||
'$prepare_body_with_correct_modules'(V,M,M:call(V)) :- var(V), !.
|
||||
'$prepare_body_with_correct_modules'((A,B),M,(A1,B1)) :- !,
|
||||
'$prepare_body_with_correct_modules'(A,M,A1),
|
||||
'$prepare_body_with_correct_modules'(B,M,B1).
|
||||
'$prepare_body_with_correct_modules'((A;B),M,(A1;B1)) :- !,
|
||||
'$prepare_body_with_correct_modules'(A,M,A1),
|
||||
'$prepare_body_with_correct_modules'(B,M,B1).
|
||||
'$prepare_body_with_correct_modules'((A->B),M,(A1->B1)) :- !,
|
||||
'$prepare_body_with_correct_modules'(A,M,A1),
|
||||
'$prepare_body_with_correct_modules'(B,M,B1).
|
||||
'$prepare_body_with_correct_modules'(true,_,true) :- !.
|
||||
'$prepare_body_with_correct_modules'(fail,_,fail) :- !.
|
||||
'$prepare_body_with_correct_modules'(false,_,false) :- !.
|
||||
'$prepare_body_with_correct_modules'(M:G,M:G) :- !.
|
||||
'$prepare_body_with_correct_modules'(G,M,G) :-
|
||||
'$system_predicate'(G,M), !.
|
||||
'$prepare_body_with_correct_modules'(G,M,M:G).
|
||||
'$module_expansion'(IB,B1,BO,M,MM,HM,UVars).
|
||||
% do not expand bodyless clauses.
|
||||
'$module_expansion'(H,H,H,_,_).
|
||||
|
||||
|
||||
'$trace_module'(X) :-
|
||||
@ -235,79 +220,113 @@ module(N) :-
|
||||
% expand module names in a body
|
||||
% args are:
|
||||
% goals to expand
|
||||
% code to pass to compiler
|
||||
% code to pass to listing
|
||||
% current module for looking up preds
|
||||
% current module for fixing up meta-call arguments
|
||||
% current module for predicate
|
||||
% code to pass to compiler
|
||||
% current module for looking up preds M
|
||||
% default module DM
|
||||
% head module HM
|
||||
%
|
||||
% to understand the differences, you can consider:
|
||||
%
|
||||
% a:(d:b(X) :- g:c(X), d(X), user:hello(X)).
|
||||
%
|
||||
% when we process meta-predicate c, HM=d, DM=a, BM=a, M=g and we should get:
|
||||
%
|
||||
% d:b(X) :- g:c(g:X), a:d(X), user:hello(X).
|
||||
%
|
||||
% on the other hand,
|
||||
%
|
||||
% a:(d:b(X) :- c(X), d(X), d:e(X)).
|
||||
%
|
||||
% will give
|
||||
%
|
||||
% d:b(X) :- a:c(a:X), a:d(X), e(X).
|
||||
%
|
||||
%
|
||||
% head variables.
|
||||
'$module_expansion'(V,call(MM:V),call(MM:V),_M,MM,_TM,_) :- var(V), !.
|
||||
'$module_expansion'((A,B),(A1,B1),(AO,BO),M,MM,TM,HVars) :- !,
|
||||
'$module_expansion'(A,A1,AO,M,MM,TM,HVars),
|
||||
'$module_expansion'(B,B1,BO,M,MM,TM,HVars).
|
||||
'$module_expansion'((A*->B;C),(A1*->B1;C1),(yap_hacks:current_choicepoint(DCP),AO,yap_hacks:cut_at(DCP),BO; CO),M,MM,TM,HVars) :- !,
|
||||
'$module_expansion'(A,A1,AOO,M,MM,TM,HVars),
|
||||
% goals or arguments/sub-arguments?
|
||||
% I cannot use call here because of format/3
|
||||
'$module_expansion'(V,NG,NG,_,MM,_,HVars) :-
|
||||
var(V), !,
|
||||
( '$not_in_vars'(V,HVars)
|
||||
->
|
||||
NG = call(MM:V)
|
||||
;
|
||||
NG = call(V)
|
||||
).
|
||||
'$module_expansion'((A,B),(A1,B1),(AO,BO),M,MM,HM,HVars) :- !,
|
||||
'$module_expansion'(A,A1,AO,M,MM,HM,HVars),
|
||||
'$module_expansion'(B,B1,BO,M,MM,HM,HVars).
|
||||
'$module_expansion'((A*->B;C),(A1*->B1;C1),(yap_hacks:current_choicepoint(DCP),AO,yap_hacks:cut_at(DCP),BO; CO),M,MM,HM,HVars) :- !,
|
||||
'$module_expansion'(A,A1,AOO,M,MM,HM,HVars),
|
||||
'$clean_cuts'(AOO, AO),
|
||||
'$module_expansion'(B,B1,BO,M,MM,TM,HVars),
|
||||
'$module_expansion'(C,C1,CO,M,MM,TM,HVars).
|
||||
'$module_expansion'((A;B),(A1;B1),(AO;BO),M,MM,TM,HVars) :- !,
|
||||
'$module_expansion'(A,A1,AO,M,MM,TM,HVars),
|
||||
'$module_expansion'(B,B1,BO,M,MM,TM,HVars).
|
||||
'$module_expansion'((A|B),(A1|B1),(AO|BO),M,MM,TM,HVars) :- !,
|
||||
'$module_expansion'(A,A1,AO,M,MM,TM,HVars),
|
||||
'$module_expansion'(B,B1,BO,M,MM,TM,HVars).
|
||||
'$module_expansion'((A->B),(A1->B1),(AO->BO),M,MM,TM,HVars) :- !,
|
||||
'$module_expansion'(A,A1,AOO,M,MM,TM,HVars),
|
||||
'$module_expansion'(B,B1,BO,M,MM,HM,HVars),
|
||||
'$module_expansion'(C,C1,CO,M,MM,HM,HVars).
|
||||
'$module_expansion'((A;B),(A1;B1),(AO;BO),M,MM,HM,HVars) :- !,
|
||||
'$module_expansion'(A,A1,AO,M,MM,HM,HVars),
|
||||
'$module_expansion'(B,B1,BO,M,MM,HM,HVars).
|
||||
'$module_expansion'((A|B),(A1|B1),(AO|BO),M,MM,HM,HVars) :- !,
|
||||
'$module_expansion'(A,A1,AO,M,MM,HM,HVars),
|
||||
'$module_expansion'(B,B1,BO,M,MM,HM,HVars).
|
||||
'$module_expansion'((A->B),(A1->B1),(AO->BO),M,MM,HM,HVars) :- !,
|
||||
'$module_expansion'(A,A1,AOO,M,MM,HM,HVars),
|
||||
'$clean_cuts'(AOO, AO),
|
||||
'$module_expansion'(B,B1,BO,M,MM,TM,HVars).
|
||||
'$module_expansion'(\+A,\+A1,\+AO,M,MM,TM,HVars) :- !,
|
||||
'$module_expansion'(A,A1,AO,M,MM,TM,HVars).
|
||||
'$module_expansion'(not(A),not(A1),not(AO),M,MM,TM,HVars) :- !,
|
||||
'$module_expansion'(A,A1,AO,M,MM,TM,HVars).
|
||||
'$module_expansion'(B,B1,BO,M,MM,HM,HVars).
|
||||
'$module_expansion'(\+A,\+A1,\+AO,M,MM,HM,HVars) :- !,
|
||||
'$module_expansion'(A,A1,AO,M,MM,HM,HVars).
|
||||
'$module_expansion'(not(A),not(A1),not(AO),M,MM,HM,HVars) :- !,
|
||||
'$module_expansion'(A,A1,AO,M,MM,HM,HVars).
|
||||
'$module_expansion'(true,true,true,_,_,_,_) :- !.
|
||||
'$module_expansion'(fail,fail,fail,_,_,_,_) :- !.
|
||||
'$module_expansion'(false,false,false,_,_,_,_) :- !.
|
||||
% if I don't know what the module is, I cannot do anything to the goal,
|
||||
% so I just put a call for later on.
|
||||
'$module_expansion'(M:G,call(M:G),'$execute_wo_mod'(G,M),_,_,_,_) :- var(M), !.
|
||||
'$module_expansion'(M:G,G1,GO,_,_,TM,HVars) :-
|
||||
'$module_expansion'(G,G1,GO,M,M,TM,HVars).
|
||||
% if M1 is given explicitly process G within M1's context.
|
||||
% '$module_expansion'(M:G,G1,GO,_Mod,_MM,TM,HVars) :- !,
|
||||
% % is this imported from some other module M1?
|
||||
% ( '$imported_pred'(G, M, M1) ->
|
||||
% % continue recursively...
|
||||
% '$module_expansion'(G,G1,GO,M1,M,TM,HVars)
|
||||
% ;
|
||||
% (
|
||||
% '$meta_expansion'(M, M, G, NG, HVars)
|
||||
% ;
|
||||
% G = NG
|
||||
% ),
|
||||
% '$complete_goal_expansion'(NG, M, M, TM, G1, GO, HVars)
|
||||
% ).
|
||||
%
|
||||
% next, check if this is something imported.
|
||||
%
|
||||
% first, try doing goal_expansion
|
||||
'$module_expansion'(G, G1, G0, CurMod, MM, TM, HVars) :-
|
||||
'$module_expansion'(M:G,G1,GO,_,_,HM,HVars) :- !,
|
||||
'$module_expansion'(G,G1,GO,M,M,HM,HVars).
|
||||
'$module_expansion'(G, G1, GO, CurMod, MM, HM, HVars) :-
|
||||
'$pred_goal_expansion_on',
|
||||
user:goal_expansion(G, CurMod, GI), !,
|
||||
'$module_expansion'(GI, G1, G0, CurMod, MM, TM, HVars).
|
||||
'$module_expansion'(G, G1, GO, CurMod, MM, TM, HVars) :-
|
||||
'$module_expansion'(GI, G1, GO, CurMod, MM, HM, HVars).
|
||||
'$module_expansion'(G, G1, GO, CurMod, MM, HM,HVars) :-
|
||||
% is this imported from some other module M1?
|
||||
( '$imported_pred'(G, CurMod, GG, M1) ->
|
||||
'$module_expansion'(GG, G1, GO, M1, MM, TM, HVars)
|
||||
'$imported_pred'(G, CurMod, GG, M1),
|
||||
!,
|
||||
'$module_expansion'(GG, G1, GO, M1, MM, HM,HVars).
|
||||
'$module_expansion'(G, G1, GO, CurMod, MM, HM,HVars) :-
|
||||
'$meta_expansion'(G, CurMod, MM, HM, GI, HVars), !,
|
||||
'$complete_goal_expansion'(GI, CurMod, MM, HM, G1, GO, HVars).
|
||||
'$module_expansion'(G, G1, GO, CurMod, MM, HM, HVars) :-
|
||||
'$complete_goal_expansion'(G, CurMod, MM, HM, G1, GO, HVars).
|
||||
|
||||
% args are:
|
||||
% goal to expand
|
||||
% current module for looking up pred
|
||||
% current module for looking up pred
|
||||
% current module from top-level clause
|
||||
% goal to pass to listing
|
||||
% goal to pass to compiler
|
||||
% head variables.
|
||||
'$complete_goal_expansion'(G, M, CM, HM, G1, G2, HVars) :-
|
||||
'$all_system_predicate'(G,M,ORIG), !,
|
||||
% make built-in processing transparent.
|
||||
'$match_mod'(G, M, ORIG, HM, G1),
|
||||
'$c_built_in'(G1, M, Gi),
|
||||
(Gi \== G1 ->
|
||||
'$module_expansion'(Gi, G2, _, M, CM, HM, HVars)
|
||||
;
|
||||
(
|
||||
'$meta_expansion'(CurMod, MM, G, GI, HVars)
|
||||
->
|
||||
true
|
||||
;
|
||||
GI = G
|
||||
),
|
||||
'$complete_goal_expansion'(GI, CurMod, MM, TM, G1, GO, HVars)
|
||||
G2 = G1
|
||||
).
|
||||
'$complete_goal_expansion'(G, GMod, _, HM, NG, NG, _) :-
|
||||
'$match_mod'(G, GMod, GMod, HM, NG).
|
||||
|
||||
%'$match_mod'(G, GMod, GMod, NG) :- !,
|
||||
% NG = G.
|
||||
'$match_mod'(G, _, SM, _, G) :- SM == prolog, !. % prolog: needs no module info.
|
||||
% same module as head, and body goal (I cannot get rid of qualifier before
|
||||
% meta-call.
|
||||
'$match_mod'(G, HMod, _, HM, G) :- HMod == HM, !.
|
||||
'$match_mod'(G, GMod, _, _, GMod:G).
|
||||
|
||||
|
||||
% be careful here not to generate an undefined exception.
|
||||
@ -326,29 +345,6 @@ module(N) :-
|
||||
'$exit_undefp',
|
||||
fail.
|
||||
|
||||
% args are:
|
||||
% goal to expand
|
||||
% current module for looking up pred
|
||||
% current module from top-level clause
|
||||
% goal to pass to compiler
|
||||
% goal to pass to listing
|
||||
% head variables.
|
||||
'$complete_goal_expansion'(G, M, CM, TM, G1, G2, HVars) :-
|
||||
'$all_system_predicate'(G,M), !,
|
||||
'$c_built_in'(G, M, Gi),
|
||||
(Gi \== G ->
|
||||
'$module_expansion'(Gi, _, G2, M, CM, TM, HVars),
|
||||
% make built-in processing transparent.
|
||||
(TM = M -> G1 = G ; G1 = M:G)
|
||||
; TM = M ->
|
||||
G2 = G, G1 = G
|
||||
;
|
||||
G2 = M:G, G1 = M:G % atts:
|
||||
).
|
||||
'$complete_goal_expansion'(G, Mod, _, Mod, G, G, _) :- !.
|
||||
'$complete_goal_expansion'(G, GMod, _, _, GMod:G, GMod:G, _).
|
||||
|
||||
|
||||
% module_transparent declaration
|
||||
%
|
||||
|
||||
@ -422,53 +418,34 @@ module(N) :-
|
||||
% expand arguments of a meta-predicate
|
||||
% $meta_expansion(ModuleWhereDefined,CurrentModule,Goal,ExpandedGoal,MetaVariables)
|
||||
|
||||
'$meta_expansion'(Mod,MP,G,G1,HVars) :-
|
||||
'$meta_expansion'(G,Mod,MP,HM,G1,HVars) :-
|
||||
functor(G,F,N),
|
||||
'$meta_predicate'(F,Mod,N,D), !,
|
||||
% format(user_error,'[ ~w ',[G]),
|
||||
functor(G1,F,N),
|
||||
'$meta_expansion_loop'(N,D,G,G1,HVars,MP).
|
||||
% format(user_error," gives ~w~n]",[G1]).
|
||||
'$meta_expansion_loop'(N, D, G, G1, HVars, Mod, MP, HM).
|
||||
% format(user_error,' gives ~w]`n',[G1]).
|
||||
|
||||
% expand argument
|
||||
'$meta_expansion_loop'(0,_,_,_,_,_) :- !.
|
||||
'$meta_expansion_loop'(I,D,G,G1,HVars,M) :-
|
||||
'$meta_expansion_loop'(0,_,_,_,_,_,_,_) :- !.
|
||||
'$meta_expansion_loop'(I,D,G,NG,HVars,CurMod,M,HM) :-
|
||||
arg(I,D,X), (X==':' ; integer(X)),
|
||||
arg(I,G,A), '$do_expand'(A,HVars), !,
|
||||
'$process_expanded_arg'(A, M, NA),
|
||||
arg(I,G1,NA),
|
||||
arg(I,G,A), '$do_expand'(A,HVars),
|
||||
!,
|
||||
arg(I,NG,M:A),
|
||||
I1 is I-1,
|
||||
'$meta_expansion_loop'(I1,D,G,G1,HVars,M).
|
||||
'$meta_expansion_loop'(I,D,G,G1,HVars,M) :-
|
||||
'$meta_expansion_loop'(I1, D, G, NG, HVars, CurMod, M, HM).
|
||||
'$meta_expansion_loop'(I, D, G, NG, HVars, CurMod, M, HM) :-
|
||||
arg(I,G,A),
|
||||
arg(I,G1,A),
|
||||
arg(I,NG,A),
|
||||
I1 is I-1,
|
||||
'$meta_expansion_loop'(I1,D,G,G1,HVars,M).
|
||||
'$meta_expansion_loop'(I1, D, G, NG, HVars, CurMod, M, HM).
|
||||
|
||||
% check if an argument should be expanded
|
||||
'$do_expand'(V,HVars) :- var(V), !, '$not_in_vars'(V,HVars).
|
||||
'$do_expand'(_:_,_) :- !, fail.
|
||||
'$do_expand'(_,_).
|
||||
|
||||
'$process_expanded_arg'(V, M, M:V) :- var(V), !.
|
||||
'$process_expanded_arg'((V1,V2), M, (NV1,NV2)) :- !,
|
||||
'$process_expanded_arg'(V1, M, NV1),
|
||||
'$process_expanded_arg'(V2, M, NV2).
|
||||
'$process_expanded_arg'((V1;V2), M, (NV1;NV2)) :- !,
|
||||
'$process_expanded_arg'(V1, M, NV1),
|
||||
'$process_expanded_arg'(V2, M, NV2).
|
||||
'$process_expanded_arg'((V1|V2), M, (NV1|NV2)) :- !,
|
||||
'$process_expanded_arg'(V1, M, NV1),
|
||||
'$process_expanded_arg'(V2, M, NV2).
|
||||
'$process_expanded_arg'((V1->V2), M, (NV1->NV2)) :- !,
|
||||
'$process_expanded_arg'(V1, M, NV1),
|
||||
'$process_expanded_arg'(V2, M, NV2).
|
||||
'$process_expanded_arg'(\+V, M, \+NV) :- !,
|
||||
'$process_expanded_arg'(V, M, NV).
|
||||
'$process_expanded_arg'(M:A, _, M:A) :- !.
|
||||
%'$process_expanded_arg'(G, M, G) :-
|
||||
% '$system_predicate'(G,M), !.
|
||||
'$process_expanded_arg'(A, M, M:A).
|
||||
|
||||
'$not_in_vars'(_,[]).
|
||||
'$not_in_vars'(V,[X|L]) :- X\==V, '$not_in_vars'(V,L).
|
||||
|
||||
@ -565,42 +542,12 @@ source_module(Mod) :-
|
||||
use_module(?,:,?),
|
||||
when(?,:),
|
||||
with_mutex(+,:),
|
||||
(: -> :),
|
||||
(: *-> :),
|
||||
(: ; :),
|
||||
^(+,:),
|
||||
\+ : .
|
||||
|
||||
%
|
||||
% if we are asserting something in somewhere else's module,
|
||||
% we need this little bird.
|
||||
%
|
||||
% assert((a:g :- b)) then SICStus compiles this into the original module.
|
||||
% YAP is not 100% compatible, as it will transform this into:
|
||||
% a:assert(g :- user:b))
|
||||
%
|
||||
'$preprocess_clause_before_mod_change'((H:-B),M,M1,(H:-B1)) :-
|
||||
'$module_u_vars'(H,UVars,M1),
|
||||
'$preprocess_body_before_mod_change'(B,M,UVars,B1).
|
||||
|
||||
'$preprocess_body_before_mod_change'(V,M,_,call(M:V)) :- var(V), !.
|
||||
'$preprocess_body_before_mod_change'((G1,G2),M,UVars,(NG1,NG2)) :- !,
|
||||
'$preprocess_body_before_mod_change'(G1,M,UVars,NG1),
|
||||
'$preprocess_body_before_mod_change'(G2,M,UVars,NG2).
|
||||
'$preprocess_body_before_mod_change'((G1;G2),M,UVars,(NG1;NG2)) :- !,
|
||||
'$preprocess_body_before_mod_change'(G1,M,UVars,NG1),
|
||||
'$preprocess_body_before_mod_change'(G2,M,UVars,NG2).
|
||||
'$preprocess_body_before_mod_change'((G1->G2),M,UVars,(NG1->NG2)) :- !,
|
||||
'$preprocess_body_before_mod_change'(G1,M,UVars,NG1),
|
||||
'$preprocess_body_before_mod_change'(G2,M,UVars,NG2).
|
||||
'$preprocess_body_before_mod_change'(M:G,_,_,M:G) :- !.
|
||||
'$preprocess_body_before_mod_change'(true,_,_,true) :- !.
|
||||
'$preprocess_body_before_mod_change'(fail,_,_,fail) :- !.
|
||||
'$preprocess_body_before_mod_change'(false,_,_,false) :- !.
|
||||
'$preprocess_body_before_mod_change'(G,M,UVars,M:NG) :-
|
||||
'$meta_expansion'(M, M, G, NG, UVars), !.
|
||||
'$preprocess_body_before_mod_change'(G,M,_,G) :-
|
||||
'$system_predicate'(G,M), !.
|
||||
'$preprocess_body_before_mod_change'(G,M,_,M:G).
|
||||
|
||||
|
||||
%
|
||||
% get rid of a module and of all predicates included in the module.
|
||||
%
|
||||
|
||||
26
pl/preds.yap
26
pl/preds.yap
@ -51,10 +51,6 @@ assert(C) :-
|
||||
var(H), !, '$do_error'(instantiation_error,P).
|
||||
'$assert_clause'(M1:C, G, M1, Where, R, P) :- !,
|
||||
'$assert_clause2'(C, G, M1, Where, R, P).
|
||||
'$assert_clause'(M:C, G, M1, Where, R, P) :- !,
|
||||
'$preprocess_clause_before_mod_change'((C:-G),M1,M,C1),
|
||||
C1 = (NH :- NG),
|
||||
'$assert_clause2'(NH, NG, M, Where, R, P).
|
||||
'$assert_clause'(H, G, M1, Where, R, P) :- !,
|
||||
'$assert_clause2'(H, G, M1, Where, R, P).
|
||||
|
||||
@ -108,13 +104,7 @@ assert(C) :-
|
||||
'$assert_dynamic'(M:C,_,Where,R,P) :- !,
|
||||
'$assert_dynamic'(C,M,Where,R,P).
|
||||
'$assert_dynamic'((H:-G),M1,Where,R,P) :-
|
||||
(var(H) -> '$do_error'(instantiation_error,P) ; H=M:C), !,
|
||||
( M1 = M ->
|
||||
'$assert_dynamic'((C:-G),M1,Where,R,P)
|
||||
;
|
||||
'$preprocess_clause_before_mod_change'((C:-G),M1,M,C1),
|
||||
'$assert_dynamic'(C1,M,Where,R,P)
|
||||
).
|
||||
var(H), !, '$do_error'(instantiation_error,P).
|
||||
'$assert_dynamic'(CI,Mod,Where,R,P) :-
|
||||
'$expand_clause'(CI,C0,C,Mod),
|
||||
'$assert_dynamic2'(C0,C,Mod,Where,R,P).
|
||||
@ -159,13 +149,7 @@ assertz_static(C) :-
|
||||
'$assert_static'(M:C,_,Where,R,P) :- !,
|
||||
'$assert_static'(C,M,Where,R,P).
|
||||
'$assert_static'((H:-G),M1,Where,R,P) :-
|
||||
(var(H) -> '$do_error'(instantiation_error,P) ; H=M:C), !,
|
||||
( M1 = M ->
|
||||
'$assert_static'((C:-G),M1,Where,R,P)
|
||||
;
|
||||
'$preprocess_clause_before_mod_change'((C:-G),M1,M,C1),
|
||||
'$assert_static'(C1,M,Where,R,P)
|
||||
).
|
||||
var(H), !, '$do_error'(instantiation_error,P).
|
||||
'$assert_static'(CI,Mod,Where,R,P) :-
|
||||
'$expand_clause'(CI,C0,C,Mod),
|
||||
'$check_head_and_body'(C,H,B,P),
|
||||
@ -753,7 +737,7 @@ dynamic_predicate(P,Sem) :-
|
||||
|
||||
|
||||
'$expand_clause'(C0,C1,C2,Mod) :-
|
||||
'$expand_term_modules'(C0, C1, C2, Mod),
|
||||
'$module_expansion'(C0, C1, C2, Mod, Mod),
|
||||
( get_value('$strict_iso',on) ->
|
||||
'$check_iso_strict_clause'(C1)
|
||||
;
|
||||
@ -845,9 +829,9 @@ predicate_property(Pred,Prop) :-
|
||||
'$predicate_property'(P,M,_,static) :-
|
||||
\+ '$is_dynamic'(P,M),
|
||||
\+ '$undefined'(P,M).
|
||||
'$predicate_property'(P,M,_,meta_predicate(P)) :-
|
||||
'$predicate_property'(P,M,_,meta_predicate(Q)) :-
|
||||
functor(P,Na,Ar),
|
||||
'$meta_predicate'(M,Na,Ar,P).
|
||||
'$meta_predicate'(Na,M,Ar,Q).
|
||||
'$predicate_property'(P,M,_,multifile) :-
|
||||
'$is_multifile'(P,M).
|
||||
'$predicate_property'(P,M,_,public) :-
|
||||
|
||||
@ -37,42 +37,42 @@ statistics :-
|
||||
|
||||
'$statistics'(Runtime,CPUtime,Walltime,HpSpa,HpInUse,HpMax,TrlSpa, TrlInUse,_TrlMax,StkSpa, GlobInU, LocInU,GlobMax,LocMax,NOfHO,TotHOTime,NOfSO,TotSOTime,NOfTO,TotTOTime,NOfGC,TotGCTime,TotGCSize,NOfAGC,TotAGCTime,TotAGCSize) :-
|
||||
TotalMemory is HpSpa+StkSpa+TrlSpa,
|
||||
format(user_error,"memory (total)~t~d bytes~35+~n", [TotalMemory]),
|
||||
format(user_error," program space~t~d bytes~35+", [HpSpa]),
|
||||
format(user_error,":~t ~d in use~19+", [HpInUse]),
|
||||
format(user_error,'memory (total)~t~d bytes~35+~n', [TotalMemory]),
|
||||
format(user_error,' program space~t~d bytes~35+', [HpSpa]),
|
||||
format(user_error,':~t ~d in use~19+', [HpInUse]),
|
||||
HpFree is HpSpa-HpInUse,
|
||||
format(user_error,",~t ~d free~19+~n", [HpFree]),
|
||||
format(user_error,"~t ~d max~73+~n", [HpMax]),
|
||||
format(user_error," stack space~t~d bytes~35+", [StkSpa]),
|
||||
format(user_error,',~t ~d free~19+~n', [HpFree]),
|
||||
format(user_error,'~t ~d max~73+~n', [HpMax]),
|
||||
format(user_error,' stack space~t~d bytes~35+', [StkSpa]),
|
||||
StackInUse is GlobInU+LocInU,
|
||||
format(user_error,":~t ~d in use~19+", [StackInUse]),
|
||||
format(user_error,':~t ~d in use~19+', [StackInUse]),
|
||||
StackFree is StkSpa-StackInUse,
|
||||
format(user_error,",~t ~d free~19+~n", [StackFree]),
|
||||
format(user_error," global stack:~t~35+", []),
|
||||
format(user_error," ~t ~d in use~19+", [GlobInU]),
|
||||
format(user_error,",~t ~d max~19+~n", [GlobMax]),
|
||||
format(user_error," local stack:~t~35+", []),
|
||||
format(user_error," ~t ~d in use~19+", [LocInU]),
|
||||
format(user_error,",~t ~d max~19+~n", [LocMax]),
|
||||
format(user_error," trail stack~t~d bytes~35+", [TrlSpa]),
|
||||
format(user_error,":~t ~d in use~19+", [TrlInUse]),
|
||||
format(user_error,',~t ~d free~19+~n', [StackFree]),
|
||||
format(user_error,' global stack:~t~35+', []),
|
||||
format(user_error,' ~t ~d in use~19+', [GlobInU]),
|
||||
format(user_error,',~t ~d max~19+~n', [GlobMax]),
|
||||
format(user_error,' local stack:~t~35+', []),
|
||||
format(user_error,' ~t ~d in use~19+', [LocInU]),
|
||||
format(user_error,',~t ~d max~19+~n', [LocMax]),
|
||||
format(user_error,' trail stack~t~d bytes~35+', [TrlSpa]),
|
||||
format(user_error,':~t ~d in use~19+', [TrlInUse]),
|
||||
TrlFree is TrlSpa-TrlInUse,
|
||||
format(user_error,",~t ~d free~19+~n", [TrlFree]),
|
||||
format(user_error,',~t ~d free~19+~n', [TrlFree]),
|
||||
OvfTime is (TotHOTime+TotSOTime+TotTOTime)/1000,
|
||||
format(user_error,"~n~t~3f~12+ sec. for ~w code, ~w stack, and ~w trail space overflows~n",
|
||||
format(user_error,'~n~t~3f~12+ sec. for ~w code, ~w stack, and ~w trail space overflows~n',
|
||||
[OvfTime,NOfHO,NOfSO,NOfTO]),
|
||||
TotGCTimeF is float(TotGCTime)/1000,
|
||||
format(user_error,"~t~3f~12+ sec. for ~w garbage collections which collected ~d bytes~n",
|
||||
format(user_error,'~t~3f~12+ sec. for ~w garbage collections which collected ~d bytes~n',
|
||||
[TotGCTimeF,NOfGC,TotGCSize]),
|
||||
TotAGCTimeF is float(TotAGCTime)/1000,
|
||||
format(user_error,"~t~3f~12+ sec. for ~w atom garbage collections which collected ~d bytes~n",
|
||||
format(user_error,'~t~3f~12+ sec. for ~w atom garbage collections which collected ~d bytes~n',
|
||||
[TotAGCTimeF,NOfAGC,TotAGCSize]),
|
||||
RTime is float(Runtime)/1000,
|
||||
format(user_error,"~t~3f~12+ sec. runtime~n", [RTime]),
|
||||
format(user_error,'~t~3f~12+ sec. runtime~n', [RTime]),
|
||||
CPUTime is float(CPUtime)/1000,
|
||||
format(user_error,"~t~3f~12+ sec. cputime~n", [CPUTime]),
|
||||
format(user_error,'~t~3f~12+ sec. cputime~n', [CPUTime]),
|
||||
WallTime is float(Walltime)/1000,
|
||||
format(user_error,"~t~3f~12+ sec. elapsed time~n~n", [WallTime]),
|
||||
format(user_error,'~t~3f~12+ sec. elapsed time~n~n', [WallTime]),
|
||||
fail.
|
||||
'$statistics'(_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_).
|
||||
|
||||
|
||||
Reference in New Issue
Block a user