improve JT

fix graph compatibility with SICStus
re-export declaration.


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

C/adtdefs.c

@@ -1169,4 +1169,60 @@ Yap_PutInSlot(long slot, Term t)
   LCL0[slot] = t;
 }
 
+HoldEntry *
+Yap_InitAtomHold(void)
+{
+  HoldEntry *x = (HoldEntry *)Yap_AllocAtomSpace(sizeof(struct hold_entry));
+  x->KindOfPE = HoldProperty;
+  x->NextOfPE = NIL;
+  return x;
+}
 
+int
+Yap_AtomGetHold(Atom at)
+{
+  AtomEntry *ae = RepAtom(at);
+  PropEntry *pp, *opp = NULL;
+
+  WRITE_LOCK(ae->ARWLock);
+  pp = RepProp(ae->PropsOfAE);
+  while (!EndOfPAEntr(pp)) {
+    pp = RepProp(pp->NextOfPE);
+    opp = pp;
+  }
+  if (!pp) {
+    ae->PropsOfAE = AbsHoldProp(GlobalHoldEntry);
+  } else if (opp->KindOfPE != HoldProperty) {
+    opp->NextOfPE = AbsHoldProp(GlobalHoldEntry);
+  } else {
+    WRITE_UNLOCK(ae->ARWLock);
+    return FALSE;
+  }
+  WRITE_UNLOCK(ae->ARWLock);
+  return TRUE;
+}
+
+int
+Yap_AtomReleaseHold(Atom at)
+{
+  AtomEntry *ae = RepAtom(at);
+  PropEntry *pp, *opp = NULL;
+
+  WRITE_LOCK(ae->ARWLock);
+  pp = RepProp(ae->PropsOfAE);
+  while (!EndOfPAEntr(pp)) {
+    if (pp->KindOfPE == HoldProperty) {
+      if (!opp) {
+	ae->PropsOfAE = NIL;
+      } else {
+	opp->NextOfPE = NIL;
+      }
+      WRITE_UNLOCK(ae->ARWLock);
+      return TRUE;
+    }
+    pp = RepProp(pp->NextOfPE);
+    opp = pp;
+  }
+  WRITE_UNLOCK(ae->ARWLock);
+  return FALSE;
+}

C/agc.c

@@ -153,6 +153,7 @@ AtomAdjust(Atom a)
 #define TrailAddrAdjust(P) (P)
 #define XAdjust(P) (P)
 #define YAdjust(P) (P)
+#define HoldEntryAdjust(P) (P)
 
 static void
 recompute_mask(DBRef dbr)

C/c_interface.c

@@ -10,8 +10,11 @@
 * File:		c_interface.c						 *
 * comments:	c_interface primitives definition 			 *
 *									 *
-* Last rev:	$Date: 2007-11-16 14:58:40 $,$Author: vsc $						 *
+* Last rev:	$Date: 2007-12-05 12:17:23 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.103  2007/11/16 14:58:40  vsc
+* implement sophisticated operations with matrices.
+*
 * Revision 1.102  2007/11/01 20:50:31  vsc
 * fix YAP_LeaveGoal (again)
 *
@@ -412,6 +415,8 @@ X_API int      STD_PROTO(YAP_ThreadDestroyEngine,(int));
 X_API Term     STD_PROTO(YAP_MkBlobTerm,(unsigned int));
 X_API void    *STD_PROTO(YAP_BlobOfTerm,(Term));
 X_API Term     STD_PROTO(YAP_TermNil,(void));
+X_API int      STD_PROTO(YAP_AtomGetHold,(Atom));
+X_API int      STD_PROTO(YAP_AtomReleaseHold,(Atom));
 
 static int (*do_getf)(void);
 
@@ -452,7 +457,7 @@ doexpand(UInt sz)
   } else {
     arity = 0;
   }
-  if (!Yap_gcl(sz, arity, ENV, CP)) {
+  if (!Yap_gcl(sz, arity, ENV, P)) {
     return FALSE;
   }
   return TRUE;
@@ -2061,3 +2066,21 @@ YAP_TermNil(void)
   return TermNil;
 } 
 
+X_API int
+YAP_AtomGetHold(Atom at)
+{
+  return Yap_AtomGetHold(at);
+} 
+
+X_API int
+YAP_AtomReleaseHold(Atom at)
+{
+  return Yap_AtomReleaseHold(at);
+} 
+
+X_API void
+YAP_AGCRegisterHook(Agc_hook hook)
+{
+   AGCHook = hook;
+} 
+

C/init.c

