From 3e71d171e71f86c8c39e9af217ca6d430c4551ea Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 20 Feb 2018 22:59:17 +0000 Subject: [PATCH 1/2] small --- packages/jpl/jpl.pl | 16 ++++++++-------- packages/python/py2pl.c | 2 +- pl/boot.yap | 2 +- pl/grammar.yap | 15 +++++++-------- pl/load_foreign.yap | 8 +++++++- pl/meta.yap | 8 ++++---- pl/top.yap | 15 +++++++++++---- swi/library/debug.pl | 4 ++-- swi/library/prolog_xref.pl | 15 ++++++--------- 9 files changed, 47 insertions(+), 38 deletions(-) diff --git a/packages/jpl/jpl.pl b/packages/jpl/jpl.pl index f5d9ccd8b..89c9488b4 100644 --- a/packages/jpl/jpl.pl +++ b/packages/jpl/jpl.pl @@ -4470,7 +4470,7 @@ add_search_path(Path, Dir) :- % =CLASSPATH=, etc. search_path_separator((;)) :- - current_prolog_flag(windows, true), !. + current_prolog_flag(windo/.... ,,,,,,,,,,,,,,,,,, :l'p[KIO)_"?ws, true), !. search_path_separator(:). /******************************* @@ -4499,14 +4499,14 @@ check_java_libs(JVM, Java) :- libfile( java, Root, Java), !. % try JAVA_HOME, registry, etc.. -location( java_root, _, Home) :- +location( java_root, _, Home) :- getenv( 'JAVA_HOME', Home ). location(java_root, _, JRE) :- % OS well-known member(Root, [ '/usr/lib', '/usr/local/lib', '/opt/lib', - '/Library/Java/JavaVirtualMachines', + '/Library/Java/JavaVirtual hines', '/System/Library/Frameworks' ]), exists_directory(Root), @@ -4517,13 +4517,13 @@ jdk_jre( Home, J ) :- absolute_file_name( Extension, [expand(true), relative_to(Home), access(exists), file_type( directory ), file_errors(fail), solutions(all) ], J0 ), pick_jdk_jre(J0, J). - + pick_jdk_jre(J, J). pick_jdk_jre(J0, J) :- absolute_file_name( 'jre*', [expand(true), relative_to(J0), access(exists), file_type( directory ), file_errors(fail), solutions(all) ], J ). pick_jdk_jre(J0, J) :- absolute_file_name( 'jdk*', [expand(true), relative_to(J0), access(exists), file_type( directory ), file_errors(fail), solutions(all) ], J ). - + libfile(Base, HomeLib, File) :- java_arch( Arch ), @@ -4534,7 +4534,7 @@ libfile(Base, HomeLib, File) :- jlib(Base, LBase), atom_concat(['lib',LBase], Lib), absolute_file_name( Lib, [relative_to(HomeLib), access(read), file_type( executable), expand(true), file_errors(fail), solutions(all)], File ). - + jlib( jvm, '/server/libjvm' ). jlib( jvm, '/client/libjvm' ). jlib( java, '/libjava' ). @@ -4616,10 +4616,10 @@ add_jpl_to_ldpath(JPL, File) :- % This appears to work on Windows. Unfortunately most Unix systems % appear to inspect the content of LD_LIBRARY_PATH only once. -add_java_to_ldpath(_LIBJAVA, LIBJVM) :- +add_java_to_ldpath(_LIBJAVA, LIBJVM) :- add_lib_to_ldpath(LIBJVM), fail. -add_java_to_ldpath(LIBJAVA, _LIBJVM) :- +add_java_to_ldpath(LIBJAVA, _LIBJVM) :- add_lib_to_ldpath(LIBJAVA), fail. add_java_to_ldpath(_,_). diff --git a/packages/python/py2pl.c b/packages/python/py2pl.c index 7e7ccfad1..5828bb850 100644 --- a/packages/python/py2pl.c +++ b/packages/python/py2pl.c @@ -150,7 +150,7 @@ foreign_t python_to_term(PyObject *pVal, term_t t) { for (i = 0; i < sz; i++) { PyObject *obj; rc = rc && PL_unify_list(t, to, t); - if ((obj = PyList_GetItem(pVal, i - 1)) == NULL) { + if ((obj = PyList_GetItem(pVal, i)) == NULL) { obj = Py_None; } rc = rc && python_to_term(obj, to); diff --git a/pl/boot.yap b/pl/boot.yap index 6a540075f..3d093a5c2 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -212,7 +212,7 @@ print_message(L,E) :- '$yap_strip_module'(C, EM, EG), '$execute_command'(EG,EM,VL,Pos,Con,C), ! ; % do term expansion - '$expand_term'(C, EC), + '$expand_term'(C, Con, EC), '$yap_strip_module'(EC, EM, EG), % execute a list of commands '$execute_commands'(EG,EM,VL,Pos,Con,_Source), diff --git a/pl/grammar.yap b/pl/grammar.yap index c7586c6cb..bdcaa9fb7 100644 --- a/pl/grammar.yap +++ b/pl/grammar.yap @@ -67,7 +67,6 @@ right hand side of a grammar rule Grammar related built-in predicates: */ -/* :- system_module( '$_grammar', [!/2, (',')/4, (->)/4, @@ -81,7 +80,7 @@ Grammar related built-in predicates: phrase/3, {}/3, ('|')/4], ['$do_error'/2]). -*/ + % :- meta_predicate ^(?,0,?). % ^(Xs, Goal, Xs) :- call(Goal). @@ -121,7 +120,7 @@ t_hgoal(V, _, _, _, G0) :- var(V), !, t_hgoal(M:H, M:NH, S, SR, G0) :- !, t_hgoal(H, NH, S, SR, G0). t_hgoal(H, NH, S, SR, _) :- - extend([S,SR],H,NH). + dcg_extend([S,SR],H,NH). t_hlist(V, _, _, _, G0) :- var(V), !, '$do_error'(instantiation_error,G0). @@ -174,10 +173,10 @@ t_body((T|R), _ToFill, _, S, SR, (Tt;Rt)) :- !, t_body(M:G, ToFill, Last, S, SR, M:NG) :- !, t_body(G, ToFill, Last, S, SR, NG). t_body(T, filled_in, _, S, SR, Tt) :- - extend([S,SR], T, Tt). + dcg_extend([S,SR], T, Tt). -extend(More, OldT, NewT) :- +dcg_extend(More, OldT, NewT) :- OldT =.. OldL, lists:append(OldL, More, NewL), NewT =.. NewL. @@ -232,7 +231,7 @@ prolog:phrase(V, S0, S) :- '$do_error'(instantiation_error,phrase(V,S0,S)). prolog:phrase([H|T], S0, S) :- !, - S0 = [H|S1], + S0 = [H|S1], '$phrase_list'(T, S1, S). prolog:phrase([], S0, S) :- !, @@ -313,10 +312,10 @@ prolog:'\\+'(A, S0, S) :- do_c_built_in('C'(A,B,C), _, _, (A=[B|C])) :- !. -do_c_built_in(phrase(NT,Xs0, Xs),Mod, _, NewGoal) :- +do_c_built_in(phrase(NT,Xs0, Xs),Mod, _, NewGoal) :- nonvar(NT), nonvar(Mod), !, '$c_built_in_phrase'(NT, Xs0, Xs, Mod, NewGoal). - + do_c_built_in(phrase(NT,Xs),Mod,_,NewGoal) :- nonvar(NT), nonvar(Mod), '$c_built_in_phrase'(NT, Xs, [], Mod, NewGoal). diff --git a/pl/load_foreign.yap b/pl/load_foreign.yap index 0d2b58dbe..3e8eef8f3 100644 --- a/pl/load_foreign.yap +++ b/pl/load_foreign.yap @@ -98,7 +98,13 @@ load_foreign_files(Objs,Libs,Entry) :- Loads object files produced by the C compiler. It is useful when no search should be performed and instead one has the full paths to the _Files_ and _Libs_. */ -load_absolute_foreign_files(_Objs,_Libs,_Entry). +load_absolute_foreign_files(Objs,Libs,Entry) :- + source_module(M), + '$load_foreign_files'(Objs,Libs,Entry), + !, + prolog_load_context(file, F), + ignore( recordzifnot( '$load_foreign_done', [F, M], _) ). + '$checklib_prefix'(F,F) :- is_absolute_file_name(F), !. '$checklib_prefix'(F, F) :- sub_atom(F, 0, _, _, lib), !. diff --git a/pl/meta.yap b/pl/meta.yap index b98eb772e..380969f00 100644 --- a/pl/meta.yap +++ b/pl/meta.yap @@ -73,7 +73,7 @@ meta_predicate declaration retractall(prolog:'$meta_predicate'(F,M2,N,_)), fail. '$install_meta_predicate'(P,M,F,N) :- - ( M = prolog -> M2 = _ ; M2 = M), + ( M = prolog -> M2 = _ ; M2 = M), assertz('$meta_predicate'(F,M2,N,P)). % comma has its own problems. @@ -591,8 +591,8 @@ meta_predicate(P) :- spy(:), stash_predicate(:), use_module(:), - use_module(:,?), - use_module(?,:,?), + use_module(:,+), + use_module(?,:,+), when(+,0), with_mutex(+,0), with_output_to(?,0), @@ -606,5 +606,5 @@ meta_predicate(P) :- '|'(2,2,?,?), ->(2,2,?,?), \+(2,?,?), - \+( 0 ) + \+( 0 ) . diff --git a/pl/top.yap b/pl/top.yap index 6bcd942a1..b00dce43f 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -231,14 +231,21 @@ current_prolog_flag(break_level, BreakLevel), '$continue_with_command'(Option, VL, Pos, M:G, Source). '$expand_term'(T,O) :- - catch( '$expand_term0'(T,O), _,( '$disable_debugging', fail) ), + '$expand_term'(T,top,O). + +'$expand_term'(T,Con,O) :- + catch( '$expand_term0'(T,Con,O), _,( '$disable_debugging', fail) ), !. -'$expand_term0'(T,O) :- - expand_term( T, T1), + '$expand_term0'(T,consult,O) :- + expand_term( T, O). + '$expand_term0'(T,reconsult,O) :- + expand_term( T, O). + '$expand_term0'(T,top,O) :- + expand_term( T, T1), !, '$expand_term1'(T1,O). -'$expand_term0'(T,T). +'$expand_term0'(T,_,T). '$expand_term1'(T,O) :- '$expand_meta_call'(T, [], O), diff --git a/swi/library/debug.pl b/swi/library/debug.pl index bae82edee..ecb3c007d 100644 --- a/swi/library/debug.pl +++ b/swi/library/debug.pl @@ -116,8 +116,8 @@ debugging(Topic) :- debugging(Topic, Bool) :- debugging(Topic, Bool, _To). -%% debug(+Topic) is det. -%% nodebug(+Topic) is det. +%% @pred debug(+Topic) is det. +%% @pred nodebug(+Topic) is det. % % Add/remove a topic from being printed. nodebug(_) removes all % topics. Gives a warning if the topic is not defined unless it is diff --git a/swi/library/prolog_xref.pl b/swi/library/prolog_xref.pl index 4265a407a..bbb5a2847 100644 --- a/swi/library/prolog_xref.pl +++ b/swi/library/prolog_xref.pl @@ -55,9 +55,7 @@ :- use_module(library(lists), [append/3, member/2]). :- use_module(library(operators), [pop_operators/0, push_op/3, push_operators/1]). -:- if(current_prolog_flag(dialect, swi)). :- use_module(library(shlib), [current_foreign_library/2]). -:- endif. :- use_module(library(prolog_source)). :- use_module(library(option)). :- use_module(library(error)). @@ -121,12 +119,12 @@ called_by(on_signal(_,_,New), [New+1]) :- :- expects_dialect(swi). -:- if(current_prolog_flag(dialect, swi)). -system_predicate(Goal) :- - functor(Goal, Name, Arity), - current_predicate(system:Name/Arity), % avoid autoloading - predicate_property(system:Goal, built_in), !. -:-endif. +% :- if(current_prolog_flag(dialect, swi)). +% system_predicate(Goal) :- +% functor(Goal, Name, Arity), +% current_predicate(system:Name/Arity), % avoid autoloading +% predicate_property(system:Goal, built_in), !. +% :-endif. /******************************** * TOPLEVEL * @@ -1452,4 +1450,3 @@ do_xref_source_file(Spec, File, Options) :- access(read), file_errors(fail) ], File), !. - From bdc9e7005d9897265517a519a85006becbd9edcc Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 21 Feb 2018 13:02:20 +0000 Subject: [PATCH 2/2] scanner fixes -> vs ! error handling --- C/errors.c | 25 ++++++++++++++--- C/scanner.c | 26 +++++++++++++----- C/text.c | 16 ++++++----- CXX/yapq.hh | 4 +-- include/YapError.h | 9 +++++-- os/YapIOConfig.h.cmake | 9 +++++++ os/chartypes.c | 4 +-- os/readterm.c | 17 +++++++----- pl/boot.yap | 61 +++++++++++++++++++++++++++++++++++++++++- pl/meta.yap | 5 ++-- 10 files changed, 141 insertions(+), 35 deletions(-) diff --git a/C/errors.c b/C/errors.c index b53ec6c43..fd0411bd6 100755 --- a/C/errors.c +++ b/C/errors.c @@ -68,7 +68,24 @@ bool Yap_Warning(const char *s, ...) { rc = Yap_execute_pred(pred, ts, true PASS_REGS); return rc; } -void Yap_InitError(yap_error_number e, Term t, const char *msg) { + +void Yap_InitError__(const char *file, const char *function, int lineno, yap_error_number e, Term t, ...) { + CACHE_REGS + va_list ap; + va_start(ap, t); + const char *fmt; + char tmpbuf[MAXPATHLEN]; + + fmt = va_arg(ap, char *); + if (fmt != NULL) { +#if HAVE_VSNPRINTF + vsnprintf(tmpbuf, MAXPATHLEN - 1, fmt, ap); +#else + (void)vsprintf(tmpbuf, fmt, ap); +#endif + } else + return; + va_end(ap); if (LOCAL_ActiveError->status) { Yap_exit(1); } @@ -76,10 +93,10 @@ void Yap_InitError(yap_error_number e, Term t, const char *msg) { LOCAL_ActiveError->errorFile = NULL; LOCAL_ActiveError->errorFunction = NULL; LOCAL_ActiveError->errorLine = 0; - if (msg) { - LOCAL_Error_Size = strlen(msg); + if (fmt) { + LOCAL_Error_Size = strlen(tmpbuf); LOCAL_ActiveError->errorMsg = malloc(LOCAL_Error_Size + 1); - strcpy(LOCAL_ActiveError->errorMsg, msg); + strcpy(LOCAL_ActiveError->errorMsg, tmpbuf); } else { LOCAL_Error_Size = 0; } diff --git a/C/scanner.c b/C/scanner.c index b247027f2..0f4f1accb 100755 --- a/C/scanner.c +++ b/C/scanner.c @@ -970,6 +970,10 @@ static Term get_num(int *chp, int *chbuffp, StreamDesc *st, int sign) { number_overflow(); *sp++ = ch; ch = getchr(st); + if (!iswhexnumber(ch)) { + Yap_InitError(SYNTAX_ERROR, TermNil, "empty hexadecimal number 0x%C",ch) ; + return 0; + } while (my_isxdigit(ch, 'F', 'f')) { Int oval = val; int chval = @@ -982,16 +986,27 @@ static Term get_num(int *chp, int *chbuffp, StreamDesc *st, int sign) { if (oval != (val - chval) / 16) /* overflow */ has_overflow = TRUE; ch = getchr(st); + } *chp = ch; } else if (ch == 'o' && base == 0) { - might_be_float = FALSE; + might_be_float = false; base = 8; ch = getchr(st); + if (ch < '0' || ch > '7') { + Yap_InitError(SYNTAX_ERROR, TermNil, "empty octal number 0b%C", ch) ; + return 0; + } } else if (ch == 'b' && base == 0) { - might_be_float = FALSE; + might_be_float = false; base = 2; ch = getchr(st); + if (ch < '0' || ch > '1') { + Yap_InitError(SYNTAX_ERROR, TermNil, "empty binary 0b%C", ch) ; + return 0; + } + + } else { val = base; base = 10; @@ -1011,7 +1026,7 @@ static Term get_num(int *chp, int *chbuffp, StreamDesc *st, int sign) { } val = val * base + ch - '0'; if (val / base != oval || val - oval * base != ch - '0') /* overflow */ - has_overflow = TRUE; + has_overflow = true; ch = getchr(st); } if (might_be_float && (ch == '.' || ch == 'e' || ch == 'E')) { @@ -1162,8 +1177,7 @@ Term Yap_scan_num(StreamDesc *inp, bool error_on) { #endif if (LOCAL_ErrorMessage != NULL || ch != -1 || cherr) { Yap_clean_tokenizer(old_tr, NULL, NULL); - if (error_on) - Yap_Error(SYNTAX_ERROR, ARG2, "converting number"); + Yap_InitError(SYNTAX_ERROR, ARG2, "while converting stream %d to number", inp-GLOBAL_Stream ); return 0; } return out; @@ -1472,7 +1486,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments, cherr = 0; CHECK_SPACE(); if ((t->TokInfo = get_num(&cha, &cherr, st, sign)) == 0L) { - if (p) { + if (t->TokInfo == 0) { p->Tok = eot_tok; t->TokInfo = TermError; } diff --git a/C/text.c b/C/text.c index 577a8f39e..2f64a815d 100644 --- a/C/text.c +++ b/C/text.c @@ -719,21 +719,23 @@ static size_t write_length(const unsigned char *s0, seq_tv_t *out USES_REGS) { static Term write_number(unsigned char *s, seq_tv_t *out, bool error_on USES_REGS) { Term t; - yap_error_number erro = LOCAL_Error_TYPE; - int i = push_text_stack(); + yap_error_descriptor_t new_error; + int i = push_text_stack(); + Yap_pushErrorContext(&new_error); t = Yap_StringToNumberTerm((char *)s, &out->enc, error_on); pop_text_stack(i); - LOCAL_Error_TYPE = erro; + Yap_popErrorContext(true); return t; } static Term string_to_term(void *s, seq_tv_t *out USES_REGS) { Term o; - yap_error_number erro = LOCAL_Error_TYPE; - o = out->val.t = Yap_BufferToTerm(s, TermNil); - LOCAL_Error_TYPE = erro; + yap_error_descriptor_t new_error; + Yap_pushErrorContext(&new_error); + o = out->val.t = Yap_BufferToTerm(s, TermNil); + Yap_popErrorContext(true); - return o; + return o; } bool write_Text(unsigned char *inp, seq_tv_t *out USES_REGS) { diff --git a/CXX/yapq.hh b/CXX/yapq.hh index e3f203c8b..bf95657dc 100644 --- a/CXX/yapq.hh +++ b/CXX/yapq.hh @@ -38,12 +38,10 @@ class X_API YAPPredicate; class X_API YAPQuery : public YAPPredicate { bool q_open; int q_state; - yhandle_t q_g, q_handles; + yhandle_t q_handles; struct yami *q_p, *q_cp; - sigjmp_buf q_env; int q_flags; YAP_dogoalinfo q_h; - YAPQuery *oq; YAPPairTerm names; YAPTerm goal; // temporaries diff --git a/include/YapError.h b/include/YapError.h index 0be7c227d..ada04ff9b 100644 --- a/include/YapError.h +++ b/include/YapError.h @@ -37,10 +37,12 @@ #define MAX_ERROR_MSG_SIZE 1024 -struct yami *Yap_Error__(const char *file, const char *function, int lineno, +extern void Yap_InitError__(const char *file, const char *function, int lineno, yap_error_number e, YAP_Term g, ...); + +extern struct yami *Yap_Error__(const char *file, const char *function, int lineno, yap_error_number err, YAP_Term wheret, ...); -void Yap_ThrowError__(const char *file, const char *function, int lineno, +extern void Yap_ThrowError__(const char *file, const char *function, int lineno, yap_error_number err, YAP_Term wheret, ...) #ifndef MSC_VER __attribute__((noreturn)) @@ -50,6 +52,9 @@ void Yap_ThrowError__(const char *file, const char *function, int lineno, #define Yap_NilError(id, ...) \ Yap_Error__(__FILE__, __FUNCTION__, __LINE__, id, TermNil, __VA_ARGS__) +#define Yap_InitError(id, ...) \ + Yap_InitError__(__FILE__, __FUNCTION__, __LINE__, id, TermNil, __VA_ARGS__) + #define Yap_Error(id, inp, ...) \ Yap_Error__(__FILE__, __FUNCTION__, __LINE__, id, inp, __VA_ARGS__) diff --git a/os/YapIOConfig.h.cmake b/os/YapIOConfig.h.cmake index 8501f670f..afda3b27f 100644 --- a/os/YapIOConfig.h.cmake +++ b/os/YapIOConfig.h.cmake @@ -1,3 +1,12 @@ + +// play nice +#ifndef HAVE_PYTHON +#cmakedefine HAVE_PYTHON ${HAVE_PYTHON} +#endif +#if HAVE_PYTHON +#include +#endif + /* Define if you have libreadline */ #ifndef HAVE_LIBREADLINE #cmakedefine HAVE_LIBREADLINE ${HAVE_LIBREADLINE} diff --git a/os/chartypes.c b/os/chartypes.c index bb0d60d20..0fad877be 100644 --- a/os/chartypes.c +++ b/os/chartypes.c @@ -95,9 +95,7 @@ Term Yap_StringToNumberTerm(const char *s, encoding_t *encp, bool error_on) { s++; #endif t = Yap_scan_num(GLOBAL_Stream + sno, error_on); - if (LOCAL_Error_TYPE == SYNTAX_ERROR) - LOCAL_Error_TYPE = YAP_NO_ERROR; - Yap_CloseStream(sno); + Yap_CloseStream(sno); UNLOCK(GLOBAL_Stream[sno].streamlock); return t; } diff --git a/os/readterm.c b/os/readterm.c index e760c10c0..7aa7c9ce5 100644 --- a/os/readterm.c +++ b/os/readterm.c @@ -324,9 +324,9 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos) { CELL *Hi = HR; TokEntry *tok = LOCAL_tokptr; Int cline = tok->TokLine; - Int startpos = tok->TokPos; - errtok = LOCAL_toktide; - Int errpos = errtok->TokPos; + Int startpos = tok->TokPos; + errtok = LOCAL_toktide; + Int errpos = errtok->TokPos; UInt diff = 0; startline = MkIntegerTerm(cline); endline = MkIntegerTerm(cline); @@ -335,15 +335,15 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos) { if (LOCAL_ErrorMessage) tm = MkStringTerm(LOCAL_ErrorMessage); else { - tm = MkStringTerm("syntax error"); + tm = MkStringTerm("syntax error"); } if (GLOBAL_Stream[sno].status & Seekable_Stream_f) { if (errpos && newpos >= 0) { char o[128 + 1]; diff = errpos - startpos; if (diff > 128) { - diff = 128; - startpos = errpos - diff; + diff = 128; + startpos = errpos - diff; } #if HAVE_FTELLO Int curpos = ftello(GLOBAL_Stream[sno].file); @@ -729,7 +729,7 @@ static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart) { CACHE_REGS Term v_vp, v_vnames, v_comments, v_pos; - if (fe->t0 & fe->t && !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); @@ -907,6 +907,9 @@ static parser_state_t scanError(REnv *re, FEnv *fe, int inp_stream) { } } // go back to the start + if (LOCAL_Error_TYPE == SYNTAX_ERROR) { + return YAP_PARSING_ERROR; + } if (re->seekable) { if (GLOBAL_Stream[inp_stream].status & InMemory_Stream_f) { GLOBAL_Stream[inp_stream].u.mem_string.pos = re->cpos; diff --git a/pl/boot.yap b/pl/boot.yap index 3d093a5c2..861ceda6a 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -107,7 +107,66 @@ private(_). :- use_system_module( '$_strict_iso', ['$check_iso_strict_clause'/1, '$iso_check_goal'/2]). -% be careful here not to generate an undefined exception. +% be careful here not to generate an undefined exception.. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + print_message(L,E) :- '$number_of_clauses'(print_message(L,E), prolog_complete, 1), diff --git a/pl/meta.yap b/pl/meta.yap index 380969f00..9d7b0396b 100644 --- a/pl/meta.yap +++ b/pl/meta.yap @@ -300,8 +300,9 @@ meta_predicate declaration nonvar(G), G = (A = B), !. -'$expand_goals'(\+A,\+A1,('$current_choice_point'(CP),AO,'$$cut_by'(CP)-> false;true),HM,SM,BM,HVars) :- !, - '$expand_goals'(A,A1,AO,HM,SM,BM,HVars). +'$expand_goals'(\+A,\+A1,(AO-> false;true),HM,SM,BM,HVars) :- !, + '$expand_goals'(A,A1,AOO,HM,SM,BM,HVars), + '$clean_cuts'(AOO, AO). '$expand_goals'(once(A),once(A1), ('$current_choice_point'(CP),AO,'$$cut_by'(CP)),HM,SM,BM,HVars) :- !, '$expand_goals'(A,A1,AO0,HM,SM,BM,HVars),