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

new error handlong mechanism

Browse Source 
new YAP_ foreign interface
fix unbound_first_arg in call_with_args


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@582 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2002-09-09 17:40:12 +00:00
parent 708437b794
commit 21aab28a59
40 changed files with 1799 additions and 2383 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
C/absmi.c
View File

@ -5855,7 +5855,7 @@ absmi(int inp)
saveregs();
save_machine_regs();
SREG = (CELL *) YapExecute(p, (CPredicate)(p->TrueCodeOfPred));
SREG = (CELL *) YAP_Execute(p, (CPredicate)(p->TrueCodeOfPred));
EX = 0L;
}
@ -5984,7 +5984,7 @@ absmi(int inp)
ASP = YENV;
saveregs();
save_machine_regs();
SREG = (CELL *) YapExecute(PREG->u.lds.p, (CPredicate)(PREG->u.lds.d));
SREG = (CELL *) YAP_Execute(PREG->u.lds.p, (CPredicate)(PREG->u.lds.d));
EX = 0L;
restore_machine_regs();
setregs();

409
C/c_interface.c
View File

@ -39,85 +39,87 @@
#define X_API
#endif
X_API Term STD_PROTO(YapA,(int));
X_API Term STD_PROTO(YapMkVarTerm,(void));
X_API Bool STD_PROTO(YapIsVarTerm,(Term));
X_API Bool STD_PROTO(YapIsNonVarTerm,(Term));
X_API Bool STD_PROTO(YapIsIntTerm,(Term));
X_API Bool STD_PROTO(YapIsFloatTerm,(Term));
X_API Bool STD_PROTO(YapIsDbRefTerm,(Term));
X_API Bool STD_PROTO(YapIsAtomTerm,(Term));
X_API Bool STD_PROTO(YapIsPairTerm,(Term));
X_API Bool STD_PROTO(YapIsApplTerm,(Term));
X_API Term STD_PROTO(YapMkIntTerm,(Int));
X_API Int STD_PROTO(YapIntOfTerm,(Term));
X_API Term STD_PROTO(YapMkFloatTerm,(flt));
X_API flt STD_PROTO(YapFloatOfTerm,(Term));
X_API Term STD_PROTO(YapMkAtomTerm,(Atom));
X_API Atom STD_PROTO(YapAtomOfTerm,(Term));
X_API Atom STD_PROTO(YapLookupAtom,(char *));
X_API Atom STD_PROTO(YapFullLookupAtom,(char *));
X_API char *STD_PROTO(YapAtomName,(Atom));
X_API Term STD_PROTO(YapMkPairTerm,(Term,Term));
X_API Term STD_PROTO(YapMkNewPairTerm,(void));
X_API Term STD_PROTO(YapHeadOfTerm,(Term));
X_API Term STD_PROTO(YapTailOfTerm,(Term));
X_API Term STD_PROTO(YapMkApplTerm,(Functor,unsigned int,Term *));
X_API Term STD_PROTO(YapMkNewApplTerm,(Functor,unsigned int));
X_API Functor STD_PROTO(YapFunctorOfTerm,(Term));
X_API Term STD_PROTO(YapArgOfTerm,(Int,Term));
X_API Functor STD_PROTO(YapMkFunctor,(Atom,Int));
X_API Atom STD_PROTO(YapNameOfFunctor,(Functor));
X_API Int STD_PROTO(YapArityOfFunctor,(Functor));
X_API void *STD_PROTO(YapExtraSpace,(void));
X_API Int STD_PROTO(Yapcut_fail,(void));
X_API Int STD_PROTO(Yapcut_succeed,(void));
X_API Int STD_PROTO(YapUnify,(Term,Term));
X_API Int STD_PROTO(YapUnify,(Term,Term));
X_API int STD_PROTO(YapReset,(void));
X_API Int STD_PROTO(YapInit,(yap_init_args *));
X_API Int STD_PROTO(YapFastInit,(char *));
X_API Int STD_PROTO(YapCallProlog,(Term));
X_API void *STD_PROTO(YapAllocSpaceFromYap,(unsigned int));
X_API void STD_PROTO(YapFreeSpaceFromYap,(void *));
X_API int STD_PROTO(YapStringToBuffer, (Term, char *, unsigned int));
X_API Term STD_PROTO(YapBufferToString, (char *));
X_API Term STD_PROTO(YapBufferToAtomList, (char *));
X_API void STD_PROTO(YapError,(char *));
X_API int STD_PROTO(YapRunGoal,(Term));
X_API int STD_PROTO(YapRestartGoal,(void));
X_API int STD_PROTO(YapGoalHasException,(Term *));
X_API int STD_PROTO(YapContinueGoal,(void));
X_API void STD_PROTO(YapPruneGoal,(void));
X_API void STD_PROTO(YapInitConsult,(int, char *));
X_API void STD_PROTO(YapEndConsult,(void));
X_API Term STD_PROTO(YapRead, (int (*)(void)));
X_API void STD_PROTO(YapWrite, (Term, void (*)(int), int));
X_API char *STD_PROTO(YapCompileClause, (Term));
X_API void STD_PROTO(YapPutValue, (Atom,Term));
X_API Term STD_PROTO(YapGetValue, (Atom));
X_API int STD_PROTO(YapReset, (void));
X_API void STD_PROTO(YapExit, (int));
X_API void STD_PROTO(YapInitSocks, (char *, long));
X_API void STD_PROTO(YapSetOutputMessage, (void));
X_API int STD_PROTO(YapStreamToFileNo, (Term));
X_API void STD_PROTO(YapCloseAllOpenStreams,(void));
X_API Term STD_PROTO(YapOpenStream,(void *, char *, Term, int));
X_API long STD_PROTO(YapNewSlots,(int));
X_API long STD_PROTO(YapInitSlot,(Term));
X_API Term STD_PROTO(YapGetFromSlot,(long));
X_API Term *STD_PROTO(YapAddressFromSlot,(long));
X_API void STD_PROTO(YapPutInSlot,(long, Term));
X_API void STD_PROTO(YapRecoverSlots,(int));
X_API void STD_PROTO(YapThrow,(Term));
X_API int STD_PROTO(YapLookupModule,(Term));
X_API Term STD_PROTO(YapModuleName,(int));
X_API void STD_PROTO(YapHalt,(int));
X_API Term *STD_PROTO(YapTopOfLocalStack,(void));
X_API void *STD_PROTO(YapPredicate,(Atom,Int,Int));
X_API void STD_PROTO(YapPredicateInfo,(void *,Atom *,Int *,Int *));
X_API void STD_PROTO(YapUserCPredicateWithArgs,(char *,CPredicate,Int,Int));
X_API Int STD_PROTO(YapCurrentModule,(void));
X_API Term STD_PROTO(YAP_A,(int));
X_API Term STD_PROTO(YAP_MkVarTerm,(void));
X_API Bool STD_PROTO(YAP_IsVarTerm,(Term));
X_API Bool STD_PROTO(YAP_IsNonVarTerm,(Term));
X_API Bool STD_PROTO(YAP_IsIntTerm,(Term));
X_API Bool STD_PROTO(YAP_IsFloatTerm,(Term));
X_API Bool STD_PROTO(YAP_IsDbRefTerm,(Term));
X_API Bool STD_PROTO(YAP_IsAtomTerm,(Term));
X_API Bool STD_PROTO(YAP_IsPairTerm,(Term));
X_API Bool STD_PROTO(YAP_IsApplTerm,(Term));
X_API Term STD_PROTO(YAP_MkIntTerm,(Int));
X_API Int STD_PROTO(YAP_IntOfTerm,(Term));
X_API Term STD_PROTO(YAP_MkFloatTerm,(flt));
X_API flt STD_PROTO(YAP_FloatOfTerm,(Term));
X_API Term STD_PROTO(YAP_MkAtomTerm,(Atom));
X_API Atom STD_PROTO(YAP_AtomOfTerm,(Term));
X_API Atom STD_PROTO(YAP_LookupAtom,(char *));
X_API Atom STD_PROTO(YAP_FullLookupAtom,(char *));
X_API char *STD_PROTO(YAP_AtomName,(Atom));
X_API Term STD_PROTO(YAP_MkPairTerm,(Term,Term));
X_API Term STD_PROTO(YAP_MkNewPairTerm,(void));
X_API Term STD_PROTO(YAP_HeadOfTerm,(Term));
X_API Term STD_PROTO(YAP_TailOfTerm,(Term));
X_API Term STD_PROTO(YAP_MkApplTerm,(Functor,unsigned long int,Term *));
X_API Term STD_PROTO(YAP_MkNewApplTerm,(Functor,unsigned long int));
X_API Functor STD_PROTO(YAP_FunctorOfTerm,(Term));
X_API Term STD_PROTO(YAP_ArgOfTerm,(Int,Term));
X_API Functor STD_PROTO(YAP_MkFunctor,(Atom,Int));
X_API Atom STD_PROTO(YAP_NameOfFunctor,(Functor));
X_API Int STD_PROTO(YAP_ArityOfFunctor,(Functor));
X_API void *STD_PROTO(YAP_ExtraSpace,(void));
X_API Int STD_PROTO(YAP_cut_fail,(void));
X_API Int STD_PROTO(YAP_cut_succeed,(void));
X_API Int STD_PROTO(YAP_Unify,(Term,Term));
X_API Int STD_PROTO(YAP_Unify,(Term,Term));
X_API int STD_PROTO(YAP_Reset,(void));
X_API Int STD_PROTO(YAP_Init,(YAP_init_args *));
X_API Int STD_PROTO(YAP_FastInit,(char *));
X_API Int STD_PROTO(YAP_CallProlog,(Term));
X_API void *STD_PROTO(YAP_AllocSpaceFromYap,(unsigned int));
X_API void STD_PROTO(YAP_FreeSpaceFromYap,(void *));
X_API int STD_PROTO(YAP_StringToBuffer, (Term, char *, unsigned int));
X_API Term STD_PROTO(YAP_BufferToString, (char *));
X_API Term STD_PROTO(YAP_BufferToAtomList, (char *));
X_API void STD_PROTO(YAP_Error,(char *));
X_API int STD_PROTO(YAP_RunGoal,(Term));
X_API int STD_PROTO(YAP_RestartGoal,(void));
X_API int STD_PROTO(YAP_GoalHasException,(Term *));
X_API int STD_PROTO(YAP_ContinueGoal,(void));
X_API void STD_PROTO(YAP_PruneGoal,(void));
X_API void STD_PROTO(YAP_InitConsult,(int, char *));
X_API void STD_PROTO(YAP_EndConsult,(void));
X_API Term STD_PROTO(YAP_Read, (int (*)(void)));
X_API void STD_PROTO(YAP_Write, (Term, void (*)(int), int));
X_API char *STD_PROTO(YAP_CompileClause, (Term));
X_API void STD_PROTO(YAP_PutValue, (Atom,Term));
X_API Term STD_PROTO(YAP_GetValue, (Atom));
X_API int STD_PROTO(YAP_Reset, (void));
X_API void STD_PROTO(YAP_Exit, (int));
X_API void STD_PROTO(YAP_InitSocks, (char *, long));
X_API void STD_PROTO(YAP_SetOutputMessage, (void));
X_API int STD_PROTO(YAP_StreamToFileNo, (Term));
X_API void STD_PROTO(YAP_CloseAllOpenStreams,(void));
X_API Term STD_PROTO(YAP_OpenStream,(void *, char *, Term, int));
X_API long STD_PROTO(YAP_NewSlots,(int));
X_API long STD_PROTO(YAP_InitSlot,(Term));
X_API Term STD_PROTO(YAP_GetFromSlot,(long));
X_API Term *STD_PROTO(YAP_AddressFromSlot,(long));
X_API void STD_PROTO(YAP_PutInSlot,(long, Term));
X_API void STD_PROTO(YAP_RecoverSlots,(int));
X_API void STD_PROTO(YAP_Throw,(Term));
X_API int STD_PROTO(YAP_LookupModule,(Term));
X_API Term STD_PROTO(YAP_ModuleName,(int));
X_API void STD_PROTO(YAP_Halt,(int));
X_API Term *STD_PROTO(YAP_TopOfLocalStack,(void));
X_API void *STD_PROTO(YAP_Predicate,(Atom,unsigned long int,int));
X_API void STD_PROTO(YAP_PredicateInfo,(void *,Atom *,unsigned long int *,int *));
X_API void STD_PROTO(YAP_UserCPredicate,(char *,CPredicate,unsigned long int));
X_API void STD_PROTO(YAP_UserBackCPredicate,(char *,CPredicate,CPredicate,unsigned long int,unsigned int));
X_API void STD_PROTO(YAP_UserCPredicateWithArgs,(char *,CPredicate,unsigned long int,int));
X_API Int STD_PROTO(YAP_CurrentModule,(void));
static int (*do_getf)(void);
@ -133,63 +135,62 @@ static int do_yap_putc(int streamno,int ch) {
}
X_API Term
YapA(int i)
YAP_A(int i)
{
return(Deref(XREGS[i]));
}
X_API Bool
YapIsIntTerm(Term t)
YAP_IsIntTerm(Term t)
{
return (IsIntegerTerm(t));
}
X_API Bool
YapIsVarTerm(Term t)
YAP_IsVarTerm(Term t)
{
return (IsVarTerm(t));
}
X_API Bool
YapIsNonVarTerm(Term t)
YAP_IsNonVarTerm(Term t)
{
return (IsNonVarTerm(t));
}
X_API Bool
YapIsFloatTerm(Term t)
YAP_IsFloatTerm(Term t)
{
return (IsFloatTerm(t));
}
X_API Bool
YapIsDbRefTerm(Term t)
YAP_IsDbRefTerm(Term t)
{
return (IsDBRefTerm(t));
}
X_API Bool
YapIsAtomTerm(Term t)
YAP_IsAtomTerm(Term t)
{
return (IsAtomTerm(t));
}
X_API Bool
YapIsPairTerm(Term t)
YAP_IsPairTerm(Term t)
{
return (IsPairTerm(t));
}
X_API Bool
YapIsApplTerm(Term t)
YAP_IsApplTerm(Term t)
{
return (IsApplTerm(t) && !IsExtensionFunctor(FunctorOfTerm(t)));
}
X_API Term
YapMkIntTerm(Int n)
YAP_MkIntTerm(Int n)
{
Term I;
BACKUP_H();
@ -200,7 +201,7 @@ YapMkIntTerm(Int n)
}
X_API Int
YapIntOfTerm(Term t)
YAP_IntOfTerm(Term t)
{
if (!IsApplTerm(t))
return (IntOfTerm(t));
@ -209,7 +210,7 @@ YapIntOfTerm(Term t)
}
X_API Term
YapMkFloatTerm(double n)
YAP_MkFloatTerm(double n)
{
Term t;
BACKUP_H();
@ -221,13 +222,13 @@ YapMkFloatTerm(double n)
}
X_API flt
YapFloatOfTerm(Term t)
YAP_FloatOfTerm(Term t)
{
return (FloatOfTerm(t));
}
X_API Term
YapMkAtomTerm(Atom n)
YAP_MkAtomTerm(Atom n)
{
Term t;
@ -236,14 +237,14 @@ YapMkAtomTerm(Atom n)
}
X_API Atom
YapAtomOfTerm(Term t)
YAP_AtomOfTerm(Term t)
{
return (AtomOfTerm(t));
}
X_API char *
YapAtomName(Atom a)
YAP_AtomName(Atom a)
{
char *o;
@ -252,13 +253,13 @@ YapAtomName(Atom a)
}
X_API Atom
YapLookupAtom(char *c)
YAP_LookupAtom(char *c)
{
return(LookupAtom(c));
}
X_API Atom
YapFullLookupAtom(char *c)
YAP_FullLookupAtom(char *c)
{
Atom at;
@ -267,7 +268,7 @@ YapFullLookupAtom(char *c)
}
X_API Term
YapMkVarTerm(void)
YAP_MkVarTerm(void)
{
CELL t;
BACKUP_H();
@ -279,7 +280,7 @@ YapMkVarTerm(void)
}
X_API Term
YapMkPairTerm(Term t1, Term t2)
YAP_MkPairTerm(Term t1, Term t2)
{
Term t;
BACKUP_H();
@ -291,7 +292,7 @@ YapMkPairTerm(Term t1, Term t2)
}
X_API Term
YapMkNewPairTerm()
YAP_MkNewPairTerm()
{
Term t;
BACKUP_H();
@ -303,19 +304,19 @@ YapMkNewPairTerm()
}
X_API Term
YapHeadOfTerm(Term t)
YAP_HeadOfTerm(Term t)
{
return (HeadOfTerm(t));
}
X_API Term
YapTailOfTerm(Term t)
YAP_TailOfTerm(Term t)
{
return (TailOfTerm(t));
}
X_API Term
YapMkApplTerm(Functor f,unsigned int arity, Term args[])
YAP_MkApplTerm(Functor f,unsigned long int arity, Term args[])
{
Term t;
BACKUP_H();
@ -327,7 +328,7 @@ YapMkApplTerm(Functor f,unsigned int arity, Term args[])
}
X_API Term
YapMkNewApplTerm(Functor f,unsigned int arity)
YAP_MkNewApplTerm(Functor f,unsigned long int arity)
{
Term t;
BACKUP_H();
@ -339,14 +340,14 @@ YapMkNewApplTerm(Functor f,unsigned int arity)
}
X_API Functor
YapFunctorOfTerm(Term t)
YAP_FunctorOfTerm(Term t)
{
return (FunctorOfTerm(t));
}
X_API Term
YapArgOfTerm(Int n, Term t)
YAP_ArgOfTerm(Int n, Term t)
{
return (ArgOfTerm(n, t));
}
@ -354,25 +355,25 @@ YapArgOfTerm(Int n, Term t)
X_API Functor
YapMkFunctor(Atom a, Int n)
YAP_MkFunctor(Atom a, Int n)
{
return (MkFunctor(a, n));
}
X_API Atom
YapNameOfFunctor(Functor f)
YAP_NameOfFunctor(Functor f)
{
return (NameOfFunctor(f));
}
X_API Int
YapArityOfFunctor(Functor f)
YAP_ArityOfFunctor(Functor f)
{
return (ArityOfFunctor(f));
}
X_API void *
YapExtraSpace(void)
YAP_ExtraSpace(void)
{
void *ptr;
BACKUP_B();
@ -385,7 +386,7 @@ YapExtraSpace(void)
}
X_API Int
Yapcut_fail(void)
YAP_cut_fail(void)
{
BACKUP_B();
@ -397,7 +398,7 @@ Yapcut_fail(void)
}
X_API Int
Yapcut_succeed(void)
YAP_cut_succeed(void)
{
BACKUP_B();
@ -409,7 +410,7 @@ Yapcut_succeed(void)
}
X_API Int
YapUnify(Term t1, Term t2)
YAP_Unify(Term t1, Term t2)
{
Int out;
BACKUP_MACHINE_REGS();
@ -421,7 +422,7 @@ YapUnify(Term t1, Term t2)
}
X_API long
YapNewSlots(int n)
YAP_NewSlots(int n)
{
Int old_slots = IntOfTerm(ASP[0]), oldn = n;
while (n > 0) {
@ -434,7 +435,7 @@ YapNewSlots(int n)
}
X_API long
YapInitSlot(Term t)
YAP_InitSlot(Term t)
{
Int old_slots = IntOfTerm(ASP[0]);
*ASP = t;
@ -444,7 +445,7 @@ YapInitSlot(Term t)
}
X_API void
YapRecoverSlots(int n)
YAP_RecoverSlots(int n)
{
Int old_slots = IntOfTerm(ASP[0]);
ASP += n;
@ -452,19 +453,19 @@ YapRecoverSlots(int n)
}
X_API Term
YapGetFromSlot(long slot)
YAP_GetFromSlot(long slot)
{
return(Deref(LCL0[slot]));
}
X_API Term *
YapAddressFromSlot(long slot)
YAP_AddressFromSlot(long slot)
{
return(LCL0+slot);
}
X_API void
YapPutInSlot(long slot, Term t)
YAP_PutInSlot(long slot, Term t)
{
LCL0[slot] = t;
}
@ -480,7 +481,7 @@ typedef Int (*CPredicate7)(long,long,long,long,long,long,long);
typedef Int (*CPredicate8)(long,long,long,long,long,long,long,long);
Int
YapExecute(PredEntry *pe, CPredicate exec_code)
YAP_Execute(PredEntry *pe, CPredicate exec_code)
{
if (pe->PredFlags & CArgsPredFlag) {
switch (pe->ArityOfPE) {
@ -492,69 +493,70 @@ YapExecute(PredEntry *pe, CPredicate exec_code)
case 1:
{
CPredicate1 code1 = (CPredicate1)exec_code;
return ((code1)(YapInitSlot(Deref(ARG1))));
return ((code1)(YAP_InitSlot(Deref(ARG1))));
}
case 2:
{
CPredicate2 code2 = (CPredicate2)exec_code;
return ((code2)(YapInitSlot(Deref(ARG1)),
YapInitSlot(Deref(ARG2))));
return ((code2)(YAP_InitSlot(Deref(ARG1)),
YAP_InitSlot(Deref(ARG2))));
}
case 3:
{
CPredicate3 code3 = (CPredicate3)exec_code;
return ((code3)(YapInitSlot(Deref(ARG1)),
YapInitSlot(Deref(ARG2)),
YapInitSlot(Deref(ARG3))));
return ((code3)(YAP_InitSlot(Deref(ARG1)),
YAP_InitSlot(Deref(ARG2)),
YAP_InitSlot(Deref(ARG3))));
}
case 4:
{
CPredicate4 code4 = (CPredicate4)exec_code;
return ((code4)(YapInitSlot(Deref(ARG1)),
YapInitSlot(Deref(ARG2)),
YapInitSlot(Deref(ARG3)),
YapInitSlot(Deref(ARG4))));
return ((code4)(YAP_InitSlot(Deref(ARG1)),
YAP_InitSlot(Deref(ARG2)),
YAP_InitSlot(Deref(ARG3)),
YAP_InitSlot(Deref(ARG4))));
}
case 5:
{
CPredicate5 code5 = (CPredicate5)exec_code;
return ((code5)(YapInitSlot(Deref(ARG1)),
YapInitSlot(Deref(ARG2)),
YapInitSlot(Deref(ARG3)),
YapInitSlot(Deref(ARG4)),YapInitSlot(Deref(ARG5))));
return ((code5)(YAP_InitSlot(Deref(ARG1)),
YAP_InitSlot(Deref(ARG2)),
YAP_InitSlot(Deref(ARG3)),
YAP_InitSlot(Deref(ARG4)),
YAP_InitSlot(Deref(ARG5))));
}
case 6:
{
CPredicate6 code6 = (CPredicate6)exec_code;
return ((code6)(YapInitSlot(Deref(ARG1)),
YapInitSlot(Deref(ARG2)),
YapInitSlot(Deref(ARG3)),
YapInitSlot(Deref(ARG4)),
YapInitSlot(Deref(ARG5)),
YapInitSlot(Deref(ARG6))));
return ((code6)(YAP_InitSlot(Deref(ARG1)),
YAP_InitSlot(Deref(ARG2)),
YAP_InitSlot(Deref(ARG3)),
YAP_InitSlot(Deref(ARG4)),
YAP_InitSlot(Deref(ARG5)),
YAP_InitSlot(Deref(ARG6))));
}
case 7:
{
CPredicate7 code7 = (CPredicate7)exec_code;
return ((code7)(YapInitSlot(Deref(ARG1)),
YapInitSlot(Deref(ARG2)),
YapInitSlot(Deref(ARG3)),
YapInitSlot(Deref(ARG4)),
YapInitSlot(Deref(ARG5)),
YapInitSlot(Deref(ARG6)),
YapInitSlot(Deref(ARG7))));
return ((code7)(YAP_InitSlot(Deref(ARG1)),
YAP_InitSlot(Deref(ARG2)),
YAP_InitSlot(Deref(ARG3)),
YAP_InitSlot(Deref(ARG4)),
YAP_InitSlot(Deref(ARG5)),
YAP_InitSlot(Deref(ARG6)),
YAP_InitSlot(Deref(ARG7))));
}
case 8:
{
CPredicate8 code8 = (CPredicate8)exec_code;
return ((code8)(YapInitSlot(Deref(ARG1)),
YapInitSlot(Deref(ARG2)),
YapInitSlot(Deref(ARG3)),
YapInitSlot(Deref(ARG4)),
YapInitSlot(Deref(ARG5)),
YapInitSlot(Deref(ARG6)),
YapInitSlot(Deref(ARG7)),
YapInitSlot(Deref(ARG8))));
return ((code8)(YAP_InitSlot(Deref(ARG1)),
YAP_InitSlot(Deref(ARG2)),
YAP_InitSlot(Deref(ARG3)),
YAP_InitSlot(Deref(ARG4)),
YAP_InitSlot(Deref(ARG5)),
YAP_InitSlot(Deref(ARG6)),
YAP_InitSlot(Deref(ARG7)),
YAP_InitSlot(Deref(ARG8))));
}
default:
return(FALSE);
@ -565,7 +567,7 @@ YapExecute(PredEntry *pe, CPredicate exec_code)
}
X_API Int
YapCallProlog(Term t)
YAP_CallProlog(Term t)
{
Int out;
SMALLUNSGN mod = CurrentModule;
@ -586,7 +588,7 @@ YapCallProlog(Term t)
}
X_API void *
YapAllocSpaceFromYap(unsigned int size)
YAP_AllocSpaceFromYap(unsigned int size)
{
void *ptr;
BACKUP_MACHINE_REGS();
@ -603,14 +605,14 @@ YapAllocSpaceFromYap(unsigned int size)
}
X_API void
YapFreeSpaceFromYap(void *ptr)
YAP_FreeSpaceFromYap(void *ptr)
{
FreeCodeSpace(ptr);
}
/* copy a string to a buffer */
X_API int
YapStringToBuffer(Term t, char *buf, unsigned int bufsize)
YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize)
{
unsigned int j = 0;
@ -652,7 +654,7 @@ YapStringToBuffer(Term t, char *buf, unsigned int bufsize)
/* copy a string to a buffer */
X_API Term
YapBufferToString(char *s)
YAP_BufferToString(char *s)
{
Term t;
BACKUP_H();
@ -665,7 +667,7 @@ YapBufferToString(char *s)
/* copy a string to a buffer */
X_API Term
YapBufferToAtomList(char *s)
YAP_BufferToAtomList(char *s)
{
Term t;
BACKUP_H();
@ -678,7 +680,7 @@ YapBufferToAtomList(char *s)
X_API void
YapError(char *buf)
YAP_Error(char *buf)
{
Error(SYSTEM_ERROR,TermNil,buf);
}
@ -689,7 +691,7 @@ static void myputc (int ch)
}
X_API int
YapRunGoal(Term t)
YAP_RunGoal(Term t)
{
int out;
yamop *old_CP = CP;
@ -701,6 +703,7 @@ YapRunGoal(Term t)
ENV = (CELL *)ENV[E_E];
CP = old_CP;
} else {
if (B != NULL) /* restore might have destroyed B */
B = B->cp_b;
}
@ -709,7 +712,7 @@ YapRunGoal(Term t)
}
X_API int
YapRestartGoal(void)
YAP_RestartGoal(void)
{
int out;
BACKUP_MACHINE_REGS();
@ -727,7 +730,7 @@ YapRestartGoal(void)
}
X_API int
YapContinueGoal(void)
YAP_ContinueGoal(void)
{
int out;
BACKUP_MACHINE_REGS();
@ -739,7 +742,7 @@ YapContinueGoal(void)
}
X_API void
YapPruneGoal(void)
YAP_PruneGoal(void)
{
BACKUP_B();
@ -752,7 +755,7 @@ YapPruneGoal(void)
}
X_API int
YapGoalHasException(Term *t)
YAP_GoalHasException(Term *t)
{
int out = FALSE;
BACKUP_MACHINE_REGS();
@ -765,7 +768,7 @@ YapGoalHasException(Term *t)
}
X_API void
YapInitConsult(int mode, char *filename)
YAP_InitConsult(int mode, char *filename)
{
BACKUP_MACHINE_REGS();
@ -778,7 +781,7 @@ YapInitConsult(int mode, char *filename)
}
X_API void
YapEndConsult(void)
YAP_EndConsult(void)
{
BACKUP_MACHINE_REGS();
@ -788,7 +791,7 @@ YapEndConsult(void)
}
X_API Term
YapRead(int (*mygetc)(void))
YAP_Read(int (*mygetc)(void))
{
Term t;
tr_fr_ptr old_TR;
@ -812,7 +815,7 @@ YapRead(int (*mygetc)(void))
}
X_API void
YapWrite(Term t, void (*myputc)(int), int flags)
YAP_Write(Term t, void (*myputc)(int), int flags)
{
BACKUP_MACHINE_REGS();
@ -823,7 +826,7 @@ YapWrite(Term t, void (*myputc)(int), int flags)
}
X_API char *
YapCompileClause(Term t)
YAP_CompileClause(Term t)
{
char *ErrorMessage;
CODEADDR codeaddr;
@ -847,7 +850,7 @@ YapCompileClause(Term t)
that wants to control Yap */
X_API Int
YapInit(yap_init_args *yap_init)
YAP_Init(YAP_init_args *yap_init)
{
int restore_result;
int Trail = 0, Stack = 0, Heap = 0;
@ -952,9 +955,9 @@ YapInit(yap_init_args *yap_init)
}
X_API Int
YapFastInit(char saved_state[])
YAP_FastInit(char saved_state[])
{
yap_init_args init_args;
YAP_init_args init_args;
init_args.SavedState = saved_state;
init_args.HeapSize = 0;
@ -970,23 +973,23 @@ YapFastInit(char saved_state[])
init_args.Argc = 0;
init_args.Argv = NULL;
return(YapInit(&init_args));
return(YAP_Init(&init_args));
}
X_API void
YapPutValue(Atom at, Term t)
YAP_PutValue(Atom at, Term t)
{
PutValue(at, t);
}
X_API Term
YapGetValue(Atom at)
YAP_GetValue(Atom at)
{
return(GetValue(at));
}
X_API int
YapReset(void)
YAP_Reset(void)
{
BACKUP_MACHINE_REGS();
@ -1006,13 +1009,13 @@ YapReset(void)
}
X_API void
YapExit(int retval)
YAP_Exit(int retval)
{
exit_yap(retval);
}
X_API void
YapInitSocks(char *host, long port)
YAP_InitSocks(char *host, long port)
{
#if USE_SOCKET
init_socks(host, port);
@ -1020,7 +1023,7 @@ YapInitSocks(char *host, long port)
}
X_API void
YapSetOutputMessage(void)
YAP_SetOutputMessage(void)
{
#if DEBUG
output_msg = TRUE;
@ -1028,13 +1031,13 @@ YapSetOutputMessage(void)
}
X_API int
YapStreamToFileNo(Term t)
YAP_StreamToFileNo(Term t)
{
return(StreamToFileNo(t));
}
X_API void
YapCloseAllOpenStreams(void)
YAP_CloseAllOpenStreams(void)
{
BACKUP_H();
@ -1044,7 +1047,7 @@ YapCloseAllOpenStreams(void)
}
X_API Term
YapOpenStream(void *fh, char *name, Term nm, int flags)
YAP_OpenStream(void *fh, char *name, Term nm, int flags)
{
Term retv;
@ -1057,7 +1060,7 @@ YapOpenStream(void *fh, char *name, Term nm, int flags)
}
X_API void
YapThrow(Term t)
YAP_Throw(Term t)
{
BACKUP_MACHINE_REGS();
JumpToEnv(t);
@ -1065,31 +1068,31 @@ YapThrow(Term t)
}
X_API int
YapLookupModule(Term t)
YAP_LookupModule(Term t)
{
return(LookupModule(t));
}
X_API Term
YapModuleName(int i)
YAP_ModuleName(int i)
{
return(ModuleName[i]);
}
X_API void
YapHalt(int i)
YAP_Halt(int i)
{
exit_yap(i);
}
X_API CELL *
YapTopOfLocalStack(void)
YAP_TopOfLocalStack(void)
{
return(ASP);
}
X_API void *
YapPredicate(Atom a, Int arity, Int m)
YAP_Predicate(Atom a, unsigned long int arity, int m)
{
if (arity == 0) {
return((void *)RepPredProp(PredPropByAtom(a,m)));
@ -1100,7 +1103,7 @@ YapPredicate(Atom a, Int arity, Int m)
}
X_API void
YapPredicateInfo(void *p, Atom* a, Int* arity, Int* m)
YAP_PredicateInfo(void *p, Atom* a, unsigned long int* arity, int* m)
{
PredEntry *pd = (PredEntry *)p;
if (pd->ArityOfPE) {
@ -1114,12 +1117,25 @@ YapPredicateInfo(void *p, Atom* a, Int* arity, Int* m)
}
X_API void
YapUserCPredicateWithArgs(char *a, CPredicate f, Int arity, Int mod)
YAP_UserCPredicate(char *name, CPredicate def, unsigned long int arity)
{
InitCPred(name, arity, def, UserCPredFlag);
}
X_API void
YAP_UserBackCPredicate(char *name, CPredicate init, CPredicate cont,
unsigned long int arity, unsigned int extra)
{
InitCPredBack(name, arity, extra, init, cont, UserCPredFlag);
}
X_API void
YAP_UserCPredicateWithArgs(char *a, CPredicate f, unsigned long int arity, int mod)
{
PredEntry *pe;
SMALLUNSGN cm = CurrentModule;
CurrentModule = mod;
UserCPredicate(a,f,arity);
YAP_UserCPredicate(a,f,arity);
if (arity == 0) {
pe = RepPredProp(PredPropByAtom(LookupAtom(a),mod));
} else {
@ -1131,7 +1147,8 @@ YapUserCPredicateWithArgs(char *a, CPredicate f, Int arity, Int mod)
}
X_API Int
YapCurrentModule(void)
YAP_CurrentModule(void)
{
return(CurrentModule);
}

70
C/cdmgr.c
View File

@ -79,9 +79,7 @@ STATIC_PROTO(Int p_call_count_info, (void));
STATIC_PROTO(Int p_call_count_set, (void));
STATIC_PROTO(Int p_call_count_reset, (void));
STATIC_PROTO(Int p_toggle_static_predicates_in_use, (void));
#ifdef DEBUG
STATIC_PROTO(void list_all_predicates_in_use, (void));
#endif
#define PredArity(p) (p->ArityOfPE)
#define TRYCODE(G,F,N) ( (N)<5 ? (op_numbers)((int)F+(N)*3) : G)
@ -1929,6 +1927,56 @@ list_all_predicates_in_use(void)
}
#endif
Term
all_calls(void)
{
choiceptr b_ptr = B;
CELL *env_ptr = ENV;
CELL *bp = NULL;
Term ts[3];
Functor f = MkFunctor(AtomLocal,3);
ts[0] = MkIntegerTerm((Int)P);
ts[1] = AbsPair(H);
/* walk the environment chain */
while (env_ptr != NULL) {
bp = H;
H += 2;
/* notice that MkIntegerTerm may increase the Heap */
bp[0] = MkIntegerTerm((Int)env_ptr[E_CP]);
if (H >= ASP) {
bp[1] = TermNil;
return(ts[0]);
} else {
bp[1] = AbsPair(H);
}
env_ptr = (CELL *)(env_ptr[E_E]);
}
bp[1] = TermNil;
ts[2] = AbsPair(H);
while (b_ptr != NULL) {
bp = H;
H += 2;
/* notice that MkIntegerTerm may increase the Heap */
bp[0] = MkIntegerTerm((Int)b_ptr->cp_ap);
if (H >= ASP) {
bp[1] = TermNil;
return(ts[0]);
} else {
bp[1] = AbsPair(H);
}
b_ptr = b_ptr->cp_b;
}
bp[1] = TermNil;
return(MkApplTerm(f,3,ts));
}
static Int
p_current_stack(void)
{
return(unify(ARG1,all_calls()));
}
static void
mark_pred(int mark, PredEntry *pe)
{
@ -2097,6 +2145,22 @@ PredForCode(CODEADDR codeptr, Atom *pat, Int *parity, SMALLUNSGN *pmodule) {
return(0);
}
static Int
p_pred_for_code(void) {
CODEADDR codeptr = (CODEADDR)IntegerOfTerm(Deref(ARG1));
Atom at;
UInt arity;
SMALLUNSGN module;
Int cl;
cl = PredForCode(codeptr, &at, &arity, &module);
return(unify(ARG2,MkAtomTerm(at)) &&
unify(ARG3,MkIntegerTerm(arity)) &&
unify(ARG4,ModuleName[module]) &&
unify(ARG5,MkIntegerTerm(cl)));
return(0);
}
static Int
p_is_profiled(void)
{
@ -2504,5 +2568,7 @@ InitCdMgr(void)
InitCPred("$cut_transparent", 1, p_cut_transparent, SafePredFlag);
InitCPred("$hide_predicate", 2, p_hide_predicate, SafePredFlag);
InitCPred("$hidden_predicate", 2, p_hidden_predicate, SafePredFlag);
InitCPred("$pred_for_code", 5, p_pred_for_code, SyncPredFlag);
InitCPred("$current_stack", 1, p_current_stack, SyncPredFlag);
}

350
C/errors.c
View File

@ -318,7 +318,7 @@ yamop *
Error (yap_error_number type, Term where, char *format,...)
{
va_list ap;
CELL nt[2];
CELL nt[3];
Functor fun;
int serious;
char *tp = tmpbuf;
@ -445,11 +445,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("array_overflow"));
ti[1] = where;
@ -465,11 +460,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("array_type"));
ti[1] = where;
@ -485,11 +475,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("io_mode"));
ti[1] = where;
@ -505,11 +490,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("mutable"));
ti[1] = where;
@ -525,11 +505,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("non_empty_list"));
ti[1] = where;
@ -545,11 +520,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("not_less_than_zero"));
ti[1] = where;
@ -565,11 +535,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("not_newline"));
ti[1] = where;
@ -585,11 +550,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("not_zero"));
ti[1] = where;
@ -605,11 +565,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("out_of_range"));
ti[1] = where;
@ -625,11 +580,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("operator_priority"));
ti[1] = where;
@ -645,11 +595,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("operator_specifier"));
ti[1] = where;
@ -665,11 +610,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("radix"));
ti[1] = where;
@ -685,11 +625,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("shift_count_overflow"));
ti[1] = where;
@ -705,11 +640,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("source_sink"));
ti[1] = where;
@ -725,11 +655,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("stream"));
ti[1] = where;
@ -745,11 +670,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("stream_or_alias"));
ti[1] = where;
@ -765,11 +685,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("stream_position"));
ti[1] = where;
@ -785,11 +700,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("syntax_error_handler"));
ti[1] = where;
@ -805,11 +715,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("time_out_spec"));
ti[1] = where;
@ -825,11 +730,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("source_sink"));
ti[1] = where;
@ -845,11 +745,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("array"));
ti[1] = where;
@ -865,11 +760,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("stream"));
ti[1] = where;
@ -885,11 +775,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[1];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("float_overflow"));
nt[0] = MkApplTerm(MkFunctor(LookupAtom("evaluation_error"),1), 1, ti);
@ -904,11 +789,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[1];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("int_overflow"));
nt[0] = MkApplTerm(MkFunctor(LookupAtom("evaluation_error"),1), 1, ti);
@ -923,11 +803,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[1];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("undefined"));
nt[0] = MkApplTerm(MkFunctor(LookupAtom("evaluation_error"),1), 1, ti);
@ -942,11 +817,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[1];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("float_underflow"));
nt[0] = MkApplTerm(MkFunctor(LookupAtom("evaluation_error"),1), 1, ti);
@ -961,11 +831,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[1];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("underflow"));
nt[0] = MkApplTerm(MkFunctor(LookupAtom("evaluation_error"),1), 1, ti);
@ -980,11 +845,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[1];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("zero_divisor"));
nt[0] = MkApplTerm(MkFunctor(LookupAtom("evaluation_error"),1), 1, ti);
@ -998,11 +858,6 @@ Error (yap_error_number type, Term where, char *format,...)
{
int i;
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
nt[0] = MkAtomTerm(LookupAtom("instantiation_error"));
tp = tmpbuf+i;
@ -1016,11 +871,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("access"));
ti[1] = MkAtomTerm(LookupAtom("private_procedure"));
@ -1037,11 +887,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("create"));
ti[1] = MkAtomTerm(LookupAtom("array"));
@ -1058,11 +903,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("create"));
ti[1] = MkAtomTerm(LookupAtom("operator"));
@ -1079,11 +919,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("input"));
ti[1] = MkAtomTerm(LookupAtom("binary_stream"));
@ -1100,11 +935,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("input"));
ti[1] = MkAtomTerm(LookupAtom("past_end_of_stream"));
@ -1121,11 +951,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("input"));
ti[1] = MkAtomTerm(LookupAtom("stream"));
@ -1142,11 +967,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("input"));
ti[1] = MkAtomTerm(LookupAtom("text_stream"));
@ -1163,11 +983,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("modify"));
ti[1] = MkAtomTerm(LookupAtom("static_procedure"));
@ -1184,11 +999,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("new"));
ti[1] = MkAtomTerm(LookupAtom("alias"));
@ -1205,11 +1015,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("open"));
ti[1] = MkAtomTerm(LookupAtom("source_sink"));
@ -1226,11 +1031,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("output"));
ti[1] = MkAtomTerm(LookupAtom("binary_stream"));
@ -1247,11 +1047,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("output"));
ti[1] = MkAtomTerm(LookupAtom("stream"));
@ -1268,11 +1063,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("output"));
ti[1] = MkAtomTerm(LookupAtom("text_stream"));
@ -1289,11 +1079,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("reposition"));
ti[1] = MkAtomTerm(LookupAtom("stream"));
@ -1310,11 +1095,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("resize"));
ti[1] = MkAtomTerm(LookupAtom("array"));
@ -1331,11 +1111,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[1];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("character"));
nt[0] = MkApplTerm(MkFunctor(LookupAtom("representation_error"),1), 1, ti);
@ -1350,11 +1125,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[1];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("character_code"));
nt[0] = MkApplTerm(MkFunctor(LookupAtom("representation_error"),1), 1, ti);
@ -1369,11 +1139,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[1];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("max_arity"));
nt[0] = MkApplTerm(MkFunctor(LookupAtom("representation_error"),1), 1, ti);
@ -1387,11 +1152,6 @@ Error (yap_error_number type, Term where, char *format,...)
{
int i;
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
nt[0] = where;
tp = tmpbuf+i;
@ -1404,11 +1164,6 @@ Error (yap_error_number type, Term where, char *format,...)
{
int i;
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
nt[0] = MkAtomTerm(LookupAtom("system_error"));
tp = tmpbuf+i;
@ -1422,11 +1177,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("array"));
ti[1] = where;
@ -1442,11 +1192,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("atom"));
ti[1] = where;
@ -1462,11 +1207,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("atomic"));
ti[1] = where;
@ -1482,11 +1222,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("byte"));
ti[1] = where;
@ -1502,11 +1237,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("callable"));
ti[1] = where;
@ -1522,11 +1252,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("character"));
ti[1] = where;
@ -1542,11 +1267,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("compound"));
ti[1] = where;
@ -1562,11 +1282,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("db_reference"));
ti[1] = where;
@ -1582,11 +1297,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("db_term"));
ti[1] = where;
@ -1602,11 +1312,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("evaluable"));
ti[1] = where;
@ -1622,11 +1327,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("float"));
ti[1] = where;
@ -1642,11 +1342,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("integer"));
ti[1] = where;
@ -1662,11 +1357,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("key"));
ti[1] = where;
@ -1682,11 +1372,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("list"));
ti[1] = where;
@ -1702,11 +1387,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("number"));
ti[1] = where;
@ -1722,11 +1402,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("predicate_indicator"));
ti[1] = where;
@ -1742,11 +1417,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("pointer"));
ti[1] = where;
@ -1762,11 +1432,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("unsigned_byte"));
ti[1] = where;
@ -1782,11 +1447,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i;
Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("variable"));
ti[1] = where;
@ -1801,11 +1461,6 @@ Error (yap_error_number type, Term where, char *format,...)
{
int i;
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf);
nt[0] = MkAtomTerm(LookupAtom("system_error"));
tp = tmpbuf+i;
@ -1817,9 +1472,8 @@ Error (yap_error_number type, Term where, char *format,...)
if (type != PURE_ABORT) {
/* This is used by some complex procedures to detect there was an error */
ErrorMessage = RepAtom(AtomOfTerm(nt[0]))->StrOfAE;
detect_bug_location(tp, psize);
}
nt[1] = MkAtomTerm(LookupAtom(tmpbuf));
nt[1] = MkPairTerm(MkAtomTerm(LookupAtom(tmpbuf)), all_calls());
if (serious) {
if (type == PURE_ABORT)
JumpToEnv(MkAtomTerm(LookupAtom("abort")));

20
C/exec.c
View File

@ -1250,7 +1250,9 @@ exec_absmi(int top)
{
int lval;
if (top && (lval = sigsetjmp (RestartEnv, 1)) != 0) {
if (lval == 1) { /* restart */
switch(lval) {
case 1:
{ /* restart */
/* otherwise, SetDBForThrow will fail entering critical mode */
PrologMode = UserMode;
/* find out where to cut to */
@ -1267,19 +1269,29 @@ exec_absmi(int top)
yap_flags[SPY_CREEP_FLAG] = 0;
CreepFlag = CalculateStackGap();
P = (yamop *)FAILCODE;
PrologMode = UserMode;
}
if (lval == 2) { /* arithmetic exception */
break;
case 2:
{
/* arithmetic exception */
/* must be done here, otherwise siglongjmp will clobber all the registers */
Error(YAP_matherror,TermNil,NULL);
/* reset the registers so that we don't have trash in abstract machine */
set_fpu_exceptions(yap_flags[LANGUAGE_MODE_FLAG] == 1);
P = (yamop *)FAILCODE;
PrologMode = UserMode;
}
if (lval == 3) { /* saved state */
break;
case 3:
{ /* saved state */
return(FALSE);
}
}
default:
/* do nothing */
PrologMode = UserMode;
}
}
return(absmi(0));
}

24
C/init.c
View File

@ -262,19 +262,6 @@ DebugGetc()
#endif
void
UserCPredicate(char *name, CPredicate def, unsigned int arity)
{
InitCPred(name, arity, def, UserCPredFlag);
}
void
UserBackCPredicate(char *name, CPredicate init, CPredicate cont,
unsigned int arity, int extra)
{
InitCPredBack(name, arity, extra, init, cont, UserCPredFlag);
}
int IsOpType(char *type)
{
int i;
@ -503,7 +490,7 @@ InitDebug(void)
}
void
InitCPred(char *Name, int Arity, CPredicate code, int flags)
InitCPred(char *Name, unsigned long int Arity, CPredicate code, int flags)
{
Atom atom = LookupAtom(Name);
PredEntry *pe;
@ -540,11 +527,14 @@ InitCPred(char *Name, int Arity, CPredicate code, int flags)
c_predicates[NUMBER_OF_CPREDS] = code;
pe->StateOfPred = NUMBER_OF_CPREDS;
NUMBER_OF_CPREDS++;
if (NUMBER_OF_CPREDS >= MAX_C_PREDS) {
Error(SYSTEM_ERROR, TermNil, "Too Many C-Predicates");
}
}
}
void
InitCmpPred(char *Name, int Arity, CmpPredicate cmp_code, CPredicate code, int flags)
InitCmpPred(char *Name, unsigned long int Arity, CmpPredicate cmp_code, CPredicate code, int flags)
{
Atom atom = LookupAtom(Name);
PredEntry *pe;
@ -585,7 +575,7 @@ InitCmpPred(char *Name, int Arity, CmpPredicate cmp_code, CPredicate code, int f
}
void
InitAsmPred(char *Name, int Arity, int code, CPredicate def, int flags)
InitAsmPred(char *Name, unsigned long int Arity, int code, CPredicate def, int flags)
{
Atom atom = LookupAtom(Name);
PredEntry *pe;
@ -660,7 +650,7 @@ CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont)
void
InitCPredBack(char *Name, int Arity, int Extra, CPredicate Start, CPredicate Cont, int flags)
InitCPredBack(char *Name, unsigned long int Arity, unsigned int Extra, CPredicate Start, CPredicate Cont, int flags)
{
PredEntry *pe;
Atom atom = LookupAtom(Name);

6
C/save.c
View File

@ -608,9 +608,9 @@ check_header(void)
get_cell();
/* now, check whether we got enough enough space to load the
saved space */
if ((hp_size = get_cell()) > Unsigned(AuxTop) - Unsigned(HeapBase)) {
Error(SYSTEM_ERROR,TermNil,"out of heap space, Yap needs %d", hp_size);
return(FAIL_RESTORE);
hp_size = get_cell();
while (hp_size > Unsigned(AuxTop) - Unsigned(HeapBase)) {
growheap(FALSE);
}
if (mode == DO_EVERYTHING) {
if ((lc_size = get_cell())+(gb_size=get_cell()) > Unsigned(LocalBase) - Unsigned(GlobalBase)) {

2
C/stdpreds.c
View File

@ -244,7 +244,7 @@ FindWhatCreep(toCreep)
static Int
p_opdec(void)
{ /* '$op'(p,type,atom) */
{ /* '$opdec'(p,type,atom) */
/* we know the arguments are integer, atom, atom */
Term p = Deref(ARG1), t = Deref(ARG2), at = Deref(ARG3);
return (OpDec((int) IntOfTerm(p), RepAtom(AtomOfTerm(t))->StrOfAE,

4
C/tracer.c
View File

@ -113,9 +113,9 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
vsc_count++;
/* if (vsc_count < 123808900) return; */
/* if (vsc_count == 134) {
if (vsc_count == 59) {
printf("Here I go\n");
} */
}
/* if (vsc_count > 500000) exit(0); */
/* if (gc_calls < 1) return;*/
#if defined(__GNUC__)

15
H/Yapproto.h
View File

@ -10,7 +10,7 @@
* File: Yap.proto *
* mods: *
* comments: Function declarations for YAP *
* version: $Id: Yapproto.h,v 1.21 2002-06-11 05:43:01 vsc Exp $ *
* version: $Id: Yapproto.h,v 1.22 2002-09-09 17:39:36 vsc Exp $ *
*************************************************************************/
/* prototype file for Yap */
@ -104,9 +104,10 @@ void STD_PROTO(InitBBPreds,(void));
void STD_PROTO(InitBigNums,(void));
/* c_interface.c */
Int STD_PROTO(YapExecute,(struct pred_entry *, CPredicate));
Int STD_PROTO(YAP_Execute,(struct pred_entry *, CPredicate));
/* cdmgr.c */
Term STD_PROTO(all_calls,(void));
void STD_PROTO(mark_as_fast,(Term));
void STD_PROTO(IPred,(CODEADDR sp));
Int STD_PROTO(PredForCode,(CODEADDR, Atom *, Int *, SMALLUNSGN *));
@ -187,15 +188,13 @@ int STD_PROTO(DebugGetc,(void));
#endif
int STD_PROTO(IsOpType,(char *));
void STD_PROTO(InitStacks,(int,int,int,int,int,int));
void STD_PROTO(InitCPred,(char *, int, CPredicate, int));
void STD_PROTO(InitAsmPred,(char *, int, int, CPredicate, int));
void STD_PROTO(InitCmpPred,(char *, int, CmpPredicate, CPredicate, int));
void STD_PROTO(InitCPredBack,(char *, int, int, CPredicate,CPredicate,int));
void STD_PROTO(InitCPred,(char *, unsigned long int, CPredicate, int));
void STD_PROTO(InitAsmPred,(char *, unsigned long int, int, CPredicate, int));
void STD_PROTO(InitCmpPred,(char *, unsigned long int, CmpPredicate, CPredicate, int));
void STD_PROTO(InitCPredBack,(char *, unsigned long int, unsigned int, CPredicate,CPredicate,int));
void STD_PROTO(InitYaamRegs,(void));
void STD_PROTO(ReInitWallTime, (void));
int STD_PROTO(OpDec,(int,char *,Atom));
void STD_PROTO(UserCPredicate,(char *,CPredicate,unsigned int));
void STD_PROTO(UserBackCPredicate,(char*,CPredicate,CPredicate,unsigned int,int));
/* iopreds.c */
void STD_PROTO(CloseStreams,(int));

84
console/yap.c
View File

@ -17,7 +17,7 @@
/* static char SccsId[] = "X 4.3.3"; */
#include "config.h"
#include "c_interface.h"
#include "YapInterface.h"
#if (DefTrailSpace < MinTrailSpace)
#undef DefTrailSpace
@ -66,7 +66,7 @@
static int PROTO(mygetc, (void));
static void PROTO(do_bootfile, (char *));
static void PROTO(do_top_goal,(Term));
static void PROTO(do_top_goal,(YAP_Term));
static void PROTO(exec_top_level,(int, char *));
#ifndef LIGHT
@ -127,25 +127,25 @@ mygetc (void)
}
static void
do_top_goal (Term Goal)
do_top_goal (YAP_Term Goal)
{
#ifdef DEBUG
if (output_msg)
fprintf(stderr,"Entering absmi\n");
#endif
/* PlPutc(0,'a'); PlPutc(0,'\n'); */
YapRunGoal(Goal);
YAP_RunGoal(Goal);
}
/* do initial boot by consulting the file boot.yap */
static void
do_bootfile (char *bootfilename)
{
Term t;
Term term_nil = MkAtomTerm(YapLookupAtom("[]"));
Term term_end_of_file = MkAtomTerm(YapLookupAtom("end_of_file"));
Term term_true = MkAtomTerm(YapLookupAtom("true"));
Functor functor_query = MkFunctor(YapLookupAtom("?-"),1);
YAP_Term t;
YAP_Term term_nil = YAP_MkAtomTerm(YAP_LookupAtom("[]"));
YAP_Term term_end_of_file = YAP_MkAtomTerm(YAP_LookupAtom("end_of_file"));
YAP_Term term_true = YAP_MkAtomTerm(YAP_LookupAtom("true"));
YAP_Functor functor_query = YAP_MkFunctor(YAP_LookupAtom("?-"),1);
fprintf(stderr,"Entering Yap\n");
@ -158,13 +158,13 @@ do_bootfile (char *bootfilename)
}
/* the consult mode does not matter here, really */
/*
To be honest, YapInitConsult does not really do much,
To be honest, YAP_InitConsult does not really do much,
it's here for the future. It also makes what we want to do clearer.
*/
YapInitConsult(YAP_CONSULT_MODE,bootfilename);
YAP_InitConsult(YAP_CONSULT_MODE,bootfilename);
while (!eof_found)
{
t = YapRead(mygetc);
t = YAP_Read(mygetc);
if (eof_found) {
break;
}
@ -173,37 +173,37 @@ do_bootfile (char *bootfilename)
fprintf(stderr, "[ SYNTAX ERROR: while parsing bootfile %s at line %d ]\n", bootfilename, yap_lineno);
exit(1);
}
if (IsVarTerm (t) || t == term_nil)
if (YAP_IsVarTerm (t) || t == term_nil)
{
continue;
}
else if (t == term_true)
{
YapExit(0);
YAP_Exit(0);
}
else if (t == term_end_of_file)
{
break;
}
else if (IsPairTerm (t))
else if (YAP_IsPairTerm (t))
{
fprintf(stderr, "[ SYSTEM ERROR: consult not allowed in boot file ]\n");
fprintf(stderr, "error found at line %d and pos %d", yap_lineno, fseek(bootfile,0L,SEEK_CUR));
}
else if (IsApplTerm (t) && FunctorOfTerm (t) == functor_query)
else if (YAP_IsApplTerm (t) && YAP_FunctorOfTerm (t) == functor_query)
{
do_top_goal(ArgOfTerm (1, t));
do_top_goal(YAP_ArgOfTerm (1, t));
}
else
{
char *ErrorMessage = YapCompileClause(t);
char *ErrorMessage = YAP_CompileClause(t);
if (ErrorMessage)
fprintf(stderr, ErrorMessage);
}
/* do backtrack */
YapReset();
YAP_Reset();
}
YapEndConsult();
YAP_EndConsult();
fclose (bootfile);
#ifdef DEBUG
if (output_msg)
@ -215,7 +215,7 @@ static char *filename;
static void
print_usage(const yap_init_args *init_args)
print_usage(const YAP_init_args *init_args)
{
fprintf(stderr,"\n[ Valid switches for command line arguments: ]\n");
fprintf(stderr," -? Shows this screen\n");
@ -246,7 +246,7 @@ print_usage(const yap_init_args *init_args)
*/
static int
parse_yap_arguments(int argc, char *argv[], yap_init_args *init_args)
parse_yap_arguments(int argc, char *argv[], YAP_init_args *init_args)
{
char *p;
int BootMode = YAP_BOOT_FROM_SAVED_CODE;
@ -280,15 +280,15 @@ parse_yap_arguments(int argc, char *argv[], yap_init_args *init_args)
host = *++argv;
argc--;
if (host != NULL && host[0] == '-')
YapError("sockets must receive host to connect to");
YAP_Error("sockets must receive host to connect to");
p1 = *++argv;
argc--;
if (p1[0] == '-')
YapError("sockets must receive port to connect to");
YAP_Error("sockets must receive port to connect to");
port = strtol(p1, &ptr, 10);
if (ptr == NULL || ptr[0] != '\0')
YapError("port argument to socket must be a number");
YapInitSocks(host,port);
YAP_Error("port argument to socket must be a number");
YAP_InitSocks(host,port);
}
break;
#endif
@ -355,14 +355,14 @@ parse_yap_arguments(int argc, char *argv[], yap_init_args *init_args)
if (ch)
{
fprintf(stderr,"[ YAP unrecoverable error: illegal size specification %s ]", argv[-1]);
YapExit(1);
YAP_Exit(1);
}
*ssize = i;
}
break;
#ifdef DEBUG
case 'p':
YapSetOutputMessage();
YAP_SetOutputMessage();
output_msg = TRUE;
break;
#endif
@ -420,7 +420,7 @@ static int
init_standard_system(int argc, char *argv[])
{
int BootMode;
yap_init_args init_args;
YAP_init_args init_args;
init_args.SavedState = NULL;
init_args.HeapSize = 0;
@ -442,7 +442,7 @@ init_standard_system(int argc, char *argv[])
if (BootMode == YAP_BOOT_FROM_PROLOG)
{
YapInit(&init_args);
YAP_Init(&init_args);
}
else
@ -452,7 +452,7 @@ init_standard_system(int argc, char *argv[])
else
init_args.SavedState = filename;
BootMode = YapInit(&init_args);
BootMode = YAP_Init(&init_args);
}
@ -464,34 +464,34 @@ init_standard_system(int argc, char *argv[])
static void
exec_top_level(int BootMode, char *filename)
{
Term atomfalse;
Atom livegoal;
YAP_Term atomfalse;
YAP_Atom livegoal;
if (BootMode == YAP_BOOT_FROM_SAVED_STACKS)
{
/* continue executing from the frozen stacks */
YapContinueGoal();
YAP_ContinueGoal();
}
else if (BootMode == YAP_BOOT_FROM_PROLOG)
{
Atom livegoal;
YAP_Atom livegoal;
/* read the bootfile */
do_bootfile (filename ? filename : BootFile);
livegoal = FullLookupAtom("$live");
livegoal = YAP_FullLookupAtom("$live");
/* initialise the top-level */
YapPutValue(livegoal, MkAtomTerm (LookupAtom("true")));
YAP_PutValue(livegoal, YAP_MkAtomTerm (YAP_LookupAtom("true")));
}
/* the top-level is now ready */
/* read it before case someone, that is, Ashwin, hides
the atom false away ;-).
*/
livegoal = FullLookupAtom("$live");
atomfalse = MkAtomTerm (LookupAtom("false"));
while (YapGetValue (livegoal) != atomfalse) {
do_top_goal (MkAtomTerm (livegoal));
livegoal = YAP_FullLookupAtom("$live");
atomfalse = YAP_MkAtomTerm (YAP_LookupAtom("false"));
while (YAP_GetValue (livegoal) != atomfalse) {
do_top_goal (YAP_MkAtomTerm (livegoal));
}
YapExit(EXIT_SUCCESS);
YAP_Exit(EXIT_SUCCESS);
}
#ifdef LIGHT

391
docs/yap.tex
View File

@ -736,7 +736,7 @@ DLL project, initially empty.
Notice that either the project is named yapdll or you must replace the
preprocessor's variable @var{YAPDLL_EXPORTS} to match your project names
in the files @code{c_interface.h} and @code{c_interface.c}.
in the files @code{YapInterface.h} and @code{c_interface.c}.
@item add all .c files in the @var{$YAPSRC/C} directory and in the
@var{$YAPSRC\OPTYap} directory to the Project's @code{Source Files} (use
@ -5806,7 +5806,7 @@ Notice that we first compile the looping predicate @code{l/0} with
exception when @code{l/0} performs more than 10000 reductions.
@node Arrays, Preds, Profiling , Top
@node Arrays, Preds, Call Countingf , Top
@section Arrays
The YAP system includes experimental support for arrays. The
@ -12465,18 +12465,18 @@ C-code described below.
@example
@cartouche
#include "../c_interface.h"
#include "Yap/YapInterface.h"
static int my_process_id(void)
@{
Term pid = MkIntTerm(getpid());
Term out = ARG1;
return(unify(out,pid));
YAP_Term pid = YAP_MkIntTerm(getpid());
YAP_Term out = YAP_ARG1;
return(YAP_Unify(out,pid));
@}
void init_my_predicates()
@{
UserCPredicate("my_process_id",my_process_id,1);
YAP_UserCPredicate("my_process_id",my_process_id,1);
@}
@end cartouche
@end example
@ -12541,18 +12541,18 @@ desired predicate. Note that it returns an integer denoting the success
of failure of the goal and also that it has no arguments even though the
predicate being defined has one.
In fact the arguments of a prolog predicate written in C are accessed
through macros, defined in the include file, with names @var{ARG1},
@var{ARG2}, ..., @var{ARG16} or with @var{ARG}(@var{N}) where @var{N} is
the argument number (starting with 1). In the present case the function
uses just one local variable of type @code{ Term}, the type used for
holding Yap terms, where the integer returned by the standard unix
function @code{getpid()} is stored as an integer term (the conversion is
done by @code{MkIntTerm(Int))}. Then it calls the pre-defined routine
@code{unify(Term*, Term*)} which in turn returns an integer denoting
success or failure of the unification.
through macros, defined in the include file, with names @var{YAP_ARG1},
@var{YAP_ARG2}, ..., @var{YAP_ARG16} or with @var{YAP_A}(@var{N})
where @var{N} is the argument number (starting with 1). In the present
case the function uses just one local variable of type @code{YAP_Term}, the
type used for holding Yap terms, where the integer returned by the
standard unix function @code{getpid()} is stored as an integer term (the
conversion is done by @code{YAP_MkIntTerm(Int))}. Then it calls the
pre-defined routine @code{YAP_Unify(YAP_Term, YAP_Term)} which in turn returns an
integer denoting success or failure of the unification.
The role of the procedure @code{init_my_predicates} is to make known to
YAP, by calling @code{UserCPredicate}, the predicates being
YAP, by calling @code{YAP_UserCPredicate}, the predicates being
defined in the file. This is in fact why, in the example above,
@code{init_my_predicates} was passed as the third argument to
@code{load_foreign_files}.
@ -12578,14 +12578,14 @@ The rest of this appendix describes exhaustively how to interface C to YAP.
This section provides information about the primitives available to the C
programmer for manipulating prolog terms.
Several C typedefs are included in the header file @code{yap/c_interface.h} to
Several C typedefs are included in the header file @code{yap/YapInterface.h} to
describe, in a portable way, the C representation of prolog terms.
The user should write is programs using this macros to ensure portability of
code across different versions of YAP.
The more important typedef is @var{Term} which is used to denote the type of a
prolog term.
The more important typedef is @var{YAP_Term} which is used to denote the
type of a prolog term.
Terms, from a point of view of the C-programmer, can be classified as
follows
@ -12600,24 +12600,17 @@ follows
@item compound terms
@end table
Before trying to find out the kind of a term, the C-programmer should insure
it is not an instantiated variable using the interface primitive
@findex YAP_IsVarTerm (C-Interface function)
The primitive
@example
Term Deref(Term)
@end example
@noindent
which follows a possibly empty chain of instantiations and returns a term which
is not an instantiated variable.
Having done so, the primitive
@example
Bool IsVarTerm(Term)
YAP_Bool YAP_IsVarTerm(YAP_Term @var{t})
@end example
@noindent
@findex YAP_IsNonVarTerm (C-Interface function)
returns true iff its argument is an uninstantiated variable. Conversely the
primitive
@example
Bool IsGroundTerm(Term)
YAP_Bool YAP_NonVarTerm(YAP_Term @var{t})
@end example
@noindent
returns true iff its argument is not a variable.
@ -12625,133 +12618,184 @@ returns true iff its argument is not a variable.
The user can create a new uninstantiated variable using the primitive
@example
Term MkVarTerm()
Term YAP_MkVarTerm()
@end example
The following primitives can be used to discriminate among the different kinds
@findex YAP_IsIntTerm (C-Interface function)
@findex YAP_IsFloatTerm (C-Interface function)
@findex YAP_IsDBRefTerm (C-Interface function)
@findex YAP_IsAtomTerm (C-Interface function)
@findex YAP_IsPairTerm (C-Interface function)
@findex YAP_IsApplTerm (C-Interface function)
The following primitives can be used to discriminate among the different types
of non-variable terms:
@example
Bool IsIntTerm(Term)
Bool IsFloatTerm(Term)
Bool IsDbRefTerm(Term)
Bool IsAtomTerm(Term)
Bool IsPairTerm(Term)
Bool IsApplTerm(Term)
YAP_Bool YAP_IsIntTerm(YAP_Term @var{t})
YAP_Bool YAP_IsFloatTerm(YAP_Term @var{t})
YAP_Bool YAP_IsDbRefTerm(YAP_Term @var{t})
YAP_Bool YAP_IsAtomTerm(YAP_Term @var{t})
YAP_Bool YAP_IsPairTerm(YAP_Term @var{t})
YAP_Bool YAP_IsApplTerm(YAP_Term @var{t})
@end example
@noindent
@strong{Important Note:} when used on variables the primitives above
will return an unpredictable result.
Next, we mention the primitives that allow one to destruct and construct
terms. All the above primitives ensure that their result is
@i{dereferenced}, i.e. that it is not a pointer to another term.
@findex YAP_MkIntTerm (C-Interface function)
@findex YAP_IntOfTerm (C-Interface function)
The following primitives are provided for creating an integer term from an
integer and to access the value of an integer term.
@example
Term MkIntTerm(Int)
Int IntOfTerm(Term)
YAP_Term YAP_MkIntTerm(YAP_Int @var{i})
YAP_Int YAP_IntOfTerm(YAP_YAP_Term @var{t})
@end example
@noindent
where @code{Int} is a typedef for the C integer type appropriate for the
machine or compiler in question (normally a 32 bit integer). Note that
the size of the allowed integers is implementation dependent but is always
greater or equal to 24 bits.
where @code{YAP_Int} is a typedef for the C integer type appropriate for
the machine or compiler in question (normally a long integer). The size
of the allowed integers is implementation dependent but is always
greater or equal to 24 bits: usually 32 bits on 32 bit machines, and 64
on 64 bit machines.
@findex YAP_MkFloatTerm (C-Interface function)
@findex YAP_FloatOfTerm (C-Interface function)
The two following primitives play a similar role for floating-point terms
@example
Term MkFloatTerm(flt)
flt FloatOfTerm(Term)
YAP_Term YAP_MkFloatTerm(YAP_flt @var{double})
YAP_flt YAP_FloatOfTerm(YAP_YAP_Term @var{t})
@end example
@noindent
where @code{flt} is a typedef for the appropriate C floating point type.
where @code{flt} is a typedef for the appropriate C floating point type,
nowadays a @code{double}
No primitives are supplied to users for manipulating data base
Currently, no primitives are supplied to users for manipulating data base
references.
A special typedef @code{Atom} is provided to describe prolog @i{atoms} and the
two following primitives can be used to manipulate atom terms
@findex YAP_MkAtomTerm (C-Interface function)
@findex YAP_AtomOfTerm (C-Interface function)
A special typedef @code{YAP_Atom} is provided to describe prolog
@i{atoms} (symbolic constants). The two following primitives can be used
to manipulate atom terms
@example
Term MkAtomTerm(Atom)
Atom AtomOfTerm(Term)
YAP_Term YAP_MkAtomTerm(YAP_Atom at)
YAP_Atom YAP_AtomOfTerm(YAP_YAP_Term @var{t})
@end example
@noindent
The two following primitives are available for associating atoms with their
@findex YAP_LookupAtom (C-Interface function)
@findex YAP_FullLookupAtom (C-Interface function)
@findex YAP_AtomName (C-Interface function)
The following primitives are available for associating atoms with their
names
@example
Atom LookupAtom(char *)
Atom FullLookupAtom(char *)
char* AtomName(Atom)
YAP_Atom YAP_LookupAtom(char * @var{s})
YAP_Atom YAP_FullLookupAtom(char * @var{s})
char *YAP_AtomName(YAP_Atom @var{t})
@end example
The function @code{LookupAtom} looks up an atom in the standard hash
table. The function @code{FullLookupAtom} will also search if the atom
had been "hidden".
The function @code{YAP_LookupAtom} looks up an atom in the standard hash
table. The function @code{YAP_FullLookupAtom} will also search if the
atom had been "hidden": this is useful for system maintenance from C
code. The functor @code{YAP_AtomName} returns a pointer to the string
for the atom.
A @i{pair} is a Prolog term which consists of a pair of prolog terms designated
as the @i{head} and the @i{tail} of the term. The following primitives can
be used to manipulate pairs
@findex YAP_MkPairTerm (C-Interface function)
@findex YAP_MkNewPairTerm (C-Interface function)
@findex YAP_HeadOfTerm (C-Interface function)
@findex YAP_TailOfTerm (C-Interface function)
A @i{pair} is a Prolog term which consists of a tuple of two prolog
terms designated as the @i{head} and the @i{tail} of the term. Pairs are
most often used to build @emph{lists}. The following primitives can be
used to manipulate pairs:
@example
Term MkPairTerm(Term Head, Term Tail)
Term HeadOfTerm(Term)
Term TailOfTerm(Term)
YAP_Term YAP_MkPairTerm(YAP_Term @var{Head}, YAP_Term @var{Tail})
YAP_Term YAP_MkNewPairTerm(void)
YAP_Term YAP_HeadOfTerm(YAP_Term @var{t})
YAP_Term YAP_TailOfTerm(YAP_Term @var{t})
@end example
One can construct a new pair from two terms, or one can just build a
pair whose head and tail are new unbound variables. Finally, one can
fetch the head or the tail.
@findex YAP_MkApplTerm (C-Interface function)
@findex YAP_MkNewApplTerm (C-Interface function)
@findex YAP_ArgOfTerm (C-Interface function)
@findex YAP_FunctorOfTerm (C-Interface function)
A @i{compound} term consists of a @i{functor} and a sequence of terms with
length equal to the @i{arity} of the functor. A functor, described in C by
the typedef @code{Functor}, consists of an atom and of an integer.
The following primitives were designed to manipulate compound terms and
functors
@example
Term MkApplTerm(Functor f, int n, Term[] args)
Functor FunctorOfTerm(Term)
Term ArgOfTerm(int argno,Term t)
Functor MkFunctor(Atom a,int arity)
Atom NameOfFunctor(Functor)
Int ArityOfFunctor(Functor)
YAP_Term YAP_MkApplTerm(YAP_Functor @var{f}, unsigned long int @var{n}, YAP_Term[] @var{args})
YAP_Term YAP_MkNewApplTerm(YAP_Functor @var{f}, int @var{n})
YAP_Term YAP_ArgOfTerm(int argno,YAP_Term @var{ts})
YAP_Functor YAP_FunctorOfTerm(YAP_YAP_Term @var{ts})
@end example
@noindent
where @code{args} should be an array of @code{n} terms with @code{n} equal to the
arity of the functor, and @code{argno} should be greater or equal to 1 and less
or equal to the arity of the functor.
The @code{YAP_MkApplTerm} function constructs a new term, with functor
@var{f} (of arity @var{n}), and using an array @var{args} of @var{n}
terms with @var{n} equal to the arity of the
functor. @code{YAP_MkNewApplTerm} builds up a compound term whose
arguments are unbound variables. @code{YAP_ArgOfTerm} gives an argument
to a compound term. @code{argno} should be greater or equal to 1 and
less or equal to the arity of the functor.
@strong{Note:} all the above primitives returning terms ensure that the
result is @i{dereferenced}, i.e. that it is not an instantiated variable.
YAP allows one to manipulate the functors of compound term. The function
@code{YAP_FunctorOfTerm} allows one to obtain a variable of type
@code{YAP_Functor} with the functor to a term. The following functions
then allow one to construct functors, and to obtain their name and arity.
@findex YAP_MkFunctor (C-Interface function)
@findex YAP_NameOfFunctor (C-Interface function)
@findex YAP_ArityOfFunctor (C-Interface function)
@example
YAP_Functor YAP_MkFunctor(YAP_Atom @var{a},unsigned long int @var{arity})
YAP_Atom YAP_NameOfFunctor(YAP_Functor @var{f})
YAP_Int YAP_ArityOfFunctor(YAP_Functor @var{f})
@end example
@noindent
Note that the functor is essencially a pair formed by an atom, and
arity.
@node Unifying Terms, Manipulating Strings, Manipulating Terms, C-Interface
@section Unification
The following routine is provided for attempting the unification of two
prolog terms
@findex YAP_Unify (C-Interface function)
YAP provides a single routine to attempt the unification of two prolog
terms. The routine may succeed or fail:
@example
Int unify(Term a, Term b)
Int YAP_Unify(YAP_Term @var{a}, YAP_Term @var{b})
@end example
@noindent
which attempts to unify the terms pointed to by @code{a} and @code{b} returning
a non-zero value if the unification succeeds and zero otherwise.
The routine attempts to unify the terms @var{a} and
@var{b} returning @code{TRUE} if the unification succeeds and @code{FALSE}
otherwise.
@node Manipulating Strings, Memory Allocation, Unifying Terms, C-Interface
@section Strings
@findex YAP_StringToBuffer (C-Interface function)
The YAP C-interface now includes an utility routine to copy a string
represented as a list of a character codes to a previously allocated buffer
@example
int StringToBuffer(Term String, char *buf, unsigned int bufsize)
int YAP_StringToBuffer(YAP_Term @var{String}, char *@var{buf}, unsigned int @var{bufsize})
@end example
@noindent
The routine copies the list of character codes @code{String} to a
previously allocated buffer @code{buf}. The string including a
terminating null character must fit in @code{bufsize} characters,
otherwise the routine will simply fail. The @code{StringToBuffer}
routine fails and generates an exception if @code{String} is not a valid
string.
The routine copies the list of character codes @var{String} to a
previously allocated buffer @var{buf}. The string including a
terminating null character must fit in @var{bufsize} characters,
otherwise the routine will simply fail. The @var{StringToBuffer} routine
fails and generates an exception if @var{String} is not a valid string.
@findex YAP_BufferToString (C-Interface function)
@findex YAP_BufferToAtomList (C-Interface function)
The C-interface also includes utility routines to do the reverse, that
is, to copy a from a buffer to a list of character codes or to a list of
character atomsr
@example
Term BufferToString(char *buf)
Term BufferToAtomList(char *buf)
YAP_Term YAP_BufferToString(char *@var{buf})
YAP_Term YAP_BufferToAtomList(char *@var{buf})
@end example
@noindent
The user-provided string must include a terminating null character.
@ -12759,17 +12803,20 @@ The user-provided string must include a terminating null character.
@node Memory Allocation, Controlling Streams, Manipulating Strings, C-Interface
@section Memory Allocation
@findex YAP_AllocSpaceFromYap (C-Interface function)
The next routine can be used to ask space from the Prolog data-base:
@example
void *AllocSpaceFromYap(int size)
void *YAP_AllocSpaceFromYap(int @var{size})
@end example
@noindent
The routine returns a pointer to a buffer allocated from the code area,
or @code{NULL} if no space was available.
or @code{NULL} if sufficient space was not available.
This Space can be released by using:
@findex YAP_FreeSpaceFromYap (C-Interface function)
The space allocated with @code{YAP_AllocSpaceFromYap} can be released
back to Yap by using:
@example
void FreeSpaceFromYap(void *buf)
void YAP_FreeSpaceFromYap(void *@var{buf})
@end example
@noindent
The routine releases a buffer allocated from the code area. The system
@ -12779,11 +12826,12 @@ area.
@node Controlling Streams, Calling Yap From C, Memory Allocation, C-Interface
@section Controlling Yap Streams from @code{C}
@findex YAP_StreamToFileNo (C-Interface function)
The C-Interface also provides the C-application with a measure of
control over the Yap Input/Output system. The first routine allows one
to find a file number given a current stream:
@example
int YapStreamToFileNo(Term stream)
int YAP_StreamToFileNo(YAP_Term @var{stream})
@end example
@noindent
This function gives the file descriptor for a currently available
@ -12793,41 +12841,45 @@ negative. Moreover, Yap will not be aware of any direct operations on
this stream, so information on, say, current stream position, may become
stale.
@findex YAP_CloseAllOpenStreams (C-Interface function)
A second routine that is sometimes useful is:
@example
void YapCloseAllOpenStreams(void)
void YAP_CloseAllOpenStreams(void)
@end example
@noindent
This routine closes the Yap Input/Output system except for the first
three streams, that are always associated with the three standard Unix
streams. It is most useful if you are doing @code{fork()}.
@findex YAP_OpenStream (C-Interface function)
The next routine allows a currently open file to become a stream. The
routine receives as arguments a file descriptor, the true file name as a
string, an atom with the yser name, and a set of flags:
@example
void YapOpenStream(void *FD, char *true, Term t, int flags)
void YAP_OpenStream(void *@var{FD}, char *@var{name}, YAP_Term @var{t}, int @var{flags})
@end example
@noindent
The available flags are @code{YAP_INPUT_STREAM},
@code{YAP_OUTPUT_STREAM}, @code{YAP_APPEND_STREAM},
@code{YAP_PIPE_STREAM}, @code{YAP_TTY_STREAM}, @code{YAP_POPEN_STREAM},
@code{YAP_BINARY_STREAM}, and @code{YAP_SEEKABLE_STREAM}. By default, the
stream is supposed to be at position 0.
stream is supposed to be at position 0. The argument @var{name} gives
the name by which YAP should know the new stream.
@node Calling Yap From C, Writing C, Controlling Streams, C-Interface
@section From @code{C} back to Prolog
@findex YAP_CallProlog (C-Interface function)
Newer versions of YAP allow for calling the Prolog interpreter from
@code{C}. One must first construct a goal @code{G}, and then it is
sufficient to perform:
@example
Int YapCallProlog(Term G)
YAP_Bool YapCallProlog(YAP_Term @var{G})
@end example
@noindent
the result will be @code{0}, if the goal failed, or @code{1}, if the
goal succeeded. In this case, the variables in @var{G} will store the
values they have been unified with. Execution only proceeds until
the result will be @code{FALSE}, if the goal failed, or @code{TRUE}, if
the goal succeeded. In this case, the variables in @var{G} will store
the values they have been unified with. Execution only proceeds until
finding the first solution to the goal, but you can call
@code{findall/3} or friends if you need all the solutions.
@ -12842,17 +12894,23 @@ backtrackable, like the one in the introduction;
predicates which can succeed more than once.
@end table
@findex YAP_UserCPredicate (C-Interface function)
The first kind of predicates should be implemented as a C function with
no arguments which should return zero if the predicate fails and a
non-zero value otherwise. The predicate should be declared to
YAP, in the initialization routine, with a call to
@example
void UserCPredicate(char *name, int *fn(), int arity);
void YAP_UserCPredicate(char *@var{name}, YAP_Bool *@var{fn}(), unsigned long int @var{arity});
@end example
@noindent
where @code{name} is the name of the predicate, @code{fn} is the C function
implementing the predicate and @code{arity} is its arity.
where @var{name} is the name of the predicate, @var{fn} is the C function
implementing the predicate and @var{arity} is its arity.
@findex YAP_UserBackCPredicate (C-Interface function)
@findex YAP_PRESERVE_DATA (C-Interface function)
@findex YAP_PRESERVED_DATA (C-Interface function)
@findex YAP_cutsucceed (C-Interface function)
@findex YAP_cutfail (C-Interface function)
For the second kind of predicates we need two C functions. The first one
which is called when the predicate is first activated, and the second one
to be called on backtracking to provide (possibly) other solutions. Note
@ -12883,7 +12941,7 @@ and a pointer variable to a structure of that type.
@example
typedef struct @{
Term next_solution; /* the next solution */
YAP_Term next_solution; /* the next solution */
@} n100_data_type;
n100_data_type *n100_data;
@ -12894,25 +12952,27 @@ We now write the @code{C} function to handle the first call:
@example
static int start_n100()
@{
Term t = ARG1;
PRESERVE_DATA(n100_data,n100_data_type);
if(IsVarTerm(t)) @{
n100_data->next_solution = MkIntTerm(0);
YAP_Term t = ARG1;
YAP_PRESERVE_DATA(n100_data,n100_data_type);
if(YAP_IsVarTerm(t)) @{
n100_data->next_solution = YAP_MkIntTerm(0);
return(continue_n100());
@}
if(!IsIntTerm(t) || IntOfTerm(t)<0 || IntOfTerm(t)>100) @{
cut_fail();
if(!YAP_IsIntTerm(t) || YAP_IntOfTerm(t)<0 || YAP_IntOfTerm(t)>100) @{
YAP_cut_fail();
@} else @{
cut_succeed();
YAP_cut_succeed();
@}
@}
@end example
The routine starts by getting the dereference value of the argument.
The call to @code{PRESERVE_DATA} is used to initialize the memory which will
The call to @code{YAP_PRESERVE_DATA} is used to initialize the memory which will
hold the information to be preserved across backtracking. The first
argument is the variable we shall use, and the second its type.
argument is the variable we shall use, and the second its type. Note
that we can only use @code{YAP_PRESERVE_DATA} once, so often we will
want the variable to be a structure.
If the argument of the predicate is a variable, the routine initializes the
structure to be preserved across backtracking with the information
@ -12921,13 +12981,14 @@ continue_n100} to provide that solution.
If the argument was not a variable, the routine then checks if it was
an integer, and if so, if its value is positive and less than 100. In that case
it exits, denoting success, with @code{cut_succeed}, or otherwise exits with
@code{cut_fail} denoting failure.
it exits, denoting success, with @code{YAP_cut_succeed}, or otherwise exits with
@code{YAP_cut_fail} denoting failure.
The reason for using for using the macros @code{cut_succeed} and @code{cut_fail}
instead of just returning a non-zero value in the first case, and zero in the
second case, is that otherwise, if backtracking occurred later, the routine
@code{continue_n100} would be called to provide additional solutions.
The reason for using for using the functions @code{YAP_cut_succeed} and
@code{YAP_cut_fail} instead of just returning a non-zero value in the
first case, and zero in the second case, is that otherwise, if
backtracking occurred later, the routine @code{continue_n100} would be
called to provide additional solutions.
The code required for the second function is
@example
@ -12936,46 +12997,47 @@ static int continue_n100()
int n;
Term t;
Term sol = ARG1;
PRESERVED_DATA(n100_data,n100_data_type);
n = IntOfTerm(n100_data->next_solution);
YAP_PRESERVED_DATA(n100_data,n100_data_type);
n = YAP_IntOfTerm(n100_data->next_solution);
if( n == 100) @{
t = MkIntTerm(n);
unify(&sol,&t);
cut_succeed();
t = YAP_MkIntTerm(n);
YAP_Unify(&sol,&t);
YAP_cut_succeed();
@}
else @{
unify(&sol,&(n100_data->next_solution));
n100_data->next_solution = MkIntTerm(n+1);
return(1);
YAP_Unify(&sol,&(n100_data->next_solution));
n100_data->next_solution = YAP_MkIntTerm(n+1);
return(TRUE);
@}
@}
@end example
Note that again the macro @code{PRESERVED_DATA} is used at the beginning of
the function to access the data preserved from the previous solution.
Then it checks if the last solution was found and in that case exits
with @code{cut_succeed} in order to cut any further backtracking. If this
is not the last solution then we save the value for the next solution in
the data structure and exit normally with 1 denoting success. Note also
that in any of the two cases we use the function @code{unify} to bind the
argument of the call to the value saved in @code{
n100_state->next_solution}.
Note that again the macro @code{YAP_PRESERVED_DATA} is used at the
beginning of the function to access the data preserved from the previous
solution. Then it checks if the last solution was found and in that
case exits with @code{YAP_cut_succeed} in order to cut any further
backtracking. If this is not the last solution then we save the value
for the next solution in the data structure and exit normally with 1
denoting success. Note also that in any of the two cases we use the
function @code{YAP_nify} to bind the argument of the call to the value
saved in @code{ n100_state->next_solution}.
Note also that the only correct way to signal failure in a backtrackable
predicate is to use the @code{cut_fail} macro.
predicate is to use the @code{YAP_cut_fail} macro.
Backtrackable predicates should be declared to YAP, in a way
similar to what happened with deterministic ones, but using instead a
call to
@example
void UserBackCPredicate(char *name,
int *init(), int *cont(), int arity, int sizeof);
void YAP_UserBackCPredicate(char *@var{name},
int *@var{init}(), int *@var{cont}(),
unsigned long int @var{arity}, unsigned int @var{sizeof});
@end example
@noindent
where @code{name} is a string with the name of the predicate, @code{init} and
@code{cont} are the C functions used to start and continue the execution of
the predicate, @code{arity} is the predicate arity, and @code{sizeof} is
where @var{name} is a string with the name of the predicate, @var{init} and
@var{cont} are the C functions used to start and continue the execution of
the predicate, @var{arity} is the predicate arity, and @var{sizeof} is
the size of the data to be preserved in the stack.
@node Loading Objects, Sav&Rest, Writing C, C-Interface
@ -13022,13 +13084,18 @@ Yap4 includes several changes over the previous @code{load_foreign_files}
interface. These changes were required to support the new binary code
formats, such as ELF used in Solaris2 and Linux.
@itemize @bullet
@item All Names of YAP objects now start with @var{YAP_}. This is
designed to avoid clashes with other code. Use @code{YapInterface.h} to
take advantage of the new interface. @code{c_interface.h} is still
available if you cannot port the code to the new interface.
@item Access to elements in the new interface always goes through
@emph{functions}. This includes access to the argument registers,
@code{ARG1} to @code{ARG16}. This change breaks code such as
@code{unify(&ARG1,&t)}:
@code{YAP_ARG1} to @code{YAP_ARG16}. This change breaks code such as
@code{unify(&ARG1,&t)}, which is nowadays:
@example
@{
unify(ARG1, t);
YAP_Unify(ARG1, t);
@}
@end example
@ -13065,7 +13132,7 @@ To actually use this library you must follow a five step process:
@enumerate
@item
You must initialise the YAP environment. A single function,
@code{YapFastInit} asks for a contiguous chunk in your memory space, fills
@code{YAP_FastInit} asks for a contiguous chunk in your memory space, fills
it in with the data-base, and sets up YAP's stacks and
execution registers. You can use a saved space from a standard system by
calling @code{save_program/1}.
@ -13074,7 +13141,7 @@ calling @code{save_program/1}.
YAP. A query is a Prolog term, and you just have to use the same
functions that are available in the C-interface.
@item You can then use @code{YapRunGoal(query)} to actually evaluate your
@item You can then use @code{YAP_RunGoal(query)} to actually evaluate your
query. The argument is the query term @code{query}, and the result is 1
if the query succeeded, and 0 if it failed.
@ -13082,7 +13149,7 @@ if the query succeeded, and 0 if it failed.
arguments were instantiated.
@item If you want extra solutions, you can use
@code{YapRestartGoal()} to obtain the next solution.
@code{YAP_RestartGoal()} to obtain the next solution.
@end enumerate
@ -13092,16 +13159,16 @@ program contains two facts for the procedure @t{b}:
@example
@cartouche
#include <stdio.h>
#include "Yap/c_interface.h"
#include "Yap/YapInterface.h"
int
main(int argc, char *argv[]) @{
if (YapFastInit("saved_state") == YAP_BOOT_FROM_SAVED_ERROR)
if (YAP_FastInit("saved_state") == YAP_BOOT_FROM_SAVED_ERROR)
exit(1);
if (YapRunGoal(MkAtomTerm(LookupAtom("do")))) @{
if (YAP_RunGoal(YAP_MkAtomTerm(LookupAtom("do")))) @{
printf("Success\n");
while (YapRestartGoal())
while (YAP_RestartGoal())
printf("Success\n");
@}
printf("NO\n");

836
include/c_interface.h
View File

@ -14,734 +14,294 @@
* *
*************************************************************************/
/******************* IMPORTANT ********************
Due to a limitation of the DecStation loader any function (including
library functions) which is linked to yap can not be called directly
from C code loaded dynamically.
To go around this problem we adopted the solution of calling such
functions indirectly
****************************************************/
#ifndef _c_interface_h
#include "yap_structs.h"
#define _c_interface_h 1
#ifndef _Yap_c_interface_h
#define _Yap_c_interface_h 1
#include "YapInterface.h"
/*
__BEGIN_DECLS should be used at the beginning of the C declarations,
so that C++ compilers don't mangle their names. __END_DECLS is used
at the end of C declarations.
*/
#undef __BEGIN_DECLS
#undef __END_DECLS
#ifdef __cplusplus
# define __BEGIN_DECLS extern "C" {
# define __END_DECLS }
#else
# define __BEGIN_DECLS /* empty */
# define __END_DECLS /* empty */
#define CELL YAP_CELL
#ifndef Bool
#define Bool YAP_Bool
#endif
__BEGIN_DECLS
#define Int long int
#if defined(_MSC_VER) && defined(YAP_EXPORTS)
#define X_API __declspec(dllexport)
#else
#define X_API
#endif
#define flt double
/* Primitive Functions */
#define Term YAP_Term
/* Term Deref(Term) */
extern X_API Term PROTO(YapA,(int));
#ifdef IndirectCalls
static Term (*YapIA)() = YapA;
#define A(I) (*YapIA)(I)
#else
#define A(I) YapA(I)
#endif
#define ARG1 A(1)
#define ARG2 A(2)
#define ARG3 A(3)
#define ARG4 A(4)
#define ARG5 A(5)
#define ARG6 A(6)
#define ARG7 A(7)
#define ARG8 A(8)
#define ARG9 A(9)
#define ARG10 A(10)
#define ARG11 A(11)
#define ARG12 A(12)
#define ARG13 A(13)
#define ARG14 A(14)
#define ARG15 A(15)
#define ARG16 A(16)
#define Functor YAP_Functor
/* Term Deref(Term) */
extern X_API Term PROTO(Deref,(Term));
#ifdef IndirectCalls
static Term (*YapIDeref)() = Deref;
#define Deref(T) (*YapIDeref)(T)
#endif
#define Atom YAP_Atom
/* Bool IsVarTerm(Term) */
extern X_API Bool PROTO(YapIsVarTerm,(Term));
#ifdef IndirectCalls
static Bool (*YapIIsVarTerm)() = YapIsVarTerm;
#define IsVarTerm(T) (*YapIIsVarTerm)(T)
#else
#define IsVarTerm(T) YapIsVarTerm(T)
#endif
#define yap_init_args YAP_init_args
/* Bool IsNonVarTerm(Term) */
extern X_API Bool PROTO(YapIsNonVarTerm,(Term));
#ifdef IndirectCalls
static Bool (*YapIIsNonVarTerm)() = YapIsNonVarTerm;
#define IsNonVarTerm(T) (*YapIIsNonVarTerm)(T)
#else
#define IsNonVarTerm(T) YapIsNonVarTerm(T)
#endif
#define A(X) YAP_A(X)
#define ARG1 YAP_ARG1
#define ARG2 YAP_ARG2
#define ARG3 YAP_ARG3
#define ARG4 YAP_ARG4
#define ARG5 YAP_ARG5
#define ARG6 YAP_ARG6
#define ARG7 YAP_ARG7
#define ARG8 YAP_ARG8
#define ARG9 YAP_ARG9
#define ARG10 YAP_ARG10
#define ARG11 YAP_ARG11
#define ARG12 YAP_ARG12
#define ARG13 YAP_ARG13
#define ARG14 YAP_ARG14
#define ARG15 YAP_ARG15
#define ARG16 YAP_ARG16
/* Term MkVarTerm() */
extern X_API Term PROTO(YapMkVarTerm,(void));
#ifdef IndirectCalls
static Term (*YapIMkVarTerm)() = YapMkVarTerm;
#define MkVarTerm() (*YapIMkVarTerm)()
#else
#define MkVarTerm() YapMkVarTerm()
#endif
/* YAP_Term Deref(YAP_Term) */
#define Deref(t) YAP_Deref(t)
#define YapDeref(t) YAP_Deref(t)
/* Bool IsIntTerm(Term) */
extern X_API Bool PROTO(YapIsIntTerm,(Term));
#ifdef IndirectCalls
static Bool (*YapIIsIntTerm)() = YapIsIntTerm;
#define IsIntTerm(T) (*YapIIsIntTerm)(T)
#else
#define IsIntTerm(T) YapIsIntTerm(T)
#endif
/* YAP_Bool IsVarTerm(YAP_Term) */
#define IsVarTerm(t) YAP_IsVarTerm(t)
#define YapIsVarTerm(t) YAP_IsVarTerm(t)
/* Bool IsFloatTerm(Term) */
extern X_API Bool PROTO(YapIsFloatTerm,(Term));
#ifdef IndirectCalls
static Bool (*YapIIsFloatTerm)() = YapIsFloatTerm;
#define IsFloatTerm(T) (*YapIIsFloatTerm)(T)
#else
#define IsFloatTerm(T) YapIsFloatTerm(T)
#endif
/* YAP_Bool IsNonVarTerm(YAP_Term) */
#define IsNonVarTerm(t) YAP_IsNonVarTerm(t)
#define YapIsNonVarTerm(t) YAP_IsNonVarTerm(t)
/* Bool IsDbRefTerm(Term) */
extern X_API Bool PROTO(YapIsDbRefTerm,(Term));
#ifdef IndirectCalls
static Bool (*YapIIsDbRefTerm)() = YapIsDbRefTerm;
#define IsDbRefTerm(T) (*YapIIsDbRefTerm)(T)
#else
#define IsDbRefTerm(T) YapIsDbRefTerm(T)
#endif
/* YAP_Term MkVarTerm() */
#define MkVarTerm() YAP_MkVarTerm()
#define YapMkVarTerm() YAP_MkVarTerm()
/* Bool IsAtomTerm(Term) */
extern X_API Bool PROTO(YapIsAtomTerm,(Term));
#ifdef IndirectCalls
static Bool (*YapIIsAtomTerm)() = YapIsAtomTerm;
#define IsAtomTerm(T) (*YapIIsAtomTerm)(T)
#else
#define IsAtomTerm(T) YapIsAtomTerm(T)
#endif
/* YAP_Bool IsIntTerm(YAP_Term) */
#define IsIntTerm(t) YAP_IsIntTerm(t)
#define YapIsIntTerm(t) YAP_IsIntTerm(t)
/* Bool IsPairTerm(Term) */
extern X_API Bool PROTO(YapIsPairTerm,(Term));
#ifdef IndirectCalls
static Bool (*YapIIsPairTerm)() = YapIsPairTerm;
#define IsPairTerm(T) (*YapIIsPairTerm)(T)
#else
#define IsPairTerm(T) YapIsPairTerm(T)
#endif
/* YAP_Bool IsFloatTerm(YAP_Term) */
#define IsFloatTerm(t) YAP_IsFloatTerm(t)
#define YapIsFloatTerm(t) YAP_IsFloatTerm(t)
/* Bool IsApplTerm(Term) */
extern X_API Bool PROTO(YapIsApplTerm,(Term));
#ifdef IndirectCalls
static Bool (*YapIIsApplTerm)() = YapIsApplTerm;
#define IsApplTerm(T) (*YapIIsApplTerm)(T)
#else
#define IsApplTerm(T) YapIsApplTerm(T)
#endif
/* YAP_Bool IsDbRefTerm(YAP_Term) */
#define IsDbRefTerm(t) YAP_IsDbRefTerm(t)
#define YapIsDbRefTerm(t) YAP_IsDbRefTerm(t)
/* Term MkIntTerm(Int) */
extern X_API Term PROTO(YapMkIntTerm,(Int));
#ifdef IndirectCalls
static Term (*YapIMkIntTerm)() = YapMkIntTerm;
#define MkIntTerm(T) (*YapIMkIntTerm)(T)
#else
#define MkIntTerm(T) YapMkIntTerm(T)
#endif
/* YAP_Bool IsAtomTerm(YAP_Term) */
#define IsAtomTerm(t) YAP_IsAtomTerm(t)
#define YapIsAtomTerm(t) YAP_IsAtomTerm(t)
/* Int IntOfTerm(Term) */
extern X_API Int PROTO(YapIntOfTerm,(Term));
#ifdef IndirectCalls
static Int (*YapIIntOfTerm)() = YapIntOfTerm;
#define IntOfTerm(T) (*YapIIntOfTerm)(T)
#else
#define IntOfTerm(T) YapIntOfTerm(T)
#endif
/* YAP_Bool IsPairTerm(YAP_Term) */
#define IsPairTerm(t) YAP_IsPairTerm(t)
#define YapIsPairTerm(t) YAP_IsPairTerm(t)
/* Term MkFloatTerm(flt) */
extern X_API Term PROTO(YapMkFloatTerm,(flt));
#ifdef IndirectCalls
static Term (*YapIMkFloatTerm)() = YapMkFloatTerm;
#define MkFloatTerm(T) (*YapIMkFloatTerm)(T)
#else
#define MkFloatTerm(T) YapMkFloatTerm(T)
#endif
/* YAP_Bool IsApplTerm(YAP_Term) */
#define IsApplTerm(t) YAP_IsApplTerm(t)
#define YapIsApplTerm(t) YAP_IsApplTerm(t)
/* flt FloatOfTerm(Term) */
extern X_API flt PROTO(YapFloatOfTerm,(Term));
#ifdef IndirectCalls
static flt (*YapIFloatOfTerm)() = YapFloatOfTerm;
#define FloatOfTerm(T) (*YapIFloatOfTerm)(T)
#else
#define FloatOfTerm(T) YapFloatOfTerm(T)
#endif
/* Term MkIntTerm(YAP_Int) */
#define MkIntTerm(t) YAP_MkIntTerm(t)
#define YapMkIntTerm(t) YAP_MkIntTerm(t)
/* YAP_Int IntOfTerm(Term) */
#define IntOfTerm(t) YAP_IntOfTerm(t)
#define YapIntOfTerm(t) YAP_IntOfTerm(t)
/* Term MkFloatTerm(YAP_flt) */
#define MkFloatTerm(f) YAP_MkFloatTerm(f)
#define YapMkFloatTerm(f) YAP_MkFloatTerm(f)
/* YAP_flt FloatOfTerm(YAP_Term) */
#define FloatOfTerm(t) YAP_FloatOfTerm(t)
#define YapFloatOfTerm(t) YAP_FloatOfTerm(t)
/* Term MkAtomTerm(Atom) */
extern X_API Term PROTO(YapMkAtomTerm,(Atom));
#ifdef IndirectCalls
static Term (*YapIMkAtomTerm)() = YapMkAtomTerm;
#define MkAtomTerm(T) (*YapIMkAtomTerm)(T)
#else
#define MkAtomTerm(T) YapMkAtomTerm(T)
#endif
#define MkAtomTerm(a) YAP_MkAtomTerm(a)
#define YapMkAtomTerm(a) YAP_MkAtomTerm(a)
/* Atom AtomOfTerm(Term) */
extern X_API Atom PROTO(YapAtomOfTerm,(Term));
#ifdef IndirectCalls
static Atom (*YapIAtomOfTerm)() = YapAtomOfTerm;
#define AtomOfTerm(T) (*YapIAtomOfTerm)(T)
#else
#define AtomOfTerm(T) YapAtomOfTerm(T)
#endif
/* YAP_Atom AtomOfTerm(Term) */
#define AtomOfTerm(t) YAP_AtomOfTerm(t)
#define YapAtomOfTerm(t) YAP_AtomOfTerm(t)
/* Atom LookupAtom(char *) */
extern X_API Atom PROTO(YapLookupAtom,(char *));
#ifdef IndirectCalls
static Atom (*YapILookupAtom)() = YapLookupAtom;
#define LookupAtom(T) (*YapILookupAtom)(T)
#else
#define LookupAtom(T) YapLookupAtom(T)
#endif
/* YAP_Atom LookupAtom(char *) */
#define LookupAtom(s) YAP_LookupAtom(s)
#define YapLookupAtom(s) YAP_LookupAtom(s)
/* Atom FullLookupAtom(char *) */
extern X_API Atom PROTO(YapFullLookupAtom,(char *));
#ifdef IndirectCalls
static Atom (*YapIFullLookupAtom)() = YapFullLookupAtom;
#define FullLookupAtom(T) (*YapIFullLookupAtom)(T)
#else
#define FullLookupAtom(T) YapFullLookupAtom(T)
#endif
/* YAP_Atom FullLookupAtom(char *) */
#define FullLookupAtom(s) YAP_FullLookupAtom(s)
#define YapFullLookupAtom(s) YAP_FullLookupAtom(s)
/* char* AtomName(Atom) */
extern X_API char *PROTO(YapAtomName,(Atom));
#ifdef IndirectCalls
static char *((*YapIAtomName)()) = YapAtomName;
#define AtomName(T) (*YapIAtomName)(T)
#else
#define AtomName(T) YapAtomName(T)
#endif
/* char* AtomName(YAP_Atom) */
#define AtomName(a) YAP_AtomName(a)
#define YapAtomName(a) YAP_AtomName(a)
/* Term MkPairTerm(Term Head, Term Tail) */
extern X_API Term PROTO(YapMkPairTerm,(Term,Term));
#ifdef IndirectCalls
static Term (*YapIMkPairTerm)() = YapMkPairTerm;
#define MkPairTerm(T1,T2) (*YapIMkPairTerm)(T1,T2)
#else
#define MkPairTerm(T1,T2) YapMkPairTerm(T1,T2)
#endif
/* YAP_Term MkPairTerm(YAP_Term Head, YAP_Term Tail) */
#define MkPairTerm(h,t) YAP_MkPairTerm(h,t)
#define YapMkPairTerm(h,t) YAP_MkPairTerm(h,t)
/* Term MkNewPairTerm(void) */
extern X_API Term PROTO(YapMkNewPairTerm,(void));
#ifdef IndirectCalls
static Term (*YapIMkNewPairTerm)() = YapMkNewPairTerm;
#define MkNewPairTerm() (*YapIMkNewPairTerm)()
#else
#define MkNewPairTerm() YapMkNewPairTerm()
#endif
/* YAP_Term MkNewPairTerm(void) */
#define MkNewPairTerm() YAP_MkNewPairTerm()
#define YapMkNewPairTerm() YAP_MkNewPairTerm()
/* Term HeadOfTerm(Term) */
extern X_API Term PROTO(YapHeadOfTerm,(Term));
#ifdef IndirectCalls
static Term (*YapIHeadOfTerm)() = YapHeadOfTerm;
#define HeadOfTerm(T) (*YapIHeadOfTerm)(T)
#else
#define HeadOfTerm(T) YapHeadOfTerm(T)
#endif
#define HeadOfTerm(t) YAP_HeadOfTerm(t)
#define YapHeadOfTerm(t) YAP_HeadOfTerm(t)
/* Term TailOfTerm(Term) */
extern X_API Term PROTO(YapTailOfTerm,(Term));
#ifdef IndirectCalls
static Term (*YapITailOfTerm)() = YapTailOfTerm;
#define TailOfTerm(T) (*YapITailOfTerm)(T)
#else
#define TailOfTerm(T) YapTailOfTerm(T)
#endif
#define TailOfTerm(t) YAP_TailOfTerm(t)
#define YapTailOfTerm(t) YAP_TailOfTerm(t)
/* YAP_Term MkApplTerm(YAP_Functor f, int n, YAP_Term[] args) */
#define MkApplTerm(f,i,ts) YAP_MkApplTerm(f,i,ts)
#define YapMkApplTerm(f,i,ts) YAP_MkApplTerm(f,i,ts)
/* Term MkApplTerm(Functor f, int n, Term[] args) */
extern X_API Term PROTO(YapMkApplTerm,(Functor,int,Term *));
#ifdef IndirectCalls
static Term (*YapIMkApplTerm)() = YapMkApplTerm;
#define MkApplTerm(F,N,As) (*YapIMkApplTerm)(F,N,As)
#else
#define MkApplTerm(F,N,As) YapMkApplTerm(F,N,As)
#endif
/* YAP_Term MkNewApplTerm(YAP_Functor f, int n) */
#define MkNewApplTerm(f,i) YAP_MkNewApplTerm(f,i)
#define YapMkNewApplTerm(f,i) YAP_MkNewApplTerm(f,i)
/* Term MkNewApplTerm(Functor f, int n) */
extern X_API Term PROTO(YapMkNewApplTerm,(Functor,int));
#ifdef IndirectCalls
static Term (*YapIMkNewApplTerm)() = YapMkNewApplTerm;
#define MkNewApplTerm(F,N) (*YapIMkNewApplTerm)(F,N)
#else
#define MkNewApplTerm(F,N) YapMkNewApplTerm(F,N)
#endif
/* YAP_Functor YAP_FunctorOfTerm(Term) */
#define FunctorOfTerm(t) YAP_FunctorOfTerm(t)
#define YapFunctorOfTerm(t) YAP_FunctorOfTerm(t)
/* YAP_Term ArgOfTerm(int argno,YAP_Term t) */
#define ArgOfTerm(i,t) YAP_ArgOfTerm(i,t)
#define YapArgOfTerm(i,t) YAP_ArgOfTerm(i,t)
/* Functor FunctorOfTerm(Term) */
extern X_API Functor PROTO(YapFunctorOfTerm,(Term));
#ifdef IndirectCalls
static Functor (*YapIFunctorOfTerm)() = YapFunctorOfTerm;
#define FunctorOfTerm(T) (*YapIFunctorOfTerm)(T)
#else
#define FunctorOfTerm(T) YapFunctorOfTerm(T)
#endif
/* YAP_Functor MkFunctor(YAP_Atom a,int arity) */
#define MkFunctor(a,i) YAP_MkFunctor(a,i)
#define YapMkFunctor(a,i) YAP_MkFunctor(a,i)
/* Term ArgOfTerm(int argno,Term t) */
extern X_API Term PROTO(YapArgOfTerm,(int,Term));
#ifdef IndirectCalls
static Term (*YapIArgOfTerm)() = YapArgOfTerm;
#define ArgOfTerm(N,T) (*YapIArgOfTerm)(N,T)
#else
#define ArgOfTerm(N,T) YapArgOfTerm(N,T)
#endif
/* YAP_Atom NameOfFunctor(Functor) */
#define NameOfFunctor(f) YAP_NameOfFunctor(f)
#define YapNameOfFunctor(f) YAP_NameOfFunctor(f)
/* Functor MkFunctor(Atom a,int arity) */
extern X_API Functor PROTO(YapMkFunctor,(Atom,int));
#ifdef IndirectCalls
static Functor (*YapIMkFunctor)() = YapMkFunctor;
#define MkFunctor(A,N) (*YapIMkFunctor)(A,N)
#else
#define MkFunctor(A,N) YapMkFunctor(A,N)
#endif
/* YAP_Int YAP_ArityOfFunctor(Functor) */
#define ArityOfFunctor(f) YAP_ArityOfFunctor(f)
#define YapArityOfFunctor(f) YAP_ArityOfFunctor(f)
/* Atom NameOfFunctor(Functor) */
extern X_API Atom PROTO(YapNameOfFunctor,(Functor));
#ifdef IndirectCalls
static Atom (*YapINameOfFunctor)() = YapNameOfFunctor;
#define NameOfFunctor(T) (*YapINameOfFunctor)(T)
#else
#define NameOfFunctor(T) YapNameOfFunctor(T)
#endif
#define PRESERVE_DATA(ptr, type) (ptr = (type *)YAP_ExtraSpace())
#define PRESERVED_DATA(ptr, type) (ptr = (type *)YAP_ExtraSpace())
/* Int ArityOfFunctor(Functor) */
extern X_API Int PROTO(YapArityOfFunctor,(Functor));
#ifdef IndirectCalls
static Int (*YapIArityOfFunctor)() = YapArityOfFunctor;
#define ArityOfFunctor(T) (*YapIArityOfFunctor)(T)
#else
#define ArityOfFunctor(T) YapArityOfFunctor(T)
#endif
/* void ExtraSpace(void) */
extern X_API void *PROTO(YapExtraSpace,(void));
#ifdef IndirectCalls
static void *(*YapIExtraSpace)() = YapExtraSpace;
#define YapExtraSpace() (*YapExtraSpace)()
#endif
#define PRESERVE_DATA(ptr, type) (ptr = (type *)YapExtraSpace())
#define PRESERVED_DATA(ptr, type) (ptr = (type *)YapExtraSpace())
/* Int unify(Term a, Term b) */
extern X_API Int PROTO(YapUnify,(Term, Term));
#ifdef IndirectCalls
static Int (*YapIUnify)() = YapUnify;
#define unify(T1,T2) (*YapIUnify)(T1,T2)
#else
#define unify(T1,T2) YapUnify(T1,T2)
#endif
/* YAP_Int unify(YAP_Term a, YAP_Term b) */
#define unify() YAP_Unify(t, t)
#define YapUnify() YAP_Unify(t, t)
/* void UserCPredicate(char *name, int *fn(), int arity) */
extern X_API void PROTO(UserCPredicate,(char *, int (*)(void), int));
#ifdef IndirectCalls
static void (*YapIUserCPredicate)() = UserCPredicate;
#define UserCPredicate(N,F,A) (*YapIUserCPredicate)(N,F,A)
#endif
#define UserCPredicate(s,f,i) YAP_UserCPredicate(s,f,i);
/* void UserBackCPredicate(char *name, int *init(), int *cont(), int
arity, int extra) */
extern X_API void PROTO(UserBackCPredicate,(char *, int (*)(void), int (*)(void), int, int));
#ifdef IndirectCalls
static void (*YapIUserBackCPredicate)() = UserBackCPredicate;
#define UserBackCPredicate(N,F,G,A,B) (*YapIUserBackCPredicate)(N,F,G,A,B)
#endif
#define UserBackCPredicate(s,f1,f2,i,i2) YAP_UserBackCPredicate(s,f,i,i2)
/* void UserCPredicate(char *name, int *fn(), int arity) */
extern X_API void PROTO(YapUserCPredicateWithArgs,(char *, int (*)(void), Int,Int));
#ifdef IndirectCalls
static void (*YapIUserCPredicateWithArgs)() = UserCPredicateWithArgs;
#define YapUserCPredicateWithArgs(N,F,A,M) (*YapIUserCPredicateWithArgs)(N,F,A,M)
#endif
/* void CallProlog(Term t) */
extern X_API Int PROTO(YapCallProlog,(Term t));
#ifdef IndirectCalls
static Int (*YapICallProlog)() = YapCallProlog;
#define CallProlog(t) (*YapICallProlog)(t)
#else
#define CallProlog(t) YapCallProlog(t)
#endif
#define UserCPredicateWithArgs(s,f,i1,i2) YAP_UserCPredicateWithArgs(s,f,i1,i2)
/* void CallProlog(YAP_Term t) */
#define CallProlog(t) YAP_CallProlog(t)
#define YapCallProlog(t) YAP_CallProlog(t)
/* void cut_fail(void) */
extern X_API Int PROTO(Yapcut_fail,(void));
#ifdef IndirectCalls
static Int (*YapIcut_fail)() = Yapcut_fail;
#define cut_fail() (*YapIcut_fail)()
#else
#define cut_fail() Yapcut_fail()
#endif
#define cut_fail() YAP_cutfail()
/* void cut_succeed(void) */
extern X_API Int PROTO(Yapcut_succeed,(void));
#ifdef IndirectCalls
static Int (*YapIcut_succeed)() = Yapcut_succeed;
#define cut_succeed() (*YapIcut_succeed)()
#else
#define cut_succeed() Yapcut_succeed()
#endif
#define cut_succeed() YAP_cutsucceed()
/* void *AllocSpaceFromYap(int) */
extern X_API void *PROTO(YapAllocSpaceFromYap,(unsigned int));
#ifdef IndirectCalls
static void (*YapIAllocSpaceFromYap)() = YapAllocSpaceFromYap;
#define AllocSpaceFromYap(SIZE) (*YapIAllocSpaceFromYap)(SIZE)
#else
#define AllocSpaceFromYap(SIZE) YapAllocSpaceFromYap(SIZE)
#endif
#define AllocSpaceFromYap(s) YAP_AllocSpaceFromYap(s)
/* void FreeSpaceFromYap(void *) */
extern X_API void PROTO(YapFreeSpaceFromYap,(void *));
#ifdef IndirectCalls
static void (YapIFreeSpaceFromYap)() = YapFreeSpaceFromYap;
#define FreeSpaceFromYap(PTR) (*YapIFreeSpaceFromYap)(PTR)
#else
#define FreeSpaceFromYap(PTR) YapFreeSpaceFromYap(PTR)
#endif
#define FreeSpaceFromYap(s) YAP_FreeSpaceFromYap(s)
/* int YapRunGoal(Term) */
extern X_API int PROTO(YapRunGoal,(Term));
#ifdef IndirectCalls
static int (YapIRunGoal)() = YapRunGoal;
#define YapRunGoal(T) (*YapIRunGoal)(T)
#endif
/* int YAP_RunGoal(YAP_Term) */
#define RunGoal(t) YAP_RunGoal(t)
#define YapRunGoal(t) YAP_RunGoal(t)
/* int YapRestartGoal(void) */
extern X_API int PROTO(YapRestartGoal,(void));
#ifdef IndirectCalls
static int (YapIRestartGoal)() = YapRestartGoal;
#define YapRestartGoal() (*YapIRestartGoal)()
#endif
/* int YAP_RestartGoal(void) */
#define RestartGoal() YAP_RestartGoal()
#define YapRestartGoal() YAP_RestartGoal()
/* int YapContinueGoal(void) */
extern X_API int PROTO(YapContinueGoal,(void));
#ifdef IndirectCalls
static int (YapIContinueGoal)() = YapContinueGoal;
#define YapContinueGoal() (*YapIContinueGoal)()
#endif
/* int YAP_ContinueGoal(void) */
#define ContinueGoal() YAP_ContinueGoal()
#define YapContinueGoal() YAP_ContinueGoal()
/* void YapPruneGoal(void) */
extern X_API void PROTO(YapPruneGoal,(void));
#ifdef IndirectCalls
static void (YapIPruneGoal)() = YapPruneGoal;
#define YapPruneGoal() (*YapIPruneGoal)()
#endif
/* void YAP_PruneGoal(void) */
#define PruneGoal() YAP_PruneGoal()
#define YapPruneGoal() YAP_PruneGoal()
/* int YapGoalHasException(void) */
extern X_API int PROTO(YapGoalHasException,(Term *));
#ifdef IndirectCalls
static int (YapIGoalHasException)(TP) = YapGoalHasException;
#define YapGoalHasException(TP) (*YapIGoalHasException)(TP)
#endif
/* int YAP_GoalHasException(void) */
#define GoalHasException(tp) YAP_GoalHasException(tp)
#define YapGoalHasException(tp) YAP_GoalHasException(tp)
/* int YapReset(void) */
extern X_API void PROTO(YapReset,(void));
#ifdef IndirectCalls
static void (YapIReset)() = YapReset;
#define YapReset() (*YapIReset)()
#endif
/* int YAP_Reset(void) */
#define YapReset() YAP_Reset()
/* void YapError(char *) */
extern X_API void PROTO(YapError,(char *));
#ifdef IndirectCalls
static void (YapIError)() = YapError;
#define YapError(T) (*YapIError)(T)
#endif
/* void YAP_Error(char *) */
#define YapError(s) YAP_Error(s)
/* Term YapRead(int (*)(void)) */
extern X_API Term PROTO(YapRead,(int (*)(void)));
#ifdef IndirectCalls
static Term (YapIRead)() = YapRead;
#define YapRead(F) (*YapIRead)(F)
#endif
/* YAP_Term YAP_Read(int (*)(void)) */
#define YapRead(f) YAP_Read(f);
/* void YapWrite(Term,void (*)(int),int) */
extern X_API void PROTO(YapWrite,(Term,void (*)(int),int));
#ifdef IndirectCalls
static void (YapIWrite)() = YapWrite;
#define YapWrite(T,W,F) (*YapIWrite)(T,W,F)
#endif
/* void YAP_Write(YAP_Term,void (*)(int),int) */
#define YapWrite(t,f) YAP_Write(t,f);
/* char *YapCompileClause(Term) */
extern X_API char *PROTO(YapCompileClause,(Term));
#ifdef IndirectCalls
static char *(YapICompileClause)() = YapCompileClause;
#define YapCompileClause(C) (*YapICompileClause)(C)
#endif
/* char *YAP_CompileClause(YAP_Term) */
#define CompileClause(t) YAP_CompileClause(t)
#define YapCompileClause(t) YAP_CompileClause(t)
/* int YapInit(yap_init_args *) */
extern X_API int PROTO(YapInit,(yap_init_args *));
#ifdef IndirectCalls
static int (YapIInit)() = YapInit;
#define YapInit(T) (*YapIInit)(T)
#endif
/* int YAP_Init(YAP_init_args *) */
#define YapInit(as) YAP_Init(as)
/* int YapFastInit(char *) */
extern X_API int PROTO(YapFastInit,(char *));
#ifdef IndirectCalls
static int (YapIFastInit)() = YapFastInit;
#define YapFastInit(S) (*YapIFastInit)(S)
#endif
/* int YAP_FastInit(char *) */
#define YapFastInit(s) YAP_FastInit(s)
/* int YapInitConsult(int, char *) */
extern X_API int PROTO(YapInitConsult,(int, char *));
#ifdef IndirectCalls
static int (YapIInitConsult)() = YapInitConsult;
#define YapInitConsult(M,F) (*YapIInitConsult)(M,F)
#endif
/* int YAP_InitConsult(int, char *) */
#define YapInitConsult(i,s) YAP_InitConsult(i,s)
/* int YapStartConsult(int, char *) */
extern X_API int PROTO(YapEndConsult,(void));
#ifdef IndirectCalls
static int (YapIEndConsult)() = YapEndConsult;
#define YapEndConsult(M,F) (*YapIEndConsult)(M,F)
#endif
/* int YAP_StartConsult(int, char *) */
#define YapEndConsult() YAP_EndConsult()
/* void YapExit(int) */
extern X_API void PROTO(YapExit,(int));
#ifdef IndirectCalls
static int (YapIExit)() = YapExit;
#define YapExit(I) (*YapIExit)(I)
#endif
/* void YAP_Exit(int) */
#define YapExit(code) YAP_Exit(code)
/* void YapPutValue(Atom, Term) */
extern X_API void PROTO(YapPutValue,(Atom, Term));
#ifdef IndirectCalls
static Term (YapIPutValue)() = YapPutValue;
#define YapPutValue(A,T) (*YapIPutValue)(A,T)
#endif
/* void YAP_PutValue(YAP_Atom, YAP_Term) */
#define PutValue() YAP_PutValue(a, t)
#define YapPutValue() YAP_PutValue(a, t)
/* Term YapGetValue(Atom) */
extern X_API Term PROTO(YapGetValue,(Atom));
#ifdef IndirectCalls
static Term (YapIGetValue)() = YapGetValue;
#define YapGetValue(A) (*YapIGetValue)(A)
#endif
/* YAP_Term YAP_GetValue(YAP_Atom) */
#define GetValue(a) YAP_GetValue(a)
#define YapGetValue(a) YAP_GetValue(a)
/* int StringToBuffer(Term,char *,unsigned int) */
extern X_API int PROTO(YapStringToBuffer,(Term,char *,unsigned int));
#ifdef IndirectCalls
static void (YapIStringToBuffer)() = YapStringToBuffer;
#define StringToBuffer(T,BUF,SIZE) (*YapIStringToBuffer)(T,BUF,SIZE)
#else
#define StringToBuffer(T,BUF,SIZE) YapStringToBuffer(T,BUF,SIZE)
#endif
/* int StringToBuffer(YAP_Term,char *,unsigned int) */
#define StringToBuffer(t,s,l) YAP_StringToBuffer(t,s,l)
#define YapStringToBuffer(t,s,l) YAP_StringToBuffer(t,s,l)
/* int BufferToString(char *) */
extern X_API Term PROTO(YapBufferToString,(char *));
#ifdef IndirectCalls
static void (YapIBufferToString)() = YapBufferToString;
#define BufferToString(BUF) (*YapIBufferToString)(BUF)
#else
#define BufferToString(BUF) YapBufferToString(BUF)
#endif
#define BufferToString(s) YAP_BufferToString(s)
#define YapBufferToString(s) YAP_BufferToString(s)
/* int BufferToAtomList(char *) */
extern X_API Term PROTO(YapBufferToAtomList,(char *));
#ifdef IndirectCalls
static void (YapIBufferToAtomList)() = YapBufferToAtomList;
#define BufferToAtomList(BUF) (*YapIBufferToAtomList)(BUF)
#else
#define BufferToAtomList(BUF) YapBufferToAtomList(BUF)
#endif
#define BufferToAtomList(s) YAP_BufferToAtomList(s)
#define YapBufferToAtomList(s) YAP_BufferToAtomList(s)
/* void YapInitSocks(char *,long) */
extern X_API int PROTO(YapInitSocks,(char *,long));
#ifdef IndirectCalls
static int (YapIInitSocks)(char *,long) = YapInitSocks;
#define YapInitSocks(S,I) (*YapIInitSocks)(S,I)
#endif
/* void YAP_InitSocks(char *,long) */
#define InitSocks(s,l) YAP_InitSocks(s,l)
#define YapInitSocks(s,l) YAP_InitSocks(s,l)
#ifdef SFUNC
#define SFArity 0
extern X_API Term *ArgsOfSFTerm();
#ifdef IndirectCalls
static Term *((*YapIArgsOfSFTerm)()) = ArgsOfSFTerm;
#define ArgsOfSFTerm(T) (*YapIArgsOfSFTerm)(T)
#endif
extern X_API Term MkSFTerm();
#ifdef IndirectCalls
static Term (*YapIMkSFTerm)() = MkSFTerm;
#define MkSFTerm(F,N,A,EV) (*YapIMkSFTerm)(F,N,A,EV)
#endif
#define ArgsOfSFTerm(s,t) YAP_ArgsOfSFTerm(s,t)
extern MkSFTerm(t) YAP_MkSFTerm(t)
#endif /* SFUNC */
/* Term YapSetOutputMessage() */
extern X_API void PROTO(YapSetOutputMessage,(void));
#ifdef IndirectCalls
static void (*YapISetOutputMessage)() = YapSetOutputMessage;
#define YapSetOutputMessage() (*YapISetOutputMessage)()
#endif
/* YAP_Term YAP_SetOutputMessage() */
#define YapSetOutputMessage(s) YAP_SetOutputMessage(s)
/* Term YapSetOutputMessage() */
extern X_API int PROTO(YapStreamToFileNo,(Term));
#ifdef IndirectCalls
static void (*YapIStreamToFileNo)() = YapStreamToFileNo;
#define YapStreamToFileNo() (*YapIStreamToFileNo)()
#endif
/* YAP_Term YAP_SetOutputMessage() */
#define YapStreamToFileNo(st) YAP_StreamToFileNo(st)
/* Term YapSetOutputMessage() */
extern X_API void PROTO(YapCloseAllOpenStreams,(void));
#ifdef IndirectCalls
static void (*YapICloseAllOpenStreams)() = YapCloseAllOpenStreams;
#define YapCloseAllOpenStreams() (*YapICloseAllOpenStreams)()
#endif
/* YAP_Term YAP_SetOutputMessage() */
#define YapCloseAllOpenStreams() YAP_CloseAllOpenStreams()
#define YAP_INPUT_STREAM 0x01
#define YAP_OUTPUT_STREAM 0x02
#define YAP_APPEND_STREAM 0x04
#define YAP_PIPE_STREAM 0x08
#define YAP_TTY_STREAM 0x10
#define YAP_POPEN_STREAM 0x20
#define YAP_BINARY_STREAM 0x40
#define YAP_SEEKABLE_STREAM 0x80
/* Term YapOpenStream() */
extern X_API Term PROTO(YapOpenStream,(void *, char *, Term, int));
#ifdef IndirectCalls
static Term (*YapIOpenStream)() = YapOpenStream;
#define YapOpenStream(FD,S,T,FL) (*YapIOpenStream)(FD,S,T,FL)
#endif
/* Term *YapNewSlots() */
extern X_API long PROTO(YapNewSlots,(int));
#ifdef IndirectCalls
static long (*YapINewSlots)(N) = YapNewSlots;
#define YapNewSlots(N) (*YapINewSlots)(N)
#endif
/* Term *YapInitSlot() */
extern X_API long PROTO(YapInitSlot,(Term));
#ifdef IndirectCalls
static long (*YapIInitSlot)(T) = YapInitSlot;
#define YapInitSlot(T) (*YapIInitSlot)(T)
#endif
/* Term YapGetFromSlots(t) */
extern X_API Term PROTO(YapGetFromSlot,(long));
#ifdef IndirectCalls
static Term (*YapIGetFromSlot)(N) = YapGetFromSlot;
#define YapGetFromSlot(N) (*YapIGetFromSlot)(N)
#endif
/* Term YapAddressFromSlots(t) */
extern X_API Term *PROTO(YapAddressFromSlot,(long));
#ifdef IndirectCalls
static Term *(*YapIAddressFromSlot)(N) = YapAddressFromSlot;
#define YapAddressFromSlot(N) (*YapIAddressFromSlot)(N)
#endif
/* Term YapPutInSlots(t) */
extern X_API void PROTO(YapPutInSlot,(long, Term));
#ifdef IndirectCalls
static void (*YapIPutInSlot)(N,T) = YapPutInSlot;
#define YapPutInSlot(N,T) (*YapIPutInSlot)(N,T)
#endif
/* void YapRecoverSlots() */
extern X_API void PROTO(YapRecoverSlots,(int));
#ifdef IndirectCalls
static void (*YapIRecoverSlots)(N) = YapRecoverSlots;
#define YapRecoverSlots(N) (*YapIRecoverSlots)(N)
#endif
/* void YapThrow() */
extern X_API void PROTO(YapThrow,(Term));
#ifdef IndirectCalls
static void (*YapIThrow)(T) = YapThrow;
#define YapThrow(T) (*YapIThrow)(T)
#endif
/* int YapLookupModule() */
extern X_API int PROTO(YapLookupModule,(Term));
#ifdef IndirectCalls
static int (*YapILookupModule)(T) = YapLookupModule;
#define YapLookupModule(T) (*YapILookupModule)(T)
#endif
/* int YapModuleName() */
extern X_API Term PROTO(YapModuleName,(int));
#ifdef IndirectCalls
static int (*YapIModuleName)(I) = YapModuleName;
#define YapModuleName(I) (*YapIModuleName)(I)
#endif
/* int YapHalt() */
extern X_API int PROTO(YapHalt,(int));
#ifdef IndirectCalls
static int (*YapIHalt)(E) = YapHalt;
#define YapHalt(E) (*YapIHalt)(E)
#endif
/* int YapTopOfLocalStack() */
extern X_API Term *PROTO(YapTopOfLocalStack,(void));
#ifdef IndirectCalls
static Term *(*YapITopOfLocalStack)() = YapTopOfLocalStack;
#define YapTopOfLocalStack() (*YapITopOfLocalStack)()
#endif
/* int YapPredicate() */
extern X_API void *PROTO(YapPredicate,(Atom,Int,Int));
#ifdef IndirectCalls
static Term *(*YapIPredicate)(N,A,M) = YapPredicate;
#define YapPredicate(N,A,M) (*YapIPredicate)(N,A,M)
#endif
/* int YapPredicate() */
extern X_API void PROTO(YapPredicateInfo,(void *,Atom*,Int*,Int*));
#ifdef IndirectCalls
static void (*YapIPredicateInfo)(P,N,A,M) = YapPredicateInfo;
#define YapPredicateInfo(P,N,A,M) (*YapIPredicateInfo)(P,N,A,M)
#endif
/* int YapPredicate() */
extern X_API int PROTO(YapCurrentModule,(void));
#ifdef IndirectCalls
static int (*YapICurrentModule)() = YapCurrentModule;
#define YapCurrentModule() (*YapICurrentModule)()
#endif
#define InitCPred(N,A,F) UserCPredicate(N,F,A)
__END_DECLS
/* YAP_Term YAP_OpenStream() */
#define YapOpenStream(st, s, t, i) YAP_OpenStream(st, s, t, i)
#endif

16
include/yap_structs.h
View File

@ -28,19 +28,15 @@
/* Type definitions */
typedef unsigned long CELL; /* this is common to all current machines */
typedef unsigned long YAP_CELL; /* this is common to all current machines */
typedef int Bool;
typedef int YAP_Bool;
typedef long int Int;
typedef YAP_CELL YAP_Term;
typedef double flt;
typedef struct FunctorEntry *YAP_Functor;
typedef CELL Term;
typedef struct FunctorEntry *Functor;
typedef struct AtomEntry *Atom;
typedef struct AtomEntry *YAP_Atom;
#ifndef TRUE
#define TRUE 1
@ -93,5 +89,5 @@ typedef struct {
int Argc;
/* array of arguments as seen by Prolog */
char **Argv;
} yap_init_args;
} YAP_init_args;

26
library/random/random.c
View File

@ -16,7 +16,7 @@
*************************************************************************/
#include "config.h"
#include "c_interface.h"
#include "YapInterface.h"
#include <math.h>
#if defined(__MINGW32__) || _MSC_VER
#include <windows.h>
@ -29,8 +29,8 @@ static short a1 = 27314, b1 = 9213, c1 = 17773;
static int
p_random(void)
{
flt fli;
Int t1, t2, t3;
double fli;
long int t1, t2, t3;
t1 = (a1 * 171) % 30269;
t2 = (b1 * 172) % 30307;
@ -39,32 +39,32 @@ p_random(void)
a1 = t1;
b1 = t2;
c1 = t3;
return(unify(ARG1, MkFloatTerm(fli-(int)(fli))));
return(YAP_Unify(YAP_ARG1, YAP_MkFloatTerm(fli-(int)(fli))));
}
static int
p_setrand(void)
{
a1 = IntOfTerm(ARG1);
b1 = IntOfTerm(ARG2);
c1 = IntOfTerm(ARG3);
a1 = YAP_IntOfTerm(YAP_ARG1);
b1 = YAP_IntOfTerm(YAP_ARG2);
c1 = YAP_IntOfTerm(YAP_ARG3);
return(TRUE);
}
static int
p_getrand(void)
{
return(unify(ARG1,MkIntTerm(a1)) &&
unify(ARG2,MkIntTerm(b1)) &&
unify(ARG3,MkIntTerm(c1)));
return(YAP_Unify(YAP_ARG1,YAP_MkIntTerm(a1)) &&
YAP_Unify(YAP_ARG2,YAP_MkIntTerm(b1)) &&
YAP_Unify(YAP_ARG3,YAP_MkIntTerm(c1)));
}
void
init_random(void)
{
UserCPredicate("random", p_random, 1);
UserCPredicate("setrand", p_setrand, 3);
UserCPredicate("getrand", p_getrand, 3);
YAP_UserCPredicate("random", p_random, 1);
YAP_UserCPredicate("setrand", p_setrand, 3);
YAP_UserCPredicate("getrand", p_getrand, 3);
}
#ifdef _WIN32

92
library/regex/regexp.c
View File

@ -19,7 +19,7 @@
#if HAVE_SYS_TYPES_H
#include <sys/types.h>
#endif
#include "c_interface.h"
#include "YapInterface.h"
#if HAVE_REGEX_H
#include "regex.h"
#define yap_regcomp(A,B,C) regcomp(A,B,C)
@ -36,20 +36,21 @@ void PROTO(init_regexp, (void));
static int check_regexp(void)
{
unsigned int buflen = (unsigned int)IntOfTerm(ARG2)+1;
unsigned int sbuflen = (unsigned int)IntOfTerm(ARG4)+1;
unsigned int buflen = (unsigned int)YAP_IntOfTerm(YAP_ARG2)+1;
unsigned int sbuflen = (unsigned int)YAP_IntOfTerm(YAP_ARG4)+1;
char *buf, *sbuf;
regex_t reg;
int out;
int yap_flags = IntOfTerm(ARG5), regcomp_flags = REG_NOSUB|REG_EXTENDED;
int yap_flags = YAP_IntOfTerm(YAP_ARG5);
int regcomp_flags = REG_NOSUB|REG_EXTENDED;
if ((buf = (char *)AllocSpaceFromYap(buflen)) == NULL) {
if ((buf = (char *)YAP_AllocSpaceFromYap(buflen)) == NULL) {
/* early exit */
return(FALSE);
}
if (StringToBuffer(ARG1,buf,buflen) == FALSE) {
if (YAP_StringToBuffer(YAP_ARG1,buf,buflen) == FALSE) {
/* something went wrong, possibly a type checking error */
FreeSpaceFromYap(buf);
YAP_FreeSpaceFromYap(buf);
return(FALSE);
}
if (yap_flags & 1)
@ -57,23 +58,23 @@ static int check_regexp(void)
/* cool, now I have my string in the buffer, let's have some fun */
if (yap_regcomp(&reg,buf, regcomp_flags) != 0)
return(FALSE);
if ((sbuf = (char *)AllocSpaceFromYap(sbuflen)) == NULL) {
if ((sbuf = (char *)YAP_AllocSpaceFromYap(sbuflen)) == NULL) {
/* early exit */
yap_regfree(&reg);
FreeSpaceFromYap(buf);
YAP_FreeSpaceFromYap(buf);
return(FALSE);
}
if (StringToBuffer(ARG3,sbuf,sbuflen) == FALSE) {
if (YAP_StringToBuffer(YAP_ARG3,sbuf,sbuflen) == FALSE) {
/* something went wrong, possibly a type checking error */
yap_regfree(&reg);
FreeSpaceFromYap(buf);
FreeSpaceFromYap(sbuf);
YAP_FreeSpaceFromYap(buf);
YAP_FreeSpaceFromYap(sbuf);
return(FALSE);
}
out = yap_regexec(&reg,sbuf,0,NULL,0);
yap_regfree(&reg);
FreeSpaceFromYap(buf);
FreeSpaceFromYap(sbuf);
YAP_FreeSpaceFromYap(buf);
YAP_FreeSpaceFromYap(sbuf);
if (out != 0 && out != REG_NOMATCH) {
return(FALSE);
}
@ -82,23 +83,24 @@ static int check_regexp(void)
static int regexp(void)
{
unsigned int buflen = (unsigned int)IntOfTerm(ARG2)+1;
unsigned int sbuflen = (unsigned int)IntOfTerm(ARG4)+1;
unsigned int buflen = (unsigned int)YAP_IntOfTerm(YAP_ARG2)+1;
unsigned int sbuflen = (unsigned int)YAP_IntOfTerm(YAP_ARG4)+1;
char *buf, *sbuf;
regex_t reg;
int out;
Int nmatch = IntOfTerm(ARG7);
long int nmatch = YAP_IntOfTerm(YAP_ARG7);
regmatch_t *pmatch;
Term tout;
int yap_flags = IntOfTerm(ARG5), regcomp_flags = REG_EXTENDED;
long int tout;
int yap_flags = YAP_IntOfTerm(YAP_ARG5);
int regcomp_flags = REG_EXTENDED;
if ((buf = (char *)AllocSpaceFromYap(buflen)) == NULL) {
if ((buf = (char *)YAP_AllocSpaceFromYap(buflen)) == NULL) {
/* early exit */
return(FALSE);
}
if (StringToBuffer(ARG1,buf,buflen) == FALSE) {
if (YAP_StringToBuffer(YAP_ARG1,buf,buflen) == FALSE) {
/* something went wrong, possibly a type checking error */
FreeSpaceFromYap(buf);
YAP_FreeSpaceFromYap(buf);
return(FALSE);
}
if (yap_flags & 1)
@ -106,62 +108,62 @@ static int regexp(void)
/* cool, now I have my string in the buffer, let's have some fun */
if (yap_regcomp(&reg,buf, regcomp_flags) != 0)
return(FALSE);
if ((sbuf = (char *)AllocSpaceFromYap(sbuflen)) == NULL) {
if ((sbuf = (char *)YAP_AllocSpaceFromYap(sbuflen)) == NULL) {
/* early exit */
yap_regfree(&reg);
FreeSpaceFromYap(buf);
YAP_FreeSpaceFromYap(buf);
return(FALSE);
}
if (StringToBuffer(ARG3,sbuf,sbuflen) == FALSE) {
if (YAP_StringToBuffer(YAP_ARG3,sbuf,sbuflen) == FALSE) {
/* something went wrong, possibly a type checking error */
yap_regfree(&reg);
FreeSpaceFromYap(buf);
FreeSpaceFromYap(sbuf);
YAP_FreeSpaceFromYap(buf);
YAP_FreeSpaceFromYap(sbuf);
return(FALSE);
}
pmatch = AllocSpaceFromYap(sizeof(regmatch_t)*nmatch);
pmatch = YAP_AllocSpaceFromYap(sizeof(regmatch_t)*nmatch);
out = yap_regexec(&reg,sbuf,(int)nmatch,pmatch,0);
if (out == 0) {
/* match succeed, let's fill the match in */
Int i;
Term TNil = MkAtomTerm(LookupAtom("[]"));
Functor FDiff = MkFunctor(LookupAtom("-"),2);
long int i;
YAP_Term TNil = YAP_MkAtomTerm(YAP_LookupAtom("[]"));
YAP_Functor FDiff = YAP_MkFunctor(YAP_LookupAtom("-"),2);
tout = ARG6;
tout = YAP_ARG6;
for (i = 0; i < nmatch; i++) {
int j;
Term t = TNil;
YAP_Term t = TNil;
if (pmatch[i].rm_so == -1) break;
if (yap_flags & 2) {
Term to[2];
to[0] = MkIntTerm(pmatch[i].rm_so);
to[1] = MkIntTerm(pmatch[i].rm_eo);
t = MkApplTerm(FDiff,2,to);
YAP_Term to[2];
to[0] = YAP_MkIntTerm(pmatch[i].rm_so);
to[1] = YAP_MkIntTerm(pmatch[i].rm_eo);
t = YAP_MkApplTerm(FDiff,2,to);
} else {
for (j = pmatch[i].rm_eo-1; j >= pmatch[i].rm_so; j--) {
t = MkPairTerm(MkIntTerm(sbuf[j]),t);
t = YAP_MkPairTerm(YAP_MkIntTerm(sbuf[j]),t);
}
}
unify(t,HeadOfTerm(tout));
tout = TailOfTerm(tout);
YAP_Unify(t,YAP_HeadOfTerm(tout));
tout = YAP_TailOfTerm(tout);
}
}
else if (out != REG_NOMATCH) {
return(FALSE);
}
yap_regfree(&reg);
FreeSpaceFromYap(buf);
FreeSpaceFromYap(sbuf);
FreeSpaceFromYap(pmatch);
YAP_FreeSpaceFromYap(buf);
YAP_FreeSpaceFromYap(sbuf);
YAP_FreeSpaceFromYap(pmatch);
return(out == 0);
}
void
init_regexp(void)
{
UserCPredicate("check_regexp", check_regexp, 5);
UserCPredicate("check_regexp", regexp, 7);
YAP_UserCPredicate("check_regexp", check_regexp, 5);
YAP_UserCPredicate("check_regexp", regexp, 7);
}
#if defined(_WIN32) || defined(__MINGW32__)

370
library/system/sys.c
View File

@ -16,7 +16,7 @@
*************************************************************************/
#include "config.h"
#include "c_interface.h"
#include "YapInterface.h"
#if STDC_HEADERS
#include <stdlib.h>
#endif
@ -70,7 +70,7 @@
void PROTO(init_sys, (void));
#if defined(__MINGW32__) || _MSC_VER
static Term
static YAP_Term
WinError(void)
{
char msg[256];
@ -79,7 +79,7 @@ WinError(void)
NULL, GetLastError(),
MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), msg, 256,
NULL);
return(MkAtomTerm(LookupAtom(msg)));
return(YAP_MkAtomTerm(YAP_LookupAtom(msg)));
}
#endif
@ -87,34 +87,34 @@ WinError(void)
static int
datime(void)
{
Term tf, out[6];
YAP_Term tf, out[6];
#if defined(__MINGW32__) || _MSC_VER
SYSTEMTIME stime;
GetLocalTime(&stime);
out[0] = MkIntTerm(stime.wYear);
out[1] = MkIntTerm(stime.wMonth);
out[2] = MkIntTerm(stime.wDay);
out[3] = MkIntTerm(stime.wHour);
out[4] = MkIntTerm(stime.wMinute);
out[5] = MkIntTerm(stime.wSecond);
out[0] = YAP_MkIntTerm(stime.wYear);
out[1] = YAP_MkIntTerm(stime.wMonth);
out[2] = YAP_MkIntTerm(stime.wDay);
out[3] = YAP_MkIntTerm(stime.wHour);
out[4] = YAP_MkIntTerm(stime.wMinute);
out[5] = YAP_MkIntTerm(stime.wSecond);
#elif HAVE_TIME
time_t tp;
if ((tp = time(NULL)) == -1) {
return(unify(ARG2, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno)));
}
#ifdef HAVE_LOCALTIME
{
struct tm *loc = localtime(&tp);
if (loc == NULL) {
return(unify(ARG2, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno)));
}
out[0] = MkIntTerm(1900+loc->tm_year);
out[1] = MkIntTerm(1+loc->tm_mon);
out[2] = MkIntTerm(loc->tm_mday);
out[3] = MkIntTerm(loc->tm_hour);
out[4] = MkIntTerm(loc->tm_min);
out[5] = MkIntTerm(loc->tm_sec);
out[0] = YAP_MkIntTerm(1900+loc->tm_year);
out[1] = YAP_MkIntTerm(1+loc->tm_mon);
out[2] = YAP_MkIntTerm(loc->tm_mday);
out[3] = YAP_MkIntTerm(loc->tm_hour);
out[4] = YAP_MkIntTerm(loc->tm_min);
out[5] = YAP_MkIntTerm(loc->tm_sec);
}
#else
oops
@ -122,8 +122,8 @@ datime(void)
#else
oops
#endif /* HAVE_TIME */
tf = MkApplTerm(MkFunctor(LookupAtom("datime"),6), 6, out);
return(unify(ARG1, tf));
tf = YAP_MkApplTerm(YAP_MkFunctor(YAP_LookupAtom("datime"),6), 6, out);
return(YAP_Unify(YAP_ARG1, tf));
}
#define BUF_SIZE 1024
@ -132,9 +132,9 @@ datime(void)
static int
list_directory(void)
{
Term tf = MkAtomTerm(LookupAtom("[]"));
YAP_Term tf = YAP_MkAtomTerm(YAP_LookupAtom("[]"));
char *buf = AtomName(AtomOfTerm(ARG1));
char *buf = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
#if defined(__MINGW32__) || _MSC_VER
struct _finddata_t c_file;
char bs[BUF_SIZE];
@ -152,12 +152,12 @@ list_directory(void)
strncat(bs, "/*");
#endif
if ((hFile = _findfirst(bs, &c_file)) == -1L) {
return(unify(ARG2,tf));
return(YAP_Unify(YAP_ARG2,tf));
}
tf = MkPairTerm(MkAtomTerm(LookupAtom(c_file.name)), tf);
tf = YAP_MkPairTerm(YAP_MkAtomTerm(YAP_LookupAtom(c_file.name)), tf);
while (_findnext( hFile, &c_file) == 0) {
Term ti = MkAtomTerm(LookupAtom(c_file.name));
tf = MkPairTerm(ti, tf);
YAP_Term ti = YAP_MkAtomTerm(YAP_LookupAtom(c_file.name));
tf = YAP_MkPairTerm(ti, tf);
}
_findclose( hFile );
#else
@ -167,23 +167,23 @@ list_directory(void)
struct dirent *dp;
if ((de = opendir(buf)) == NULL) {
return(unify(ARG3, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno)));
}
while ((dp = readdir(de))) {
Term ti = MkAtomTerm(LookupAtom(dp->d_name));
tf = MkPairTerm(ti, tf);
YAP_Term ti = YAP_MkAtomTerm(YAP_LookupAtom(dp->d_name));
tf = YAP_MkPairTerm(ti, tf);
}
closedir(de);
}
#endif /* HAVE_OPENDIR */
#endif
return(unify(ARG2, tf));
return(YAP_Unify(YAP_ARG2, tf));
}
static int
p_unlink(void)
{
char *fd = AtomName(AtomOfTerm(ARG1));
char *fd = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
#if defined(__MINGW32__) || _MSC_VER
if (_unlink(fd) == -1)
#else
@ -191,7 +191,7 @@ p_unlink(void)
#endif
{
/* return an error number */
return(unify(ARG2, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno)));
}
return(TRUE);
}
@ -199,14 +199,14 @@ p_unlink(void)
static int
p_mkdir(void)
{
char *fd = AtomName(AtomOfTerm(ARG1));
char *fd = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
#if defined(__MINGW32__) || _MSC_VER
if (_mkdir(fd) == -1) {
#else
if (mkdir(fd, 0777) == -1) {
#endif
/* return an error number */
return(unify(ARG2, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno)));
}
return(TRUE);
}
@ -214,14 +214,14 @@ p_mkdir(void)
static int
p_rmdir(void)
{
char *fd = AtomName(AtomOfTerm(ARG1));
char *fd = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
#if defined(__MINGW32__) || _MSC_VER
if (_rmdir(fd) == -1) {
#else
if (rmdir(fd) == -1) {
#endif
/* return an error number */
return(unify(ARG2, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno)));
}
return(TRUE);
}
@ -229,12 +229,12 @@ p_rmdir(void)
static int
rename_file(void)
{
char *s1 = AtomName(AtomOfTerm(ARG1));
char *s2 = AtomName(AtomOfTerm(ARG2));
char *s1 = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
char *s2 = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG2));
#if HAVE_RENAME
if (rename(s1, s2) == -1) {
/* return an error number */
return(unify(ARG3, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno)));
}
#endif
return(TRUE);
@ -243,7 +243,7 @@ rename_file(void)
static int
dir_separator(void)
{
return(unify(ARG1,MkAtomTerm(LookupAtom("/"))));
return(YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom("/"))));
}
static int
@ -253,75 +253,75 @@ file_property(void)
#if HAVE_LSTAT
struct stat buf;
fd = AtomName(AtomOfTerm(ARG1));
fd = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
if (lstat(fd, &buf) == -1) {
/* return an error number */
return(unify(ARG7, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG7, YAP_MkIntTerm(errno)));
}
if (S_ISREG(buf.st_mode)) {
if (!(unify(ARG2, MkAtomTerm(LookupAtom("regular"))) &&
unify(ARG6, YapMkIntTerm(0))))
if (!(YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("regular"))) &&
YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0))))
return(FALSE);
} else if (S_ISDIR(buf.st_mode)) {
if (!(unify(ARG2, MkAtomTerm(LookupAtom("directory"))) &&
unify(ARG6, YapMkIntTerm(0))))
if (!(YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("directory"))) &&
YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0))))
return(FALSE);
} else if (S_ISFIFO(buf.st_mode)) {
if (!(unify(ARG2, MkAtomTerm(LookupAtom("fifo"))) &&
unify(ARG6, YapMkIntTerm(0))))
if (!(YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("fifo"))) &&
YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0))))
return(FALSE);
} else if (S_ISLNK(buf.st_mode)) {
if (!unify(ARG2, MkAtomTerm(LookupAtom("symlink"))))
if (!YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("symlink"))))
return(FALSE);
#if HAVE_READLINK
{
char tmp[256];
int n;
if ((n = readlink(fd,tmp,256)) == -1) {
return(unify(ARG7, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG7, YAP_MkIntTerm(errno)));
}
tmp[n] = '\0';
if(!unify(ARG6,MkAtomTerm(LookupAtom(tmp)))) {
if(!YAP_Unify(YAP_ARG6,YAP_MkAtomTerm(YAP_LookupAtom(tmp)))) {
return(FALSE);
}
}
#else
if (!unify(ARG6, YapMkIntTerm(0)))
if (!YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0)))
return(FALSE);
#endif
} else if (S_ISSOCK(buf.st_mode)) {
if (!(unify(ARG2, MkAtomTerm(LookupAtom("socket"))) &&
unify(ARG6, YapMkIntTerm(0))))
if (!(YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("socket"))) &&
YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0))))
return(FALSE);
} else {
if (!(unify(ARG2, MkAtomTerm(LookupAtom("unknown"))) &&
unify(ARG6, YapMkIntTerm(0))))
if (!(YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("unknown"))) &&
YAP_Unify(YAP_ARG6, YAP_MkIntTerm(0))))
return(FALSE);
}
#elif defined(__MINGW32__) || _MSC_VER
/* for some weird reason _stat did not work with mingw32 */
struct stat buf;
fd = AtomName(AtomOfTerm(ARG1));
fd = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
if (stat(fd, &buf) != 0) {
/* return an error number */
return(unify(ARG7, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG7, YAP_MkIntTerm(errno)));
}
if (buf.st_mode & S_IFREG) {
if (!unify(ARG2, MkAtomTerm(LookupAtom("regular"))))
if (!YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("regular"))))
return(FALSE);
} else if (buf.st_mode & S_IFDIR) {
if (!unify(ARG2, MkAtomTerm(LookupAtom("directory"))))
if (!YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("directory"))))
return(FALSE);
} else {
if (!unify(ARG2, MkAtomTerm(LookupAtom("unknown"))))
if (!YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom("unknown"))))
return(FALSE);
}
#endif
return (
unify(ARG3, MkIntTerm(buf.st_size)) &&
unify(ARG4, MkIntTerm(buf.st_mtime)) &&
unify(ARG5, MkIntTerm(buf.st_mode))
YAP_Unify(YAP_ARG3, YAP_MkIntTerm(buf.st_size)) &&
YAP_Unify(YAP_ARG4, YAP_MkIntTerm(buf.st_mtime)) &&
YAP_Unify(YAP_ARG5, YAP_MkIntTerm(buf.st_mode))
);
}
@ -332,7 +332,7 @@ p_mktemp(void)
{
#if HAVE_MKTEMP
char *s, tmp[BUF_SIZE];
s = AtomName(AtomOfTerm(ARG1));
s = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
#if HAVE_STRNCPY
strncpy(tmp, s, BUF_SIZE);
#else
@ -344,9 +344,9 @@ p_mktemp(void)
if ((s = mktemp(tmp)) == NULL) {
#endif
/* return an error number */
return(unify(ARG3, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno)));
}
return(unify(ARG2,MkAtomTerm(LookupAtom(s))));
return(YAP_Unify(YAP_ARG2,YAP_MkAtomTerm(YAP_LookupAtom(s))));
#else
oops
#endif
@ -357,7 +357,7 @@ static int
p_tpmnam(void)
{
#if HAVE_TMPNAM
return(unify(ARG1,MkAtomTerm(LookupAtom(tmpnam(NULL)))));
return(YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom(tmpnam(NULL)))));
#else
oops
#endif
@ -373,10 +373,10 @@ p_environ(void)
#else
extern char **environ;
#endif
Term t1 = ARG1;
Int i;
YAP_Term t1 = YAP_ARG1;
long int i;
i = IntOfTerm(t1);
i = YAP_IntOfTerm(t1);
#if defined(__MINGW32__) || _MSC_VER
if (_environ[i] == NULL)
#else
@ -384,20 +384,20 @@ p_environ(void)
#endif
return(FALSE);
else {
Term t = BufferToString(environ[i]);
return(unify(t, ARG2));
YAP_Term t = YAP_BufferToString(environ[i]);
return(YAP_Unify(t, YAP_ARG2));
}
#else
YapError("environ not available in this configuration");
YAP_Error("environ not available in this configuration");
return(FALSE);
#endif
}
#if defined(__MINGW32__) || _MSC_VER
static HANDLE
get_handle(Term ti, DWORD fd)
get_handle(YAP_Term ti, DWORD fd)
{
if (IsAtomTerm(ti)) {
if (YAP_IsAtomTerm(ti)) {
HANDLE out;
SECURITY_ATTRIBUTES satt;
@ -413,17 +413,17 @@ get_handle(Term ti, DWORD fd)
NULL);
return(out);
} else {
if (IsIntTerm(ti)) {
if (YAP_IsIntTerm(ti)) {
return(GetStdHandle(fd));
} else
return((HANDLE)YapStreamToFileNo(ti));
return((HANDLE)YAP_StreamToFileNo(ti));
}
}
static void
close_handle(Term ti, HANDLE h)
close_handle(YAP_Term ti, HANDLE h)
{
if (IsAtomTerm(ti)) {
if (YAP_IsAtomTerm(ti)) {
CloseHandle(h);
}
}
@ -434,7 +434,7 @@ close_handle(Term ti, HANDLE h)
static int
execute_command(void)
{
Term ti = ARG2, to = ARG3, te = ARG4;
YAP_Term ti = YAP_ARG2, to = YAP_ARG3, te = YAP_ARG4;
int res;
#if defined(__MINGW32__) || _MSC_VER
HANDLE inpf, outf, errf;
@ -443,20 +443,20 @@ execute_command(void)
PROCESS_INFORMATION ProcessInformation;
inpf = get_handle(ti, STD_INPUT_HANDLE);
if (inpf == INVALID_HANDLE_VALUE) {
return(unify(ARG6, WinError()));
return(YAP_Unify(YAP_ARG6, WinError()));
}
outf = get_handle(to, STD_OUTPUT_HANDLE);
if (outf == INVALID_HANDLE_VALUE) {
close_handle(ti, inpf);
return(unify(ARG6, WinError()));
return(YAP_Unify(YAP_ARG6, WinError()));
}
errf = get_handle(te, STD_OUTPUT_HANDLE);
if (errf == INVALID_HANDLE_VALUE) {
close_handle(ti, inpf);
close_handle(to, outf);
return(unify(ARG6, WinError()));
return(YAP_Unify(YAP_ARG6, WinError()));
}
if (!IsIntTerm(ti) && !IsIntTerm(to) && !IsIntTerm(te)) {
if (!YAP_IsIntTerm(ti) && !YAP_IsIntTerm(to) && !YAP_IsIntTerm(te)) {
/* we do not keep a current stream */
CreationFlags = DETACHED_PROCESS;
}
@ -472,7 +472,7 @@ execute_command(void)
StartupInfo.hStdError = errf;
/* got stdin, stdout and error as I like it */
if (CreateProcess(NULL,
AtomName(AtomOfTerm(ARG1)),
YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)),
NULL,
NULL,
TRUE,
@ -484,62 +484,62 @@ execute_command(void)
close_handle(ti, inpf);
close_handle(to, outf);
close_handle(te, errf);
return(unify(ARG6, WinError()));
return(YAP_Unify(YAP_ARG6, WinError()));
}
close_handle(ti, inpf);
close_handle(to, outf);
close_handle(te, errf);
res = ProcessInformation.dwProcessId;
return(unify(ARG5,MkIntTerm(res)));
return(YAP_Unify(YAP_ARG5,YAP_MkIntTerm(res)));
#else /* UNIX CODE */
int inpf, outf, errf;
/* process input first */
if (IsAtomTerm(ti)) {
if (YAP_IsAtomTerm(ti)) {
inpf = open("/dev/null", O_RDONLY);
} else {
int sd;
if (IsIntTerm(ti))
if (YAP_IsIntTerm(ti))
sd = 0;
else
sd = YapStreamToFileNo(ti);
sd = YAP_StreamToFileNo(ti);
inpf = dup(sd);
}
if (inpf < 0) {
/* return an error number */
return(unify(ARG6, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG6, YAP_MkIntTerm(errno)));
}
/* then output stream */
if (IsAtomTerm(to)) {
if (YAP_IsAtomTerm(to)) {
outf = open("/dev/zero", O_WRONLY);
} else {
int sd;
if (IsIntTerm(to))
if (YAP_IsIntTerm(to))
sd = 1;
else
sd = YapStreamToFileNo(to);
sd = YAP_StreamToFileNo(to);
outf = dup(sd);
}
if (outf < 0) {
/* return an error number */
close(inpf);
return(unify(ARG6, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG6, YAP_MkIntTerm(errno)));
}
/* then error stream */
if (IsAtomTerm(te)) {
if (YAP_IsAtomTerm(te)) {
errf = open("/dev/zero", O_WRONLY);
} else {
int sd;
if (IsIntTerm(te))
if (YAP_IsIntTerm(te))
sd = 2;
else
sd = YapStreamToFileNo(te);
sd = YAP_StreamToFileNo(te);
errf = dup(sd);
}
if (errf < 0) {
/* return an error number */
close(inpf);
close(outf);
return(unify(ARG6, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG6, YAP_MkIntTerm(errno)));
}
/* we are now ready to fork */
if ((res = fork()) < 0) {
@ -548,13 +548,13 @@ execute_command(void)
close(outf);
close(errf);
/* return an error number */
return(unify(ARG6, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG6, YAP_MkIntTerm(errno)));
} else if (res == 0) {
char *argv[4];
/* child */
/* close current streams, but not std streams */
YapCloseAllOpenStreams();
YAP_CloseAllOpenStreams();
close(0);
dup(inpf);
close(inpf);
@ -566,7 +566,7 @@ execute_command(void)
close(errf);
argv[0] = "sh";
argv[1] = "-c";
argv[2] = AtomName(AtomOfTerm(ARG1));
argv[2] = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
argv[3] = NULL;
execv("/bin/sh", argv);
exit(127);
@ -575,7 +575,7 @@ execute_command(void)
close(inpf);
close(outf);
close(errf);
return(unify(ARG5,MkIntTerm(res)));
return(YAP_Unify(YAP_ARG5,YAP_MkIntTerm(res)));
}
#endif /* UNIX code */
}
@ -584,15 +584,15 @@ execute_command(void)
static int
do_system(void)
{
char *command = AtomName(AtomOfTerm(ARG1));
char *command = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
#if HAVE_SYSTEM
int sys = system(command);
if (sys < 0) {
return(unify(ARG3,MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG3,YAP_MkIntTerm(errno)));
}
return(unify(ARG2, MkIntTerm(sys)));
return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(sys)));
#else
YapError("system not available in this configuration");
YAP_Error("system not available in this configuration");
return(FALSE);
#endif
}
@ -604,35 +604,35 @@ static int
do_shell(void)
{
#if defined(__MINGW32__) || _MSC_VER
char *buf = YapAllocSpaceFromYap(BUF_SIZE);
char *buf = YAP_AllocSpaceFromYap(BUF_SIZE);
int sys;
if (buf == NULL) {
YapError("No Temporary Space for Shell");
YAP_Error("No Temporary Space for Shell");
return(FALSE);
}
#if HAVE_STRNCPY
strncpy(YapAtomName(AtomOfTerm(ARG1)), buf, BUF_SIZE);
strncpy(YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)), buf, BUF_SIZE);
strncpy(" ", buf, BUF_SIZE);
strncpy(YapAtomName(AtomOfTerm(ARG2)), buf, BUF_SIZE);
strncpy(YAP_AtomName(YAP_AtomOfTerm(YAP_ARG2)), buf, BUF_SIZE);
strncpy(" ", buf, BUF_SIZE);
strncpy(YapAtomName(AtomOfTerm(ARG3)), buf, BUF_SIZE);
strncpy(YAP_AtomName(YAP_AtomOfTerm(YAP_ARG3)), buf, BUF_SIZE);
#else
strcpy(YapAtomName(AtomOfTerm(ARG1)), buf);
strcpy(YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)), buf);
strcpy(" ", buf);
strcpy(YapAtomName(AtomOfTerm(ARG2)), buf);
strcpy(YAP_AtomName(YAP_AtomOfTerm(YAP_ARG2)), buf);
strcpy(" ", buf);
strcpy(YapAtomName(AtomOfTerm(ARG3)), buf);
strcpy(YAP_AtomName(YAP_AtomOfTerm(YAP_ARG3)), buf);
#endif
#if HAVE_SYSTEM
sys = system(buf);
YapFreeSpaceFromYap(buf);
YAP_FreeSpaceFromYap(buf);
if (sys < 0) {
return(unify(ARG5,MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG5,YAP_MkIntTerm(errno)));
}
return(unify(ARG4, MkIntTerm(sys)));
return(YAP_Unify(YAP_ARG4, YAP_MkIntTerm(sys)));
#else
YapError("system not available in this configuration");
YAP_Error("system not available in this configuration");
return(FALSE);
#endif
#else
@ -640,23 +640,23 @@ do_shell(void)
int t;
int sys;
cptr[0]= YapAtomName(AtomOfTerm(ARG1));
cptr[1]= YapAtomName(AtomOfTerm(ARG2));
cptr[2]= YapAtomName(AtomOfTerm(ARG3));
cptr[0]= YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
cptr[1]= YAP_AtomName(YAP_AtomOfTerm(YAP_ARG2));
cptr[2]= YAP_AtomName(YAP_AtomOfTerm(YAP_ARG3));
cptr[3]= NULL;
t = fork();
if (t < 0) {
return(unify(ARG5,MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG5,YAP_MkIntTerm(errno)));
} else if (t == 0) {
t = execvp(YapAtomName(AtomOfTerm(ARG1)),cptr);
t = execvp(YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)),cptr);
return(t);
} else {
t = wait(&sys);
if (t < 0) {
return(unify(ARG5,MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG5,YAP_MkIntTerm(errno)));
}
}
return(unify(ARG4, MkIntTerm(sys)));
return(YAP_Unify(YAP_ARG4, YAP_MkIntTerm(sys)));
#endif
}
@ -664,21 +664,21 @@ do_shell(void)
static int
p_wait(void)
{
Int pid = IntOfTerm(ARG1);
long int pid = YAP_IntOfTerm(YAP_ARG1);
#if defined(__MINGW32__) || _MSC_VER
HANDLE proc = OpenProcess(STANDARD_RIGHTS_REQUIRED|SYNCHRONIZE, FALSE, pid);
DWORD ExitCode;
if (proc == NULL) {
return(unify(ARG3, WinError()));
return(YAP_Unify(YAP_ARG3, WinError()));
}
if (WaitForSingleObject(proc, INFINITE) == WAIT_FAILED) {
return(unify(ARG3, WinError()));
return(YAP_Unify(YAP_ARG3, WinError()));
}
if (GetExitCodeProcess(proc, &ExitCode) == 0) {
return(unify(ARG3, WinError()));
return(YAP_Unify(YAP_ARG3, WinError()));
}
CloseHandle(proc);
return(unify(ARG2, MkIntTerm(ExitCode)));
return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(ExitCode)));
#else
do {
int status;
@ -687,9 +687,9 @@ p_wait(void)
if (waitpid(pid, &status, 0) == -1) {
if (errno != EINTR)
return -1;
return(unify(ARG3, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno)));
} else {
return(unify(ARG2, MkIntTerm(status)));
return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(status)));
}
} while(TRUE);
#endif
@ -699,10 +699,10 @@ p_wait(void)
static int
p_popen(void)
{
char *command = AtomName(AtomOfTerm(ARG1));
Int mode = IntOfTerm(ARG2);
char *command = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
long int mode = YAP_IntOfTerm(YAP_ARG2);
FILE *pfd;
Term tsno;
YAP_Term tsno;
int flags;
#if HAVE_POPEN
@ -719,29 +719,29 @@ p_popen(void)
pfd = popen(command, "w");
#endif
if (pfd == NULL) {
return(unify(ARG4, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG4, YAP_MkIntTerm(errno)));
}
if (mode == 0)
flags = YAP_INPUT_STREAM | YAP_POPEN_STREAM;
else
flags = YAP_OUTPUT_STREAM | YAP_POPEN_STREAM;
tsno = YapOpenStream((void *)pfd,
tsno = YAP_OpenStream((void *)pfd,
"pipe",
MkAtomTerm(LookupAtom("pipe")),
YAP_MkAtomTerm(YAP_LookupAtom("pipe")),
flags);
#endif
return(unify(ARG3, tsno));
return(YAP_Unify(YAP_ARG3, tsno));
}
static int
p_sleep(void)
{
Term ts = ARG1;
Int secs = 0, usecs = 0, out;
if (IsIntTerm(ts)) {
secs = IntOfTerm(ts);
} else if (IsFloatTerm(ts)) {
flt tfl = FloatOfTerm(ts);
YAP_Term ts = YAP_ARG1;
long int secs = 0, usecs = 0, out;
if (YAP_IsIntTerm(ts)) {
secs = YAP_IntOfTerm(ts);
} else if (YAP_IsFloatTerm(ts)) {
double tfl = YAP_FloatOfTerm(ts);
if (tfl > 1.0)
secs = tfl;
else
@ -764,7 +764,7 @@ p_sleep(void)
}
#endif
#endif /* defined(__MINGW32__) || _MSC_VER */
return(unify(ARG2, MkIntTerm(out)));
return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(out)));
}
/* host info */
@ -776,27 +776,27 @@ host_name(void)
char name[MAX_COMPUTERNAME_LENGTH+1];
DWORD nSize = MAX_COMPUTERNAME_LENGTH+1;
if (GetComputerName(name, &nSize) == 0) {
return(unify(ARG2, WinError()));
return(YAP_Unify(YAP_ARG2, WinError()));
}
#else
#if HAVE_GETHOSTNAME
char name[256];
if (gethostname(name, 256) == -1) {
/* return an error number */
return(unify(ARG2, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno)));
}
#endif
#endif /* defined(__MINGW32__) || _MSC_VER */
return(unify(ARG1, MkAtomTerm(LookupAtom(name))));
return(YAP_Unify(YAP_ARG1, YAP_MkAtomTerm(YAP_LookupAtom(name))));
}
static int
host_id(void)
{
#if HAVE_GETHOSTID
return(unify(ARG1, MkIntTerm(gethostid())));
return(YAP_Unify(YAP_ARG1, YAP_MkIntTerm(gethostid())));
#else
return(unify(ARG1, MkIntTerm(0)));
return(YAP_Unify(YAP_ARG1, YAP_MkIntTerm(0)));
#endif
}
@ -804,9 +804,9 @@ static int
pid(void)
{
#if defined(__MINGW32__) || _MSC_VER
return(unify(ARG1, MkIntTerm(_getpid())));
return(YAP_Unify(YAP_ARG1, YAP_MkIntTerm(_getpid())));
#else
return(unify(ARG1, MkIntTerm(getpid())));
return(YAP_Unify(YAP_ARG1, YAP_MkIntTerm(getpid())));
#endif
}
@ -827,18 +827,18 @@ p_kill(void)
/* Windows does not support cross-process signals, so we shall do the
SICStus thing and assume that a signal to a process will
always kill it */
HANDLE proc = OpenProcess(STANDARD_RIGHTS_REQUIRED|PROCESS_TERMINATE, FALSE, IntOfTerm(ARG1));
HANDLE proc = OpenProcess(STANDARD_RIGHTS_REQUIRED|PROCESS_TERMINATE, FALSE, YAP_IntOfTerm(YAP_ARG1));
if (proc == NULL) {
return(unify(ARG3, WinError()));
return(YAP_Unify(YAP_ARG3, WinError()));
}
if (TerminateProcess(proc, -1) == 0) {
return(unify(ARG3, WinError()));
return(YAP_Unify(YAP_ARG3, WinError()));
}
CloseHandle(proc);
#else
if (kill(IntOfTerm(ARG1), IntOfTerm(ARG2)) < 0) {
if (kill(YAP_IntOfTerm(YAP_ARG1), YAP_IntOfTerm(YAP_ARG2)) < 0) {
/* return an error number */
return(unify(ARG3, MkIntTerm(errno)));
return(YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno)));
}
#endif /* defined(__MINGW32__) || _MSC_VER */
return(TRUE);
@ -848,10 +848,10 @@ static int
error_message(void)
{
#if HAVE_STRERROR
return(unify(ARG2,MkAtomTerm(LookupAtom(strerror(IntOfTerm(ARG1))))));
return(YAP_Unify(YAP_ARG2,YAP_MkAtomTerm(YAP_LookupAtom(strerror(YAP_IntOfTerm(YAP_ARG1))))));
#else
#if HAVE_STRERROR
return(unify(ARG2,ARG1));
return(YAP_Unify(YAP_ARG2,YAP_ARG1));
#endif
#endif
}
@ -859,29 +859,29 @@ error_message(void)
void
init_sys(void)
{
UserCPredicate("datime", datime, 2);
UserCPredicate("list_directory", list_directory, 3);
UserCPredicate("file_property", file_property, 7);
UserCPredicate("unlink", p_unlink, 2);
UserCPredicate("mkdir", p_mkdir, 2);
UserCPredicate("rmdir", p_rmdir, 2);
UserCPredicate("dir_separator", dir_separator, 1);
UserCPredicate("p_environ", p_environ, 2);
UserCPredicate("exec_command", execute_command, 6);
UserCPredicate("do_shell", do_shell, 5);
UserCPredicate("do_system", do_system, 3);
UserCPredicate("popen", p_popen, 4);
UserCPredicate("wait", p_wait, 3);
UserCPredicate("host_name", host_name, 2);
UserCPredicate("host_id", host_id, 2);
UserCPredicate("pid", pid, 2);
UserCPredicate("kill", p_kill, 3);
UserCPredicate("mktemp", p_mktemp, 3);
UserCPredicate("tmpnam", p_tpmnam, 2);
UserCPredicate("rename_file", rename_file, 3);
UserCPredicate("sleep", p_sleep, 2);
UserCPredicate("error_message", error_message, 2);
UserCPredicate("win", win, 0);
YAP_UserCPredicate("datime", datime, 2);
YAP_UserCPredicate("list_directory", list_directory, 3);
YAP_UserCPredicate("file_property", file_property, 7);
YAP_UserCPredicate("unlink", p_unlink, 2);
YAP_UserCPredicate("mkdir", p_mkdir, 2);
YAP_UserCPredicate("rmdir", p_rmdir, 2);
YAP_UserCPredicate("dir_separator", dir_separator, 1);
YAP_UserCPredicate("p_environ", p_environ, 2);
YAP_UserCPredicate("exec_command", execute_command, 6);
YAP_UserCPredicate("do_shell", do_shell, 5);
YAP_UserCPredicate("do_system", do_system, 3);
YAP_UserCPredicate("popen", p_popen, 4);
YAP_UserCPredicate("wait", p_wait, 3);
YAP_UserCPredicate("host_name", host_name, 2);
YAP_UserCPredicate("host_id", host_id, 2);
YAP_UserCPredicate("pid", pid, 2);
YAP_UserCPredicate("kill", p_kill, 3);
YAP_UserCPredicate("mktemp", p_mktemp, 3);
YAP_UserCPredicate("tmpnam", p_tpmnam, 2);
YAP_UserCPredicate("rename_file", rename_file, 3);
YAP_UserCPredicate("sleep", p_sleep, 2);
YAP_UserCPredicate("error_message", error_message, 2);
YAP_UserCPredicate("win", win, 0);
}
#ifdef _WIN32