@@ -391,6 +391,7 @@ static Opdef    Ops[] = {
   {">", xfx, 700},
   {"=<", xfx, 700},
   {">=", xfx, 700},
+  {"as", xfx, 600},
   {":", xfy, 600},
   {"+", yfx, 500},
   {"-", yfx, 500},
@@ -1231,6 +1232,7 @@ InitCodes(void)
   Yap_heap_regs->agc_threshold = 10000;
   Yap_heap_regs->agc_hook = NULL;
   Yap_heap_regs->parser_error_style = EXCEPTION_ON_PARSER_ERROR;
+  Yap_heap_regs->global_hold_entry = Yap_InitAtomHold();
   Yap_heap_regs->size_of_overflow  = 0;
   /* make sure no one else can use these two atoms */
   CurrentModule = 0;

C/tracer.c

@@ -58,7 +58,7 @@ send_tracer_message(char *start, char *name, Int arity, char *mname, CELL *args)
       if (i > 0) fprintf(Yap_stderr, ",");
 #if DEBUG
 #if COROUTINING
-      Yap_Portray_delays = TRUE;
+      Yap_Portray_delays = FALSE;
 #endif
 #endif
   omax_depth = max_depth;

CLPBN/clpbn/bnt.yap

@@ -164,9 +164,9 @@ get_tied(More,_,Vs,Vs,Ns,Ns,Es,Es,More).
 
 tied_graph(TVars,Graph,Vertices) :-
 	dgraph_new(Graph0),
-	dgraph_add_vertices(Vertices, Graph0, Graph1),
+	dgraph_add_vertices(Graph0, Vertices, Graph1),
 	get_tied_edges(TVars,Edges),
-	dgraph_add_edges(Edges, Graph1, Graph).
+	dgraph_add_edges(Graph1, Edges, Graph).
 
 get_tied_edges([],[]).
 get_tied_edges([N-g(_,Vs,_)|TGraph],Edges) :-
@@ -192,9 +192,9 @@ distribute_tied([V|Vs],I0,In,[V|NVs],NVs0) :-
 
 extract_graph(AllVars, Graph) :-
 	dgraph_new(Graph0),
-	dgraph_add_vertices(AllVars, Graph0, Graph1),
+	dgraph_add_vertices(Graph0, AllVars, Graph1),
 	get_edges(AllVars,Edges),
-	dgraph_add_edges(Edges, Graph1, Graph).
+	dgraph_add_edges(Graph1, Edges, Graph).
 	
 get_edges([],[]).
 get_edges([V|AllVars],Edges) :-

CLPBN/clpbn/dists.yap

@@ -17,7 +17,9 @@
 
 :- use_module(library(lists),[is_list/1]).
 
-:- use_module(library(matrix),[matrix_new/4]).
+:- use_module(library(matrix),
+	      [matrix_new/4,
+	       matrix_to_logs/1]).
 
 
 /*
@@ -152,7 +154,8 @@ get_dist(Id, Type, Domain, Tab) :-
 get_dist_matrix(Id, Parents, Type, Domain, Mat) :-
 	recorded(clpbn_dist_db, db(Id, Tab, Type, Domain, _, DomainSize), _),
 	get_dsizes(Parents, Sizes, []),
-	matrix_new(floats, [DomainSize|Sizes], Tab, Mat).
+	matrix_new(floats, [DomainSize|Sizes], Tab, Mat),
+	matrix_to_logs(Mat).
 
 get_dsizes([], Sizes, Sizes).
 get_dsizes([P|Parents], [Sz|Sizes], Sizes0) :-

CLPBN/clpbn/jt.yap

@@ -76,6 +76,7 @@ jt(LVs,Vs0,AllDiffs) :-
 	% JTree is a dgraph
 	% now our tree has cpts
 	fill_with_cpts(JTree, NewTree),
+%	write_tree(NewTree,0),
 	propagate_evidence(Evidence, NewTree, EvTree),
 	message_passing(EvTree, MTree),
 	get_margin(MTree, LVs, LPs),
@@ -85,8 +86,8 @@ jt(LVs,Vs0,AllDiffs) :-
 get_graph(LVs, BayesNet, CPTs, Evidence) :-
 	run_vars(LVs, Edges, Vertices, CPTs, Evidence),
 	dgraph_new(V0),
-	dgraph_add_edges(Edges, V0, V1),
+	dgraph_add_edges(V0, Edges, V1),
-	dgraph_add_vertices(Vertices, V1, V2),
+	dgraph_add_vertices(V1, Vertices, V2),
 	dgraph_to_ugraph(V2, BayesNet).
 
 run_vars([], [], [], [], []).
@@ -125,7 +126,7 @@ build_jt(BayesNet, CPTs, Tree) :-
 initial_graph(_,Parents, CPTs) :-
 	test_graph(0, Graph0, CPTs),
 	dgraph_new(V0),
-	dgraph_add_edges(Graph0, V0, V1),
+	dgraph_add_edges(V0, Graph0, V1),
 	% OK, this is a bit silly, I could have written the transposed graph
 	% from the very beginning.
 	dgraph_transpose(V1, V2),
@@ -180,7 +181,7 @@ moralised([_-KPars|Ks],Moral0,MoralF) :-
 add_moral_edges([], Moral, Moral).
 add_moral_edges([_], Moral, Moral).
 add_moral_edges([K1,K2|KPars], Moral0, MoralF) :-
-	undgraph_add_edge(K1,K2,Moral0,MoralI),
+	undgraph_add_edge(Moral0, K1, K2, MoralI),
 	add_moral_edges([K1|KPars], MoralI, MoralJ),
 	add_moral_edges([K2|KPars],MoralJ,MoralF).
 
@@ -188,9 +189,9 @@ triangulate([], _, Triangulated, Triangulated, []) :- !.
 triangulate(Vertices, S0, T0, Tf, Cliques) :-
 	choose(Vertices, S0, +inf, [], -1, BestVertex, _, Cliques0, Cliques, Edges),
 	ord_del_element(Vertices, BestVertex, NextVertices),
-	undgraph_add_edges(Edges, T0, T1),
+	undgraph_add_edges(T0, Edges, T1),
-	undgraph_del_vertex(BestVertex, S0, Si),
+	undgraph_del_vertex(S0, BestVertex, Si),
-	undgraph_add_edges(Edges, Si, Si2),
+	undgraph_add_edges(Si, Edges, Si2),
 	triangulate(NextVertices, Si2, T1, Tf, Cliques0).
 
 choose([], _, _, NewEdges, Best, Best, Clique, Cliques0, [Clique|Cliques0], NewEdges).
@@ -208,6 +209,7 @@ choose([V|Vertices], Graph, Score0, _, _, Best, _, Cliques0, Cliques, EdgesF) :-
 	   length(PossibleClique,L),
 	   Cliques = [L-PossibleClique|Cliques0]
 	;
+%	   cliquelength(PossibleClique,1,CL),
 	 length(PossibleClique,CL),
 	   CL < Score0, !,
 	   choose(Vertices,Graph,CL,NewEdges, V, Best, CL-PossibleClique, Cliques0,Cliques,EdgesF)
@@ -227,6 +229,12 @@ new_edges([N1|Neighbors],N,Graph,NewEdges0, NewEdgesF) :-
 new_edges([N1|Neighbors],N,Graph,NewEdges0, [N-N1|NewEdgesF]) :-
 	new_edges(Neighbors,N,Graph,NewEdges0, NewEdgesF).
 
+cliquelength([],CL,CL).
+cliquelength([V|Vs],CL0,CL) :-
+	clpbn:get_atts(V, [dist(Id,_)]),
+	get_dist_domain_size(Id, Sz),
+	CL1 is CL0*Sz,
+	cliquelength(Vs,CL1,CL).
 
 
 %
@@ -239,8 +247,8 @@ cliques(CliqueList, CliquesF) :-
 	keysort(CliqueList,Sort),
 	reverse(Sort, Rev),
 	get_links(Rev, [], Vertices, [], Edges),
-	wundgraph_add_vertices(Vertices, Cliques0, CliquesI),
+	wundgraph_add_vertices(Cliques0, Vertices, CliquesI),
-	wundgraph_add_edges(Edges, CliquesI, CliquesF).
+	wundgraph_add_edges(CliquesI, Edges, CliquesF).
 
 % stupid quadratic algorithm, needs to be improved.
 get_links([], Vertices, Vertices, Edges, Edges).
@@ -276,7 +284,7 @@ remove_leaves(Tree, SmallerTree) :-
 	Vertices = [_,_,_|_],
 	get_leaves(Vertices, Tree, Leaves),
 	Leaves = [_|_], !,
-	undgraph_del_vertices(Leaves, Tree, NTree),
+	undgraph_del_vertices(Tree, Leaves, NTree),
 	remove_leaves(NTree, SmallerTree).
 remove_leaves(Tree, Tree).
 
@@ -424,21 +432,24 @@ add_evidence_to_kids([K|Kids], V, P, [K|NNKids]) :-
 
 message_passing(tree(Clique-Dist,Kids), tree(Clique-NDist,NKids)) :-
 	get_CPT_sizes(Dist, Sizes),
-	upward(Kids, Clique, tab(Dist, Clique, Sizes), IKids, ITab),
+	upward(Kids, Clique, tab(Dist, Clique, Sizes), IKids, ITab, 1),
 	ITab = tab(NDist, _, _),
+	nb_setval(cnt,0),
 	downward(IKids, Clique, ITab, NKids).
 
-upward([], _, Dist, [], Dist).
+upward([], _, Dist, [], Dist, _).
-upward([tree(Clique1-Dist1,DistKids)|Kids], Clique, Tab, [tree(Clique1-(NewDist1,EDist1),NDistKids)|Kids], NewTab) :-
+upward([tree(Clique1-Dist1,DistKids)|Kids], Clique, Tab, [tree(Clique1-(NewDist1,EDist1),NDistKids)|NKids], NewTab, Lev) :-
 	get_CPT_sizes(Dist1, Sizes1),
-	upward(DistKids, Clique1, tab(Dist1,Clique1,Sizes1), NDistKids, NewTab1),
+	Lev1 is Lev+1,
+	upward(DistKids, Clique1, tab(Dist1,Clique1,Sizes1), NDistKids, NewTab1, Lev1),
 	NewTab1 = tab(NewDist1,_,_),
 	ord_intersection(Clique1, Clique, Int),
 	sum_out_from_CPT(Int, NewDist1, Clique1, Tab1),
-	multiply_CPTs(Tab, Tab1, NewTab, EDist1).
+	multiply_CPTs(Tab, Tab1, ITab, EDist1),
+	upward(Kids, Clique, ITab, NKids, NewTab, Lev).
 
 downward([], _, _, []).
-downward([tree(Clique1-(Dist1,Msg1),DistKids)|Kids], Clique, Tab, [tree(Clique1-NDist1,NDistKids)|Kids]) :-
+downward([tree(Clique1-(Dist1,Msg1),DistKids)|Kids], Clique, Tab, [tree(Clique1-NDist1,NDistKids)|NKids]) :-
 	get_CPT_sizes(Dist1, Sizes1),
 	ord_intersection(Clique1, Clique, Int),
 	Tab = tab(Dist,_,_),
@@ -446,7 +457,8 @@ downward([tree(Clique1-(Dist1,Msg1),DistKids)|Kids], Clique, Tab, [tree(Clique1-
 	sum_out_from_CPT(Int, Div, Clique, STab),
 	multiply_CPTs(STab, tab(Dist1, Clique1, Sizes1), NewTab, _),
 	NewTab = tab(NDist1,_,_),
-	downward(DistKids, Clique1, NewTab, NDistKids).
+	downward(DistKids, Clique1, NewTab, NDistKids),
+	downward(Kids, Clique, Tab, NKids).
 
 
 get_margin(NewTree, LVs0, LPs) :-
@@ -467,3 +479,20 @@ find_clique_from_kids([K|_], LVs, Clique, Dist) :-
 find_clique_from_kids([_|Kids], LVs, Clique, Dist) :-
 	find_clique_from_kids(Kids, LVs, Clique, Dist).
 
+
+write_tree(tree(Clique-(Dist,_),Leaves), I0) :- !,
+	matrix:matrix_to_list(Dist,L),
+	format('~*c ~w:~w~n',[I0,0' ,Clique,L]),
+	I is I0+2,
+	write_subtree(Leaves, I).
+write_tree(tree(Clique-Dist,Leaves), I0) :-
+	matrix:matrix_to_list(Dist,L),
+	format('~*c ~w:~w~n',[I0,0' ,Clique, L]),
+	I is I0+2,
+	write_subtree(Leaves, I).
+
+write_subtree([], _).
+write_subtree([Tree|Leaves], I) :-
+	write_tree(Tree, I),
+	write_subtree(Leaves, I).
+

CLPBN/clpbn/matrix_cpt_utils.yap

@@ -26,16 +26,19 @@
 	       matrix_op/4,
 	       matrix_dims/2,
 	       matrix_sum/2,
-	       matrix_sum_out/3,
+	       matrix_sum_logs_out/3,
-	       matrix_sum_out_several/3,
+	       matrix_sum_logs_out_several/3,
 	       matrix_op_to_all/4,
+	       matrix_to_exps/1,
+	       matrix_to_logs/1,
 	       matrix_set_all_that_disagree/5,
 	       matrix_to_list/2]).
 
 :- use_module(library(lists), [nth0/3]).
 
 init_CPT(List, Sizes, TAB) :-
-	matrix_new(floats, Sizes, List, TAB).
+	matrix_new(floats, Sizes, List, TAB),
+	matrix_to_logs(TAB).
 
 project_from_CPT(V,tab(Table,Deps,_),tab(NewTable,NDeps,NSzs)) :-
 	evidence(V,Pos), !,
@@ -44,7 +47,7 @@ project_from_CPT(V,tab(Table,Deps,_),tab(NewTable,NDeps,NSzs)) :-
 	matrix_dims(NewTable, NSzs).
 project_from_CPT(V,tab(Table,Deps,_),tab(NewTable,NDeps,NSzs)) :-
 	vnth(Deps, 0, V, N, NDeps),
-	matrix_sum_out(Table, N, NewTable),
+	matrix_sum_logs_out(Table, N, NewTable),
 	matrix_dims(NewTable, NSzs).
 
 evidence(V, Pos) :-
@@ -110,14 +113,14 @@ split_map([_-M|Is], [M|Map]) :-
 	split_map(Is, Map).
 
 divide_CPTs(Tab1, Tab2, OT) :-
-	matrix_op(Tab1,Tab2,/,OT).
+	matrix_op(Tab1,Tab2,-,OT).
 
 
 multiply_CPTs(tab(Tab1, Deps1, Sz1), tab(Tab2, Deps2, Sz2), tab(OT, NDeps, NSz), NTab2) :-
 	expand_tabs(Deps1, Sz1, Deps2, Sz2, Map1, Map2, NDeps),
 	matrix_expand(Tab1, Map1, NTab1),
 	matrix_expand(Tab2, Map2, NTab2),
-	matrix_op(NTab1,NTab2,*,OT),
+	matrix_op(NTab1,NTab2,+,OT),
 	matrix_dims(OT,NSz).
 
 expand_tabs([], [], [], [], [], [], []).
@@ -149,6 +152,7 @@ expand_tabs([V1|Deps1], [S1|Sz1], [V2|Deps2], [S2|Sz2], Map1, Map2, NDeps) :-
 	).
 	
 normalise_CPT(MAT,NMAT) :-
+	matrix_to_exps(MAT),
 	matrix_sum(MAT, Sum),
 	matrix_op_to_all(MAT,/,Sum,NMAT).
 
@@ -174,11 +178,11 @@ unit_CPT(V,CPT) :-
 
 reset_CPT_that_disagrees(CPT, Vars, V, Pos, NCPT) :-
 	vnth(Vars, 0, V, Dim,  _),
-	matrix_set_all_that_disagree(CPT, Dim, Pos, 0.0, NCPT).
+	matrix_set_all_that_disagree(CPT, Dim, Pos, -inf, NCPT).
 
 sum_out_from_CPT(Vs,Table,Deps,tab(NewTable,Vs,Sz)) :-
 	conversion_matrix(Vs, Deps, Conv),
-	matrix_sum_out_several(Table, Conv, NewTable),
+	matrix_sum_logs_out_several(Table, Conv, NewTable),
 	matrix_dims(NewTable, Sz).
 
 conversion_matrix([], [], []).

CLPBN/clpbn/viterbi.yap

@@ -48,8 +48,8 @@ mk_graph(NOfNodes, Map, ViterbiCode) :-
 	empty_assoc(KeyMap0),
 	get_graph(Vars0, Nodes, Edges, KeyMap0, KeyMap),
 	dgraph_new(G0),
-	dgraph_add_vertices(Nodes, G0, G1),
+	dgraph_add_vertices(G0, Nodes, G1),
-	dgraph_add_edges(Edges, G1, G2),
+	dgraph_add_edges(G1, Edges, G2),
 	dgraph_top_sort(G2, SortedNodes),
 	compile_viterbi(SortedNodes, KeyMap, NOfNodes, Map, ViterbiCode).
 

H/Heap.h

@@ -10,7 +10,7 @@
 * File:		Heap.h         						 *
 * mods:									 *
 * comments:	Heap Init Structure					 *
-* version:      $Id: Heap.h,v 1.121 2007-11-26 23:43:08 vsc Exp $	 *
+* version:      $Id: Heap.h,v 1.122 2007-12-05 12:17:23 vsc Exp $	 *
 *************************************************************************/
 
 /* information that can be stored in Code Space */
@@ -348,6 +348,7 @@ typedef struct various_codes {
   unsigned int size_of_overflow;
   struct mod_entry *current_modules;
   struct operator_entry *op_list;
+  struct hold_entry *global_hold_entry;
   struct static_clause *dead_static_clauses;
   struct static_mega_clause *dead_mega_clauses;
   struct static_index *dead_static_indices;
@@ -949,6 +950,7 @@ struct various_codes *Yap_heap_regs;
 #define  PredHashInitialSize      1039L
 #define  PredHashIncrement        7919L
 #define  ParserErrorStyle         Yap_heap_regs->parser_error_style
+#define  GlobalHoldEntry          Yap_heap_regs->global_hold_entry
 #define  DeadStaticClauses        Yap_heap_regs->dead_static_clauses
 #define  DeadMegaClauses          Yap_heap_regs->dead_mega_clauses
 #define  DBTermsList              Yap_heap_regs->dbterms_list

H/Yapproto.h

@@ -10,7 +10,7 @@
 * File:		Yap.proto						 *
 * mods:									 *
 * comments:	Function declarations for YAP				 *
-* version:      $Id: Yapproto.h,v 1.81 2007-11-06 17:02:12 vsc Exp $	 *
+* version:      $Id: Yapproto.h,v 1.82 2007-12-05 12:17:23 vsc Exp $	 *
 *************************************************************************/
 
 /* prototype file for Yap */
@@ -41,6 +41,9 @@ void	STD_PROTO(Yap_ReleaseAtom,(Atom));
 Term	STD_PROTO(Yap_StringToList,(char *));
 Term	STD_PROTO(Yap_StringToDiffList,(char *,Term));
 Term	STD_PROTO(Yap_StringToListOfAtoms,(char *));
+struct hold_entry *STD_PROTO(Yap_InitAtomHold,(void));
+int     STD_PROTO(Yap_AtomGetHold,(Atom));
+int     STD_PROTO(Yap_AtomReleaseHold,(Atom));
 
 #define Yap_StartSlots() (*--ASP = MkIntTerm(0))
 #define Yap_CurrentSlot() IntOfTerm(ASP[0])

H/Yatom.h

@@ -188,6 +188,7 @@ IsFunctorProperty (int flags)
 	bb 00	functor entry 
 	ff df	sparse functor
 	ff ex	arithmetic property
+	ff f6   hold
 	ff f7   array
 	ff f8   wide atom
 	ff fa   module property
@@ -1110,6 +1111,69 @@ IsBBProperty (int flags)
 }
 
 
+/*		hold property entry structure				*/
+typedef struct hold_entry
+{
+  Prop NextOfPE;		/* used to chain properties             */
+  PropFlags KindOfPE;		/* kind of property                     */
+} HoldEntry;
+
+#if USE_OFFSETS_IN_PROPS
+
+inline EXTERN HoldEntry *RepHoldProp (Prop p);
+
+inline EXTERN HoldEntry *
+RepHoldProp (Prop p)
+{
+  return (HoldEntry *) (AtomBase + Unsigned (p));
+}
+
+
+
+inline EXTERN Prop AbsHoldProp (HoldEntry * p);
+
+inline EXTERN Prop
+AbsHoldProp (HoldEntry * p)
+{
+  return (Prop) (Addr (p) - AtomBase);
+}
+
+
+#else
+
+inline EXTERN HoldEntry *RepHoldProp (Prop p);
+
+inline EXTERN HoldEntry *
+RepHoldProp (Prop p)
+{
+  return (HoldEntry *) (p);
+}
+
+
+
+inline EXTERN Prop AbsHoldProp (HoldEntry * p);
+
+inline EXTERN Prop
+AbsHoldProp (HoldEntry * p)
+{
+  return (Prop) (p);
+}
+
+
+#endif
+#define	HoldProperty  0xfff6
+
+/* only unary and binary expressions are acceptable */
+
+inline EXTERN PropFlags IsHoldProperty (int);
+
+inline EXTERN PropFlags
+IsHoldProperty (int flags)
+{
+  return (PropFlags) ((flags == HoldProperty));
+}
+
+
 
 
 /*		array property entry structure				*/

H/rheap.h

@@ -11,8 +11,11 @@
 * File:		rheap.h							 *
 * comments:	walk through heap code					 *
 *									 *
-* Last rev:     $Date: 2007-11-26 23:43:09 $,$Author: vsc $						 *
+* Last rev:     $Date: 2007-12-05 12:17:23 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.81  2007/11/26 23:43:09  vsc
+* fixes to support threads and assert correctly, even if inefficiently.
+*
 * Revision 1.80  2007/11/07 09:35:53  vsc
 * small fix
 *
@@ -736,6 +739,7 @@ restore_codes(void)
   Yap_heap_regs->readutil_module = AtomTermAdjust(Yap_heap_regs->readutil_module);
   Yap_heap_regs->globals_module = AtomTermAdjust(Yap_heap_regs->globals_module);
   Yap_heap_regs->swi_module = AtomTermAdjust(Yap_heap_regs->swi_module);
+  Yap_heap_regs->global_hold_entry = HoldEntryAdjust(Yap_heap_regs->global_hold_entry);
   if (Yap_heap_regs->file_aliases != NULL) {
     Yap_heap_regs->yap_streams =
       (struct stream_desc *)AddrAdjust((ADDR)Yap_heap_regs->yap_streams);

H/sshift.h

@@ -254,6 +254,14 @@ CellPtoHeapAdjust (CELL * ptr)
   return (CELL *) (((CELL *) (CharP (ptr) + HDiff)));
 }
 
+inline EXTERN HoldEntry *HoldEntryAdjust (HoldEntry *);
+
+inline EXTERN HoldEntry *
+HoldEntryAdjust (HoldEntry * ptr)
+{
+  return (HoldEntry *) (((HoldEntry *) (CharP (ptr) + HDiff)));
+}
+
 
 #if	USE_OFFSETS
 

changes-5.1.html

@@ -17,6 +17,11 @@
 
 <h2>Yap-5.1.3:</h2>
 <ul>
+<li> NEW: allow re-exporting other modules.</li>
+<li> FIXED: graph add_ and del_ predicates should have the original
+  graph as the first argument (obs from A N Saravanaraj).</li>
+<li> FIXED: implement atom holds so that the C-interface can make sure
+  the atom garbage collector will not remove an object.</li>
 <li> FIXED: implement JT for CLP(BN).</li>
 <li> FIXED: use safe locking to ensure that dynamic predicates
   run correctly.</li>

docs/yap.tex

@@ -168,6 +168,7 @@ Subnodes of Modules
 * Defining Modules:: How To Define a New Module
 * Using Modules:: How to Use a Module
 * Meta-Predicates in Modules:: How to Handle New Meta-Predicates
+* Re-Exporting Modules:: How to Re-export Predicates From Other Modules
 
 Subnodes of Input/Output
 * Streams and Files:: Handling Streams and Files
@@ -284,11 +285,13 @@ Subnodes of CHR
 
 Subnodes of C-Interface
 * Manipulating Terms:: Primitives available to the C programmer
+* Manipulating Terms:: Primitives available to the C programmer
 * Unifying Terms:: How to Unify Two Prolog Terms
 * Manipulating Strings:: From character arrays to Lists of codes and back
 * Memory Allocation:: Stealing Memory From YAP
 * Controlling Streams:: Control How YAP sees Streams
 * Calling YAP From C:: From C to YAP to C to YAP 
+* Module Manipulation in C:: Create and Test Modules from within C
 * Writing C:: Writing Predicates in C
 * Loading Objects:: Loading Object Files
 * Save&Rest:: Saving and Restoring
@@ -2090,6 +2093,7 @@ slowed down by the presence of modules.
 * Defining Modules:: How To Define a New Module
 * Using Modules:: How to Use a Module
 * Meta-Predicates in Modules:: How to Handle New Meta-Predicates
+* Re-Exporting Modules:: How to Re-export Predicates From Other Modules
 
 @end menu
 
@@ -2243,7 +2247,8 @@ the current module. Otherwise, load the files specified by @var{F},
 importing the predicates specified in the list @var{L}. 
 @end table
 
-@node Meta-Predicates in Modules, , Using Modules, Modules
+
+@node Meta-Predicates in Modules, Re-Exporting Modules, Using Modules, Modules
 @section Meta-Predicates in Modules
 
 The module system must know whether predicates operate on goals or
@@ -2304,6 +2309,61 @@ a(G) :- call(example:G)
 
 @end example
 
+@node Re-Exporting Modules, , Meta-Predicates in Modules, Modules
+@section Re-Exporting Predicates From Other Modules
+
+It is sometimes convenient to re-export predicates originally defined in
+a different module. This is often useful if you are adding to the
+functionality of a module, or if you are composing a large module with
+several small modules. The following declarations can be used for that purpose:
+
+@table @code
+
+@item reexport(+@var{F})
+@findex reexport/1
+@snindex reexport/1
+@cnindex reexport/1
+Export all predicates defined in file @var{F} as if they were defined in
+the curremt module.
+
+@item reexport(+@var{F},+@var{Decls})
+@findex reexport/2
+@snindex reexport/2
+@cnindex reexport/2
+Export predicates defined in file @var{F} according to @var{Decls}. The
+declarations may be of the form:
+@itemize @bullet
+@item A list of predicate declarations to be exported. Each declaration
+may be a predicate indicator or of the form ``@var{PI} @code{as}
+@var{NewName}'', meaning that the predicate with indicator @var{PI} is
+to be exported under name @var{NewName}.
+@item @code{except}(@var{List}) 
+In this case, all predicates not in @var{List} are exported. Moreover,
+if ``@var{PI} @code{as} @var{NewName}'' is found, the predicate with
+indicator @var{PI} is to be exported under name @var{NewName}@ as
+before.
+@end itemize
+@end table
+
+Re-exporting predicates must be used with some care. Please, take into
+account the following observations:
+
+@itemize @bullet
+@item
+The @code{reexport} declarations must be the first declarations to
+follow the  @code{module} declaration.
+@item
+It is possible to use both @code{reexport} and @code{use_module}, but
+all predicates reexported are automatically available for use in the
+current module.
+@item
+In order to obtain efficient execution, YAP compiles dependencies
+between re-exported predicates. In practice, this means that changing a
+@code{reexport} declaration and then @strong{just} recompiling the file
+may result in incorrect execution.
+@end itemize
+
+
 @node Built-ins, Library, Modules, Top
 
 @chapter Built-In Predicates
@@ -10460,7 +10520,7 @@ NG = [0-[],1-[3,5],2-[4],3-[],4-[5],5-[],
       6-[],7-[],8-[],9-[],10-[],11-[]]
 @end example
 
-@item del_vertices(+@var{Vertices}, +@var{Graph}, -@var{NewGraph})
+@item del_vertices(+@var{Graph}, +@var{Vertices}, -@var{NewGraph})
 @findex  del_vertices/3
 @syindex del_vertices/3
 @cnindex del_vertices/3
@@ -10807,7 +10867,7 @@ Unify @var{Edges} with all edges appearing in graph
 Unify @var{NewGraph} with a new graph obtained by adding the list of
 vertices @var{Vertices} to the graph @var{Graph}.
 
-@item undgraph_del_vertices(+@var{Vertices}, +@var{Graph}, -@var{NewGraph})
+@item undgraph_del_vertices(+@var{Graph}, +@var{Vertices}, -@var{NewGraph})
 @findex  undgraph_del_vertices/3
 @syindex undgraph_del_vertices/3
 @cnindex undgraph_del_vertices/3
@@ -13135,6 +13195,7 @@ The rest of this appendix describes exhaustively how to interface C to YAP.
 * Memory Allocation:: Stealing Memory From YAP
 * Controlling Streams:: Control How YAP sees Streams
 * Calling YAP From C:: From C to YAP to C to YAP 
+* Module Manipulation in C:: Create and Test Modules from within C
 * Writing C:: Writing Predicates in C
 * Loading Objects:: Loading Object Files
 * Save&Rest:: Saving and Restoring
@@ -13329,6 +13390,21 @@ representation-independent way:
       int      YAP_AtomNameLength(YAP_Atom @var{t})
 @end example
 
+@findex YAP_AtomGetHold  (C-Interface function)
+@findex YAP_AtomReleaseHold  (C-Interface function)
+@findex YAP_AGCHook  (C-Interface function)
+The next routines give users some control over  the atom
+garbage collector. They allow the user to guarantee that an atom is not
+to be garbage collected (this is important if the atom is hold
+externally to the Prolog engine, allow it to be collected, and call a
+hook on garbage collection:
+@example
+      int  YAP_AtomGetHold(YAP_Atom @var{at})
+      int  YAP_AtomReleaseHold(YAP_Atom @var{at})
+      int  YAP_AGCRegisterHook(YAP_AGC_hook @var{f})
+      YAP_Term  YAP_TailOfTerm(YAP_Term @var{t})
+@end example
+
 @findex YAP_MkPairTerm (C-Interface function)
 @findex YAP_MkNewPairTerm (C-Interface function)
 @findex YAP_HeadOfTerm (C-Interface function)
@@ -13511,15 +13587,169 @@ The available flags are @code{YAP_INPUT_STREAM},
 stream is supposed to be at position 0. The argument @var{name} gives
 the name by which YAP should know the new stream.
 
-@node Calling YAP From C, Writing C, Controlling Streams, C-Interface
+@node Calling YAP From C, Module Manipulation in C, Controlling Streams, C-Interface
 @section From @code{C} back to Prolog
 
-@findex YAP_CallProlog (C-Interface function)
+@findex YAP_RunGoal (C-Interface function)
-Newer versions of YAP allow for calling the Prolog interpreter from
+There are several ways to call Prolog code from C-code. By default, the
-@code{C}. One must first construct a goal @code{G}, and then it is
+@code{YAP_RunGoal()} should be used for this task. It assumes the engine
-sufficient to perform:
+has been initialised before:
+
 @example
-      YAP_Bool      YAPCallProlog(YAP_Term @var{G})
+  YAP_RunGoal(YAP_Term Goal)
+@end example
+Execute query @var{Goal} and return 1 if the query succeeds, and 0
+otherwise. The predicate returns 0 if failure, otherwise it will return
+an @var{YAP_Term}. 
+
+One problem is that @var{YAP_Term} may change due to garbage
+collection. To make sure you have access to the current value, it may be
+a good idea to reload the term, as next example shows:
+@example
+  val = YAP_RunGoal(YAP_ARG1);
+  if (val == 0) return FALSE;
+  else t = YAP_ARG1;
+@end example
+Note that even if execution failed, garbage collection might still have
+been called and moved the term. In this case, this is not a problem:
+
+An alternative that ensures correct access to arguments is to use
+@emph{slots}, as shown next:
+
+@example
+  long sl = YAP_InitSlot(scoreTerm);
+
+  out = YAP_RunGoal(t);
+  t = YAP_GetFromSlot(sl);
+  YAP_RecoverSlots(1);
+  if (out == 0) return FALSE;
+@end example
+Slots are safe houses in the stack, preserved by the garbage collector
+and the stack shifter. In this case, we use a slot to preserve @var{t}
+during the execution of @code{YAP_RunGoal}. When the execution of
+@var{t} is over we read the (possibly changed) value of @var{t} back
+from the slot @var{sl} and tell YAP that the slot @var{sl} is not needed
+and can be given back to the system. The slot functions are as follows:
+
+@table @code
+@item long int YAP_NewSlots(int @var{NumberOfSlots})
+@findex YAP_NewSlots (C-Interface function)
+Allocate @var{NumberOfSlots} from the stack and return an handle to the
+last one. Th eother hand can be obtained by decrementing the handle.
+
+@item long int YAP_CurrentSlot(void)
+@findex YAP_CurrentSlot (C-Interface function)
+Return a handle to the system's default slot.
+
+@item long YAP_InitSlot(YAP_Term @var{t})
+@findex YAP_InitSlot (C-Interface function)
+Create a new slot, initialise it with @var{t}, and return a handle to
+this slot, that also becomes the current slot.
+
+@item YAP_Term *YAP_AddressFromSlot(long int @var{slot})
+@findex YAP_AddressFromSlot (C-Interface function)
+Return the address of slot @var{slot}: please use with care.
+
+@item void YAP_PutInSlot(long int @var{slot}, YAP_Term @var{t})
+@findex YAP_PutInSlot (C-Interface function)
+Set the contents of slot @var{slot} to @var{t}.
+
+@item void YAP_RecoverSlots(int @var{HowMany})
+@findex YAP_RecoverSlots (C-Interface function)
+Recover the space for @var{HowMany} slots: these will include the
+current default slot.
+@end table
+
+The following functions complement @var{YAP_RunGoal}:
+@table @code
+@findex YAP_RestartGoal (C-Interface function)
+Look for the next solution to the current query by forcing YAP to
+backtrack to the latest goal. Notice that slots allocated since the last
+@code{YAP_RunGoal} will become invalid.
+
+@item  @code{int} YAP_Reset(@code{void})
+@findex YAP_Reset (C-Interface function)
+Reset execution environment (similar to the @code{abort/0}
+built-in). This is useful when you want to start a new query before
+asking all solutions to the previous query.
+
+@item  @code{int} YAP_ShutdownGoal(@code{int backtrack})
+@findex YAP_ShutdownGoal (C-Interface function)
+Clean up the current goal. If
+@code{backtrack} is true, stack space will be recovered and bindings
+will be undone. In both cases, any slots allocated since the goal was
+created will become invalid.
+
+@item  @code{YAP_Bool} YAP_GoalHasException(@code{YAP_Term *tp})
+@findex YAP_RestartGoal (C-Interface function)
+Check if the last goal generated an exception, and if so copy it to the
+space pointed to by @var{tp}
+
+@item  @code{void} YAP_ClearExceptions(@code{void})
+@findex YAP_ClearExceptions (C-Interface function)
+Reset any exceptions left over by the system.
+@end table
+
+The @var{YAP_RunGoal} interface is designed to be very robust, but may
+not be the most efficient when repeated calls to the same goal are made
+and when there is no interest in processing exception. The
+@var{YAP_EnterGoal} interface should have lower-overhead:
+@table @code
+@item  @code{YAP_PredEntryPtr} YAP_FunctorToPred(@code{YAP_Functor} @var{f},
+@findex YAP_FunctorToPred (C-Interface function)
+Return the predicate whose main functor is @var{f}.
+
+@item  @code{YAP_PredEntryPtr} YAP_AtomToPred(@code{YAP_Atom} @var{at},
+@findex YAP_AtomToPred (C-Interface function)
+Return the arity 0 predicate whose name is @var{at}.
+
+@item  @code{YAP_Bool} YAP_EnterGoal(@code{YAP_PredEntryPtr} @var{pe},
+@code{YAP_Term *} @var{array}, @code{YAP_dogoalinfo *} @var{infop})
+@findex YAP_EnterGoal (C-Interface function)
+Execute a  query for predicate @var{pe}. The query is given as an
+array of terms @var{Array}. @var{infop} is the address of a goal
+handle that can be used to backtrack and to recover space. Succeeds if
+a solution was found.
+
+Notice that you cannot create new slots if an YAP_EnterGoal goal is open.
+
+@item  @code{YAP_Bool} YAP_RetryGoal(@code{YAP_dogoalinfo *} @var{infop})
+@findex YAP_RetryGoal (C-Interface function)
+Backtrack to a query created by @code{YAP_EnterGoal}. The query is
+given by the handle @var{infop}. Returns whether a new solution could
+be be found.
+
+@item  @code{YAP_Bool} YAP_LeaveGoal(@code{YAP_Bool} @var{backtrack},
+@code{YAP_dogoalinfo *} @var{infop})
+@findex YAP_LeaveGoal (C-Interface function)
+Exit a query query created by @code{YAP_EnterGoal}. If
+@code{backtrack} is @code{TRUE}, variable bindings are undone and Heap
+space is recovered.  Otherwise, only stack space is recovered, ie,
+@code{LeaveGoal} executes a cut.
+@end table
+Next, follows an example of how to use @code{YAP_EnterGoal}:
+@example
+void
+runall(YAP_Term g)
+@{
+    YAP_dogoalinfo goalInfo;
+    YAP_Term *goalArgs = YAP_ArraysOfTerm(g);
+    YAP_Functor *goalFunctor = YAP_FunctorOfTerm(g);
+    YAP_PredEntryPtr goalPred = YAP_FunctorToGoal(goalFunctor);
+    
+    result = YAP_EnterGoal( goalPred, goalArgs, &goalInfo );
+    while (result)
+       result = YAP_RetryGoal( &goalInfo );
+    YAP_LeaveGoal(TRUE, &goalInfo);
+@}
+@end example
+
+@findex YAP_CallProlog (C-Interface function)
+YAP allows calling a @strong{new} Prolog interpreter from @code{C}. One
+way is to first construct a goal @code{G}, and then it is sufficient to
+perform:
+@example
+      YAP_Bool      YAP_CallProlog(YAP_Term @var{G})
 @end example
 @noindent
 the result will be @code{FALSE}, if the goal failed, or @code{TRUE}, if
@@ -13528,7 +13758,34 @@ the values they have been unified with. Execution only proceeds until
 finding the first solution to the goal, but you can call
 @code{findall/3} or friends if you need all the solutions.
 
-@node Writing C, Loading Objects, Calling YAP From C, C-Interface
+Notice that during execution, garbage collection or stack shifting may
+have moved the terms 
+
+@node Module Manipulation in C, Writing C, Calling YAP From C, C-Interface
+@section Module Manipulation in C
+
+YAP allows one to create a new module from C-code. To create the new
+code it is sufficient to call:
+@example
+      YAP_Module      YAP_CreateModule(YAP_Atom @var{ModuleName})
+@end example
+@noindent
+Notice that the new module does not have any predicates associated and
+that it is not the current module. To find the current module, you can call:
+@example
+      YAP_Module      YAP_CurrentModule()
+@end example
+
+Given a module, you may want to obtain the corresponding name. This is
+possioble by using:
+@example
+      YAP_Term      YAP_ModuleName(YAP_Module mod)
+@end example
+@noindent
+Notice that this function returns a term, and not an atom. You can
+@code{YAP_AtomOfTerm} to extract the corresponding Prolog atom.
+
+@node Writing C, Loading Objects, Module Manipulation in C, C-Interface
 @section Writing predicates in C
 
 We will distinguish two kinds of predicates:
@@ -13936,113 +14193,6 @@ simple way for controlling and communicating with the Prolog run-time.
 @findex  YAP_Read/1
 Parse a Term  using the function @var{GetC} to input characters.
 
-@item  @code{YAP_Term} YAP_RunGoal(@code{YAP_Term} @var{Goal})
-@findex YAP_RunGoal/1
-Execute query @var{Goal} and return 1 if the query succeeds, and
-0 otherwise. The predicate returns 0 if failure, otherwise it will
-return @var{YAP_Term}. Note that @var{YAP_Term} may change due to garbage
-collection, so you should use something like:
-@example
-  t = YAP_RunGoal(t);
-  if (t == 0) return FALSE;
-@end example
-If the execution fails, garbage collection might still have changed
-the term, so you should not use the input argument again.
-
-An alternative is to use @emph{slots}, as shown next:
-
-@example
-  long sl = YAP_InitSlot(scoreTerm);
-
-  out = YAP_RunGoal(t);
-  t = YAP_GetFromSlot(sl);
-  YAP_RecoverSlots(1);
-  if (out == 0) return FALSE;
-@end example
-Slots are safe houses in the stack, preserved by the garbage collector
-and the stack shifter. In this case, we use a slot to preserve @var{t}
-during the execution of @code{YAP_RunGoal}. When the execution of
-@var{t} is over we read the (possibly changed) value of @var{t} back
-from the slot @var{sl} and tell YAP that the slot @var{sl} is not
-needed and can be given back to the system.
-
-@item  @code{int} YAP_RestartGoal(@code{void})
-@findex YAP_RestartGoal/0
-Look for the next solution to the current query by forcing YAP to
-backtrack to the latest goal. Notice that slots allocated since the last
-@code{YAP_RunGoal} will become invalid.
-
-@item  @code{int} YAP_ShutdownGoal(@code{int backtrack})
-@findex YAP_ShutdownGoal/0
-Clean up the current goal. If
-@code{backtrack} is true, stack space will be recovered and bindings
-will be undone. In both cases, any slots allocated since the goal was
-created will become invalid.
-
-@item  @code{int} YAP_Reset(@code{void})
-@findex YAP_Reset/0
-Reset execution environment (similar to the @code{abort/0}
-built-in). This is useful when you want to start a new query before
-asking all solutions to the previous query.
-
-@item  @code{YAP_Bool} YAP_GoalHasException(@code{YAP_Term *tp})
-@findex YAP_RestartGoal/1
-Check if the last goal generated an exception, and if so copy it to the
-space pointed to by @var{tp}
-
-@item  @code{void} YAP_ClearExceptions(@code{void})
-@findex YAP_ClearExceptions/0
-Reset any exceptions left over by the system.
-
-@item  @code{YAP_PredEntryPtr} YAP_FunctorToPred(@code{YAP_Functor} @var{f},
-@findex YAP_FunctorToPred/1
-Return the predicate whose main functor is @var{f}.
-
-@item  @code{YAP_PredEntryPtr} YAP_AtomToPred(@code{YAP_Atom} @var{at},
-@findex YAP_AtomToPred/1
-Return the arity 0 predicate whose name is @var{at}.
-
-@item  @code{YAP_Bool} YAP_EnterGoal(@code{YAP_PredEntryPtr} @var{pe},
-@code{YAP_Term *} @var{array}, @code{YAP_dogoalinfo *} @var{infop})
-@findex YAP_EnterGoal/3
-Execute a  query for predicate @var{pe}. The query is given as an
-array of terms @var{Array}. @var{infop} is the address of a goal
-handle that can be used to backtrack and to recover space. Succeeds if
-a solution was found.
-
-Notice that you cannot create new slots if an YAP_EnterGoal goal is open.
-
-@item  @code{YAP_Bool} YAP_RetryGoal(@code{YAP_dogoalinfo *} @var{infop})
-@findex YAP_RetryGoal/1
-Backtrack to a query created by @code{YAP_EnterGoal}. The query is
-given by the handle @var{infop}. Returns whether a new solution could
-be be found.
-
-@item  @code{YAP_Bool} YAP_LeaveGoal(@code{YAP_Bool} @var{backtrack},
-@code{YAP_dogoalinfo *} @var{infop})
-@findex YAP_LeaveGoal/2
-Exit a query query created by @code{YAP_EnterGoal}. If
-@code{backtrack} is @code{TRUE}, variable bindings are undone and Heap
-space is recovered.  Otherwise, only stack space is recovered, ie,
-@code{LeaveGoal} executes a cut.
-
-Next, follows an example of how to use @code{YAP_EnterGoal}:
-@example
-void
-runall(YAP_Term g)
-@{
-    YAP_dogoalinfo goalInfo;
-    YAP_Term *goalArgs = YAP_ArraysOfTerm(g);
-    YAP_Functor *goalFunctor = YAP_FunctorOfTerm(g);
-    YAP_PredEntryPtr goalPred = YAP_FunctorToGoal(goalFunctor);
-    
-    result = YAP_EnterGoal( goalPred, goalArgs, &goalInfo );
-    while (result)
-       result = YAP_RetryGoal( &goalInfo );
-    YAP_LeaveGoal(TRUE, &goalInfo);
-@}
-@end example
-
 @item  @code{YAP_Term} YAP_Write(@code{YAP_Term} @var{t})
 @findex  YAP_CopyTerm/1
 Copy a Term @var{t} and all associated constraints. May call the garbage

include/YapInterface.h

@@ -406,6 +406,15 @@ extern X_API YAP_Module  PROTO(YAP_CurrentModule,(void));
 /*  int  YAP_CurrentModule()  */
 extern X_API YAP_Module  PROTO(YAP_CreateModule,(YAP_Atom));
 
+/*  int  YAP_AtomGetHold(YAP_Atom)  */
+extern X_API int  PROTO(YAP_AtomGetHold,(YAP_Atom));
+
+/*  int  YAP_AtomReleaseHold(YAP_Atom)  */
+extern X_API int  PROTO(YAP_AtomReleaseHold,(YAP_Atom));
+
+/*  void  YAP_AtomReleaseHold(YAP_Atom)  */
+extern X_API void  PROTO(YAP_AGCRegisterHook,(YAP_agc_hook));
+
 /* thread stuff */
 extern X_API int  PROTO(YAP_ThreadSelf,(void));
 extern X_API YAP_CELL PROTO(YAP_ThreadCreateEngine,(YAP_thread_attr *));

include/yap_structs.h

@@ -146,3 +146,5 @@ typedef struct {
   struct yami *p;
 } YAP_dogoalinfo;
 
+typedef int   (*YAP_agc_hook)(YAP_Atom);
+

library/Makefile.in

@@ -61,6 +61,7 @@ PROGRAMS= $(srcdir)/apply_macros.yap \
 	$(srcdir)/undgraphs.yap \
 	$(srcdir)/varnumbers.yap \
 	$(srcdir)/wdgraphs.yap \
+	$(srcdir)/wgraphs.yap \
 	$(srcdir)/wundgraphs.yap \
 	$(srcdir)/lam_mpi.yap \
 	$(srcdir)/ypp.yap 

library/dgraphs.yap

@@ -5,7 +5,6 @@
 
 :- module( dgraphs,
 	   [
-	    dgraph_new/1,
 	    dgraph_add_edge/4,
 	    dgraph_add_edges/3,
 	    dgraph_add_vertex/3,
@@ -34,9 +33,11 @@
 	    dgraph_isomorphic/4,
 	    dgraph_path/3]).
 
+:- reexport(library(rbtrees),
+	[rb_new/1 as dgraph_new]).
+
 :- use_module(library(rbtrees),
-	[rb_new/1,
+	[rb_empty/1,
-	 rb_empty/1,
 	 rb_lookup/3,
 	 rb_apply/4,
 	 rb_insert/4,
@@ -60,27 +61,22 @@
 	 wdgraph_max_path/5,
 	 wdgraph_min_paths/3]).
 
-dgraph_new(Vertices) :-
+dgraph_add_edge(Vs0,V1,V2,Vs2) :-
-	rb_new(Vertices).
-
-dgraph_add_edge(V1,V2,Vs0,Vs2) :-
 	dgraph_new_edge(V1,V2,Vs0,Vs1),
-	dgraph_add_vertex(V2,Vs1,Vs2).
+	dgraph_add_vertex(Vs1,V2,Vs2).
 	
-dgraph_add_edges(Edges, V0, VF) :-
+dgraph_add_edges(V0, Edges, VF) :-
 	rb_empty(V0), !,
 	sort(Edges,SortedEdges),
 	all_vertices_in_edges(SortedEdges,Vertices),
 	sort(Vertices,SortedVertices),
 	edges2graphl(SortedVertices, SortedEdges, GraphL),
 	ord_list_to_rbtree(GraphL, VF).
-dgraph_add_edges(Edges) -->
+dgraph_add_edges(G0, Edges, GF) :-
-	{
 	sort(Edges,SortedEdges),
 	all_vertices_in_edges(SortedEdges,Vertices),
-	 sort(Vertices,SortedVertices)
+	sort(Vertices,SortedVertices),
-	},
+	dgraph_add_edges(SortedVertices,SortedEdges, G0, GF).
-	dgraph_add_edges(SortedVertices,SortedEdges).
 
 all_vertices_in_edges([],[]).
 all_vertices_in_edges([V1-V2|Edges],[V1,V2|Vertices]) :-
@@ -124,15 +120,15 @@ dgraph_new_edge(V1,V2,Vs0,Vs) :-
 insert_edge(V2, Children0, Children) :-
 	ord_insert(Children0,V2,Children).
 
-dgraph_add_vertices([]) --> [].
+dgraph_add_vertices(G, [], G).
-dgraph_add_vertices([V|Vs]) -->
+dgraph_add_vertices(G0, [V|Vs], GF) :-
-	dgraph_add_vertex(V),
+	dgraph_add_vertex(G0, V, G1),
-	dgraph_add_vertices(Vs).
+	dgraph_add_vertices(G1, Vs, GF).
 
 
-dgraph_add_vertex(V,Vs0,Vs0) :-
+dgraph_add_vertex(Vs0, V, Vs0) :-
 	rb_lookup(V,_,Vs0), !.
-dgraph_add_vertex(V, Vs0, Vs) :-
+dgraph_add_vertex(Vs0, V, Vs) :-
 	rb_insert(Vs0, V, [], Vs).
 
 dgraph_edges(Vs,Edges) :-
@@ -169,14 +165,12 @@ dgraph_complement(Vs0,VsF) :-
 complement(Vs,Children,NewChildren) :-
 	ord_subtract(Vs,Children,NewChildren).
 
-dgraph_del_edge(V1,V2,Vs0,Vs1) :-
+dgraph_del_edge(Vs0,V1,V2,Vs1) :-
 	rb_apply(Vs0, V1, delete_edge(V2), Vs1).
 
-dgraph_del_edges(Edges) -->
+dgraph_del_edges(G0, Edges, Gf) :-
-	{
+	sort(Edges,SortedEdges),
-	 sort(Edges,SortedEdges)
+	continue_del_edges(SortedEdges, G0, Gf).
-	},
-	continue_del_edges(SortedEdges).
 
 continue_del_edges([]) --> [].
 continue_del_edges([V-V1|Es]) --> !,
@@ -190,17 +184,17 @@ contract_vertex(V,Children, Vs0, Vs) :-
 del_edges(ToRemove,E0,E) :-
 	ord_subtract(E0,ToRemove,E).
 
-dgraph_del_vertex(V,Vs0,Vsf) :-
+dgraph_del_vertex(Vs0, V, Vsf) :-
 	rb_delete(Vs0, V, Vs1),
 	rb_map(Vs1, delete_edge(V), Vsf).
 
-delete_edge(V, Edges0, Edges) :-
+delete_edge(Edges0, V, Edges) :-
 	ord_del_element(Edges0, V, Edges).
 
-dgraph_del_vertices(Vs) -->
+dgraph_del_vertices(G0, Vs, GF) -->
-	{ sort(Vs,SortedVs) },
+	sort(Vs,SortedVs),
-	delete_all(SortedVs),
+	delete_all(SortedVs, G0, G1),
-	delete_remaining_edges(SortedVs).
+	delete_remaining_edges(SortedVs, G1, GF).
 
 % it would be nice to be able to delete a set of elements from an RB tree
 % but I don't how to do it yet.
@@ -240,7 +234,7 @@ dgraph_compose(T1,T2,CT) :-
 	rb_visit(T1,Nodes),
 	compose(Nodes,T2,NewNodes),
 	dgraph_new(CT0),
-	dgraph_add_edges(NewNodes,CT0,CT).
+	dgraph_add_edges(CT0,NewNodes,CT).
 
 compose([],_,[]).
 compose([V-Children|Nodes],T2,NewNodes) :-
@@ -264,7 +258,7 @@ dgraph_transitive_closure(G,Closure) :-
 continue_closure([], Closure, Closure) :- !.
 continue_closure(Edges, G, Closure) :-
 	transit_graph(Edges,G,NewEdges),
-	dgraph_add_edges(NewEdges, G, GN),
+	dgraph_add_edges(G, NewEdges, GN),
 	continue_closure(NewEdges, GN, Closure).
 
 transit_graph([],_,[]).
@@ -287,7 +281,7 @@ is_edge(V1,V2,G) :-
 dgraph_symmetric_closure(G,S) :-
 	dgraph_edges(G, Edges),
 	invert_edges(Edges, InvertedEdges),
-	dgraph_add_edges(InvertedEdges, G, S).
+	dgraph_add_edges(G, InvertedEdges, S).
 
 invert_edges([], []).
 invert_edges([V1-V2|Edges], [V2-V1|InvertedEdges]) :-
@@ -395,7 +389,7 @@ dgraph_isomorphic(Vs, Vs2, G1, G2) :-
 	translate_edges(Edges,Map,TEdges),
 	dgraph_new(G20),
 	dgraph_add_vertices(Vs2,G20,G21),
-	dgraph_add_edges(TEdges,G21,G2).
+	dgraph_add_edges(G21,TEdges,G2).
 
 mapping([],[],Map,Map).
 mapping([V1|Vs],[V2|Vs2],Map0,Map) :-

library/matrix.yap

@@ -31,7 +31,8 @@ typedef enum {
   MAT_SUB=1,
   MAT_TIMES=2,
   MAT_DIV=3,
-  MAT_IDIV=4
+  MAT_IDIV=4,
+  MAT_ZDIV=5
 } op_type;
 
   */
@@ -63,9 +64,13 @@ typedef enum {
 	    matrix_sum/2,
 	    matrix_sum_out/3,
 	    matrix_sum_out_several/3,
+	    matrix_sum_logs_out/3,
+	    matrix_sum_logs_out_several/3,
 	    matrix_add_to_all/2,
 	    matrix_agg_lines/3,
 	    matrix_agg_cols/3,
+	    matrix_to_logs/1,
+	    matrix_to_exps/1,
 	    matrix_op/4,
 	    matrix_op_to_all/4,
 	    matrix_op_to_lines/4,
@@ -125,6 +130,8 @@ matrix_op(M1,M2,*,NM) :-
 	do_matrix_op(M1,M2,2,NM).
 matrix_op(M1,M2,/,NM) :-
 	do_matrix_op(M1,M2,3,NM).
+matrix_op(M1,M2,zdiv,NM) :-
+	do_matrix_op(M1,M2,5,NM).
 
 matrix_op_to_all(M1,+,Num,NM) :-
 	do_matrix_op_to_all(M1,0,Num,NM).

library/matrix/matrix.c

@@ -60,7 +60,10 @@ typedef enum {
   MAT_SUB=1,
   MAT_TIMES=2,
   MAT_DIV=3,
-  MAT_IDIV=4
+  MAT_IDIV=4,
+  MAT_ZDIV=5,
+  MAT_LOG=6,
+  MAT_EXP=7
 } op_type;
 
 static long int *
@@ -1002,6 +1005,52 @@ matrix_min(void)
   return YAP_Unify(YAP_ARG2, tf);
 }
 
+static int
+matrix_log_all(void)
+{
+  int *mat;
+
+  mat = (int *)YAP_BlobOfTerm(YAP_ARG1);
+  if (!mat) {
+    /* Error */
+    return FALSE;
+  }
+  if (mat[MAT_TYPE] == INT_MATRIX) {
+    return FALSE;
+  } else {
+    double *data = matrix_double_data(mat, mat[MAT_NDIMS]);
+    int i;
+
+    for (i=0; i< mat[MAT_SIZE]; i++) {
+      data[i] = log(data[i]);
+    }
+  }
+  return TRUE;
+}
+
+static int
+matrix_exp_all(void)
+{
+  int *mat;
+
+  mat = (int *)YAP_BlobOfTerm(YAP_ARG1);
+  if (!mat) {
+    /* Error */
+    return FALSE;
+  }
+  if (mat[MAT_TYPE] == INT_MATRIX) {
+    return FALSE;
+  } else {
+    double *data = matrix_double_data(mat, mat[MAT_NDIMS]);
+    int i;
+
+    for (i=0; i< mat[MAT_SIZE]; i++) {
+      data[i] = exp(data[i]);
+    }
+  }
+  return TRUE;
+}
+
 static int
 matrix_minarg(void)
 {
@@ -1492,6 +1541,59 @@ matrix_double_div_data(double *nmat, int siz, double mat1[], double mat2[])
   }
 }
 
+static void
+matrix_long_zdiv_data(long int *nmat, int siz, long int mat1[], long int mat2[])
+{
+  int i;
+
+  for (i=0; i< siz; i++) {
+    if (mat1[i] == 0)
+      nmat[i] = 0;
+    else
+      nmat[i] = mat1[i]/mat2[i];
+  }
+}
+
+static void
+matrix_long_double_zdiv_data(double *nmat, int siz, long int mat1[], double mat2[])
+{
+  int i;
+
+  for (i=0; i< siz; i++) {
+    if (mat1[i] == 0)
+      nmat[i] = 0;
+    else
+      nmat[i] = mat1[i]/mat2[i];
+  }
+}
+
+static void
+matrix_long_double_zdiv2_data(double *nmat, int siz, double mat1[], long int mat2[])
+{
+  int i;
+
+  for (i=0; i< siz; i++) {
+    if (mat1[i] == 0.0)
+      nmat[i] = 0;
+    else
+      nmat[i] = mat1[i]/mat2[i];
+  }
+}
+
+static void
+matrix_double_zdiv_data(double *nmat, int siz, double mat1[], double mat2[])
+{
+  int i;
+
+  for (i=0; i< siz; i++) {
+    if (mat1[i] == 0.0) {
+      nmat[i] = 0.0;
+    } else {
+      nmat[i] = mat1[i]/mat2[i];
+    }
+  }
+}
+
 static int
 matrix_op(void)
 {
@@ -1549,6 +1651,9 @@ matrix_op(void)
       case MAT_DIV:
 	matrix_long_div_data(ndata, mat1[MAT_SIZE], data1, data2);
 	break;
+      case MAT_ZDIV:
+	matrix_long_zdiv_data(ndata, mat1[MAT_SIZE], data1, data2);
+	break;
       default:
 	return FALSE;
       }
@@ -1581,6 +1686,9 @@ matrix_op(void)
       case MAT_DIV:
 	matrix_long_double_div_data(ndata, mat1[MAT_SIZE], data1, data2);
 	break;
+      case MAT_ZDIV:
+	matrix_long_double_zdiv_data(ndata, mat1[MAT_SIZE], data1, data2);
+	break;
       default:
 	return FALSE;
       }
@@ -1622,6 +1730,9 @@ matrix_op(void)
       case MAT_DIV:
 	matrix_long_double_div2_data(ndata, mat1[MAT_SIZE], data1, data2);
 	break;
+      case MAT_ZDIV:
+	matrix_long_double_zdiv2_data(ndata, mat1[MAT_SIZE], data1, data2);
+	break;
       default:
 	return FALSE;
       }
@@ -1654,6 +1765,9 @@ matrix_op(void)
       case MAT_DIV:
 	matrix_double_div_data(ndata, mat1[MAT_SIZE], data1, data2);
 	break;
+      case MAT_ZDIV:
+	matrix_double_zdiv_data(ndata, mat1[MAT_SIZE], data1, data2);
+	break;
       default:
 	return FALSE;
       }
@@ -2244,7 +2358,7 @@ matrix_sum_out_several(void)
 	  nindx[k++]= indx[j];
 	}
       }
-      ndata[matrix_get_offset(nmat, nindx)] += data[i];
+      ndata[matrix_get_offset(nmat, nindx)] = log(exp(ndata[matrix_get_offset(nmat, nindx)]) + exp(data[i]));
     }
   } else {
     double *data, *ndata;
@@ -2273,7 +2387,199 @@ matrix_sum_out_several(void)
 	  nindx[k++]= indx[j];
 	}
       }
