fix comment handling

H/dhstruct.h

@@ -141,6 +141,7 @@
 #define PredIs Yap_heap_regs->pred_is
 #define PredSafeCallCleanup Yap_heap_regs->pred_safe_call_cleanup
 #define PredRestoreRegs Yap_heap_regs->pred_restore_regs
+#define PredCommentHook Yap_heap_regs->pred_comment_hook
 #ifdef YAPOR
 #define PredGetwork Yap_heap_regs->pred_getwork
 #define PredGetworkSeq Yap_heap_regs->pred_getwork_seq

H/hstruct.h

@@ -141,6 +141,7 @@
   struct pred_entry  *pred_is;
   struct pred_entry  *pred_safe_call_cleanup;
   struct pred_entry  *pred_restore_regs;
+  struct pred_entry  *pred_comment_hook;
 #ifdef YAPOR
   struct pred_entry  *pred_getwork;
   struct pred_entry  *pred_getwork_seq;

H/iatoms.h

@@ -55,6 +55,7 @@
   AtomCodeSpace = Yap_LookupAtom("code_space");
   AtomCodes = Yap_LookupAtom("codes");
   AtomComma = Yap_LookupAtom(",");
+  AtomCommentHook = Yap_LookupAtom("comment_hook");
   AtomCompound = Yap_LookupAtom("compound");
   AtomConsistencyError = Yap_LookupAtom("consistency_error");
   AtomConsultOnBoot = Yap_FullLookupAtom("$consult_on_boot");
@@ -361,6 +362,7 @@
   FunctorClist = Yap_MkFunctor(AtomWhen,4);
   FunctorCodes = Yap_MkFunctor(AtomCodes,2);
   FunctorComma = Yap_MkFunctor(AtomComma,2);
+  FunctorCommentHook = Yap_MkFunctor(AtomCommentHook,3);
   FunctorContext2 = Yap_MkFunctor(AtomContext,2);
   FunctorConsistencyError = Yap_MkFunctor(AtomConsistencyError,1);
   FunctorCreep = Yap_MkFunctor(AtomCreep,1);

H/ihstruct.h

@@ -141,6 +141,7 @@
   PredIs = RepPredProp(PredPropByFunc(FunctorIs,PROLOG_MODULE));
   PredSafeCallCleanup = RepPredProp(PredPropByFunc(FunctorSafeCallCleanup,PROLOG_MODULE));
   PredRestoreRegs = RepPredProp(PredPropByFunc(FunctorRestoreRegs,PROLOG_MODULE));
+  PredCommentHook = RepPredProp(PredPropByFunc(FunctorCommentHook,PROLOG_MODULE));
 #ifdef YAPOR
   PredGetwork = RepPredProp(PredPropByAtom(AtomGetwork,PROLOG_MODULE));
   PredGetworkSeq = RepPredProp(PredPropByAtom(AtomGetworkSeq,PROLOG_MODULE));

H/ratoms.h

@@ -55,6 +55,7 @@
   AtomCodeSpace = AtomAdjust(AtomCodeSpace);
   AtomCodes = AtomAdjust(AtomCodes);
   AtomComma = AtomAdjust(AtomComma);
+  AtomCommentHook = AtomAdjust(AtomCommentHook);
   AtomCompound = AtomAdjust(AtomCompound);
   AtomConsistencyError = AtomAdjust(AtomConsistencyError);
   AtomConsultOnBoot = AtomAdjust(AtomConsultOnBoot);
@@ -361,6 +362,7 @@
   FunctorClist = FuncAdjust(FunctorClist);
   FunctorCodes = FuncAdjust(FunctorCodes);
   FunctorComma = FuncAdjust(FunctorComma);
+  FunctorCommentHook = FuncAdjust(FunctorCommentHook);
   FunctorContext2 = FuncAdjust(FunctorContext2);
   FunctorConsistencyError = FuncAdjust(FunctorConsistencyError);
   FunctorCreep = FuncAdjust(FunctorCreep);

H/rhstruct.h

@@ -141,6 +141,7 @@
   PredIs = PtoPredAdjust(PredIs);
   PredSafeCallCleanup = PtoPredAdjust(PredSafeCallCleanup);
   PredRestoreRegs = PtoPredAdjust(PredRestoreRegs);
+  PredCommentHook = PtoPredAdjust(PredCommentHook);
 #ifdef YAPOR
   PredGetwork = PtoPredAdjust(PredGetwork);
   PredGetworkSeq = PtoPredAdjust(PredGetworkSeq);

H/tatoms.h

@@ -108,6 +108,8 @@
 #define AtomCodes Yap_heap_regs->AtomCodes_
   Atom AtomComma_;
 #define AtomComma Yap_heap_regs->AtomComma_
+  Atom AtomCommentHook_;
+#define AtomCommentHook Yap_heap_regs->AtomCommentHook_
   Atom AtomCompound_;
 #define AtomCompound Yap_heap_regs->AtomCompound_
   Atom AtomConsistencyError_;
@@ -720,6 +722,8 @@
 #define FunctorCodes Yap_heap_regs->FunctorCodes_
   Functor FunctorComma_;
 #define FunctorComma Yap_heap_regs->FunctorComma_
