Merge branch 'master' of yap.dcc.fc.up.pt:yap-6

C/cdmgr.c

@@ -2975,6 +2975,29 @@ p_is_source(void)
   return(out);
 }
 
+static Int 
+p_owner_file(void)
+{				/* '$owner_file'(+P,M,F)	 */
+  PredEntry      *pe;
+  Atom            owner;
+
+  pe = get_pred(Deref(ARG1),  Deref(ARG2), "$is_source");
+  if (EndOfPAEntr(pe))
+    return FALSE;
+  LOCK(pe->PELock);
+  if (pe->ModuleOfPred == IDB_MODULE) {
+    UNLOCK(pe->PELock);
+    return FALSE;
+  }
+  if (pe->PredFlags & MultiFileFlag) {
+    UNLOCK(pe->PELock);
+    return FALSE;
+  }
+  owner =  pe->src.OwnerFile
+  UNLOCK(pe->PELock);
+  return Yap_unify(ARG3, MkAtomTerm(owner));
+}
+
 static Int 
 p_mk_d(void)
 {				/* '$is_dynamic'(+P)	 */
@@ -5593,6 +5616,7 @@ Yap_InitCdMgr(void)
   Yap_InitCPred("$is_expand_goal_or_meta_predicate", 2, p_is_expandgoalormetapredicate, TestPredFlag | SafePredFlag|HiddenPredFlag);
   Yap_InitCPred("$is_log_updatable", 2, p_is_log_updatable, TestPredFlag | SafePredFlag|HiddenPredFlag);
   Yap_InitCPred("$is_source", 2, p_is_source, TestPredFlag | SafePredFlag|HiddenPredFlag);
+  Yap_InitCPred("$owner_file", 3, p_owner_file, SafePredFlag|HiddenPredFlag);
   Yap_InitCPred("$mk_d", 2, p_mk_d, SafePredFlag|HiddenPredFlag);
   Yap_InitCPred("$pred_exists", 2, p_pred_exists, TestPredFlag | SafePredFlag|HiddenPredFlag);
   Yap_InitCPred("$number_of_clauses", 3, p_number_of_clauses, SafePredFlag|SyncPredFlag|HiddenPredFlag);

C/cmppreds.c

@@ -681,35 +681,35 @@ a_eq(Term t1, Term t2)
 static Int 
 a_dif(Term t1, Term t2)
 {
-  int out = a_cmp(Deref(t1),Deref(t2));
+  Int out = a_cmp(Deref(t1),Deref(t2));
   return !ArithError && out != 0;
 }
 
 static Int 
 a_gt(Term t1, Term t2)
 {				/* A > B		 */
-  int out = a_cmp(Deref(t1),Deref(t2));
+  Int out = a_cmp(Deref(t1),Deref(t2));
   return !ArithError && out > 0;
 }
 
 static Int 
 a_ge(Term t1, Term t2)
 {				/* A >= B		 */
-  int out = a_cmp(Deref(t1),Deref(t2));
+  Int out = a_cmp(Deref(t1),Deref(t2));
   return !ArithError && out >= 0;
 }
 
 static Int 
 a_lt(Term t1, Term t2)
 {				/* A < B       */
-  int out = a_cmp(Deref(t1),Deref(t2));
+  Int out = a_cmp(Deref(t1),Deref(t2));
   return !ArithError && out < 0;
 }
 
 static Int 
 a_le(Term t1, Term t2)
 {				/* A <= B */
-  int out = a_cmp(Deref(t1),Deref(t2));
+  Int out = a_cmp(Deref(t1),Deref(t2));
   return !ArithError && out <= 0;
 }
 

C/errors.c

@@ -902,6 +902,21 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
       serious = TRUE;
     }
     break;
+  case EXISTENCE_ERROR_VARIABLE:
+    {
+      int i;
+      Term ti[2];
+
+      i = strlen(tmpbuf);
+      ti[0] = MkAtomTerm(AtomVariable);
+      ti[1] = where;
+      nt[0] = Yap_MkApplTerm(FunctorExistenceError, 2, ti);
+      tp = tmpbuf+i;
+      psize -= i;
+      fun = FunctorError;
+      serious = TRUE;
+    }
+    break;
   case EVALUATION_ERROR_FLOAT_OVERFLOW:
     {
       int i;

C/globals.c

@@ -1285,8 +1285,10 @@ p_nb_getval(void)
     return FALSE;
   }
   ge = FindGlobalEntry(AtomOfTerm(t));