-      ndata[matrix_get_offset(nmat, nindx)] += data[i];
+      ndata[matrix_get_offset(nmat, nindx)] = log(exp(ndata[matrix_get_offset(nmat, nindx)]) + exp(data[i]));
+    }
+  }
+  return YAP_Unify(YAP_ARG3, tf);
+}
+
+/* given a matrix M and a set of dims, sum out one of the dimensions
+*/ 
+static int
+matrix_sum_out_logs(void)
+{
+  int ndims, i, j, *dims, newdims, prdim;
+  int indx[MAX_DIMS], nindx[MAX_DIMS];
+  YAP_Term tpdim, tf;
+  int *mat = (int *)YAP_BlobOfTerm(YAP_ARG1), *nmat;
+  if (!mat) {
+    /* Error */
+    return FALSE;
+  }
+  /* we now have our target matrix, let us grab our conversion arguments */
+  tpdim = YAP_ARG2;
+  ndims = mat[MAT_NDIMS];
+  dims = mat+MAT_DIMS;
+  if (!YAP_IsIntTerm(tpdim)) {
+    return FALSE;
+  }
+  prdim = YAP_IntOfTerm(tpdim);
+  newdims = ndims-1;
+  for (i=0, j=0; i< ndims; i++) {
+    if (i != prdim) {
+      nindx[j]= (mat+MAT_DIMS)[i];
+      j++;
+    }
+  }
+  if (mat[MAT_TYPE] == INT_MATRIX) {
+    long int *data, *ndata;
+
+    /* create a new matrix with the same size */
+    tf = new_int_matrix(newdims,nindx,NULL);
+    if (tf == YAP_TermNil())
+      return FALSE;
+    /* in case the matrix moved */
+    mat = (int *)YAP_BlobOfTerm(YAP_ARG1);
+    nmat = (int *)YAP_BlobOfTerm(tf);  
+    data = matrix_long_data(mat,ndims);
+    ndata = matrix_long_data(nmat,newdims);
+    /* create a new matrix with smaller size */
+    for (i=0;i<nmat[MAT_SIZE];i++) 
+      ndata[i] = 0;
+    for (i=0; i< mat[MAT_SIZE]; i++) {
+      int j, k;
+      /*
+	not very efficient, we could try to take advantage of the fact
+	that we usually only change an index at a time
+      */
+      matrix_get_index(mat, i, indx);
+      for (j = 0, k=0; j < ndims; j++)  {
+	if (j != prdim) {
+	  nindx[k++]= indx[j];
+	}
+      }
+      ndata[matrix_get_offset(nmat, nindx)] += exp(data[i]);
+    }
+    for (i=0; i< nmat[MAT_SIZE]; i++) {
+      ndata[i] = log(ndata[i]);
+    }
+  } else {
+    double *data, *ndata;
+
+    /* create a new matrix with the same size */
+    tf = new_float_matrix(newdims,nindx,NULL);
+    if (tf == YAP_TermNil())
+      return FALSE;
+    /* in case the matrix moved */
+    mat = (int *)YAP_BlobOfTerm(YAP_ARG1);
+    nmat = (int *)YAP_BlobOfTerm(tf);  
+    data = matrix_double_data(mat,ndims);
+    ndata = matrix_double_data(nmat,newdims);
+    /* create a new matrix with smaller size */
+    for (i=0;i<nmat[MAT_SIZE];i++) 
+      ndata[i] = 0.0;
+    for (i=0; i< mat[MAT_SIZE]; i++) {
+      int j, k;
+      /*
+	not very efficient, we could try to take advantage of the fact
+	that we usually only change an index at a time
+      */
+      matrix_get_index(mat, i, indx);
+      for (j = 0, k=0; j < ndims; j++)  {
+	if (j != prdim) {
+	  nindx[k++]= indx[j];
+	}
+      }
+      ndata[matrix_get_offset(nmat, nindx)] += exp(data[i]);
+    }
+    for (i=0; i< nmat[MAT_SIZE]; i++) {
+      ndata[i] = log(ndata[i]);
+    }
+  }
+  return YAP_Unify(YAP_ARG3, tf);
+}
+
+/* given a matrix M and a set of dims, sum out one of the dimensions
+*/ 
+static int
+matrix_sum_out_logs_several(void)
+{
+  int ndims, i, *dims, newdims;
+  int indx[MAX_DIMS], nindx[MAX_DIMS], conv[MAX_DIMS];
+  YAP_Term tf, tconv;
+  int *mat = (int *)YAP_BlobOfTerm(YAP_ARG1), *nmat;
+  if (!mat) {
+    /* Error */
+    return FALSE;
+  }
+  ndims = mat[MAT_NDIMS];
+  dims = mat+MAT_DIMS;
+  /* we now have our target matrix, let us grab our conversion arguments */
+  tconv = YAP_ARG2;
+  for (i=0, newdims=0; i < ndims; i++) {
+    YAP_Term th;
+
+    if (!YAP_IsPairTerm(tconv))
+      return FALSE;
+    th = YAP_HeadOfTerm(tconv);
+    if (!YAP_IsIntTerm(th))
+      return FALSE;
+    conv[i] = YAP_IntOfTerm(th);
+    if (!conv[i]) {
+      nindx[newdims++] = dims[i];
+    }
+    tconv = YAP_TailOfTerm(tconv);
+  }
+  if (mat[MAT_TYPE] == INT_MATRIX) {
+    long int *data, *ndata;
+
+    /* create a new matrix with the same size */
+    tf = new_int_matrix(newdims,nindx,NULL);
+    if (tf == YAP_TermNil())
+      return FALSE;
+    /* in case the matrix moved */
+    mat = (int *)YAP_BlobOfTerm(YAP_ARG1);
+    nmat = (int *)YAP_BlobOfTerm(tf);  
+    data = matrix_long_data(mat,ndims);
+    ndata = matrix_long_data(nmat,newdims);
+    /* create a new matrix with smaller size */
+    for (i=0;i<nmat[MAT_SIZE];i++) 
+      ndata[i] = 0;
+    for (i=0; i< mat[MAT_SIZE]; i++) {
+      int j, k;
+      /*
+	not very efficient, we could try to take advantage of the fact
+	that we usually only change an index at a time
+      */
+      matrix_get_index(mat, i, indx);
+      for (j = 0, k=0; j < ndims; j++)  {
+	if (!conv[j]) {
+	  nindx[k++]= indx[j];
+	}
+      }
+      ndata[matrix_get_offset(nmat, nindx)] += exp(data[i]);
+    }
+  } else {
+    double *data, *ndata;
+
+    /* create a new matrix with the same size */
+    tf = new_float_matrix(newdims,nindx,NULL);
+    if (tf == YAP_TermNil())
+      return FALSE;
+    /* in case the matrix moved */
+    mat = (int *)YAP_BlobOfTerm(YAP_ARG1);
+    nmat = (int *)YAP_BlobOfTerm(tf);  
+    data = matrix_double_data(mat,ndims);
+    ndata = matrix_double_data(nmat,newdims);
+    /* create a new matrix with smaller size */
+    for (i=0;i<nmat[MAT_SIZE];i++) 
+      ndata[i] = 0.0;
+    for (i=0; i< mat[MAT_SIZE]; i++) {
+      int j, k;
+      /*
+	not very efficient, we could try to take advantage of the fact
+	that we usually only change an index at a time
+      */
+      matrix_get_index(mat, i, indx);
+      for (j = 0, k=0; j < ndims; j++)  {
+	if (!conv[j]) {
+	  nindx[k++]= indx[j];
+	}
+      }
+      ndata[matrix_get_offset(nmat, nindx)] += exp(data[i]);
+    }
+    for (i=0; i< nmat[MAT_SIZE]; i++) {
+      ndata[i] = log(ndata[i]);
     }
   }
   return YAP_Unify(YAP_ARG3, tf);
@@ -2370,12 +2676,12 @@ matrix_expand(void)
 	not very efficient, we could try to take advantage of the fact
 	that we usually only change an index at a time
       */
-      matrix_next_index(nmat+MAT_DIMS, newdims, indx);
       for (j = 0; j < newdims; j++)  {
 	if (!new[j])
 	  nindx[k++] = indx[j];
       }
       ndata[i] = data[matrix_get_offset(mat, nindx)];
+      matrix_next_index(nmat+MAT_DIMS, newdims, indx);
     }
   }
   return YAP_Unify(YAP_ARG3, tf);
