From bb570108debbc6034073d5d1344a65135ccb3a66 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 21 Nov 2010 21:47:07 +0000 Subject: [PATCH 01/10] ISO: Always bracket atoms that are current operators when written as operands (7.10.5 h 2 ii) --- C/write.c | 18 ++++-------------- 1 file changed, 4 insertions(+), 14 deletions(-) diff --git a/C/write.c b/C/write.c index cabb21864..75c78847e 100755 --- a/C/write.c +++ b/C/write.c @@ -303,16 +303,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 +778,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 +808,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 +848,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) */ From 1b36c797331932ee8161a09609b33f7e53ae2424 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 21 Nov 2010 21:49:13 +0000 Subject: [PATCH 02/10] ISO: conforming type errors for setof/3 etc ulrich neumerkel patch --- pl/setof.yap | 30 ++++++++++++++++++++---------- 1 file changed, 20 insertions(+), 10 deletions(-) diff --git a/pl/setof.yap b/pl/setof.yap index 5049a2328..198c9d55f 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). From 86d0a251b53961742534c353bb1d5d8599bd4338 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 21 Nov 2010 21:53:58 +0000 Subject: [PATCH 03/10] [PATCH-YAP 4/4] ISO: quote atoms starting with /* (7.10.5 d) from ulrich neumerkel --- C/write.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/C/write.c b/C/write.c index 75c78847e..79cc46091 100755 --- a/C/write.c +++ b/C/write.c @@ -285,6 +285,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]) From c4913849c63bb747eeb18a15a35571abfcb37191 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 21 Nov 2010 21:55:58 +0000 Subject: [PATCH 04/10] [PATCH-YAP 3/4] ISO: Restrict binary, octal, hexadecimal integer constant indicators and exponent char to minuscules. (6.4.4) from Ulrich Neumerkel --- C/scanner.c | 26 +++++++++----------------- 1 file changed, 9 insertions(+), 17 deletions(-) diff --git a/C/scanner.c b/C/scanner.c index c8569772b..415b74e92 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,7 @@ 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' )) { if (ch == '.') { if (--max_size == 0) { Yap_ErrorMessage = "Number Too Long"; @@ -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); From 0fa3fff5d552af4707dd644cf30a4eba19559546 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 21 Nov 2010 22:09:07 +0000 Subject: [PATCH 05/10] [PATCH-YAP 5/5] ISO: reject 1E1 as float notation from ulrich neumerkel --- C/scanner.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/C/scanner.c b/C/scanner.c index 415b74e92..bc230f521 100755 --- a/C/scanner.c +++ b/C/scanner.c @@ -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' )) { - if (ch == '.') { + if (might_be_float && ch == '.') { + { if (--max_size == 0) { Yap_ErrorMessage = "Number Too Long"; return TermNil; From 7640700fdf47447df5c94866ddf8483439810667 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 21 Nov 2010 22:11:10 +0000 Subject: [PATCH 06/10] [PATCH-YAP 6/6] ISO: compound(+1). now holds. from ulrich neumerkel --- C/parser.c | 4 ---- 1 file changed, 4 deletions(-) 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; From 1730d4e206cdb13697e4db911e1cef1f50831342 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 21 Nov 2010 23:04:38 +0000 Subject: [PATCH 07/10] fix profon profon (obs from Bernd). --- C/gprof.c | 30 ++++++++++++++++-------------- 1 file changed, 16 insertions(+), 14 deletions(-) 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(); From 92bfc4cedc173712e41bbf57635883f73ef67749 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 22 Nov 2010 10:36:32 +0000 Subject: [PATCH 08/10] fix loop in c_files (obs from roberto bagnara). --- C/load_foreign.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) 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); From 20699fd838e41340471b1407b771b68b2b9f3d2b Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 22 Nov 2010 12:50:50 +0000 Subject: [PATCH 09/10] fix syntax error. --- pl/setof.yap | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pl/setof.yap b/pl/setof.yap index 198c9d55f..e3e9a3edc 100644 --- a/pl/setof.yap +++ b/pl/setof.yap @@ -237,6 +237,6 @@ all(T,G,S) :- '$partial_list_or_list'(V) :- var(V), !. '$partial_list_or_list'([]) :- !. -'$partial_list_or_list'([_|B]) :- ! +'$partial_list_or_list'([_|B]) :- !, '$partial_list_or_list'(B). From 2ee12ca1a781e94b34504099c31164c49a11eb47 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 22 Nov 2010 12:51:02 +0000 Subject: [PATCH 10/10] only force 1E30 an error if in ISO mode. always 1.0e30. --- C/scanner.c | 14 +++++++++++--- C/write.c | 34 ++++++++++++++++++++++++++-------- 2 files changed, 37 insertions(+), 11 deletions(-) diff --git a/C/scanner.c b/C/scanner.c index bc230f521..590ab78cf 100755 --- a/C/scanner.c +++ b/C/scanner.c @@ -602,8 +602,12 @@ 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 == '.') { - { + 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"; return TermNil; @@ -628,10 +632,14 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted } while (chtype(ch = Nxtch(inp_stream)) == NU); } - if (ch == 'e') { + if (ch == 'e' || ch == 'E') { 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; diff --git a/C/write.c b/C/write.c index 79cc46091..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