diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fix comment handling

Browse Source
This commit is contained in:
Vítor Santos Costa 2013-12-08 22:56:48 +00:00
parent a654907fe1
commit 61d624e416
11 changed files with 76 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
H/dhstruct.h
View File

@ -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

1
H/hstruct.h
View File

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

2
H/iatoms.h
View File

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

1
H/ihstruct.h
View File

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

2
H/ratoms.h
View File

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

1
H/rhstruct.h
View File

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

4
H/tatoms.h
View File

@ -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_;

2
misc/ATOMS
View File

@ -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

1
misc/HEAPFIELDS
View File

@ -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

68
os/pl-read.c
View File

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

28
pl/boot.yap
View File

@ -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),
'$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 ),
read_term(Stream, Command, [module(Mod), variable_names(Vars), term_position(Pos), syntax_errors(dec10), process_comment(true) ]),
'$command'(Command,Vars,Pos,Status).
'$abort_loop'(Stream) :-