@@ -2496,8 +2802,12 @@ init_matrix(void)
   YAP_UserCPredicate("matrix_expand", matrix_expand, 3);
   YAP_UserCPredicate("matrix_select", matrix_select, 4);
   YAP_UserCPredicate("matrix_add_to_all", matrix_sum, 2);
+  YAP_UserCPredicate("matrix_to_logs", matrix_log_all,1);
+  YAP_UserCPredicate("matrix_to_exps", matrix_exp_all, 1);
   YAP_UserCPredicate("matrix_sum_out", matrix_sum_out, 3);
   YAP_UserCPredicate("matrix_sum_out_several", matrix_sum_out_several, 3);
+  YAP_UserCPredicate("matrix_sum_logs_out", matrix_sum_out_logs, 3);
+  YAP_UserCPredicate("matrix_sum_logs_out_several", matrix_sum_out_logs_several, 3);
   YAP_UserCPredicate("matrix_set_all_that_disagree", matrix_set_all_that_disagree, 5);
   YAP_UserCPredicate("do_matrix_op", matrix_op, 4);
   YAP_UserCPredicate("do_matrix_agg_lines", matrix_agg_lines, 3);

library/ugraphs.yap

@@ -154,7 +154,7 @@ add_empty_vertices([V|G], [V-[]|NG]) :-
 %
 % unmark a set of vertices plus all edges leading to them.
 %