524
library/yap2swi/yap2swi.c
View File

File diff suppressed because it is too large Load Diff

8
library/yap2swi/yap2swi.h
View File

@ -12,7 +12,7 @@
//=== includes ===============================================================
#include <c_interface.h>
#include <YapInterface.h>
#include <stdarg.h>
#if defined(_MSC_VER) && defined(YAP_EXPORTS)
@ -24,8 +24,8 @@
typedef unsigned int fid_t;
typedef unsigned int term_t;
typedef int module_t;
typedef Atom atom_t;
typedef Term *predicate_t;
typedef YAP_Atom atom_t;
typedef YAP_Term *predicate_t;
typedef struct open_query_struct *qid_t;
typedef long functor_t;
typedef int (*PL_agc_hook_t)(atom_t);
@ -95,7 +95,7 @@ extern X_API term_t PL_new_term_refs(int);
extern X_API void PL_reset_term_refs(term_t);
/* begin PL_get_* functions =============================*/
extern X_API int PL_get_arg(int, term_t, term_t);
extern X_API int PL_get_atom(term_t, Atom *);
extern X_API int PL_get_atom(term_t, YAP_Atom *);
extern X_API int PL_get_atom_chars(term_t, char **);
extern X_API int PL_get_chars(term_t, char **, unsigned);
extern X_API int PL_get_functor(term_t, functor_t *);

