ciao style arrays, (...)

C/parser.c

@@ -70,7 +70,7 @@ typedef struct jmp_buff_struct {
 
 static void GNextToken( CACHE_TYPE1 );
 static void checkfor(Term, JMPBUFF * CACHE_TYPE);
-static Term ParseArgs(Atom, JMPBUFF * CACHE_TYPE);
+static Term ParseArgs(Atom, Term, JMPBUFF *, Term CACHE_TYPE);
 static Term ParseList(JMPBUFF * CACHE_TYPE);
 static Term ParseTerm(int, JMPBUFF * CACHE_TYPE);
 
@@ -324,7 +324,7 @@ checkfor(Term c, JMPBUFF *FailBuff USES_REGS)
 }
 
 static Term
-ParseArgs(Atom a, JMPBUFF *FailBuff USES_REGS)
+ParseArgs(Atom a, Term close, JMPBUFF *FailBuff, Term arg1 USES_REGS)
 {
   int nargs = 0;
   Term *p, t;
@@ -335,6 +335,27 @@ ParseArgs(Atom a, JMPBUFF *FailBuff USES_REGS)
   
   NextToken;
   p = (Term *) ParserAuxSp;
+  if (arg1) {
+    *p = arg1;
+    nargs++;
+    ParserAuxSp = (char *)(p+1);
+    if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)
+	&& LOCAL_tokptr->TokInfo == close) {
+
+      func = Yap_MkFunctor(a, 1);
+      if (func == NULL) {
+	LOCAL_ErrorMessage = "Heap Overflow";
+	FAIL;
+      }
+      t = Yap_MkApplTerm(func, nargs, p);
+      if (H > ASP-4096) {
+	LOCAL_ErrorMessage = "Stack Overflow";
+	return TermNil;
+      }  
+      NextToken;
+      return t;
+    }
+  }
   while (1) {
     Term *tp = (Term *)ParserAuxSp;
     if (ParserAuxSp+1 > LOCAL_TrailTop) {
@@ -380,7 +401,7 @@ ParseArgs(Atom a, JMPBUFF *FailBuff USES_REGS)
     return TermNil;
   }  
   /* check for possible overflow against local stack */
-  checkfor((Term) ')', FailBuff PASS_REGS);
+  checkfor(close, FailBuff PASS_REGS);
   return t;
 }
 
@@ -519,7 +540,7 @@ ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS)
     }
     if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)
 	&& Unsigned(LOCAL_tokptr->TokInfo) == 'l')
-      t = ParseArgs((Atom) t, FailBuff PASS_REGS);
+      t = ParseArgs((Atom) t, (Term)')', FailBuff, 0L PASS_REGS);
     else
       t = MkAtomTerm((Atom)t);
     break;
@@ -710,6 +731,24 @@ ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS)
 	}  
 	curprio = opprio;
 	continue;
+      } else if (Unsigned(LOCAL_tokptr->TokInfo) == '(' &&
+                IsPosfixOp(AtomEmptyBrackets, &opprio, &oplprio PASS_REGS)
+                && opprio <= prio && oplprio >= curprio) {
+	t = ParseArgs(AtomEmptyBrackets, (Term)')', FailBuff, t PASS_REGS);
+	curprio = opprio;
+	continue;
+       } else if (Unsigned(LOCAL_tokptr->TokInfo) == '[' &&
+                IsPosfixOp(AtomEmptySquareBrackets, &opprio, &oplprio PASS_REGS)
+                && opprio <= prio && oplprio >= curprio) {
+	t = ParseArgs(AtomEmptySquareBrackets, (Term)']', FailBuff, t PASS_REGS);
+	curprio = opprio;
+	continue;
+      } else if (Unsigned(LOCAL_tokptr->TokInfo) == '{' &&
+                IsPosfixOp(AtomEmptyCurlyBrackets, &opprio, &oplprio PASS_REGS)
+                && opprio <= prio && oplprio >= curprio) {
+	t = ParseArgs(AtomEmptyCurlyBrackets, (Term)'}', FailBuff, t PASS_REGS);
+	curprio = opprio;
+	continue;
       }
     }
     if (LOCAL_tokptr->Tok <= Ord(WString_tok))

C/write.c

@@ -320,7 +320,7 @@ wrputf(Float f, struct write_globs *wglb)	/* writes a float	 */
   ob = protect_open_number(wglb, last_minus, sgn);
 #if THREADS
   /* old style writing */
-  int found_dot = FALSE, found_exp = FALSE;
+  int found_dot = FALSE;
   char            *pt = s;
   int ch;
 
@@ -348,7 +348,6 @@ wrputf(Float f, struct write_globs *wglb)	/* writes a float	 */
         found_dot = TRUE;
         wrputs(".0", stream);
       }
-      found_exp = TRUE;
     default:
       wrputc(ch, stream);
     }