-del_vertices(Vertices, Graph, NewGraph) :-
+del_vertices(Graph, Vertices, NewGraph) :-
 	msort(Vertices, V1),
 	(V1 = [] -> Graph = NewGraph ;
 	 del_vertices(Graph, V1, V1, NewGraph) ).

library/undgraphs.yap

@@ -8,7 +8,6 @@
 	    undgraph_new/1,
 	    undgraph_add_edge/4,
 	    undgraph_add_edges/3,
-	    undgraph_add_vertex/3,
 	    undgraph_add_vertices/3,
 	    undgraph_del_edge/4,
 	    undgraph_del_edges/3,
@@ -16,31 +15,35 @@
 	    undgraph_del_vertices/3,
 	    undgraph_edge/3,
 	    undgraph_edges/2,
-	    undgraph_vertices/2,
 	    undgraph_neighbors/3,
 	    undgraph_neighbours/3,
 	    undgraph_complement/2,
 	    dgraph_to_undgraph/2,
 	    undgraph_min_tree/2]).
 
+:- reexport( library(dgraphs),
+	   [
+	    dgraph_new/1 as undgraph_new,
+	    dgraph_add_vertex/3 as undgraph_add_vertex,
+	    dgraph_vertices/2 as undgraph_vertices,
+	    dgraph_complement/2 as undgraph_complement,
+	    dgraph_symmetric_closure/2 as dgraph_to_undgraph,
+	    dgraph_edge/3 as undgraph_edge
+	    ]).
+
+
 :- use_module( library(dgraphs),
 	   [
-	    dgraph_new/1,
 	    dgraph_add_edge/4,
 	    dgraph_add_edges/3,
-	    dgraph_add_vertex/3,
 	    dgraph_add_vertices/3,
 	    dgraph_del_edge/4,
 	    dgraph_del_edges/3,
 	    dgraph_del_vertex/3,
 	    dgraph_del_vertices/3,
-	    dgraph_edge/3,
 	    dgraph_edges/2,
-	    dgraph_vertices/2,
 	    dgraph_neighbors/3,
-	    dgraph_neighbours/3,
+	    dgraph_neighbours/3]).
-	    dgraph_complement/2,
-	    dgraph_symmetric_closure/2]).
 
 :- use_module(library(wundgraphs), [
             undgraph_to_wundgraph/2,
@@ -58,28 +61,22 @@
 	   rb_partial_map/4
 	]).
 
