fix comment handling

os/pl-read.c

@@ -420,7 +420,7 @@ PRED_IMPL("$qq_open", 2, qq_open, 0)
     if ( PL_get_arg(1, A1, arg) && PL_get_pointer_ex(arg, &ptr) &&
 	 PL_get_arg(2, A1, arg) && PL_get_intptr(arg, (intptr_t *)&start) &&
 	 PL_get_arg(3, A1, arg) && PL_get_intptr(arg, (intptr_t *)&len) )
-      {  source_location pos;
+      {  //source_location pos;
       if ( (s=Sopenmem(&start, &len, "r")) )
 	  s->encoding = ENC_UTF8;
 
@@ -975,6 +975,35 @@ raw_read(ReadData _PL_rd, unsigned char **endp ARG_LD)
   return s;
 }
 
+static void
+callCommentHook(term_t comments, term_t tpos, term_t term)
+{ GET_LD
+  fid_t fid;
+  term_t av;
+
+  if ( (fid = PL_open_foreign_frame()) &&
+       (av = PL_new_term_refs(3)) )
+  { qid_t qid;
+
+    PL_put_term(av+0, comments);
+    PL_put_term(av+1, tpos);
+    PL_put_term(av+2, term);
+
+    if ( (qid = PL_open_query(NULL, PL_Q_NODEBUG|PL_Q_CATCH_EXCEPTION,
+			      (predicate_t)PredCommentHook, av)) )
+    { term_t ex;
+
+      if ( !PL_next_solution(qid) && (ex=PL_exception(qid)) )
+	printMessage(ATOM_error, PL_TERM, ex);
+
+      PL_close_query(qid);
+    }
+
+    PL_discard_foreign_frame(fid);
+  }
+}
+
+
 
 		/********************************
 		*       PROLOG CONNECTION       *
@@ -1110,6 +1139,7 @@ static const opt_spec read_term_options[] =
   { ATOM_syntax_errors,     OPT_ATOM },
   { ATOM_backquoted_string, OPT_BOOL },
   { ATOM_comments,	    OPT_TERM },
+  { ATOM_process_comment,   OPT_BOOL },
 #ifdef O_QUASIQUOTATIONS
   { ATOM_quasi_quotations,  OPT_TERM },
 #endif
@@ -1121,7 +1151,9 @@ static const opt_spec read_term_options[] =
 static foreign_t
 read_term_from_stream(IOSTREAM *s, term_t term, term_t options ARG_LD)
 { term_t tpos = 0;
-  term_t tcomments = 0;
+  term_t comments = 0;
+  term_t opt_comments = 0;
+  int process_comment;
   int rval;
   atom_t w;
   read_data rd;
@@ -1130,6 +1162,8 @@ read_term_from_stream(IOSTREAM *s, term_t term, term_t options ARG_LD)
   atom_t mname = NULL_ATOM;
   fid_t fid = PL_open_foreign_frame();
 
+  if (!fid)
+    return FALSE;
 retry:
   init_read_data(&rd, s PASS_LD);
 
@@ -1144,7 +1178,8 @@ retry:
 		     &mname,
 		     &rd.on_error,
 		     &rd.backquoted_string,
-		     &tcomments,
+		     &opt_comments,
+		     &process_comment,
 #ifdef O_QUASIQUOTATIONS
 		     &rd.quasi_quotations,
 #endif
@@ -1154,6 +1189,21 @@ retry:
     return FALSE;
   }
 
+  // yap specific, do not call process comment if undefined 
+  if (process_comment) {
+    OPCODE ophook = PredCommentHook->OpcodeOfPred;
+    if (ophook == UNDEF_OPCODE || ophook == FAIL_OPCODE)
+      process_comment = FALSE;
+  }	
+
+  if ( opt_comments )
+  { comments = PL_new_term_ref();
+  } else if ( process_comment )
+  { if ( !tpos )
+      tpos = PL_new_term_ref();
+    comments = PL_new_term_ref();
+  }
+
   if ( mname )
   { rd.module = lookupModule(mname);
     rd.flags  = rd.module->flags;
@@ -1171,8 +1221,8 @@ retry:
   }
   if ( rd.singles && PL_get_atom(rd.singles, &w) && w == ATOM_warning )
     rd.singles = TRUE;
-  if ( tcomments )
-    rd.comments = PL_copy_term_ref(tcomments);
+  if ( comments )
+    rd.comments = PL_copy_term_ref(comments);
 
   rval = read_term(term, &rd PASS_LD);
   if ( Sferror(s) ) {
@@ -1186,9 +1236,11 @@ retry:
   if ( rval )
   { if ( tpos )
       rval = unify_read_term_position(tpos PASS_LD);
-    if ( rval && tcomments )
-    { if ( !PL_unify_nil(rd.comments) )
-	rval = FALSE;
+    if (rval) { 
+      if ( opt_comments )
+	rval = PL_unify(opt_comments, comments);
+      else if (comments && !PL_get_nil(comments) )
+	callCommentHook(comments, tpos, term);
     }
   } else {
     if ( rd.has_exception && reportReadError(&rd) )