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

Merge branch 'master' of https://github.com/vscosta/yap-6.3

Browse Source
This commit is contained in:
Vitor Santos Costa 2016-06-04 22:24:38 +01:00
commit 0069222b75
21 changed files with 248 additions and 215 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
C/cdmgr.c
View File

@ -1014,6 +1014,20 @@ bool Yap_unknown(Term t) {
return false;
}
static Int
undef_handler(USES_REGS1) { /* '$undef_handler'(+S,+Mod) */
PredEntry *pe;
Int out;
pe = get_pred(Deref(ARG1), Deref(ARG2), "undef_handler");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(27, pe);
UndefCode = pe;
UNLOCKPE(44, pe);
return true;
}
static int source_pred(PredEntry *p, yamop *q) {
if (p->PredFlags & (DynamicPredFlag | LogUpdatePredFlag))
return FALSE;
@ -4653,6 +4667,7 @@ void Yap_InitCdMgr(void) {
Yap_InitCPred("$call_count_reset", 0, p_call_count_reset,
SafePredFlag | SyncPredFlag);
Yap_InitCPred("$set_pred_module", 2, p_set_pred_module, SafePredFlag);
Yap_InitCPred("$undef_handler", 2, undef_handler, SafePredFlag);
Yap_InitCPred("$set_pred_owner", 2, p_set_pred_owner, SafePredFlag);
Yap_InitCPred("$hide_predicate", 2, hide_predicate, SafePredFlag);
Yap_InitCPred("$stash_predicate", 2, p_stash_predicate, SafePredFlag);

9
C/text.c
View File

@ -834,14 +834,14 @@ size_t write_buffer(void *s0, seq_tv_t *out, encoding_t enc, int minimal,
if (!minimal)
sz *= 4;
if (out->type & (YAP_STRING_MALLOC)) {
out->val.c = malloc(sz);
out->val.uc = malloc(sz);
} else if (!(out->type & (YAP_STRING_WITH_BUFFER))) {
if (ASP - (sz / sizeof(CELL) + 1) > HR + 1024) {
out->val.c = Yap_PreAllocCodeSpace();
}
}
} else {
out->val.c = s0;
out->val.uc = s0;
}
if (out->enc == ENC_ISO_UTF8) {
switch (enc) {
@ -849,17 +849,18 @@ size_t write_buffer(void *s0, seq_tv_t *out, encoding_t enc, int minimal,
if (out->type & (YAP_STRING_WITH_BUFFER | YAP_STRING_MALLOC)) {
char *s = s0;
size_t n = strlen(s) + 1;
out->val.c[n] = '\0';
out->val.uc[n] = '\0';
sz_end = n + 1;
} else {
sz_end = strlen(out->val.c) + 1;
}
break;
case ENC_ISO_LATIN1: {
unsigned char *s = s0, *lim = s + (max = strnlen(s0, max));
unsigned char *cp = s, *buf0, *buf;
buf = buf0 = s0;
buf = buf0 = out->val.uc;
if (!buf)
return -1;
while (*cp && cp < lim) {

1
H/ATOMS
View File

@ -406,6 +406,7 @@ A Txt N "txt"
A TypeError N "type_error"
A Undefined N "undefined"
A Undefp F "$undefp"
A Undefp0 F "$undefp0"
A Underflow N "underflow"
A UnificationStack N "unification_stack"
A Unique N "unique"

6
H/HEAPFIELDS
View File

@ -141,10 +141,10 @@ rwlock_t PredHashRWLock void
/* Well-Known Predicates */
struct pred_entry *CreepCode MkPred AtomCreep 1 PROLOG_MODULE
struct pred_entry *UndefCode MkPred AtomUndefp 2 PROLOG_MODULE
struct pred_entry *UndefCode MkPred AtomUndefp0 2 PROLOG_MODULE
struct pred_entry *SpyCode MkPred AtomSpy 1 PROLOG_MODULE
struct pred_entry *PredFail MkPred AtomFail 0 PROLOG_MODULE
struct pred_entry *PredTrue MkPred AtomTrue 0 PROLOG_MODULE
struct pred_entry *PredFail MkPred AtomFail 0 PROLOG_MODULE
struct pred_entry *PredTrue MkPred AtomTrue 0 PROLOG_MODULE
#ifdef COROUTINING
struct pred_entry *WakeUpCode MkPred AtomWakeUpGoal 2 PROLOG_MODULE
#endif

18
H/Tags_64bits.h
View File

@ -1,10 +1,4 @@
/*************************************************************************
* *
* YAP Prolog %W% %G% *
@ -42,18 +36,18 @@ property list
*/
#define SHIFT_HIGH_TAG 62
#define SHIFT_HIGH_TAG 61
#define MKTAG(HI,LO) ((((UInt) (HI))<<SHIFT_HIGH_TAG)|(LO))
#define TagBits /* 0x30000007L */ MKTAG(0x1,7)
#define TagBits /* 0x70000007L */ MKTAG(0x7,7)
#define LowTagBits /* 0x00000007L */ MKTAG(0x0,7)
#define HighTagBits /* 0x70000000L */ MKTAG(0x1,0)
#define AdrHiBit /* 0x08000000L */ (((UInt)1) << (SHIFT_HIGH_TAG-1))
#define MaskPrim /* 0x0ffffff8L */ ((((UInt)1) << (SHIFT_HIGH_TAG))-8)
#define HighTagBits /* 0x70000000L */ MKTAG(0x7,0)
#define AdrHiBit /* 0x08000000L */ (((UInt)1) << (SHIFT_HIGH_TAG-3))
#define MaskPrim /* 0x0ffffff8L */ (((((UInt)1) << (SHIFT_HIGH_TAG-3))-1)<<3)
#define NumberTag /* 0x30000001L */ MKTAG(0x1,1)
#define AtomTag /* 0x10000001L */ MKTAG(0x0,1)
#define MAX_ABS_INT /* 0xfe00000LL */ (((Int)1) << (63-(2+4)))
#define MAX_ABS_INT /* 0xfe00000LL */ ((((Int)1) << (63-(3+3)))<<3)
/* bits that should not be used by anyone but us */
#define YAP_PROTECTED_MASK 0xe000000000000000L

3
H/YapSignals.h
View File

@ -20,6 +20,9 @@
#if HAVE_SIGNAL_H
#include <signal.h>
#endif
#if HAVE_ERRNO_H
#include <errno.h>
#endif
typedef enum
{

4
H/eval.h
View File

@ -426,7 +426,11 @@ INLINE_ONLY inline EXTERN Term Yap_Eval__(Term t USES_REGS) {
return Yap_InnerEval(t);
}
#if HAVE_FECLEAREXCEPT
inline static void Yap_ClearExs(void) { feclearexcept(FE_ALL_EXCEPT); }
#else
inline static void Yap_ClearExs(void) { }
#endif
inline static yap_error_number Yap_FoundArithError__(USES_REGS1) {
if (LOCAL_Error_TYPE != YAP_NO_ERROR)

1
H/generated/iatoms.h
View File

@ -401,6 +401,7 @@
AtomTypeError = Yap_LookupAtom("type_error"); TermTypeError = MkAtomTerm(AtomTypeError);
AtomUndefined = Yap_LookupAtom("undefined"); TermUndefined = MkAtomTerm(AtomUndefined);
AtomUndefp = Yap_FullLookupAtom("$undefp"); TermUndefp = MkAtomTerm(AtomUndefp);
AtomUndefp0 = Yap_FullLookupAtom("$undefp0"); TermUndefp0 = MkAtomTerm(AtomUndefp0);
AtomUnderflow = Yap_LookupAtom("underflow"); TermUnderflow = MkAtomTerm(AtomUnderflow);
AtomUnificationStack = Yap_LookupAtom("unification_stack"); TermUnificationStack = MkAtomTerm(AtomUnificationStack);
AtomUnique = Yap_LookupAtom("unique"); TermUnique = MkAtomTerm(AtomUnique);

2
H/generated/ihstruct.h
View File

@ -129,7 +129,7 @@
#endif
CreepCode = RepPredProp(PredPropByFunc(Yap_MkFunctor(AtomCreep,1),PROLOG_MODULE));
UndefCode = RepPredProp(PredPropByFunc(Yap_MkFunctor(AtomUndefp,2),PROLOG_MODULE));
UndefCode = RepPredProp(PredPropByFunc(Yap_MkFunctor(AtomUndefp0,2),PROLOG_MODULE));
SpyCode = RepPredProp(PredPropByFunc(Yap_MkFunctor(AtomSpy,1),PROLOG_MODULE));
PredFail = RepPredProp(PredPropByAtom(AtomFail,PROLOG_MODULE));
PredTrue = RepPredProp(PredPropByAtom(AtomTrue,PROLOG_MODULE));

1
H/generated/ratoms.h
View File

@ -401,6 +401,7 @@
AtomTypeError = AtomAdjust(AtomTypeError); TermTypeError = MkAtomTerm(AtomTypeError);
AtomUndefined = AtomAdjust(AtomUndefined); TermUndefined = MkAtomTerm(AtomUndefined);
AtomUndefp = AtomAdjust(AtomUndefp); TermUndefp = MkAtomTerm(AtomUndefp);
AtomUndefp0 = AtomAdjust(AtomUndefp0); TermUndefp0 = MkAtomTerm(AtomUndefp0);
AtomUnderflow = AtomAdjust(AtomUnderflow); TermUnderflow = MkAtomTerm(AtomUnderflow);
AtomUnificationStack = AtomAdjust(AtomUnificationStack); TermUnificationStack = MkAtomTerm(AtomUnificationStack);
AtomUnique = AtomAdjust(AtomUnique); TermUnique = MkAtomTerm(AtomUnique);

1
H/generated/tatoms.h
View File

@ -401,6 +401,7 @@ Atom AtomTxt; Term TermTxt;
Atom AtomTypeError; Term TermTypeError;
Atom AtomUndefined; Term TermUndefined;
Atom AtomUndefp; Term TermUndefp;
Atom AtomUndefp0; Term TermUndefp0;
Atom AtomUnderflow; Term TermUnderflow;
Atom AtomUnificationStack; Term TermUnificationStack;
Atom AtomUnique; Term TermUnique;

71
H/heapgc.h
View File

@ -77,6 +77,75 @@
(CellPtr(B) < CellPtr(val) && CellPtr(val) <= \
LCL0 && HEAP_PTR(val))))
#ifdef TAG_64BITS00
#define MARK_BIT MKTAG(0x2,0x0)
#define RMARK_BIT MKTAG(0x4,0x0)
#define MARKED_PTR(P) MARKED_PTR__(P PASS_REGS)
#define UNMARKED_CELL(P) MARKED_PTR__(P PASS_REGS)
#define UNMARKED_MARK(P, BP) UNMARKED_MARK__(P, BP PASS_REGS)
#define MARK(P) MARK__(P PASS_REGS)
#define UNMARK(P) UNMARK__(P PASS_REGS)
#define RMARK(P) RMARK__(P PASS_REGS)
#define RMARKED(P) RMARKED__(P PASS_REGS)
#define UNRMARK(P) UNRMARK__(P PASS_REGS)
static inline Int
MARKED_PTR__(CELL* ptr USES_REGS)
{
return (CELL)ptr & MARK_BIT;
}
static inline Int
UNMARKED_MARK__(CELL* ptr, char *bp USES_REGS)
{
CELL t = *ptr;
if (t & MARK_BIT) {
return true;
}
*ptr = t | MARK_BIT;
return false;
}
static inline void
MARK__(CELL* ptr USES_REGS)
{
CELL t = *ptr;
*ptr = t | MARK_BIT;
}
static inline void
UNMARK__(CELL* ptr USES_REGS)
{
*ptr &= ~MARK_BIT;
}
/* not really that useful */
#define MAY_UNMARK(X)
#define UNMARK_CELL(X) (X)
static inline void
RMARK__(CELL* ptr USES_REGS)
{
*ptr |= RMARK_BIT;
}
static inline void
UNRMARK__(CELL* ptr USES_REGS)
{
*ptr &= ~RMARK_BIT;
}
static inline int
RMARKED__(CELL* ptr USES_REGS)
{
return *ptr & RMARK_BIT;
}
#else
#define MARK_BIT ((char)1)
#define RMARK_BIT ((char)2)
@ -145,6 +214,8 @@ RMARKED__(CELL* ptr USES_REGS)
return mcell(ptr) & RMARK_BIT;
}
#endif
/* is the object pointed to by ptr marked as in a relocation chain? */
#if LONG_ADDRESSES

13
os/alias.c
View File

@ -53,7 +53,7 @@ static char SccsId[] = "%W% %G%";
* It must always be interactive.
*/
#include "Yap.h"
#include "sysbits.h"
#if HAVE_FCNTL_H
/* for O_BINARY and O_TEXT in WIN32 */
#include <fcntl.h>
@ -98,25 +98,18 @@ static char SccsId[] = "%W% %G%";
#include <signal.h>
#endif
#ifdef _WIN32
// WIN32 API support
#if HAVE_IO_H
/* Windows */
#include <io.h>
#endif
#endif
#if !HAVE_STRNCAT
#define strncat(X,Y,Z) strcat(X,Y)
#endif
#if !HAVE_STRNCPY
#define strncpy(X,Y,Z) strcpy(X,Y)
#endif
#if _MSC_VER || defined(__MINGW32__)
#if HAVE_SOCKET
#include <winsock2.h>
#endif
#include <windows.h>
#ifndef S_ISDIR
#define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR)
#endif
#endif
#include "iopreds.h"

2
os/charsio.c
View File

@ -1192,7 +1192,7 @@ void Yap_InitCharsio(void) {
Yap_InitCPred("put_char", 2, put_char, SafePredFlag | SyncPredFlag);
Yap_InitCPred("put_char1", 1, put_char_1, SafePredFlag | SyncPredFlag);
Yap_InitCPred("tab", 2, tab, SafePredFlag | SyncPredFlag);
Yap_InitCPred("tab1", 1, tab_1, SafePredFlag | SyncPredFlag);
Yap_InitCPred("tab", 1, tab_1, SafePredFlag | SyncPredFlag);
Yap_InitCPred("nl", 0, nl_1, SafePredFlag | SyncPredFlag);
Yap_InitCPred("nl", 1, nl, SafePredFlag | SyncPredFlag);

3
os/files.c
View File

@ -496,9 +496,8 @@ static Int is_absolute_file_name(USES_REGS1) { /* file_base_name(Stream,N) */
#endif
}
freeBuffer( buf );
return rc;
}
return false;
return rc;
}
static Int file_base_name(USES_REGS1) { /* file_base_name(Stream,N) */

30
os/sig.c
View File

@ -1,7 +1,19 @@
#include "sysbits.h"
#if HAVE_SIGNAL || __ANDROID__
#if HAVE_SIGINFO_H
#include <siginfo.h>
#endif
#if HAVE_SYS_UCONTEXT_H
#include <sys/ucontext.h>
#endif
#if HAVE_FPU_CONTROL_H
#include <fpu_control.h>
#endif
#if HAVE_SIGNAL
#ifdef MSH
@ -24,7 +36,7 @@ static void HandleMatherr(int sig, void *sipv, void *uapv);
#endif
#define SIG_GC (SIG_PROLOG_OFFSET + 2)
#ifdef THREADS
#define SIG_THREAD_SIGNAL (SIG_PROLOG_OFFSET + 3)
#define SIG_THREAD_SIGNAL (SIG_PROLOG_OFFSET + 3)b
#endif
#define SIG_FREECLAUSES (SIG_PROLOG_OFFSET + 4)
#define SIG_PLABORT (SIG_PROLOG_OFFSET + 5)
@ -178,13 +190,6 @@ int Yap_signal_index(const char *name) {
return -1;
}
#if HAVE_SIGINFO_H
#include <siginfo.h>
#endif
#if HAVE_SYS_UCONTEXT_H
#include <sys/ucontext.h>
#endif
#if HAVE_SIGSEGV
static void SearchForTrailFault(void *ptr, int sure) {
@ -241,10 +246,6 @@ static void HandleSIGSEGV(int sig, void *sipv, void *uap) {
#if HAVE_SIGFPE
#if HAVE_FPU_CONTROL_H
#include <fpu_control.h>
#endif
/* by default Linux with glibc is IEEE compliant anyway..., but we will pretend
* it is not. */
static bool set_fpu_exceptions(Term flag) {
@ -795,7 +796,6 @@ VaxFixFrame(dummy) {
#if defined(_WIN32)
#include <windows.h>
int WINAPI win_yap(HANDLE, DWORD, LPVOID);
@ -881,9 +881,7 @@ void Yap_InitSignalPreds(void) {
CACHE_REGS
Term cm = CurrentModule;
#ifndef __ANDROID__
Yap_InitCPred("$fpe_error", 0, fpe_error, 0);
#endif
Yap_InitCPred("$alarm", 4, alarm4, SafePredFlag | SyncPredFlag);
CurrentModule = HACKS_MODULE;
Yap_InitCPred("virtual_alarm", 4, virtual_alarm, SafePredFlag | SyncPredFlag);

29
os/sysbits.h
View File

@ -27,6 +27,8 @@
#include "Yatom.h"
#include "eval.h"
#include "yapio.h"
// Win32 InputOutput Support
#if _WIN32 || defined(__MINGW32__)
#include <winsock2.h>
/* Windows */
@ -34,7 +36,12 @@
#include <direct.h>
#include <io.h>
#include <windows.h>
#ifndef S_ISDIR
#define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR)
#endif
#endif
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
@ -43,14 +50,10 @@
#endif
#include <stdlib.h>
#if HAVE_SYS_PARAM_H
#if HAVE_SYS_PARAM_Hb
#include <sys/param.h>
#endif
#ifdef FENV_H
#include <fenv.h>
#endif
#define S_ISDIR(x) (((x)&_S_IFDIR) == _S_IFDIR)
#if HAVE_STDARG_H
#include <stdarg.h>
#endif
@ -96,10 +99,16 @@
#include "iopreds.h"
#if HAVE_SIGNAL_H
#include <signal.h>
#endif
#ifdef HAVE_ERRNO_H
#include <errno.h>
#endif
/* CYGWIN seems to include this automatically */
#if HAVE_FENV_H // && !defined(__CYGWIN__)
#include <fenv.h>
#endif
#ifdef MPW
#define signal sigset
#endif
@ -132,12 +141,6 @@
#if HAVE_FCNTL_H
#include <fcntl.h>
#endif
#if _MSC_VER || defined(__MINGW32__)
#endif
/* CYGWIN seems to include this automatically */
#if HAVE_FENV_H && !defined(__CYGWIN__)
#include <fenv.h>
#endif
#if HAVE_WORDEXP_H
#include <wordexp.h>
#endif

6
os/yapio.h
View File

@ -139,12 +139,6 @@ void Yap_plwrite(Term t, struct stream_desc *mywrite, int max_depth, int flags,
int Yap_CheckSocketStream(Term stream, const char *error);
void Yap_init_socks(char *host, long interface_port);
#ifdef HAVE_ERRNO_H
#include <errno.h>
#else
extern int errno;
#endif
uint64_t HashFunction(const unsigned char *);
uint64_t WideHashFunction(wchar_t *);

89
pl/boot.yap
View File

@ -11,7 +11,7 @@
* File: boot.yap *
* Last rev: 8/2/88 *
* mods: *
* comments: boot file for Prolog *
* commen ts: boot file for Prolog *
* *
*************************************************************************/
@ -251,8 +251,6 @@ private(_).
:- use_system_module( '$_strict_iso', ['$check_iso_strict_clause'/1,
'$iso_check_goal'/2]).
'$early_print_message'(informational, _) :-
yap_flag( verbose, S),
S == silent,
@ -273,89 +271,22 @@ private(_).
'$handle_error'(_Action,_G0,_M0) :- fail.
% cases where we cannot afford to ever fail.
'$undefp'([ImportingMod|G], _) :-
'$undefp0'([ImportingMod|G], _) :-
recorded('$import','$import'(ExportingModI,ImportingMod,G,G0I,_,_),_), !,
% writeln('$execute0'(G0I, ExportingModI)),
'$execute0'(G0I, ExportingModI).
'$undefp'([_|print_message(Context, Msg)], _) :- !,
'$undefp0'([_|print_message(Context, Msg)], _) :- !,
'$early_print_message'(Context, Msg).
% undef handler
'$undefp'([M0|G0], Action) :-
'$undefp0'([M0|G0], Action) :-
% make sure we do not loop on undefined predicates
'$stop_creeping'(Current),
yap_flag( unknown, Action, fail),
Action\=fail,
% yap_flag( debug, Debug, false),
(
'$undefp_search'(M0:G0, NM:NG),
( M0 \== NM -> true ; G0 \== NG ),
NG \= fail
->
yap_flag( unknown, _, Action),
% yap_flag( debug, _, Debug),
(
Current == true
->
% carry on signal processing
'$start_creep'([NM|NG], creep)
;
'$execute0'(NG, NM)
)
;
yap_flag( unknown, _, Action),
'$handle_error'(Action,G0,M0)
).
/*
'$undefp'([M0|G0], Default) :-
G0 \= '$imported_predicate'(_,_,_,_),
G0 \= '$full_clause_optimisation'(_H, _M, _B0, _BF),
G0 \= '$expand_a_clause'(_,_,_,_),
G0 \= '$all_directives'(_),
format(user_error, 'ERROR: undefined ~a:~q.~n', [M0, G0]), fail.
*/
'$prepare_goals'((A,B),(NA,NB),Any) :-
!,
'$prepare_goals'(A,NA,Any),
'$prepare_goals'(B,NB,Any).
'$prepare_goals'((A;B),(NA;NB),Any) :-
!,
'$prepare_goals'(A,NA,Any),
'$prepare_goals'(B,NB,Any).
'$prepare_goals'((A->B),(NA->NB),Any) :-
!,
'$prepare_goals'(A,NA,Any),
'$prepare_goals'(B,NB,Any).
'$prepare_goals'((A*->B),(NA*->NB),Any) :-
!,
'$prepare_goals'(A,NA,Any),
'$prepare_goals'(B,NB,Any).
'$prepare_goals'((\+ A),(\+ NA),Any) :-
!,
'$prepare_goals'(A,NA,Any).
'$prepare_goals'('$do_error'(Error,Goal),
(clause_location(Call, Caller),
source_module(M),
strip_module(M:Goal,M1,NGoal),
throw(error(Error, [[g|g(M1:NGoal)],[p|Call],[e|Caller],[h|g(Head)]]))
),
true) :-
!,
'$head_and_body'(NGoal,Head,_Body).
'$prepare_goals'(X is AOB,
is(X, IOp, A, B ),
true) :-
var(X),
functor(AOB, Op, 2),
arg(1, AOB, A),
arg(2, AOB, B),
!,
'$inbrary_op_as_integer'(Op,IOp).
'$prepare_goals'((A,B),(A,B),_Any).
'$prepare_clause'((H :- B), (H:-NB)) :-
'$prepare_goals'(B,NB,Any),
Any==true.
Action \= fail,
'$handle_error'(Action,G0,M0),
clause_location(Call, Caller),
source_module(M),
strip_module(M:Goal,M1,NGoal),
throw(error(Error, [[g|g(M1:NGoal)],[p|Call],[e|Caller],[h|g(Head)]])).

93
pl/checker.yap
View File

@ -76,70 +76,63 @@ The style_check/1 built-in is now deprecated. Please use
style_check(V) :- var(V), !, fail.
style_check(V) :-
style_check_(V), !.
style_check(V) :-
\+atom(V), \+ list(V), V \= + _, V \= + _, !,
\+atom(V),
\+ is_list(V),
V \= + _,
V \= - _, !,
'$do_error'( type_error('+|-|?(Flag)', V), style_check(V) ).
style_check(V) :-
\+atom(V), \+ list(V), V \= + _, V \= + _, !,
\+atom(V),
\+ is_list(V),
V \= + _,
V \= + _, !,
'$do_error'( domain_error(style_name, V), style_check(V) ).
style_check_(all) :-
'$style_checker'( [ singleton, discontiguous, multiple ] ).
style_check_(single_var) :-
'$style_checker'( [ singleton ] ).
style_check_(singleton) :-
'$style_checker'( [ singleton ] ).
style_check_(+single_var) :-
'$style_checker'( [ singleton ] ).
style_check_(+singleton) :-
'$style_checker'( [ singleton ] ).
style_check_(-single_var) :-
'$style_checker'( [ -singleton ] ).
style_check_(-singleton) :-
'$style_checker'( [ -singleton ] ).
style_check_(discontiguous) :-
'$style_checker'( [ discontiguous ] ).
style_check_(+discontiguous) :-
'$style_checker'( [ discontiguous ] ).
style_check_(-discontiguous) :-
'$style_checker'( [ -discontiguous ] ).
style_check_(multiple) :-
'$style_checker'( [ multiple ] ).
style_check_(+multiple) :-
'$style_checker'( [ multiple ] ).
style_check_(-multiple) :-
'$style_checker'( [ -multiple ] ).
style_check_(no_effect) :-
'$style_checker'( [ no_effect ] ).
style_check_(+no_effect) :-
'$style_checker'( [ no_effect ] ).
style_check_(-no_effect) :-
'$style_checker'( [ -no_effect ] ).
style_check_(var_branches) :-
style_check(all) :-
style_check( [ singleton, discontiguous, multiple ] ).
style_check(+X) :-
style_check(X).
style_check(single_var) :-
style_check( singleton ).
style_check(singleton) :-
yap_flag( single_var_warnings, true ).
style_check(-single_var) :-
yap_flag( single_var_warnings, false ).
style_check(-singleton) :-
yap_flag( single_var_warnings, false ).
style_check(discontiguous) :-
yap_flag( discontiguous_warnings, true ).
style_check(-discontiguous) :-
yap_flag( discontiguous_warnings, false ).
style_check(multiple) :-
yap_flag( redefine_warnings, true ).
style_check(-multiple) :-
yap_flag( redefine_warnings, false ).
style_check(no_effect).
style_check(+no_effect) .
style_check(-no_effect).
style_check(var_branches).
style_check(+var_branches) :-
'$style_checker'( [ var_branches ] ).
style_check_(+var_branches) :-
'$style_checker'( [ var_branches ] ).
style_check_(-var_branches) :-
style_check(-var_branches) :-
'$style_checker'( [ -var_branches ] ).
style_check_(atom) :-
style_check(atom).
style_check(+atom) :-
'$style_checker'( [ atom ] ).
style_check_(+atom) :-
'$style_checker'( [ atom ] ).
style_check_(-atom) :-
style_check(-atom) :-
'$style_checker'( [ -atom ] ).
style_check_(charset) :-
style_check(charset) :-
'$style_checker'( [ charset ] ).
style_check_(+charset) :-
style_check(+charset) :-
'$style_checker'( [ charset ] ).
style_check_(-charset) :-
style_check(-charset) :-
'$style_checker'( [ -charset ] ).
style_check_('?'(Info) ) :-
style_check('?'(Info) ) :-
L = [ singleton, discontiguous, multiple ],
( lists:member(Style, L ) -> Info = +Style ; Info = -Style ).
style_check_([]).
style_check_([H|T]) :- style_check(H), style_check(T).
style_check([]).
style_check([H|T]) :- style_check(H), style_check(T).
/** @pred no_style_check(+ _X_)

66
pl/messages.yap
View File

@ -882,24 +882,6 @@ confusing to YAP (who will process the error?). So we write this small
stub to ensure everything os ok
*/
prolog:print_message(Level, _Msg) :-
current_prolog_flag(verbose_load, silent),
stream_property(_Stream, alias(loop_stream) ),
Level \= error,
Level \= warning,
!.
prolog:print_message(Level, _Msg) :-
current_prolog_flag(verbose, silent),
Level \= error,
Level \= warning,
!.
prolog:print_message(_, _Msg) :-
% first step at hook processi --ng
'$nb_getval'('$if_skip_mode',skip,fail),
!.
prolog:print_message(banner, _Msg) :-
current_prolog_flag(verbose, silent),
!.
prolog:print_message(Severity, Msg) :-
(
var(Severity)
@ -916,6 +898,20 @@ prolog:print_message(Severity, Msg) :-
user:portray_message(Severity, Msg)
),
!.
prolog:print_message(Level, _Msg) :-
current_prolog_flag(verbose_load, silent),
stream_property(_Stream, alias(loop_stream) ),
Level = informational,
!.
prolog:print_message(Level, _Msg) :-
current_prolog_flag(verbose, silent),
Level \= error,
Level \= warning,
!.
prolog:print_message(_, _Msg) :-
% first step at hook processi --ng
'$nb_getval'('$if_skip_mode',skip,fail),
!.
prolog:print_message(force(_Severity), Msg) :- !,
print(user_error,Msg).
% This predicate has more hooks than a pirate ship!
@ -935,6 +931,40 @@ prolog:print_message(Severity, _Term) :-
format('No handler for ~a message ~q,~n',[Severity, _Term]).
% cases where we cannot afford to ever fail.
'$undefp'([ImportingMod|G], _) :-
recorded('$import','$import'(ExportingModI,ImportingMod,G,G0I,_,_),_), !,
% writeln('$execute'(G0I, ExportingModI)),
'$execute0'(G0I, ExportingModI).
% undef handler
'$undefp'([M0|G0], Action) :-
% make sure we do not loop on undefined predicates
'$stop_creeping'(Current),
yap_flag( unknown, Action, fail),
Action\=fail,
% yap_flag( debug, Debug, false),
(
'$undefp_search'(M0:G0, NM:NG),
( M0 \== NM -> true ; G0 \== NG ),
NG \= fail
->
yap_flag( unknown, _, Action),
% yap_flag( debug, _, Debug),
(
Current == true
->
% carry on signal processing
'$start_creep'([NM|NG], creep)
;
'$execute0'(NG, NM)
)
;
yap_flag( unknown, _, Action),
'$handle_error'(Action,G0,M0)
).
:- '$undef_handler'('$undefp'(_,_), prolog).
/**
@}
*/