small bugs, especiall in error processing

C/arith1.c

@@ -1075,4 +1075,3 @@ Yap_ReInitUnaryExps(void)
 {
   return TRUE;
 }
-

C/cmppreds.c

@@ -595,10 +595,12 @@ inline static Int flt_cmp(Float dif) {
 
 static Int a_cmp(Term t1, Term t2 USES_REGS) {
   if (IsVarTerm(t1)) {
-      Yap_ThrowError( INSTANTIATION_ERROR, t1, 4, "while doing arithmetic comparison" );
+    Yap_ArithError(INSTANTIATION_ERROR, t1,
+                   "while doing arithmetic comparison");
   }
   if (IsVarTerm(t2)) {
-      Yap_ThrowError( INSTANTIATION_ERROR, t1, 4, "while doing arithmetic comparison" );
+    Yap_ArithError(INSTANTIATION_ERROR,  t2,
+                   "while doing arithmetic comparison");
   }
   if (IsFloatTerm(t1) && IsFloatTerm(t2)) {
     return flt_cmp(FloatOfTerm(t1) - FloatOfTerm(t2));
@@ -621,7 +623,8 @@ static Int a_cmp(Term t1, Term t2 USES_REGS) {
       Float f2 = FloatOfTerm(t2);
 #if HAVE_ISNAN
       if (isnan(f2)) {
-        Yap_ThrowError( EVALUATION_ERROR_UNDEFINED, t2, 4, "trying to evaluate nan" );
+        Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t2,
+                       "trying to evaluate nan");
       }
 #endif
       return flt_cmp(i1 - f2);
@@ -636,7 +639,8 @@ static Int a_cmp(Term t1, Term t2 USES_REGS) {
     Float f1 = FloatOfTerm(t1);
 #if HAVE_ISNAN
     if (isnan(f1)) {
-        Yap_ThrowError( EVALUATION_ERROR_UNDEFINED, t1, 4, "trying to evaluate nan" );
+      Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t1,
+                     "trying to evaluate nan");
     }
 #endif
     t2 = Yap_Eval(t2);
@@ -652,7 +656,8 @@ static Int a_cmp(Term t1, Term t2 USES_REGS) {
       Float f2 = FloatOfTerm(t2);
 #if HAVE_ISNAN
       if (isnan(f2)) {
-          Yap_ThrowError( EVALUATION_ERROR_UNDEFINED, t2,  4, "trying to evaluate nan" );
+        Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t2,
+                       "trying to evaluate nan");
       }
 #endif
       return flt_cmp(f1 - f2);
@@ -674,7 +679,8 @@ static Int a_cmp(Term t1, Term t2 USES_REGS) {
         Float f2 = FloatOfTerm(t2);
 #if HAVE_ISNAN
         if (isnan(f2)) {
-            Yap_ThrowError( EVALUATION_ERROR_UNDEFINED, t2, 4, "trying to evaluate nan" );
+          Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t2,
+                         "trying to evaluate nan");
         }
 #endif
         return Yap_gmp_cmp_big_float(t1, f2);

C/exec.c

@@ -1446,7 +1446,6 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
       /* must be done here, otherwise siglongjmp will clobber all the
        * registers
        */
-      Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
       /* reset the registers so that we don't have trash in abstract
        * machine */
       Yap_set_fpu_exceptions(

C/scanner.c

@@ -1211,7 +1211,6 @@ Term Yap_tokRep(void *tokptre) {
   return TermDot;
 }
 
-
 const char *Yap_tokText(void *tokptre) {
   CACHE_REGS
   TokEntry *tokptr = tokptre;
@@ -1244,13 +1243,13 @@ const char * Yap_tokText(void *tokptre) {
     }
     break;
   case Var_tok:
-            if (info == 0) return "[]";
+    if (info == 0)
+      return "[]";
     return ((Atom)info)->StrOfAE;
   }
   return ".";
 }
 
-
 static void open_comment(int ch, StreamDesc *inp_stream USES_REGS) {
   CELL *h0 = HR;
   HR += 5;
@@ -1972,7 +1971,6 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
   return (l);
 }
 
-
 void Yap_clean_tokenizer(TokEntry *tokstart, VarEntry *vartable,
                          VarEntry *anonvartable) {
   CACHE_REGS

H/ATOMS

@@ -294,6 +294,7 @@ A	PastEndOfStream		N	"past_end_of_stream"
 A	PermissionError		N	"permission_error"
 A	Pi			N	"pi"
 A	Pipe			N	"pipe"
+A   Priority		N   "priority"
 A	Plus			N	"+"
 A	Pointer			N	"pointer"
 A	Portray			F	"portray"
@@ -546,11 +547,13 @@ F	NBQueue			Queue		4
 F	Not			Not		1
 F	Obj			Obj		1
 F	Or			Semic		2
+F   Output      Output      1
 F	PermissionError		PermissionError	3
 F	Plus			Plus		2
 F	Portray			Portray		1
 F	PrintMessage		PrintMessage	2
 F   Procedure       Procedure       5
+F   Priority		Priority      1
 F	PrologConstraint	Prolog		2
 F	ProtectStack	ProtectStack    4
 F	Query			Query		1

H/YapFlags.h

@@ -204,7 +204,7 @@ typedef struct x_el {
 } xarg;
 
 typedef struct struct_param {
-  char *name;
+  const char *name;
   flag_func type;
   int id;
 } param_t;

H/absmi.h

@@ -2455,7 +2455,7 @@ extern yamop *headoftrace;
 #define Yap_AsmError(e, d)                                                     \
   {                                                                            \
     saveregs();                                                                \
-    Yap_ThrowError(e, d, 4, "");                                                       \
+    Yap_ThrowError(e, d, "while exwcuting inlined built-in");                  \
     setregs();                                                                 \
   }
 

H/eval.h

@@ -407,7 +407,7 @@ yamop *Yap_EvalError__(const char *, const char *, int, yap_error_number, Term,
                        ...);
 
 #define Yap_ArithError(id, t, ...)                                             \
-  Yap_ThrowError__(__FILE__, __FUNCTION__, __LINE__, id, t, 2, __VA_ARGS__)
+  Yap_ThrowError__(__FILE__, __FUNCTION__, __LINE__, id, t, __VA_ARGS__)
 #define Yap_BinError(id)                                                       \
   Yap_Error__(__FILE__, __FUNCTION__, __LINE__, id, 0L, "")
 #define Yap_AbsmiError(id)                                                     \

H/generated/iatoms.h

@@ -289,6 +289,7 @@
   AtomPermissionError = Yap_LookupAtom("permission_error"); TermPermissionError = MkAtomTerm(AtomPermissionError);
   AtomPi = Yap_LookupAtom("pi"); TermPi = MkAtomTerm(AtomPi);
   AtomPipe = Yap_LookupAtom("pipe"); TermPipe = MkAtomTerm(AtomPipe);
+  AtomPriority = Yap_LookupAtom("priority"); TermPriority = MkAtomTerm(AtomPriority);
   AtomPlus = Yap_LookupAtom("+"); TermPlus = MkAtomTerm(AtomPlus);
   AtomPointer = Yap_LookupAtom("pointer"); TermPointer = MkAtomTerm(AtomPointer);
   AtomPortray = Yap_FullLookupAtom("portray"); TermPortray = MkAtomTerm(AtomPortray);
@@ -541,11 +542,13 @@
   FunctorNot = Yap_MkFunctor(AtomNot,1);
   FunctorObj = Yap_MkFunctor(AtomObj,1);
   FunctorOr = Yap_MkFunctor(AtomSemic,2);
+  FunctorOutput = Yap_MkFunctor(AtomOutput,1);
   FunctorPermissionError = Yap_MkFunctor(AtomPermissionError,3);
   FunctorPlus = Yap_MkFunctor(AtomPlus,2);
   FunctorPortray = Yap_MkFunctor(AtomPortray,1);
   FunctorPrintMessage = Yap_MkFunctor(AtomPrintMessage,2);
   FunctorProcedure = Yap_MkFunctor(AtomProcedure,5);
+  FunctorPriority = Yap_MkFunctor(AtomPriority,1);
   FunctorPrologConstraint = Yap_MkFunctor(AtomProlog,2);
   FunctorProtectStack = Yap_MkFunctor(AtomProtectStack,4);
   FunctorQuery = Yap_MkFunctor(AtomQuery,1);

H/generated/ratoms.h

@@ -289,6 +289,7 @@
   AtomPermissionError = AtomAdjust(AtomPermissionError); TermPermissionError = MkAtomTerm(AtomPermissionError);
   AtomPi = AtomAdjust(AtomPi); TermPi = MkAtomTerm(AtomPi);
   AtomPipe = AtomAdjust(AtomPipe); TermPipe = MkAtomTerm(AtomPipe);
+  AtomPriority = AtomAdjust(AtomPriority); TermPriority = MkAtomTerm(AtomPriority);
   AtomPlus = AtomAdjust(AtomPlus); TermPlus = MkAtomTerm(AtomPlus);
   AtomPointer = AtomAdjust(AtomPointer); TermPointer = MkAtomTerm(AtomPointer);
   AtomPortray = AtomAdjust(AtomPortray); TermPortray = MkAtomTerm(AtomPortray);
@@ -541,11 +542,13 @@
   FunctorNot = FuncAdjust(FunctorNot);
   FunctorObj = FuncAdjust(FunctorObj);
   FunctorOr = FuncAdjust(FunctorOr);
+  FunctorOutput = FuncAdjust(FunctorOutput);
   FunctorPermissionError = FuncAdjust(FunctorPermissionError);
   FunctorPlus = FuncAdjust(FunctorPlus);
   FunctorPortray = FuncAdjust(FunctorPortray);
   FunctorPrintMessage = FuncAdjust(FunctorPrintMessage);
   FunctorProcedure = FuncAdjust(FunctorProcedure);
+  FunctorPriority = FuncAdjust(FunctorPriority);
   FunctorPrologConstraint = FuncAdjust(FunctorPrologConstraint);
   FunctorProtectStack = FuncAdjust(FunctorProtectStack);
   FunctorQuery = FuncAdjust(FunctorQuery);

H/generated/tatoms.h

@@ -289,6 +289,7 @@ EXTERNAL Atom AtomPastEndOfStream; EXTERNAL Term TermPastEndOfStream;
 EXTERNAL Atom AtomPermissionError; EXTERNAL Term TermPermissionError;
 EXTERNAL Atom AtomPi; EXTERNAL Term TermPi;
 EXTERNAL Atom AtomPipe; EXTERNAL Term TermPipe;
+EXTERNAL Atom AtomPriority; EXTERNAL Term TermPriority;
 EXTERNAL Atom AtomPlus; EXTERNAL Term TermPlus;
 EXTERNAL Atom AtomPointer; EXTERNAL Term TermPointer;
 EXTERNAL Atom AtomPortray; EXTERNAL Term TermPortray;
@@ -645,6 +646,8 @@ EXTERNAL  Functor FunctorObj;
 
 EXTERNAL  Functor FunctorOr;
 
+EXTERNAL  Functor FunctorOutput;
+
 EXTERNAL  Functor FunctorPermissionError;
 
 EXTERNAL  Functor FunctorPlus;
@@ -655,6 +658,8 @@ EXTERNAL  Functor FunctorPrintMessage;
 
 EXTERNAL  Functor FunctorProcedure;
 
+EXTERNAL  Functor FunctorPriority;
+
 EXTERNAL  Functor FunctorPrologConstraint;
 
 EXTERNAL  Functor FunctorProtectStack;

os/iopreds.c

@@ -545,12 +545,14 @@ static int NullPutc(int sno, int ch) {
 }
 
 int ResetEOF(StreamDesc *s) {
-  s->status &= ~Push_Eof_Stream_f;
   if (s->status & Eof_Error_Stream_f) {
-    Yap_Error(PERMISSION_ERROR_INPUT_PAST_END_OF_STREAM, MkAtomTerm(s->name),
+    Atom name = s->name;
+    // Yap_CloseStream(s - GLOBAL_Stream);
+    Yap_Error(PERMISSION_ERROR_INPUT_PAST_END_OF_STREAM, MkAtomTerm(name),
               "GetC");
     return FALSE;
   } else if (s->status & Reset_Eof_Stream_f) {
+    s->status &= ~Push_Eof_Stream_f;
     /* reset the eof indicator on file */
     if (feof(s->file))
       clearerr(s->file);
@@ -654,9 +656,9 @@ int post_process_weof(StreamDesc *s) {
  *
  * @return EOF
  */
-int EOFPeek(int sno) { return EOFGetc(sno); }
+int EOFPeek(int sno) { return EOFCHAR; }
 
-int EOFWPeek(int sno) { return EOFWGetc(sno); }
+int EOFWPeek(int sno) { return EOFCHAR; }
 
 /* standard routine, it should read from anything pointed by a FILE *.
  It could be made more efficient by doing our own buffering and avoiding

os/readterm.c

@@ -211,19 +211,31 @@ static const param_t read_defs[] = {READ_DEFS()};
 static Term add_output(Term t, Term tail) {
   Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomOutput, 1), 1);
   Yap_unify(t, ArgOfTerm(1, topt));
+  if (IsPairTerm(tail) || tail == TermNil) {
     return MkPairTerm(topt, tail);
+  } else {
+    return MkPairTerm(topt, MkPairTerm(tail, TermNil));
+  }
 }
 
 static Term add_names(Term t, Term tail) {
   Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1);
   Yap_unify(t, ArgOfTerm(1, topt));
+  if (IsPairTerm(tail) || tail == TermNil) {
     return MkPairTerm(topt, tail);
+  } else {
+    return MkPairTerm(topt, MkPairTerm(tail, TermNil));
+  }
 }
 
 static Term add_priority(Term t, Term tail) {
   Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomPriority, 1), 1);
   Yap_unify(t, ArgOfTerm(1, topt));
+  if (IsPairTerm(tail) || tail == TermNil) {
     return MkPairTerm(topt, tail);
+  } else {
+    return MkPairTerm(topt, MkPairTerm(tail, TermNil));
+  }
 }
 
 /**
@@ -372,7 +384,8 @@ static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) {
     fe->cmod = CurrentModule;
     if (fe->cmod == TermProlog)
       fe->cmod = PROLOG_MODULE;
-    }  if (args[READ_BACKQUOTED_STRING].used) {
+  }
+  if (args[READ_BACKQUOTED_STRING].used) {
     if (!setBackQuotesFlag(args[READ_BACKQUOTED_STRING].tvalue)) {
       return false;
     }
@@ -586,7 +599,7 @@ static bool complete_processing(FEnv *fe, TokEntry *tokstart) {
   CACHE_REGS
   Term v1, v2, v3, vc, tp;
 
-  if (fe->t0 && !(Yap_unify(fe->t, fe->t0)))
+  if (fe->t0 && fe->t && !(Yap_unify(fe->t, fe->t0)))
     return false;
 
   if (fe->t && fe->vp)
@@ -625,7 +638,7 @@ static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart) {
   CACHE_REGS
   Term v_vp, v_vnames, v_comments, v_pos;
 
-  if (fe->t0 && !Yap_unify(fe->t, fe->t0))
+  if (fe->t0 & fe->t && !Yap_unify(fe->t, fe->t0))
     return false;
   if (fe->t && fe->vp)
     v_vp = get_variables(fe, tokstart);
@@ -682,6 +695,8 @@ static parser_state_t scanEOF(FEnv *fe, int inp_stream) {
       return YAP_PARSING_FINISHED;
     }
     // a :- <eof>
+    if (GLOBAL_Stream[inp_stream].status & Past_Eof_Stream_f)
+      return YAP_PARSING_ERROR;
     /* we need to force the next read to also give end of file.*/
     GLOBAL_Stream[inp_stream].status |= Push_Eof_Stream_f;
     LOCAL_ErrorMessage = "end of file found before end of term";
@@ -818,14 +833,11 @@ static parser_state_t scanError(REnv *re, FEnv *fe, int inp_stream) {
 static parser_state_t parseError(REnv *re, FEnv *fe, int inp_stream) {
   CACHE_REGS
   fe->t = 0;
-  if (LOCAL_Error_TYPE == RESOURCE_ERROR_TRAIL ||
+  if (LOCAL_Error_TYPE != SYNTAX_ERROR && LOCAL_Error_TYPE != YAP_NO_ERROR) {
-      LOCAL_Error_TYPE == RESOURCE_ERROR_AUXILIARY_STACK ||
-      LOCAL_Error_TYPE == RESOURCE_ERROR_HEAP ||
-      LOCAL_Error_TYPE == RESOURCE_ERROR_STACK) {
     return YAP_SCANNING_ERROR;
   }
   Term ParserErrorStyle = re->sy;
-  if (ParserErrorStyle == TermQuiet) {
+  if (ParserErrorStyle == TermQuiet || LOCAL_Error_TYPE == YAP_NO_ERROR) {
     /* just fail */
     LOCAL_Error_TYPE = YAP_NO_ERROR;
     return YAP_PARSING_FINISHED;
@@ -948,7 +960,7 @@ static Int read_term(
   if (inp_stream == -1) {
     return (FALSE);
   }
-  out = Yap_read_term(inp_stream, add_output(ARG1, ARG2), false);
+  out = Yap_read_term(inp_stream, add_output(ARG2, ARG3), false);
   UNLOCK(GLOBAL_Stream[inp_stream].streamlock);
   return out != 0L;
 }
@@ -1404,16 +1416,73 @@ static Int read_term_from_string(USES_REGS1) {
   return Yap_unify(rc, ARG2);
 }
 
+static Int atomic_to_term(USES_REGS1) {
+  Term t1 = Deref(ARG1);
+  size_t len;
+  if (IsVarTerm(t1)) {
+    Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3");
+    return (FALSE);
+  } else if (!IsAtomicTerm(t1)) {
+    Yap_Error(TYPE_ERROR_ATOMIC, t1, "read_term_from_atomic/3");
+    return (FALSE);
+  } else {
+    Term t = Yap_AtomicToString(t1 PASS_REGS);
+    const unsigned char *us = UStringOfTerm(t);
+    len = strlen_utf8(us);
+    return Yap_BufferToTerm(us, len,
+                            add_output(ARG2, add_names(ARG3, TermNil)));
+  }
+}
+
+static Int atom_to_term(USES_REGS1) {
+  Term t1 = Deref(ARG1);
+  size_t len;
+  if (IsVarTerm(t1)) {
+    Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3");
+    return (FALSE);
+  } else if (!IsAtomTerm(t1)) {
+    Yap_Error(TYPE_ERROR_ATOM, t1, "read_term_from_atomic/3");
+    return (FALSE);
+  } else {
+    Term t = Yap_AtomicToString(t1 PASS_REGS);
+    const unsigned char *us = UStringOfTerm(t);
+    len = strlen_utf8(us);
+    return Yap_BufferToTerm(us, len,
+                            add_output(ARG2, add_names(ARG3, TermNil)));
+  }
+}
+
+static Int string_to_term(USES_REGS1) {
+  Term t1 = Deref(ARG1);
+  size_t len;
+  if (IsVarTerm(t1)) {
+    Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3");
+    return (FALSE);
+  } else if (!IsStringTerm(t1)) {
+    Yap_Error(TYPE_ERROR_STRING, t1, "read_term_from_string/3");
+    return (FALSE);
+  } else {
+    const unsigned char *us = UStringOfTerm(t1);
+    len = strlen_utf8(us);
+    return Yap_BufferToTerm(us, len,
+                            add_output(ARG2, add_names(ARG3, TermNil)));
+  }
+}
+
 void Yap_InitReadTPreds(void) {
-  Yap_InitCPred("read", 1, read1, SyncPredFlag);
-  Yap_InitCPred("read", 2, read2, SyncPredFlag);
   Yap_InitCPred("read_term", 2, read_term2, SyncPredFlag);
   Yap_InitCPred("read_term", 3, read_term, SyncPredFlag);
+
+  Yap_InitCPred("read", 1, read1, SyncPredFlag);
+  Yap_InitCPred("read", 2, read2, SyncPredFlag);
   Yap_InitCPred("read_clause", 2, read_clause2, SyncPredFlag);
   Yap_InitCPred("read_clause", 3, read_clause, 0);
   Yap_InitCPred("read_term_from_atom", 3, read_term_from_atom, 0);
   Yap_InitCPred("read_term_from_atomic", 3, read_term_from_atomic, 0);
   Yap_InitCPred("read_term_from_string", 3, read_term_from_string, 0);
+  Yap_InitCPred("atom_to_term", 3, atom_to_term, 0);
+  Yap_InitCPred("atomic_to_term", 3, atomic_to_term, 0);
+  Yap_InitCPred("string_to_term", 3, string_to_term, 0);
 
   Yap_InitCPred("fileerrors", 0, fileerrors, SyncPredFlag);
   Yap_InitCPred("nofileeleerrors", 0, nofileerrors, SyncPredFlag);