Merge ../yap-6.2

C/parser.c

@@ -456,10 +456,6 @@ ParseTerm(int prio, JMPBUFF *FailBuff)
 	    t = MkLongIntTerm(-LongIntOfTerm(t));
 	  NextToken;
 	  break;
-	} else if ((Atom)t == AtomPlus) {
-	  t = Yap_tokptr->TokInfo;
-	  NextToken;
-	  break;
 	}
       } else if (Yap_tokptr->Tok == Name_tok) {
 	Atom at = (Atom)Yap_tokptr->TokInfo;

C/scanner.c

@@ -547,7 +547,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
 	ch = Nxtch(inp_stream);
       }
     }
-  } else if ((ch == 'x' || ch == 'X') && base == 0) {
+  } else if (ch == 'x' && base == 0) {
     might_be_float = FALSE;
     if (--max_size == 0) {
       Yap_ErrorMessage = "Number Too Long";
@@ -571,11 +571,11 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
     }
     *chp = ch;
   }
-  else if ((ch == 'o' || ch == 'O') && base == 0) {
+  else if (ch == 'o' && base == 0) {
     might_be_float = FALSE;
     base = 8;
     ch = Nxtch(inp_stream);
-  } else if ((ch == 'b' || ch == 'B') && base == 0) {
+  } else if (ch == 'b' && base == 0) {
     might_be_float = FALSE;
     base = 2;
     ch = Nxtch(inp_stream);
@@ -602,8 +602,8 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
       has_overflow = TRUE;
     ch = Nxtch(inp_stream);
   }
-  if (might_be_float && (ch == '.' || ch == 'e' || ch == 'E')) {
+  if (might_be_float && ch == '.') {
-    if (ch == '.') {
+    {
       if (--max_size == 0) {
 	Yap_ErrorMessage = "Number Too Long";
 	return TermNil;
@@ -628,7 +628,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
       }
       while (chtype(ch = Nxtch(inp_stream)) == NU);
     }
-    if (ch == 'e' || ch == 'E') {
+    if (ch == 'e') {
       char *sp0 = sp;
       char cbuff = ch;
 
@@ -654,15 +654,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
 	/* error */
 	char *sp;
 	*chp = ch;
-	if (*sp0 == 'E') {
-	  /* code the fact that we have E and not e */
-	  if (cbuff == '+')
-	    *chbuffp = '=';
-	  else
-	    *chbuffp = '_';
-	} else {
 	*chbuffp = cbuff;
-	}
 	*sp0 = '\0';
 	for (sp = s; sp < sp0; sp++) {
 	  if (*sp == '.')
@@ -685,11 +677,11 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
     *sp = '\0';
     /* skip base */
     *chp = ch;
-    if (s[0] == '0' && (s[1] == 'x' || s[1] == 'X'))
+    if (s[0] == '0' && s[1] == 'x')
       return read_int_overflow(s+2,16,val,sign);
-    else if (s[0] == '0' && (s[1] == 'o' || s[1] == 'O'))
+    else if (s[0] == '0' && s[1] == 'o')
       return read_int_overflow(s+2,8,val,sign);
-    else if (s[0] == '0' && (s[1] == 'b' || s[1] == 'B'))
+    else if (s[0] == '0' && s[1] == 'b')
       return read_int_overflow(s+2,2,val,sign);
     if (s[1] == '\'')
       return read_int_overflow(s+2,base,val,sign);

C/write.c

@@ -286,6 +286,8 @@ legalAtom(unsigned char *s)			/* Is this a legal atom ? */
       return (*++s == ']' && !(*++s));
     else if (ch == '{')
       return (*++s == '}' && !(*++s));
+    else if (ch == '/')
+      return (*++s != '*');
     else if (Yap_chtype[ch] == SL)
       return (!*++s);
     else if ((ch == ',' || ch == '.') && !s[1])
@@ -304,16 +306,6 @@ legalAtom(unsigned char *s)			/* Is this a legal atom ? */
   return (TRUE);
 }
 
-static int LeftOpToProtect(Atom at, int p)
-{
-  return Yap_IsOpMaxPrio(at) > p;
-}
-
-static int RightOpToProtect(Atom at, int p)
-{
-  return Yap_IsOpMaxPrio(at) > p;
-}
-
 static wtype 
 AtomIsSymbols(unsigned char *s)		/* Is this atom just formed by symbols ? */
 {
@@ -828,7 +820,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
       Term  tright = ArgOfTerm(1, t);
       int            bracket_right =
 	!IsVarTerm(tright) && IsAtomTerm(tright) &&
-	RightOpToProtect(AtomOfTerm(tright), rp);
+	Yap_IsOp(AtomOfTerm(tright));
       if (op > p) {
 	/* avoid stuff such as \+ (a,b) being written as \+(a,b) */
 	if (lastw != separator && !rinfixarg)
@@ -858,7 +850,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
       Int sl = 0;
       int            bracket_left =
 	!IsVarTerm(tleft) && IsAtomTerm(tleft) &&
-	LeftOpToProtect(AtomOfTerm(tleft), lp); 
+	Yap_IsOp(AtomOfTerm(tleft)); 
       if (op > p) {
 	/* avoid stuff such as \+ (a,b) being written as \+(a,b) */
 	if (lastw != separator && !rinfixarg)
@@ -898,10 +890,10 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
       Int sl = 0;
       int   bracket_left =
 	!IsVarTerm(tleft) && IsAtomTerm(tleft) &&
-	LeftOpToProtect(AtomOfTerm(tleft), lp);
+	Yap_IsOp(AtomOfTerm(tleft));
       int   bracket_right =
 	!IsVarTerm(tright) && IsAtomTerm(tright) &&
-	RightOpToProtect(AtomOfTerm(tright), rp);
+	Yap_IsOp(AtomOfTerm(tright));
 
       if (op > p) {
 	/* avoid stuff such as \+ (a,b) being written as \+(a,b) */

library/tries/core_dbtries.c

@@ -261,14 +261,11 @@ void displaynode(TrNode node) {
     else if (TrNode_entry(node) == PairEndTag)
       printf("PairEndTag\n");
     else if (IS_FUNCTOR_NODE(node))
-      {printf("2\n");
+      printf("functor(%s)\n", YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)( ~ApplTag & TrNode_entry(node)))));
-      printf("FUNCTOR %s\n", YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)( ~ApplTag & TrNode_entry(node)))));}
     else if (YAP_IsIntTerm(TrNode_entry(node)))
-      {printf("3\n");
+      printf("int(%ld)\n", YAP_IntOfTerm(TrNode_entry(node)));
-      printf("%ld\n", YAP_IntOfTerm(TrNode_entry(node)));}
     else if (YAP_IsAtomTerm(TrNode_entry(node)))
-      {printf("4\n");
+       printf("atom(%s)\n", YAP_AtomName(YAP_AtomOfTerm(TrNode_entry(node))));
-      printf("%s\n", YAP_AtomName(YAP_AtomOfTerm(TrNode_entry(node))));}
     else
       printf("What?\n");
   } else
@@ -627,10 +624,14 @@ TrNode core_breadth_reduction(TrEngine engine, TrNode node, TrNode breadth_node,
           while(!(child = *--bucket));
         }
       }
-      TrNode temp = TrNode_child(child);
+      if (TrNode_child(child) == NULL) return NULL;
+      if (TrNode_entry(TrNode_child(child)) != PairEndTag) return NULL;
+      
+      
+   /*   TrNode temp = TrNode_child(child);
       if (temp == NULL)
         return NULL;
-// printf("Chosen start node child: "); displaynode(temp);
+ printf("Chosen start node child: "); displaynode(temp);
       if (IS_HASH_NODE(temp)) {
         TrNode *first_bucket, *bucket;
         TrHash hash = (TrHash) temp;
@@ -646,17 +647,19 @@ TrNode core_breadth_reduction(TrEngine engine, TrNode node, TrNode breadth_node,
       } else {
         while((temp != NULL) && (TrNode_entry(temp) != PairEndTag))
           temp = TrNode_next(temp);
-      }
+      }*/
 // printf("while end\n");
       //Nested Trie code
       if (IS_FUNCTOR_NODE(TrNode_parent(child)) && (strcmp(YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)(~ApplTag & TrNode_entry(TrNode_parent(child))))), NESTED_TRIE_TERM) == 0)) {
         /* nested trie: stop procedure and return nested trie node */
         return child;
       }