2
m4/Yatom.h.m4
View File

@ -239,7 +239,7 @@ Inline(IsPredProperty, PropFlags, int, flags, (flags == PEProp) )
/********* maximum number of C-written predicates and cmp funcs ******************/
#define MAX_C_PREDS 360
#define MAX_C_PREDS 400
#define MAX_CMP_FUNCS 20
typedef struct {

166
misc/yap.def
View File

@ -1,85 +1,85 @@
EXPORTS
YapA
YapInit
YapRunGoal
YapRestartGoal
YapReset
Deref
YapIsVarTerm
YapIsNonVarTerm
YapMkVarTerm
YapIsIntTerm
YapIsFloatTerm
YapIsDbRefTerm
YapIsAtomTerm
YapIsPairTerm
YapIsApplTerm
YapMkIntTerm
YapIntOfTerm
YapMkFloatTerm
YapFloatOfTerm
YapMkAtomTerm
YapAtomOfTerm
YapLookupAtom
YapFullLookupAtom
YapAtomName
YapMkPairTerm
YapMkNewPairTerm
YapHeadOfTerm
YapTailOfTerm
YapMkApplTerm
YapMkNewApplTerm
YapFunctorOfTerm
YapArgOfTerm
YapMkFunctor
YapNameOfFunctor
YapArityOfFunctor
YapExtraSpace
YapUnify
UserCPredicate
UserBackCPredicate
YapCallProlog
Yapcut_fail
Yapcut_succeed
YapAllocSpaceFromYap
YapFreeSpaceFromYap
YapStringToBuffer
YapBufferToString
YapBufferToAtomList
YapError
YapRunGoal
YapContinueGoal
YapPruneGoal
YapGoalHasException
YapRead
YapCompileClause
YapInit
YapFastInit
YapPutValue
YapGetValue
YapReset
YapExit
YapInitSocks
YapSetOutputMessage
YapWrite
YapInitConsult
YapEndConsult
YapStreamToFileNo
YapCloseAllOpenStreams
YapOpenStream
YapNewSlots
YapInitSlot
YapGetFromSlot
YapAddressFromSlot
YapPutInSlot
YapRecoverSlots
YapThrow
YapLookupModule
YapModuleName
YapHalt
YapTopOfLocalStack
YapPredicate
YapCurrentModule
YapPredicateInfo
YapUserCPredicateWithArgs
YAP_A
YAP_Init
YAP_RunGoal
YAP_RestartGoal
YAP_Reset
YAP_Deref
YAP_IsVarTerm
YAP_IsNonVarTerm
YAP_MkVarTerm
YAP_IsIntTerm
YAP_IsFloatTerm
YAP_IsDbRefTerm
YAP_IsAtomTerm
YAP_IsPairTerm
YAP_IsApplTerm
YAP_MkIntTerm
YAP_IntOfTerm
YAP_MkFloatTerm
YAP_FloatOfTerm
YAP_MkAtomTerm
YAP_AtomOfTerm
YAP_LookupAtom
YAP_FullLookupAtom
YAP_AtomName
YAP_MkPairTerm
YAP_MkNewPairTerm
YAP_HeadOfTerm
YAP_TailOfTerm
YAP_MkApplTerm
YAP_MkNewApplTerm
YAP_FunctorOfTerm
YAP_ArgOfTerm
YAP_MkFunctor
YAP_NameOfFunctor
YAP_ArityOfFunctor
YAP_ExtraSpace
YAP_Unify
YAP_UserCPredicate
YAP_UserCPredicateWithArgs
YAP_UserBackCPredicate
YAP_CallProlog
YAP_cut_fail
YAP_cut_succeed
YAP_AllocSpaceFromYap
YAP_FreeSpaceFromYap
YAP_StringToBuffer
YAP_BufferToString
YAP_BufferToAtomList
YAP_Error
YAP_RunGoal
YAP_ContinueGoal
YAP_PruneGoal
YAP_GoalHasException
YAP_Read
YAP_CompileClause
YAP_Init
YAP_FastInit
YAP_PutValue
YAP_GetValue
YAP_Reset
YAP_Exit
YAP_InitSocks
YAP_SetOutputMessage
YAP_Write
YAP_InitConsult
YAP_EndConsult
YAP_StreamToFileNo
YAP_CloseAllOpenStreams
YAP_OpenStream
YAP_NewSlots
YAP_InitSlot
YAP_GetFromSlot
YAP_AddressFromSlot
YAP_PutInSlot
YAP_RecoverSlots
YAP_Throw
YAP_LookupModule
YAP_ModuleName
YAP_Halt
YAP_TopOfLocalStack
YAP_Predicate
YAP_CurrentModule
YAP_PredicateInfo

36
pl/boot.yap
View File

@ -249,7 +249,7 @@ repeat :- '$repeat'.
% Hack in case expand_term has created a list of commands.
%
'$execute_commands'(V,_,_) :- var(V), !,
throw(error(instantiation_error,meta_call(V))).
'$do_error'(instantiation_error,meta_call(V)).
'$execute_commands'([],_,_) :- !, fail.
'$execute_commands'([C|_],VL,Con) :-
'$execute_command'(C,VL,Con).
@ -263,12 +263,12 @@ repeat :- '$repeat'.
%
'$execute_command'(C,_,top) :- var(C), !,
throw(error(instantiation_error,meta_call(C))).
'$do_error'(instantiation_error,meta_call(C)).
'$execute_command'(end_of_file,_,_).
'$execute_command'(C,_,top) :- number(C), !,
throw(error(type_error(callable,C),meta_call(C))).
'$do_error'(type_error(callable,C),meta_call(C)).
'$execute_command'(R,_,top) :- db_reference(R), !,
throw(error(type_error(callable,R),meta_call(R))).
'$do_error'(type_error(callable,R),meta_call(R)).
'$execute_command'((:-G),_,Option) :- !,
'$current_module'(M),
'$process_directive'(G, Option, M),
@ -288,7 +288,7 @@ repeat :- '$repeat'.
'$access_yap_flags'(8, 0), !, % YAP mode, go in and do it,
'$process_directive'(G, consult, M).
'$process_directive'(G, top, _) :- !,
throw(error(context_error((:- G),clause),query)).
'$do_error'(context_error((:- G),clause),query).
%
% always allow directives.
%
@ -313,7 +313,7 @@ repeat :- '$repeat'.
%
'$process_directive'(D, _, M) :-
'$access_yap_flags'(8, 1), !, % ISO Prolog mode, go in and do it,
throw(error(context_error((:- M:D),query),directive)).
'$do_error'(context_error((:- M:D),query),directive).
%
% but YAP and SICStus does.
%
@ -706,7 +706,7 @@ not(A) :-
\+ '$execute_within'(A).
'$call'(M:_,_,G0,_) :- var(M), !,
throw(error(instantiation_error,call(G0))).
'$do_error'(instantiation_error,call(G0)).
'$call'(M:G,CP,G0,_) :- !,
'$call'(G,CP,G0,M).
'$call'((X,Y),CP,G0,M) :- !,
@ -819,13 +819,13 @@ not(A) :-
'$check_callable'(V,G) :- var(V), !,
'$current_module'(Mod),
throw(error(instantiation_error,Mod:G)).
'$do_error'(instantiation_error,Mod:G).
'$check_callable'(A,G) :- number(A), !,
'$current_module'(Mod),
throw(error(type_error(callable,A),Mod:G)).
'$do_error'(type_error(callable,A),Mod:G).
'$check_callable'(R,G) :- db_reference(R), !,
'$current_module'(Mod),
throw(error(type_error(callable,R),Mod:G)).
'$do_error'(type_error(callable,R),Mod:G).
'$check_callable'(_,_).
% Called by the abstract machine, if no clauses exist for a predicate
@ -876,13 +876,13 @@ break :- '$get_value'('$break',BL), NBL is BL+1,
'$csult'(V, _) :- var(V), !,
throw(error(instantiation_error,consult(V))).
'$do_error'(instantiation_error,consult(V)).
'$csult'([], _) :- !.
'$csult'([-F|L], M) :- !, '$reconsult'(M:F), '$csult'(L, M).
'$csult'([F|L], M) :- '$consult'(M:F), '$csult'(L, M).
'$consult'(V) :- var(V), !,
throw(error(instantiation_error,consult(V))).
'$do_error'(instantiation_error,consult(V)).
'$consult'([]) :- !.
'$consult'([F|Fs]) :- !,
'$consult'(F),
@ -898,7 +898,7 @@ break :- '$get_value'('$break',BL), NBL is BL+1,
'$consult'(X,Stream),
'$close'(Stream).
'$consult'(X) :-
throw(error(permission_error(input,stream,X),consult(X))).
'$do_error'(permission_error(input,stream,X),consult(X)).
'$consult'(_,Stream) :-
@ -1002,7 +1002,7 @@ break :- '$get_value'('$break',BL), NBL is BL+1,
'$command'(Command,Vars,Status).
'$abort_loop'(Stream) :-
throw(error(permission_error(input,closed_stream,Stream), loop)).
'$do_error'(permission_error(input,closed_stream,Stream), loop).
/* General purpose predicates */
@ -1018,11 +1018,11 @@ break :- '$get_value'('$break',BL), NBL is BL+1,
'$check_head'(H,P).
'$check_head'(H,P) :- var(H), !,
throw(error(instantiation_error,P)).
'$do_error'(instantiation_error,P).
'$check_head'(H,P) :- number(H), !,
throw(error(type_error(callable,H),P)).
'$do_error'(type_error(callable,H),P).
'$check_head'(H,P) :- db_reference(H), !,
throw(error(type_error(callable,H),P)).
'$do_error'(type_error(callable,H),P).
'$check_head'(_,_).
% Path predicates
@ -1044,7 +1044,7 @@ break :- '$get_value'('$break',BL), NBL is BL+1,
'$find_in_path'(File,NewFile,_) :- atom(File), !,
'$search_in_path'(File,NewFile),!.
'$find_in_path'(File,_,Call) :-
throw(error(domain_error(source_sink,File),Call)).
'$do_error'(domain_error(source_sink,File),Call).
'$search_in_path'(New,New) :-
'$exists'(New,'$csult'), !.

2
pl/callcount.yap
View File

@ -30,7 +30,7 @@ call_count(Calls, Retries, Both) :-
'$check_if_call_count_on'(Calls, 1) :- integer(Calls), !.
'$check_if_call_count_on'(Calls, 0) :- var(Calls), !.
'$check_if_call_count_on'(Calls, _) :-
throw(error(type_error(integer,Calls),call_count(A))).
'$do_error'(type_error(integer,Calls),call_count(A)).

8
pl/checker.yap
View File

@ -187,7 +187,7 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
nl(user_error).
'$multifile'(V, _) :- var(V), !,
throw(error(instantiation_error,multifile(V))).
'$do_error'(instantiation_error,multifile(V)).
'$multifile'((X,Y), M) :- '$multifile'(X, M), '$multifile'(Y, M).
'$multifile'(Mod:PredSpec, _) :- !,
'$multifile'(PredSpec, Mod).
@ -201,10 +201,10 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
'$multifile'(N/A, M) :- !,
'$new_multifile'(N,A,M).
'$multifile'(P, M) :-
throw(error(type_error(predicate_indicator,P),multifile(M:P))).
'$do_error'(type_error(predicate_indicator,P),multifile(M:P)).
'$discontiguous'(V,M) :- var(V), !,
throw(error(instantiation_error,M:discontiguous(V))).
'$do_error'(instantiation_error,M:discontiguous(V)).
'$discontiguous'((X,Y),M) :- !,
'$discontiguous'(X,M),
'$discontiguous'(Y,M).
@ -217,7 +217,7 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
true
).
'$discontiguous'(P,M) :-
throw(error(type_error(predicate_indicator,P),M:discontiguous(P))).
'$do_error'(type_error(predicate_indicator,P),M:discontiguous(P)).
%
% did we declare multifile properly?