+  Functor FunctorCommentHook_;
+#define FunctorCommentHook Yap_heap_regs->FunctorCommentHook_
   Functor FunctorContext2_;
 #define FunctorContext2 Yap_heap_regs->FunctorContext2_
   Functor FunctorConsistencyError_;

misc/ATOMS

@@ -60,6 +60,7 @@ A	Colomn			N	":"
 A	CodeSpace		N	"code_space"
 A	Codes			N	"codes"
 A	Comma			N	","
+A	CommentHook		N	"comment_hook"
 A	Compound		N	"compound"
 A	ConsistencyError	N	"consistency_error"
 A	ConsultOnBoot		F	"$consult_on_boot"
@@ -366,6 +367,7 @@ F	CleanCall		CleanCall	2
 F	Clist			When		4
 F	Codes			Codes		2
 F	Comma			Comma		2
+F	CommentHook		CommentHook	3
 F	Context2		Context		2
 F	ConsistencyError	ConsistencyError	1
 F	Creep			Creep		1

misc/HEAPFIELDS

@@ -149,6 +149,7 @@ struct pred_entry *pred_handle_throw	PredHandleThrow		MkPred FunctorHandleThrow
 struct pred_entry *pred_is		PredIs			MkPred FunctorIs PROLOG_MODULE
 struct pred_entry *pred_safe_call_cleanup PredSafeCallCleanup	MkPred FunctorSafeCallCleanup PROLOG_MODULE
 struct pred_entry *pred_restore_regs	PredRestoreRegs		MkPred FunctorRestoreRegs PROLOG_MODULE
+struct pred_entry *pred_comment_hook	PredCommentHook		MkPred FunctorCommentHook PROLOG_MODULE
 #ifdef YAPOR
 struct pred_entry *pred_getwork		PredGetwork		MkPred AtomGetwork 0 PROLOG_MODULE
 struct pred_entry *pred_getwork_seq	PredGetworkSeq		MkPred AtomGetworkSeq 0 PROLOG_MODULE

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 )
+  if ( comments )
-    rd.comments = PL_copy_term_ref(tcomments);
+    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 (rval) { 
-    { if ( !PL_unify_nil(rd.comments) )
+      if ( opt_comments )
-	rval = FALSE;
+	rval = PL_unify(opt_comments, comments);
+      else if (comments && !PL_get_nil(comments) )
+	callCommentHook(comments, tpos, term);
     }
   } else {
     if ( rd.has_exception && reportReadError(&rd) )

pl/boot.yap

@@ -1022,11 +1022,6 @@ bootstrap(F) :-
 	!,
 	close(Stream).
 
-'$read_vars'(Stream, T, Mod, Pos, V, _Prompt, false) :- !,
-       read_term(Stream, T, [  module(Mod), variable_names(V), term_position(Pos), syntax_errors(dec10)  ]).
-'$read_vars'(Stream, T, Mod, Pos, V, _Prompt, ReadComments) :-
-       read_term(Stream, T, [module(Mod), variable_names(V), term_position(Pos), syntax_errors(dec10),  comments( ReadComments ) ]).
-
 '$loop'(Stream,exo) :-
 	prolog_flag(agc_margin,Old,0),	
 	prompt1('|     '), prompt(_,'| '),
@@ -1046,36 +1041,15 @@ bootstrap(F) :-
 	prolog_flag(agc_margin,_,Old),
 	!.
 '$loop'(Stream,Status) :-
-	(
-	 Status = top
-	;
-	 '$undefined'(comment_hook(_,_,_),prolog)
-	;
-	 '$number_of_clauses'(comment_hook(_,_,_),prolog,0)
-	), !,
 	repeat,
 		prompt1('|     '), prompt(_,'| '),
 		'$current_module'(OldModule),
 		'$system_catch'('$enter_command'(Stream,OldModule,Status), OldModule, Error,
 			 user:'$LoopError'(Error, Status)),
 	!.
-% support comment hook
-'$loop'(Stream,Status) :-
-	repeat,
-		prompt1('|     '), prompt(_,'| '),
-		'$current_module'(OldModule),
-		'$system_catch'('$enter_command_with_hook'(Stream,OldModule,Status), OldModule, Error,
-			 user:'$LoopError'(Error, Status)),
-	!.
 
 '$enter_command'(Stream,Mod,Status) :-
-	'$read_vars'(Stream,Command,Mod,Pos,Vars, '|: ', false),
+	read_term(Stream, Command, [module(Mod), variable_names(Vars), term_position(Pos), syntax_errors(dec10), process_comment(true) ]),
-	'$command'(Command,Vars,Pos,Status).
-
-% support SWI hook in a separate predicate, to avoid slow down standard consult.
-'$enter_command_with_hook'(Stream,Mod,Status) :-
-	'$read_vars'(Stream,Command,Mod,Pos,Vars, '|: ', Comments),
-	( prolog:comment_hook(Comments,Pos,Command) -> true ; true ),
 	'$command'(Command,Vars,Pos,Status).
 
 '$abort_loop'(Stream) :-