SWI and module fixes

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2290 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

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);

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

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

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) {
+  sno = OpenBufWriteStream();
-    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);
   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 */
+  if (IsVarTerm(tin)) {
-  Yap_c_output_stream = CheckStream (ARG1, Output_Stream_f, "format/3");
+    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;  
+  if (mem_stream) {
-  return(out);
+    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");

GPL/aggregate.pl

@@ -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,

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.
+
+

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

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;

H/rheap.h

@@ -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

changes-5.1.html

@@ -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>

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
+@findex nth0/3
-@syindex nth0/2
+@syindex nth0/3
-@cnindex nth0/2
+@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})
+@item nth1(?@var{N}, ?@var{List}, ?@var{Elem})
-@findex nth/2
+@findex nth1/3
-@syindex nth/2
+@syindex nth1/3
-@cnindex nth/2
+@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})
+@item nth1(?@var{N}, ?@var{List}, ?@var{Elem}, ?@var{Rest})
-@findex nth/4
+@findex nth1/4
-@syindex nth/4
+@syindex nth1/4
-@cnindex nth/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
+True when @var{Set} is a list, @var{Element} occurs in @var{List}, and
-everything in @var{Set} except @var{Element} (things stay in the same order).
+@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

library/lists.yap

@@ -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).
+
+

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).
+

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'(G, V, N, Mod, Source) :-
+'$go_compile_clause'(M:G,V,N,_,_,Source) :- !,
-	 '$prepare_term'(G, V, G0, G1, Mod, Source),
+	  '$go_compile_clause'(G,V,N,M,M,Source).
-	 '$$compile'(G1, G0, N, Mod).
+'$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).
 
- '$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 ),
+		 '$check_term'(Source, V, BodyMod) ; true ),
-	 '$precompile_term'(G, G0, G1, Mod).
+	 '$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),
+	 Expanded = ExpandedI,
-	    '$check_iso_strict_clause'(Expanded0)
+	 '$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

pl/errors.yap

@@ -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)),

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) :- !,
+% A1: Input Clause
-	'$is_mt'(Mod,H,B,IB,MM),
+% A2: Output Class to Compiler (lives in module HM) 
-	'$prepare_body_with_correct_modules'(IB, M, B0),
+% 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'(IB,B1,BO,M,MM,HM,UVars).
-'$module_expansion'((H:-B),(H:-B1),(H:-BO),M) :-
+% do not expand bodyless clauses.
-	'$is_mt'(M,H,B,IB,MM),
+'$module_expansion'(H,H,H,_,_).
-	'$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).
 
 
 '$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