24
pl/consult.yap
View File

@ -19,7 +19,7 @@ ensure_loaded(V) :-
'$ensure_loaded'(V).
'$ensure_loaded'(V) :- var(V), !,
throw(error(instantiation_error,ensure_loaded(V))).
'$do_error'(instantiation_error,ensure_loaded(V)).
'$ensure_loaded'([]) :- !.
'$ensure_loaded'([F|Fs]) :- !,
'$ensure_loaded'(F),
@ -43,12 +43,12 @@ ensure_loaded(V) :-
),
'$close'(Stream).
'$ensure_loaded'(X) :-
throw(error(permission_error(input,stream,X),ensure_loaded(X))).
'$do_error'(permission_error(input,stream,X),ensure_loaded(X)).
compile(P) :-
'$has_yap_or',
throw(error(context_error(compile(P),clause),query)).
'$do_error'(context_error(compile(P),clause),query).
compile(P) :-
'$compile'(P).
@ -60,18 +60,18 @@ compile(P) :-
consult(Fs) :-
'$has_yap_or',
throw(error(context_error(consult(Fs),clause),query)).
'$do_error'(context_error(consult(Fs),clause),query).
consult(Fs) :-
'$consult'(Fs).
reconsult(Fs) :-
'$has_yap_or', fail,
throw(error(context_error(reconsult(Fs),clause),query)).
'$do_error'(context_error(reconsult(Fs),clause),query).
reconsult(Fs) :-
'$reconsult'(Fs).
'$reconsult'(V) :- var(V), !,
throw(error(instantiation_error,reconsult(V))).
'$do_error'(instantiation_error,reconsult(V)).
'$reconsult'([]) :- !.
'$reconsult'(M:X) :- atom(M), !,
'$current_module'(M0),
@ -87,7 +87,7 @@ reconsult(Fs) :-
'$reconsult'(X,Stream),
'$close'(Stream).
'$reconsult'(X) :-
throw(error(permission_error(input,stream,X),reconsult(X))).
'$do_error'(permission_error(input,stream,X),reconsult(X)).
'$reconsult'(F,Stream) :-
'$record_loaded'(Stream),
@ -154,11 +154,11 @@ reconsult(Fs) :-
'$initialization'(V) :-
var(V), !,
throw(error(instantiation_error,initialization(V))).
'$do_error'(instantiation_error,initialization(V)).
'$initialization'(C) :- number(C), !,
throw(error(type_error(callable,C),initialization(C))).
'$do_error'(type_error(callable,C),initialization(C)).
'$initialization'(C) :- db_reference(C), !,
throw(error(type_error(callable,C),initialization(C))).
'$do_error'(type_error(callable,C),initialization(C)).
'$initialization'(G) :-
'$recorda'('$initialisation',G,_),
fail.
@ -166,7 +166,7 @@ reconsult(Fs) :-
'$include'(V, _) :- var(V), !,
throw(error(instantiation_error,include(V))).
'$do_error'(instantiation_error,include(V)).
'$include'([], _) :- !.
'$include'([F|Fs], Status) :- !,
'$include'(F, Status),
@ -177,7 +177,7 @@ reconsult(Fs) :-
( '$open'(Y,'$csult',Stream,0), !,
'$loop'(Stream,Status), '$close'(Stream)
;
throw(error(permission_error(input,stream,Y),include(X)))
'$do_error'(permission_error(input,stream,Y),include(X))
),
'$set_value'('$included_file',OY).

