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

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

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

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;

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') {
+	*chbuffp = cbuff;
-	  /* 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 +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);

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 LeftOpToProtect, (Atom, int));
-STATIC_PROTO(int RightOpToProtect, (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 == '-') {
-  if (*pt == '-') pt++;
+    wrputc('-', writewch);
-  while ((ch = *pt) != '\0') {
-    if (ch < '0' || ch > '9')
-      return;
     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) */

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), !.
+'$partial_list_or_list'(V) :- var(V), !.
-'$check_list_for_bags'([], _) :- !.
+'$partial_list_or_list'([]) :- !.
-'$check_list_for_bags'([_|B], T) :- !,
+'$partial_list_or_list'([_|B]) :- !,
-	'$check_list_for_bags'(B,T).
+	'$partial_list_or_list'(B).
-'$check_list_for_bags'(S, T) :-
-	'$do_error'(type_error(list,S),T).