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

small fixes 

indenting
This commit is contained in:
Vítor Santos Costa 2016-03-30 17:35:03 +01:00
parent 78ba5d01f2
commit 145ad73255
18 changed files with 693 additions and 445566 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
.gitignore vendored
View File

@ -16,6 +16,7 @@ tags
TGSautom4te.cache TGSautom4te.cache
cscope.* cscope.*
GPATH GPATH
m32
GRTAGS GRTAGS
GTAGS GTAGS
tmtags* tmtags*
@ -149,5 +150,7 @@ yap-6.3.workspace
yap-6.3.geany yap-6.3.geany
YAP.project YAP.project
CBlocks CBlocks
yPQ
*.tmp *.tmp
YAP.sublime* YAP.sublime*
yap32/CMakeCache.txt

12
C/cdmgr.c
View File

@ -4447,18 +4447,18 @@ static bool pred_flag_clause(Functor f, Term mod, const char *name,
s[1] = MkIntegerTerm(val); s[1] = MkIntegerTerm(val);
#elif USE_GMP #elif USE_GMP
{ {
char s[64]; char text[64];
MP_INT rop; MP_INT rop;
#ifdef _WIN32 #ifdef _WIN32
snprintf(s, 64, "%I64d", (long long int)val); snprintf(text, 64, "%I64d", (long long int)val);
#elif HAVE_SNPRINTF #elif HAVE_SNPRINTF
snprintf(s, 64, "%lld", (long long int)val); snprintf(text, 64, "%lld", (long long int)val);
#else #else
sprintf(s, "%lld", (long long int)val); sprintf(text, "%lld", (long long int)val);
#endif #endif
mpz_init_set_str(&rop, s, 10); mpz_init_set_str(&rop, text, 10);
s[1] = Yap_MkBigNumTerm((void *)&rop); s[1] = Yap_MkBigIntTerm((void *)&rop);
} }
#endif #endif
tn = Yap_MkApplTerm(f, 2, s); tn = Yap_MkApplTerm(f, 2, s);

57
C/exec.c
View File

@ -978,7 +978,6 @@ static Int setup_call_cleanup(USES_REGS1) {
yamop *oCP = CP, *oP = P; yamop *oCP = CP, *oP = P;
bool rc; bool rc;
Yap_DisableInterrupts(worker_id); Yap_DisableInterrupts(worker_id);
rc = Yap_RunTopGoal(Setup, false); rc = Yap_RunTopGoal(Setup, false);
Yap_EnableInterrupts(worker_id); Yap_EnableInterrupts(worker_id);
@ -1451,7 +1450,7 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
if (!Yap_has_a_signal()) if (!Yap_has_a_signal())
CalculateStackGap(PASS_REGS1); CalculateStackGap(PASS_REGS1);
LOCAL_CBorder = OldBorder; LOCAL_CBorder = OldBorder;
return out; return out;
} }
void Yap_PrepGoal(UInt arity, CELL *pt, choiceptr saved_b USES_REGS) { void Yap_PrepGoal(UInt arity, CELL *pt, choiceptr saved_b USES_REGS) {
@ -1982,53 +1981,53 @@ bool is_cleanup_cp(choiceptr cp_b) {
static Int JumpToEnv() { static Int JumpToEnv() {
choiceptr handler = B, oh = NULL; choiceptr handler = B, oh = NULL;
/* just keep the thrown object away, we don't need to care about it /* just keep the throwm object away, we don't need to care about it
*/ */
/* careful, previous step may have caused a stack shift, /* careful, previous step may have caused a stack shift,
so get pointers here */ so get pointers here */
/* find the first choicepoint that may be a catch */ /* find the first choicepoint that may be a catch */
//DBTerm *dbt = Yap_RefToException(); // DBTerm *dbt = Yap_RefToException();
while (handler && while (handler && Yap_PredForChoicePt(handler, NULL) != PredDollarCatch) {
Yap_PredForChoicePt(handler, NULL) != PredDollarCatch) { while (POP_CHOICE_POINT(handler)) {
while (POP_CHOICE_POINT(handler)) {
POP_FAIL_EXECUTE(handler); POP_FAIL_EXECUTE(handler);
} }
/* we are already doing a catch */ /* we are already doing a catch */
/* make sure we prune C-choicepoints */ /* make sure we prune C-choicepoints */
if (handler->cp_ap == NOCODE && handler >= (choiceptr)(LCL0 - LOCAL_CBorder)) { if (handler->cp_ap == NOCODE &&
break; handler >= (choiceptr)(LCL0 - LOCAL_CBorder)) {
} break;
oh = handler; }
handler = handler->cp_b; oh = handler;
handler = handler->cp_b;
} }
if (LOCAL_PrologMode & AsyncIntMode) { if (LOCAL_PrologMode & AsyncIntMode) {
Yap_signal(YAP_FAIL_SIGNAL); Yap_signal(YAP_FAIL_SIGNAL);
} }
POP_FAIL(handler); POP_FAIL(handler);
B = handler; B = handler;
//Yap_CopyException(ref); // Yap_CopyException(ref);
if (Yap_PredForChoicePt(B, NULL) == PredDollarCatch) { if (Yap_PredForChoicePt(B, NULL) == PredDollarCatch) {
/* can recover Heap thanks to copy term :-( */ /* can recover Heap thanks to copy term :-( */
/* B->cp_h = H; */ /* B->cp_h = H; */
/* I could backtrack here, but it is easier to leave the unwinding /* I could backtrack here, but it is easier to leave the unwinding
to the emulator */ to the emulator */
// handler->cp_h = HR; // handler->cp_h = HR;
/* try to recover space */ /* try to recover space */
/* can only do that when we recover space */ /* can only do that when we recover space */
/* first, backtrack */ /* first, backtrack */
/* so that I recover memory execute op_fail */ /* so that I recover memory execute op_fail */
// now put the ball in place // now put the ball in place
//Yap_CopyException(dbt); // Yap_CopyException(dbt);
Term t = Yap_GetException(); Term t = Yap_GetException();
if (t == 0) { if (t == 0) {
return false; return false;
} }
t = Yap_MkApplTerm(FunctorThrow, 1, &t); t = Yap_MkApplTerm(FunctorThrow, 1, &t);
B->cp_h = HR; B->cp_h = HR;
HB = HR; HB = HR;
Yap_unify(t, B->cp_a2); Yap_unify(t, B->cp_a2);
B->cp_tr = TR; B->cp_tr = TR;
} }
P = FAILCODE; P = FAILCODE;
return true; return true;
} }
@ -2048,7 +2047,7 @@ static Int jump_env(USES_REGS1) {
Term t = Deref(ARG1); Term t = Deref(ARG1);
Yap_PutException(t); Yap_PutException(t);
bool out = JumpToEnv(PASS_REGS1); bool out = JumpToEnv(PASS_REGS1);
if (P == FAILCODE && B->cp_ap == NOCODE && LCL0-(CELL*)B > LOCAL_CBorder) { if (P == FAILCODE && B->cp_ap == NOCODE && LCL0 - (CELL *)B > LOCAL_CBorder) {
// we're failing up to the top layer // we're failing up to the top layer
LOCAL_Error_TYPE = THROW_EVENT; LOCAL_Error_TYPE = THROW_EVENT;
} }

9
CMakeLists.txt
View File

@ -16,12 +16,11 @@ include(disallow)
disallow_intree_builds() disallow_intree_builds()
# set(CMAKE_BUILD_TYPE Debug) # set(CMAKE_BUILD_TYPE Debug)
set (MACOSX_RPATH ON) set (MACOSX_RPATH ON)
if(POLICY CMP0042) if(POLICY CMP0042)
cmake_policy(SET CMP0042 NEW)
endif(POLICY CMP0042) endif(POLICY CMP0042)
if(POLICY CMP0043) if(POLICY CMP0043)
cmake_policy(SET CMP0043 NEW) cmake_policy(SET CMP0043 NEW)
@ -118,8 +117,8 @@ add_library(libYap
${WINDLLS} ${WINDLLS}
$<TARGET_OBJECTS:libYAPOs> $<TARGET_OBJECTS:libYAPOs>
$<TARGET_OBJECTS:libOPTYap> $<TARGET_OBJECTS:libOPTYap>
$<TARGET_OBJECTS:myddas> $<TARGET_OBJECTS:myddas>
$<TARGET_OBJECTS:libswi> $<TARGET_OBJECTS:libswi>
) )
set_property(DIRECTORY PROPERTY CXX_STANDARD 11) set_property(DIRECTORY PROPERTY CXX_STANDARD 11)
@ -523,7 +522,7 @@ target_link_libraries(libYap
if(WIN32) if(WIN32)
if(MSVC) if(MSVC)
set(MSVC_RUNTIME "dynamic") set(MSVC_RUNTIME "dynamic")
ENDIF(MSVC) ENDIF(MSVC)
target_link_libraries(libYap wsock32 ws2_32 Shlwapi) target_link_libraries(libYap wsock32 ws2_32 Shlwapi)
endif() endif()

348
H/YapTags.h
View File

@ -24,109 +24,111 @@
#include "inline-only.h" #include "inline-only.h"
#ifndef SHORT_ADDRESSES #ifndef SHORT_ADDRESSES
# define LONG_ADDRESSES 1 #define LONG_ADDRESSES 1
#else #else
# define LONG_ADDRESSES 0 #define LONG_ADDRESSES 0
#endif #endif
/***********************************************************************/ /***********************************************************************/
/* /*
absrectype Term = Int + Float + Atom + Pair + Appl + Ref + Var absrectype Term = Int + Float + Atom + Pair + Appl + Ref + Var
with AbsAppl(t) : *CELL -> Term with AbsAppl(t) : *CELL -> Term
and RepAppl(t) : Term -> *CELL and RepAppl(t) : Term -> *CELL
and AbsPair(t) : *CELL -> Term and AbsPair(t) : *CELL -> Term
and RepPair(t) : Term -> *CELL and RepPair(t) : Term -> *CELL
and IsIntTerm(t) = ... and IsIntTerm(t) = ...
and IsAtomTerm(t) = ... and IsAtomTerm(t) = ...
and IsVarTerm(t) = ... and IsVarTerm(t) = ...
and IsPairTerm(t) = ... and IsPairTerm(t) = ...
and IsApplTerm(t) = ... and IsApplTerm(t) = ...
and IsFloatTerm(t) = ... and IsFloatTerm(t) = ...
and IsRefTerm(t) = ... and IsRefTerm(t) = ...
and IsNonVarTerm(t) = ! IsVar(t) and IsNonVarTerm(t) = ! IsVar(t)
and IsNumterm(t) = IsIntTerm(t) || IsFloatTerm(t) and IsNumterm(t) = IsIntTerm(t) || IsFloatTerm(t)
and IsAtomicTerm(t) = IsNumTerm(t) || IsAtomTerm(t) and IsAtomicTerm(t) = IsNumTerm(t) || IsAtomTerm(t)
and IsPrimitiveTerm(t) = IsAtomicTerm(t) || IsRefTerm(t) and IsPrimitiveTerm(t) = IsAtomicTerm(t) || IsRefTerm(t)
and MkIntTerm(n) = ... and MkIntTerm(n) = ...
and MkFloatTerm(f) = ... and MkFloatTerm(f) = ...
and MkAtomTerm(a) = ... and MkAtomTerm(a) = ...
and MkVarTerm(r) = ... and MkVarTerm(r) = ...
and MkApplTerm(f,n,args) = ... and MkApplTerm(f,n,args) = ...
and MkPairTerm(hd,tl) = ... and MkPairTerm(hd,tl) = ...
and MkRefTerm(R) = ... and MkRefTerm(R) = ...
and PtrOfTerm(t) : Term -> CELL * = ... and PtrOfTerm(t) : Term -> CELL * = ...
and IntOfTerm(t) : Term -> int = ... and IntOfTerm(t) : Term -> int = ...
and FloatOfTerm(t) : Term -> flt = ... and FloatOfTerm(t) : Term -> flt = ...
and AtomOfTerm(t) : Term -> Atom = ... and AtomOfTerm(t) : Term -> Atom = ...
and VarOfTerm(t) : Term -> *Term = .... and VarOfTerm(t) : Term -> *Term = ....
and HeadOfTerm(t) : Term -> Term = ... and HeadOfTerm(t) : Term -> Term = ...
and TailOfTerm(t) : Term -> Term = ... and TailOfTerm(t) : Term -> Term = ...
and FunctorOfTerm(t) : Term -> Functor = ... and FunctorOfTerm(t) : Term -> Functor = ...
and ArgOfTerm(i,t) : Term -> Term= ... and ArgOfTerm(i,t) : Term -> Term= ...
and RefOfTerm(t) : Term -> DBRef = ... and RefOfTerm(t) : Term -> DBRef = ...
*/ */
/* /*
YAP can use several different tag schemes, according to the kind of YAP can use several different tag schemes, according to the kind of
machine we are experimenting with. machine we are experimenting with.
*/ */
#if LONG_ADDRESSES && defined(OLD_TAG_SCHEME) #if LONG_ADDRESSES && defined(OLD_TAG_SCHEME)
#include "Tags_32bits.h" #include "Tags_32bits.h"
#endif /* LONG_ADDRESSES && defined(OLD_TAG_SCHEME) */ #endif /* LONG_ADDRESSES && defined(OLD_TAG_SCHEME) */
/* AIX will by default place mmaped segments at 0x30000000. This is /* AIX will by default place mmaped segments at 0x30000000. This is
incompatible with the high tag scheme. Linux-ELF also does not like incompatible with the high tag scheme. Linux-ELF also does not like
if you place things in the lower addresses (power to the libc people). if you place things in the lower addresses (power to the libc people).
*/ */
#if defined(__APPLE__) #if defined(__APPLE__)
/* mmap on __APPLE__ is not the greatest idea. It overwrites memory allocated by malloc */ /* mmap on __APPLE__ is not the greatest idea. It overwrites memory allocated by
* malloc */
#undef USE_DL_MALLOC #undef USE_DL_MALLOC
#ifndef USE_SYSTEM_MALLOC #ifndef USE_SYSTEM_MALLOC
#define USE_SYSTEM_MALLOC 1 #define USE_SYSTEM_MALLOC 1
#endif #endif
#endif #endif
#if (defined(_AIX) || (defined(__APPLE__) && SIZEOF_INT_P==4) || defined(_WIN32) || defined(sparc) || defined(__sparc) || defined(mips) || defined(__FreeBSD__) || defined(_POWER) || defined(__POWERPC__) || defined(__linux__) || defined(IN_SECOND_QUADRANT) || defined(__CYGWIN__)) || defined(__NetBSD__) || defined(__DragonFly__) #if SIZEOF_INT_P == 4
#define USE_LOW32_TAGS 1 #define USE_LOW32_TAGS 1
#endif #endif
#if LONG_ADDRESSES && SIZEOF_INT_P==4 && !defined(OLD_TAG_SCHEME) && !defined(USE_LOW32_TAGS) #if SIZEOF_INT_P == 4 && !defined(OLD_TAG_SCHEME) && !defined(USE_LOW32_TAGS)
#include "Tags_32Ops.h" #include "Tags_32Ops.h"
#elif LONG_ADDRESSES && SIZEOF_INT_P==4 && !defined(OLD_TAG_SCHEME) && defined(USE_LOW32_TAGS) #elif LONG_ADDRESSES && SIZEOF_INT_P == 4 && !defined(OLD_TAG_SCHEME) && \
defined(USE_LOW32_TAGS)
#include "Tags_32LowTag.h" #include "Tags_32LowTag.h"
#elif LONG_ADDRESSES && SIZEOF_INT_P==8 && !defined(OLD_TAG_SCHEME) #elif SIZEOF_INT_P == 8 && !defined(OLD_TAG_SCHEME)
#include "Tags_64bits.h" #include "Tags_64bits.h"
#elif !LONG_ADDRESSES // #elif !LONG_ADDRESSES
//
// #include "Tags_24bits.h"
#include "Tags_24bits.h" #endif
#endif
#ifdef TAG_LOW_BITS_32 #ifdef TAG_LOW_BITS_32
#if !GC_NO_TAGS #if !GC_NO_TAGS
#define MBIT 0x80000000 #define MBIT 0x80000000
#define RBIT 0x40000000 #define RBIT 0x40000000
#if IN_SECOND_QUADRANT #if IN_SECOND_QUADRANT
#define INVERT_RBIT 1 /* RBIT is 1 by default */ #define INVERT_RBIT 1 /* RBIT is 1 by default */
#endif #endif
#endif /* !GC_NO_TAGS */ #endif /* !GC_NO_TAGS */
@ -134,10 +136,10 @@
#if !GC_NO_TAGS #if !GC_NO_TAGS
#if defined(YAPOR_SBA) && defined(__linux__) #if defined(YAPOR_SBA) && defined(__linux__)
#define MBIT /* 0x20000000 */ MKTAG(0x1,0) /* mark bit */ #define MBIT /* 0x20000000 */ MKTAG(0x1, 0) /* mark bit */
#else #else
#define RBIT /* 0x20000000 */ MKTAG(0x1,0) /* relocation chain bit */ #define RBIT /* 0x20000000 */ MKTAG(0x1, 0) /* relocation chain bit */
#define MBIT /* 0x40000000 */ MKTAG(0x2,0) /* mark bit */ #define MBIT /* 0x40000000 */ MKTAG(0x2, 0) /* mark bit */
#endif #endif
#endif /* !GC_NO_TAGS */ #endif /* !GC_NO_TAGS */
@ -147,211 +149,143 @@
??? ???
*************************************************************************************************/ *************************************************************************************************/
#define MkVarTerm() MkVarTerm__( PASS_REGS1 ) #define MkVarTerm() MkVarTerm__(PASS_REGS1)
#define MkPairTerm(A,B) MkPairTerm__( A, B PASS_REGS ) #define MkPairTerm(A, B) MkPairTerm__(A, B PASS_REGS)
/************************************************************************************************* /*************************************************************************************************
applies to unbound variables applies to unbound variables
*************************************************************************************************/ *************************************************************************************************/
INLINE_ONLY inline EXTERN Term *VarOfTerm (Term t); INLINE_ONLY inline EXTERN Term *VarOfTerm(Term t);
INLINE_ONLY inline EXTERN Term *
VarOfTerm (Term t)
{
return (Term *) (t);
}
INLINE_ONLY inline EXTERN Term *VarOfTerm(Term t) { return (Term *)(t); }
#ifdef YAPOR_SBA #ifdef YAPOR_SBA
#define RESET_VARIABLE(V) (*(CELL *)(V) = 0) #define RESET_VARIABLE(V) (*(CELL *)(V) = 0)
INLINE_ONLY inline EXTERN Term MkVarTerm__ ( USES_REGS1 ); INLINE_ONLY inline EXTERN Term MkVarTerm__(USES_REGS1);
INLINE_ONLY inline EXTERN Term INLINE_ONLY inline EXTERN Term MkVarTerm__(USES_REGS1) {
MkVarTerm__ ( USES_REGS1 ) return (Term)((*HR = 0, HR++));
{
return (Term) ((*HR = 0, HR++));
} }
INLINE_ONLY inline EXTERN int IsUnboundVar(Term *);
INLINE_ONLY inline EXTERN int IsUnboundVar(Term *t) { return (int)(*(t) == 0); }
INLINE_ONLY inline EXTERN int IsUnboundVar (Term *);
INLINE_ONLY inline EXTERN int
IsUnboundVar (Term * t)
{
return (int) (*(t) == 0);
}
#else #else
#define RESET_VARIABLE(V) (*(CELL *)(V) = Unsigned(V)) #define RESET_VARIABLE(V) (*(CELL *)(V) = Unsigned(V))
INLINE_ONLY inline EXTERN Term MkVarTerm__ ( USES_REGS1 ); INLINE_ONLY inline EXTERN Term MkVarTerm__(USES_REGS1);
INLINE_ONLY inline EXTERN Term INLINE_ONLY inline EXTERN Term MkVarTerm__(USES_REGS1) {
MkVarTerm__ ( USES_REGS1 ) return (Term)((*HR = (CELL)HR, HR++));
{
return (Term) ((*HR = (CELL) HR, HR++));
} }
INLINE_ONLY inline EXTERN int IsUnboundVar(Term *);
INLINE_ONLY inline EXTERN int IsUnboundVar (Term *); INLINE_ONLY inline EXTERN int IsUnboundVar(Term *t) {
return (int)(*(t) == (Term)(t));
INLINE_ONLY inline EXTERN int
IsUnboundVar (Term * t)
{
return (int) (*(t) == (Term) (t));
} }
#endif #endif
INLINE_ONLY inline EXTERN CELL *PtrOfTerm (Term); INLINE_ONLY inline EXTERN CELL *PtrOfTerm(Term);
INLINE_ONLY inline EXTERN CELL * INLINE_ONLY inline EXTERN CELL *PtrOfTerm(Term t) {
PtrOfTerm (Term t) return (CELL *)(*(CELL *)(t));
{
return (CELL *) (*(CELL *) (t));
} }
INLINE_ONLY inline EXTERN Functor FunctorOfTerm(Term);
INLINE_ONLY inline EXTERN Functor FunctorOfTerm(Term t) {
return (Functor)(*RepAppl(t));
INLINE_ONLY inline EXTERN Functor FunctorOfTerm (Term);
INLINE_ONLY inline EXTERN Functor
FunctorOfTerm (Term t)
{
return (Functor) (*RepAppl (t));
} }
#if USE_LOW32_TAGS #if USE_LOW32_TAGS
INLINE_ONLY inline EXTERN Term MkAtomTerm (Atom); INLINE_ONLY inline EXTERN Term MkAtomTerm(Atom);
INLINE_ONLY inline EXTERN Term INLINE_ONLY inline EXTERN Term MkAtomTerm(Atom a) {
MkAtomTerm (Atom a) return (Term)(AtomTag | (CELL)(a));
{
return (Term) (AtomTag | (CELL) (a));
} }
INLINE_ONLY inline EXTERN Atom AtomOfTerm(Term t);
INLINE_ONLY inline EXTERN Atom AtomOfTerm(Term t) {
INLINE_ONLY inline EXTERN Atom AtomOfTerm (Term t); return (Atom)((~AtomTag & (CELL)(t)));
INLINE_ONLY inline EXTERN Atom
AtomOfTerm (Term t)
{
return (Atom) ((~AtomTag & (CELL) (t)));
} }
#else #else
INLINE_ONLY inline EXTERN Term MkAtomTerm (Atom); INLINE_ONLY inline EXTERN Term MkAtomTerm(Atom);
INLINE_ONLY inline EXTERN Term INLINE_ONLY inline EXTERN Term MkAtomTerm(Atom at) {
MkAtomTerm (Atom at) return (Term)(TAGGEDA((CELL)AtomTag, (CELL)(at)));
{
return (Term) (TAGGEDA ((CELL)AtomTag, (CELL) (at)));
} }
INLINE_ONLY inline EXTERN Atom AtomOfTerm(Term t);
INLINE_ONLY inline EXTERN Atom AtomOfTerm(Term t) {
INLINE_ONLY inline EXTERN Atom AtomOfTerm (Term t); return (Atom)(NonTagPart(t));
INLINE_ONLY inline EXTERN Atom
AtomOfTerm (Term t)
{
return (Atom) (NonTagPart (t));
} }
#endif #endif
INLINE_ONLY inline EXTERN int IsAtomTerm (Term); INLINE_ONLY inline EXTERN int IsAtomTerm(Term);
INLINE_ONLY inline EXTERN int INLINE_ONLY inline EXTERN int IsAtomTerm(Term t) {
IsAtomTerm (Term t) return (int)(CHKTAG((t), AtomTag));
{
return (int) (CHKTAG ((t), AtomTag));
} }
INLINE_ONLY inline EXTERN Term MkIntTerm(Int);
INLINE_ONLY inline EXTERN Term MkIntTerm(Int n) {
return (Term)(TAGGED(NumberTag, (n)));
INLINE_ONLY inline EXTERN Term MkIntTerm (Int);
INLINE_ONLY inline EXTERN Term
MkIntTerm (Int n)
{
return (Term) (TAGGED (NumberTag, (n)));
} }
/* /*
A constant to subtract or add to a well-known term, we assume no A constant to subtract or add to a well-known term, we assume no
overflow problems are possible overflow problems are possible
*/ */
INLINE_ONLY inline EXTERN Term MkIntConstant (Int); INLINE_ONLY inline EXTERN Term MkIntConstant(Int);
INLINE_ONLY inline EXTERN Term INLINE_ONLY inline EXTERN Term MkIntConstant(Int n) {
MkIntConstant (Int n) return (Term)(NONTAGGED(NumberTag, (n)));
{
return (Term) (NONTAGGED (NumberTag, (n)));
} }
INLINE_ONLY inline EXTERN int IsIntTerm(Term);
INLINE_ONLY inline EXTERN int IsIntTerm(Term t) {
INLINE_ONLY inline EXTERN int IsIntTerm (Term); return (int)(CHKTAG((t), NumberTag));
INLINE_ONLY inline EXTERN int
IsIntTerm (Term t)
{
return (int) (CHKTAG ((t), NumberTag));
} }
INLINE_ONLY EXTERN inline Term MkPairTerm__(Term head, Term tail USES_REGS);
INLINE_ONLY EXTERN inline Term MkPairTerm__(Term head, Term tail USES_REGS ); INLINE_ONLY EXTERN inline Term MkPairTerm__(Term head, Term tail USES_REGS) {
INLINE_ONLY EXTERN inline Term
MkPairTerm__ (Term head, Term tail USES_REGS)
{
CELL *p = HR; CELL *p = HR;
HR[0] = head; HR[0] = head;
HR[1] = tail; HR[1] = tail;
HR += 2; HR += 2;
return (AbsPair (p)); return (AbsPair(p));
} }
/* Needed to handle numbers: /* Needed to handle numbers:
these two macros are fundamental in the integer/float conversions */ these two macros are fundamental in the integer/float conversions */
#ifdef M_WILLIAMS #ifdef M_WILLIAMS
#define IntInBnd(X) (TRUE) #define IntInBnd(X) (TRUE)
#else #else
#ifdef TAGS_FAST_OPS #ifdef TAGS_FAST_OPS
#define IntInBnd(X) (Unsigned( ( (Int)(X) >> (32-7) ) + 1) <= 1) #define IntInBnd(X) (Unsigned(((Int)(X) >> (32 - 7)) + 1) <= 1)
#else #else
#define IntInBnd(X) ( (X) < MAX_ABS_INT && \ #define IntInBnd(X) ((X) < MAX_ABS_INT && (X) > -MAX_ABS_INT - 1L)
(X) > -MAX_ABS_INT-1L )
#endif #endif
#endif #endif
#ifdef C_PROLOG
#define FlIsInt(X) ( (X) == (Int)(X) && IntInBnd((X)) )
#else
#define FlIsInt(X) ( FALSE )
#endif
/* /*
There are two types of functors: There are two types of functors:
@ -363,70 +297,56 @@ MkPairTerm__ (Term head, Term tail USES_REGS)
*/ */
#include "TermExt.h" #include "TermExt.h"
#define IsAccessFunc(func) ((func) == FunctorAccess) #define IsAccessFunc(func) ((func) == FunctorAccess)
#ifdef YAP_H #ifdef YAP_H
#define MkIntegerTerm(i) __MkIntegerTerm(i PASS_REGS) #define MkIntegerTerm(i) __MkIntegerTerm(i PASS_REGS)
INLINE_ONLY inline EXTERN Term __MkIntegerTerm (Int USES_REGS); INLINE_ONLY inline EXTERN Term __MkIntegerTerm(Int USES_REGS);
INLINE_ONLY inline EXTERN Term INLINE_ONLY inline EXTERN Term __MkIntegerTerm(Int n USES_REGS) {
__MkIntegerTerm (Int n USES_REGS) return (Term)(IntInBnd(n) ? MkIntTerm(n) : MkLongIntTerm(n));
{
return (Term) (IntInBnd (n) ? MkIntTerm (n) : MkLongIntTerm (n));
} }
#endif #endif
INLINE_ONLY inline EXTERN int IsIntegerTerm(Term);
INLINE_ONLY inline EXTERN int IsIntegerTerm (Term); INLINE_ONLY inline EXTERN int IsIntegerTerm(Term t) {
return (int)(IsIntTerm(t) || IsLongIntTerm(t));
INLINE_ONLY inline EXTERN int
IsIntegerTerm (Term t)
{
return (int) (IsIntTerm (t) || IsLongIntTerm (t));
} }
INLINE_ONLY inline EXTERN Int IntegerOfTerm (Term); INLINE_ONLY inline EXTERN Int IntegerOfTerm(Term);
INLINE_ONLY inline EXTERN Int INLINE_ONLY inline EXTERN Int IntegerOfTerm(Term t) {
IntegerOfTerm (Term t)
{
return (Int) (IsIntTerm (t) ? IntOfTerm (t) : LongIntOfTerm (t)); return (Int)(IsIntTerm(t) ? IntOfTerm(t) : LongIntOfTerm(t));
} }
#ifdef YAP_H #ifdef YAP_H
#define MkAddressTerm(i) __MkAddressTerm(i PASS_REGS) #define MkAddressTerm(i) __MkAddressTerm(i PASS_REGS)
INLINE_ONLY inline EXTERN Term __MkAddressTerm (void * USES_REGS); INLINE_ONLY inline EXTERN Term __MkAddressTerm(void *USES_REGS);
INLINE_ONLY inline EXTERN Term INLINE_ONLY inline EXTERN Term __MkAddressTerm(void *n USES_REGS) {
__MkAddressTerm (void * n USES_REGS)
{
return __MkIntegerTerm((Int)n PASS_REGS); return __MkIntegerTerm((Int)n PASS_REGS);
} }
#endif #endif
INLINE_ONLY inline EXTERN bool IsAddressTerm (Term); INLINE_ONLY inline EXTERN bool IsAddressTerm(Term);
INLINE_ONLY inline EXTERN bool INLINE_ONLY inline EXTERN bool IsAddressTerm(Term t) {
IsAddressTerm (Term t) return (bool)IsIntegerTerm(t);
{
return (bool) IsIntegerTerm (t);
} }
INLINE_ONLY inline EXTERN void * AddressOfTerm (Term); INLINE_ONLY inline EXTERN void *AddressOfTerm(Term);
INLINE_ONLY inline EXTERN void * INLINE_ONLY inline EXTERN void *AddressOfTerm(Term t) {
AddressOfTerm (Term t) return (void *)(IsIntTerm(t) ? IntOfTerm(t) : LongIntOfTerm(t));
{
return (void *) (IsIntTerm (t) ? IntOfTerm (t) : LongIntOfTerm (t));
} }
#endif #endif

328
H/arith2.h
View File

@ -8,9 +8,9 @@
* * * *
************************************************************************** **************************************************************************
* * * *
* File: arithi2.c * * File: arithi2.c *
* Last rev: * * Last rev: *
* mods: * * mods: *
* comments: arithmetical expression evaluation * * comments: arithmetical expression evaluation *
* * * *
*************************************************************************/ *************************************************************************/
@ -19,115 +19,110 @@
* *
*/ */
inline static int inline static int sub_overflow(Int x, Int i, Int j) {
sub_overflow(Int x, Int i, Int j)
{
return ((i & ~j & ~x) | (~i & j & x)) < 0; return ((i & ~j & ~x) | (~i & j & x)) < 0;
} }
inline static Term inline static Term sub_int(Int i, Int j USES_REGS) {
sub_int(Int i, Int j USES_REGS) Int x = i - j;
{
Int x = i-j;
#if USE_GMP #if USE_GMP
Int overflow = ((i & ~j & ~x) | (~i & j & x)) < 0; Int overflow = ((i & ~j & ~x) | (~i & j & x)) < 0;
/* Integer overflow, we need to use big integers */ /* Integer overflow, we need to use big integers */
if (overflow) { if (overflow) {
return(Yap_gmp_sub_ints(i, j)); return (Yap_gmp_sub_ints(i, j));
} }
#endif #endif
#ifdef BEAM #ifdef BEAM
RINT(x); RINT(x);
return( MkIntegerTerm (x)); return (MkIntegerTerm(x));
#else #else
RINT(x); RINT(x);
#endif #endif
} }
inline static Int inline static Int SLR(Int i, Int shift) {
SLR(Int i, Int shift) return (shift < sizeof(Int) * 8 - 1 ? i >> shift : (i >= 0 ? 0 : -1));
{
return (shift < sizeof(Int)*8-1 ? i >> shift : (i >= 0 ? 0 : -1));
} }
#ifdef __GNUC__ inline static int mul_overflow(Int z, Int i1, Int i2) {
#ifdef __i386__
#define DO_MULTI() { Int tmp1; \
__asm__ ("imull %3\n\t movl $0,%1\n\t jno 0f\n\t movl $1,%1\n\t 0:" \
: "=a" (z), \
"=d" (tmp1) \
: "a" (i1), \
"rm" (i2) \
: "cc" ); \
if (tmp1) goto overflow; \
}
#define OPTIMIZE_MULTIPLI 1
#endif
#endif
inline static int
mul_overflow(Int z, Int i1, Int i2)
{
if (i1 == Int_MIN && i2 == -1) if (i1 == Int_MIN && i2 == -1)
return TRUE; return TRUE;
return (i2 && z/i2 != i1); return (i2 && z / i2 != i1);
} }
#if defined(_MSC_VER) && SIZEOF_DOUBLE == SIZEOF_INT_P #
#define DO_MULTI() { \ #if defined(__GNUC__) && defined(__i386__)
uint64_t h1 = (11 > 0 ? i1 : -i1) >> 32;\ #define DO_MULTI() \
uint64_t h2 = (12 > 0 ? i2 : -12) >> 32;\ { \
if (h1 != 0 && h2 != 0) goto overflow;\ Int tmp1; \
if ((uint64_t)(i1 & 0xfffffff)*h2 + ((uint64_t)(i2 & 0xfffffff)*h1) > 0x7fffffff) goto overflow;\ __asm__("imull %3\n\t movl $0,%1\n\t jno 0f\n\t movl $1,%1\n\t 0:" \
z = i1 * i2;\ : "=a"(z), "=d"(tmp1) \
} : "a"(i1), "rm"(i2) \
#elif __clang__ && FALSE /* not in OSX yet */ : "cc"); \
#define DO_MULTI() if (__builtin_smul_overflow( i1, i2, & z ) ) { goto overflow; } if (tmp1) \
#elif SIZEOF_DOUBLE == 2*SIZEOF_INT_P goto overflow; \
#define DO_MULTI() {\ }
int64_t w = (int64_t)i1*i2; \ #define OPTIMIZE_MULTIPLI 1
if (w >= 0) {\ #elif defined(_MSC_VER) && SIZEOF_DOUBLE == SIZEOF_INT_P
if ((w | ((int64_t)(2^31)-1)) != ((int64_t)(2^31)-1)) goto overflow; \ #define DO_MULTI() \
} else {\ { \
if ((-w | ((int64_t)(2^31)-1)) != ((int64_t)(2^31)-1)) goto overflow; \ uint64_t h1 = (11 > 0 ? i1 : -i1) >> 32; \
}\ uint64_t h2 = (12 > 0 ? i2 : -12) >> 32; \
z = w;\ if (h1 != 0 && h2 != 0) \
} goto overflow; \
if ((uint64_t)(i1 & 0xfffffff) * h2 + ((uint64_t)(i2 & 0xfffffff) * h1) > \
0x7fffffff) \
goto overflow; \
z = i1 * i2; \
}
#elif __clang__ && FALSE /* not in OSX yet */
#define DO_MULTI() \
if (__builtin_smul_overflow(i1, i2, &z)) { \
goto overflow; \
}
#elif SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
#define DO_MULTI() \
{ \
int64_t w = (int64_t)i1 * i2; \
if (w >= 0) { \
if ((w | ((int64_t)(2 ^ 31) - 1)) != ((int64_t)(2 ^ 31) - 1)) \
goto overflow; \
} else { \
if ((-w | ((int64_t)(2 ^ 31) - 1)) != ((int64_t)(2 ^ 31) - 1)) \
goto overflow; \
} \
z = w; \
}
#else #else
#define DO_MULTI() {\ #define DO_MULTI() \
__int128_t w = (__int128_t)i1*i2; \ { \
if (w >= 0) {\ __int128_t w = (__int128_t)i1 * i2; \
if ((w | ((__int128_t)(2^63)-1)) != ((__int128_t)(2^63)-1)) goto overflow; \ if (w >= 0) { \
} else {\ if ((w | ((__int128_t)(2 ^ 63) - 1)) != ((__int128_t)(2 ^ 63) - 1)) \
if ((-w | ((__int128_t)(2^63)-1)) != ((__int128_t)(2^63)-1)) goto overflow; \ goto overflow; \
}\ } else { \
z = (Int)w; \ if ((-w | ((__int128_t)(2 ^ 63) - 1)) != ((__int128_t)(2 ^ 63) - 1)) \
} goto overflow; \
} \
z = (Int)w; \
}
#endif #endif
inline static Term inline static Term times_int(Int i1, Int i2 USES_REGS) {
times_int(Int i1, Int i2 USES_REGS) {
#ifdef USE_GMP #ifdef USE_GMP
Int z; Int z;
DO_MULTI(); DO_MULTI();
RINT(z); RINT(z);
overflow: overflow : { return (Yap_gmp_mul_ints(i1, i2)); }
{
return(Yap_gmp_mul_ints(i1, i2));
}
#else #else
RINT(i1*i2); RINT(i1 * i2);
#endif #endif
} }
#ifdef USE_GMP #ifdef USE_GMP
#ifndef __GNUC__X #ifndef __GNUC__X
static int static int clrsb(Int i) {
clrsb(Int i) Int j = 0;
{
Int j=0;
if (i < 0) { if (i < 0) {
if (i == Int_MIN) if (i == Int_MIN)
@ -135,25 +130,35 @@ clrsb(Int i)
i = -i; i = -i;
} }
#if SIZEOF_INT_P == 8 #if SIZEOF_INT_P == 8
if (i < (Int)(0x100000000)) { j += 32;} if (i < (Int)(0x100000000)) {
else i >>= 32; j += 32;
} else
i >>= 32;
#endif #endif
if (i < (Int)(0x10000)) {j += 16;} if (i < (Int)(0x10000)) {
else i >>= 16; j += 16;
if (i < (Int)(0x100)) {j += 8;} } else
else i >>= 8; i >>= 16;
if (i < (Int)(0x10)) {j += 4;} if (i < (Int)(0x100)) {
else i >>= 4; j += 8;
if (i < (Int)(0x4)) {j += 2;} } else
else i >>= 2; i >>= 8;
if (i < (Int)(0x2)) j++; if (i < (Int)(0x10)) {
j += 4;
} else
i >>= 4;
if (i < (Int)(0x4)) {
j += 2;
} else
i >>= 2;
if (i < (Int)(0x2))
j++;
return j; return j;
} }
#endif #endif
#endif #endif
inline static Term inline static Term do_sll(Int i, Int j USES_REGS) /* j > 0 */
do_sll(Int i, Int j USES_REGS) /* j > 0 */
{ {
#ifdef USE_GMP #ifdef USE_GMP
if ( if (
@ -174,22 +179,19 @@ do_sll(Int i, Int j USES_REGS) /* j > 0 */
#endif #endif
} }
static Term p_minus(Term t1, Term t2 USES_REGS) {
static Term
p_minus(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) { switch (ETypeOfTerm(t1)) {
case long_int_e: case long_int_e:
switch (ETypeOfTerm(t2)) { switch (ETypeOfTerm(t2)) {
case long_int_e: case long_int_e:
/* two integers */ /* two integers */
return sub_int(IntegerOfTerm(t1), IntegerOfTerm(t2) PASS_REGS); return sub_int(IntegerOfTerm(t1), IntegerOfTerm(t2) PASS_REGS);
case double_e: case double_e: {
{ /* integer, double */
/* integer, double */ Float fl1 = (Float)IntegerOfTerm(t1);
Float fl1 = (Float)IntegerOfTerm(t1); Float fl2 = FloatOfTerm(t2);
Float fl2 = FloatOfTerm(t2); RFLOAT(fl1 - fl2);
RFLOAT(fl1-fl2); }
}
case big_int_e: case big_int_e:
#ifdef USE_GMP #ifdef USE_GMP
return Yap_gmp_sub_int_big(IntegerOfTerm(t1), t2); return Yap_gmp_sub_int_big(IntegerOfTerm(t1), t2);
@ -202,14 +204,13 @@ p_minus(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t2)) { switch (ETypeOfTerm(t2)) {
case long_int_e: case long_int_e:
/* float * integer */ /* float * integer */
RFLOAT(FloatOfTerm(t1)-IntegerOfTerm(t2)); RFLOAT(FloatOfTerm(t1) - IntegerOfTerm(t2));
case double_e: case double_e: {
{ RFLOAT(FloatOfTerm(t1) - FloatOfTerm(t2));
RFLOAT(FloatOfTerm(t1)-FloatOfTerm(t2)); }
}
case big_int_e: case big_int_e:
#ifdef USE_GMP #ifdef USE_GMP
return Yap_gmp_sub_float_big(FloatOfTerm(t1),t2); return Yap_gmp_sub_float_big(FloatOfTerm(t1), t2);
#endif #endif
default: default:
RERROR(); RERROR();
@ -223,7 +224,7 @@ p_minus(Term t1, Term t2 USES_REGS) {
case big_int_e: case big_int_e:
return Yap_gmp_sub_big_big(t1, t2); return Yap_gmp_sub_big_big(t1, t2);
case double_e: case double_e:
return Yap_gmp_sub_big_float(t1,FloatOfTerm(t2)); return Yap_gmp_sub_big_float(t1, FloatOfTerm(t2));
default: default:
RERROR(); RERROR();
} }
@ -234,25 +235,22 @@ p_minus(Term t1, Term t2 USES_REGS) {
RERROR(); RERROR();
} }
static Term p_times(Term t1, Term t2 USES_REGS) {
static Term
p_times(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) { switch (ETypeOfTerm(t1)) {
case long_int_e: case long_int_e:
switch (ETypeOfTerm(t2)) { switch (ETypeOfTerm(t2)) {
case long_int_e: case long_int_e:
/* two integers */ /* two integers */
return(times_int(IntegerOfTerm(t1),IntegerOfTerm(t2) PASS_REGS)); return (times_int(IntegerOfTerm(t1), IntegerOfTerm(t2) PASS_REGS));
case double_e: case double_e: {
{ /* integer, double */
/* integer, double */ Float fl1 = (Float)IntegerOfTerm(t1);
Float fl1 = (Float)IntegerOfTerm(t1); Float fl2 = FloatOfTerm(t2);
Float fl2 = FloatOfTerm(t2); RFLOAT(fl1 * fl2);
RFLOAT(fl1*fl2); }
}
case big_int_e: case big_int_e:
#ifdef USE_GMP #ifdef USE_GMP
return(Yap_gmp_mul_int_big(IntegerOfTerm(t1), t2)); return (Yap_gmp_mul_int_big(IntegerOfTerm(t1), t2));
#endif #endif
default: default:
RERROR(); RERROR();
@ -262,12 +260,12 @@ p_times(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t2)) { switch (ETypeOfTerm(t2)) {
case long_int_e: case long_int_e:
/* float * integer */ /* float * integer */
RFLOAT(FloatOfTerm(t1)*IntegerOfTerm(t2)); RFLOAT(FloatOfTerm(t1) * IntegerOfTerm(t2));
case double_e: case double_e:
RFLOAT(FloatOfTerm(t1)*FloatOfTerm(t2)); RFLOAT(FloatOfTerm(t1) * FloatOfTerm(t2));
case big_int_e: case big_int_e:
#ifdef USE_GMP #ifdef USE_GMP
return Yap_gmp_mul_float_big(FloatOfTerm(t1),t2); return Yap_gmp_mul_float_big(FloatOfTerm(t1), t2);
#endif #endif
default: default:
RERROR(); RERROR();
@ -282,7 +280,7 @@ p_times(Term t1, Term t2 USES_REGS) {
/* two bignums */ /* two bignums */
return Yap_gmp_mul_big_big(t1, t2); return Yap_gmp_mul_big_big(t1, t2);
case double_e: case double_e:
return Yap_gmp_mul_float_big(FloatOfTerm(t2),t1); return Yap_gmp_mul_float_big(FloatOfTerm(t2), t1);
default: default:
RERROR(); RERROR();
} }
@ -293,28 +291,27 @@ p_times(Term t1, Term t2 USES_REGS) {
RERROR(); RERROR();
} }
static Term static Term p_div(Term t1, Term t2 USES_REGS) {
p_div(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) { switch (ETypeOfTerm(t1)) {
case long_int_e: case long_int_e:
switch (ETypeOfTerm(t2)) { switch (ETypeOfTerm(t2)) {
case long_int_e: case long_int_e:
/* two integers */ /* two integers */
{ {
Int i1 = IntegerOfTerm(t1), i2 = IntegerOfTerm(t2); Int i1 = IntegerOfTerm(t1), i2 = IntegerOfTerm(t2);
if (i2 == 0) { if (i2 == 0) {
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "// /2"); return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "// /2");
} else if (i1 == Int_MIN && i2 == -1) { } else if (i1 == Int_MIN && i2 == -1) {
#ifdef USE_GMP #ifdef USE_GMP
return Yap_gmp_add_ints(Int_MAX, 1); return Yap_gmp_add_ints(Int_MAX, 1);
#else #else
return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, t1, return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, t1,
"rem/2 with %d and %d", i1, i2); "rem/2 with %d and %d", i1, i2);
#endif #endif
} else { } else {
RINT(IntegerOfTerm(t1) / i2); RINT(IntegerOfTerm(t1) / i2);
} }
} }
case double_e: case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "// /2"); return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "// /2");
@ -350,8 +347,7 @@ p_div(Term t1, Term t2 USES_REGS) {
RERROR(); RERROR();
} }
static Term static Term p_and(Term t1, Term t2 USES_REGS) {
p_and(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) { switch (ETypeOfTerm(t1)) {
case long_int_e: case long_int_e:
switch (ETypeOfTerm(t2)) { switch (ETypeOfTerm(t2)) {
@ -362,7 +358,7 @@ p_and(Term t1, Term t2 USES_REGS) {
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "/\\ /2"); return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "/\\ /2");
case big_int_e: case big_int_e:
#ifdef USE_GMP #ifdef USE_GMP
return Yap_gmp_and_int_big(IntegerOfTerm(t1),t2); return Yap_gmp_and_int_big(IntegerOfTerm(t1), t2);
#endif #endif
default: default:
RERROR(); RERROR();
@ -375,7 +371,7 @@ p_and(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t2)) { switch (ETypeOfTerm(t2)) {
case long_int_e: case long_int_e:
/* anding a bignum with an integer is easy */ /* anding a bignum with an integer is easy */
return Yap_gmp_and_int_big(IntegerOfTerm(t2),t1); return Yap_gmp_and_int_big(IntegerOfTerm(t2), t1);
case big_int_e: case big_int_e:
/* two bignums */ /* two bignums */
return Yap_gmp_and_big_big(t1, t2); return Yap_gmp_and_big_big(t1, t2);
@ -391,9 +387,8 @@ p_and(Term t1, Term t2 USES_REGS) {
RERROR(); RERROR();
} }
static Term static Term p_or(Term t1, Term t2 USES_REGS) {
p_or(Term t1, Term t2 USES_REGS) { switch (ETypeOfTerm(t1)) {
switch(ETypeOfTerm(t1)) {
case long_int_e: case long_int_e:
switch (ETypeOfTerm(t2)) { switch (ETypeOfTerm(t2)) {
case long_int_e: case long_int_e:
@ -403,7 +398,7 @@ p_or(Term t1, Term t2 USES_REGS) {
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "\\/ /2"); return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "\\/ /2");
case big_int_e: case big_int_e:
#ifdef USE_GMP #ifdef USE_GMP
return Yap_gmp_ior_int_big(IntegerOfTerm(t1),t2); return Yap_gmp_ior_int_big(IntegerOfTerm(t1), t2);
#endif #endif
default: default:
RERROR(); RERROR();
@ -416,7 +411,7 @@ p_or(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t2)) { switch (ETypeOfTerm(t2)) {
case long_int_e: case long_int_e:
/* anding a bignum with an integer is easy */ /* anding a bignum with an integer is easy */
return Yap_gmp_ior_int_big(IntegerOfTerm(t2),t1); return Yap_gmp_ior_int_big(IntegerOfTerm(t2), t1);
case big_int_e: case big_int_e:
/* two bignums */ /* two bignums */
return Yap_gmp_ior_big_big(t1, t2); return Yap_gmp_ior_big_big(t1, t2);
@ -432,22 +427,22 @@ p_or(Term t1, Term t2 USES_REGS) {
RERROR(); RERROR();
} }
static Term static Term p_sll(Term t1, Term t2 USES_REGS) {
p_sll(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) { switch (ETypeOfTerm(t1)) {
case long_int_e: case long_int_e:
switch (ETypeOfTerm(t2)) { switch (ETypeOfTerm(t2)) {
case long_int_e: case long_int_e:
/* two integers */ /* two integers */
{ Int i2 = IntegerOfTerm(t2); {
Int i2 = IntegerOfTerm(t2);
if (i2 <= 0) { if (i2 <= 0) {
if (i2 == Int_MIN) { if (i2 == Int_MIN) {
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2"); return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
} }
RINT(SLR(IntegerOfTerm(t1), -i2)); RINT(SLR(IntegerOfTerm(t1), -i2));
} }
return do_sll(IntegerOfTerm(t1),i2 PASS_REGS); return do_sll(IntegerOfTerm(t1), i2 PASS_REGS);
} }
case double_e: case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "<</2"); return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "<</2");
@ -465,7 +460,7 @@ p_sll(Term t1, Term t2 USES_REGS) {
#ifdef USE_GMP #ifdef USE_GMP
switch (ETypeOfTerm(t2)) { switch (ETypeOfTerm(t2)) {
case long_int_e: case long_int_e:
return Yap_gmp_sll_big_int(t1, IntegerOfTerm(t2)); return Yap_gmp_sll_big_int(t1, IntegerOfTerm(t2));
case big_int_e: case big_int_e:
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2"); return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
case double_e: case double_e:
@ -480,22 +475,22 @@ p_sll(Term t1, Term t2 USES_REGS) {
RERROR(); RERROR();
} }
static Term static Term p_slr(Term t1, Term t2 USES_REGS) {
p_slr(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) { switch (ETypeOfTerm(t1)) {
case long_int_e: case long_int_e:
switch (ETypeOfTerm(t2)) { switch (ETypeOfTerm(t2)) {
case long_int_e: case long_int_e:
/* two integers */ /* two integers */
{ Int i2 = IntegerOfTerm(t2); {
Int i2 = IntegerOfTerm(t2);
if (i2 < 0) { if (i2 < 0) {
if (i2 == Int_MIN) { if (i2 == Int_MIN) {
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2"); return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
} }
return do_sll(IntegerOfTerm(t1), -i2 PASS_REGS); return do_sll(IntegerOfTerm(t1), -i2 PASS_REGS);
} }
RINT(SLR(IntegerOfTerm(t1), i2)); RINT(SLR(IntegerOfTerm(t1), i2));
} }
case double_e: case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, ">>/2"); return Yap_ArithError(TYPE_ERROR_INTEGER, t2, ">>/2");
@ -513,7 +508,7 @@ p_slr(Term t1, Term t2 USES_REGS) {
#ifdef USE_GMP #ifdef USE_GMP
switch (ETypeOfTerm(t2)) { switch (ETypeOfTerm(t2)) {
case long_int_e: case long_int_e:
return Yap_gmp_sll_big_int(t1, -IntegerOfTerm(t2)); return Yap_gmp_sll_big_int(t1, -IntegerOfTerm(t2));
case big_int_e: case big_int_e:
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2"); return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
case double_e: case double_e:
@ -527,4 +522,3 @@ p_slr(Term t1, Term t2 USES_REGS) {
} }
RERROR(); RERROR();
} }

421
H/eval.h
View File

@ -19,7 +19,7 @@
@file eval.h @file eval.h
@defgroup arithmetic Arithmetic in YAP @defgroup arithmetic Arithmetic in YAP
@ingroup builtins @ingroup builtins
@ -27,7 +27,8 @@
+ See @ref arithmetic_cmps for the arithmetic comparisons supported in YAP + See @ref arithmetic_cmps for the arithmetic comparisons supported in YAP
+ See @ref arithmetic_operators for what arithmetic operations are supported in YAP + See @ref arithmetic_operators for what arithmetic operations are supported
in YAP
YAP supports several different numeric types: YAP supports several different numeric types:
<ul> <ul>
@ -88,11 +89,14 @@ exceptions:
@exception "type_error(float( V ), Call)" if must be float @exception "type_error(float( V ), Call)" if must be float
@exception "domain_error(out_of_range( V ), Call)" if argument invalid @exception "domain_error(out_of_range( V ), Call)" if argument invalid
@exception "domain_error(not_less_than_zero( V ), Call)" if argument must be positive or zero @exception "domain_error(not_less_than_zero( V ), Call)" if argument must be
positive or zero
@exception "evaluation_error(undefined( V ), Call)" result is not defined
(nan)
@exception "evaluation_error(overflow( V ), Call)" result is arithmetic
overflow
@exception "evaluation_error(undefined( V ), Call)" result is not defined (nan)
@exception "evaluation_error(overflow( V ), Call)" result is arithmetic overflow
@tableofcontents @tableofcontents
@secreflist @secreflist
@ -132,64 +136,68 @@ exceptions:
#include <string.h> #include <string.h>
#endif #endif
#ifdef LONG_MAX #ifdef LONG_MAX
#define Int_MAX LONG_MAX #define Int_MAX LONG_MAX
#else #else
#define Int_MAX ((Int)((~((CELL)0))>>1)) #define Int_MAX ((Int)((~((CELL)0)) >> 1))
#endif #endif
#ifdef LONG_MIN #ifdef LONG_MIN
#define Int_MIN LONG_MIN #define Int_MIN LONG_MIN
#else #else
#define Int_MIN (-Int_MAX-(CELL)1) #define Int_MIN (-Int_MAX - (CELL)1)
#endif #endif
#define PLMAXTAGGEDINT (MAX_ABS_INT-((CELL)1)) #define PLMAXTAGGEDINT (MAX_ABS_INT - ((CELL)1))
#define PLMINTAGGEDINT (-MAX_ABS_INT) #define PLMINTAGGEDINT (-MAX_ABS_INT)
#define PLMAXINT Int_MAX #define PLMAXINT Int_MAX
#define PLMININT Int_MIN #define PLMININT Int_MIN
#ifndef INFINITY #ifndef INFINITY
#define INFINITY (1.0/0.0) #define INFINITY (1.0 / 0.0)
#endif #endif
#ifndef NAN #ifndef NAN
#define NAN (0.0/0.0) #define NAN (0.0 / 0.0)
#endif #endif
/** /**
* @addtogroup arithmetic_operators * @addtogroup arithmetic_operators
* @enum arith0_op constant operators * @enum arith0_op constant operators
* @brief specifies the available unary arithmetic operators * @brief specifies the available unary arithmetic operators
*/ */
typedef enum { typedef enum {
/** pi [ISO] /** pi [ISO]
An approximation to the value of <em>pi</em>, that is, the ratio of a circle's circumference to its diameter. An approximation to the value of <em>pi</em>, that is, the ratio of a
* circle's circumference to its diameter.
*
*/ */
op_pi, op_pi,
/** e /** e
Euler's number, the base of the natural logarithms (approximately 2.718281828). Euler's number, the base of the natural logarithms (approximately
* 2.718281828).
*
*/ */
op_e, op_e,
/** epsilon /** epsilon
The difference between the float `1.0` and the next largest floating point number. The difference between the float `1.0` and the next largest floating point
* number.
*
*/ */
op_epsilon, op_epsilon,
/** inf /** inf
Infinity according to the IEEE Floating-Point standard. Note that evaluating this term will generate a domain error in the `iso` language mode. Also note that Infinity according to the IEEE Floating-Point standard. Note that
evaluating this term will generate a domain error in the `iso` language mode.
Also note that
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.prolog} * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.prolog}
* ?- +inf =:= -inf. * ?- +inf =:= -inf.
* false. * false.
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
* *
*/ */
op_inf, op_inf,
op_nan, op_nan,
@ -206,35 +214,36 @@ typedef enum {
/** /**
* @addtogroup arithmetic_operators * @addtogroup arithmetic_operators
* @enum arith1_op unary operators * @enum arith1_op unary operators
* @brief specifies the available unary arithmetic operators * @brief specifies the available unary arithmetic operators
*/ */
typedef enum { typedef enum {
/** \+ _X_: the value of _X_ . /** \+ _X_: the value of _X_ .
* *
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.prolog} * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.prolog}
* X =:= +X. * X =:= +X.
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
*/ */
op_uplus, op_uplus,
/** \- _X_: the complement of _X_ . /** \- _X_: the complement of _X_ .
* *
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.prolog} * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.prolog}
* 0-X =:= -X. * 0-X =:= -X.
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
*/ */
op_uminus, op_uminus,
/** \\ _X_, The bitwise negation of _X_ . /** \\ _X_, The bitwise negation of _X_ .
* *
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.prolog} * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.prolog}
* \X /\ X =:= 0. * \X /\ X =:= 0.
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
* *
* Note that the number of bits of an integer is at least the size in bits of a Prolog term cell. * Note that the number of bits of an integer is at least the size in bits of
* a Prolog term cell.
*/ */
op_unot, op_unot,
/** exp( _X_ ), natural exponentiation of _X_ . /** exp( _X_ ), natural exponentiation of _X_ .
* *
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.prolog} * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.prolog}
* X = 0.0, abs(1.0 - exp( _X_ )) < 0.0001 * X = 0.0, abs(1.0 - exp( _X_ )) < 0.0001
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@ -250,11 +259,12 @@ typedef enum {
*/ */
op_log, op_log,
/** log10( _X_ ) [ISO] /** log10( _X_ ) [ISO]
* *
* Decimal logarithm. * Decimal logarithm.
* *
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.prolog} * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.prolog}
* ?- between(1, 10, I), Delta is log10(I*10) + log10(1/(I*10)), format('0 == ~3g~n',[Delta]), fail. * ?- between(1, 10, I), Delta is log10(I*10) + log10(1/(I*10)), format('0
* == ~3g~n',[Delta]), fail.
* 0 == 0 * 0 == 0
* 0 == 0 * 0 == 0
* 0 == 0 * 0 == 0
@ -305,7 +315,7 @@ typedef enum {
/** /**
* @addtogroup arithmetic_operators * @addtogroup arithmetic_operators
* @enum arith2_op binary operators * @enum arith2_op binary operators
* @brief specifies the available unary arithmetic operators * @brief specifies the available unary arithmetic operators
*/ */
typedef enum { typedef enum {
@ -336,62 +346,69 @@ typedef enum {
op_rdiv op_rdiv
} arith2_op; } arith2_op;
yap_error_number yap_error_number Yap_MathException__(USES_REGS1);
Yap_MathException__(USES_REGS1); Functor EvalArg(Term);
Functor EvalArg(Term);
/* Needed to handle numbers: /* Needed to handle numbers:
these two macros are fundamental in the integer/float conversions */ these two macros are fundamental in the integer/float conversions */
#ifdef C_PROLOG #ifdef C_PROLOG
#define FlIsInt(X) ( (X) == (Int)(X) && IntInBnd((X)) ) #define FlIsInt(X) ((X) == (Int)(X) && IntInBnd((X)))
#else #else
#define FlIsInt(X) ( FALSE ) #define FlIsInt(X) (FALSE)
#endif #endif
#ifdef M_WILLIAMS #ifdef M_WILLIAMS
#define MkEvalFl(X) MkFloatTerm(X) #define MkEvalFl(X) MkFloatTerm(X)
#else #else
#define MkEvalFl(X) ( FlIsInt(X) ? MkIntTerm((Int)(X)) : MkFloatTerm(X) ) #define MkEvalFl(X) (FlIsInt(X) ? MkIntTerm((Int)(X)) : MkFloatTerm(X))
#endif #endif
/* Macros used by some of the eval functions */ /* Macros used by some of the eval functions */
#define REvalInt(I) { eval_int = (I); return(FInt); } #define REvalInt(I) \
#define REvalFl(F) { eval_flt = (F); return(FFloat); } { \
#define REvalError() { return(FError); } eval_int = (I); \
return (FInt); \
}
#define REvalFl(F) \
{ \
eval_flt = (F); \
return (FFloat); \
}
#define REvalError() \
{ return (FError); }
/* this macro, dependent on the particular implementation /* this macro, dependent on the particular implementation
is used to interface the arguments into the C libraries */ is used to interface the arguments into the C libraries */
#ifdef MPW #ifdef MPW
#define FL(X) ((extended)(X)) #define FL(X) ((extended)(X))
#else #else
#define FL(X) ((double)(X)) #define FL(X) ((double)(X))
#endif #endif
void Yap_InitConstExps(void); void Yap_InitConstExps(void);
void Yap_InitUnaryExps(void); void Yap_InitUnaryExps(void);
void Yap_InitBinaryExps(void); void Yap_InitBinaryExps(void);
int Yap_ReInitConstExps(void); int Yap_ReInitConstExps(void);
int Yap_ReInitUnaryExps(void); int Yap_ReInitUnaryExps(void);
int Yap_ReInitBinaryExps(void); int Yap_ReInitBinaryExps(void);
Term Yap_eval_atom(Int); Term Yap_eval_atom(Int);
Term Yap_eval_unary(Int,Term); Term Yap_eval_unary(Int, Term);
Term Yap_eval_binary(Int,Term,Term); Term Yap_eval_binary(Int, Term, Term);
Term Yap_InnerEval__(Term USES_REGS); Term Yap_InnerEval__(Term USES_REGS);
#define Yap_EvalError(id, t, ...) \
Yap_EvalError__(__FILE__, __FUNCTION__, __LINE__, id, t, __VA_ARGS__)
yamop *Yap_EvalError__(const char *, const char *, int, yap_error_number, Term,
...);
#define Yap_ArithError(id, t, ...) \
#define Yap_EvalError( id, t, ...) Yap_EvalError__(__FILE__, __FUNCTION__, __LINE__, id, t, __VA_ARGS__) Yap_ArithError__(__FILE__, __FUNCTION__, __LINE__, id, t, __VA_ARGS__)
yamop *Yap_EvalError__(const char *, const char *, int, yap_error_number,Term, ...); Int Yap_ArithError__(const char *, const char *, int, yap_error_number, Term,
...);
#define Yap_ArithError( id, t, ...) Yap_ArithError__(__FILE__, __FUNCTION__, __LINE__, id, t, __VA_ARGS__)
Int Yap_ArithError__(const char *, const char *, int, yap_error_number,Term, ...);
#include "inline-only.h" #include "inline-only.h"
@ -403,55 +420,49 @@ Int Yap_ArithError__(const char *, const char *, int, yap_error_number,Term, ...
INLINE_ONLY inline EXTERN Term Yap_Eval__(Term t USES_REGS); INLINE_ONLY inline EXTERN Term Yap_Eval__(Term t USES_REGS);
INLINE_ONLY inline EXTERN Term INLINE_ONLY inline EXTERN Term Yap_Eval__(Term t USES_REGS) {
Yap_Eval__(Term t USES_REGS) if (t == 0L || (!IsVarTerm(t) && IsNumTerm(t)))
{
if (t == 0L || ( !IsVarTerm(t) && IsNumTerm(t) ))
return t; return t;
return Yap_InnerEval(t); return Yap_InnerEval(t);
} }
inline static void inline static void Yap_ClearExs(void) { feclearexcept(FE_ALL_EXCEPT); }
Yap_ClearExs(void)
{
feclearexcept(FE_ALL_EXCEPT);
}
inline static yap_error_number inline static yap_error_number Yap_FoundArithError__(USES_REGS1) {
Yap_FoundArithError__(USES_REGS1)
{
if (LOCAL_Error_TYPE != YAP_NO_ERROR) if (LOCAL_Error_TYPE != YAP_NO_ERROR)
return LOCAL_Error_TYPE; return LOCAL_Error_TYPE;
if (trueGlobalPrologFlag( ARITHMETIC_EXCEPTIONS_FLAG ) ) // test support for exception if (trueGlobalPrologFlag(
ARITHMETIC_EXCEPTIONS_FLAG)) // test support for exception
return Yap_MathException(); return Yap_MathException();
return YAP_NO_ERROR; return YAP_NO_ERROR;
} }
static inline Term takeIndicator(Term t) { static inline Term takeIndicator(Term t) {
Term ts[2]; Term ts[2];
if (IsAtomTerm(t)) { ts[0] = t; ts[1] = MkIntTerm(0); } if (IsAtomTerm(t)) {
else if (IsPairTerm(t)) { ts[0] = TermNil; ts[1] = MkIntTerm(2); } ts[0] = t;
else { ts[1] = MkIntTerm(0);
} else if (IsPairTerm(t)) {
ts[0] = TermNil;
ts[1] = MkIntTerm(2);
} else {
CACHE_REGS CACHE_REGS
ts[0] = MkAtomTerm(NameOfFunctor(FunctorOfTerm(t))); ts[0] = MkAtomTerm(NameOfFunctor(FunctorOfTerm(t)));
ts[1] = MkIntegerTerm(ArityOfFunctor(FunctorOfTerm(t))); ts[1] = MkIntegerTerm(ArityOfFunctor(FunctorOfTerm(t)));
} }
return Yap_MkApplTerm( FunctorSlash, 2, ts ); return Yap_MkApplTerm(FunctorSlash, 2, ts);
} }
Atom Yap_NameOfUnaryOp(int i); Atom Yap_NameOfUnaryOp(int i);
Atom Yap_NameOfBinaryOp(int i); Atom Yap_NameOfBinaryOp(int i);
#define RINT(v) return (MkIntegerTerm(v))
#define RFLOAT(v) return (MkFloatTerm(v))
#define RBIG(v) return (Yap_MkBigIntTerm(v))
#define RERROR() return (0L)
#define RINT(v) return(MkIntegerTerm(v)) static inline blob_type ETypeOfTerm(Term t) {
#define RFLOAT(v) return(MkFloatTerm(v)) if (IsIntTerm(t))
#define RBIG(v) return(Yap_MkBigIntTerm(v))
#define RERROR() return(0L)
static inline blob_type
ETypeOfTerm(Term t)
{
if (IsIntTerm(t))
return long_int_e; return long_int_e;
if (IsApplTerm(t)) { if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
@ -469,106 +480,105 @@ ETypeOfTerm(Term t)
#if USE_GMP #if USE_GMP
char *Yap_mpz_to_string(MP_INT *b, char *s, size_t sz, int base); char *Yap_mpz_to_string(MP_INT *b, char *s, size_t sz, int base);
Term Yap_gmq_rdiv_int_int(Int, Int); Term Yap_gmq_rdiv_int_int(Int, Int);
Term Yap_gmq_rdiv_int_big(Int, Term); Term Yap_gmq_rdiv_int_big(Int, Term);
Term Yap_gmq_rdiv_big_int(Term, Int); Term Yap_gmq_rdiv_big_int(Term, Int);
Term Yap_gmq_rdiv_big_big(Term, Term); Term Yap_gmq_rdiv_big_big(Term, Term);
Term Yap_gmp_add_ints(Int, Int); Term Yap_gmp_add_ints(Int, Int);
Term Yap_gmp_sub_ints(Int, Int); Term Yap_gmp_sub_ints(Int, Int);
Term Yap_gmp_mul_ints(Int, Int); Term Yap_gmp_mul_ints(Int, Int);
Term Yap_gmp_sll_ints(Int, Int); Term Yap_gmp_sll_ints(Int, Int);
Term Yap_gmp_add_int_big(Int, Term); Term Yap_gmp_add_int_big(Int, Term);
Term Yap_gmp_sub_int_big(Int, Term); Term Yap_gmp_sub_int_big(Int, Term);
Term Yap_gmp_sub_big_int(Term, Int); Term Yap_gmp_sub_big_int(Term, Int);
Term Yap_gmp_mul_int_big(Int, Term); Term Yap_gmp_mul_int_big(Int, Term);
Term Yap_gmp_div_int_big(Int, Term); Term Yap_gmp_div_int_big(Int, Term);
Term Yap_gmp_div_big_int(Term, Int); Term Yap_gmp_div_big_int(Term, Int);
Term Yap_gmp_div2_big_int(Term, Int); Term Yap_gmp_div2_big_int(Term, Int);
Term Yap_gmp_fdiv_int_big(Int, Term); Term Yap_gmp_fdiv_int_big(Int, Term);
Term Yap_gmp_fdiv_big_int(Term, Int); Term Yap_gmp_fdiv_big_int(Term, Int);
Term Yap_gmp_and_int_big(Int, Term); Term Yap_gmp_and_int_big(Int, Term);
Term Yap_gmp_ior_int_big(Int, Term); Term Yap_gmp_ior_int_big(Int, Term);
Term Yap_gmp_xor_int_big(Int, Term); Term Yap_gmp_xor_int_big(Int, Term);
Term Yap_gmp_sll_big_int(Term, Int); Term Yap_gmp_sll_big_int(Term, Int);
Term Yap_gmp_add_big_big(Term, Term); Term Yap_gmp_add_big_big(Term, Term);
Term Yap_gmp_sub_big_big(Term, Term); Term Yap_gmp_sub_big_big(Term, Term);
Term Yap_gmp_mul_big_big(Term, Term); Term Yap_gmp_mul_big_big(Term, Term);
Term Yap_gmp_div_big_big(Term, Term); Term Yap_gmp_div_big_big(Term, Term);
Term Yap_gmp_div2_big_big(Term, Term); Term Yap_gmp_div2_big_big(Term, Term);
Term Yap_gmp_fdiv_big_big(Term, Term); Term Yap_gmp_fdiv_big_big(Term, Term);
Term Yap_gmp_and_big_big(Term, Term); Term Yap_gmp_and_big_big(Term, Term);
Term Yap_gmp_ior_big_big(Term, Term); Term Yap_gmp_ior_big_big(Term, Term);
Term Yap_gmp_xor_big_big(Term, Term); Term Yap_gmp_xor_big_big(Term, Term);
Term Yap_gmp_mod_big_big(Term, Term); Term Yap_gmp_mod_big_big(Term, Term);
Term Yap_gmp_mod_big_int(Term, Int); Term Yap_gmp_mod_big_int(Term, Int);
Term Yap_gmp_mod_int_big(Int, Term); Term Yap_gmp_mod_int_big(Int, Term);
Term Yap_gmp_rem_big_big(Term, Term); Term Yap_gmp_rem_big_big(Term, Term);
Term Yap_gmp_rem_big_int(Term, Int); Term Yap_gmp_rem_big_int(Term, Int);
Term Yap_gmp_rem_int_big(Int, Term); Term Yap_gmp_rem_int_big(Int, Term);
Term Yap_gmp_exp_int_int(Int,Int); Term Yap_gmp_exp_int_int(Int, Int);
Term Yap_gmp_exp_int_big(Int,Term); Term Yap_gmp_exp_int_big(Int, Term);
Term Yap_gmp_exp_big_int(Term,Int); Term Yap_gmp_exp_big_int(Term, Int);
Term Yap_gmp_exp_big_big(Term,Term); Term Yap_gmp_exp_big_big(Term, Term);
Term Yap_gmp_gcd_int_big(Int,Term); Term Yap_gmp_gcd_int_big(Int, Term);
Term Yap_gmp_gcd_big_big(Term,Term); Term Yap_gmp_gcd_big_big(Term, Term);
Term Yap_gmp_big_from_64bits(YAP_LONG_LONG); Term Yap_gmp_big_from_64bits(YAP_LONG_LONG);
Term Yap_gmp_float_to_big(Float); Term Yap_gmp_float_to_big(Float);
Term Yap_gmp_float_to_rational(Float); Term Yap_gmp_float_to_rational(Float);
Term Yap_gmp_float_rationalize(Float); Term Yap_gmp_float_rationalize(Float);
Float Yap_gmp_to_float(Term); Float Yap_gmp_to_float(Term);
Term Yap_gmp_add_float_big(Float, Term); Term Yap_gmp_add_float_big(Float, Term);
Term Yap_gmp_sub_float_big(Float, Term); Term Yap_gmp_sub_float_big(Float, Term);
Term Yap_gmp_sub_big_float(Term, Float); Term Yap_gmp_sub_big_float(Term, Float);
Term Yap_gmp_mul_float_big(Float, Term); Term Yap_gmp_mul_float_big(Float, Term);
Term Yap_gmp_fdiv_float_big(Float, Term); Term Yap_gmp_fdiv_float_big(Float, Term);
Term Yap_gmp_fdiv_big_float(Term, Float); Term Yap_gmp_fdiv_big_float(Term, Float);
int Yap_gmp_cmp_big_int(Term, Int); int Yap_gmp_cmp_big_int(Term, Int);
#define Yap_gmp_cmp_int_big(I, T) (-Yap_gmp_cmp_big_int(T, I)) #define Yap_gmp_cmp_int_big(I, T) (-Yap_gmp_cmp_big_int(T, I))
int Yap_gmp_cmp_big_float(Term, Float); int Yap_gmp_cmp_big_float(Term, Float);
#define Yap_gmp_cmp_float_big(D, T) (-Yap_gmp_cmp_big_float(T, D)) #define Yap_gmp_cmp_float_big(D, T) (-Yap_gmp_cmp_big_float(T, D))
int Yap_gmp_cmp_big_big(Term, Term); int Yap_gmp_cmp_big_big(Term, Term);
int Yap_gmp_tcmp_big_int(Term, Int); int Yap_gmp_tcmp_big_int(Term, Int);
#define Yap_gmp_tcmp_int_big(I, T) (-Yap_gmp_tcmp_big_int(T, I)) #define Yap_gmp_tcmp_int_big(I, T) (-Yap_gmp_tcmp_big_int(T, I))
int Yap_gmp_tcmp_big_float(Term, Float); int Yap_gmp_tcmp_big_float(Term, Float);
#define Yap_gmp_tcmp_float_big(D, T) (-Yap_gmp_tcmp_big_float(T, D)) #define Yap_gmp_tcmp_float_big(D, T) (-Yap_gmp_tcmp_big_float(T, D))
int Yap_gmp_tcmp_big_big(Term, Term); int Yap_gmp_tcmp_big_big(Term, Term);
Term Yap_gmp_neg_int(Int); Term Yap_gmp_neg_int(Int);
Term Yap_gmp_abs_big(Term); Term Yap_gmp_abs_big(Term);
Term Yap_gmp_neg_big(Term); Term Yap_gmp_neg_big(Term);
Term Yap_gmp_unot_big(Term); Term Yap_gmp_unot_big(Term);
Term Yap_gmp_floor(Term); Term Yap_gmp_floor(Term);
Term Yap_gmp_ceiling(Term); Term Yap_gmp_ceiling(Term);
Term Yap_gmp_round(Term); Term Yap_gmp_round(Term);
Term Yap_gmp_trunc(Term); Term Yap_gmp_trunc(Term);
Term Yap_gmp_float_fractional_part(Term); Term Yap_gmp_float_fractional_part(Term);
Term Yap_gmp_float_integer_part(Term); Term Yap_gmp_float_integer_part(Term);
Term Yap_gmp_sign(Term); Term Yap_gmp_sign(Term);
Term Yap_gmp_lsb(Term); Term Yap_gmp_lsb(Term);
Term Yap_gmp_msb(Term); Term Yap_gmp_msb(Term);
Term Yap_gmp_popcount(Term); Term Yap_gmp_popcount(Term);
char * Yap_gmp_to_string(Term, char *, size_t, int); char *Yap_gmp_to_string(Term, char *, size_t, int);
size_t Yap_gmp_to_size(Term, int); size_t Yap_gmp_to_size(Term, int);
int Yap_term_to_existing_big(Term, MP_INT *); int Yap_term_to_existing_big(Term, MP_INT *);
int Yap_term_to_existing_rat(Term, MP_RAT *); int Yap_term_to_existing_rat(Term, MP_RAT *);
void Yap_gmp_set_bit(Int i, Term t); void Yap_gmp_set_bit(Int i, Term t);
#endif #endif
#define Yap_Mk64IntegerTerm(i) __Yap_Mk64IntegerTerm((i) PASS_REGS) #define Yap_Mk64IntegerTerm(i) __Yap_Mk64IntegerTerm((i)PASS_REGS)
INLINE_ONLY inline EXTERN Term __Yap_Mk64IntegerTerm(YAP_LONG_LONG USES_REGS); INLINE_ONLY inline EXTERN Term __Yap_Mk64IntegerTerm(YAP_LONG_LONG USES_REGS);
INLINE_ONLY inline EXTERN Term INLINE_ONLY inline EXTERN Term
__Yap_Mk64IntegerTerm(YAP_LONG_LONG i USES_REGS) __Yap_Mk64IntegerTerm(YAP_LONG_LONG i USES_REGS) {
{
if (i <= Int_MAX && i >= Int_MIN) { if (i <= Int_MAX && i >= Int_MIN) {
return MkIntegerTerm((Int)i); return MkIntegerTerm((Int)i);
} else { } else {
@ -580,52 +590,51 @@ __Yap_Mk64IntegerTerm(YAP_LONG_LONG i USES_REGS)
} }
} }
#if __clang__ && FALSE /* not in OSX yet */
#if __clang__ && FALSE /* not in OSX yet */ #define DO_ADD() \
#define DO_ADD() if (__builtin_sadd_overflow( i1, i2, & z ) ) { goto overflow; } if (__builtin_sadd_overflow(i1, i2, &z)) { \
goto overflow; \
}
#endif #endif
inline static Term inline static Term add_int(Int i, Int j USES_REGS) {
add_int(Int i, Int j USES_REGS)
{
#if USE_GMP #if USE_GMP
UInt w = (UInt)i+(UInt)j; UInt w = (UInt)i + (UInt)j;
if (i > 0) { if (i > 0) {
if (j > 0 && (Int)w < 0) goto overflow; if (j > 0 && (Int)w < 0)
goto overflow;
} else { } else {
if (j < 0 && (Int)w > 0) goto overflow; if (j < 0 && (Int)w > 0)
goto overflow;
} }
RINT( (Int)w); RINT((Int)w);
/* Integer overflow, we need to use big integers */ /* Integer overflow, we need to use big integers */
overflow: overflow:
return Yap_gmp_add_ints(i, j); return Yap_gmp_add_ints(i, j);
#else #else
RINT(i+j); RINT(i + j);
#endif #endif
} }
/* calculate the most significant bit for an integer */ /* calculate the most significant bit for an integer */
Int Int Yap_msb(Int inp USES_REGS);
Yap_msb(Int inp USES_REGS);
static inline Term static inline Term p_plus(Term t1, Term t2 USES_REGS) {
p_plus(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) { switch (ETypeOfTerm(t1)) {
case long_int_e: case long_int_e:
switch (ETypeOfTerm(t2)) { switch (ETypeOfTerm(t2)) {
case long_int_e: case long_int_e:
/* two integers */ /* two integers */
return add_int(IntegerOfTerm(t1),IntegerOfTerm(t2) PASS_REGS); return add_int(IntegerOfTerm(t1), IntegerOfTerm(t2) PASS_REGS);
case double_e: case double_e: {
{ /* integer, double */
/* integer, double */ Float fl1 = (Float)IntegerOfTerm(t1);
Float fl1 = (Float)IntegerOfTerm(t1); Float fl2 = FloatOfTerm(t2);
Float fl2 = FloatOfTerm(t2); RFLOAT(fl1 + fl2);
RFLOAT(fl1+fl2); }
}
case big_int_e: case big_int_e:
#ifdef USE_GMP #ifdef USE_GMP
return(Yap_gmp_add_int_big(IntegerOfTerm(t1), t2)); return (Yap_gmp_add_int_big(IntegerOfTerm(t1), t2));
#endif #endif
default: default:
RERROR(); RERROR();
@ -634,12 +643,12 @@ p_plus(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t2)) { switch (ETypeOfTerm(t2)) {
case long_int_e: case long_int_e:
/* float * integer */ /* float * integer */
RFLOAT(FloatOfTerm(t1)+IntegerOfTerm(t2)); RFLOAT(FloatOfTerm(t1) + IntegerOfTerm(t2));
case double_e: case double_e:
RFLOAT(FloatOfTerm(t1)+FloatOfTerm(t2)); RFLOAT(FloatOfTerm(t1) + FloatOfTerm(t2));
case big_int_e: case big_int_e:
#ifdef USE_GMP #ifdef USE_GMP
return Yap_gmp_add_float_big(FloatOfTerm(t1),t2); return Yap_gmp_add_float_big(FloatOfTerm(t1), t2);
#endif #endif
default: default:
RERROR(); RERROR();
@ -653,7 +662,7 @@ p_plus(Term t1, Term t2 USES_REGS) {
/* two bignums */ /* two bignums */
return Yap_gmp_add_big_big(t1, t2); return Yap_gmp_add_big_big(t1, t2);
case double_e: case double_e:
return Yap_gmp_add_float_big(FloatOfTerm(t2),t1); return Yap_gmp_add_float_big(FloatOfTerm(t2), t1);
default: default:
RERROR(); RERROR();
} }
@ -677,11 +686,11 @@ p_plus(Term t1, Term t2 USES_REGS) {
#endif #endif
#ifndef INFINITY #ifndef INFINITY
#define INFINITY (1.0/0.0) #define INFINITY (1.0 / 0.0)
#endif #endif
#ifndef NAN #ifndef NAN
#define NAN (0.0/0.0) #define NAN (0.0 / 0.0)
#endif #endif
/* copied from SWI-Prolog */ /* copied from SWI-Prolog */

444924
OPTYap/Terminal Saved Output
View File

File diff suppressed because one or more lines are too long

39
cmake/FindCUDD.cmake Normal file
View File

@ -0,0 +1,39 @@
# Try to find CUDD headers and libraries.
#
# Usage of this module as follows:
#
# find_package(CUDD)
#
# Variables used by this module, they can change the default behaviour and need
# to be set before calling find_package:
#
# CUDD_ROOT Set this variable to the root installation of
# libpapi if the module has problems finding the
# proper installation path.
#
# Variables defined by this module:
#
# CUDD_FOUND System has CUDD libraries and headers
# CUDD_LIBRARIES The CUDD library
# CUDD_INCLUDE_DIRS The location of CUDD headers
# Get hint from environment variable (if any)
if(NOT CUDD_ROOT AND DEFINED ENV{CUDD_ROOT})
set(CUDD_ROOT "$ENV{CUDD_ROOT}" CACHE PATH "CUDD base directory location (optional, used for nonstandard installation paths)")
mark_as_advanced(CUDD_ROOT)
endif()
# Search path for nonstandard locations
if(CUDD_ROOT)
set(CUDD_INCLUDE_PATH PATHS "${CUDD_ROOT}/include" NO_DEFAULT_PATH)
set(CUDD_LIBRARY_PATH PATHS "${CUDD_ROOT}/lib" NO_DEFAULT_PATH)
endif()
find_path(CUDD_INCLUDE_DIRS NAMES cudd.h cudd/cudd.h HINTS ${CUDD_INCLUDE_PATH})
find_library(CUDD_LIBRARIES NAMES cudd CUDDVC-2.5.0 HINTS ${CUDD_LIBRARY_PATH})
include(FindPackageHandleStandardArgs)
find_package_handle_standard_args(CUDD DEFAULT_MSG CUDD_LIBRARIES CUDD_INCLUDE_DIRS)
mark_as_advanced(CUDD_ROOT CUDD_LIBRARIES CUDD_INCLUDE_DIRS)

14
cmake/FindGMP.cmake
View File

@ -9,7 +9,7 @@
# GMP_LIBRARIES_DIR - the directory the library we link with is found in. # GMP_LIBRARIES_DIR - the directory the library we link with is found in.
find_path(GMP_INCLUDE_DIRS NAMES gmp.h find_path(GMP_INCLUDE_DIRS NAMES gmp.h
PATHS "$ENV{PROGRAMFILES}/mpir/include" PATHS "${GMP_DIR}/include" "${GMP_DIR}" "$ENV{PROGRAMFILES}/mpir/include"
DOC "The gmp include directory" DOC "The gmp include directory"
) )
@ -30,12 +30,20 @@ if(MVC)
) )
else(MVC) else(MVC)
find_library(GMP_LIBRARIES NAMES gmp find_library(GMP_LIBRARIES NAMES gmp
PATHS "{CMAKE_INSTALL_PREFIX}/lib" PATHS "${GMP_DIR}/lib"
DOC "The GMP library"
)
find_library(GMP_LIBRARIES NAMES gmp
PATHS "${GMP_DIR}"
DOC "The GMP library"
)
find_library(GMP_LIBRARIES NAMES gmp
PATHS "${CMAKE_INSTALL_PREFIX}/lib"
DOC "The GMP library" DOC "The GMP library"
) )
if(WIN32) if(WIN32)
find_library(GMP_LIBRARY_DLL NAMES gmp find_library(GMP_LIBRARY_DLL NAMES gmp
PATHS "{CMAKE_INSTALL_PREFIX}/bin" PATHS "${CMAKE_INSTALL_PREFIX}/bin" "${GMP_DIR}/bin" "${GMP_DIR}"
DOC "The GMP library DLL" DOC "The GMP library DLL"
) )
endif() endif()

2
os/files.c
View File

@ -290,7 +290,7 @@ static Int time_file(USES_REGS1) {
snprintf(s, 64, "%I64d", (long long int)n); snprintf(s, 64, "%I64d", (long long int)n);
mpz_init_set_str(&rop, s, 10); mpz_init_set_str(&rop, s, 10);
rc = Yap_MkBigNumTerm((void *)&rop) PASS_REGS); rc = Yap_MkBigIntTerm((void *)&rop) PASS_REGS);
#else #else
rc = MkIntegerTerm(ft.dwHighDateTime); rc = MkIntegerTerm(ft.dwHighDateTime);
#endif #endif

2
os/readterm.c
View File

@ -1022,7 +1022,7 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re,
int inp_stream) { int inp_stream) {
CACHE_REGS CACHE_REGS
xarg *args = Yap_ArgListToVector(opts, read_clause_defs, READ_END); xarg *args = Yap_ArgListToVector(opts, read_clause_defs, READ_CLAUSE_END);
if (args == NULL) { if (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_GENERIC_ARGUMENT) if (LOCAL_Error_TYPE == DOMAIN_ERROR_GENERIC_ARGUMENT)
LOCAL_Error_TYPE = DOMAIN_ERROR_READ_OPTION; LOCAL_Error_TYPE = DOMAIN_ERROR_READ_OPTION;

24
packages/cplint/CMakeLists.txt
View File

@ -7,6 +7,28 @@ set(SO_MAJOR 1)
set(SO_MINOR 0) set(SO_MINOR 0)
set(SO_PATCH 0) set(SO_PATCH 0)
find_package (CUDD)
macro_log_feature (CUDD_FOUND "CUDD"
"Use CUDD Library"
"http://vlsi.colorado.edu/~fabio/CUDD/" FALSE)
IF (CUDD_FOUND)
# CUDD_FOUND - system has Cudd
# CUDD_LIBRARIES - Link these to use Cudd
# CUDD_INCLUDE_DIR - Include directory for using Cudd
INCLUDE_DIRECTORIES(
${CUDD_INCLUDE_DIR}
${CMAKE_CURRENT_BINARY_DIR}
)
check_include_files( util.h HAVE_UTIL_H )
check_include_files( cudd/util.h HAVE_CUDD_UTIL_H )
check_include_files( cudd.h HAVE_CUDD_H )
check_include_files( "stdio.h;cudd/cudd.h" HAVE_CUDD_CUDD_H )
check_include_files( cuddInt.h HAVE_CUDDINT_H )
check_include_files( "stdio.h;cudd/cudd.h;cudd/cuddInt.h" HAVE_CUDD_CUDDINT_H )
set( CPLINT_SOURCES set( CPLINT_SOURCES
cplint.h cplint.h
cplint_yap.c cplint_yap.c
@ -128,8 +150,6 @@ examples/win.uni
${CMAKE_CURRENT_BINARY_DIR}/../bdd ${CMAKE_CURRENT_BINARY_DIR}/../bdd
) )
IF (CUDD_FOUND_EXPORT)
add_library (bddem SHARED add_library (bddem SHARED
${BDDEM_SOURCES} ${BDDEM_SOURCES}
) )

2
packages/cplint/slipcase/bddem.c
View File

@ -16,7 +16,7 @@ for the relative license.
#include "config.h" #include "config.h"
#include "cudd_config.h" #include "cudd_config.h"
#if HAVE_CUDD_CUDDINT_H #if HAVE_CUDD_CUDDINT_H
#include "cudd/cuddInt.h" #include <cudd/cuddInt.h>
#elif HAVE_CUDDINT_H #elif HAVE_CUDDINT_H
#include "cuddInt.h" #include "cuddInt.h"
#endif #endif

11
utf8proc/CMakeLists.txt
View File

@ -1,5 +1,9 @@
cmake_minimum_required (VERSION 2.8) cmake_minimum_required (VERSION 2.8)
if(POLICY CMP0042)
cmake_policy(SET CMP0042 NEW)
endif(POLICY CMP0042)
include (utils.cmake) include (utils.cmake)
disallow_intree_builds() disallow_intree_builds()
@ -19,6 +23,9 @@ if (NOT MSVC)
set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -O2 -std=c99 -pedantic -Wall") set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -O2 -std=c99 -pedantic -Wall")
endif () endif ()
SET( CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} ${my_cxx_flags}" )
SET( CMAKE_C_FLAGS "${CMAKE_C_FLAGS} ${my_cxx_flags}" )
add_library (utf8proc add_library (utf8proc
utf8proc.c utf8proc.c
utf8proc.h utf8proc.h
@ -32,10 +39,10 @@ set_target_properties (utf8proc PROPERTIES
set( CMAKE_REQUIRED_INCLUDES . ${CMAKE_REQUIRED_INCLUDES} ) set( CMAKE_REQUIRED_INCLUDES . ${CMAKE_REQUIRED_INCLUDES} )
set ( YAP_YAPUTF8LIB $<TARGET_FILE_NAME:utf8proc> ) set ( YAP_YAPUTF8LIB $<TARGET_FILE_NAME:utf8proc> )
install(TARGETS utf8proc install(TARGETS utf8proc
LIBRARY DESTINATION ${libdir} LIBRARY DESTINATION ${libdir}
ARCHIVE DESTINATION ${libdir}) ARCHIVE DESTINATION ${libdir})

8
utils/analysis/load.yap
View File

@ -328,7 +328,7 @@ pl_interface(F, Mod, Lev) :-
catch( open(PF, read, S, [script(true)]) , _, fail ), catch( open(PF, read, S, [script(true)]) , _, fail ),
repeat, repeat,
nb_getval( current_module, MR ), nb_getval( current_module, MR ),
catch( read_clause( S, T, [module( MR ),term_position(Pos),comment(Comment)] ), Throw, loop_error( MR:Throw)), catch( read_clause( S, T, [module( MR ),term_position(Pos),comments(Comment)] ), Throw, loop_error( S, MR:Throw)),
( T == end_of_file ( T == end_of_file
-> ->
@ -382,7 +382,7 @@ get_interface( T, F, M0 , _Lev) :-
NT = term_expansion( _, _ ) NT = term_expansion( _, _ )
), ),
!, !,
catch(directive(NT, F, M), Error, loop_error(Error)). catch(directive(NT, F, M), Error, loop_error(c_file,Error)).
get_interface( ( M:H :- _B), F, _M , _Lev) :- get_interface( ( M:H :- _B), F, _M , _Lev) :-
!, !,
functor( H, N, A), functor( H, N, A),
@ -519,7 +519,7 @@ get_directive( record( Records ), F, M , _Lev) :-
handle_record( Records, F, M). handle_record( Records, F, M).
get_directive( set_prolog_flag(dollar_as_lower_case,On), F, M , _Lev) :- get_directive( set_prolog_flag(dollar_as_lower_case,On), F, M , _Lev) :-
!, !,
catch(directive(set_prolog_flag(dollar_as_lower_case,M:On), F), Msg, loop_error(585, Msg) ). catch(directive(set_prolog_flag(dollar_as_lower_case,M:On), F), Msg, loop_error(c_file, Msg) ).
% support SWI package record % support SWI package record
handle_record( (Records1, Records2), F, M ) :- handle_record( (Records1, Records2), F, M ) :-
@ -665,7 +665,7 @@ pl_source(F, F0, Mod, Lev) :-
repeat, repeat,
nb_getval( current_module, MR ), nb_getval( current_module, MR ),
%( sub_atom(F,_,_,_,'examples/matrix.yap') -> spy get_interf ; nospyall ), %( sub_atom(F,_,_,_,'examples/matrix.yap') -> spy get_interf ; nospyall ),
catch( read_clause( S, T, [module( MR ),term_position(Pos)] ), Throw, loop_error( Throw)), catch( read_clause( S, T, [module( MR ),term_position(Pos)] ), Throw, loop_error( S, Throw)),
( (
T == end_of_file T == end_of_file
-> ->

52
utils/analysis/undefs.yap Normal file
View File

@ -0,0 +1,52 @@
find_undefs :-
% check_args(undefs, boolean, true, true),
format('UNDEFINED procedure calls:~n===~n',[]),
pmodule(M),
findall(P, undef_in_m(M,P), Ps),
Ps = [_|_],
format(' * ~w~n', [M]),
member(P, Ps),
format(' + ~w:~n',[P]),
fail.
find_undefs.
pmodule(M) :-
findall(M, node(M, _,_,_), Ms),
sort(Ms, SMs),
member(M, SMs).
called_in_module(M, P) :-
findall(P, edge((_ :- _-M:P)), Ps),
sort(Ps, SPs),
member(P, SPs).
undef_in_m(M,P) :-
called_in_module(M, P),
\+ edge((_-M:P :- _)),
\+ is_private(_, M, P),
\+ is_public(_, M, P).
/*
setof(M, Target^F^Line^NA^undef( ( Target :- F-M:NA ), Line ), Ms ),
member( Mod, Ms ),
format(' module ~a:~n',[Mod]),
setof(NA, Target^F^Line^undef( ( Target :- F-Mod:NA ), Line ), Ns ),
member( NA, Ns ),
\+ node( Mod , NA , _File1, _ ),
\+ node( prolog , NA , _File2, _ ),
format(' predicate ~w:~n',[NA]),
(
setof(F-Line, Target^undef( ( Target :- F-Mod:NA ), Line ), FLs ),
member(F-L, FLs ),
format(' line ~w, file ~a~n',[L,F]),
fail
;
setof(F-M,Type^node( M, NA, F, Type ) , FMs ),
format(' same name at:~n',[]),
member((F-L)-M, FMs ),
format(' module ~a, file ~a, line ~d~n',[M,F,L]),
fail
).
undefs.
*/

1
utils/sysgraph
View File

@ -15,6 +15,7 @@
:- use_module(library(analysis/graphs)). :- use_module(library(analysis/graphs)).
:- use_module(library(analysis/load)). :- use_module(library(analysis/load)).
:- use_module(library(analysis/undefs)).
:- initialization(main). :- initialization(main).