26
pl/debug.yap
View File

@ -30,7 +30,7 @@
% $suspy does most of the work
'$suspy'(V,S,M) :- var(V) , !,
throw(error(instantiation_error,M:spy(V,S))).
'$do_error'(instantiation_error,M:spy(V,S)).
'$suspy'((M:S),P,_) :- !,
'$suspy'(S,P,M).
'$suspy'([],_,_) :- !.
@ -41,9 +41,9 @@
'$suspy'(A,S,M) :- atom(A), !,
'$suspy_predicates_by_name'(A,S,M).
'$suspy'(P,spy,M) :- !,
throw(error(domain_error(predicate_spec,P),spy(M:P))).
'$do_error'(domain_error(predicate_spec,P),spy(M:P)).
'$suspy'(P,nospy,M) :-
throw(error(domain_error(predicate_spec,P),nospy(M:P))).
'$do_error'(domain_error(predicate_spec,P),nospy(M:P)).
'$suspy_predicates_by_name'(A,S,M) :-
% just check one such predicate exists
@ -85,9 +85,9 @@
'$do_suspy'(S, F, N, T, M) :-
'$system_predicate'(T,M),
( S = spy ->
throw(error(permission_error(access,private_procedure,T),spy(M:F/N)))
'$do_error'(permission_error(access,private_procedure,T),spy(M:F/N))
;
throw(error(permission_error(access,private_procedure,T),nospy(M:F/N)))
'$do_error'(permission_error(access,private_procedure,T),nospy(M:F/N))
).
'$do_suspy'(S,F,N,T,M) :-
'$suspy2'(S,F,N,T,M).
@ -162,13 +162,13 @@ notrace :-
leash(X) :- var(X),
throw(error(instantiation_error,leash(X))).
'$do_error'(instantiation_error,leash(X)).
leash(X) :-
'$leashcode'(X,Code),
'$set_value'('$leash',Code),
'$show_leash'(informational,Code), !.
leash(X) :-
throw(error(type_error(leash_mode,X),leash(X))).
'$do_error'(type_error(leash_mode,X),leash(X)).
'$show_leash'(Msg,0) :-
'$print_message'(Msg,leash([])).
@ -194,10 +194,10 @@ leash(X) :-
'$leashcode'(N,N) :- integer(N), N >= 0, N =< 2'1111.
'$list2Code'(V,_) :- var(V), !,
throw(error(instantiation_error,leash(V))).
'$do_error'(instantiation_error,leash(V)).
'$list2Code'([],0) :- !.
'$list2Code'([V|L],_) :- var(V), !,
throw(error(instantiation_error,leash([V|L]))).
'$do_error'(instantiation_error,leash([V|L])).
'$list2Code'([call|L],N) :- '$list2Code'(L,N1), N is 2'1000 + N1.
'$list2Code'([exit|L],N) :- '$list2Code'(L,N1), N is 2'0100 + N1.
'$list2Code'([redo|L],N) :- '$list2Code'(L,N1), N is 2'0010 + N1.
@ -632,11 +632,11 @@ debugging :-
%'$creep_call'(G,_) :- write(user_error,'$creepcall'(G)), nl(user_error), fail.
'$creep_call'(V,M,_) :- var(V), !,
throw(error(instantiation_error,meta_call(M:V))).
'$do_error'(instantiation_error,meta_call(M:V)).
'$creep_call'(A,M,_) :- number(A), !,
throw(error(type_error(callable,A),meta_call(M:A))).
'$do_error'(type_error(callable,A),meta_call(M:A)).
'$creep_call'(R,M,_) :- db_reference(R), !,
throw(error(type_error(callable,R),meta_call(M:R))).
'$do_error'(type_error(callable,R),meta_call(M:R)).
'$creep_call'(M:G,_,CP) :- !,
'$creep_call'(G,M,CP).
'$creep_call'(fail,Module,_) :- !,
@ -744,7 +744,7 @@ debugging :-
G=[M|Goal],
'$execute'(M:Goal).
'$creep'([M|V]) :- var(V), !,
throw(error(instantiation_error,M:call(M:V))).
'$do_error'(instantiation_error,M:call(M:V)).
'$creep'([M|'$execute_in_mod'(G,ModNum)]) :- !,
'$module_number'(Mod,ModNum),
'$creep'([Mod|G]).