+%       code to pass to compiler
-%       current module for fixing up meta-call arguments
+%       current module for looking up preds  M
-%       current module for predicate
+%       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), !.
+%       goals or arguments/sub-arguments?
-'$module_expansion'((A,B),(A1,B1),(AO,BO),M,MM,TM,HVars) :- !,
+% I cannot use call here because of format/3
-	'$module_expansion'(A,A1,AO,M,MM,TM,HVars),
+'$module_expansion'(V,NG,NG,_,MM,_,HVars) :-
-	'$module_expansion'(B,B1,BO,M,MM,TM,HVars).
+	var(V), !,
-'$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) :- !,
+	( '$not_in_vars'(V,HVars)
-	'$module_expansion'(A,A1,AOO,M,MM,TM,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'(B,B1,BO,M,MM,HM,HVars),
-	'$module_expansion'(C,C1,CO,M,MM,TM,HVars).
+	'$module_expansion'(C,C1,CO,M,MM,HM,HVars).
-'$module_expansion'((A;B),(A1;B1),(AO;BO),M,MM,TM,HVars) :- !,
+'$module_expansion'((A;B),(A1;B1),(AO;BO),M,MM,HM,HVars) :- !,
-	'$module_expansion'(A,A1,AO,M,MM,TM,HVars),
+	'$module_expansion'(A,A1,AO,M,MM,HM,HVars),
-	'$module_expansion'(B,B1,BO,M,MM,TM,HVars).
+	'$module_expansion'(B,B1,BO,M,MM,HM,HVars).
-'$module_expansion'((A|B),(A1|B1),(AO|BO),M,MM,TM,HVars) :- !,
+'$module_expansion'((A|B),(A1|B1),(AO|BO),M,MM,HM,HVars) :- !,
-	'$module_expansion'(A,A1,AO,M,MM,TM,HVars),
+	'$module_expansion'(A,A1,AO,M,MM,HM,HVars),
-	'$module_expansion'(B,B1,BO,M,MM,TM,HVars).
+	'$module_expansion'(B,B1,BO,M,MM,HM,HVars).
-'$module_expansion'((A->B),(A1->B1),(AO->BO),M,MM,TM,HVars) :- !,
+'$module_expansion'((A->B),(A1->B1),(AO->BO),M,MM,HM,HVars) :- !,
-	'$module_expansion'(A,A1,AOO,M,MM,TM,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'(B,B1,BO,M,MM,HM,HVars).
-'$module_expansion'(\+A,\+A1,\+AO,M,MM,TM,HVars) :- !,
+'$module_expansion'(\+A,\+A1,\+AO,M,MM,HM,HVars) :- !,
-	'$module_expansion'(A,A1,AO,M,MM,TM,HVars).
+	'$module_expansion'(A,A1,AO,M,MM,HM,HVars).
-'$module_expansion'(not(A),not(A1),not(AO),M,MM,TM,HVars) :- !,
+'$module_expansion'(not(A),not(A1),not(AO),M,MM,HM,HVars) :- !,
-	'$module_expansion'(A,A1,AO,M,MM,TM,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'(M:G,G1,GO,_,_,HM,HVars) :- !,
-	'$module_expansion'(G,G1,GO,M,M,TM,HVars).
+	'$module_expansion'(G,G1,GO,M,M,HM,HVars).
-% if M1 is given explicitly process G within M1's context.
+'$module_expansion'(G, G1, GO, CurMod, MM, HM, HVars) :-
-% '$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) :-
 	'$pred_goal_expansion_on',
 	user:goal_expansion(G, CurMod, GI), !,
-	'$module_expansion'(GI, G1, G0, CurMod, MM, TM, HVars).
+	'$module_expansion'(GI, G1, GO, CurMod, MM, HM, HVars).
-'$module_expansion'(G, G1, GO, CurMod, MM, TM, HVars) :-
+'$module_expansion'(G, G1, GO, CurMod, MM, HM,HVars) :-
 	% is this imported from some other module M1?
-	( '$imported_pred'(G, CurMod, GG, M1) ->
+	'$imported_pred'(G, CurMod, GG, M1),
-	    '$module_expansion'(GG, G1, GO, M1, MM, TM, HVars)
+	!,
+	'$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)
 	;
-	  (
+	 G2 = G1
-	   '$meta_expansion'(CurMod, MM, G, GI, HVars)
-	  ->
-	   true
-	   ;
-	   GI = G
-	  ),
-	  '$complete_goal_expansion'(GI, CurMod, MM, TM, G1, GO, HVars)
 	).
+'$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).
+	'$meta_expansion_loop'(N, D, G, G1, HVars, Mod, MP, HM).
-%	format(user_error," gives ~w~n]",[G1]).
+%	format(user_error,' gives ~w]`n',[G1]).
 
 % expand argument
-'$meta_expansion_loop'(0,_,_,_,_,_) :- !.
+'$meta_expansion_loop'(0,_,_,_,_,_,_,_) :- !.
-'$meta_expansion_loop'(I,D,G,G1,HVars,M) :- 
+'$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), !,
+	arg(I,G,A), '$do_expand'(A,HVars),
-	'$process_expanded_arg'(A, M, NA),
+	!,
-	arg(I,G1,NA),
+	arg(I,NG,M: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).
-'$meta_expansion_loop'(I,D,G,G1,HVars,M) :- 
+'$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.
 %

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), !,
+        var(H), !, '$do_error'(instantiation_error,P).
-	( 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)
-	).
 '$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), !,
+	var(H), !, '$do_error'(instantiation_error,P).
-	( 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)
-	).
 '$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) :-

pl/statistics.yap

@@ -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,'memory (total)~t~d bytes~35+~n', [TotalMemory]),
-	format(user_error,"   program space~t~d bytes~35+", [HpSpa]),
+	format(user_error,'   program space~t~d bytes~35+', [HpSpa]),
-	format(user_error,":~t  ~d in use~19+", [HpInUse]),
+	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 free~19+~n', [HpFree]),
-	format(user_error,"~t  ~d  max~73+~n", [HpMax]),
+	format(user_error,'~t  ~d  max~73+~n', [HpMax]),
-	format(user_error,"   stack space~t~d bytes~35+", [StkSpa]),
+	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,',~t  ~d free~19+~n', [StackFree]),
-	format(user_error,"     global stack:~t~35+", []),
+	format(user_error,'     global stack:~t~35+', []),
-	format(user_error," ~t  ~d in use~19+", [GlobInU]),
+	format(user_error,' ~t  ~d in use~19+', [GlobInU]),
-	format(user_error,",~t  ~d  max~19+~n", [GlobMax]),
+	format(user_error,',~t  ~d  max~19+~n', [GlobMax]),
-	format(user_error,"      local stack:~t~35+", []),
+	format(user_error,'      local stack:~t~35+', []),
-	format(user_error," ~t  ~d in use~19+", [LocInU]),
+	format(user_error,' ~t  ~d in use~19+', [LocInU]),
-	format(user_error,",~t  ~d  max~19+~n", [LocMax]),
+	format(user_error,',~t  ~d  max~19+~n', [LocMax]),
-	format(user_error,"   trail stack~t~d bytes~35+", [TrlSpa]),
+	format(user_error,'   trail stack~t~d bytes~35+', [TrlSpa]),
-	format(user_error,":~t  ~d in use~19+", [TrlInUse]),
+	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'(_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_).