-undgraph_new(Vertices) :-
+undgraph_add_edge(Vs0,V1,V2,Vs2) :-
-	dgraph_new(Vertices).
-
-undgraph_add_edge(V1,V2,Vs0,Vs2) :-
 	dgraphs:dgraph_new_edge(V1,V2,Vs0,Vs1),
 	dgraphs:dgraph_new_edge(V2,V1,Vs1,Vs2).
 	
-undgraph_add_edges(Edges) -->
+undgraph_add_edges(G0, Edges, GF) :-
-	{ dup_edges(Edges, DupEdges) },
+	dup_edges(Edges, DupEdges),
-	dgraph_add_edges(DupEdges).
+	dgraph_add_edges(G0, DupEdges, GF).
 
 dup_edges([],[]).
 dup_edges([E1-E2|Edges], [E1-E2,E2-E1|DupEdges]) :-
 	dup_edges(Edges, DupEdges).
 
-undgraph_add_vertices([]) --> [].
+undgraph_add_vertices(G, [], G).
-undgraph_add_vertices([V|Vs]) -->
+undgraph_add_vertices(G0, [V|Vs], GF) :-
-	dgraph_add_vertex(V),
+	dgraph_add_vertex(G0, V, GI),
-	undgraph_add_vertices(Vs).
+	undgraph_add_vertices(GI, Vs, GF).
-
-undgraph_add_vertex(V) -->
-	dgraph_add_vertex(V).
 
 undgraph_edges(Vs,Edges) :-
 	dgraph_edges(Vs,DupEdges),
@@ -92,9 +89,6 @@ remove_dups([V1-V2|DupEdges],NEdges) :- V1 @< V2, !,
 remove_dups([_|DupEdges],Edges) :-
 	remove_dups(DupEdges,Edges).
 
-undgraph_vertices(Vs,Vertices) :-
-	dgraph_vertices(Vs,Vertices).
-
 undgraph_neighbours(V,Vertices,Children) :-
 	dgraph_neighbours(V,Vertices,Children0),
 	(
@@ -114,20 +108,15 @@ undgraph_neighbors(V,Vertices,Children) :-
 	    Children = Children0
 	).
 
-undgraph_complement(Vs0,VsF) :-
+undgraph_del_edge(Vs0,V1,V2,VsF) :-
-	dgraph_complement(Vs0,VsF).
+	dgraph_del_edge(Vs0,V1,V2,Vs1),
+	dgraph_del_edge(Vs1,V2,V1,VsF).
 
-undgraph_del_edge(V1,V2,Vs0,VsF) :-
+undgraph_del_edges(G0, Edges, GF) :-
-	dgraph_del_edge(V1,V2,Vs0,Vs1),
+	dup_edges(Edges,DupEdges),
-	dgraph_del_edge(V2,V1,Vs1,VsF).
+	dgraph_del_edges(G0, DupEdges, GF).
 
-undgraph_del_edges(Edges) -->
+undgraph_del_vertex(Vs0, V, Vsf) :-
-	{
-	  dup_edges(Edges,DupEdges)
-	},
-	dgraph_del_edges(DupEdges).
-
-undgraph_del_vertex(V, Vs0, Vsf) :-
 	rb_delete(Vs0, V, BackEdges, Vsi),
 	(
 	    ord_del_element(BackEdges,V,RealBackEdges)
@@ -138,11 +127,11 @@ undgraph_del_vertex(V, Vs0, Vsf) :-
 	),
 	rb_partial_map(Vsi, RealBackEdges, del_edge(V), Vsf).
 
-undgraph_del_vertices(Vs) -->
+undgraph_del_vertices(G0, Vs, GF) :-
-	{ sort(Vs,SortedVs) },
+	sort(Vs,SortedVs),
-	delete_all(SortedVs, [], BackEdges),
+	delete_all(SortedVs, [], BackEdges, G0, GI),
-	{ ord_subtract(BackEdges, SortedVs, TrueBackEdges) },
+	ord_subtract(BackEdges, SortedVs, TrueBackEdges),
-	delete_remaining_edges(SortedVs, TrueBackEdges).
+	delete_remaining_edges(SortedVs, TrueBackEdges, GI, GF).
 
 % it would be nice to be able to delete a set of elements from an RB tree
 % but I don't how to do it yet.
@@ -161,13 +150,6 @@ del_edges(ToRemove,E0,E) :-
 del_edge(ToRemove,E0,E) :-
 	ord_del_element(E0,ToRemove,E).
 
-dgraph_to_undgraph(G, U) :-
-	dgraph_symmetric_closure(G, U).
-
-undgraph_edge(N1, N2, G) :-
-	dgraph_edge(N1, N2, G).
-
-
 undgraph_min_tree(G, T) :-
 	undgraph_to_wundgraph(G, WG),
 	wundgraph_min_tree(WG, WT, _),

library/wdgraphs.yap

@@ -8,15 +8,12 @@
 	    wdgraph_new/1,
 	    wdgraph_add_edge/5,
 	    wdgraph_add_edges/3,
-	    wdgraph_add_vertex/3,
+	    wdgraph_add_vertices_and_edges/4,
-	    wdgraph_add_vertices/3,
 	    wdgraph_del_edge/5,
 	    wdgraph_del_edges/3,
 	    wdgraph_del_vertex/3,
 	    wdgraph_del_vertices/3,
 	    wdgraph_edge/4,
-	    wdgraph_edges/2,
-	    wdgraph_vertices/2,
 	    wdgraph_to_dgraph/2,
 	    dgraph_to_wdgraph/2,
 	    wdgraph_neighbors/3,
@@ -30,13 +27,17 @@
 	    wdgraph_max_path/5,
 	    wdgraph_path/3]).
 
+:- reexport(library(dgraphs),
+	    [dgraph_add_vertex/3 as wdgraph_add_vertex,
+	     dgraph_add_vertices/3 as wdgraph_add_vertices,
+	     dgraph_vertices/2 as wdgraph_vertices,
+	     dgraph_edges/2 as wdgraph_edges
+	    ]).
+
+
 :- use_module(library(dgraphs),
 	[	    
-        dgraph_add_vertex/3,
-	dgraph_add_vertices/3,
 	dgraph_top_sort/2,
-	dgraph_edges/2,
-	dgraph_vertices/2,
 	dgraph_path/3
 	]
     ).
@@ -69,24 +70,27 @@
 wdgraph_new(Vertices) :-
 	rb_new(Vertices).
 
-wdgraph_add_edge(V1,V2,Weight,Vs0,Vs2) :-
+wdgraph_add_vertices_and_edges(Vs0,Vertices,Edges,Vs2) :-
-	wdgraph_new_edge(V1,V2,Weight,Vs0,Vs1),
+	wdgraph_add_vertices(Vs0, Vertices, Vs1),
-	dgraph_add_vertex(V2,Vs1,Vs2).
+	wdgraph_add_edges(Vs1, Edges, Vs2).
 	
-wdgraph_add_edges(Edges, V0, VF) :-
+
+wdgraph_add_edge(Vs0,V1,V2,Weight,Vs2) :-
+	wdgraph_new_edge(V1,V2,Weight,Vs0,Vs1),
+	dgraph_add_vertex(Vs1,V2,Vs2).
+	
+wdgraph_add_edges(V0, Edges, VF) :-
 	rb_empty(V0), !,
 	sort(Edges,SortedEdges),
 	all_vertices_in_wedges(SortedEdges,Vertices),
 	sort(Vertices,SortedVertices),
 	edges2wgraphl(SortedVertices, SortedEdges, GraphL),
 	ord_list_to_rbtree(GraphL, VF).
-wdgraph_add_edges(Edges) -->
+wdgraph_add_edges(G0, Edges, GF) :-
-	{
 	sort(Edges,SortedEdges),
 	all_vertices_in_wedges(SortedEdges,Vertices),
-	 sort(Vertices,SortedVertices)
+	sort(Vertices,SortedVertices),
-	},
+	add_edges(SortedVertices,SortedEdges, G0, GF).
-	wdgraph_add_edges(SortedVertices,SortedEdges).
 
 all_vertices_in_wedges([],[]).
 all_vertices_in_wedges([V1-(V2-_)|Edges],[V1,V2|Vertices]) :-
@@ -100,14 +104,14 @@ edges2wgraphl([V|Vertices], SortedEdges, [V-[]|GraphL]) :-
 	edges2wgraphl(Vertices, SortedEdges, GraphL).
 
 
-wdgraph_add_edges([],[]) --> [].
+add_edges([],[]) --> [].
-wdgraph_add_edges([VA|Vs],[VB-(V1-W)|Es]) --> { VA == VB }, !,
+add_edges([VA|Vs],[VB-(V1-W)|Es]) --> { VA == VB }, !,
 	{ get_extra_children(Es,VA,Children,REs) },
 	wdgraph_update_vertex(VA,[V1-W|Children]),
-	wdgraph_add_edges(Vs,REs).
+	add_edges(Vs,REs).
-wdgraph_add_edges([V|Vs],Es) --> !,
+add_edges([V|Vs],Es) --> !,
 	wdgraph_update_vertex(V,[]),
-	wdgraph_add_edges(Vs,Es).
+	add_edges(Vs,Es).
 
 get_extra_children([VA-(C-W)|Es],VB,[C-W|Children],REs) :- VA == VB, !,
 	get_extra_children(Es,VB,Children,REs).
@@ -144,12 +148,6 @@ wdgraph_new_edge(V1,V2,W,Vs0,Vs) :-
 insert_edge(V2, W, Children0, Children) :-
 	ord_insert(Children0,V2-W,Children).
 
-wdgraph_add_vertex(V) -->
-	dgraph_add_vertex(V).
-
-wdgraph_add_vertices(V) -->
-	dgraph_add_vertices(V).
-
 wdgraph_top_sort(WG,Q) :-
 	wdgraph_to_dgraph(WG, G),
 	dgraph_top_sort(G, Q).
@@ -168,7 +166,7 @@ find_edge(N-W,[N1-W|_]) :- N == N1, !.
 find_edge(El,[_|Edges]) :- 
 	find_edge(El,Edges).
 
-wdgraph_del_edge(V1, V2, W, Vs0, Vs) :-
+wdgraph_del_edge(Vs0, V1, V2, W, Vs) :-
 	rb_update(Vs0, V1, Children0, NewChildren, Vs),
 	del_edge(Children0, V2, W, NewChildren).
 
@@ -183,11 +181,9 @@ del_edge([K-W|Children], K1, W1, NewChildren) :-
 	    del_edge(Children, K1, W1, ChildrenLeft)
 	).
 
-wdgraph_del_edges(Edges) -->
+wdgraph_del_edges(G0, Edges, GF) :-
-	{
+	sort(Edges,SortedEdges),
-	 sort(Edges,SortedEdges)
+	continue_del_edges(SortedEdges, G0, GF).
-	},
-	continue_del_edges(SortedEdges).
 
 continue_del_edges([]) --> [].
 continue_del_edges([V-V1|Es]) --> !,
@@ -200,18 +196,18 @@ contract_vertex(V,Children, Vs0, Vs) :-
 	del_vertices(Children, Children0, NewChildren).
 
 % I assume first argument is subset of second.
-del_vertices([], Children, Children).
+del_vertices(Children, [], Children).
-del_vertices([K-W|ToDel], [K1-W1|Children0], NewChildren) :-
+del_vertices([K1-W1|Children0], [K-W|ToDel], NewChildren) :-
 	( K == K1 ->
 	    W = W1,
-	    del_vertices(ToDel, Children0, NewChildren)
+	    del_vertices(Children0, ToDel, NewChildren)
 	;
 	    % K1 @< K
 	    NewChildren = [K1-W1|ChildrenLeft],
-	    del_vertices([K-W|ToDel], Children0, ChildrenLeft)
+	    del_vertices(Children0, [K-W|ToDel], ChildrenLeft)
 	).
 
-wdgraph_del_vertex(V,Vs0,Vsf) :-
+wdgraph_del_vertex(Vs0, V, Vsf) :-
 	rb_delete(Vs0, V, Vs1),
 	rb_map(Vs1, delete_wedge(V), Vsf).
 
@@ -227,10 +223,10 @@ delete_wedge(V, [K-W|Children], NewChildren) :-
 	   Children = NewChildren
 	).
 
-wdgraph_del_vertices(Vs) -->
+wdgraph_del_vertices(G0, Vs, GF) :-
-	{ sort(Vs,SortedVs) },
+	sort(Vs,SortedVs),
-	delete_all(SortedVs),
+	delete_all(SortedVs, G0, G1),
-	delete_remaining_edges(SortedVs).
+	delete_remaining_edges(SortedVs, G1, GF).
 
 % it would be nice to be able to delete a set of elements from an RB tree
 % but I don't how to do it yet.