64
pl/directives.yap
View File

@ -190,9 +190,9 @@ yap_flag(bounded,X) :-
'$transl_to_true_false'(X1,X).
yap_flag(bounded,X) :- !,
(X = true ; X = false), !,
throw(error(permission_error(modify,flag,bounded),yap_flag(bounded,X))).
'$do_error'(permission_error(modify,flag,bounded),yap_flag(bounded,X)).
yap_flag(bounded,X) :-
throw(error(domain_error(flag_value,bounded+X),yap_flag(bounded,X))).
'$do_error'(domain_error(flag_value,bounded+X),yap_flag(bounded,X)).
% do or do not indexation
yap_flag(index,X) :- var(X), !,
@ -205,7 +205,7 @@ yap_flag(informational_messages,X) :- var(X), !,
yap_flag(informational_messages,on) :- !, '$set_value'('$verbose',on).
yap_flag(informational_messages,off) :- !, '$set_value'('$verbose',off).
yap_flag(informational_messages,X) :-
throw(error(domain_error(flag_value,informational_messages+X),yap_flag(informational_messages,X))).
'$do_error'(domain_error(flag_value,informational_messages+X),yap_flag(informational_messages,X)).
yap_flag(integer_rounding_function,X) :-
var(X), !,
@ -213,9 +213,9 @@ yap_flag(integer_rounding_function,X) :-
'$transl_to_rounding_function'(X1,X).
yap_flag(integer_rounding_function,X) :-
(X = down; X = toward_zero), !,
throw(error(permission_error(modify,flag,integer_rounding_function),yap_flag(integer_rounding_function,X))).
'$do_error'(permission_error(modify,flag,integer_rounding_function),yap_flag(integer_rounding_function,X)).
yap_flag(integer_rounding_function,X) :-
throw(error(domain_error(flag_value,integer_rounding_function+X),yap_flag(integer_rounding_function,X))).
'$do_error'(domain_error(flag_value,integer_rounding_function+X),yap_flag(integer_rounding_function,X)).
yap_flag(max_arity,X) :-
var(X), !,
@ -223,15 +223,15 @@ yap_flag(max_arity,X) :-
'$transl_to_arity'(X1,X).
yap_flag(max_arity,X) :-
integer(X), X > 0, !,
throw(error(permission_error(modify,flag,max_arity),yap_flag(max_arity,X))).
'$do_error'(permission_error(modify,flag,max_arity),yap_flag(max_arity,X)).
yap_flag(max_arity,X) :-
throw(error(domain_error(flag_value,max_arity+X),yap_flag(max_arity,X))).
'$do_error'(domain_error(flag_value,max_arity+X),yap_flag(max_arity,X)).
yap_flag(version,X) :-
var(X), !,
'$get_value'('$version_name',X).
yap_flag(version,X) :-
throw(error(permission_error(modify,flag,version),yap_flag(version,X))).
'$do_error'(permission_error(modify,flag,version),yap_flag(version,X)).
yap_flag(max_integer,X) :-
var(X), !,
@ -239,9 +239,9 @@ yap_flag(max_integer,X) :-
'$access_yap_flags'(3, X).
yap_flag(max_integer,X) :-
integer(X), X > 0, !,
throw(error(permission_error(modify,flag,max_integer),yap_flag(max_integer,X))).
'$do_error'(permission_error(modify,flag,max_integer),yap_flag(max_integer,X)).
yap_flag(max_integer,X) :-
throw(error(domain_error(flag_value,max_integer+X),yap_flag(max_integer,X))).
'$do_error'(domain_error(flag_value,max_integer+X),yap_flag(max_integer,X)).
yap_flag(min_integer,X) :-
var(X), !,
@ -249,9 +249,9 @@ yap_flag(min_integer,X) :-
'$access_yap_flags'(4, X).
yap_flag(min_integer,X) :-
integer(X), X < 0, !,
throw(error(permission_error(modify,flag,min_integer),yap_flag(min_integer,X))).
'$do_error'(permission_error(modify,flag,min_integer),yap_flag(min_integer,X)).
yap_flag(min_integer,X) :-
throw(error(domain_error(flag_value,min_integer+X),yap_flag(min_integer,X))).
'$do_error'(domain_error(flag_value,min_integer+X),yap_flag(min_integer,X)).
yap_flag(char_conversion,X) :-
var(X), !,
@ -266,7 +266,7 @@ yap_flag(char_conversion,X) :-
'$disable_char_conversion'
).
yap_flag(char_conversion,X) :-
throw(error(domain_error(flag_value,char_conversion+X),yap_flag(char_conversion,X))).
'$do_error'(domain_error(flag_value,char_conversion+X),yap_flag(char_conversion,X)).
yap_flag(double_quotes,X) :-
var(X), !,
@ -276,7 +276,7 @@ yap_flag(double_quotes,X) :-
'$transl_to_trl_types'(X1,X), !,
'$set_yap_flags'(6,X1).
yap_flag(double_quotes,X) :-
throw(error(domain_error(flag_value,double_quotes+X),yap_flag(double_quotes,X))).
'$do_error'(domain_error(flag_value,double_quotes+X),yap_flag(double_quotes,X)).
yap_flag(n_of_integer_keys_in_db,X) :-
var(X), !,
@ -284,7 +284,7 @@ yap_flag(n_of_integer_keys_in_db,X) :-
yap_flag(n_of_integer_keys_in_db,X) :- integer(X), X > 0, !,
'$resize_int_keys'(X).
yap_flag(n_of_integer_keys_in_db,X) :-
throw(error(domain_error(flag_value,n_of_integer_keys_in_db+X),yap_flag(n_of_integer_keys_in_db,X))).
'$do_error'(domain_error(flag_value,n_of_integer_keys_in_db+X),yap_flag(n_of_integer_keys_in_db,X)).
yap_flag(n_of_integer_keys_in_bb,X) :-
var(X), !,
@ -292,7 +292,7 @@ yap_flag(n_of_integer_keys_in_bb,X) :-
yap_flag(n_of_integer_keys_in_bb,X) :- integer(X), X > 0, !,
'$resize_bb_int_keys'(X).
yap_flag(n_of_integer_keys_in_bb,X) :-
throw(error(domain_error(flag_value,n_of_integer_keys_in_bb+X),yap_flag(n_of_integer_keys_in_bb,X))).
'$do_error'(domain_error(flag_value,n_of_integer_keys_in_bb+X),yap_flag(n_of_integer_keys_in_bb,X)).
yap_flag(strict_iso,OUT) :-
var(OUT), !,
@ -306,7 +306,7 @@ yap_flag(strict_iso,off) :- !,
'$transl_to_on_off'(X,off),
'$set_yap_flags'(9,X).
yap_flag(strict_iso,X) :-
throw(error(domain_error(flag_value,strict_iso+X),yap_flag(strict_iso,X))).
'$do_error'(domain_error(flag_value,strict_iso+X),yap_flag(strict_iso,X)).
yap_flag(language,X) :-
var(X), !,
@ -317,7 +317,7 @@ yap_flag(language,X) :-
'$set_yap_flags'(8,N),
'$adjust_language'(X).
yap_flag(language,X) :-
throw(error(domain_error(flag_value,language+X),yap_flag(language,X))).
'$do_error'(domain_error(flag_value,language+X),yap_flag(language,X)).
yap_flag(debug,X) :-
var(X), !,
@ -330,7 +330,7 @@ yap_flag(debug,X) :-
'$transl_to_on_off'(_,X), !,
(X = on -> debug ; nodebug).
yap_flag(debug,X) :-
throw(error(domain_error(flag_value,debug+X),yap_flag(debug,X))).
'$do_error'(domain_error(flag_value,debug+X),yap_flag(debug,X)).
yap_flag(discontiguous_warnings,X) :-
var(X), !,
@ -347,7 +347,7 @@ yap_flag(discontiguous_warnings,X) :-
;
'$syntax_check_discontiguous'(_,off)).
yap_flag(discontiguous_warnings,X) :-
throw(error(domain_error(flag_value,discontiguous_warnings+X),yap_flag(discontiguous_warnings,X))).
'$do_error'(domain_error(flag_value,discontiguous_warnings+X),yap_flag(discontiguous_warnings,X)).
yap_flag(redefine_warnings,X) :-
var(X), !,
@ -364,7 +364,7 @@ yap_flag(redefine_warnings,X) :-
;
'$syntax_check_multiple'(_,off)).
yap_flag(redefine_warnings,X) :-
throw(error(domain_error(flag_value,redefine_warnings+X),yap_flag(redefine_warnings,X))).
'$do_error'(domain_error(flag_value,redefine_warnings+X),yap_flag(redefine_warnings,X)).
yap_flag(single_var_warnings,X) :-
var(X), !,
@ -381,7 +381,7 @@ yap_flag(single_var_warnings,X) :-
;
'$syntax_check_single_var'(_,off)).
yap_flag(single_var_warnings,X) :-
throw(error(domain_error(flag_value,single_var_warnings+X),yap_flag(single_var_warnings,X))).
'$do_error'(domain_error(flag_value,single_var_warnings+X),yap_flag(single_var_warnings,X)).
yap_flag(unknown,X) :-
var(X), !,
@ -397,7 +397,7 @@ yap_flag(to_chars_mode,quintus) :- !,
yap_flag(to_chars_mode,iso) :- !,
'$set_yap_flags'(7,1).
yap_flag(to_chars_mode,X) :-
throw(error(domain_error(flag_value,to_chars_mode+X),yap_flag(to_chars_mode,X))).
'$do_error'(domain_error(flag_value,to_chars_mode+X),yap_flag(to_chars_mode,X)).
yap_flag(character_escapes,X) :-
var(X), !,
@ -407,7 +407,7 @@ yap_flag(character_escapes,X) :- !,
'$transl_to_character_escape_modes'(Y,X), !,
'$set_yap_flags'(12,Y).
yap_flag(character_escapes,X) :-
throw(error(domain_error(flag_value,character_escapes+X),yap_flag(to_chars_mode,X))).
'$do_error'(domain_error(flag_value,character_escapes+X),yap_flag(to_chars_mode,X)).
yap_flag(update_semantics,X) :-
var(X), !,
@ -419,7 +419,7 @@ yap_flag(update_semantics,logical_assert) :- !,
yap_flag(update_semantics,immediate) :- !,
'$switch_log_upd'(0).
yap_flag(update_semantics,X) :-
throw(error(domain_error(flag_value,update_semantics+X),yap_flag(update_semantics,X))).
'$do_error'(domain_error(flag_value,update_semantics+X),yap_flag(update_semantics,X)).
yap_flag(toplevel_hook,X) :-
var(X), !,
@ -444,7 +444,7 @@ yap_flag(write_strings,off) :- !,
'$transl_to_on_off'(X,off),
'$set_yap_flags'(13,X).
yap_flag(write_strings,X) :-
throw(error(domain_error(flag_value,write_strings+X),yap_flag(write_strings,X))).
'$do_error'(domain_error(flag_value,write_strings+X),yap_flag(write_strings,X)).
yap_flag(user_input,OUT) :-
var(OUT), !,
@ -492,7 +492,7 @@ yap_flag(fileerrors,on) :- !,
yap_flag(fileerrors,off) :- !,
'$set_value'(fileerrors,0).
yap_flag(fileerrors,X) :-
throw(error(domain_error(flag_value,fileerrors+X),yap_flag(fileerrors,X))).
'$do_error'(domain_error(flag_value,fileerrors+X),yap_flag(fileerrors,X)).
:- '$recorda'('$print_options','$toplevel'([quoted(true),numbervars(true),portrayed(true)]),_).
@ -631,23 +631,23 @@ current_prolog_flag(V,Out) :-
yap_flag(V,NOut),
NOut = Out.
current_prolog_flag(V,Out) :-
throw(error(type_error(atom,V),current_prolog_flag(V,Out))).
'$do_error'(type_error(atom,V),current_prolog_flag(V,Out)).
set_prolog_flag(F,V) :-
var(F), !,
throw(error(instantiation_error,set_prolog_flag(F,V))).
'$do_error'(instantiation_error,set_prolog_flag(F,V)).
set_prolog_flag(F,V) :-
var(V), !,
throw(error(instantiation_error,set_prolog_flag(F,V))).
'$do_error'(instantiation_error,set_prolog_flag(F,V)).
set_prolog_flag(F,V) :-
\+ atom(F), !,
throw(error(type_error(atom,F),set_prolog_flag(F,V))).
'$do_error'(type_error(atom,F),set_prolog_flag(F,V)).
set_prolog_flag(F,V) :-
yap_flag(F,V).
prolog_flag(F, Old, New) :-
var(F), !,
throw(error(instantiation_error,prolog_flag(F,Old,New))).
'$do_error'(instantiation_error,prolog_flag(F,Old,New)).
prolog_flag(F, Old, New) :-
current_prolog_flag(F, Old),
set_prolog_flag(F, New).

57
pl/errors.yap
View File

@ -15,6 +15,10 @@
* *
*************************************************************************/
'$do_error'(Type,Message) :-
'$current_stack'(local_sp(_,Envs,CPs)),
throw(error(Type,[Message|local_sp(Message,Envs,CPs)])).
'$Error'(E) :-
'$LoopError'(E).
@ -47,8 +51,13 @@ print_message(Level, Mss) :-
'$print_message'(Severity, Msg) :-
\+ '$undefined'(portray_message(Severity, Msg), user),
user:portray_message(Severity, Msg), !.
'$print_message'(error,error(Msg,Where)) :-
'$output_error_message'(Msg, Where), !.
'$print_message'(error,error(syntax_error(A,B,C,D,E,F),_)) :- !,
'$output_error_message'(syntax_error(A,B,C,D,E,F), 'SYNTAX ERROR').
'$print_message'(error,error(Msg,[Info|local_sp(Where,Envs,CPs)])) :-
'$show_cps'(CPs),
'$show_envs'(Envs),
'$prepare_loc'(Info,Where,Location),
'$output_error_message'(Msg, Location), !.
'$print_message'(error,Throw) :-
'$format'(user_error,"[ No handler for error ~w ]~n", [Throw]).
'$print_message'(informational,M) :-
@ -127,6 +136,50 @@ print_message(Level, Mss) :-
'$format'(user_error,"~n ~w",[P]),
'$print_list_of_preds'(L).
'$show_cps'(List) :-
'$format'(user_error,"[ Goals with alternatives open:~n",[]),
'$print_stack'(List),
'$format'(user_error," ]~n",[]).
'$show_envs'(List) :-
'$format'(user_error,"[ Goals left to continue:~n",[]),
'$print_stack'(List),
'$format'(user_error," ]~n",[]).
'$prepare_loc'(Info,Where,Location) :- integer(Where), !,
'$pred_for_code'(Where,Name,Arity,Mod,Clause),
'$construct_code'(Clause,Name,Arity,Mod,Info,Location).
'$prepare_loc'(Info,Where,Info).
'$print_stack'([]).
'$print_stack'([G|List]) :-
'$pred_for_code'(G,Name,Arity,Mod,Clause),
(
Name = '$yes_no' ; Name = '$query' ; Name = '$do_yes_no' ->
true
;
'$show_goal'(Clause,Name,Arity,Mod),
'$print_stack'(List)
).
'$show_goal'(-1,Name,Arity,Mod) :- !,
'$format'(" ~a:~a/~d at indexing code~n",[Mod,Name,Arity]).
'$show_goal'(0,Name,Arity,Mod) :- !.
'$show_goal'(I,Name,Arity,Mod) :-
'$format'(" ~a:~a/~d at clause ~d~n",[Mod,Name,Arity,I]).
'$construct_code'(-1,Name,Arity,Mod,Where,Location) :- !,
number_codes(Arity,ArityCode),
atom_codes(ArityAtom,ArityCode),
atom_concat([Where,' at ',Mod,':',Name,'/',ArityAtom,' at indexing code'],Location).
'$construct_code'(0,_,_,_,Location,Location) :- !.
'$construct_code'(Cl,Name,Arity,Mod,Where,Location) :-
number_codes(Arity,ArityCode),
atom_codes(ArityAtom,ArityCode),
number_codes(Cl,ClCode),
atom_codes(ClAtom,ClCode),
atom_concat([Where,' at ',Mod,':',Name,'/',ArityAtom,' (clause ',ClAtom,')'],Location).
'$output_error_message'(context_error(Goal,Who),Where) :-
'$format'(user_error,"[ CONTEXT ERROR- ~w: ~w appeared in ~w ]~n",
[Goal,Who,Where]).

4
pl/grammar.yap
View File

@ -108,10 +108,10 @@ phrase(PhraseDef, WordList) :-
phrase(P, S0, S) :-
var(P), !,
throw(error(instantiation_error,phrase(P,S0,S))).
'$do_error'(instantiation_error,phrase(P,S0,S)).
phrase(P, S0, S) :-
( primitive(P), \+ atom(P) ), !,
throw(error(type_error(callable,P),phrase(P,S0,S))).
'$do_error'(type_error(callable,P),phrase(P,S0,S)).
phrase([], S0, S) :- !,
S0 = S.
phrase([H|T], S0, S) :- !,

20
pl/load_foreign.yap
View File

@ -22,43 +22,43 @@ load_foreign_files(Objs,Libs,Entry) :-
'$load_foreign_files'(NewObjs,Libs,Entry).
'$check_objs_for_load_foreign_files'(V,_,G) :- var(V), !,
throw(error(instantiation_error,G)).
'$do_error'(instantiation_error,G).
'$check_objs_for_load_foreign_files'([],[],_) :- !.
'$check_objs_for_load_foreign_files'([Obj|Objs],[NObj|NewObjs],G) :- !,
'$check_obj_for_load_foreign_files'(Obj,NObj,G),
'$check_objs_for_load_foreign_files'(Objs,NewObjs,G).
'$check_objs_for_load_foreign_files'(Objs,_,G) :-
throw(error(type_error(list,Objs),G)).
'$do_error'(type_error(list,Objs),G).
'$check_obj_for_load_foreign_files'(V,_,G) :- var(V), !,
throw(error(instantiation_error,G)).
'$do_error'(instantiation_error,G).
'$check_obj_for_load_foreign_files'(Obj,NewObj,_) :- atom(Obj), !,
atom_codes(Obj,ObjCodes),
'$process_obj_suffix'(ObjCodes,NewObjCodes),
atom_codes(NewObj,NewObjCodes).
'$check_obj_for_load_foreign_files'(Obj,_,G) :-
throw(error(type_error(atom,Obj),G)).
'$do_error'(type_error(atom,Obj),G).
'$check_libs_for_load_foreign_files'(V,G) :- var(V), !,
throw(error(instantiation_error,G)).
'$do_error'(instantiation_error,G).
'$check_libs_for_load_foreign_files'([],_) :- !.
'$check_libs_for_load_foreign_files'([Lib|Libs],G) :- !,
'$check_lib_for_load_foreign_files'(Lib,G),
'$check_libs_for_load_foreign_files'(Libs,G).
'$check_libs_for_load_foreign_files'(Libs,G) :-
throw(error(type_error(list,Libs),G)).
'$do_error'(type_error(list,Libs),G).
'$check_lib_for_load_foreign_files'(V,G) :- var(V), !,
throw(error(instantiation_error,G)).
'$do_error'(instantiation_error,G).
'$check_lib_for_load_foreign_files'(Lib,_) :- atom(Lib), !.
'$check_lib_for_load_foreign_files'(Lib,G) :-
throw(error(type_error(atom,Lib),G)).
'$do_error'(type_error(atom,Lib),G).
'$check_entry_for_load_foreign_files'(V,G) :- var(V), !,
throw(error(instantiation_error,G)).
'$do_error'(instantiation_error,G).
'$check_entry_for_load_foreign_files'(Entry,_) :- atom(Entry), !.
'$check_entry_for_load_foreign_files'(Entry,G) :-
throw(error(type_error(atom,Entry),G)).
'$do_error'(type_error(atom,Entry),G).
'$process_obj_suffix'(ObjCodes,ObjCodes) :-

