diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'master' of ssh://yap.git.sourceforge.net/gitroot/yap/yap-6.3

Browse Source
This commit is contained in:
Vítor Santos Costa 2010-11-22 18:08:09 +00:00
commit ff95134c16
12 changed files with 117 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
C/gprof.c
View File

@ -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();

4
C/load_foreign.c
View File

@ -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);

4
C/parser.c
View File

@ -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;

26
C/scanner.c
View File

@ -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;
}
*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
View File

@ -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
View File

@ -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

25
library/tries/core_dbtries.c
View File

@ -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");
}

4
packages/ProbLog/dtproblog.yap
View File

@ -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]),

18
packages/ProbLog/problog.yap
View File

@ -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,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),
!,
(
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,

6
packages/ProbLog/problog/tabling.yap
View File

@ -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 ->

28
pl/setof.yap
View File

@ -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).

24
pl/utils.yap
View File

@ -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).