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

C/gprof.c

@@ -213,7 +213,7 @@ static void
 LeftRotate(rb_red_blk_node* x) {
   CACHE_REGS
   rb_red_blk_node* y;
-  rb_red_blk_node* nil=LOCAL_ProfilerNil;
+  rb_red_blk_node* rb_nil=LOCAL_ProfilerNil;
 
   /*  I originally wrote this function to use the sentinel for */
   /*  nil to avoid checking for nil.  However this introduces a */
@@ -228,7 +228,7 @@ LeftRotate(rb_red_blk_node* x) {
   y=x->right;
   x->right=y->left;
 
-  if (y->left != nil) y->left->parent=x; /* used to use sentinel here */
+  if (y->left != rb_nil) y->left->parent=x; /* used to use sentinel here */
   /* and do an unconditional assignment instead of testing for nil */
   
   y->parent=x->parent;   
@@ -270,7 +270,7 @@ static void
 RightRotate(rb_red_blk_node* y) {
   CACHE_REGS
   rb_red_blk_node* x;
-  rb_red_blk_node* nil=LOCAL_ProfilerNil;
+  rb_red_blk_node* rb_nil=LOCAL_ProfilerNil;
 
   /*  I originally wrote this function to use the sentinel for */
   /*  nil to avoid checking for nil.  However this introduces a */
@@ -285,7 +285,7 @@ RightRotate(rb_red_blk_node* y) {
   x=y->left;
   y->left=x->right;
 
-  if (nil != x->right)  x->right->parent=y; /*used to use sentinel here */
+  if (rb_nil != x->right)  x->right->parent=y; /*used to use sentinel here */
   /* and do an unconditional assignment instead of testing for nil */
 
   /* instead of checking if x->parent is the root as in the book, we */
@@ -325,12 +325,12 @@ TreeInsertHelp(rb_red_blk_node* z) {
   /*  This function should only be called by InsertRBTree (see above) */
   rb_red_blk_node* x;
   rb_red_blk_node* y;
-  rb_red_blk_node* nil=LOCAL_ProfilerNil;
+  rb_red_blk_node* rb_nil=LOCAL_ProfilerNil;
   
-  z->left=z->right=nil;
+  z->left=z->right=rb_nil;
   y=LOCAL_ProfilerRoot;
   x=LOCAL_ProfilerRoot->left;
-  while( x != nil) {
+  while( x != rb_nil) {
     y=x;
     if (x->key > z->key) { /* x.key > z.key */
       x=x->left;
@@ -447,18 +447,18 @@ static rb_red_blk_node*
 RBExactQuery(yamop* q) {
   CACHE_REGS
   rb_red_blk_node* x;
-  rb_red_blk_node* nil=LOCAL_ProfilerNil;
+  rb_red_blk_node* rb_nil=LOCAL_ProfilerNil;
 
   if (!LOCAL_ProfilerRoot) return NULL;
   x=LOCAL_ProfilerRoot->left;
-  if (x == nil) return NULL;
+  if (x == rb_nil) return NULL;
   while(x->key != q) {/*assignemnt*/
     if (x->key > q) { /* x->key > q */
       x=x->left;
     } else {
       x=x->right;
     }
-    if ( x == nil) return NULL;
+    if ( x == rb_nil) return NULL;
   }
   return(x);
 }
@@ -584,11 +584,11 @@ static rb_red_blk_node*
 TreeSuccessor(rb_red_blk_node* x) { 
   CACHE_REGS
   rb_red_blk_node* y;
-  rb_red_blk_node* nil=LOCAL_ProfilerNil;
+  rb_red_blk_node* rb_nil=LOCAL_ProfilerNil;
   rb_red_blk_node* root=LOCAL_ProfilerRoot;
 
-  if (nil != (y = x->right)) { /* assignment to y is intentional */
+  if (rb_nil != (y = x->right)) { /* assignment to y is intentional */
-    while(y->left != nil) { /* returns the minium of the right subtree of x */
+    while(y->left != rb_nil) { /* returns the minium of the right subtree of x */
       y=y->left;
     }
     return(y);
@@ -598,7 +598,7 @@ TreeSuccessor(rb_red_blk_node* x) {
       x=y;
       y=y->parent;
     }
-    if (y == root) return(nil);
+    if (y == root) return(rb_nil);
     return(y);
   }
 }
@@ -624,11 +624,11 @@ RBDelete(rb_red_blk_node* z){
   CACHE_REGS
   rb_red_blk_node* y;
   rb_red_blk_node* x;
-  rb_red_blk_node* nil=LOCAL_ProfilerNil;
+  rb_red_blk_node* rb_nil=LOCAL_ProfilerNil;
   rb_red_blk_node* root=LOCAL_ProfilerRoot;
 
-  y= ((z->left == nil) || (z->right == nil)) ? z : TreeSuccessor(z);
+  y= ((z->left == rb_nil) || (z->right == rb_nil)) ? z : TreeSuccessor(z);
-  x= (y->left == nil) ? y->right : y->left;
+  x= (y->left == rb_nil) ? y->right : y->left;
   if (root == (x->parent = y->parent)) { /* assignment of y->p to x->p is intentional */
     root->left=x;
   } else {

C/heapgc.c

@@ -622,7 +622,7 @@ RBTreeCreate(void) {
 static void
 LeftRotate(rb_red_blk_node* x USES_REGS) {
   rb_red_blk_node* y;
-  rb_red_blk_node* nil=LOCAL_db_nil;
+  rb_red_blk_node* rb_nil=LOCAL_db_nil;
 
   /*  I originally wrote this function to use the sentinel for */
   /*  nil to avoid checking for nil.  However this introduces a */
@@ -637,7 +637,7 @@ LeftRotate(rb_red_blk_node* x USES_REGS) {
   y=x->right;
   x->right=y->left;
 
-  if (y->left != nil) y->left->parent=x; /* used to use sentinel here */
+  if (y->left != rb_nil) y->left->parent=x; /* used to use sentinel here */
   /* and do an unconditional assignment instead of testing for nil */
   
   y->parent=x->parent;   
@@ -678,7 +678,7 @@ LeftRotate(rb_red_blk_node* x USES_REGS) {
 static void
 RightRotate(rb_red_blk_node* y USES_REGS) {
   rb_red_blk_node* x;
-  rb_red_blk_node* nil=LOCAL_db_nil;
+  rb_red_blk_node* rb_nil=LOCAL_db_nil;
 
   /*  I originally wrote this function to use the sentinel for */
   /*  nil to avoid checking for nil.  However this introduces a */
@@ -693,7 +693,7 @@ RightRotate(rb_red_blk_node* y USES_REGS) {
   x=y->left;
   y->left=x->right;
 
-  if (nil != x->right)  x->right->parent=y; /*used to use sentinel here */
+  if (rb_nil != x->right)  x->right->parent=y; /*used to use sentinel here */
   /* and do an unconditional assignment instead of testing for nil */
 
   /* instead of checking if x->parent is the root as in the book, we */
@@ -732,12 +732,12 @@ TreeInsertHelp(rb_red_blk_node* z USES_REGS) {
   /*  This function should only be called by InsertRBTree (see above) */
   rb_red_blk_node* x;
   rb_red_blk_node* y;
-  rb_red_blk_node* nil=LOCAL_db_nil;
+  rb_red_blk_node* rb_nil=LOCAL_db_nil;
   
-  z->left=z->right=nil;
+  z->left=z->right=rb_nil;
   y=LOCAL_db_root;
   x=LOCAL_db_root->left;
-  while( x != nil) {
+  while( x != rb_nil) {
     y=x;
     if (x->key < z->key) { /* x.key > z.key */
       x=x->left;

C/init.c

@@ -1368,6 +1368,7 @@ void
 Yap_exit (int value)
 {
   CACHE_REGS
+  void closeFiles(int all);
 #if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA)
   Yap_unmap_yapor_memory();
 #endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA */
@@ -1383,6 +1384,7 @@ Yap_exit (int value)
     run_halt_hooks(value);
     Yap_ShutdownLoadForeign();
   }
+  closeFiles(TRUE);
   exit(value);
 }
 

docs/yap.tex

@@ -4664,7 +4664,10 @@ will not have a leading dot.
 Defines the relation: The stream @var{S} is opened on the file @var{F}
 in mode @var{M}. It might be used to obtain all open streams (by
 backtracking) or to access the stream for a file @var{F} in mode
-@var{M}, or to find properties for a stream @var{S}.
+@var{M}, or to find properties for a stream @var{S}. Notice that some
+streams might not be associated to a file: in this case YAP tries to
+return the file number. If that is not available, YAP unifies @var{F}
+with @var(S}.
 
 @item is_stream(@var{S})
 @findex is_stream/1

packages/CLPBN/Makefile.in

@@ -100,7 +100,7 @@ CLPBN_LEARNING_EXAMPLES= \
 
 CLPBN_EXAMPLES= \
 	$(CLPBN_EXDIR)/burglary-alarm.fg \
-	$(CLPBN_EXDIR)/burglary-alarm.yap \
+	$(CLPBN_EXDIR)/burglary-alarm.pfl \
 	$(CLPBN_EXDIR)/burglary-alarm.uai \
 	$(CLPBN_EXDIR)/cg.yap \
 	$(CLPBN_EXDIR)/city.yap \

packages/CLPBN/clpbn.yap

@@ -16,6 +16,7 @@
 		  op( 500, xfy, with)]).
 
 :- use_module(library(atts)).
+:- use_module(library(bhash)).
 :- use_module(library(lists)).
 :- use_module(library(terms)).
 
@@ -232,7 +233,7 @@ project_attributes(GVars, _AVars0) :-
 	use_parfactors(on),
 	clpbn_flag(solver, Solver), Solver \= fove, !,
 	generate_network(GVars, GKeys, Keys, Factors, Evidence),
-	call_ground_solver(Solver, GVars, GKeys, Keys, Factors, Evidence, _Avars0).
+	call_ground_solver(Solver, GVars, GKeys, Keys, Factors, Evidence).
 project_attributes(GVars, AVars) :-
 	suppress_attribute_display(false),
 	AVars = [_|_],
@@ -314,8 +315,62 @@ write_out(fove, GVars, AVars, DiffVars) :-
 	call_horus_lifted_solver(GVars, AVars, DiffVars).
 
 % call a solver with keys, not actual variables
-call_ground_solver(bp, GVars, GoalKeys, Keys, Factors, Evidence, Answ) :-
+call_ground_solver(bp, GVars, GoalKeys, Keys, Factors, Evidence) :- !,
-	call_horus_ground_solver(GVars, GoalKeys, Keys, Factors, Evidence, Answ).
+	call_horus_ground_solver(GVars, GoalKeys, Keys, Factors, Evidence, _Answ).
+call_ground_solver(Solver, GVars, _GoalKeys, Keys, Factors, Evidence) :-
+	% traditional solver
+	b_hash_new(Hash0),
+	gvars_in_hash(GVars,Hash0, HashI), 
+	keys_to_vars(Keys, AllVars, HashI, Hash1),
+	evidence_to_vars(Evidence, _EVars, Hash1, Hash),
+	factors_to_dists(Factors, Hash),
+	% evidence
+	retract(use_parfactors(on)),
+	write_out(Solver, [GVars], AllVars, _),
+	assert(use_parfactors(on)).
+
+%
+% convert a PFL network (without constriants)
+% into CLP(BN) for evaluation
+%
+gvars_in_hash([V|GVars],Hash0, Hash) :-
+	get_atts(V, [key(K)]),
+	b_hash_insert(Hash0, K, V, HashI),
+	gvars_in_hash(GVars,HashI, Hash).
+gvars_in_hash([],Hash, Hash). 
+
+
+keys_to_vars([], [], Hash, Hash).
+keys_to_vars([K|Keys], [V|Vs], Hash0, Hash) :-
+	b_hash_lookup(K, V, Hash0), !,
+	keys_to_vars(Keys, Vs, Hash0, Hash).
+keys_to_vars([K|Keys], [V|Vs],Hash0, Hash) :-
+	b_hash_insert(Hash0, K, V, HashI),
+	keys_to_vars(Keys, Vs, HashI, Hash).
+
+evidence_to_vars([], [], Hash, Hash).
+evidence_to_vars([K=E|Keys], [V|Vs], Hash0, Hash) :-
+	b_hash_lookup(K, V, Hash0), !,
+	clpbn:put_atts(V,[evidence(E)]),
+	evidence_to_vars(Keys, Vs, Hash0, Hash).
+evidence_to_vars([K=E|Keys], [V|Vs],Hash0, Hash) :-
+	b_hash_insert(Hash0, K, V, HashI),
+	clpbn:put_atts(V,[evidence(E)]),
+	evidence_to_vars(Keys, Vs, HashI, Hash).
+
+factors_to_dists([], _Hash).
+factors_to_dists([f(bayes,_Id,Ks,CPT)|Factors], Hash) :-
+	keys_to_vars(Ks, Hash, [V|Parents]),
+	Ks =[Key|_],
+	pfl:skolem(Key, Domain),
+	dist(p(Domain,CPT,Parents), DistInfo, Key, Parents),
+	put_atts(V,[dist(DistInfo,Parents)]),
+	factors_to_dists(Factors, Hash).
+
+keys_to_vars([], _Hash, []).
+keys_to_vars([K|Ks], Hash, [V|Vs]) :-
+	b_hash_lookup(K,V,Hash),
+	keys_to_vars(Ks, Hash, Vs).
 
 
 get_bnode(Var, Goal) :-

packages/CLPBN/clpbn/horus_ground.yap

@@ -58,20 +58,21 @@ call_horus_ground_solver(QueryVars, QueryKeys, AllKeys, Factors, Evidence, Outpu
 call_horus_ground_solver_for_probabilities(QueryKeys, _AllKeys, Factors, Evidence, Solutions) :-
 	attributes:all_attvars(AVars),
 	keys(AVars, AllKeys),
+writeln(AllKeys),
 	b_hash_new(Hash0),
-	keys_to_ids(AllKeys, 0, Hash0, Hash),
+	keys_to_ids(AllKeys, 0, Id1, Hash0, Hash1),
 	get_factors_type(Factors, Type),
-	evidence_to_ids(Evidence, Hash, EvidenceIds),
+	evidence_to_ids(Evidence, Hash1, Hash2, Id1, Id2, EvidenceIds),
-	factors_to_ids(Factors, Hash, FactorIds),
+	factors_to_ids(Factors, Hash2, Hash, Id2, _, FactorIds),
 	writeln(queryKeys:QueryKeys), writeln(''),
 	writeln(type:Type), writeln(''),
 	writeln(allKeys:AllKeys), writeln(''),
 	sort(AllKeys,SKeys),writeln(allSortedKeys:SKeys), writeln(''),
-	keys_to_ids(SKeys, 0, Hash0, Hash),
+	keys_to_ids(SKeys, 0, _, Hash0, Hash),
-	writeln(factors:Factors), writeln(''),
+% 	writeln(factors:Factors), writeln(''),
-	writeln(factorIds:FactorIds), writeln(''),
+% 	writeln(factorIds:FactorIds), writeln(''),
-	writeln(evidence:Evidence), writeln(''),
+% 	writeln(evidence:Evidence), writeln(''),
-	writeln(evidenceIds:EvidenceIds), writeln(''),
+% 	writeln(evidenceIds:EvidenceIds), writeln(''),
 	cpp_create_ground_network(Type, FactorIds, EvidenceIds, Network),
 	get_vars_information(AllKeys, StatesNames),
 	terms_to_atoms(AllKeys, KeysAtoms),
@@ -91,51 +92,59 @@ keys([_V|AVars], AllKeys) :-
 run_solver(ground(Network,Hash), QueryKeys, Solutions) :-
   %get_dists_parameters(DistIds, DistsParams),
   %cpp_set_factors_params(Network, DistsParams),
-  list_of_keys_to_ids(QueryKeys, Hash, QueryIds),
+  list_of_keys_to_ids(QueryKeys, Hash, _, _, _, QueryIds),
   %writeln(queryKeys:QueryKeys), writeln(''),
   %writeln(queryIds:QueryIds), writeln(''),
   cpp_run_ground_solver(Network, [QueryIds], Solutions).
 
 
-keys_to_ids([], _, Hash, Hash).
+keys_to_ids([], Id, Id, Hash, Hash).
-keys_to_ids([Key|AllKeys], I0, Hash0, Hash) :-
+keys_to_ids([Key|AllKeys], I0, I, Hash0, Hash) :-
   b_hash_insert(Hash0, Key, I0, HashI),
-  I is I0+1,
+  I1 is I0+1,
-  keys_to_ids(AllKeys, I, HashI, Hash).
+  keys_to_ids(AllKeys, I1, I, HashI, Hash).
 
 
 get_factors_type([f(bayes, _, _, _)|_], bayes) :- ! .
 get_factors_type([f(markov, _, _, _)|_], markov) :- ! .
 
 
-list_of_keys_to_ids([], _, []).
+list_of_keys_to_ids([], H, H, I, I, []).
-list_of_keys_to_ids([List|Extra], Hash, [IdList|More]) :-
+list_of_keys_to_ids([List|Extra], Hash0, Hash, I0, I, [IdList|More]) :-
 	List = [_|_], !,
-	list_of_keys_to_ids(List, Hash, IdList),
+	list_of_keys_to_ids(List, Hash0, Hash1, I0, I1, IdList),
-	list_of_keys_to_ids(Extra, Hash, More).
+	list_of_keys_to_ids(Extra, Hash1, Hash, I1, I, More).
-list_of_keys_to_ids([Key|QueryKeys], Hash, [Id|QueryIds]) :-
+list_of_keys_to_ids([Key|QueryKeys], Hash0, Hash, I0, I, [Id|QueryIds]) :-
-	b_hash_lookup(Key, Id, Hash),
+	b_hash_lookup(Key, Id, Hash0), !,
-	list_of_keys_to_ids(QueryKeys, Hash, QueryIds).
+	list_of_keys_to_ids(QueryKeys, Hash0, Hash, I0, I, QueryIds).
+list_of_keys_to_ids([Key|QueryKeys], Hash0, Hash, I0, I, [I0|QueryIds]) :-
+	b_hash_insert(Hash0, Key, I0, Hash1),
+	I1 is I0+1,
+	list_of_keys_to_ids(QueryKeys, Hash1, Hash, I1, I, QueryIds).
 
 
-factors_to_ids([], _, []).
+factors_to_ids([], H, H, I, I, []).
-factors_to_ids([f(_, DistId, Keys, CPT)|Fs], Hash, [f(Ids, Ranges, CPT, DistId)|NFs]) :-
+factors_to_ids([f(_, DistId, Keys, CPT)|Fs], Hash0, Hash, I0, I, [f(Ids, Ranges, CPT, DistId)|NFs]) :-
-  list_of_keys_to_ids(Keys, Hash, Ids),
+	list_of_keys_to_ids(Keys, Hash0, Hash1, I0, I1, Ids),
-  get_ranges(Keys, Ranges),
+	get_ranges(Keys, Ranges),
-  factors_to_ids(Fs, Hash, NFs).
+	factors_to_ids(Fs, Hash1, Hash, I1, I, NFs).
 
 
 get_ranges([],[]).
 get_ranges(K.Ks, Range.Rs) :- !,
-  skolem(K,Domain),
+	skolem(K,Domain),
-  length(Domain,Range),
+	length(Domain,Range),
-  get_ranges(Ks, Rs).
+	get_ranges(Ks, Rs).
 
 
-evidence_to_ids([], _, []).
+evidence_to_ids([], H, H, I, I, []).
-evidence_to_ids([Key=Ev|QueryKeys], Hash, [Id=Ev|QueryIds]) :-
+evidence_to_ids([Key=Ev|QueryKeys], Hash0, Hash, I0, I, [Id=Ev|QueryIds]) :-
-  b_hash_lookup(Key, Id, Hash),
+	b_hash_lookup(Key, Id, Hash0),
-  evidence_to_ids(QueryKeys, Hash, QueryIds).
+	evidence_to_ids(QueryKeys, Hash0, Hash, I0, I, QueryIds).
+evidence_to_ids([Key=Ev|QueryKeys], Hash0, Hash, I0, I, [I=Ev|QueryIds]) :-
+	b_hash_insert(Hash0, Key, I0, Hash1),
+	I1 is I0+1,
+	evidence_to_ids(QueryKeys, Hash1, Hash, I1, I, QueryIds).
 
 
 get_vars_information([], []).

packages/CLPBN/clpbn/ve.yap

@@ -102,9 +102,8 @@ solve_ve([LVs|_], [NVs0|_], Ps) :-
 	sort(LV0, LV),
 	% construct the graph
 	find_all_table_deps(Tables0, LV),
-%writeln((Li: LVs: LV)),
 	process(LVi, LVs, tab(Dist,_,_)),
-%writeln(m:Dist),matrix:matrix_to_list(Dist,LD),writeln(LD),
+% writeln(m:Dist),matrix:matrix_to_list(Dist,LD),writeln(LD),
 %exps(LD,LDE),writeln(LDE),
 	% move from potentials back to probabilities
 	normalise_CPT(Dist,MPs),

pl/boot.yap

@@ -518,14 +518,17 @@ true :- true.
 % *-> at this point would require compiler support, which does not exist.
 %
 '$delayed_goals'(G, V, NV, LGs, NCP) :-
-	if(
+	(
-	  (yap_hacks:current_choice_point(NCP1),
+	  CP is '$last_choice_pt',
+	  yap_hacks:current_choice_point(NCP1),
 	  '$attributes':delayed_goals(G, V, NV, LGs),
-	  yap_hacks:current_choice_point(NCP2))
+	  yap_hacks:current_choice_point(NCP2),
-	  ,
+	 '$clean_ifcp'(CP),
-	   (NCP is NCP2-NCP1)
+	   NCP is NCP2-NCP1
-	  , 
+	  ;
-	   (copy_term_nat(V, NV), LGs = [], NCP = 0)
+	   copy_term_nat(V, NV), 
+	   LGs = [], 
+	   NCP = 0
         ).
 
 '$out_neg_answer' :-

pl/yio.yap

@@ -98,6 +98,16 @@ socket(Domain, Type, Protocol, Sock) :-
 	),
 	yap_sockets:ip_socket(Domain, Type, Protocol, Sock).
 
+socket_connect(Sock, Host, Read) :-
+	(
+	 '$undefined'(ip_socket(_,_),yap_sockets)
+	->
+	 load_files(library(sockets), [silent(true),if(not_loaded)])
+	;
+	 true
+	),
+	yap_sockets:ip_socket(Domain, Type, Protocol, Sock).
+
 open_pipe_streams(Read, Write) :-
 	(
 	 '$undefined'(pipe(_,_),unix)
@@ -263,6 +273,7 @@ current_line_number(Stream,N) :-
 
 stream_position(Stream, Position) :-
 	stream_property(Stream, position(Position)).
+
 stream_position(Stream, Position, NewPosition) :-
 	stream_property(Stream, position(Position)),
 	set_stream_position(Stream, NewPosition).
@@ -292,8 +303,15 @@ current_char_conversion(X,Y) :-
 	'$fetch_char_conversion'(List,X,Y).
 
 
-current_stream(File, Opts, Stream) :-
+current_stream(File, Mode, Stream) :-
-	'$current_stream'(File, Opts, Stream).
+    stream_property(Stream, mode(Mode)),
+    '$stream_name'(Stream, File).
+
+'$stream_name'(Stream, File) :-
+    stream_property(Stream, file_name(File)), !.
+'$stream_name'(Stream, file_no(File)) :-
+    stream_property(Stream, file_no(File)), !.
+'$stream_name'(Stream, Stream).
 
 '$extend_file_search_path'(P) :-
 	atom_codes(P,S),