Merge branch 'master' of ssh://yap.git.sourceforge.net/gitroot/yap/yap-6.3
This commit is contained in:
Vítor Santos Costa
commit
ff95134c16
30
C/gprof.c
30
C/gprof.c
@ -1156,20 +1156,6 @@ static Int start_profilers(int msec)
|
||||
}
|
||||
|
||||
|
||||
static Int profon(void) {
|
||||
Term p;
|
||||
p=Deref(ARG1);
|
||||
return(start_profilers(IntOfTerm(p)));
|
||||
}
|
||||
|
||||
static Int profon0(void) {
|
||||
return(start_profilers(TIMER_DEFAULT));
|
||||
}
|
||||
|
||||
static Int profison(void) {
|
||||
return (ProfilerOn > 0);
|
||||
}
|
||||
|
||||
static Int profoff(void) {
|
||||
if (ProfilerOn>0) {
|
||||
setitimer(ITIMER_PROF,NULL,NULL);
|
||||
@ -1179,6 +1165,22 @@ static Int profoff(void) {
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
static Int profon(void) {
|
||||
Term p;
|
||||
profoff();
|
||||
p=Deref(ARG1);
|
||||
return(start_profilers(IntOfTerm(p)));
|
||||
}
|
||||
|
||||
static Int profon0(void) {
|
||||
profoff();
|
||||
return(start_profilers(TIMER_DEFAULT));
|
||||
}
|
||||
|
||||
static Int profison(void) {
|
||||
return (ProfilerOn > 0);
|
||||
}
|
||||
|
||||
static Int profalt(void) {
|
||||
if (ProfilerOn==0) return(FALSE);
|
||||
if (ProfilerOn==-1) return profon();
|
||||
|
||||
@ -135,7 +135,7 @@ p_open_shared_object(void) {
|
||||
}
|
||||
|
||||
ofiles = (StringList) Yap_AllocCodeSpace(sizeof(StringListItem));
|
||||
ofiles->next = ofiles;
|
||||
ofiles->next = NULL;
|
||||
ofiles->s = RepAtom(AtomOfTerm(t))->StrOfAE;
|
||||
if ((ptr = Yap_LoadForeignFile(ofiles->s, IntOfTerm(tflags)))==NULL) {
|
||||
return FALSE;
|
||||
@ -179,7 +179,7 @@ p_close_shared_object(void) {
|
||||
if (f0) {
|
||||
f0->next = f->next;
|
||||
} else {
|
||||
ForeignCodeLoaded->next = f->next;
|
||||
ForeignCodeLoaded = f->next;
|
||||
}
|
||||
handle = f->objs->handle;
|
||||
Yap_FreeCodeSpace((ADDR)f->objs);
|
||||
|
||||
@ -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;
|
||||
|
||||
28
C/scanner.c
28
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 (ch == '.') {
|
||||
if (might_be_float && 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;
|
||||
}
|
||||
*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);
|
||||
|
||||
20
C/write.c
20
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) */
|
||||
|
||||
10
docs/yap.tex
10
docs/yap.tex
@ -2339,14 +2339,16 @@ with the current source module:
|
||||
@cnindex meta_predicate/1 (directive)
|
||||
Each @var{Gi} is a mode specification.
|
||||
|
||||
If the argument is @code{:} or an integer, the argument is a call and
|
||||
must be expanded. Otherwise, the argument is not expanded. Note
|
||||
that the system already includes declarations for all built-ins.
|
||||
If the argument is @code{:}, it does not refer directly to a predicate
|
||||
but must be module expanded. If the argument is an integer, the argument
|
||||
is a goal or a closure and must be expanded. Otherwise, the argument is
|
||||
not expanded. Note that the system already includes declarations for all
|
||||
built-ins.
|
||||
|
||||
For example, the declaration for @code{call/1} and @code{setof/3} are:
|
||||
|
||||
@example
|
||||
:- meta_predicate call(:), setof(?,:,?).
|
||||
:- meta_predicate call(0), setof(?,0,?).
|
||||
@end example
|
||||
|
||||
@end table
|
||||
|
||||
@ -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("%ld\n", YAP_IntOfTerm(TrNode_entry(node)));}
|
||||
printf("int(%ld)\n", YAP_IntOfTerm(TrNode_entry(node)));
|
||||
else if (YAP_IsAtomTerm(TrNode_entry(node)))
|
||||
{printf("4\n");
|
||||
printf("%s\n", YAP_AtomName(YAP_AtomOfTerm(TrNode_entry(node))));}
|
||||
printf("atom(%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");
|
||||
}
|
||||
|
||||
@ -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]),
|
||||
|
||||
@ -2,8 +2,8 @@
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
%
|
||||
% $Date: 2010-10-21 10:47:36 +0200 (Thu, 21 Oct 2010) $
|
||||
% $Revision: 4970 $
|
||||
% $Date: 2010-11-09 02:47:35 +0100 (Tue, 09 Nov 2010) $
|
||||
% $Revision: 4991 $
|
||||
%
|
||||
% This file is part of ProbLog
|
||||
% http://dtai.cs.kuleuven.be/problog
|
||||
@ -881,19 +881,21 @@ 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),
|
||||
!,
|
||||
(
|
||||
grounding_is_known(Goal,ID)
|
||||
->
|
||||
true;
|
||||
(
|
||||
user:problog_user_ground(Goal), !,
|
||||
(grounding_is_known(Goal,ID) ->
|
||||
true
|
||||
;
|
||||
(
|
||||
nb_getval(non_ground_fact_grounding_id_counter,ID),
|
||||
ID2 is ID+1,
|
||||
nb_setval(non_ground_fact_grounding_id_counter,ID2),
|
||||
assertz(grounding_is_known(Goal,ID))
|
||||
)
|
||||
)
|
||||
).
|
||||
non_ground_fact_grounding_id(Goal,_) :-
|
||||
format(user_error,'The current program uses non-ground facts.~n', []),
|
||||
|
||||
@ -2,8 +2,8 @@
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
%
|
||||
% $Date: 2010-11-03 19:08:13 +0100 (Wed, 03 Nov 2010) $
|
||||
% $Revision: 4984 $
|
||||
% $Date: 2010-11-09 15:09:33 +0100 (Tue, 09 Nov 2010) $
|
||||
% $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 ->
|
||||
|
||||
30
pl/setof.yap
30
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), !.
|
||||
'$check_list_for_bags'([], _) :- !.
|
||||
'$check_list_for_bags'([_|B], T) :- !,
|
||||
'$check_list_for_bags'(B,T).
|
||||
'$check_list_for_bags'(S, T) :-
|
||||
'$do_error'(type_error(list,S),T).
|
||||
'$partial_list_or_list'(V) :- var(V), !.
|
||||
'$partial_list_or_list'([]) :- !.
|
||||
'$partial_list_or_list'([_|B]) :- !
|
||||
'$partial_list_or_list'(B).
|
||||
|
||||
|
||||
26
pl/utils.yap
26
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).
|
||||
@ -602,7 +626,7 @@ sub_atom(At, Bef, Size, After, SubAt) :-
|
||||
'$subtract_lists_of_variables'(VL1,VL2,VL).
|
||||
'$subtract_lists_of_variables'([V1|VL1],[V2|VL2],[V2|VL]) :-
|
||||
'$subtract_lists_of_variables'([V1|VL1],VL2,VL).
|
||||
|
||||
|
||||
atom_to_term(Atom, Term, Bindings) :-
|
||||
atom_codes(Atom, Chars),
|
||||
charsio:open_mem_read_stream(Chars, Stream),
|
||||
|
||||
Reference in New Issue
Block a user