diff --git a/C/gprof.c b/C/gprof.c index 25d9405db..6ae41fd16 100755 --- a/C/gprof.c +++ b/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(); diff --git a/C/load_foreign.c b/C/load_foreign.c index 434e55f82..13c86b782 100755 --- a/C/load_foreign.c +++ b/C/load_foreign.c @@ -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); diff --git a/C/parser.c b/C/parser.c index d10863f03..664022ce8 100644 --- a/C/parser.c +++ b/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; diff --git a/C/scanner.c b/C/scanner.c index c8569772b..590ab78cf 100755 --- a/C/scanner.c +++ b/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,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); diff --git a/C/write.c b/C/write.c index cabb21864..bc77cfac6 100755 --- a/C/write.c +++ b/C/write.c @@ -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) */ diff --git a/pl/setof.yap b/pl/setof.yap index 5049a2328..e3e9a3edc 100644 --- a/pl/setof.yap +++ b/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).