-  if (!ge)
+  if (!ge) {
+    Yap_Error(EXISTENCE_ERROR_VARIABLE,t,"nb_getval");
     return FALSE;
+  }
   READ_LOCK(ge->GRWLock);
   to = ge->global;
   if (IsVarTerm(to) && IsUnboundVar(VarOfTerm(to))) {
@@ -1309,8 +1311,10 @@ nbdelete(Atom at)
   Prop gp, g0;
 
   ge = FindGlobalEntry(at);
-  if (!ge)
+  if (!ge) {
+    Yap_Error(EXISTENCE_ERROR_VARIABLE,MkAtomTerm(at),"nb_delete");
     return FALSE;
+  }
   WRITE_LOCK(ge->GRWLock);
   ae = ge->AtomOfGE;
   if (GlobalVariables == ge) {
@@ -1375,8 +1379,10 @@ p_nb_create(void)
     return FALSE;
   }
   ge = GetGlobalEntry(AtomOfTerm(t));
-  if (!ge)
+  if (!ge) {
+    Yap_Error(EXISTENCE_ERROR_VARIABLE,t,"nb_create");
     return FALSE;
+  }
   if (IsVarTerm(tarity)) {
     Yap_Error(INSTANTIATION_ERROR,tarity,"nb_create");
     return FALSE;
@@ -1418,8 +1424,10 @@ p_nb_create2(void)
     return FALSE;
   }
   ge = GetGlobalEntry(AtomOfTerm(t));
-  if (!ge)
+  if (!ge) {
+    Yap_Error(EXISTENCE_ERROR_VARIABLE,t,"nb_create");
     return FALSE;
+  }
   if (IsVarTerm(tarity)) {
     Yap_Error(INSTANTIATION_ERROR,tarity,"nb_create");
     return FALSE;

C/iopreds.c

@@ -3401,7 +3401,7 @@ p_peek_mem_write_stream (void)
 	Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
 	return(FALSE);
       }
-      i = 0;
+      i = Stream[sno].u.mem_string.pos;
       tf = ARG2;
       LOCK(Stream[sno].streamlock);
       goto restart;

H/Yap.h

@@ -90,7 +90,7 @@
 #undef  USE_THREADED_CODE
 #endif
 #define inline __inline
-#define YAP_VERSION "Yap-6.0.0"
+#define YAP_VERSION "Yap-6.0.1"
 
 #define BIN_DIR "c:\\Yap\\bin"
 #define LIB_DIR "c:\\Yap\\lib\\Yap"
@@ -464,6 +464,7 @@ typedef enum
   EXISTENCE_ERROR_KEY,
   EXISTENCE_ERROR_SOURCE_SINK,
   EXISTENCE_ERROR_STREAM,
+  EXISTENCE_ERROR_VARIABLE,
   INSTANTIATION_ERROR,
   INTERRUPT_ERROR,
   OPERATING_SYSTEM_ERROR,

LGPL/prolog_source.pl

@@ -69,10 +69,6 @@ users of the library are:
 
 :- if(current_prolog_flag(dialect, yap)).
 % yap
-'$set_source_module'(M1, M2) :-
-	source_module(M1),
-	module(M2).
-
 '$style_check'([Singleton,Discontiguous,Multiple], StyleF) :-
 	(
 	 prolog_flag(single_var_warnings,on)

LGPL/prolog_xref.pl

@@ -1,4 +1,4 @@
-/*  $Id: prolog_xref.pl,v 1.3 2008-02-13 14:42:55 vsc Exp $
+/*  $Id$
 
     Part of SWI-Prolog
 
@@ -51,15 +51,16 @@
 	    xref_used_class/2,		% ?Source, ?ClassName
 	    xref_defined_class/3	% ?Source, ?ClassName, -How
 	  ]).
-
+:- use_module(library(debug), [debug/3, debugging/1]).
-%:- use_module(library(debug), [debug/3, debugging/1]).
+:- use_module(library(lists), [append/3, member/2]).
-:- use_module(library(lists), [append/3, member/2, is_list/1]).
 :- use_module(library(operators),
 	      [pop_operators/0, push_op/3, push_operators/1]).
+:- if(current_prolog_flag(dialect, swi)).
 :- use_module(library(shlib), [current_foreign_library/2]).
+:- endif.
 :- use_module(library(prolog_source)).
 :- use_module(library(option)).
-:- use_module(library(debug)).
+:- use_module(library(error)).
 
 :- dynamic
 	called/3,			% Head, Src, From
@@ -78,6 +79,7 @@
 	defined_class/5,		% Name, Super, Summary, Src, Line
 	(mode)/2.			% Mode, Src
 
+:- create_prolog_flag(xref, false, [type(boolean)]).
 
 		 /*******************************
 		 *	      HOOKS		*
@@ -101,44 +103,30 @@
 :- dynamic
 	meta_goal/2.
 
+called_by(Goal, Called) :-
+	prolog:called_by(Goal, Called), !.
+called_by(on_signal(_,_,New), [New+1]) :-
+	(   new == throw
+	;   new == default
+	), !, fail.
+
+
 		 /*******************************
 		 *	     BUILT-INS		*
 		 *******************************/
 
 %%	built_in_predicate(+Callable)
-%	
+%
 %	True if Callable is a built-in
 
+:- expects_dialect(swi).
+
 :- if(current_prolog_flag(dialect, swi)).
 system_predicate(Goal) :-
+	functor(Goal, Name, Arity),
+	current_predicate(system:Name/Arity),	% avoid autoloading
 	predicate_property(system:Goal, built_in), !.
-
+:-endif.
-genarg(X,Y,Z) :-
-	arg(X,Y,Z).
-:- else.
-% yap
-
-:- ensure_loaded(library(swi)).
-
-:- user_defined_flag(xref).
-
-:- use_module(library(arg)).
-
-flag(Key,Old,New) :-
-	retract('$flag'(Key,OOld)), !,
-	Old = OOld,
-	assert('$flag'(Key,New)).
-flag(Key,0,New) :-
-	assert('$flag'(Key,New)).
-
-'$set_source_module'(M1, M2) :-
-	source_module(M1),
-	module(M2).
-
-'$get_predicate_attribute'(M1, P1, P2) :-
-	Prop =.. [P1,P2],
-	predicate_property(M1, Prop).
-:- endif.
 
 		/********************************
 		*            TOPLEVEL		*
@@ -148,11 +136,11 @@ verbose :-
 	debugging(xref).
 
 %%	xref_source(+Source) is det.
-%	
+%
 %	Generate the cross-reference data  for   Source  if  not already
 %	done and the source is not modified.  Checking for modifications
 %	is only done for files.
-%	
+%
 %	@param Source	File specification or XPCE buffer
 
 xref_source(Source) :-
@@ -172,28 +160,38 @@ xref_source(Source) :-
 	xref_setup(Src, In, State),
 	call_cleanup(collect(Src, In), xref_cleanup(State)).
 
-xref_setup(Src, In, state(In, Xref, Ref)) :-
+:- thread_local
+	xref_stream/1.			% input stream
+
+xref_setup(Src, In, state(In, Xref, [SRef|HRefs])) :-
 	prolog_open_source(Src, In),
+	asserta(xref_stream(In), SRef),
 	(   current_prolog_flag(xref, Xref)
 	->  true
 	;   Xref = false
 	),
 	set_prolog_flag(xref, true),
 	(   verbose
-	->  Ref = []
+	->  HRefs = []
-	;   asserta(user:message_hook(_,_,_), Ref)
+	;   asserta(user:message_hook(_,_,_), Ref),
+	    HRefs = [Ref]
 	).
 
-xref_cleanup(state(In, Xref, Ref)) :-
+xref_cleanup(state(In, Xref, Refs)) :-
 	prolog_close_source(In),
 	set_prolog_flag(xref, Xref),
-	(   Ref \== []
+	maplist(erase, Refs).
-	->  erase(Ref)
+
-	;   true
+%%	xref_input_stream(-Stream) is det.
-	).
+%
+%	Current input stream for cross-referencer.
+
+xref_input_stream(Stream) :-
+	xref_stream(Var), !,
+	Stream = Var.
 
 %%	xref_push_op(Source, +Prec, +Type, :Name)
-%	
+%
 %	Define operators into the default source module and register
 %	them to be undone by pop_operators/0.
 
@@ -209,7 +207,7 @@ xref_push_op(Src, P, T, N0) :- !,
 
 
 %%	xref_clean(+Source) is det.
-%	
+%
 %	Reset the database for the given source.
 
 xref_clean(Source) :-
@@ -228,7 +226,7 @@ xref_clean(Source) :-
 	retractall(used_class(_, Src)),
 	retractall(defined_class(_, _, _, Src, _)),
 	retractall(mode(_, Src)).
-	
+
 
 		 /*******************************
 		 *	    READ RESULTS	*
@@ -243,7 +241,7 @@ xref_current_source(Source) :-
 
 
 %%	xref_done(+Source, -Time) is det.
-%	
+%
 %	Cross-reference executed at Time
 
 xref_done(Source, Time) :-
@@ -252,7 +250,7 @@ xref_done(Source, Time) :-
 
 
 %%	xref_called(+Source, ?Called, ?By) is nondet.
-%	
+%
 %	Enumerate the predicate-call relations. Predicate called by
 %	directives have a By '<directive>'.
 
@@ -262,7 +260,7 @@ xref_called(Source, Called, By) :-
 
 
 %%	xref_defined(+Source, +Goal, ?How) is semidet.
-%	
+%
 %	Test if Goal is accessible in Source. If this is the case, How
 %	specifies the reason why the predicate is accessible. Note that
 %	this predicate does not deal with built-in or global predicates,
@@ -289,7 +287,7 @@ xref_defined2(imported(From), Src, Called) :-
 
 
 %%	xref_definition_line(+How, -Line)
-%	
+%
 %	If the 3th argument of xref_defined contains line info, return
 %	this in Line.
 
@@ -306,7 +304,7 @@ xref_exported(Source, Called) :-
 	exported(Called, Src).
 
 %%	xref_module(?Source, ?Module) is nondet.
-%	
+%
 %	True if Module is defined in Source.
 
 xref_module(Source, Module) :-
@@ -314,11 +312,11 @@ xref_module(Source, Module) :-
 	xmodule(Module, Src).
 
 %%	xref_op(?Source, Op) is nondet.
-%	
+%
 %	Give the operators active inside the module. This is intended to
 %	setup the environment for incremental parsing of a term from the
 %	source-file.
-%	
+%
 %	@param Op	Term of the form op(Priority, Type, Name)
 
 xref_op(Source, Op) :-
@@ -342,18 +340,18 @@ xref_defined_class(Source, Class, file(File)) :-
 
 collect(Src, In) :-
 	repeat,
-	    catch(read_source_term(In, Term, TermPos),
+	    catch(read_source_term(Src, In, Term, TermPos),
-		  E, syntax_error(E)),
+		  E, report_syntax_error(E)),
 	    xref_expand(Term, T),
 	    (   T == end_of_file
 	    ->  !
 	    ;   stream_position_data(line_count, TermPos, Line),
 		flag(xref_src_line, _, Line),
-	        process(T, Src),
+		catch(process(T, Src), E, print_message(error, E)),
 		fail
 	    ).
 
-%%	read_source_term(+In:stream, -Term, -TermPos) is det.
+%%	read_source_term(+Src, +In:stream, -Term, -TermPos) is det.
 %
 %	Read next term  from  In.   The  cross-referencer  supports  the
 %	comment_hook  as  also  implemented  by  the  compiler  for  the
@@ -362,7 +360,9 @@ collect(Src, In) :-
 :- multifile
 	prolog:comment_hook/3.
 
-read_source_term(In, Term, TermPos) :-
+read_source_term(Src, In, Term, TermPos) :-
+	atom(Src),
+	\+ source_file(Src),		% normally loaded; no need to update
 	'$get_predicate_attribute'(prolog:comment_hook(_,_,_),
 				   number_of_clauses, N),
 	N > 0, !,
@@ -377,7 +377,7 @@ read_source_term(In, Term, TermPos) :-
 	->  true
 	;   true
 	).
-read_source_term(In, Term, TermPos) :-
+read_source_term(_, In, Term, TermPos) :-
 	'$set_source_module'(SM, SM),
 	read_term(In, Term,
 		  [ term_position(TermPos),
@@ -385,7 +385,7 @@ read_source_term(In, Term, TermPos) :-
 		  ]).
 
 
-syntax_error(E) :-
+report_syntax_error(E) :-
 	(   verbose
 	->  print_message(error, E)
 	;   true
@@ -405,6 +405,10 @@ syntax_error(E) :-
 %	are processed using process_chr/2  directly   from  the  source,
 %	which is why we inhibit expansion here.
 
+xref_expand((:- if(Cond)), (:- if(Cond))).
+xref_expand((:- elif(Cond)), (:- elif(Cond))).
+xref_expand((:- else), (:- else)).
+xref_expand((:- endif), (:- endif)).
 xref_expand((:- require(X)),
 	    (:- require(X))) :- !.
 xref_expand(Term, _) :-
@@ -468,15 +472,20 @@ process_directive(List, Src) :-
 	process_directive(consult(List), Src).
 process_directive(use_module(Spec, Import), Src) :-
 	xref_public_list(Spec, Path, Public, Src),
-	assert_import(Src, Import, Public, Path).
+	assert_import(Src, Import, Public, Path, false).
+process_directive(reexport(Spec, Import), Src) :-
+	xref_public_list(Spec, Path, Public, Src),
+	assert_import(Src, Import, Public, Path, true).
+process_directive(reexport(Modules), Src) :-
+	process_use_module(Modules, Src, true).
 process_directive(use_module(Modules), Src) :-
-	process_use_module(Modules, Src).
+	process_use_module(Modules, Src, false).
 process_directive(consult(Modules), Src) :-
-	process_use_module(Modules, Src).
+	process_use_module(Modules, Src, false).
 process_directive(ensure_loaded(Modules), Src) :-
-	process_use_module(Modules, Src).
+	process_use_module(Modules, Src, false).
 process_directive(load_files(Files, _Options), Src) :-
-	process_use_module(Files, Src).
+	process_use_module(Files, Src, false).
 process_directive(include(Files), Src) :-
 	process_include(Files, Src).
 process_directive(dynamic(Dynamic), Src) :-
@@ -499,15 +508,20 @@ process_directive(op(P, A, N), Src) :-
 	xref_push_op(Src, P, A, N).
 process_directive(style_check(X), _) :-
 	style_check(X).
+process_directive(encoding(Enc), _) :-
+	(   xref_input_stream(Stream)
+	->  catch(set_stream(Stream, encoding(Enc)), _, true)
+	;   true			% can this happen?
+	).
 process_directive(system_module, _) :-
 	style_check(+dollar).
 process_directive(set_prolog_flag(character_escapes, Esc), _) :-
 	set_prolog_flag(character_escapes, Esc).
 process_directive(pce_expansion:push_compile_operators, _) :-
 	'$set_source_module'(SM, SM),
-	pce_expansion:push_compile_operators(SM).
+	call(pce_expansion:push_compile_operators(SM)). % call to avoid xref
 process_directive(pce_expansion:pop_compile_operators, _) :-
-	pce_expansion:pop_compile_operators.
+	call(pce_expansion:pop_compile_operators).
 process_directive(meta_predicate(Meta), _) :-
 	process_meta_predicate(Meta).
 process_directive(arithmetic_function(FSpec), Src) :-
@@ -517,12 +531,20 @@ process_directive(arithmetic_function(FSpec), Src) :-
 process_directive(format_predicate(_, Goal), Src) :- !,
 	flag(xref_src_line, Line, Line),
 	assert_called(Src, '<directive>'(Line), Goal).
+process_directive(if(Cond), Src) :- !,
+	flag(xref_src_line, Line, Line),
+	assert_called(Src, '<directive>'(Line), Cond).
+process_directive(elif(Cond), Src) :- !,
+	flag(xref_src_line, Line, Line),
+	assert_called(Src, '<directive>'(Line), Cond).
+process_directive(else, _) :- !.
+process_directive(endif, _) :- !.
 process_directive(Goal, Src) :-
 	flag(xref_src_line, Line, Line),
 	process_body(Goal, '<directive>'(Line), Src).
 
 %%	process_meta_predicate(+Decl)
-%	
+%
 %	Create prolog:meta_goal/2 declaration from the meta-goal
 %	declaration.
 
@@ -534,22 +556,22 @@ process_meta_predicate(Decl) :-
 	functor(Head, Name, Arity),
 	meta_args(1, Arity, Decl, Head, Meta),
 	(   (   prolog:meta_goal(Head, _)
-	    ;   prolog:called_by(Head, _)
+	    ;   called_by(Head, _)
 	    ;   meta_goal(Head, _)
 	    )
 	->  true
-	;   assert(prolog:meta_goal(Head, Meta))
+	;   assert(meta_goal(Head, Meta))
 	).
 
 meta_args(I, Arity, _, _, []) :-
 	I > Arity, !.
-meta_args(I, Arity, Decl, Head, [H|T]) :- 		% :
+meta_args(I, Arity, Decl, Head, [H|T]) :- 		% 0
-	arg(I, Decl, :), !,
+	arg(I, Decl, 0), !,
 	arg(I, Head, H),
 	I2 is I + 1,
 	meta_args(I2, Arity, Decl, Head, T).
 meta_args(I, Arity, Decl, Head, [H+A|T]) :-		% I --> H+I
-	arg(I, Decl, A), 
+	arg(I, Decl, A),
 	integer(A), A > 0, !,
 	arg(I, Head, H),
 	I2 is I + 1,
@@ -568,15 +590,24 @@ xref_meta((A; B), 		[A, B]).
 xref_meta((A| B), 		[A, B]).
 xref_meta((A -> B),		[A, B]).
 xref_meta((A *-> B),		[A, B]).
-xref_meta(findall(_V, G, _L),	[G]).
+xref_meta(findall(_V,G,_L),	[G]).
+xref_meta(findall(_V,G,_L,_T),	[G]).
 xref_meta(setof(_V, G, _L),	[G]).
 xref_meta(bagof(_V, G, _L),	[G]).
 xref_meta(forall(A, B),		[A, B]).
-xref_meta(maplist(G, _),	[G+1]).
+xref_meta(maplist(G,_),		[G+1]).
-xref_meta(maplist(G, _, _),	[G+2]).
+xref_meta(maplist(G,_,_),	[G+2]).
-xref_meta(maplist(G, _, _, _),	[G+3]).
+xref_meta(maplist(G,_,_,_),	[G+3]).
+xref_meta(maplist(G,_,_,_,_),	[G+4]).
+xref_meta(map_list_to_pairs(G,_,_), [G+2]).
+xref_meta(map_assoc(G, _),	[G+1]).
+xref_meta(map_assoc(G, _, _),	[G+2]).
 xref_meta(checklist(G, _L),	[G+1]).
 xref_meta(sublist(G, _, _),	[G+1]).
+xref_meta(include(G, _, _),	[G+1]).
+xref_meta(exclude(G, _, _),	[G+1]).
+xref_meta(partition(G, _, _, _, _),	[G+2]).
+xref_meta(partition(G, _, _, _),[G+1]).
 xref_meta(call(G),		[G]).
 xref_meta(call(G, _),		[G+1]).
 xref_meta(call(G, _, _),	[G+2]).
@@ -588,21 +619,23 @@ xref_meta(\+(G),		[G]).
 xref_meta(ignore(G),		[G]).
 xref_meta(once(G),		[G]).
 xref_meta(initialization(G),	[G]).
+xref_meta(initialization(G,_),	[G]).
 xref_meta(retract(Rule),	[G]) :- head_of(Rule, G).
 xref_meta(clause(G, _),		[G]).
 xref_meta(clause(G, _, _),	[G]).
 xref_meta(phrase(G, _A),	[G+2]).
 xref_meta(phrase(G, _A, _R),	[G+2]).
+xref_meta(phrase_from_file(G,_),[G+2]).
 xref_meta(catch(A, _, B),	[A, B]).
 xref_meta(thread_create(A,_,_), [A]).
 xref_meta(thread_signal(_,A),   [A]).
 xref_meta(thread_at_exit(A),	[A]).
+xref_meta(thread_initialization(A), [A]).
 xref_meta(predsort(A,_,_),	[A+3]).
 xref_meta(call_cleanup(A, B),	[A, B]).
 xref_meta(call_cleanup(A, _, B),[A, B]).
-xref_meta(setup_and_call_cleanup(A, B, C),[A, B, C]).
+xref_meta(setup_call_cleanup(A, B, C),[A, B, C]).
-xref_meta(setup_and_call_cleanup(A, B, _, C),[A, B, C]).
+xref_meta(setup_call_catcher_cleanup(A, B, _, C),[A, B, C]).
-xref_meta(on_signal(_,_,A),	[A+1]).
 xref_meta(with_mutex(_,A),	[A]).
 xref_meta(assume(G),		[G]).	% library(debug)
 xref_meta(assertion(G),		[G]).	% library(debug)
@@ -615,8 +648,13 @@ xref_meta(profile(G),		[G]).
 xref_meta(at_halt(G),		[G]).
 xref_meta(call_with_time_limit(_, G), [G]).
 xref_meta(call_with_depth_limit(G, _, _), [G]).
+xref_meta(alarm(_, G, _),	[G]).
+xref_meta(alarm(_, G, _, _),	[G]).
 xref_meta('$add_directive_wic'(G), [G]).
 xref_meta(with_output_to(_, G),	[G]).
+xref_meta(if(G),		[G]).
+xref_meta(elif(G),		[G]).
+xref_meta(meta_options(G,_,_),	[G+1]).
 
 					% XPCE meta-predicates
 xref_meta(pce_global(_, new(_)), _) :- !, fail.
@@ -633,7 +671,7 @@ xref_meta(G, Meta) :-			% Generated from :- meta_predicate
 
 
 %%	head_of(+Rule, -Head)
-%	
+%
 %	Get the head for a retract call.
 
 head_of(Var, _) :-
@@ -642,7 +680,7 @@ head_of((Head :- _), Head).
 head_of(Head, Head).
 
 %%	xref_hook(?Callable)
-%	
+%
 %	Definition of known hooks.  Hooks  that   can  be  called in any
 %	module are unqualified.  Other  hooks   are  qualified  with the
 %	module where they are called.
@@ -650,42 +688,52 @@ head_of(Head, Head).
 xref_hook(Hook) :-
 	prolog:hook(Hook).
 xref_hook(Hook) :-
-	xhook(Hook).
+	hook(Hook).
 
 
-xhook(attr_portray_hook(_,_)).
+hook(attr_portray_hook(_,_)).
-xhook(attr_unify_hook(_,_)).
+hook(attr_unify_hook(_,_)).
-xhook(goal_expansion(_,_)).
+hook(goal_expansion(_,_)).
-xhook(term_expansion(_,_)).
+hook(term_expansion(_,_)).
-xhook(resource(_,_,_)).
+hook(resource(_,_,_)).
+
+hook(emacs_prolog_colours:goal_classification(_,_)).
+hook(emacs_prolog_colours:term_colours(_,_)).
+hook(emacs_prolog_colours:goal_colours(_,_)).
+hook(emacs_prolog_colours:style(_,_)).
+hook(emacs_prolog_colours:identify(_,_)).
+hook(pce_principal:pce_class(_,_,_,_,_,_)).
+hook(pce_principal:send_implementation(_,_,_)).
+hook(pce_principal:get_implementation(_,_,_,_)).
+hook(pce_principal:pce_lazy_get_method(_,_,_)).
+hook(pce_principal:pce_lazy_send_method(_,_,_)).
+hook(pce_principal:pce_uses_template(_,_)).
+hook(prolog:locate_clauses(_,_)).
+hook(prolog:message(_,_,_)).
+hook(prolog:message_context(_,_,_)).
+hook(prolog:debug_control_hook(_)).
+hook(prolog:help_hook(_)).
+hook(prolog:show_profile_hook(_,_)).
+hook(prolog:general_exception(_,_)).
+hook(prolog_edit:load).
+hook(prolog_edit:locate(_,_,_)).
+hook(shlib:unload_all_foreign_libraries).
+hook(system:'$foreign_registered'(_, _)).
+hook(user:exception(_,_,_)).
+hook(user:file_search_path(_,_)).
+hook(user:library_directory(_)).
+hook(user:message_hook(_,_,_)).
+hook(user:portray(_)).
+hook(user:prolog_clause_name(_,_)).
+hook(user:prolog_list_goal(_)).
+hook(user:prolog_predicate_name(_,_)).
+hook(user:prolog_trace_interception(_,_,_,_)).
+hook(user:prolog_event_hook(_)).
+hook(user:prolog_exception_hook(_,_,_,_)).
 
-xhook(emacs_prolog_colours:goal_colours(_,_)).
-xhook(pce_principal:pce_class(_,_,_,_,_,_)).
-xhook(pce_principal:send_implementation(_,_,_)).
-xhook(pce_principal:get_implementation(_,_,_,_)).
-xhook(pce_principal:pce_lazy_get_method(_,_,_)).
-xhook(pce_principal:pce_lazy_send_method(_,_,_)).
-xhook(prolog:locate_clauses(_,_)).
-xhook(prolog:message(_,_,_)).
-xhook(prolog:debug_control_hook(_)).
-xhook(prolog:help_hook(_)).
-xhook(prolog:show_profile_hook(_,_)).
-xhook(prolog_edit:load).
-xhook(shlib:unload_all_foreign_libraries).
-xhook(system:'$foreign_registered'(_, _)).
-xhook(user:exception(_,_,_)).
-xhook(user:file_search_path(_,_)).
-xhook(user:library_directory(_)).
-xhook(user:message_hook(_,_,_)).
-xhook(user:portray(_)).
-xhook(user:prolog_clause_name(_,_)).
-xhook(user:prolog_list_goal(_)).
-xhook(user:prolog_predicate_name(_,_)).
-xhook(user:prolog_trace_interception(_,_,_,_)).
-xhook(user:prolog_event_hook(_)).
 
 %%	arith_callable(+Spec, -Callable)
-%	
+%
 %	Translate argument of arithmetic_function/1 into a callable term
 
 arith_callable(Var, _) :-
@@ -698,18 +746,15 @@ arith_callable(Name/Arity, Goal) :-
 
 
 %%	process_body(+Body, +Origin, +Src)
-%	
+%
 %	Process a callable body (body of a clause or directive). Origin
 %	describes the origin of the call.
 
 process_body(Var, _, _) :-
 	var(Var), !.
 process_body(Goal, Origin, Src) :-
-	prolog:called_by(Goal, Called), !,
+	called_by(Goal, Called), !,
-	(   is_list(Called)
+	must_be(list, Called),
-	->  true
-	;   throw(error(type_error(list, Called), _))
-	),
 	assert_called(Src, Origin, Goal),
 	process_called_list(Called, Origin, Src).
 process_body(Goal, Origin, Src) :-
@@ -782,13 +827,13 @@ pce_goal(get_object(_,_,_), get_object(arg, msg, -)).
 process_xpce_goal(G, Origin, Src) :-
 	pce_goal(G, Process), !,
 	assert_called(Src, Origin, G),
-	(   genarg(I, Process, How),
+	(   arg(I, Process, How),
 	    arg(I, G, Term),
 	    process_xpce_arg(How, Term, Origin, Src),
 	    fail
 	;   true
 	).
-		
+
 process_xpce_arg(new, Term, Origin, Src) :-
 	callable(Term),
 	process_new(Term, Origin, Src).
@@ -797,7 +842,7 @@ process_xpce_arg(arg, Term, Origin, Src) :-
 	process_new(Term, Origin, Src).
 process_xpce_arg(msg, Term, Origin, Src) :-
 	compound(Term),
-	(   genarg(_, Term, Arg),
+	(   arg(_, Term, Arg),
 	    process_xpce_arg(arg, Arg, Origin, Src),
 	    fail
 	;   true
@@ -806,12 +851,19 @@ process_xpce_arg(msg, Term, Origin, Src) :-
 process_new(_M:_Term, _, _) :- !.	% TBD: Calls on other modules!
 process_new(Term, Origin, Src) :-
 	assert_new(Src, Origin, Term),
-	(   genarg(_, Term, Arg),
+	(   arg(_, Term, Arg),
 	    process_xpce_arg(arg, Arg, Origin, Src),
 	    fail
 	;   true
 	).
 
+assert_new(_, _, Term) :-
+	\+ callable(Term), !.
+assert_new(Src, Origin, Control) :-
+	functor(Control, Class, _),
+	pce_control_class(Class), !,
+	forall(arg(_, Control, Arg),
+	       assert_new(Src, Origin, Arg)).
 assert_new(Src, Origin, Term) :-
 	compound(Term),
 	arg(1, Term, Prolog),
@@ -829,27 +881,34 @@ assert_new(Src, Origin, Term) :-
 	fail.
 assert_new(_, _, @(_)) :- !.
 assert_new(Src, _, Term) :-
-	callable(Term),
 	functor(Term, Name, _),
 	assert_used_class(Src, Name).
 
 
+pce_control_class(and).
+pce_control_class(or).
+pce_control_class(if).
+pce_control_class(not).
+
+
 		/********************************
 		*       INCLUDED MODULES	*
 		********************************/
 
-process_use_module(_Module:_Files, _) :- !.	% loaded in another module
+%%	process_use_module(+Modules, +Src, +Rexport) is det.
-process_use_module([], _) :- !.
+
-process_use_module([H|T], Src) :- !,
+process_use_module(_Module:_Files, _, _) :- !.	% loaded in another module
-	process_use_module(H, Src),
+process_use_module([], _, _) :- !.
-	process_use_module(T, Src).
+process_use_module([H|T], Src, Reexport) :- !,
-process_use_module(library(pce), Src) :- !,	% bit special
+	process_use_module(H, Src, Reexport),
+	process_use_module(T, Src, Reexport).
+process_use_module(library(pce), Src, Reexport) :- !,	% bit special
 	xref_public_list(library(pce), Path, Public, Src),
 	forall(member(Import, Public),
-	       process_pce_import(Import, Src, Path)).
+	       process_pce_import(Import, Src, Path, Reexport)).
-process_use_module(File, Src) :-
+process_use_module(File, Src, Reexport) :-
 	(   catch(xref_public_list(File, Path, Public, Src), _, fail)
-	->  assert_import(Src, Public, Path),
+	->  assert_import(Src, Public, _, Path, Reexport),
 	    (	File = library(chr)	% hacky
 	    ->	assert(mode(chr, Src))
 	    ;	true
@@ -857,30 +916,103 @@ process_use_module(File, Src) :-
 	;   true
 	).
 
-process_pce_import(Name/Arity, Src, Path) :-
+process_pce_import(Name/Arity, Src, Path, Reexport) :-
 	atom(Name),
 	integer(Arity), !,
 	functor(Term, Name, Arity),
 	(   \+ system_predicate(Term),
 	    \+ Term = pce_error(_) 	% hack!?
-	->  assert_import(Src, Name/Arity, Path)
+	->  assert_import(Src, [Name/Arity], _, Path, Reexport)
 	;   true
 	).
-process_pce_import(op(P,T,N), Src, _) :-
+process_pce_import(op(P,T,N), Src, _, _) :-
 	xref_push_op(Src, P, T, N).
 
 %%	xref_public_list(+File, -Path, -Public, +Src)
-%	
+%
-%	Find File as referenced from Src. Unify Path with the an
+%	Find File as  referenced  from  Src.   Unify  Path  with  the an
-%	absolute path to the referenced source and Public with a
+%	absolute path to the  referenced  source   and  Public  with the
-%	Name/Arity list holding all the public predicates exported from
+%	export list of that (module) file.   Exports are produced by the
-%	that (module) file.
+%	:- module/2 directive and all subsequent :- reexport directives.
 
 xref_public_list(File, Path, Public, Src) :-
+	xref_public_list(File, Path, Src, Public, []).
+
+xref_public_list(File, Path, Src, Public, Rest) :-
 	xref_source_file(File, Path, Src),
 	prolog_open_source(Path, Fd),		% skips possible #! line
-	call_cleanup(read(Fd, ModuleDecl), prolog_close_source(Fd)),
+	call_cleanup(read_public(Fd, Src, Public, Rest),
-	ModuleDecl = (:- module(_, Public)).
+		     prolog_close_source(Fd)).
+
+read_public(In, File, Public, Rest) :-
+	read(In, (:- module(_, Export))),
+	append(Export, Reexport, Public),
+	read(In, ReexportDecl),
+	read_reexport(ReexportDecl, In, File, Reexport, Rest).
+
+read_reexport((:- reexport(Spec)), In, File, Reexport, Rest) :- !,
+	reexport_files(Spec, File, Reexport, Rest0),
+	read(In, ReexportDecl),
+	read_reexport(ReexportDecl, In, File, Rest0, Rest).
+read_reexport((:- reexport(Spec, Import)), In, File, Reexport, Rest) :- !,
+	public_from_import(Import, Spec, File, Reexport, Rest0),
+	read(In, ReexportDecl),
+	read_reexport(ReexportDecl, In, File, Rest0, Rest).
+read_reexport(_, _, _, Rest, Rest).
+
+
+reexport_files([], _, Public, Public) :- !.
+reexport_files([H|T], Src, Public, Rest) :- !,
+	xref_public_list(H, _, Src, Public, Rest0),
+	reexport_files(T, Src, Rest0, Rest).
+reexport_files(Spec, Src, Public, Rest) :-
+	xref_public_list(Spec, Src, Public, Rest).
+
+public_from_import(except(Map), File, Src, Export, Rest) :- !,
+	xref_public_list(File, _, Public, Src),
+	except(Map, Public, Export, Rest).
+public_from_import(Import, _, _, Export, Rest) :-
+	import_name_map(Import, Export, Rest).
+
+
+except([], Public, Export, Rest) :-
+	append(Public, Rest, Export).
+except([PI0 as NewName|Map], Public, Export, Rest) :- !,
+	canonical_pi(PI0, PI),
+	map_as(Public, PI, NewName, Public2),
+	except(Map, Public2, Export, Rest).
+except([PI0|Map], Public, Export, Rest) :-
+	canonical_pi(PI0, PI),
+	select(PI2, Public, Public2),
+	same_pi(PI, PI2), !,
+	except(Map, Public2, Export, Rest).
+
+
+map_as([PI|T], Repl, As, [PI2|T])  :-
+	same_pi(Repl, PI), !,
+	pi_as(PI, As, PI2).
+map_as([H|T0], Repl, As, [H|T])  :-
+	map_as(T0, Repl, As, T).
+
+pi_as(_/Arity, Name, Name/Arity).
+pi_as(_//Arity, Name, Name//Arity).
+
+import_name_map([], L, L).
+import_name_map([_/Arity as NewName|T0], [NewName/Arity|T], Tail) :- !,
+	import_name_map(T0, T, Tail).
+import_name_map([_//Arity as NewName|T0], [NewName//Arity|T], Tail) :- !,
+	import_name_map(T0, T, Tail).
+import_name_map([H|T0], [H|T], Tail) :-
+	import_name_map(T0, T, Tail).
+
+canonical_pi(Name//Arity0, PI) :-
+	integer(Arity0), !,
+	PI = Name/Arity,
+	Arity is Arity0 + 2.
+canonical_pi(PI, PI).
+
+same_pi(Canonical, PI2) :-
+	canonical_pi(PI2, Canonical).
 
 
 		 /*******************************
@@ -906,7 +1038,7 @@ read_src_to_terms(File, Src, Terms) :-
 	prolog_open_source(Path, Fd),
 	call_cleanup(read_clauses(Fd, Terms),
 		     prolog_close_source(Fd)).
-	
+
 read_clauses(In, Terms) :-
 	read_clause(In, C0),
 	read_clauses(C0, In, Terms).
@@ -918,7 +1050,7 @@ read_clauses(Term, In, [Term|T]) :-
 
 
 %%	process_foreign(+Spec, +Src)
-%	
+%
 %	Process a load_foreign_library/1 call.
 
 process_foreign(Spec, Src) :-
@@ -1068,7 +1200,7 @@ assert_called(Src, Origin, Goal) :-
 	assert(called(Term, Src, OTerm)).
 
 %%	hide_called(:Callable)
-%	
+%
 %	Goals that should not turn up as being called. Hack. Eventually
 %	we should deal with that using an XPCE plugin.
 
@@ -1091,27 +1223,56 @@ assert_foreign(Src, Goal) :-
 	flag(xref_src_line, Line, Line),
 	assert(foreign(Term, Src, Line)).
 
-%%	assert_import(+Src, +ImportList, +From) is det.
+%%	assert_import(+Src, +Import, +PublicList, +From, +Reexport) is det.
-%%	assert_import(+Src, +ImportList, +PublicList, +From) is det.
+%
+%	Asserts imports into Src. Import   is  the import specification,
+%	PublicList is the list of known  public predicates or unbound if
+%	this need not be checked and  From   is  the file from which the
+%	public predicates come. If  Reexport   is  =true=, re-export the
+%	imported predicates.
+%
+%	@tbd	Tighter type-checking on Import.
 
-assert_import(Src, Import, From) :-
+assert_import(_, [], _, _, _) :- !.
-	assert_import(Src, Import, _, From).
+assert_import(Src, [H|T], Public, From, Reexport) :- !,
-
+	assert_import(Src, H, Public, From, Reexport),
-assert_import(_, [], _, _) :- !.
+	assert_import(Src, T, Public, From, Reexport).
-assert_import(Src, [H|T], Public, From) :- !,
+assert_import(Src, except(Except), Public, From, Reexport) :- !,
-	assert_import(Src, H, Public, From),
+	is_list(Public), !,
-	assert_import(Src, T, Public, From).
+	except(Except, Public, Import, []),
-assert_import(Src, Name/Arity, Public, From) :-
+	assert_import(Src, Import, _All, From, Reexport).
-	atom(Name), integer(Arity), !,
+assert_import(Src, Import as Name, Public, From, Reexport) :- !,
+	pi_to_head(Import, Term0),
+	functor(Term0, _OldName, Arity),
 	functor(Term, Name, Arity),
-	(   member(Name/Arity, Public)
+	(   in_public_list(Term0, Public)
-	->  assert(imported(Term, Src, From))
+	->  assert(imported(Term, Src, From)),
+	    assert_reexport(Reexport, Src, Term)
+	;   flag(xref_src_line, Line, Line),
+	    assert_called(Src, '<directive>'(Line), Term0)
+	).
+assert_import(Src, Import, Public, From, Reexport) :-
+	pi_to_head(Import, Term), !,
+	(   in_public_list(Term, Public)
+	->  assert(imported(Term, Src, From)),
+	    assert_reexport(Reexport, Src, Term)
 	;   flag(xref_src_line, Line, Line),
 	    assert_called(Src, '<directive>'(Line), Term)
 	).
-assert_import(Src, op(P,T,N), _, _) :-
+assert_import(Src, op(P,T,N), _, _, _) :-
 	xref_push_op(Src, P,T,N).
 
+in_public_list(_Head, Public) :-
+	var(Public), !.
+in_public_list(Head, Public) :-
+	member(Export, Public),
+	pi_to_head(Export, Head).
+
+assert_reexport(false, _, _) :- !.
+assert_reexport(true, Src, Term) :-
+	assert(exported(Term, Src)).
+
+
 %%	assert_op(+Src, +Op) is det.
 %
 %	@param Op	Ground term op(Priority, Type, Name).
@@ -1123,34 +1284,22 @@ assert_op(Src, op(P,T,_:N)) :-
 	).
 
 %%	assert_module(+Src, +Module)
-%	
+%
 %	Assert we are loading code into Module.  This is also used to
 %	exploit local term-expansion and other rules.
 
-assert_module(Src, $(Module)) :-	% deal with system modules
-	atom(Module), !,
-	atom_concat($, Module, Name),
-	assert_module(Src, Name).
 assert_module(Src, Module) :-
 	xmodule(Module, Src), !.
 assert_module(Src, Module) :-
 	'$set_source_module'(_, Module),
-	assert(xmodule(Module, Src)),
+	assert(xmodule(Module, Src)).
-	(   sub_atom(Module, 0, _, _, $)
-	->  style_check(+dollar)
-	;   true
-	).
 
 assert_export(_, []) :- !.
-assert_export(Src, [H|T]) :-
+assert_export(Src, [H|T]) :- !,
 	assert_export(Src, H),
 	assert_export(Src, T).
-assert_export(Src, Name0/Arity) :-
+assert_export(Src, PI) :-
-	(   Name0 = $(Hidden)		% deal with system modules
+	pi_to_head(PI, Term), !,
-	->  atom_concat($, Hidden, Name)
-	;   Name = Name0
-	),
-	functor(Term, Name, Arity),
 	assert(exported(Term, Src)).
 assert_export(Src, op(P, A, N)) :-
 	xref_push_op(Src, P, A, N).
@@ -1159,8 +1308,8 @@ assert_dynamic(Src, (A, B)) :- !,
 	assert_dynamic(Src, A),
 	assert_dynamic(Src, B).
 assert_dynamic(_, _M:_Name/_Arity) :- !. % not local
-assert_dynamic(Src, Name/Arity) :-
+assert_dynamic(Src, PI) :-
-	functor(Term, Name, Arity),
+	pi_to_head(PI, Term),
 	(   thread_local(Term, Src, _)	% dynamic after thread_local has
 	->  true			% no effect
 	;   flag(xref_src_line, Line, Line),
@@ -1171,8 +1320,8 @@ assert_thread_local(Src, (A, B)) :- !,
 	assert_thread_local(Src, A),
 	assert_thread_local(Src, B).
 assert_thread_local(_, _M:_Name/_Arity) :- !. % not local
-assert_thread_local(Src, Name/Arity) :-
+assert_thread_local(Src, PI) :-
-	functor(Term, Name, Arity),
+	pi_to_head(PI, Term),
 	flag(xref_src_line, Line, Line),
 	assert(thread_local(Term, Src, Line)).
 
@@ -1180,11 +1329,25 @@ assert_multifile(Src, (A, B)) :- !,
 	assert_multifile(Src, A),
 	assert_multifile(Src, B).
 assert_multifile(_, _M:_Name/_Arity) :- !. % not local
-assert_multifile(Src, Name/Arity) :-
+assert_multifile(Src, PI) :-
-	functor(Term, Name, Arity),
+	pi_to_head(PI, Term),
 	flag(xref_src_line, Line, Line),
 	assert(multifile(Term, Src, Line)).
 
+%%	pi_to_head(+PI, -Head) is semidet.
+%
+%	Translate Name/Arity or Name//Arity to a callable term. Fails if
+%	PI is not a predicate indicator.
+
+pi_to_head(Var, _) :-
+	var(Var), !, fail.
+pi_to_head(Name/Arity, Term) :-
+	functor(Term, Name, Arity).
+pi_to_head(Name//DCGArity, Term) :-
+	Arity is DCGArity+2,
+	functor(Term, Name, Arity).
+
+
 assert_used_class(Src, Name) :-
 	used_class(Name, Src), !.
 assert_used_class(Src, Name) :-
@@ -1220,7 +1383,7 @@ assert_defined_class(Src, Name, imported_from(File)) :-
 		********************************/
 
 %%	generalise(+Callable, -General)
-%	
+%
 %	Generalise a callable term.
 
 generalise(Var, Var) :-
@@ -1259,7 +1422,7 @@ hooking can be databases, (HTTP) URIs, etc.
 
 %%	xref_source_file(+Spec, -File, +Src) is semidet.
 %%	xref_source_file(+Spec, -File, +Src, +Options) is semidet.
-%	
+%
 %	Find named source file from Spec, relative to Src.
 
 xref_source_file(Plain, File, Source) :-
@@ -1273,7 +1436,7 @@ xref_source_file(Plain, File, Source, Options) :-
 	;   atom(Source),
 	    file_directory_name(Source, Dir)
 	),
-	concat_atom([Dir, /, Plain], Spec),
+	atomic_list_concat([Dir, /, Plain], Spec),
 	do_xref_source_file(Spec, File, Options), !.
 xref_source_file(Spec, File, _, Options) :-
 	do_xref_source_file(Spec, File, Options), !.

Makefile.in

@@ -98,7 +98,7 @@ YAPLIB=@YAPLIB@
 #4.1VPATH=@srcdir@:@srcdir@/OPTYap
 CWD=$(PWD)
 #
-VERSION=6.0.0
+VERSION=6.0.1
 MYDDAS_VERSION=MYDDAS-0.9.1
 #
 
@@ -219,7 +219,9 @@ PL_SOURCES= \
 	$(srcdir)/pl/directives.yap \
 	$(srcdir)/pl/eam.yap \
 	$(srcdir)/pl/eval.yap \
-	$(srcdir)/pl/errors.yap	$(srcdir)/pl/grammar.yap \
+	$(srcdir)/pl/errors.yap	\
+	$(srcdir)/pl/flags.yap	\
+	$(srcdir)/pl/grammar.yap \
 	$(srcdir)/pl/ground.yap \
 	$(srcdir)/pl/hacks.yap \
 	$(srcdir)/pl/init.yap \

docs/yap.tex

@@ -8,9 +8,9 @@ a\input texinfo @c -*- mode: texinfo; coding: latin-1; -*-
 @c @setchapternewpage odd
 @c %**end of header
 
-@set VERSION 6.0.0
+@set VERSION 6.0.1
-@set EDITION 4.2.5
+@set EDITION 4.2.6
-@set UPDATED June 2008
+@set UPDATED Feb 2010
 
 @c Index for C-Prolog compatible predicate
 @defindex cy
@@ -6395,6 +6395,7 @@ Grammar related built-in predicates:
 
 @table @code
 
+@item @var{CurrentModule}:expand_term(@var{T},-@var{X})
 @item user:expand_term(@var{T},-@var{X})
 @findex expand_term/2
 @syindex expand_term/2
@@ -6405,11 +6406,12 @@ Grammar related built-in predicates:
 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
+rules: first try @code{term_expansion/2}  in the current module, and then try to use the user defined predicate
 @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.
 
+@item @var{CurrentModule}:goal_expansion(+@var{G},+@var{M},-@var{NG})
 @item user:goal_expansion(+@var{G},+@var{M},-@var{NG})
 @findex goal_expansion/3
 @snindex goal_expansion/3
@@ -6544,7 +6546,7 @@ Execute a new shell.
 @snindex alarm/3
 @cnindex alarm/3
 Arranges for YAP to be interrupted in @var{Seconds} seconds, or in
-@var{Seconds.MicroSeconds}. When interrupted, YAP will execute
+@var{[Seconds|MicroSeconds]}. When interrupted, YAP will execute
 @var{Callable} and then return to the previous execution. If
 @var{Seconds} is @code{0}, no new alarm is scheduled. In any event,
 any previously set alarm is canceled.
@@ -7766,6 +7768,11 @@ procedures. If @code{on} compile predicates so that they will output
 profiling information. Profiling data can be read through the
 @code{profile_data/3} built-in.
 
+@item  prompt_alternatives_on(atom, changeable)
+@findex  prompt_alternatives_on  (yap_flag/2 option)
+SWI-Compatible opttion, determines prompting for alternatives in the Prolog toplevel. Default is @t{groundness}, YAP prompts for alternatives if and only if the query contains variables. The alternative, default in SWI-Prolog is @t{determinism} which implies the system prompts for alternatives if the goal succeeded while leaving choicepoints.
+
+
 @item redefine_warnings
 @findex discontiguous_warnings (yap_flag/2 option)
 @*
@@ -7936,6 +7943,11 @@ prompts from the system were redirected to the stream
 automatically redirects the @code{user_error} alias to the original
 @code{stderr}.
 
+@item user_flags
+@findex user_flags  (yap_flag/2 option)
+@*
+Define the behaviour of @code{set_prolog_flag/2} if the flag is not known. Values are @code{silent}, @code{warning} and @code{error}. The first two create the flag on-the-fly, with @code{warning} printing a message. The value @code{error} is consistent with ISO: it raises an existence error and does not create the flag. See also @code{create_prolog_flag/3}. The default is@code{error}, and developers are encouraged to use @code{create_prolog_flag/3} to create flags for their library.
+
 @item user_input
 @findex user_input (yap_flag/2 option)
 @*
@@ -8141,15 +8153,28 @@ Stream currently being read in.
 Stream position at the stream currently being read in.
 @end table
 
-
-@end table
-
 @item source_location(?@var{FileName}, ?@var{Line})
 @findex source_location/2
 @syindex source_location/2
 @cnindex source_location/2
 SWI-compatible predicate. If the last term has been read from a physical file (i.e., not from the file user or a string), unify File with an absolute path to the file and Line with the line-number in the file. Please use @code{prolog_load_context/2}.
 
+@item source_file(?@var{File})
+@findex source_file/1
+@syindex source_file/1
+@cnindex source_file/1
+SWI-compatible predicate. True if @var{File} is a loaded Prolog source file.
+
+@item source_file(?@var{ModuleAndPred},?@var{File})
+@findex source_file/2
+@syindex source_file/2
+@cnindex source_file/2
+SWI-compatible predicate. True if the predicate specified by @var{ModuleAndPred} was loaded from file @var{File}, where @var{File} is an absolute path name (see @code{absolute_file_name/2}).
+
+
+
+@end table
+
 @node Library, SWI-Prolog, Built-ins, Top
 
 @chapter Library Predicates

library/Makefile.in

@@ -34,7 +34,7 @@ PROGRAMS= \
 	$(srcdir)/bhash.yap \
 	$(srcdir)/charsio.yap \
 	$(srcdir)/cleanup.yap \
-	$(srcdir)/clpfd.pl \
+	$(srcdir)/clp/clpfd.pl \
 	$(srcdir)/dbqueues.yap \
 	$(srcdir)/dbusage.yap \
 	$(srcdir)/dgraphs.yap \

library/clp/clp_distinct.pl

@@ -0,0 +1,261 @@
+/*  $Id$
+
+    Part of SWI-Prolog
+
+    Author:        Markus Triska
+    E-mail:        triska@gmx.at
+    WWW:           http://www.swi-prolog.org
+    Copyright (C): 2005, Markus Triska
+
+    This program is free software; you can redistribute it and/or
+    modify it under the terms of the GNU General Public License
+    as published by the Free Software Foundation; either version 2
+    of the License, or (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+    As a special exception, if you link this library with other files,
+    compiled with a Free Software compiler, to produce an executable, this
+    library does not by itself cause the resulting executable to be covered
+    by the GNU General Public License. This exception does not however
+    invalidate any other reasons why the executable file might be covered by
+    the GNU General Public License.
+*/
+
+
+:- module(clp_distinct,
+	[
+		vars_in/2,
+		vars_in/3,
+		all_distinct/1
+	]).
+:- use_module(library(lists)).
+
+/** <module> Weak arc consistent all_distinct/1 constraint
+
+@deprecated	Superseded by library(clpfd)'s all_distinct/1.
+@author		Markus Triska
+*/
+
+% For details, see Neng-Fa Zhou, 2005:
+%      "Programming Finite-Domain Constraint Propagators in Action Rules"
+
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+This library uses the following arribute value:
+
+	dom_neq(Domain, Left, Right)
+
+Domain is an unbounded  (GMP)  integer   representing  the  domain  as a
+bit-vector, meaning N is in the domain iff 0 =\= Domain /\ (1<<N).
+
+Left and Right are both lists of lists of variables. Each of those lists
+corresponds to one all_distinct constraint the  variable is involved in,
+and "left" and "right" means literally which  variables are to the left,
+and which to the right in the first, second etc. of those constraints.
+
+all_distinct([A,B,C,D]), all_distinct([X,Y,C,F,E]) causes the following
+attributes for "C":
+
+	Left:  [[A,B],[X,Y]]
+	Right: [[D],[F,E]]
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+vars_in(Xs, From, To) :-
+	Bitvec is (1<<(To+1)) - (1<<From),
+	vars_in_(Xs, Bitvec).
+
+vars_in(Xs, Dom) :-
+	domain_bitvector(Dom, 0, Bitvec),
+	vars_in_(Xs, Bitvec).
+
+vars_in_([], _).
+vars_in_([V|Vs], Bitvec) :-
+	( var(V) ->
+		( get_attr(V, clp_distinct, dom_neq(VBV,VLeft,VRight)) ->
+			Bitvec1 is VBV /\ Bitvec,
+		  	Bitvec1 =\= 0,
+		        ( popcount(Bitvec1) =:= 1 ->
+				V is msb(Bitvec1)
+			;
+				put_attr(V, clp_distinct, dom_neq(Bitvec1,VLeft,VRight))
+			)
+		;
+			( popcount(Bitvec) =:= 1 ->
+				V is msb(Bitvec)
+			;
+				put_attr(V, clp_distinct, dom_neq(Bitvec, [], []))
+			)
+		)
+	;
+		0 =\= Bitvec /\ (1<<V)
+	),
+	vars_in_(Vs, Bitvec).
+
+domain_bitvector([], Bitvec, Bitvec).
+domain_bitvector([D|Ds], Bitvec0, Bitvec) :-
+	Bitvec1 is Bitvec0 \/ (1 << D),
+	domain_bitvector(Ds, Bitvec1, Bitvec).
+
+
+all_distinct(Ls) :-
+	all_distinct(Ls, []),
+	outof_reducer(Ls).
+
+outof_reducer([]).
+outof_reducer([X|Xs]) :-
+	( var(X) ->
+		get_attr(X, clp_distinct, dom_neq(Dom,Lefts,Rights)),
+		outof_reducer(Lefts, Rights, X, Dom)
+	;
+		true
+	),
+	outof_reducer(Xs).
+
+all_distinct([], _).
+all_distinct([X|Right], Left) :-
+	\+ list_contains(Right, X),
+	outof(X, Left, Right),
+	all_distinct(Right, [X|Left]).
+
+
+outof(X, Left, Right) :-
+	( var(X) ->
+		get_attr(X, clp_distinct, dom_neq(Dom, XLefts, XRights)),
+		put_attr(X, clp_distinct, dom_neq(Dom, [Left|XLefts], [Right|XRights]))
+	;
+		exclude_fire([Left], [Right], X)
+	).
+
+
+exclude_fire(Lefts, Rights, E) :-
+	Mask is \ ( 1 << E),
+	exclude_fire(Lefts, Rights, E, Mask).
+
+exclude_fire([], [], _, _).
+exclude_fire([Left|Ls], [Right|Rs], E, Mask) :-
+	exclude_list(Left, E, Mask),
+	exclude_list(Right, E, Mask),
+	exclude_fire(Ls, Rs, E, Mask).
+
+
+exclude_list([], _, _).
+exclude_list([V|Vs], Val, Mask) :-
+	( var(V) ->
+		get_attr(V, clp_distinct, dom_neq(VDom0,VLefts,VRights)),
+		VDom1 is VDom0 /\ Mask,
+		VDom1 =\= 0,
+		( popcount(VDom1) =:= 1 ->
+			V is msb(VDom1)
+		;
+			put_attr(V, clp_distinct, dom_neq(VDom1,VLefts,VRights))
+		)
+	;
+		V =\= Val
+	),
+	exclude_list(Vs, Val, Mask).
+
+attr_unify_hook(dom_neq(Dom,Lefts,Rights), Y) :-
+	( ground(Y) ->
+		Dom /\ (1 << Y) =\= 0,
+		exclude_fire(Lefts, Rights, Y)
+	;
+
+		\+ lists_contain(Lefts, Y),
+		\+ lists_contain(Rights, Y),
+		( get_attr(Y, clp_distinct, dom_neq(YDom0,YLefts0,YRights0)) ->
+			YDom1 is YDom0 /\ Dom,
+			YDom1 =\= 0,
+			( popcount(YDom1) =:= 1 ->
+				Y is msb(YDom1)
+			;
+				append(YLefts0, Lefts, YLefts1),
+				append(YRights0, Rights, YRights1),
+				put_attr(Y, clp_distinct, dom_neq(YDom1,YLefts1,YRights1))
+			)
+		;
+			put_attr(Y, clp_distinct, dom_neq(Dom,Lefts,Rights))
+		)
+	).
+
+lists_contain([X|Xs], Y) :-
+	( list_contains(X, Y) ->
+		true
+	;
+		lists_contain(Xs, Y)
+	).
+
+list_contains([X|Xs], Y) :-
+	( X == Y ->
+		true
+	;
+		list_contains(Xs, Y)
+	).
+
+
+outof_reducer([], [], _, _).
+outof_reducer([L|Ls], [R|Rs], Var, Dom) :-
+	append(L, R, Others),
+	N is popcount(Dom),
+	num_subsets(Others, Dom, 0, Num),
+	( Num >= N ->
+		fail
+	; Num =:= (N - 1) ->
+		reduce_from_others(Others, Dom)
+	;
+		true
+	),
+	outof_reducer(Ls, Rs, Var, Dom).
+
+
+reduce_from_others([], _).
+reduce_from_others([X|Xs], Dom) :-
+	( var(X) ->
+		get_attr(X, clp_distinct, dom_neq(XDom,XLeft,XRight)),
+		( is_subset(Dom, XDom) ->
+			true
+		;
+			NXDom is XDom /\ \Dom,
+			NXDom =\= 0,
+			( popcount(NXDom) =:= 1 ->
+				X is msb(NXDom)
+			;
+				put_attr(X, clp_distinct, dom_neq(NXDom,XLeft,XRight))
+			)
+		)
+	;
+		true
+	),
+	reduce_from_others(Xs, Dom).
+
+num_subsets([], _Dom, Num, Num).
+num_subsets([S|Ss], Dom, Num0, Num) :-
+	( var(S) ->
+		get_attr(S, clp_distinct, dom_neq(SDom,_,_)),
+		( is_subset(Dom, SDom) ->
+			Num1 is Num0 + 1
+		;
+			Num1 = Num0
+		)
+	;
+		Num1 = Num0
+	),
+	num_subsets(Ss, Dom, Num1, Num).
+
+
+   % true iff S is a subset of Dom - should be a GMP binding (subsumption)
+
+is_subset(Dom, S) :-
+	S \/ Dom =:= Dom.
+
+attr_portray_hook(dom_neq(Dom,_,_), _) :-
+	Max is msb(Dom),
+	Min is lsb(Dom),
+	write(Min-Max).

library/clp/clp_events.pl

@@ -0,0 +1,89 @@
+/*  $Id$
+
+    Part of SWI-Prolog
+
+    Author:        Tom Schrijvers
+    E-mail:        tom.schrijvers@cs.kuleuven.ac.be
+    WWW:           http://www.swi-prolog.org
+    Copyright (C): 2005, K.U.Leuven
+
+    This program is free software; you can redistribute it and/or
+    modify it under the terms of the GNU General Public License
+    as published by the Free Software Foundation; either version 2
+    of the License, or (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+    As a special exception, if you link this library with other files,
+    compiled with a Free Software compiler, to produce an executable, this
+    library does not by itself cause the resulting executable to be covered
+    by the GNU General Public License. This exception does not however
+    invalidate any other reasons why the executable file might be covered by
+    the GNU General Public License.
+*/
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Module for managing constraint solver events.
+%
+% Author: 	Tom Schrijvers
+% E-mail: 	tom.schrijvers@cs.kuleuven.ac.be
+% Copyright:	2005, K.U.Leuven
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+:-module(clp_events,
+	[
+		notify/2,
+		subscribe/4,
+		unsubscribe/2
+	]).
+
+notify(V,NMod) :-
+	( get_attr(V,clp_events,List) ->
+		notify_list(List,NMod)
+	;
+		true
+	).
+
+subscribe(V,NMod,SMod,Goal) :-
+	( get_attr(V,clp_events,List) ->
+		put_attr(V,clp_events,[entry(NMod,SMod,Goal)|List])
+	;
+	        put_attr(V,clp_events,[entry(NMod,SMod,Goal)])
+	).
+
+unsubscribe(V,SMod) :-
+	( get_attr(V,clp_events,List) ->
+		unsubscribe_list(List,SMod,NList),
+		put_attr(V,clp_events,NList)
+	;
+		true
+	).
+
+notify_list([],_).
+notify_list([entry(Mod,_,Goal)|Rest],NMod) :-
+	( Mod == NMod ->
+		call(Goal)
+	;
+		true
+	),
+	notify_list(Rest,NMod).
+
+unsubscribe_list([],_,_).
+unsubscribe_list([Entry|Rest],SMod,List) :-
+	Entry = entry(_,Mod,_),
+	( Mod == SMod ->
+		List = Rest
+	;
+		List = [Entry|Tail],
+		unsubscribe_list(Rest,SMod,Tail)
+	).
+
+attr_unify_hook(_,_).

library/dialect/swi.yap

@@ -13,6 +13,8 @@
 
 :- load_foreign_files([plstream], [], initIO).
 
+:- set_prolog_flag(user_flags,silent).
+
 :- ensure_loaded(library(atts)).
 
 :- use_module(library(charsio),[write_to_chars/2,read_from_chars/2]).
@@ -38,6 +40,7 @@
 :- use_module(library(system),
 	      [datime/1,
 	       mktime/2,
+	       file_property/2,
 	       sleep/1]).
 
 :- use_module(library(arg),
@@ -48,6 +51,7 @@
 
 :- use_module(library(terms),
 	      [subsumes/2,
+	       subsumes_chk/2,
 	       term_hash/2,
 	       unifiable/3,
 	       variant/2]).
@@ -96,6 +100,7 @@ swi_predicate_table(_,sublist(X,Y),lists,sublist(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(_,subsumes(X,Y),terms,subsumes(X,Y)).
+swi_predicate_table(_,subsumes_chk(X,Y),terms,subsumes_chk(X,Y)).
 swi_predicate_table(_,unifiable(X,Y,Z),terms,unifiable(X,Y,Z)).
 swi_predicate_table(_,cyclic_term(X),terms,cyclic_term(X)).
 swi_predicate_table(_,acyclic_term(X),terms,acyclic_term(X)).
@@ -352,7 +357,33 @@ prolog:'$set_source_module'(Source0, SourceF) :-
 	prolog_load_context(module, Source0),
 	module(SourceF).
 
+prolog:'$set_source_module'(Source0, SourceF) :-
+	current_module(Source0, SourceF).
+
 prolog:'$declare_module'(Name, Context, _, _, _) :-
 	add_import_module(Name, Context, start).
 
 prolog:'$set_predicate_attribute'(_, _, _).
+
+prolog:time_file(File, Time) :-
+	file_property(File, mod_time(Date)),
+	Time is Date*1.0.
+
+prolog:flag(Key, Old, New) :-
+	recorded(Key, Old, R), !,
+	(
+	 Old \== New
+	->
+	 erase(R),
+	 recorda(Key, New, _)
+	;
+	 true
+	).
+prolog:flag(Key, 0, New) :-
+	functor(Key, N, Ar),
+	functor(K, N, Ar),
+	assert(swi:flag(K)),
+	recorda(K, New, _).
+
+prolog:current_flag(Key) :-
+	swi:flag(Key).

misc/Yap.spec

@@ -3,10 +3,10 @@
 
 Name: Yap
 Summary: Prolog Compiler
-Version: 6.0.0
+Version: 6.0.1
 Packager: Vitor Santos Costa <vitor@cos.ufrj.br>
 Release: 1
-Source: http://www.ncc.up.pt/~vsc/Yap/%{name}-%{version}.tar.gz
+Source: http://www.dcc.fc.up.pt/~vsc/Yap/%{name}-%{version}.tar.gz
 License: Perl Artistic License
 Provides: yap
 Requires: readline

misc/yap.nsi

@@ -268,4 +268,4 @@ Function .onInstFailed
 		    installer, please contact yap-users@sf.net"
 FunctionEnd
 
-outfile "yap-6.0.0-installer.exe"
+outfile "yap-6.0.1-installer.exe"

pl/boot.yap

@@ -65,17 +65,12 @@ true :- true.
 	'$stream_representation_error'(user_output, 512),
 	'$stream_representation_error'(user_error, 512),
 	'$enter_system_mode',
+	'$init_globals',
 	set_value(fileerrors,1),
-	'$init_consult',
 	set_value('$gc',on),
 	('$exit_undefp' -> true ; true),
 	prompt('  ?- '),
-	nb_setval('$break',0),
-	% '$set_read_error_handler'(error), let the user do that
-	nb_setval('$open_expands_filename',true),
 	'$debug_on'(false),
-	nb_setval('$trace',off),
-	b_setval('$spy_glist',[]),
 	% simple trick to find out if this is we are booting from Prolog.
 	get_value('$user_module',V),
 	(
@@ -99,6 +94,17 @@ true :- true.
 	'$init_or_threads',
 	'$run_at_thread_start'.
 
+
+'$init_globals' :-
+	'$init_consult',
+	nb_setval('$break',0),
+	% '$set_read_error_handler'(error), let the user do that
+	nb_setval('$open_expands_filename',true),
+	nb_setval('$trace',off),
+	nb_setval('$assert_all',off),
+	nb_setval('$if_skip_mode',no_skip),
+	b_setval('$spy_glist',[]).
+
 '$init_consult' :-
 	nb_setval('$lf_verbose',informational),
 	nb_setval('$if_level',0),
@@ -475,7 +481,9 @@ true :- true.
 	X == '$', !,
 	( recorded('$reconsulting',_,R) -> erase(R) ).
 
- /* Executing a query */
+'$prompt_alternatives_on'(groundness).
+
+/* Executing a query */
 
 '$query'(end_of_file,_).
 
@@ -493,21 +501,31 @@ true :- true.
 
  % end of YAPOR
 
- '$query'(G,[]) :- !,
+ '$query'(G,[]) :-
+	 '$prompt_alternatives_on'(groundness), !,
 	 '$yes_no'(G,(?-)).
  '$query'(G,V) :-
 	 (
 	   '$exit_system_mode',
+	  yap_hacks:current_choice_point(CP),
 	   '$execute'(G),
-	   ( '$enter_system_mode' ; '$exit_system_mode', fail),
+	  yap_hacks:current_choice_point(NCP),
-	   '$output_frozen'(G, V, LGs),
+	  ( '$enter_system_mode' ; '$exit_system_mode', fail),
-	   '$write_answer'(V, LGs, Written),
+	  '$output_frozen'(G, V, LGs),
-	   '$write_query_answer_true'(Written),
+	  '$write_answer'(V, LGs, Written),
+	  '$write_query_answer_true'(Written),
+	  (
+	   '$prompt_alternatives_on'(determinism), CP = NCP ->
+	   nl(user_error),
+	   !
+	  ;
 	   '$another',
-	   !, fail
+	   !
+	  ),
+	  fail	 
 	 ;
-	   '$enter_system_mode',
+	  '$enter_system_mode',
-           '$out_neg_answer'
+	  '$out_neg_answer'
 	 ).
 
  '$yes_no'(G,C) :-
@@ -921,8 +939,6 @@ not(G) :-    \+ '$execute'(G).
 '$check_callable'(_,_).
 
 % Called by the abstract machine, if no clauses exist for a predicate
-'$undefp'([M|expand_goal(G,GEx)]) :- !,
-	G = GEx.
 '$undefp'([M|G]) :-
 	% make sure we do not loop on undefined predicates
         % for undefined_predicates.
@@ -993,7 +1009,7 @@ break :-
 	nb_setval('$system_mode',SystemMode).
 
 '$silent_bootstrap'(F) :-
-	'$init_consult',
+	'$init_globals',
 	nb_setval('$if_level',0),
 	nb_getval('$lf_verbose',OldSilent),
 	nb_setval('$lf_verbose',silent),
@@ -1113,12 +1129,14 @@ access_file(F,Mode) :-
 	
 
 expand_term(Term,Expanded) :-
-	( \+ '$undefined'(term_expansion(_,_), user),
+	( '$current_module'(Mod), \+ '$undefined'(term_expansion(_,_), Mod),
+	  '$notrace'(Mod:term_expansion(Term,Expanded))
+        ; \+ '$undefined'(term_expansion(_,_), user),
 	  '$notrace'(user:term_expansion(Term,Expanded))
         ;
 	  '$expand_term_grammar'(Term,Expanded)
 	),
-!.
+	!.
 
 
 %

pl/checker.yap

@@ -217,6 +217,10 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
 '$multifile'((X,Y), M) :- !, '$multifile'(X, M), '$multifile'(Y, M).
 '$multifile'(Mod:PredSpec, _) :- !,
 	'$multifile'(PredSpec, Mod).
+'$multifile'(N//A, M) :- !,
+	integer(A),
+	A1 is A+2,
+	'$multifile'(N/A1, M).
 '$multifile'(N/A, M) :-
 	'$add_multifile'(N,A,M),
 	fail.
@@ -247,6 +251,10 @@ discontiguous(F) :-
 	'$discontiguous'(Y,M).
 '$discontiguous'(M:A,_) :- !,
 	'$discontiguous'(A,M).
+'$discontiguous'(N//A1, M) :- !,
+	integer(A1), !,
+	A is A1+2,
+	'$discontiguous'(N/A, M).
 '$discontiguous'(N/A, M) :- !,
 	( recordzifnot('$discontiguous_defs','$df'(N,A,M),_) ->
 	    true

pl/consult.yap

@@ -425,6 +425,23 @@ use_module(M,F,Is) :-
 '$skip_unix_comments'(_).
 
 
+source_file(FileName) :-
+	recorded('$lf_loaded','$lf_loaded'(FileName,Mod,_,_),_), Mod \= prolog.
+
+source_file(Mod:Pred, FileName) :-
+	current_module(Mod),
+	Mod \= prolog,
+	'$current_predicate_no_modules'(Mod,_,Pred),
+	'$owned_by'(Pred, Mod, FileName).
+
+'$owned_by'(T, Mod, FileName) :-
+	'$is_multifile'(T, Mod),
+	functor(T, Name, Arity),
+	setof(FileName, Ref^recorded('$multifile_defs','$defined'(FileName,Name,Arity,Mod), Ref), L),
+	lists:member(FileName, L).
+'$owned_by'(T, Mod, FileName) :-
+	'$owner_file'(T, Mod, FileName).
+
 source_location(FileName, Line) :-
 	prolog_load_context(file, FileName),
 	prolog_load_context(term_position,'$stream_position'(_, Line, _, _, _)).

pl/init.yap

@@ -45,7 +45,8 @@ otherwise.
 :- [	 'utils.yap',
 	 'control.yap',
 	 'arith.yap',
-	 'directives.yap'].
+	 'directives.yap',
+	 'flags.yap'].
 
 :- compile_expressions.
 

pl/messages.yap

@@ -127,6 +127,8 @@ system_message(no_match(P)) -->
 	[ 'No matching predicate for ~w.' - [P] ].
 system_message(leash([A|B])) -->
 	[ 'Leashing set to ~w.' - [[A|B]] ].
+system_message(existence_error(prolog_flag,F)) -->
+	[ 'Prolog Flag ~w: new Prolog flags must be created using create_prolog_flag/3.' - [F] ].
 system_message(singletons([SV],P,CLN)) -->
 	[ 'Singleton variable ~s in ~q, clause ~d.' - [SV,P,CLN] ].
 system_message(singletons(SVs,P,CLN)) -->
@@ -154,6 +156,8 @@ system_message(error(context_error(Goal,Who),Where)) -->
 system_message(error(domain_error(DomainType,Opt), Where)) -->
 	[ 'DOMAIN ERROR- ~w: ' - Where],
 	domain_error(DomainType, Opt).
+system_message(error(existence_error(prolog_flag,P), Where)) --> !,
+	[ 'EXISTENCE ERROR- ~w: prolog flag ~w is undefined' - [Where,P] ].
 system_message(error(existence_error(procedure,P), context(Call,Parent))) --> !,
 	[ 'EXISTENCE ERROR- procedure ~w is undefined, called from context  ~w~n                 Goal was ~w' - [P,Parent,Call] ].
 system_message(error(existence_error(stream,Stream), Where)) -->
@@ -162,6 +166,8 @@ system_message(error(existence_error(key,Key), Where)) -->
 	[ 'EXISTENCE ERROR- ~w: ~w not an existing key' - [Where,Key] ].
 system_message(error(existence_error(thread,Thread), Where)) -->
 	[ 'EXISTENCE ERROR- ~w: ~w not a running thread' - [Where,Thread] ].
+system_message(error(existence_error(variable,Var), Where)) -->
+	[ 'EXISTENCE ERROR- ~w: variable ~w does not exist' - [Where,Var] ].
 system_message(error(existence_error(Name,F), W)) -->
 	{ object_name(Name, ObjName) },
 	[ 'EXISTENCE ERROR- ~w could not open ~a ~w' - [W,ObjName,F] ].

pl/modules.yap

@@ -297,6 +297,27 @@ module(N) :-
 '$module_expansion'(M:G,G1,GO,_,CM,_,HVars) :- !,
 	'$module_expansion'(G,G1,GO,M,M,HM,HVars).
 '$module_expansion'(G, G1, GO, CurMod, MM, HM, HVars) :-
+	'$do_expand'(CurMod:G, CurMod:GI), !,
+	'$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, 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).
+
+expand_goal(G, NG) :-
+	'$current_module'(Mod),
+	'$do_expand'(G, M, NG), !.
+expand_goal(M:G, M:NG) :-
+	'$do_expand'(G, M, NG), !.
+expand_goal(G, G).
+	
+'$do_expand'(G, CurMod, NG) :-
 	'$pred_goal_expansion_on',
 	( user:goal_expansion(G, CurMod, GI)
 	->
@@ -309,18 +330,7 @@ module(N) :-
 	  )
 	;
 	  user:goal_expansion(G, GI)
-	), !,
+	).
-	'$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, 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

pl/preds.yap

@@ -525,6 +525,11 @@ abolish(X) :-
 	'$abolish_all_atoms'(A,M).
 '$new_abolish'(M:PS,_) :- !,
 	'$new_abolish'(PS,M).
+'$new_abolish'(Na//Ar1, M) :-
+	integer(Ar1),
+	!,
+	Ar is Ar1+2,
+	'$new_abolish'(Na//Ar, M).
 '$new_abolish'(Na/Ar, M) :-
 	functor(H, Na, Ar),
 	'$is_dynamic'(H, M), !,
@@ -556,7 +561,8 @@ abolish(X) :-
 	'$check_error_in_module'(M, Msg),
 	'$check_error_in_predicate_indicator'(S, Msg).
 '$check_error_in_predicate_indicator'(S, Msg) :-
-	S \= _/_, !,
+	S \= _/_,
+	S \= _//_, !,
 	'$do_error'(type_error(predicate_indicator,S), Msg).
 '$check_error_in_predicate_indicator'(Na/_, Msg) :-
 	var(Na), !,
@@ -685,6 +691,10 @@ dynamic(X) :-
 
 '$dynamic2'(X, Mod) :- '$log_upd'(Stat), Stat\=0, !,
 	'$logical_updatable'(X, Mod).
+'$dynamic2'(A//N1, Mod) :-
+	integer(N1),
+	N is N1+2,
+	'$dynamic2'(A/N, Mod).
 '$dynamic2'(A/N, Mod) :-
 	integer(N), atom(A), !,
 	functor(T,A,N), '$flags'(T,Mod,F,F),
@@ -699,6 +709,9 @@ dynamic(X) :-
 	'$do_error'(type_error(callable,X),dynamic(Mod:X)).
 
 
+'$logical_updatable'(A//N,Mod) :- integer(N), !,
+	N1 is N+2,
+	'$logical_updatable'(A/N1,Mod).
 '$logical_updatable'(A/N,Mod) :- integer(N), atom(A), !,
 	functor(T,A,N), '$flags'(T,Mod,F,F),
 	(
@@ -747,6 +760,9 @@ dynamic_predicate(P,Sem) :-
 '$public'((A,B), M) :- !, '$public'(A,M), '$public'(B,M).
 '$public'([],_) :- !.
 '$public'([H|L], M) :- !, '$public'(H, M), '$public'(L, M).
+'$public'(A//N1, Mod) :- integer(N1), !,
+	N is N1+2,
+	'$public'(A//N, Mod).
 '$public'(A/N, Mod) :- integer(N), atom(A), !,
 	functor(T,A,N),
 	'$do_make_public'(T, Mod).

pl/signals.yap

@@ -249,6 +249,12 @@ alarm(Interval, Goal, Left) :-
 	integer(Interval), !,
 	on_signal(sig_alarm, _, Goal),
 	'$alarm'(Interval, 0, Left, _).
+alarm(Number, Goal, Left) :-
+	float(Number), !,
+	Secs is integer(Number),
+	USecs is integer((Number-Secs)*1000000) mod 1000000,
+	on_signal(sig_alarm, _, Goal),
+	'$alarm'(Interval, 0, Left, _).
 alarm(Interval.USecs, Goal, Left.LUSecs) :-
 	on_signal(sig_alarm, _, Goal),
 	'$alarm'(Interval, USecs, Left, LUSecs).