@@ -256,12 +252,6 @@ del_possible_edges([K|ToDel], [K1-W1|Children0], NewChildren) :-
 	    del_possible_edges(ToDel, [K1-W1|Children0], NewChildren)
 	).
 
-wdgraph_edges(G,Edges) :-
-	dgraph_edges(G,Edges).
-
-wdgraph_vertices(G,Edges) :-
-	dgraph_vertices(G,Edges).
-
 wdgraph_to_dgraph(WG, DG) :-
 	rb_clone(WG, EdgesList0, DG, EdgeList),
 	cvt_wedges(EdgesList0, EdgeList).
@@ -327,7 +317,7 @@ wdgraph_transitive_closure(G,Closure) :-
 continue_closure([], Closure, Closure) :- !.
 continue_closure(Edges, G, Closure) :-
 	transit_wgraph(Edges,G,NewEdges),
-	wdgraph_add_edges(NewEdges, G, GN),
+	wdgraph_add_edges(G, NewEdges, GN),
 	continue_closure(NewEdges, GN, Closure).
 
 transit_wgraph([],_,[]).
@@ -351,7 +341,7 @@ is_edge(V1,V2,G) :-
 wdgraph_symmetric_closure(G,S) :-
 	dgraph_edges(G, WEdges),
 	invert_wedges(WEdges, InvertedWEdges),
-	wdgraph_add_edges(InvertedWEdges, G, S).
+	wdgraph_add_edges(G, InvertedWEdges, S).
 
 invert_wedges([], []).
 invert_wedges([V1-(V2-W)|WEdges], [V2-(V1-W)|InvertedWEdges]) :-
@@ -421,7 +411,7 @@ wdgraph_min_paths(V1, WGraph, T) :-
 	queue_edges(Edges, V1, 0, H0, H1),
 	dijkstra(H1, WGraph, Status, [], EPath),
 	rb_empty(T0),
-	wdgraph_add_edges(EPath, T0, T).
+	wdgraph_add_edges(T0, EPath, T).
 
 
 dijkstra(H0, WGraph, Status, Path0, PathF) :-

library/wundgraphs.yap

@@ -5,56 +5,44 @@
 
 :- module( wundgraphs,
 	   [
-	    wundgraph_new/1,
 	    wundgraph_add_edge/5,
 	    wundgraph_add_edges/3,
-	    wundgraph_add_vertex/3,
-	    wundgraph_add_vertices/3,
 	    wundgraph_del_edge/5,
 	    wundgraph_del_edges/3,
 	    wundgraph_del_vertex/3,
-	    wundgraph_del_vertices/3,
-	    wundgraph_edge/4,
 	    wundgraph_edges/2,
-	    wundgraph_vertices/2,
 	    wundgraph_neighbors/3,
 	    wundgraph_neighbours/3,
 	    wdgraph_to_wundgraph/2,
-	    wundgraph_to_wdgraph/2,
-	    undgraph_to_wundgraph/2,
 	    wundgraph_to_undgraph/2,
 	    wundgraph_min_tree/3,
-	    wundgraph_max_tree/3,
+	    wundgraph_max_tree/3]).
-	    wundgraph_min_path/5,
+
-	    wundgraph_min_paths/3,
+:- reexport( library(wdgraphs),
-	    wundgraph_max_path/5,
+	   [
-	    wundgraph_path/3]).
+	    wdgraph_new/1 as wundgraph_new,
+	    wdgraph_add_vertex/3 as wundgraph_add_vertex,
+	    wdgraph_add_vertices/3 as wundgraph_add_vertices,
+	    wdgraph_vertices/2 as wundgraph_vertices,
+	    wdgraph_del_vertices/3 as wundgraph_del_vertices,
+	    wdgraph_edge/4 as wundgraph_edge,
+	    wdgraph_to_dgraph/2 as wundgraph_to_undgraph,
+	    dgraph_to_wdgraph/2 as undgraph_to_wundgraph,
+	    wdgraph_min_path/5 as wundgraph_min_path,
+	    wdgraph_min_paths/3 as wundgraph_min_paths,
+	    wdgraph_max_path/5 as wundgraph_max_path,
+	    wdgraph_path/3 as wundgraph_path]).
 
 :- use_module( library(wdgraphs),
 	   [
-	    wdgraph_new/1,
 	    wdgraph_add_edge/5,
 	    wdgraph_add_edges/3,
-	    wdgraph_add_vertex/3,
-	    wdgraph_add_vertices/3,
 	    wdgraph_del_edge/5,
 	    wdgraph_del_edges/3,
 	    wdgraph_del_vertex/3,
-	    wdgraph_del_vertices/3,
-	    wdgraph_edge/4,
 	    wdgraph_edges/2,
-	    wdgraph_to_dgraph/2,
+	    wdgraph_neighbors/3,
-	    dgraph_to_wdgraph/2,
+	    wdgraph_symmetric_closure/2
-	    wdgraph_symmetric_closure/2,
-	    wdgraph_min_path/5,
-	    wdgraph_min_paths/3,
-	    wdgraph_max_path/5,
-	    wdgraph_path/3]).
-
-:- use_module( library(dgraphs),
-	   [
-            dgraph_vertices/2,
-	    dgraph_neighbors/3
 	   ]).
 
 :- use_module(library(rbtrees),
@@ -72,29 +60,20 @@
          reverse/2
 	]).
 
-wundgraph_new(Vertices) :-
+wundgraph_add_edge(Vs0, V1, V2, K, Vs2) :-
-	wdgraph_new(Vertices).
-
-wundgraph_add_edge(V1,V2,K,Vs0,Vs2) :-
 	wdgraphs:wdgraph_new_edge(V1,V2,K,Vs0,Vs1),
 	wdgraphs:wdgraph_new_edge(V2,V1,K,Vs1,Vs2).
 	
-wundgraph_add_edges(Edges) -->
+wundgraph_add_edges(G0, Edges, GF) :-
-	{ dup_edges(Edges, DupEdges) },
+	dup_edges(Edges, DupEdges),
-	wdgraph_add_edges(DupEdges).
+	wdgraph_add_edges(G0, DupEdges, GF).
 
 dup_edges([],[]).
 dup_edges([E1-(E2-K)|Edges], [E1-(E2-K),E2-(E1-K)|DupEdges]) :-
 	dup_edges(Edges, DupEdges).
 
-wundgraph_add_vertices(Vs) -->
+wundgraph_edges(Vs, Edges) :-
-	wdgraph_add_vertices(Vs).
+	wdgraph_edges(Vs, DupEdges),
-
-wundgraph_add_vertex(V) -->
-	wdgraph_add_vertex(V).
-
-wundgraph_edges(Vs,Edges) :-
-	wdgraph_edges(Vs,DupEdges),
 	remove_dups(DupEdges,Edges).
 
 remove_dups([],[]).
@@ -104,11 +83,8 @@ remove_dups([V1-(V2-K)|DupEdges],NEdges) :- V1 @< V2, !,
 remove_dups([_|DupEdges],Edges) :-
 	remove_dups(DupEdges,Edges).
 
-wundgraph_vertices(Vs,Vertices) :-
-	dgraph_vertices(Vs,Vertices).
-
 wundgraph_neighbours(V,Vertices,Children) :-
-	dgraph_neighbours(V,Vertices,Children0),
+	wdgraph_neighbours(V,Vertices,Children0),
 	(
 	    del_me(Children0,V,Children)
 	->
@@ -117,7 +93,7 @@ wundgraph_neighbours(V,Vertices,Children) :-
 	    Children = Children0
 	).
 wundgraph_neighbors(V,Vertices,Children) :-
-	dgraph_neighbors(V,Vertices,Children0),
+	wdgraph_neighbors(V,Vertices,Children0),
 	(
 	    del_me(Children0,V,Children)
 	->
@@ -139,17 +115,15 @@ del_me([K-_|Children], K1, NewChildren) :-
 	    compact(Children, MoreChildren)
 	).
 
-wundgraph_del_edge(V1,V2,K,Vs0,VsF) :-
+wundgraph_del_edge(Vs0,V1,V2,K,VsF) :-
-	wdgraph_del_edge(V1,V2,K,Vs0,Vs1),
+	wdgraph_del_edge(Vs0,V1,V2,K,Vs1),
-	wdgraph_del_edge(V2,V1,K,Vs1,VsF).
+	wdgraph_del_edge(Vs1,V2,V1,K,VsF).
 
-wundgraph_del_edges(Edges) -->
+wundgraph_del_edges(G0, Edges, GF) :-
-	{
+	dup_edges(Edges,DupEdges),
-	  dup_edges(Edges,DupEdges)
+	wdgraph_del_edges(G0, DupEdges, GF).
-	},
-	wdgraph_del_edges(DupEdges).
 
-wundgraph_del_vertex(V, Vs0, Vsf) :-
+wundgraph_del_vertex(Vs0, V, Vsf) :-
 	rb_delete(Vs0, V, BackEdges, Vsi),
 	del_and_compact(BackEdges,V,BackVertices),
 	rb_partial_map(Vsi, BackVertices, del_edge(V), Vsf).
@@ -172,8 +146,8 @@ compact([K-_|Children], [K|CompactChildren]) :-
 	compact(Children, CompactChildren).
 
 
-wundgraph_del_vertices(Vs) -->
+wundgraph_del_vertices(G0, Vs, GF) :-
-	wdgraph_del_vertices(Vs).
+	wdgraph_del_vertices(G0, Vs, GF).
 
 del_edge(_, [], []).
 del_edge(K1, [K-W|Children], NewChildren) :-
@@ -195,21 +169,6 @@ wdgraph_to_wundgraph(G, U) :-
 
 wundgraph_to_wdgraph(G, G).
 
-wundgraph_min_path(V1, V2, WGraph, Path, Cost) :-
-	wdgraph_min_path(V1, V2, WGraph, Path, Cost).
-
-wundgraph_max_path(V1, V2, WGraph, Path, Cost) :-
-	wdgraph_max_path(V1, V2, WGraph, Path, Cost).
-
-wundgraph_min_paths(V1, WGraph, T) :-
-	wdgraph_min_paths(V1, WGraph, T).
-
-wundgraph_path(V, WG, P) :-
-	wdgraph_path(V, WG, P).
-
-undgraph_to_wundgraph(G1, G2) :-
-	dgraph_to_wdgraph(G1, G2).
-
 wundgraph_to_undgraph(G1, G2) :-
 	    wdgraph_to_dgraph(G1, G2).
 
@@ -225,14 +184,14 @@ generate_min_tree([], T, 0) :- !,
 	wundgraph_new(T).
 generate_min_tree([El-_], T, 0) :- !,
 	wundgraph_new(T0),
-	wundgraph_add_vertex(El,T0,T).
+	wundgraph_add_vertex(T0, El, T).
 generate_min_tree(Els0, T, C) :-
 	mk_list_of_edges(Els0, Edges),
 	keysort(Edges, SortedEdges),
 	rb_new(V0),
 	rb_new(T0),
 	add_sorted_edges(SortedEdges, V0, TreeEdges, 0, C),
-	wundgraph_add_edges(TreeEdges, T0, T).
+	wundgraph_add_edges(T0, TreeEdges, T).
 
 wundgraph_max_tree(G, T, C) :-
 	rb_visit(G, Els0),
@@ -242,7 +201,7 @@ generate_max_tree([], T, 0) :- !,
 	wundgraph_new(T).
 generate_max_tree([El-_], T, 0) :- !,
 	wundgraph_new(T0),
-	wundgraph_add_vertex(El,T0,T).
+	wundgraph_add_vertex(T0, El, T).
 generate_max_tree(Els0, T, C) :-
 	mk_list_of_edges(Els0, Edges),
 	keysort(Edges, SortedEdges),
@@ -250,7 +209,7 @@ generate_max_tree(Els0, T, C) :-
 	rb_new(V0),
 	rb_new(T0),
 	add_sorted_edges(ReversedEdges, V0, TreeEdges, 0, C),
-	wundgraph_add_edges(TreeEdges, T0, T).
+	wundgraph_add_edges(T0, TreeEdges, T).
 
 mk_list_of_edges([], []).
 mk_list_of_edges([V-Els|Els0], Edges) :-

library/yap2swi/yap2swi.c

@@ -33,14 +33,13 @@ alloc_ring_buf(void)
   return buffers+(TMP_BUF_SIZE+ret*BUF_SIZE);
 }
 
-/* SWI: void PL_agc_hook(void)
+/* SWI: void PL_agc_hook(void) */
-   YAP: NO EQUIVALENT */
 
 /* dummy function for now (until Vitor comes through!)*/
 X_API PL_agc_hook_t
 PL_agc_hook(PL_agc_hook_t entry)
 {
-  return entry;
+  YAP_AGCRegisterHook((YAP_agc_hook)entry);
 }
 
 /* SWI: char* PL_atom_chars(atom_t atom)
@@ -977,18 +976,20 @@ X_API int PL_unify_term(term_t l,...)
 
 /* end PL_unify_* functions =============================*/
 
-/* SWI: void PL_register_atom(atom_t atom)
+/* SWI: void PL_register_atom(atom_t atom) */
-   YAP: NO EQUIVALENT */
 /* SAM TO DO */
 X_API void PL_register_atom(atom_t atom)
 {
+  extern int Yap_AtomGetHold(atom_t atom);
+  Yap_AtomGetHold(atom);
 }
 
-/* SWI: void PL_unregister_atom(atom_t atom)
+/* SWI: void PL_unregister_atom(atom_t atom) */
-   YAP: NO EQUIVALENT */
 /* SAM TO DO */
 X_API void PL_unregister_atom(atom_t atom)
 {
+  extern int Yap_AtomReleaseHold(atom_t atom);
+  Yap_AtomReleaseHold(atom);
 }
 
 X_API int PL_get_string_chars(term_t t, char **s, int *len)

pl/boot.yap

@@ -814,9 +814,8 @@ not(G) :-    \+ '$execute'(G).
 	'$find_undefp_handler'(G,M,Goal,NM), !,
 	'$execute0'(Goal,NM).
 
-'$find_undefp_handler'(G,M,G,S) :-
+'$find_undefp_handler'(G,M,NG,S) :-
-	functor(G,F,N),
+	recorded('$import','$import'(S,M,NG,G,_,_),_),
-	recorded('$import','$import'(S,M,F,N),_),
 	S \= M, % can't try importing from the module itself.
 	!,
 	'$exit_undefp'.

pl/debug.yap

@@ -50,10 +50,11 @@
 	->
 	  M = EM
 	;
-	  recorded('$import','$import'(EM,M,A,_),_)
+	 recorded('$import','$import'(EM,M,GA,_,A,_),_),
+	 functor(GA,NA,_)
 	),
 	!,