26
pl/modules.yap
View File

@ -23,7 +23,7 @@ use_module(M) :-
'$use_module'(M).
'$use_module'(V) :- var(V), !,
throw(error(instantiation_error,use_module(V))).
'$do_error'(instantiation_error,use_module(V)).
'$use_module'([]) :- !.
'$use_module'([A|B]) :- !,
'$use_module'(A),
@ -41,16 +41,16 @@ use_module(M) :-
'$ensure_loaded'(File)
).
'$use_module'(File) :-
throw(error(permission_error(input,stream,File),use_module(File))).
'$do_error'(permission_error(input,stream,File),use_module(File)).
use_module(M,I) :-
'$use_module'(M, I).
'$use_module'(File,Imports) :- var(File), !,
throw(error(instantiation_error,use_module(File,Imports))).
'$do_error'(instantiation_error,use_module(File,Imports)).
'$use_module'(File,Imports) :- var(Imports), !,
throw(error(instantiation_error,use_module(File,Imports))).
'$do_error'(instantiation_error,use_module(File,Imports)).
'$use_module'(M:F, Imports) :- atom(M), !,
'$current_module'(M0),
'$change_module'(M),
@ -76,7 +76,7 @@ use_module(M,I) :-
fail
).
'$use_module'(File,Imports) :-
throw(error(permission_error(input,stream,File),use_module(File,Imports))).
'$do_error'(permission_error(input,stream,File),use_module(File,Imports)).
use_module(Mod,F,I) :-
'$use_module'(Mod,F,I).
@ -113,7 +113,7 @@ use_module(Mod,F,I) :-
fail
).
'$use_module'(Module,File,Imports) :-
throw(error(permission_error(input,stream,File),use_module(Module,File,Imports))).
'$do_error'(permission_error(input,stream,File),use_module(Module,File,Imports)).
'$consulting_file_name'(Stream,F) :-
'$file_name'(Stream, F).
@ -139,17 +139,17 @@ use_module(Mod,F,I) :-
'$process_module_decls_options'(Var,Mod) :-
var(Var),
throw(error(instantiation_error,Mod)).
'$do_error'(instantiation_error,Mod).
'$process_module_decls_options'([],_).
'$process_module_decls_options'([H|L],M) :-
'$process_module_decls_option'(H,M),
'$process_module_decls_options'(L,M).
'$process_module_decls_options'(T,M) :-
throw(error(type_error(list,T),M)).
'$do_error'(type_error(list,T),M).
'$process_module_decls_option'(Var,M) :-
var(Var),
throw(error(instantiation_error,M)).
'$do_error'(instantiation_error,M).
'$process_module_decls_option'(At,_) :-
atom(At),
'$use_module'(At).
@ -158,7 +158,7 @@ use_module(Mod,F,I) :-
'$process_module_decls_option'(hidden(Bool),M) :-
'$process_hidden_module'(Bool, M).
'$process_module_decls_option'(Opt,M) :-
throw(error(domain_error(module_decl_options,Opt),M)).
'$do_error'(domain_error(module_decl_options,Opt),M).
'$process_hidden_module'(TNew,M) :-
'$convert_true_off_mod3'(TNew, New, M),
@ -168,7 +168,7 @@ use_module(Mod,F,I) :-
'$convert_true_off_mod3'(true, off, _).
'$convert_true_off_mod3'(false, on, _).
'$convert_true_off_mod3'(X, _, M) :-
throw(error(domain_error(module_decl_options,hidden(X)),M)).
'$do_error'(domain_error(module_decl_options,hidden(X)),M).
'$prepare_restore_hidden'(Old,Old) :- !.
'$prepare_restore_hidden'(Old,New) :-
@ -176,7 +176,7 @@ use_module(Mod,F,I) :-
module(N) :-
var(N),
throw(error(instantiation_error,module(N))).
'$do_error'(instantiation_error,module(N)).
module(N) :-
atom(N), !,
'$current_module'(_,N),
@ -187,7 +187,7 @@ module(N) :-
recorda('$module','$module'(F,N,[]),_)
).
module(N) :-
throw(error(type_error(atom,N),module(N))).
'$do_error'(type_error(atom,N),module(N)).
'$module_dec'(N,P) :-
'$current_module'(Old,N),

132
pl/preds.yap
View File

@ -19,29 +19,29 @@
% to dynamic code
asserta(V) :- var(V), !,
throw(error(instantiation_error,asserta(V))).
'$do_error'(instantiation_error,asserta(V)).
asserta(C) :-
'$current_module'(Mod),
'$assert'(C,Mod,first,_,asserta(C)).
assertz(V) :- var(V), !,
throw(error(instantiation_error,assertz(V))).
'$do_error'(instantiation_error,assertz(V)).
assertz(C) :-
'$current_module'(Mod),
'$assert'(C,Mod,last,_,assertz(C)).
assert(V) :- var(V), !,
throw(error(instantiation_error,assert(V))).
'$do_error'(instantiation_error,assert(V)).
assert(C) :-
'$current_module'(Mod),
'$assert'(C,Mod,last,_,assert(C)).
'$assert'(V,Mod,_,_,_) :- var(V), !,
throw(error(instantiation_error,assert(Mod:V))).
'$do_error'(instantiation_error,assert(Mod:V)).
'$assert'(M:C,_,Where,R,P) :- !,
'$assert'(C,M,Where,R,P).
'$assert'((H:-G),M1,Where,R,P) :-
(var(H) -> throw(error(instantiation_error,P)) ; H=M:C), !,
(var(H) -> '$do_error'(instantiation_error,P) ; H=M:C), !,
( M1 = M ->
'$assert'((C:-G),M1,Where,R,P)
;
@ -63,16 +63,16 @@ assert(C) :-
'$assert1'(Where,C,C0,Mod,H)
;
functor(H, Na, Ar),
throw(error(permission_error(modify,static_procedure,Na/Ar),P))
'$do_error'(permission_error(modify,static_procedure,Na/Ar),P)
).
'$assert_dynamic'(V,Mod,_,_,_) :- var(V), !,
throw(error(instantiation_error,assert(Mod:V))).
'$do_error'(instantiation_error,assert(Mod:V)).
'$assert_dynamic'(M:C,_,Where,R,P) :- !,
'$assert_dynamic'(C,M,Where,R,P).
'$assert_dynamic'((H:-G),M1,Where,R,P) :-
(var(H) -> throw(error(instantiation_error,P)) ; H=M:C), !,
(var(H) -> '$do_error'(instantiation_error,P) ; H=M:C), !,
( M1 = M ->
'$assert_dynamic'((C:-G),M1,Where,R,P)
;
@ -91,33 +91,33 @@ assert(C) :-
'$assertat_d'(Where,H,B,C0,Mod,R)
;
functor(H,Na,Ar),
throw(error(permission_error(modify,static_procedure,Na/Ar),P))
'$do_error'(permission_error(modify,static_procedure,Na/Ar),P)
).
assert_static(V) :- var(V), !,
throw(error(instantiation_error,assert_static(V))).
'$do_error'(instantiation_error,assert_static(V)).
assert_static(C) :-
'$current_module'(Mod),
'$assert_static'(C,Mod,last,_,assert_static(C)).
asserta_static(V) :- var(V), !,
throw(error(instantiation_error,asserta_static(V))).
'$do_error'(instantiation_error,asserta_static(V)).
asserta_static(C) :-
'$current_module'(Mod),
'$assert_static'(C,Mod,first,_,asserta_static(C)).
assertz_static(V) :- var(V), !,
throw(error(instantiation_error,assertz_static(V))).
'$do_error'(instantiation_error,assertz_static(V)).
assertz_static(C) :-
'$current_module'(Mod),
'$assert_static'(C,Mod,last,_,assertz_static(C)).
'$assert_static'(V,M,_,_,_) :- var(V), !,
throw(error(instantiation_error,assert(M:V))).
'$do_error'(instantiation_error,assert(M:V)).
'$assert_static'(M:C,_,Where,R,P) :- !,
'$assert_static'(C,M,Where,R,P).
'$assert_static'((H:-G),M1,Where,R,P) :-
(var(H) -> throw(error(instantiation_error,P)) ; H=M:C), !,
(var(H) -> '$do_error'(instantiation_error,P) ; H=M:C), !,
( M1 = M ->
'$assert_static'((C:-G),M1,Where,R,P)
;
@ -128,7 +128,7 @@ assertz_static(C) :-
'$expand_clause'(CI,C0,C,Mod),
'$check_head_and_body'(C,H,B,P),
( '$is_dynamic'(H, Mod) ->
throw(error(permission_error(modify,dynamic_procedure,Na/Ar),P))
'$do_error'(permission_error(modify,dynamic_procedure,Na/Ar),P)
;
'$undefined'(H,Mod), '$get_value'('$full_iso',true) ->
functor(H,Na,Ar), '$dynamic'(Na/Ar, Mod), '$assertat_d'(Where,H,B,C0,Mod,R)
@ -212,19 +212,19 @@ assertz_static(C) :-
'$erase_all_mf_dynamic'(_,_,_).
asserta(V,R) :- var(V), !,
throw(error(instantiation_error,asserta(V,R))).
'$do_error'(instantiation_error,asserta(V,R)).
asserta(C,R) :-
'$current_module'(M),
'$assert_dynamic'(C,M,first,R,asserta(C,R)).
assertz(V,R) :- var(V), !,
throw(error(instantiation_error,assertz(V,R))).
'$do_error'(instantiation_error,assertz(V,R)).
assertz(C,R) :-
'$current_module'(M),
'$assert_dynamic'(C,M,last,R,assertz(C,R)).
assert(V,R) :- var(V), !,
throw(error(instantiation_error,assert(V,R))).
'$do_error'(instantiation_error,assert(V,R)).
assert(C,R) :-
'$current_module'(M),
'$assert_dynamic'(C,M,last,R,assert(C,R)).
@ -234,11 +234,11 @@ clause(V,Q) :-
'$clause'(V,M,Q).
'$clause'(V,M,Q) :- var(V), !,
throw(error(instantiation_error,M:clause(V,Q))).
'$do_error'(instantiation_error,M:clause(V,Q)).
'$clause'(C,M,Q) :- number(C), !,
throw(error(type_error(callable,C),M:clause(C,Q))).
'$do_error'(type_error(callable,C),M:clause(C,Q)).
'$clause'(R,M,Q) :- db_reference(R), !,
throw(error(type_error(callable,R),M:clause(R,Q))).
'$do_error'(type_error(callable,R),M:clause(R,Q)).
'$clause'(M:P,_,Q) :- !,
'$clause'(P,M,Q).
'$clause'(P,Mod,Q) :- '$is_dynamic'(P, Mod), !,
@ -250,19 +250,19 @@ clause(V,Q) :-
( '$system_predicate'(P,M) -> true ;
'$number_of_clauses'(P,M,N), N > 0 ),
functor(P,Name,Arity),
throw(error(permission_error(access,private_procedure,Name/Arity),
clause(M:P,Q))).
'$do_error'(permission_error(access,private_procedure,Name/Arity),
clause(M:P,Q)).
clause(V,Q,R) :-
'$current_module'(V,M,Q,R),
'$clause'(V,M,Q,R).
'$clause'(V,M,Q,R) :- var(V), !,
throw(error(instantiation_error,M:clause(V,Q,R))).
'$do_error'(instantiation_error,M:clause(V,Q,R)).
'$clause'(C,M,Q,R) :- number(C), !,
throw(error(type_error(callable,C),clause(C,M:Q,R))).
'$do_error'(type_error(callable,C),clause(C,M:Q,R)).
'$clause'(R,M,Q,R1) :- db_reference(R), !,
throw(error(type_error(callable,R),clause(R,M:Q,R1))).
'$do_error'(type_error(callable,R),clause(R,M:Q,R1)).
'$clause'(M:P,_,Q,R) :- !,
'$clause'(P,M,Q,R).
'$clause'(P,Mod,Q,R) :-
@ -270,8 +270,8 @@ clause(V,Q,R) :-
'$recordedp'(Mod:P,(P:-Q),R)
;
functor(P,N,A),
throw(error(permission_error(access,private_procedure,N/A),
clause(Mod:P,Q,R)))
'$do_error'(permission_error(access,private_procedure,N/A),
clause(Mod:P,Q,R))
).
retract(C) :-
@ -280,7 +280,7 @@ retract(C) :-
'$retract'(V,_) :- var(V), !,
throw(error(instantiation_error,retract(V))).
'$do_error'(instantiation_error,retract(V)).
'$retract'(M:C,_) :- !,
'$retract'(C,M).
'$retract'(C,M) :-
@ -295,7 +295,7 @@ retract(C) :-
fail.
'$retract'(C,M) :-
'$fetch_predicate_indicator_from_clause'(C, PI),
throw(error(permission_error(modify,static_procedure,PI),retract(M:C))).
'$do_error'(permission_error(modify,static_procedure,PI),retract(M:C)).
retract(C,R) :- !,
'$current_module'(M),
@ -303,7 +303,7 @@ retract(C,R) :- !,
'$retract'(V,M,R) :- var(V), !,
throw(error(instantiation_error,retract(M:V,R))).
'$do_error'(instantiation_error,retract(M:V,R)).
'$retract'(M:C,_,R) :- !,
'$retract'(C,M,R).
'$retract'(C, M, R) :-
@ -324,7 +324,7 @@ retract(C,R) :- !,
fail.
'$retract'(C,M,_) :-
'$fetch_predicate_indicator_from_clause'(C, PI),
throw(error(permission_error(modify,static_procedure,PI),retract(M:C))).
'$do_error'(permission_error(modify,static_procedure,PI),retract(M:C)).
'$fetch_predicate_indicator_from_clause'((C :- _), Na/Ar) :- !,
functor(C, Na, Ar).
@ -337,7 +337,7 @@ retractall(V) :- !,
'$retractall'(V,M).
'$retractall'(V,M) :- var(V), !,
throw(error(instantiation_error,retract(M:V))).
'$do_error'(instantiation_error,retract(M:V)).
'$retractall'(M:V,_) :- !,
'$retractall'(V,M).
'$retractall'(T,M) :-
@ -347,7 +347,7 @@ retractall(V) :- !,
'$retractall'(T,M) :-
\+ '$is_dynamic'(T,M), !,
functor(T,Na,Ar),
throw(error(permission_error(modify,static_procedure,Na/Ar),retractall(T))).
'$do_error'(permission_error(modify,static_procedure,Na/Ar),retractall(T)).
'$retractall'(T,M) :-
'$erase_all_clauses_for_dynamic'(T, M).
@ -364,9 +364,9 @@ abolish(N,A) :-
'$abolish'(N,A,Mod).
'$abolish'(N,A,M) :- var(N), !,
throw(error(instantiation_error,abolish(M:N,A))).
'$do_error'(instantiation_error,abolish(M:N,A)).
'$abolish'(N,A,M) :- var(A), !,
throw(error(instantiation_error,abolish(M:N,A))).
'$do_error'(instantiation_error,abolish(M:N,A)).
'$abolish'(N,A,M) :-
( '$recorded'('$predicate_defs','$predicate_defs'(N,A,M,_),R) -> erase(R) ),
fail.
@ -396,9 +396,9 @@ abolish(X) :-
functor(T, Na, Ar),
'$undefined'(T, M), !.
'$new_abolish'(Na/Ar, M) :-
throw(error(permission_error(modify,static_procedure,Na/Ar),abolish(M:Na/Ar))).
'$do_error'(permission_error(modify,static_procedure,Na/Ar),abolish(M:Na/Ar)).
'$new_abolish'(T, M) :-
throw(error(type_error(predicate_indicator,T),abolish(M:T))).
'$do_error'(type_error(predicate_indicator,T),abolish(M:T)).
'$abolish_all'(M) :-
'$current_predicate'(M,Na,Ar),
@ -414,49 +414,49 @@ abolish(X) :-
'$check_error_in_predicate_indicator'(V, Msg) :-
var(V), !,
throw(error(instantiation_error, Msg)).
'$do_error'(instantiation_error, Msg).
'$check_error_in_predicate_indicator'(M:S, Msg) :- !,
'$check_error_in_module'(M, Msg),
'$check_error_in_predicate_indicator'(S, Msg).
'$check_error_in_predicate_indicator'(S, Msg) :-
S \= _/_, !,
throw(error(type_error(predicate_indicator,S), Msg)).
'$do_error'(type_error(predicate_indicator,S), Msg).
'$check_error_in_predicate_indicator'(Na/_, Msg) :-
var(Na), !,
throw(error(instantiation_error, Msg)).
'$do_error'(instantiation_error, Msg).
'$check_error_in_predicate_indicator'(Na/_, Msg) :-
\+ atom(Na), !,
throw(error(type_error(atom,Na), Msg)).
'$do_error'(type_error(atom,Na), Msg).
'$check_error_in_predicate_indicator'(_/Ar, Msg) :-
var(Ar), !,
throw(error(instantiation_error, Msg)).
'$do_error'(instantiation_error, Msg).
'$check_error_in_predicate_indicator'(_/Ar, Msg) :-
\+ integer(Ar), !,
throw(error(type_error(integer,Ar), Msg)).
'$do_error'(type_error(integer,Ar), Msg).
'$check_error_in_predicate_indicator'(_/Ar, Msg) :-
Ar < 0, !,
throw(error(domain_error(not_less_than_zero,Ar), Msg)).
'$do_error'(domain_error(not_less_than_zero,Ar), Msg).
% not yet implemented!
%'$check_error_in_predicate_indicator'(Na/Ar, Msg) :-
% Ar < maxarity, !,
% throw(error(type_error(representation_error(max_arity),Ar), Msg)).
% '$do_error'(type_error(representation_error(max_arity),Ar), Msg).
'$check_error_in_module'(M, Msg) :-
var(M), !,
throw(error(instantiation_error, Msg)).
'$do_error'(instantiation_error, Msg).
'$check_error_in_module'(M, Msg) :-
\+ atom(M), !,
throw(error(type_error(atom,M), Msg)).
'$do_error'(type_error(atom,M), Msg).
'$old_abolish'(V,M) :- var(V), !,
( '$access_yap_flags'(8, 1) ->
throw(error(instantiation_error,abolish(M:V)))
'$do_error'(instantiation_error,abolish(M:V))
;
'$abolish_all_old'(M)
).
'$old_abolish'(A,M) :- atom(A), !,
( '$access_yap_flags'(8, 1) ->
throw(error(type_error(predicate_indicator,A),abolish(M:A)))
'$do_error'(type_error(predicate_indicator,A),abolish(M:A))
;
'$abolish_all_atoms_old'(A,M)
).
@ -467,7 +467,7 @@ abolish(X) :-
'$old_abolish'(N/A, M) :- !,
'$abolish'(N, A, M).
'$old_abolish'(T, M) :-
throw(error(type_error(predicate_indicator,T),abolish(M:T))).
'$do_error'(type_error(predicate_indicator,T),abolish(M:T)).
'$abolish_all_old'(M) :-
'$current_predicate'(M, Na, Ar),
@ -487,7 +487,7 @@ abolish(X) :-
'$abolishs'(G, M) :- '$system_predicate'(G,M), !,
functor(G,Name,Arity),
throw(error(permission_error(modify,static_procedure,Name/Arity),abolish(M:G))).
'$do_error'(permission_error(modify,static_procedure,Name/Arity),abolish(M:G)).
'$abolishs'(G, Module) :-
'$access_yap_flags'(8, 2), % only do this in sicstus mode
'$undefined'(G, Module),
@ -499,7 +499,7 @@ abolish(X) :-
'$abolishs'(G, Module) :-
'$has_yap_or', !,
functor(G,A,N),
throw(error(permission_error(modify,static_procedure,A/N),abolish(Module:G))).
'$do_error'(permission_error(modify,static_procedure,A/N),abolish(Module:G)).
'$abolishs'(G, M) :-
'$purge_clauses'(G, M),
'$recordedp'(M:G,_,R), erase(R), fail.
@ -512,10 +512,10 @@ dynamic(X) :- '$access_yap_flags'(8, 0), !,
'$current_module'(M),
'$dynamic'(X, M).
dynamic(X) :-
throw(error(context_error(dynamic(X),declaration),query)).
'$do_error'(context_error(dynamic(X),declaration),query).
'$dynamic'(X,M) :- var(X), !,
throw(error(instantiation_error,dynamic(M:X))).
'$do_error'(instantiation_error,dynamic(M:X)).
'$dynamic'(Mod:Spec,_) :- !,
'$dynamic'(Spec,Mod).
'$dynamic'([], _) :- !.
@ -532,10 +532,10 @@ dynamic(X) :-
'$is_dynamic'(T,Mod) -> true;
F /\ 16'400 =:= 16'400, '$undefined'(T,Mod) -> F1 is F /\ \(0x600), NF is F1 \/ 16'2000, '$flags'(T,Mod,F,NF);
F/\16'8 =:= 16'8 -> true ;
throw(error(permission_error(modify,static_procedure,A/N),dynamic(Mod:A/N)))
'$do_error'(permission_error(modify,static_procedure,A/N),dynamic(Mod:A/N))
).
'$dynamic2'(X,Mod) :-
throw(error(type_error(callable,X),dynamic(Mod:X))).
'$do_error'(type_error(callable,X),dynamic(Mod:X)).
'$logical_updatable'(A/N,Mod) :- integer(N), atom(A), !,
@ -544,10 +544,10 @@ dynamic(X) :-
'$is_dynamic'(T,Mod) -> true;
F /\ 16'400 =:= 16'400 , '$undefined'(T,Mod) -> NF is F \/ 0x8, '$flags'(T,Mod,F,NF);
F /\ 16'8=:= 16'8 -> true ;
throw(error(permission_error(modify,static_procedure,A/N),dynamic(Mod:A/N)))
'$do_error'(permission_error(modify,static_procedure,A/N),dynamic(Mod:A/N))
).
'$logical_updatable'(X,Mod) :-
throw(error(type_error(callable,X),dynamic(Mod:X))).
'$do_error'(type_error(callable,X),dynamic(Mod:X)).
dynamic_predicate(P,Sem) :-
@ -561,10 +561,10 @@ dynamic_predicate(P,Sem) :-
'$bad_if_is_semantics'(Sem, Goal) :-
var(Sem), !,
throw(error(instantiation_error,Goal)).
'$do_error'(instantiation_error,Goal).
'$bad_if_is_semantics'(Sem, Goal) :-
Sem \= immediate, Sem \= logical, !,
throw(error(domain_error(semantics_indicator,Sem),Goal)).
'$do_error'(domain_error(semantics_indicator,Sem),Goal).
'$expand_clause'(C0,C1,C2,Mod) :-
@ -576,7 +576,7 @@ dynamic_predicate(P,Sem) :-
).
'$public'(X, _) :- var(X), !,
throw(error(instantiation_error,public(X))).
'$do_error'(instantiation_error,public(X)).
'$public'(Mod:Spec, _) :- !,
'$public'(Spec,Mod).
'$public'((A,B), M) :- !, '$public'(A,M), '$public'(B,M).
@ -586,7 +586,7 @@ dynamic_predicate(P,Sem) :-
functor(T,A,N),
'$do_make_public'(T, Mod).
'$public'(X, Mod) :-
throw(error(type_error(callable,X),dynamic(Mod:X))).
'$do_error'(type_error(callable,X),dynamic(Mod:X)).
'$do_make_public'(T, Mod) :-
'$is_dynamic'(T, Mod), !. % all dynamic predicates are public.
@ -602,7 +602,7 @@ dynamic_predicate(P,Sem) :-
F\/16'400000 \== 0.
hide_predicate(V) :- var(V), !,
throw(error(instantiation_error,hide_predicate(X))).
'$do_error'(instantiation_error,hide_predicate(X)).
hide_predicate(M:P) :- !,
'$hide_predicate2'(P, M).
hide_predicate(P) :-
@ -610,12 +610,12 @@ hide_predicate(P) :-
'$hide_predicate2'(M, P).
'$hide_predicate2'(V, M) :- var(V), !,
throw(error(instantiation_error,hide_predicate(M:V))).
'$do_error'(instantiation_error,hide_predicate(M:V)).
'$hide_predicate2'(N/A, M) :- !,
functor(S,N,A),
'$hide_predicate'(S, M) .
'$hide_predicate2'(PredDesc, M) :-
throw(error(type_error(predicate_indicator,T),hide_predicate(M:PredDesc))).
'$do_error'(type_error(predicate_indicator,T),hide_predicate(M:PredDesc)).

2
pl/profile.yap
View File

@ -20,7 +20,7 @@
profile_data(P, Parm, Data) :- P = M:D, !,
(
var(M) ->
throw(error(instantiation_error,profile_data(M:D, Parm, Data)))
'$do_error'(instantiation_error,profile_data(M:D, Parm, Data))
;
'$profile_data'(D, Parm, Data, M)
).

2
pl/setof.yap
View File

@ -220,5 +220,5 @@ all(T,G,S) :- '$recorda'('$$one','$',R), (
'$check_list_for_bags'([_|B], T) :- !,
'$check_list_for_bags'(B,T).
'$check_list_for_bags'(S, T) :-
throw(error(type_error(list,S),T)).
'$do_error'(type_error(list,S),T).

8
pl/sockets.yap
View File

@ -33,12 +33,12 @@ socket_select(Socks, OutSocks, TimeOut, Streams, OutStreams) :-
/* check whether a list of options is valid */
'$check_list_for_sockets'(V,G) :- var(V), !,
throw(error(instantiation_error,G)).
'$do_error'(instantiation_error,G).
'$check_list_for_sockets'([],_) :- !.
'$check_list_for_sockets'([_|T],G) :- !,
  '$check_list_for_sockets'(T,G).
'$check_list_for_sockets'(T,G) :-
throw(error(type_error(list,T),G)).
'$do_error'(type_error(list,T),G).
'$select_cp_fds'([], Fds, Fds).
'$select_cp_fds'([_-Fd|L], Fds0, [Fd|Fds]) :-
@ -46,7 +46,7 @@ socket_select(Socks, OutSocks, TimeOut, Streams, OutStreams) :-
'$check_select_time'(V, _, _, Goal) :-
var(V), !,
throw(error(instantiation_error,Goal)).
'$do_error'(instantiation_error,Goal).
'$check_select_time'(off, -1, -1, _).
'$check_select_time'(Sec0:USec0, Sec, USec, _) :-
Sec is Sec0,
@ -68,7 +68,7 @@ socket_select(Socks, OutSocks, TimeOut, Streams, OutStreams) :-
socket_buffering(Sock, Flag, InSize, OutSize) :-
var(OutSize), OutSize \= InSize, !,
throw(error(instantiation_error,socket_buffering(Sock, Flag, InSize, OutSize))).
'$do_error'(instantiation_error,socket_buffering(Sock, Flag, InSize, OutSize)).
socket_buffering(Sock, Flag, InSize, OutSize) :-
'$convert_sock_buff'(OutSize, OutNumb),
'$socket_buffering'(Sock, Flag, InNumb, OutNumb),

18
pl/strict_iso.yap
View File

@ -1,9 +1,9 @@
'$iso_check_goal'(V,G) :-
var(V), !,
throw(error(instantiation_error,call(G))).
'$do_error'(instantiation_error,call(G)).
'$iso_check_goal'(V,G) :-
number(V), !,
throw(error(type_error(callable,V),G)).
'$do_error'(type_error(callable,V),G).
'$iso_check_goal'(_:G,G0) :- !,
'$iso_check_goal'(G,G0).
'$iso_check_goal'((G1,G2),G0) :- !,
@ -18,7 +18,7 @@
'$iso_check_goal'(!,_) :- !.
'$iso_check_goal'((G1|G2),G0) :-
'$access_yap_flags'(9,1), !,
throw(error(domain_error(builtin_procedure,(G1|G2)), call(G0))).
'$do_error'(domain_error(builtin_procedure,(G1|G2)), call(G0)).
'$iso_check_goal'((G1|G2),G0) :- !,
'$iso_check_a_goal'(G1,(G1|G2),G0),
'$iso_check_a_goal'(G2,(G1|G2),G0).
@ -30,16 +30,16 @@
->
true
;
throw(error(domain_error(builtin_procedure,G), call(G0)))
'$do_error'(domain_error(builtin_procedure,G), call(G0))
).
'$iso_check_goal'(_,_).
'$iso_check_a_goal'(V,_,G) :-
var(V), !,
throw(error(instantiation_error,call(G))).
'$do_error'(instantiation_error,call(G)).
'$iso_check_a_goal'(V,E,G) :-
number(V), !,
throw(error(type_error(callable,E),call(G))).
'$do_error'(type_error(callable,E),call(G)).
'$iso_check_a_goal'(_:G,E,G0) :- !,
'$iso_check_a_goal'(G,E,G0).
'$iso_check_a_goal'((G1,G2),E,G0) :- !,
@ -54,7 +54,7 @@
'$iso_check_a_goal'(!,_,_) :- !.
'$iso_check_a_goal'((_|_),E,G0) :-
'$access_yap_flags'(9,1), !,
throw(error(domain_error(builtin_procedure,E), call(G0))).
'$do_error'(domain_error(builtin_procedure,E), call(G0)).
'$iso_check_a_goal'((_|_),_,_) :- !.
'$iso_check_a_goal'(G,_,G0) :-
'$access_yap_flags'(9,1),
@ -64,7 +64,7 @@
->
true
;
throw(error(domain_error(builtin_procedure,G), call(G0)))
'$do_error'(domain_error(builtin_procedure,G), call(G0))
).
'$iso_check_a_goal'(_,_,_).
@ -93,7 +93,7 @@
'$check_iso_system_goal'(G) :-
'$iso_builtin'(G), !.
'$check_iso_system_goal'(G) :-
throw(error(domain_error(builtin_procedure,G), G)).
'$do_error'(domain_error(builtin_procedure,G), G).
'$iso_builtin'(abolish(_)).

2
pl/tabling.yap
View File

@ -82,7 +82,7 @@ show_trie(X) :-
'$show_trie'(X, M).
'$show_trie'(X, M) :- var(X), !,
throw(error(instantiation_error,show_trie(M:X))).
'$do_error'(instantiation_error,show_trie(M:X)).
'$show_trie'((A,B), _) :- !, '$show_trie'(A, M), '$show_trie'(B, M).
'$show_trie'(M:A, _) :- !, '$show_trie'(A, M).
'$show_trie'(A/N, M) :- integer(N), atom(A), !,

152
pl/utils.yap
View File