@@ -751,7 +750,6 @@ check_infinite_loop(Term t, struct rewind_term *x, struct write_globs *wglb)
 static void
 write_list(Term t, int direction, int depth, struct write_globs *wglb, struct rewind_term *rwt)
 {
-  CACHE_REGS
   Term ti;
   struct rewind_term nrwt;
   nrwt.parent = rwt;
@@ -975,7 +973,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
 	wrclose_bracket(wglb, TRUE);
       }
     } else if (!wglb->Ignore_ops &&
-	       Arity == 1 &&
+	       ( Arity == 1 || atom == AtomEmptyBrackets || atom == AtomEmptyCurlyBrackets || atom == AtomEmptySquareBrackets) &&
 	       Yap_IsPosfixOp(atom, &op, &lp)) {
       Term  tleft = ArgOfTerm(1, t);
 
@@ -995,7 +993,40 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
       if (bracket_left) {
 	wrclose_bracket(wglb, TRUE);
       }
-      putAtom(atom, wglb->Quote_illegal, wglb);
+      if (Arity > 1) {
+	if (atom == AtomEmptyBrackets) {
+	  wrputc('(', wglb->stream);  
+	} else if (atom == AtomEmptySquareBrackets) {
+	  wrputc('[', wglb->stream);  
+	} else if (atom == AtomEmptyCurlyBrackets) {
+	  wrputc('{', wglb->stream);  
+	}
+	lastw = separator;
+	for (op = 2; op <= Arity; ++op) {
+	  if (op == wglb->MaxArgs) {
+	    wrputc('.', wglb->stream);
+	    wrputc('.', wglb->stream);
+	    wrputc('.', wglb->stream);
+	    break;
+	  }
+	  writeTerm(from_pointer(RepAppl(t)+op, &nrwt, wglb), 999, depth + 1, FALSE, wglb, &nrwt);
+	  restore_from_write(&nrwt, wglb);
+	  if (op != Arity) {
+	    wrputc(',', wglb->stream);
+	    lastw = separator;
+	  }
+	}
+	if (atom == AtomEmptyBrackets) {
+	  wrputc(')', wglb->stream);  
+	} else if (atom == AtomEmptySquareBrackets) {
+	  wrputc(']', wglb->stream);  
+	} else if (atom == AtomEmptyCurlyBrackets) {
+	  wrputc('}', wglb->stream);  
+	}
+ 	lastw = separator;
+      } else {
+	putAtom(atom, wglb->Quote_illegal, wglb);
+      }
       if (op > p) {
 	wrclose_bracket(wglb, TRUE);
       }

H/iatoms.h

@@ -20,6 +20,9 @@
   AtomArrayType = Yap_LookupAtom("array_type");
   AtomArrow = Yap_LookupAtom("->");
   AtomAssert = Yap_LookupAtom(":-");
+  AtomEmptyBrackets = Yap_LookupAtom("()");
+  AtomEmptySquareBrackets = Yap_LookupAtom("[]");
+  AtomEmptyCurlyBrackets = Yap_LookupAtom("{}");
   AtomAt = Yap_LookupAtom("at");
   AtomAtom = Yap_LookupAtom("atom");
   AtomAtomic = Yap_LookupAtom("atomic");

H/ratoms.h

@@ -20,6 +20,9 @@
   AtomArrayType = AtomAdjust(AtomArrayType);
   AtomArrow = AtomAdjust(AtomArrow);
   AtomAssert = AtomAdjust(AtomAssert);
+  AtomEmptyBrackets = AtomAdjust(AtomEmptyBrackets);
+  AtomEmptySquareBrackets = AtomAdjust(AtomEmptySquareBrackets);
+  AtomEmptyCurlyBrackets = AtomAdjust(AtomEmptyCurlyBrackets);
   AtomAt = AtomAdjust(AtomAt);
   AtomAtom = AtomAdjust(AtomAtom);
   AtomAtomic = AtomAdjust(AtomAtomic);

H/tatoms.h

@@ -38,6 +38,12 @@
 #define AtomArrow Yap_heap_regs->AtomArrow_
   Atom AtomAssert_;
 #define AtomAssert Yap_heap_regs->AtomAssert_
+  Atom AtomEmptyBrackets_;
+#define AtomEmptyBrackets Yap_heap_regs->AtomEmptyBrackets_
+  Atom AtomEmptySquareBrackets_;
+#define AtomEmptySquareBrackets Yap_heap_regs->AtomEmptySquareBrackets_
+  Atom AtomEmptyCurlyBrackets_;
+#define AtomEmptyCurlyBrackets Yap_heap_regs->AtomEmptyCurlyBrackets_
   Atom AtomAt_;
 #define AtomAt Yap_heap_regs->AtomAt_
   Atom AtomAtom_;

misc/ATOMS

@@ -25,6 +25,9 @@ A	ArrayOverflow		N	"array_overflow"
 A	ArrayType		N	"array_type"
 A	Arrow			N	"->"
 A	Assert			N	":-"
+A	EmptyBrackets		N	"()"
+A	EmptySquareBrackets	N	"[]"
+A	EmptyCurlyBrackets	N	"{}"
 A	At			N	"at"
 A	Atom			N	"atom"
 A	Atomic			N	"atomic"

pl/utils.yap

@@ -92,11 +92,11 @@
 	  '$do_error'(instantiation_error,G).
  '$check_op_name'(_,_,',',G) :- !,
 	  '$do_error'(permission_error(modify,operator,','),G).
- '$check_op_name'(_,_,'[]',G) :- !,
+'$check_op_name'(_,_,'[]',G) :-  T \= yf, T\= xf, !,
 	  '$do_error'(permission_error(create,operator,'[]'),G).
- '$check_op_name'(_,_,'{}',G) :- !,
+'$check_op_name'(_,_,'{}',G) :- T \= yf, T\= xf, !,
 	  '$do_error'(permission_error(create,operator,'{}'),G).
- '$check_op_name'(P,T,'|',G) :-
+'$check_op_name'(P,T,'|',G) :-
 	 (
 	  integer(P),
 	  P < 1001, P > 0