-	'$do_suspy_predicates_by_name'(A,S,EM).
+	'$do_suspy_predicates_by_name'(NA,S,EM).
 '$suspy_predicates_by_name'(A,spy,M) :- !,
 	'$print_message'(warning,no_match(spy(M:A))).
 '$suspy_predicates_by_name'(A,nospy,M) :-
@@ -64,17 +65,18 @@
 	functor(T,A,N),
 	'$do_suspy'(S, A, N, T, M).
 '$do_suspy_predicates_by_name'(A, S, M) :-
-	recorded('$import','$import'(EM,M,A,N),_),
+	recorded('$import','$import'(EM,M,T0,_,A,N),_),
-	functor(T,A,N),
+	functor(T0,A0,N0),
-	'$do_suspy'(S, A, N, T, EM).
+	'$do_suspy'(S, A0, N0, T, EM).
 
 
 %
 % protect against evil arguments.
 %
 '$do_suspy'(S, F, N, T, M) :-
-	recorded('$import','$import'(EM,M,F,N),_), !,
+	recorded('$import','$import'(EM,M,T0,_,F,N),_), !,
-	'$do_suspy'(S, F, N, T, EM).
+	functor(T0, F0, N0),
+	'$do_suspy'(S, F0, N0, T, EM).
 '$do_suspy'(S, F, N, T, M) :-
 	 '$undefined'(T,M), !,
 	 ( S = spy ->

pl/directives.yap

@@ -54,6 +54,8 @@
 '$directive'(else).
 '$directive'(elif(_)).
 '$directive'(endif).
+'$directive'(reexport(_)).
+'$directive'(reexport(_,_)).
 
 '$exec_directives'((G1,G2), Mode, M) :- !,
 	'$exec_directives'(G1, Mode, M),
@@ -109,6 +111,10 @@
 	'$consult'(Fs, M).
 '$exec_directive'(use_module(F), _, M) :-
 	'$load_files'(M:F, [if(not_loaded)],use_module(F)).
+'$exec_directive'(reexport(F), _, M) :-
+	'$reexport'(F, all, M).
+'$exec_directive'(reexport(F,Spec), _, M) :-
+	'$reexport'(F, Spec, M).
 '$exec_directive'(use_module(F,Is), _, M) :-
 	'$load_files'(M:F, [if(not_loaded),imports(Is)],use_module(F,Is)).
 '$exec_directive'(use_module(Mod,F,Is), _, _) :-

pl/modules.yap

@@ -99,7 +99,7 @@ module(N) :-
 % redefining a previously-defined file, no problem.
 '$add_preexisting_module_on_file'(F, F, Mod, Exports, R) :- !,
 	erase(R),
-	( recorded('$import','$import'(Mod,_,_,_),R), erase(R), fail; true),
+	( recorded('$import','$import'(Mod,_,_,_,_,_),R), erase(R), fail; true),
 	recorda('$module','$module'(F,Mod,Exports),_).
 '$add_preexisting_module_on_file'(F,F0,Mod,Exports,R) :-
 	repeat,
@@ -119,38 +119,11 @@ module(N) :-
 '$import'([],_,_) :- !.
 '$import'([N/K|L],M,T) :-
 	integer(K), atom(N), !,
-	( '$check_import'(M,T,N,K) ->
+	'$do_import'(N, K, M, T),
-	     ( T = user ->
-	       ( recordzifnot('$import','$import'(M,user,N,K),_) -> true ; true)
-             ;
-	       ( recordaifnot('$import','$import'(M,T,N,K),_) -> true ; true )
-             )
-	 ;
-	    true
-	),
 	'$import'(L,M,T).
 '$import'([PS|L],_,_) :-
 	'$do_error'(domain_error(predicate_spec,PS),import([PS|L])).
 
-'$check_import'(M,T,N,K) :-
-   recorded('$import','$import'(MI,T,N,K),R),
-    \+ '$module_produced by'(M,T,N,K), !,
-    format(user_error,"NAME CLASH: ~w was already imported to module ~w;~n",[MI:N/K,T]),
-    format(user_error,"            Do you want to import it from ~w ? [y or n] ",M),
-    repeat,
-	get0(C), '$skipeol'(C),
-	( C is "y" -> erase(R), !;
-	  C is "n" -> !, fail;
-	  write(user_error, ' Please answer with ''y'' or ''n'' '), fail
-	).
-'$check_import'(_,_,_,_).
-
-'$module_produced by'(M,M0,N,K) :-
-	recorded('$import','$import'(M,M0,N,K),_), !.
-'$module_produced by'(M,M0,N,K) :-
-	recorded('$import','$import'(MI,M0,N,K),_), 
-	'$module_produced by'(M,MI,N,K).	
-
 % $use_preds(Imports,Publics,Mod,M)
 '$use_preds'(Imports,Publics,Mod,M) :- var(Imports), !,
 	'$import'(Publics,Mod,M).
@@ -164,18 +137,49 @@ module(N) :-
     (  '$member'(N/K,Publics) -> true ;
 	print_message(warning,import(N/K,Mod,M,private))
     ),
-    ( '$check_import'(M,Mod,N,K) -> 
+    '$do_import'(N, K, M, Mod).
-	%	     format(user_error,'[ Importing ~w to ~w]~n',[M:N/K,Mod]),
+ 
-        %            '$trace_module'(importing(M:N/K,Mod)),
+
-	  (Mod = user ->
+'$do_import'(N, K, M, T) :-
-             ( recordzifnot('$import','$import'(M,user,N,K),_) -> true ; true )
+	functor(G,N,K),
+	'$follow_import_chain'(M,G,M0,G0),
+	functor(G0,N1,K),
+	( '$check_import'(M0,T,N1,K) ->
+	  ( T = user ->
+	    ( recordzifnot('$import','$import'(M0,user,G0,G,N,K),_) -> true ; true)
 	  ;
-	     ( recordaifnot('$import','$import'(M,Mod,N,K),_) -> true ; true )
+	    ( recordaifnot('$import','$import'(M0,T,G0,G,N,K),_) -> true ; true )
 	  )
 	;
 	  true
 	).
 
+'$follow_import_chain'(M,G,M0,G0) :-
+	recorded('$import','$import'(M1,M,G1,G,_,_),_), !,
+	'$follow_import_chain'(M1,G1,M0,G0).
+'$follow_import_chain'(M,G,M,G).
+
+'$check_import'(M,T,N,K) :-
+   recorded('$import','$import'(MI,T,_,_,N,K),R),
+    \+ '$module_produced by'(M,T,N,K), !,
+    format(user_error,"NAME CLASH: ~w was already imported to module ~w;~n",[MI:N/K,T]),
+    format(user_error,"            Do you want to import it from ~w ? [y or n] ",M),
+    repeat,
+	get0(C), '$skipeol'(C),
+	( C is "y" -> erase(R), !;
+	  C is "n" -> !, fail;
+	  write(user_error, ' Please answer with ''y'' or ''n'' '), fail
+	).
+'$check_import'(_,_,_,_).
+
+'$module_produced by'(M,M0,N,K) :-
+	recorded('$import','$import'(M,M0,_,_,N,K),_), !.
+'$module_produced by'(M,M0,N,K) :-
+	recorded('$import','$import'(MI,M0,G1,_,N,K),_),
+	functor(G1, N1, K1),
+	'$module_produced by'(M,MI,N1,K1).	
+
+
 % expand module names in a clause
 '$module_expansion'(((Mod:H) :-B ),((Mod:H) :- B1),((Mod:H) :- BO),M) :- !,
 	'$prepare_body_with_correct_modules'(B, M, B0),
@@ -279,8 +283,8 @@ module(N) :-
 %
 '$module_expansion'(G, G1, GO, CurMod, MM, TM, HVars) :-
 	% is this imported from some other module M1?
-	( '$imported_pred'(G, CurMod, M1) ->
+	( '$imported_pred'(G, CurMod, GG, M1) ->
-	    '$module_expansion'(G, G1, GO, M1, MM, TM, HVars)
+	    '$module_expansion'(GG, G1, GO, M1, MM, TM, HVars)
 	;
 	( '$meta_expansion'(CurMod, MM, G, GI, HVars)
           ;
@@ -290,10 +294,9 @@ module(N) :-
 	).
 
 
-'$imported_pred'(G, ImportingMod, ExportingMod) :-
+'$imported_pred'(G, ImportingMod, G0, ExportingMod) :-
 	'$undefined'(G, ImportingMod),
-	functor(G,F,N),
+	recorded('$import','$import'(ExportingMod,ImportingMod,G0,G,_,_),_),
-	recorded('$import','$import'(ExportingMod,ImportingMod,F,N),_),
 	ExportingMod \= ImportingMod.
 
 % args are:
@@ -562,6 +565,67 @@ abolish_module(Mod) :-
 	recorded('$module','$module'(_,Mod,_),R), erase(R),
 	fail.
 abolish_module(Mod) :-
-	recorded('$import','$import'(Mod,_,_,_),R), erase(R),
+	recorded('$import','$import'(Mod,_,_,_,_,_),R), erase(R),
 	fail.
 abolish_module(_).
+
+'$reexport'(ModuleSource, Spec, Module) :-
+	nb_getval('$consulting_file',TopFile),
+	(
+	 Spec == all
+	->
+	 Goal =	reexport(ModuleSource)
+	;
+	 Goal =	reexport(ModuleSource,Spec)
+	),
+	absolute_file_name(ModuleSource, File),
+	'$load_files'(File, [if(not_loaded)], Goal),
+	recorded('$module', '$module'(FullFile, Mod, Exports),_),
+	atom_concat(File, _, FullFile), !,
+	'$convert_for_reexport'(Spec, Exports, Tab, MyExports, Goal),
+	'$add_to_imports'(Tab, Module, Mod),
+	recorded('$lf_loaded','$lf_loaded'(TopFile,TopModule,_),_),
+	recorded('$module', '$module'(CurrentFile, Module, ModExports), Ref),
+	erase(Ref),
+	'$append'(ModExports, MyExports, AllExports),
+	recorda('$module', '$module'(CurrentFile, Module, AllExports), _),
+	'$import'(MyExports, Module, TopModule).
+
+'$convert_for_reexport'(all, Exports, Tab, MyExports, _) :-
+	'$simple_conversion'(Exports, Tab, MyExports).
+'$convert_for_reexport'([P1|Ps], Exports, Tab, MyExports, Goal) :-
+	'$clean_conversion'([P1|Ps], Exports, Tab, MyExports, Goal).
+'$convert_for_reexport'(except(List), Exports, Tab, MyExports, Goal) :-
+	'$neg_conversion'(Exports, List, Tab, MyExports, Goal).
+
+'$simple_conversion'([], [], []).
+'$simple_conversion'([P|Exports], [P-P|Tab], [P|MyExports]) :-
+	'$simple_conversion'(Exports, Tab, MyExports).
+
+'$clean_conversion'([], _, [], [], _).
+'$clean_conversion'([P1|Ps], List, [P1-P1|Tab], [P1|MyExports], Goal) :-
+	'$member'(P1, List), !,
+	'$clean_conversion'(Ps, List, Tab, MyExports, Goal).
+'$clean_conversion'([(N1/A1 as N2)|Ps], List, [N1/A1-N2/A1|Tab], [N2/A1|MyExports], Goal) :-
+	'$member'(N1/A1, List), !,
+	'$clean_conversion'(Ps, List, Tab, MyExports, Goal).
+'$clean_conversion'([P|_], _, _, _, Goal) :-
+	'$do_error'(domain_error(module_reexport_predicates,P), Goal).
+	
+'$neg_conversion'([], _, [], [], _).
+'$neg_conversion'([P1|Ps], List, Tab, MyExports, Goal) :-
+	'$member'(P1, List), !,
+	'$neg_conversion'(Ps, List, Tab, MyExports, Goal).
+'$neg_conversion'([N1/A1|Ps], List, [N1/A1-N2/A1|Tab], [N2/A1|MyExports], Goal) :-
+	'$member'(N1/A1 as N2, List), !,
+	'$neg_conversion'(Ps, List, Tab, MyExports, Goal).
+'$neg_conversion'([P|Ps], List, [P-P|Tab], [P|MyExports], Goal) :-
+	'$neg_conversion'(Ps, List, Tab, MyExports, Goal).
+	
+'$add_to_imports'([], _, _).
+'$add_to_imports'([N0/K0-N1/_|Tab], Mod, ModR) :-
+	functor(G,N0,K0),
+	G=..[N0|Args],
+	G1=..[N1|Args],
+	recordaifnot('$import','$import'(ModR,Mod,G,G1,N0,K0),_),
+	'$add_to_imports'(Tab, Mod, ModR).

pl/preds.yap

@@ -634,8 +634,7 @@ abolish(X) :-
 	erase(Ref),
 	fail.
 '$abolishd'(T, M) :-
-	functor(T,N,A),
+	recorded('$import','$import'(_,M,_,T,_,_),R),
-	recorded('$import','$import'(_,M,N,A),R),	
 	erase(R),
 	fail.
 '$abolishd'(T, M) :-
@@ -665,8 +664,7 @@ abolish(X) :-
 	erase(Ref),
 	fail.
 '$abolishs'(T, M) :-
-	functor(T,N,A),
+	recorded('$import','$import'(_,M,_,_,T,_,_),R),
-	recorded('$import','$import'(_,M,N,A),R),
 	erase(R),
 	fail.
 '$abolishs'(G, M) :-
@@ -803,16 +801,14 @@ predicate_property(Pred,Prop) :-
 	'$pred_exists'(Pred,Mod), !,
 	'$predicate_property'(Pred,Mod,Mod,Prop).
 '$predicate_property2'(Pred,Prop,Mod) :- 
-	functor(Pred, N, K),
+	recorded('$import','$import'(M,Mod,NPred,Pred,_,_),_),
-	recorded('$import','$import'(M,Mod,N,K),_),
+	'$predicate_property2'(NPred,Prop,M).
-	'$predicate_property'(Pred,M,Mod,Prop).
 
 '$generate_all_preds_from_mod'(Pred, M, M) :-
 	'$current_predicate'(M,Na,Ar),
 	functor(Pred, Na, Ar).
 '$generate_all_preds_from_mod'(Pred, SourceMod, Mod) :-
-	recorded('$import','$import'(SourceMod,Mod,N,K),_),
+	recorded('$import','$import'(SourceMod,Mod,_,Pred,_,_),_).
-	functor(Pred, N, K).
 
 
 '$predicate_property'(P,M,_,built_in) :- 
@@ -834,8 +830,7 @@ predicate_property(Pred,Prop) :-
 '$predicate_property'(P,M,_,multifile) :-
 	'$is_multifile'(P,M).
 '$predicate_property'(P,Mod,M,imported_from(Mod)) :-
-	functor(P,N,K),
+	recorded('$import','$import'(Mod,M,_,P,_,_),_).
-	recorded('$import','$import'(Mod,M,N,K),_).
 '$predicate_property'(P,M,_,public) :-
 	'$is_public'(P,M).
 '$predicate_property'(P,M,M,exported) :-