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

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

Browse Source
This commit is contained in:
Vítor Santos Costa 2010-11-22 17:53:42 +00:00
commit 80b2253de1
6 changed files with 86 additions and 68 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;

32
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,7 +602,11 @@ 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 == '.' || ch == 'e' || ch == 'E')) {
if (yap_flags[STRICT_ISO_FLAG] && (ch == 'e' || ch == 'E')) {
Yap_ErrorMessage = "Float format not allowed in ISO mode";
return TermNil;
}
if (ch == '.') {
if (--max_size == 0) {
Yap_ErrorMessage = "Number Too Long";
@ -632,6 +636,10 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
char *sp0 = sp;
char cbuff = ch;
if (yap_flags[STRICT_ISO_FLAG] && ch == 'E') {
Yap_ErrorMessage = "Float format not allowed in ISO mode";
return TermNil;
}
if (--max_size == 0) {
Yap_ErrorMessage = "Number Too Long";
return TermNil;
@ -654,15 +662,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 +685,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);

54
C/write.c
View File

@ -78,8 +78,8 @@ STATIC_PROTO(void wrputs, (char *, wrf));
STATIC_PROTO(void wrputf, (Float, wrf));
STATIC_PROTO(void wrputref, (CODEADDR, int, wrf));
STATIC_PROTO(int legalAtom, (unsigned char *));
STATIC_PROTO(int LeftOpToProtect, (Atom, int));
STATIC_PROTO(int RightOpToProtect, (Atom, int));
/*STATIC_PROTO(int LeftOpToProtect, (Atom, int));
STATIC_PROTO(int RightOpToProtect, (Atom, int));*/
STATIC_PROTO(wtype AtomIsSymbols, (unsigned char *));
STATIC_PROTO(void putAtom, (Atom, int, wrf));
STATIC_PROTO(void writeTerm, (Term, int, int, int, struct write_globs *, struct rewind_term *));
@ -212,6 +212,7 @@ wrputf(Float f, wrf writewch) /* writes a float */
{
char s[256], *pt = s, ch;
int found_dot = FALSE, found_exp = FALSE;
#if HAVE_ISNAN || defined(__WIN32)
if (isnan(f)) {
@ -246,14 +247,31 @@ wrputf(Float f, wrf writewch) /* writes a float */
sprintf(s, RepAtom(AtomFloatFormat)->StrOfAE, f);
while (*pt == ' ')
pt++;
wrputs(pt, writewch);
if (*pt == '-') pt++;
while ((ch = *pt) != '\0') {
if (ch < '0' || ch > '9')
return;
if (*pt == '-') {
wrputc('-', writewch);
pt++;
}
wrputs(".0", writewch);
while ((ch = *pt) != '\0') {
switch (ch) {
case '.':
found_dot = TRUE;
wrputc('.', writewch);
break;
case 'e':
case 'E':
if (!found_dot) {
found_dot = TRUE;
wrputs(".0", writewch);
}
found_exp = TRUE;
default:
wrputc(ch, writewch);
}
pt++;
}
if (!found_dot) {
wrputs(".0", writewch);
}
}
static void
@ -285,6 +303,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])
@ -303,16 +323,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 ? */
{
@ -788,7 +798,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)
@ -818,7 +828,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)
@ -858,10 +868,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) */

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