@ -26,99 +26,99 @@ if(_X,_Y,Z) :-
'$execute'(Z).
call_with_args(V) :- var(V), !,
throw(error(instantiation_error,call_with_args(V))).
call_with_args(M:V) :- var(V), !,
'$do_error'(instantiation_error,call_with_args(M:V)).
call_with_args(M:A) :- !,
'$call_with_args'(A,M).
call_with_args(A) :- atom(A), !,
'$current_module'(M),
'$call_with_args'(A,M).
call_with_args(A) :-
throw(error(type_error(atom,A),call_with_args(A))).
'$do_error'(type_error(atom,A),call_with_args(A)).
call_with_args(V,A1) :- var(V), !,
throw(error(instantiation_error,call_with_args(V,A1))).
call_with_args(M:V,A1) :- var(V), !,
'$do_error'(instantiation_error,call_with_args(M:V,A1)).
call_with_args(M:A,A1) :- !,
'$call_with_args'(A,A1,M).
call_with_args(A,A1) :- atom(A), !,
'$current_module'(M),
'$call_with_args'(A,A1,M).
call_with_args(A,A1) :-
throw(error(type_error(atom,A),call_with_args(A,A1))).
'$do_error'(type_error(atom,A),call_with_args(A,A1)).
call_with_args(V,A1,A2) :- var(V), !,
throw(error(instantiation_error,call_with_args(V,A1,A2))).
call_with_args(M:V,A1,A2) :- var(V), !,
'$do_error'(instantiation_error,call_with_args(M:V,A1,A2)).
call_with_args(M:A,A1,A2) :- !,
'$call_with_args'(A,A1,A2,M).
call_with_args(A,A1,A2) :- atom(A), !,
'$current_module'(M),
'$call_with_args'(A,A1,A2,M).
call_with_args(A,A1,A2) :-
throw(error(type_error(atom,A),call_with_args(A,A1,A2))).
'$do_error'(type_error(atom,A),call_with_args(A,A1,A2)).
call_with_args(V,A1,A2,A3) :- var(V), !,
throw(error(instantiation_error,call_with_args(V,A1,A2,A3))).
call_with_args(M:V,A1,A2,A3) :- var(V), !,
'$do_error'(instantiation_error,call_with_args(M:V,A1,A2,A3)).
call_with_args(M:A,A1,A2,A3) :- !,
'$call_with_args'(A,A1,A2,A3,M).
call_with_args(A,A1,A2,A3) :- atom(A), !,
'$current_module'(M),
'$call_with_args'(A,A1,A2,A3,M).
call_with_args(A,A1,A2,A3) :-
throw(error(type_error(atom,A),call_with_args(A,A1,A2,A3))).
'$do_error'(type_error(atom,A),call_with_args(A,A1,A2,A3)).
call_with_args(V,A1,A2,A3,A4) :- var(V), !,
throw(error(instantiation_error,call_with_args(V,A1,A2,A3,A4))).
call_with_args(M:V,A1,A2,A3,A4) :- var(V), !,
'$do_error'(instantiation_error,call_with_args(M:V,A1,A2,A3,A4)).
call_with_args(M:A,A1,A2,A3,A4) :- !,
'$call_with_args'(A,A1,A2,A3,A4,M).
call_with_args(A,A1,A2,A3,A4) :- atom(A), !,
'$current_module'(M),
'$call_with_args'(A,A1,A2,A3,A4,M).
call_with_args(A,A1,A2,A3,A4) :-
throw(error(type_error(atom,A),call_with_args(A,A1,A2,A3,A4))).
'$do_error'(type_error(atom,A),call_with_args(A,A1,A2,A3,A4)).
call_with_args(V,A1,A2,A3,A4,A5) :- var(V), !,
throw(error(instantiation_error,call_with_args(V,A1,A2,A3,A4,A5))).
call_with_args(M:V,A1,A2,A3,A4,A5) :- var(V), !,
'$do_error'(instantiation_error,call_with_args(M:V,A1,A2,A3,A4,A5)).
call_with_args(M:A,A1,A2,A3,A4,A5) :- !,
'$call_with_args'(A,A1,A2,A3,A4,A5,M).
call_with_args(A,A1,A2,A3,A4,A5) :- atom(A), !,
'$current_module'(M),
'$call_with_args'(A,A1,A2,A3,A4,A5,M).
call_with_args(A,A1,A2,A3,A4,A5) :-
throw(error(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5))).
'$do_error'(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5)).
call_with_args(V,A1,A2,A3,A4,A5,A6) :- var(V), !,
throw(error(instantiation_error,call_with_args(V,A1,A2,A3,A4,A5,A6))).
call_with_args(M:V,A1,A2,A3,A4,A5,A6) :- var(V), !,
'$do_error'(instantiation_error,call_with_args(M:V,A1,A2,A3,A4,A5,A6)).
call_with_args(M:A,A1,A2,A3,A4,A5,A6) :- !,
'$call_with_args'(A,A1,A2,A3,A4,A5,A6,M).
call_with_args(A,A1,A2,A3,A4,A5,A6) :- atom(A), !,
'$current_module'(M),
'$call_with_args'(A,A1,A2,A3,A4,A5,A6,M).
call_with_args(A,A1,A2,A3,A4,A5,A6) :-
throw(error(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5,A6))).
'$do_error'(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5,A6)).
call_with_args(V,A1,A2,A3,A4,A5,A6,A7) :- var(V), !,
throw(error(instantiation_error,call_with_args(V,A1,A2,A3,A4,A5,A6,A7))).
call_with_args(M:V,A1,A2,A3,A4,A5,A6,A7) :- var(V), !,
'$do_error'(instantiation_error,call_with_args(M:V,A1,A2,A3,A4,A5,A6,A7)).
call_with_args(M:A,A1,A2,A3,A4,A5,A6,A7) :- !,
'$call_with_args'(A,A1,A2,A3,A4,A5,A6,A7,M).
call_with_args(A,A1,A2,A3,A4,A5,A6,A7) :- atom(A), !,
'$current_module'(M),
'$call_with_args'(A,A1,A2,A3,A4,A5,A6,A7,M).
call_with_args(A,A1,A2,A3,A4,A5,A6,A7) :-
throw(error(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5,A6,A7))).
'$do_error'(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5,A6,A7)).
call_with_args(V,A1,A2,A3,A4,A5,A6,A7,A8) :- var(V), !,
throw(error(instantiation_error,call_with_args(V,A1,A2,A3,A4,A5,A6,A7,A8))).
call_with_args(M:V,A1,A2,A3,A4,A5,A6,A7,A8) :- var(V), !,
'$do_error'(instantiation_error,call_with_args(M:V,A1,A2,A3,A4,A5,A6,A7,A8)).
call_with_args(M:A,A1,A2,A3,A4,A5,A6,A7,A8) :- !,
'$call_with_args'(A,A1,A2,A3,A4,A5,A6,A7,A8,M).
call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8) :- atom(A), !,
'$current_module'(M),
'$call_with_args'(A,A1,A2,A3,A4,A5,A6,A7,A8,M).
call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8) :-
throw(error(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8))).
'$do_error'(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8)).
call_with_args(V,A1,A2,A3,A4,A5,A6,A7,A8,A9) :- var(V), !,
throw(error(instantiation_error,call_with_args(V,A1,A2,A3,A4,A5,A6,A7,A8,A9))).
call_with_args(M:V,A1,A2,A3,A4,A5,A6,A7,A8,A9) :- var(V), !,
'$do_error'(instantiation_error,call_with_args(M:V,A1,A2,A3,A4,A5,A6,A7,A8,A9)).
call_with_args(M:A,A1,A2,A3,A4,A5,A6,A7,A8,A9) :- !,
'$current_module'(M),
'$call_with_args'(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,M).
@ -126,56 +126,56 @@ call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9) :- atom(A), !,
'$current_module'(M),
'$call_with_args'(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,M).
call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9) :-
throw(error(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9))).
'$do_error'(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9)).
call_with_args(V,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) :- var(V), !,
throw(error(instantiation_error,call_with_args(V,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10))).
call_with_args(M:V,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) :- var(V), !,
'$do_error'(instantiation_error,call_with_args(M:V,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)).
call_with_args(M:A,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) :- !,
'$call_with_args'(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,M).
call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) :- atom(A), !,
'$current_module'(M),
'$call_with_args'(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,M).
call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) :-
throw(error(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10))).
'$do_error'(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)).
op(P,T,V) :- var(P), !,
throw(error(instantiation_error,op(P,T,V))).
'$do_error'(instantiation_error,op(P,T,V)).
op(P,T,V) :- \+integer(P), !,
throw(error(type_error(integer,P),op(P,T,V))).
'$do_error'(type_error(integer,P),op(P,T,V)).
op(P,T,V) :- (P < 0 ; P > 1200), !,
throw(error(domain_error(operator_priority,P),op(P,T,V))).
'$do_error'(domain_error(operator_priority,P),op(P,T,V)).
op(P,T,V) :- var(T), !,
throw(error(instantiation_error,op(P,T,V))).
'$do_error'(instantiation_error,op(P,T,V)).
op(P,T,V) :- \+atom(T), !,
throw(error(type_error(atom,T),op(P,T,V))).
'$do_error'(type_error(atom,T),op(P,T,V)).
op(P,T,V) :- var(V), !,
throw(error(instantiation_error,op(P,T,V))).
'$do_error'(instantiation_error,op(P,T,V)).
op(P,T,V) :-
\+ atom(V), \+ '$check_list_of_operators'(V, op(P,T,V)),
throw(error(type_error(list,V),op(P,T,V))).
'$do_error'(type_error(list,V),op(P,T,V)).
op(P,T,V) :- '$op2'(P,T,V).
'$check_list_of_operators'(V, T) :- var(V), !,
throw(error(instantiation_error,T)).
'$do_error'(instantiation_error,T).
'$check_list_of_operators'([], _).
'$check_list_of_operators'([H|L], T) :-
'$check_if_operator'(H,T),
'$check_list_of_operators'(L, T).
'$check_if_operator'(H,T) :- var(H), !,
throw(error(instantiation_error,T)).
'$do_error'(instantiation_error,T).
'$check_if_operator'(H,_) :- atom(H), !.
'$check_if_operator'(H,T) :-
throw(error(type_error(atom,H),T)).
'$do_error'(type_error(atom,H),T).
'$op2'(_,_,[]) :- !.
'$op2'(P,T,[A|L]) :- !, '$op'(P,T,A), '$op2'(P,T,L).
'$op2'(P,T,A) :- atom(A), '$op'(P,T,A).
'$op'(P,T,',') :- !,
throw(error(permission_error(modify,operator,','),op(P,T,','))).
'$do_error'(permission_error(modify,operator,','),op(P,T,',')).
'$op'(P,T,A) :- '$opdec'(P,T,A).
%%% Operating System utilities
@ -193,28 +193,28 @@ rename(Old,New) :- atom(Old), atom(New), !,
'$rename'(SOld,SNew).
unix(V) :- var(V), !,
throw(error(instantiation_error,unix(V))).
'$do_error'(instantiation_error,unix(V)).
unix(argv(L)) :- '$is_list_of_atoms'(L,L), !, '$argv'(L).
unix(argv(V)) :-
throw(error(type_error(atomic,V),unix(argv(V)))).
'$do_error'(type_error(atomic,V),unix(argv(V))).
unix(cd) :- cd('~').
unix(cd(V)) :- var(V), !,
throw(error(instantiation_error,unix(cd(V)))).
'$do_error'(instantiation_error,unix(cd(V))).
unix(cd(A)) :- atomic(A), !, cd(A).
unix(cd(V)) :-
throw(error(type_error(atomic,V),unix(cd(V)))).
'$do_error'(type_error(atomic,V),unix(cd(V))).
unix(environ(X,Y)) :- '$do_environ'(X,Y).
unix(getcwd(X)) :- getcwd(X).
unix(shell(V)) :- var(V), !,
throw(error(instantiation_error,unix(shell(V)))).
'$do_error'(instantiation_error,unix(shell(V))).
unix(shell(A)) :- atomic(A), !, '$shell'(A).
unix(shell(V)) :-
throw(error(type_error(atomic,V),unix(shell(V)))).
'$do_error'(type_error(atomic,V),unix(shell(V))).
unix(system(V)) :- var(V), !,
throw(error(instantiation_error,unix(system(V)))).
'$do_error'(instantiation_error,unix(system(V))).
unix(system(A)) :- atomic(A), !, system(A).
unix(system(V)) :-
throw(error(type_error(atom,V),unix(system(V)))).
'$do_error'(type_error(atom,V),unix(system(V))).
unix(shell) :- sh.
unix(putenv(X,Y)) :- '$putenv'(X,Y).
@ -225,23 +225,23 @@ unix(putenv(X,Y)) :- '$putenv'(X,Y).
'$check_if_head_may_be_atom'(H,L0),
'$is_list_of_atoms'(L,L0).
'$is_list_of_atoms'(H,L0) :-
throw(error(type_error(list,H),unix(argv(L0)))).
'$do_error'(type_error(list,H),unix(argv(L0))).
'$check_if_head_may_be_atom'(H,L0) :-
var(H), !.
'$check_if_head_may_be_atom'(H,L0) :-
atom(H), !.
'$check_if_head_may_be_atom'(H,L0) :-
throw(error(type_error(atom,H),unix(argv(L0)))).
'$do_error'(type_error(atom,H),unix(argv(L0))).
'$do_environ'(X, Y) :-
var(X), !,
throw(error(instantiation_error,unix(environ(X,Y)))).
'$do_error'(instantiation_error,unix(environ(X,Y))).
'$do_environ'(X, Y) :- atom(X), !,
'$getenv'(X,Y).
'$do_environ'(X, Y) :-
throw(error(type_error(atom,X),unix(environ(X,Y)))).
'$do_error'(type_error(atom,X),unix(environ(X,Y))).
putenv(Na,Val) :-
@ -270,26 +270,26 @@ on_signal(Signal,OldAction,Action) :-
%%% Saving and restoring a computation
save(A) :- var(A), !,
throw(error(instantiation_error,save(A))).
'$do_error'(instantiation_error,save(A)).
save(A) :- atom(A), !, name(A,S), '$save'(S).
save(S) :- '$save'(S).
save(A,_) :- var(A), !,
throw(error(instantiation_error,save(A))).
'$do_error'(instantiation_error,save(A)).
save(A,OUT) :- atom(A), !, name(A,S), '$save'(S,OUT).
save(S,OUT) :- '$save'(S,OUT).
save_program(A) :- var(A), !,
throw(error(instantiation_error,save_program(A))).
'$do_error'(instantiation_error,save_program(A)).
save_program(A) :- atom(A), !, name(A,S), '$save_program'(S).
save_program(S) :- '$save_program'(S).
save_program(A, G) :- var(A), !,
throw(error(instantiation_error,save_program(A,G))).
'$do_error'(instantiation_error,save_program(A,G)).
save_program(A, G) :- var(G), !,
throw(error(instantiation_error,save_program(A,G))).
'$do_error'(instantiation_error,save_program(A,G)).
save_program(A, G) :- \+ callable(G), !,
throw(error(type_error(callable,G),save_program(A,G))).
'$do_error'(type_error(callable,G),save_program(A,G)).
save_program(A, G) :-
( atom(A) -> name(A,S) ; A = S),
'$recorda'('$restore_goal',G,R),
@ -299,7 +299,7 @@ save_program(A, G) :-
save_program(_,_).
restore(A) :- var(A), !,
throw(error(instantiation_error,restore(A))).
'$do_error'(instantiation_error,restore(A)).
restore(A) :- atom(A), !, name(A,S), '$restore'(S).
restore(S) :- '$restore'(S).
@ -378,7 +378,7 @@ system_predicate(P) :-
functor(T,A,Arity),
'$pred_exists'(T,M).
'$current_predicate3'(M,BadSpec) :- % only for the predicate
throw(error(type_error(predicate_indicator,BadSpec),current_predicate(M:BadSpec))).
'$do_error'(type_error(predicate_indicator,BadSpec),current_predicate(M:BadSpec)).
%%% User interface for statistics
@ -500,7 +500,7 @@ unknown(V0,V) :-
'$valid_unknown_handler'(V,_) :-
var(V), !,
throw(error(instantiation_error,yap_flag(unknown,V))).
'$do_error'(instantiation_error,yap_flag(unknown,V)).
'$valid_unknown_handler'(fail,_) :- !.
'$valid_unknown_handler'(error,_) :- !.
'$valid_unknown_handler'(warning,_) :- !.
@ -511,7 +511,7 @@ unknown(V0,V) :-
\+ '$undefined'(S,M),
!.
'$valid_unknown_handler'(S,_) :-
throw(error(domain_error(flag_value,unknown+S),yap_flag(unknown,S))).
'$do_error'(domain_error(flag_value,unknown+S),yap_flag(unknown,S)).
'$ask_unknown_flag'(Old) :-
'$recorded'('$unknown','$unkonwn'(_,MyOld),_), !,
@ -532,7 +532,7 @@ unknown(V0,V) :-
'$recorda'('$unknown','$unknown'(A,M:X),_).
'$unknown_error'(P) :-
throw(error(unknown,P)).
'$do_error'(unknown,P).
'$unknown_warning'(P) :-
P=M:F,
@ -654,13 +654,13 @@ atom_concat(X,Y,At) :-
sub_atom(At, Bef, Size, After, SubAt) :-
var(At), !,
throw(error(instantiation_error,sub_atom(At, Bef, Size,After, SubAt))).
'$do_error'(instantiation_error,sub_atom(At, Bef, Size,After, SubAt)).
sub_atom(At, Bef, Size, After, SubAt) :-
\+ atom(At), !,
throw(error(type_error(atom,At),sub_atom(At, Bef, Size,After, SubAt))).
'$do_error'(type_error(atom,At),sub_atom(At, Bef, Size,After, SubAt)).
sub_atom(At, Bef, Size, After, SubAt) :-
nonvar(SubAt), \+ atom(SubAt), !,
throw(error(type_error(atom,SubAt),sub_atom(At, Bef, Size,After, SubAt))).
'$do_error'(type_error(atom,SubAt),sub_atom(At, Bef, Size,After, SubAt)).
sub_atom(At, Bef, Size, After, SubAt) :-
'$check_type_sub_atom'(Bef, sub_atom(At, Bef, Size,After, SubAt)),
'$check_type_sub_atom'(Size, sub_atom(At, Bef, Size,After, SubAt)),
@ -674,10 +674,10 @@ sub_atom(At, Bef, Size, After, SubAt) :-
var(I), !.
'$check_type_sub_atom'(I, P) :-
integer(I), I < 0, !,
throw(error(domain_error(not_less_than_zero,I),P)).
'$do_error'(domain_error(not_less_than_zero,I),P).
'$check_type_sub_atom'(I, P) :-
\+ integer(I), !,
throw(error(type_error(integer,I),P)).
'$do_error'(type_error(integer,I),P).
'$check_type_sub_atom'(_, _).
'$split_len_in_parts'(Atl, Len, Bef, Size, After, SubAt) :-
@ -743,11 +743,11 @@ initialization :-
'$initialisation_goals'.
prolog_initialization(G) :- var(G), !,
throw(error(instantiation_error,initialization(G))).
'$do_error'(instantiation_error,initialization(G)).
prolog_initialization(T) :- callable(T), !,
'$assert_init'(T).
prolog_initialization(T) :-
throw(error(type_error(callable,T),initialization(T))).
'$do_error'(type_error(callable,T),initialization(T)).
'$assert_init'(T) :- '$recordz'('$startup_goal',T,_), fail.
'$assert_init'(_).
@ -755,10 +755,10 @@ prolog_initialization(T) :-
version :- '$version'.
version(V) :- var(V), !,
throw(error(instantiation_error,version(V))).
'$do_error'(instantiation_error,version(V)).
version(T) :- atom(T), !, '$assert_version'(T).
version(T) :-
throw(error(type_error(atom,T),version(T))).
'$do_error'(type_error(atom,T),version(T)).
'$assert_version'(T) :- '$recordz'('$version',T,_), fail.
'$assert_version'(_).

2
pl/yapor.yap
View File

@ -70,7 +70,7 @@ default_sequential(_).
fail.
'$parallel_directive'(X,M) :- var(X), !,
throw(error(instantiation_error,parallel(M:X))).
'$do_error'(instantiation_error,parallel(M:X)).
'$parallel_directive'((A,B),M) :- !,
'$parallel_directive'(A,M),
'parallel_directive'(B,M).

138
pl/yio.yap
View File

@ -18,11 +18,11 @@
/* stream predicates */
open(Source,M,T) :- var(Source), !,
throw(error(instantiation_error,open(Source,M,T))).
'$do_error'(instantiation_error,open(Source,M,T)).
open(Source,M,T) :- var(M), !,
throw(error(instantiation_error,open(Source,M,T))).
'$do_error'(instantiation_error,open(Source,M,T)).
open(Source,M,T) :- nonvar(T), !,
throw(error(type_error(variable,T),open(Source,M,T))).
'$do_error'(type_error(variable,T),open(Source,M,T)).
open(File,Mode,Stream) :-
'$open'(File,Mode,Stream,0).
@ -34,7 +34,7 @@ open(File,Mode,Stream) :-
*/
close(V) :- var(V), !,
throw(error(instantiation_error,close(V))).
'$do_error'(instantiation_error,close(V)).
close(File) :-
atom(File), !,
(
@ -50,7 +50,7 @@ close(Stream) :-
'$close'(Stream).
close(V,Opts) :- var(V), !,
throw(error(instantiation_error,close(V,Opts))).
'$do_error'(instantiation_error,close(V,Opts)).
close(S,Opts) :-
'$check_io_opts'(Opts,close(S,Opts)),
/* YAP ignores the force/1 flag */
@ -63,11 +63,11 @@ open(F,T,S,Opts) :-
'$process_open_aliases'(Aliases,S).
'$open2'(Source,M,T,N) :- var(Source), !,
throw(error(instantiation_error,open(Source,M,T,N))).
'$do_error'(instantiation_error,open(Source,M,T,N)).
'$open2'(Source,M,T,N) :- var(M), !,
throw(error(instantiation_error,open(Source,M,T,N))).
'$do_error'(instantiation_error,open(Source,M,T,N)).
'$open2'(Source,M,T,N) :- nonvar(T), !,
throw(error(type_error(variable,T),open(Source,M,T,N))).
'$do_error'(type_error(variable,T),open(Source,M,T,N)).
'$open2'(File,Mode,Stream,N) :-
'$open'(File,Mode,Stream,N).
@ -106,20 +106,20 @@ open(F,T,S,Opts) :-
/* check whether a list of options is valid */
'$check_io_opts'(V,G) :- var(V), !,
throw(error(instantiation_error,G)).
'$do_error'(instantiation_error,G).
'$check_io_opts'([],_) :- !.
'$check_io_opts'([H|_],G) :- var(H), !,
throw(error(instantiation_error,G)).
'$do_error'(instantiation_error,G).
'$check_io_opts'([Opt|T],G) :- !,
'$check_opt'(G,Opt,G),
'$check_io_opts'(T,G).
'$check_io_opts'(T,G) :-
throw(error(type_error(list,T),G)).
'$do_error'(type_error(list,T),G).
'$check_opt'(close(_,_),Opt,G) :- !,
(Opt = force(X) ->
'$check_force_opt_arg'(X,G) ;
throw(error(domain_error(close_option,Opt),G))
'$do_error'(domain_error(close_option,Opt),G)
).
'$check_opt'(open(_,_,_,_),Opt,G) :- !,
'$check_opt_open'(Opt, G).
@ -140,7 +140,7 @@ open(F,T,S,Opts) :-
'$check_opt_open'(eof_action(T), G) :- !,
'$check_open_eof_action_arg'(T, G).
'$check_opt_open'(A, G) :-
throw(error(domain_error(stream_option,A),G)).
'$do_error'(domain_error(stream_option,A),G).
'$check_opt_read'(variables(_), _) :- !.
'$check_opt_read'(variable_names(_), _) :- !.
@ -149,7 +149,7 @@ open(F,T,S,Opts) :-
'$check_read_syntax_errors_arg'(T, G).
'$check_opt_read'(term_position(_), G) :- !.
'$check_opt_read'(A, G) :-
throw(error(domain_error(read_option,A),G)).
'$do_error'(domain_error(read_option,A),G).
'$check_opt_sp'(file_name(_), _) :- !.
'$check_opt_sp'(mode(_), _) :- !.
@ -162,7 +162,7 @@ open(F,T,S,Opts) :-
'$check_opt_sp'(reposition(_), _) :- !.
'$check_opt_sp'(type(_), _) :- !.
'$check_opt_sp'(A, G) :-
throw(error(domain_error(stream_property,A),G)).
'$do_error'(domain_error(stream_property,A),G).
'$check_opt_write'(quoted(T), G) :- !,
'$check_write_quoted_arg'(T, G).
@ -175,93 +175,93 @@ open(F,T,S,Opts) :-
'$check_opt_write'(max_depth(T), G) :- !,
'$check_write_max_depth'(T, G).
'$check_opt_write'(A, G) :-
throw(error(domain_error(write_option,A),G)).
'$do_error'(domain_error(write_option,A),G).
%
% check force arg
%
'$check_force_opt_arg'(X,G) :- var(X), !,
throw(error(instantiation_error,G)).
'$do_error'(instantiation_error,G).
'$check_force_opt_arg'(true,_) :- !.
'$check_force_opt_arg'(false,_) :- !.
'$check_force_opt_arg'(X,G) :-
throw(error(domain_error(close_option,force(X)),G)).
'$do_error'(domain_error(close_option,force(X)),G).
'$check_open_type_arg'(X, G) :- var(X), !,
throw(error(instantiation_error,G)).
'$do_error'(instantiation_error,G).
'$check_open_type_arg'(text,_) :- !.
'$check_open_type_arg'(binary,_) :- !.
'$check_open_opt_arg'(X,G) :-
throw(error(domain_error(io_mode,type(X)),G)).
'$do_error'(domain_error(io_mode,type(X)),G).
'$check_open_reposition_arg'(X, G) :- var(X), !,
throw(error(instantiation_error,G)).
'$do_error'(instantiation_error,G).
'$check_open_reposition_arg'(true,_) :- !.
'$check_open_reposition_arg'(false,_) :- !.
'$check_open_reposition_arg'(X,G) :-
throw(error(domain_error(io_mode,reposition(X)),G)).
'$do_error'(domain_error(io_mode,reposition(X)),G).
'$check_open_alias_arg'(X, G) :- var(X), !,
throw(error(instantiation_error,G)).
'$do_error'(instantiation_error,G).
'$check_open_alias_arg'(X,G) :- atom(X), !,
( '$check_if_valid_new_alias'(X), X \= user ->
true ;
throw(error(permission_error(open, source_sink, alias(X)),G))
'$do_error'(permission_error(open, source_sink, alias(X)),G)
).
'$check_open_alias_arg'(X,G) :-
throw(error(domain_error(io_mode,alias(X)),G)).
'$do_error'(domain_error(io_mode,alias(X)),G).
'$check_open_eof_action_arg'(X, G) :- var(X), !,
throw(error(instantiation_error,G)).
'$do_error'(instantiation_error,G).
'$check_open_eof_action_arg'(error,_) :- !.
'$check_open_eof_action_arg'(eof_code,_) :- !.
'$check_open_eof_action_arg'(reset,_) :- !.
'$check_open_eof_action_arg'(X,G) :-
throw(error(domain_error(io_mode,eof_action(X)),G)).
'$do_error'(domain_error(io_mode,eof_action(X)),G).
'$check_read_syntax_errors_arg'(X, G) :- var(X), !,
throw(error(instantiation_error,G)).
'$do_error'(instantiation_error,G).
'$check_read_syntax_errors_arg'(dec10,_) :- !.
'$check_read_syntax_errors_arg'(fail,_) :- !.
'$check_read_syntax_errors_arg'(error,_) :- !.
'$check_read_syntax_errors_arg'(quiet,_) :- !.
'$check_read_syntax_errors_arg'(X,G) :-
throw(error(domain_error(read_option,syntax_errors(X)),G)).
'$do_error'(domain_error(read_option,syntax_errors(X)),G).
'$check_write_quoted_arg'(X, G) :- var(X), !,
throw(error(instantiation_error,G)).
'$do_error'(instantiation_error,G).
'$check_write_quoted_arg'(true,_) :- !.
'$check_write_quoted_arg'(false,_) :- !.
'$check_write_quoted_arg'(X,G) :-
throw(error(domain_error(write_option,write_quoted(X)),G)).
'$do_error'(domain_error(write_option,write_quoted(X)),G).
'$check_write_ignore_ops_arg'(X, G) :- var(X), !,
throw(error(instantiation_error,G)).
'$do_error'(instantiation_error,G).
'$check_write_ignore_ops_arg'(true,_) :- !.
'$check_write_ignore_ops_arg'(false,_) :- !.
'$check_write_ignore_ops_arg'(X,G) :-
throw(error(domain_error(write_option,ignore_ops(X)),G)).
'$do_error'(domain_error(write_option,ignore_ops(X)),G).
'$check_write_numbervars_arg'(X, G) :- var(X), !,
throw(error(instantiation_error,G)).
'$do_error'(instantiation_error,G).
'$check_write_numbervars_arg'(true,_) :- !.
'$check_write_numbervars_arg'(false,_) :- !.
'$check_write_numbervars_arg'(X,G) :-
throw(error(domain_error(write_option,numbervars(X)),G)).
'$do_error'(domain_error(write_option,numbervars(X)),G).
'$check_write_portrayed'(X, G) :- var(X), !,
throw(error(instantiation_error,G)).
'$do_error'(instantiation_error,G).
'$check_write_portrayed'(true,_) :- !.
'$check_write_portrayed'(false,_) :- !.
'$check_write_portrayed'(X,G) :-
throw(error(domain_error(write_option,portrayed(X)),G)).
'$do_error'(domain_error(write_option,portrayed(X)),G).
'$check_write_max_depth'(X, G) :- var(X), !,
throw(error(instantiation_error,G)).
'$do_error'(instantiation_error,G).
'$check_write_max_depth'(I,_) :- integer(I), I > 0, !.
'$check_write_max_depth'(X,G) :-
throw(error(domain_error(write_option,max_depth(X)),G)).
'$do_error'(domain_error(write_option,max_depth(X)),G).
set_input(Stream) :-
'$set_input'(Stream).
@ -280,7 +280,7 @@ exists(F) :- '$exists'(F,read).
see(user) :- !, set_input(user_input).
see(F) :- var(F), !,
throw(error(instantiation_error,see(F))).
'$do_error'(instantiation_error,see(F)).
see(F) :- current_input(Stream),
'$user_file_name'(Stream,F).
see(F) :- current_stream(_,read,Stream), '$user_file_name'(Stream,F), !,
@ -297,7 +297,7 @@ seen :- current_input(Stream), '$close'(Stream), set_input(user).
tell(user) :- !, set_output(user_output).
tell(F) :- var(F), !,
throw(error(instantiation_error,tell(F))).
'$do_error'(instantiation_error,tell(F)).
tell(F) :- current_output(Stream),
'$user_file_name'(Stream,F), !.
tell(F) :- current_stream(_,write,Stream), '$user_file_name'(Stream, F), !,
@ -524,34 +524,34 @@ get(N) :- current_input(S), '$get'(S,N).
get_byte(V) :-
\+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !,
throw(error(type_error(in_byte,V),get_byte(V))).
'$do_error'(type_error(in_byte,V),get_byte(V)).
get_byte(V) :-
current_input(S),
'$get_byte'(S,V).
get_byte(S,V) :-
\+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !,
throw(error(type_error(in_byte,V),get_byte(S,V))).
'$do_error'(type_error(in_byte,V),get_byte(S,V)).
get_byte(S,V) :-
'$get_byte'(S,V).
peek_byte(V) :-
\+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !,
throw(error(type_error(in_byte,V),get_byte(V))).
'$do_error'(type_error(in_byte,V),get_byte(V)).
peek_byte(V) :-
current_input(S),
'$peek_byte'(S,V).
peek_byte(S,V) :-
\+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !,
throw(error(type_error(in_byte,V),get_byte(S,V))).
'$do_error'(type_error(in_byte,V),get_byte(S,V)).
peek_byte(S,V) :-
'$peek_byte'(S,V).
get_char(V) :-
\+ var(V),
( atom(V) -> atom_codes(V,[_,_|_]), V \= end_of_file ; true ), !,
throw(error(type_error(in_character,V),get_char(V))).
'$do_error'(type_error(in_character,V),get_char(V)).
get_char(V) :-
current_input(S),
'$get0'(S,I),
@ -560,7 +560,7 @@ get_char(V) :-
get_char(S,V) :-
\+ var(V),
( atom(V) -> atom_codes(V,[_,_|_]), V \= end_of_file ; true ), !,
throw(error(type_error(in_character,V),get_char(S,V))).
'$do_error'(type_error(in_character,V),get_char(S,V)).
get_char(S,V) :-
'$get0'(S,I),
( I = -1 -> V = end_of_file ; atom_codes(V,[I])).
@ -568,7 +568,7 @@ get_char(S,V) :-
peek_char(V) :-
\+ var(V),
( atom(V) -> atom_codes(V,[_,_|_]), V \= end_of_file ; true ), !,
throw(error(type_error(in_character,V),get_char(V))).
'$do_error'(type_error(in_character,V),get_char(V)).
peek_char(V) :-
current_input(S),
'$peek'(S,I),
@ -577,89 +577,89 @@ peek_char(V) :-
peek_char(S,V) :-
\+ var(V),
( atom(V) -> atom_codes(V,[_,_|_]), V \= end_of_file ; true ), !,
throw(error(type_error(in_character,V),get_char(S,V))).
'$do_error'(type_error(in_character,V),get_char(S,V)).
peek_char(S,V) :-
'$peek'(S,I),
( I = -1 -> V = end_of_file ; atom_codes(V,[I])).
get_code(S,V) :-
\+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !,
throw(error(type_error(in_character_code,V),get_code(S,V))).
'$do_error'(type_error(in_character_code,V),get_code(S,V)).
get_code(S,V) :-
'$get0'(S,V).
get_code(V) :-
\+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !,
throw(error(type_error(in_character_code,V),get_code(V))).
'$do_error'(type_error(in_character_code,V),get_code(V)).
get_code(V) :-
current_input(S),
'$get0'(S,V).
peek_code(S,V) :-
\+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !,
throw(error(type_error(in_character_code,V),get_code(S,V))).
'$do_error'(type_error(in_character_code,V),get_code(S,V)).
peek_code(S,V) :-
'$peek'(S,V).
peek_code(V) :-
\+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !,
throw(error(type_error(in_character_code,V),get_code(V))).
'$do_error'(type_error(in_character_code,V),get_code(V)).
peek_code(V) :-
current_input(S),
'$peek'(S,V).
put_byte(V) :- var(V), !,
throw(error(instantiation_error,put_byte(V))).
'$do_error'(instantiation_error,put_byte(V)).
put_byte(V) :-
(\+ integer(V) ; V < 0 ; V > 256), !,
throw(error(type_error(byte,V),put_byte(V))).
'$do_error'(type_error(byte,V),put_byte(V)).
put_byte(V) :-
current_output(S),
'$put_byte'(S,V).
put_byte(S,V) :- var(V), !,
throw(error(instantiation_error,put_byte(S,V))).
'$do_error'(instantiation_error,put_byte(S,V)).
put_byte(S,V) :-
(\+ integer(V) ; V < 0 ; V > 256), !,
throw(error(type_error(byte,V),put_byte(S,V))).
'$do_error'(type_error(byte,V),put_byte(S,V)).
put_byte(S,V) :-
'$put_byte'(S,V).
put_char(V) :- var(V), !,
throw(error(instantiation_error,put_char(V))).
'$do_error'(instantiation_error,put_char(V)).
put_char(V) :-
( atom(V) -> atom_codes(V,[_,_|_]) ; true ), !,
throw(error(type_error(character,V),put_char(V))).
'$do_error'(type_error(character,V),put_char(V)).
put_char(V) :-
current_output(S),
atom_codes(V,[I]),
'$put'(S,I).
put_char(S,V) :- var(V), !,
throw(error(instantiation_error,put_char(S,V))).
'$do_error'(instantiation_error,put_char(S,V)).
put_char(S,V) :-
( atom(V) -> atom_codes(V,[_,_|_]) ; true ), !,
throw(error(type_error(character,V),put_char(S,V))).
'$do_error'(type_error(character,V),put_char(S,V)).
put_char(S,V) :-
atom_codes(V,[I]),
'$put'(S,I).
put_code(V) :- var(V), !,
throw(error(instantiation_error,put_code(V))).
'$do_error'(instantiation_error,put_code(V)).
put_code(V) :-
(\+ integer(V) ; V < 0 ; V > 256), !,
throw(error(type_error(character_code,V),put_code(V))).
'$do_error'(type_error(character_code,V),put_code(V)).
put_code(V) :-
current_output(S),
'$put'(S,V).
put_code(S,V) :- var(V), !,
throw(error(instantiation_error,put_code(S,V))).
'$do_error'(instantiation_error,put_code(S,V)).
put_code(S,V) :-
(\+ integer(V) ; V < 0 ; V > 256), !,
throw(error(type_error(character_code,V),put_code(S,V))).
'$do_error'(type_error(character_code,V),put_code(S,V)).
put_code(S,V) :-
'$put'(S,V).
@ -768,7 +768,7 @@ stream_position(S,N,M) :-
set_stream_position(S,N) :- var(S), !,
throw(error(instantiation_error, set_stream_position(S, N))).
'$do_error'(instantiation_error, set_stream_position(S, N)).
set_stream_position(user,N) :- !,
'$set_stream_position'(user_input,N).
set_stream_position(A,N) :-
@ -789,7 +789,7 @@ stream_property(Stream, Props) :-
'$current_stream'(_,_,Stream), !,
'$stream_property'(Stream, Props).
stream_property(Stream, Props) :-
throw(error(domain_error(stream,Stream),stream_property(Stream, Props))).
'$do_error'(domain_error(stream,Stream),stream_property(Stream, Props)).
'$generate_prop'(file_name(_F)).
'$generate_prop'(mode(_M)).
@ -804,7 +804,7 @@ stream_property(Stream, Props) :-
'$stream_property'(Stream, Props) :-
var(Props), !,
throw(error(instantiation_error, stream_properties(Stream, Props))).
'$do_error'(instantiation_error, stream_properties(Stream, Props)).
'$stream_property'(Stream, Props0) :-
'$check_stream_props'(Props0, Props),
'$check_io_opts'(Props, stream_property(Stream, Props)),
@ -882,7 +882,7 @@ at_end_of_stream(S) :-
consult_depth(LV) :- '$show_consult_level'(LV).
absolute_file_name(V,Out) :- var(V), !,
throw(error(instantiation_error, absolute_file_name(V, Out))).
'$do_error'(instantiation_error, absolute_file_name(V, Out)).
absolute_file_name(user,user) :- !.
absolute_file_name(RelFile,AbsFile) :-
'$find_in_path'(RelFile,PathFile,absolute_file_name(RelFile,AbsFile)),