+      
+
       PUSH_DOWN(stack_args, TrNode_entry(child), stack_top);
       count++;
       if (IS_FUNCTOR_NODE(TrNode_parent(child))) {
-        temp = TrNode_parent(child);
+        TrNode temp = TrNode_parent(child);
         while (IS_FUNCTOR_NODE(temp)) {
           PUSH_DOWN(stack_args, TrNode_entry(temp), stack_top);
           temp = TrNode_parent(temp);
@@ -665,6 +668,8 @@ TrNode core_breadth_reduction(TrEngine engine, TrNode node, TrNode breadth_node,
           child = TrNode_parent(child);
       }
       child = TrNode_next(child);
+         //   printf("Siblings: ");displaynode(child);
+
     } while (child);
 //      printf("pass through\n");
   }

packages/ProbLog/dtproblog.yap

@@ -408,7 +408,7 @@ set_strategy(_) :-
 set_strategy([]) :- problog_control(on,internal_strategy).
 set_strategy([Term|R]) :-
   strategy_entry(Term,LogProb,Decision),
-  (ground(Decision)->
+  (user:problog_user_ground(Decision)->
       decision_fact(ID,Decision),
       grounding_id(ID,Decision,ID2),
       %format("Setting ~q/~q to ~q~n",[Decision,ID2,Prob]),
@@ -427,7 +427,7 @@ unset_strategy([]) :-
   problog_control(off,internal_strategy).
 unset_strategy([Term|R]) :-
   strategy_entry(Term,LogProb,Decision),
-  (ground(Decision)->
+  (user:problog_user_ground(Decision)->
       decision_fact(ID,Decision),
       grounding_id(ID,Decision,ID2),
       %format("Unsetting ~q/~q to ~q~n",[Decision,ID2,Prob]),

packages/ProbLog/problog.yap

@@ -2,8 +2,8 @@
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %
-%  $Date: 2010-10-21 10:47:36 +0200 (Thu, 21 Oct 2010) $
+%  $Date: 2010-11-09 02:47:35 +0100 (Tue, 09 Nov 2010) $
-%  $Revision: 4970 $
+%  $Revision: 4991 $
 %
 %  This file is part of ProbLog
 %  http://dtai.cs.kuleuven.be/problog
@@ -881,13 +881,15 @@ problog_predicate(Name, Arity, ProblogName,Mod) :-
 % non-ground probabilistic facts
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
+:- multifile(user:problog_user_ground/1).
+user:problog_user_ground(Goal) :-
+  ground(Goal).
+
 non_ground_fact_grounding_id(Goal,ID) :-
-	ground(Goal),
+  user:problog_user_ground(Goal), !,
-	!,
+	(grounding_is_known(Goal,ID) ->
-	(
+	  true
-	 grounding_is_known(Goal,ID)
+	;
-	->
-	 true;
 	  (
 	  nb_getval(non_ground_fact_grounding_id_counter,ID),
 	  ID2 is ID+1,

packages/ProbLog/problog/tabling.yap

@@ -2,8 +2,8 @@
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %
-%  $Date: 2010-11-03 19:08:13 +0100 (Wed, 03 Nov 2010) $
+%  $Date: 2010-11-09 15:09:33 +0100 (Tue, 09 Nov 2010) $
-%  $Revision: 4984 $
+%  $Revision: 4992 $
 %
 %  This file is part of ProbLog
 %  http://dtai.cs.kuleuven.be/problog
@@ -355,7 +355,7 @@ problog_table(Name/Arity, Module) :-
   % Exact method tabling
   assert_static((
     Module:ExactPred :-
-      (ground(ExactPred) ->
+      (user:problog_user_ground(Head) ->
         nb_setval(problog_nested_tries, true),
         get_negated_synonym_state(OriginalPred, State),
         (State = false ->

pl/setof.yap

@@ -32,7 +32,11 @@ _^Goal :-
 
 
 findall(Template, Generator, Answers) :-
-	'$check_list_for_bags'(Answers, findall(Template, Generator, Answers)),
+	( '$partial_list_or_list'(Answers) ->
+		true
+	;
+		'$do_error'(type_error(list,Answers), findall(Template, Generator, Answers))
+	),
 	'$findall'(Template, Generator, [], Answers).
 
 
@@ -76,7 +80,11 @@ findall(Template, Generator, Answers, SoFar) :-
 % This is the setof predicate
 
 setof(Template, Generator, Set) :-
-	'$check_list_for_bags'(Set, setof(Template, Generator, Set)),
+	( '$partial_list_or_list'(Set) ->
+		true
+	;
+		'$do_error'(type_error(list,Set), setof(Template, Generator, Set))
+	),
 	'$bagof'(Template, Generator, Bag),
 	'$sort'(Bag, Set).
 
@@ -87,10 +95,14 @@ setof(Template, Generator, Set) :-
 % of these variables
 
 bagof(Template, Generator, Bag) :-
+	( '$partial_list_or_list'(Bag) ->
+		true
+	;
+		'$do_error'(type_error(list,Bag), bagof(Template, Generator, Bag))
+	),
 	'$bagof'(Template, Generator, Bag).
 
 '$bagof'(Template, Generator, Bag) :-
-	'$check_list_for_bags'(Bag, bagof(Template, Generator, Bag)),
 	'$variables_in_term'(Template, [], TemplateV),
 	'$excess_vars'(Generator, StrippedGenerator, TemplateV, [], FreeVars),
 	( FreeVars \== [] ->
@@ -223,10 +235,8 @@ all(T,G,S) :-
 '$$split'([T1|Tn],T,X,S1,[T1|S2]) :- '$$split'(Tn,T,X,S1,S2).
 
 
-'$check_list_for_bags'(V, _) :- var(V), !.
+'$partial_list_or_list'(V) :- var(V), !.
-'$check_list_for_bags'([], _) :- !.
+'$partial_list_or_list'([]) :- !.
-'$check_list_for_bags'([_|B], T) :- !,
+'$partial_list_or_list'([_|B]) :- !
-	'$check_list_for_bags'(B,T).
+	'$partial_list_or_list'(B).
-'$check_list_for_bags'(S, T) :-
-	'$do_error'(type_error(list,S),T).
 

pl/utils.yap

@@ -215,6 +215,30 @@ current_op(X,Y,Z) :-
 
 %%% Operating System utilities
 
+cd :-
+	cd('~').
+
+ls :-
+	getcwd(X),
+	system:directory_files(X, L),
+	'$do_print_files'(L).
+
+'$do_print_files'([]) :-
+	nl.
+'$do_print_files'([F| Fs]) :-
+	'$do_print_file'(F),
+	'$do_print_files'(Fs).
+
+'$do_print_file'('.') :- !.
+'$do_print_file'('..') :- !.
+'$do_print_file'(F) :- atom_concat('.', _, F), !.
+'$do_print_file'(F) :-
+	write(F), write('  ').
+
+pwd :-
+	getcwd(X),
+	write(X), nl.
+
 unix(V) :- var(V), !,
 	'$do_error'(instantiation_error,unix(V)).
 unix(argv(L)) :- '$is_list_of_atoms'(L,L), !, '$argv'(L).