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(); saveregs();
save_machine_regs(); save_machine_regs();
SREG = (CELL *) YapExecute(p, (CPredicate)(p->TrueCodeOfPred)); SREG = (CELL *) YAP_Execute(p, (CPredicate)(p->TrueCodeOfPred));
EX = 0L; EX = 0L;
} }
@ -5984,7 +5984,7 @@ absmi(int inp)
ASP = YENV; ASP = YENV;
saveregs(); saveregs();
save_machine_regs(); 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; EX = 0L;
restore_machine_regs(); restore_machine_regs();
setregs(); setregs();

409
C/c_interface.c
View File

@ -39,85 +39,87 @@
#define X_API #define X_API
#endif #endif
X_API Term STD_PROTO(YapA,(int)); X_API Term STD_PROTO(YAP_A,(int));
X_API Term STD_PROTO(YapMkVarTerm,(void)); X_API Term STD_PROTO(YAP_MkVarTerm,(void));
X_API Bool STD_PROTO(YapIsVarTerm,(Term)); X_API Bool STD_PROTO(YAP_IsVarTerm,(Term));
X_API Bool STD_PROTO(YapIsNonVarTerm,(Term)); X_API Bool STD_PROTO(YAP_IsNonVarTerm,(Term));
X_API Bool STD_PROTO(YapIsIntTerm,(Term)); X_API Bool STD_PROTO(YAP_IsIntTerm,(Term));
X_API Bool STD_PROTO(YapIsFloatTerm,(Term)); X_API Bool STD_PROTO(YAP_IsFloatTerm,(Term));
X_API Bool STD_PROTO(YapIsDbRefTerm,(Term)); X_API Bool STD_PROTO(YAP_IsDbRefTerm,(Term));
X_API Bool STD_PROTO(YapIsAtomTerm,(Term)); X_API Bool STD_PROTO(YAP_IsAtomTerm,(Term));
X_API Bool STD_PROTO(YapIsPairTerm,(Term)); X_API Bool STD_PROTO(YAP_IsPairTerm,(Term));
X_API Bool STD_PROTO(YapIsApplTerm,(Term)); X_API Bool STD_PROTO(YAP_IsApplTerm,(Term));
X_API Term STD_PROTO(YapMkIntTerm,(Int)); X_API Term STD_PROTO(YAP_MkIntTerm,(Int));
X_API Int STD_PROTO(YapIntOfTerm,(Term)); X_API Int STD_PROTO(YAP_IntOfTerm,(Term));
X_API Term STD_PROTO(YapMkFloatTerm,(flt)); X_API Term STD_PROTO(YAP_MkFloatTerm,(flt));
X_API flt STD_PROTO(YapFloatOfTerm,(Term)); X_API flt STD_PROTO(YAP_FloatOfTerm,(Term));
X_API Term STD_PROTO(YapMkAtomTerm,(Atom)); X_API Term STD_PROTO(YAP_MkAtomTerm,(Atom));
X_API Atom STD_PROTO(YapAtomOfTerm,(Term)); X_API Atom STD_PROTO(YAP_AtomOfTerm,(Term));
X_API Atom STD_PROTO(YapLookupAtom,(char *)); X_API Atom STD_PROTO(YAP_LookupAtom,(char *));
X_API Atom STD_PROTO(YapFullLookupAtom,(char *)); X_API Atom STD_PROTO(YAP_FullLookupAtom,(char *));
X_API char *STD_PROTO(YapAtomName,(Atom)); X_API char *STD_PROTO(YAP_AtomName,(Atom));
X_API Term STD_PROTO(YapMkPairTerm,(Term,Term)); X_API Term STD_PROTO(YAP_MkPairTerm,(Term,Term));
X_API Term STD_PROTO(YapMkNewPairTerm,(void)); X_API Term STD_PROTO(YAP_MkNewPairTerm,(void));
X_API Term STD_PROTO(YapHeadOfTerm,(Term)); X_API Term STD_PROTO(YAP_HeadOfTerm,(Term));
X_API Term STD_PROTO(YapTailOfTerm,(Term)); X_API Term STD_PROTO(YAP_TailOfTerm,(Term));
X_API Term STD_PROTO(YapMkApplTerm,(Functor,unsigned int,Term *)); X_API Term STD_PROTO(YAP_MkApplTerm,(Functor,unsigned long int,Term *));
X_API Term STD_PROTO(YapMkNewApplTerm,(Functor,unsigned int)); X_API Term STD_PROTO(YAP_MkNewApplTerm,(Functor,unsigned long int));
X_API Functor STD_PROTO(YapFunctorOfTerm,(Term)); X_API Functor STD_PROTO(YAP_FunctorOfTerm,(Term));
X_API Term STD_PROTO(YapArgOfTerm,(Int,Term)); X_API Term STD_PROTO(YAP_ArgOfTerm,(Int,Term));
X_API Functor STD_PROTO(YapMkFunctor,(Atom,Int)); X_API Functor STD_PROTO(YAP_MkFunctor,(Atom,Int));
X_API Atom STD_PROTO(YapNameOfFunctor,(Functor)); X_API Atom STD_PROTO(YAP_NameOfFunctor,(Functor));
X_API Int STD_PROTO(YapArityOfFunctor,(Functor)); X_API Int STD_PROTO(YAP_ArityOfFunctor,(Functor));
X_API void *STD_PROTO(YapExtraSpace,(void)); X_API void *STD_PROTO(YAP_ExtraSpace,(void));
X_API Int STD_PROTO(Yapcut_fail,(void)); X_API Int STD_PROTO(YAP_cut_fail,(void));
X_API Int STD_PROTO(Yapcut_succeed,(void)); X_API Int STD_PROTO(YAP_cut_succeed,(void));
X_API Int STD_PROTO(YapUnify,(Term,Term)); X_API Int STD_PROTO(YAP_Unify,(Term,Term));
X_API Int STD_PROTO(YapUnify,(Term,Term)); X_API Int STD_PROTO(YAP_Unify,(Term,Term));
X_API int STD_PROTO(YapReset,(void)); X_API int STD_PROTO(YAP_Reset,(void));
X_API Int STD_PROTO(YapInit,(yap_init_args *)); X_API Int STD_PROTO(YAP_Init,(YAP_init_args *));
X_API Int STD_PROTO(YapFastInit,(char *)); X_API Int STD_PROTO(YAP_FastInit,(char *));
X_API Int STD_PROTO(YapCallProlog,(Term)); X_API Int STD_PROTO(YAP_CallProlog,(Term));
X_API void *STD_PROTO(YapAllocSpaceFromYap,(unsigned int)); X_API void *STD_PROTO(YAP_AllocSpaceFromYap,(unsigned int));
X_API void STD_PROTO(YapFreeSpaceFromYap,(void *)); X_API void STD_PROTO(YAP_FreeSpaceFromYap,(void *));
X_API int STD_PROTO(YapStringToBuffer, (Term, char *, unsigned int)); X_API int STD_PROTO(YAP_StringToBuffer, (Term, char *, unsigned int));
X_API Term STD_PROTO(YapBufferToString, (char *)); X_API Term STD_PROTO(YAP_BufferToString, (char *));
X_API Term STD_PROTO(YapBufferToAtomList, (char *)); X_API Term STD_PROTO(YAP_BufferToAtomList, (char *));
X_API void STD_PROTO(YapError,(char *)); X_API void STD_PROTO(YAP_Error,(char *));
X_API int STD_PROTO(YapRunGoal,(Term)); X_API int STD_PROTO(YAP_RunGoal,(Term));
X_API int STD_PROTO(YapRestartGoal,(void)); X_API int STD_PROTO(YAP_RestartGoal,(void));
X_API int STD_PROTO(YapGoalHasException,(Term *)); X_API int STD_PROTO(YAP_GoalHasException,(Term *));
X_API int STD_PROTO(YapContinueGoal,(void)); X_API int STD_PROTO(YAP_ContinueGoal,(void));
X_API void STD_PROTO(YapPruneGoal,(void)); X_API void STD_PROTO(YAP_PruneGoal,(void));
X_API void STD_PROTO(YapInitConsult,(int, char *)); X_API void STD_PROTO(YAP_InitConsult,(int, char *));
X_API void STD_PROTO(YapEndConsult,(void)); X_API void STD_PROTO(YAP_EndConsult,(void));
X_API Term STD_PROTO(YapRead, (int (*)(void))); X_API Term STD_PROTO(YAP_Read, (int (*)(void)));
X_API void STD_PROTO(YapWrite, (Term, void (*)(int), int)); X_API void STD_PROTO(YAP_Write, (Term, void (*)(int), int));
X_API char *STD_PROTO(YapCompileClause, (Term)); X_API char *STD_PROTO(YAP_CompileClause, (Term));
X_API void STD_PROTO(YapPutValue, (Atom,Term)); X_API void STD_PROTO(YAP_PutValue, (Atom,Term));
X_API Term STD_PROTO(YapGetValue, (Atom)); X_API Term STD_PROTO(YAP_GetValue, (Atom));
X_API int STD_PROTO(YapReset, (void)); X_API int STD_PROTO(YAP_Reset, (void));
X_API void STD_PROTO(YapExit, (int)); X_API void STD_PROTO(YAP_Exit, (int));
X_API void STD_PROTO(YapInitSocks, (char *, long)); X_API void STD_PROTO(YAP_InitSocks, (char *, long));
X_API void STD_PROTO(YapSetOutputMessage, (void)); X_API void STD_PROTO(YAP_SetOutputMessage, (void));
X_API int STD_PROTO(YapStreamToFileNo, (Term)); X_API int STD_PROTO(YAP_StreamToFileNo, (Term));
X_API void STD_PROTO(YapCloseAllOpenStreams,(void)); X_API void STD_PROTO(YAP_CloseAllOpenStreams,(void));
X_API Term STD_PROTO(YapOpenStream,(void *, char *, Term, int)); X_API Term STD_PROTO(YAP_OpenStream,(void *, char *, Term, int));
X_API long STD_PROTO(YapNewSlots,(int)); X_API long STD_PROTO(YAP_NewSlots,(int));
X_API long STD_PROTO(YapInitSlot,(Term)); X_API long STD_PROTO(YAP_InitSlot,(Term));
X_API Term STD_PROTO(YapGetFromSlot,(long)); X_API Term STD_PROTO(YAP_GetFromSlot,(long));
X_API Term *STD_PROTO(YapAddressFromSlot,(long)); X_API Term *STD_PROTO(YAP_AddressFromSlot,(long));
X_API void STD_PROTO(YapPutInSlot,(long, Term)); X_API void STD_PROTO(YAP_PutInSlot,(long, Term));
X_API void STD_PROTO(YapRecoverSlots,(int)); X_API void STD_PROTO(YAP_RecoverSlots,(int));
X_API void STD_PROTO(YapThrow,(Term)); X_API void STD_PROTO(YAP_Throw,(Term));
X_API int STD_PROTO(YapLookupModule,(Term)); X_API int STD_PROTO(YAP_LookupModule,(Term));
X_API Term STD_PROTO(YapModuleName,(int)); X_API Term STD_PROTO(YAP_ModuleName,(int));
X_API void STD_PROTO(YapHalt,(int)); X_API void STD_PROTO(YAP_Halt,(int));
X_API Term *STD_PROTO(YapTopOfLocalStack,(void)); X_API Term *STD_PROTO(YAP_TopOfLocalStack,(void));
X_API void *STD_PROTO(YapPredicate,(Atom,Int,Int)); X_API void *STD_PROTO(YAP_Predicate,(Atom,unsigned long int,int));
X_API void STD_PROTO(YapPredicateInfo,(void *,Atom *,Int *,Int *)); X_API void STD_PROTO(YAP_PredicateInfo,(void *,Atom *,unsigned long int *,int *));
X_API void STD_PROTO(YapUserCPredicateWithArgs,(char *,CPredicate,Int,Int)); X_API void STD_PROTO(YAP_UserCPredicate,(char *,CPredicate,unsigned long int));
X_API Int STD_PROTO(YapCurrentModule,(void)); 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); static int (*do_getf)(void);
@ -133,63 +135,62 @@ static int do_yap_putc(int streamno,int ch) {
} }
X_API Term X_API Term
YapA(int i) YAP_A(int i)
{ {
return(Deref(XREGS[i])); return(Deref(XREGS[i]));
} }
X_API Bool X_API Bool
YapIsIntTerm(Term t) YAP_IsIntTerm(Term t)
{ {
return (IsIntegerTerm(t)); return (IsIntegerTerm(t));
} }
X_API Bool X_API Bool
YapIsVarTerm(Term t) YAP_IsVarTerm(Term t)
{ {
return (IsVarTerm(t)); return (IsVarTerm(t));
} }
X_API Bool X_API Bool
YapIsNonVarTerm(Term t) YAP_IsNonVarTerm(Term t)
{ {
return (IsNonVarTerm(t)); return (IsNonVarTerm(t));
} }
X_API Bool X_API Bool
YapIsFloatTerm(Term t) YAP_IsFloatTerm(Term t)
{ {
return (IsFloatTerm(t)); return (IsFloatTerm(t));
} }
X_API Bool X_API Bool
YapIsDbRefTerm(Term t) YAP_IsDbRefTerm(Term t)
{ {
return (IsDBRefTerm(t)); return (IsDBRefTerm(t));
} }
X_API Bool X_API Bool
YapIsAtomTerm(Term t) YAP_IsAtomTerm(Term t)
{ {
return (IsAtomTerm(t)); return (IsAtomTerm(t));
} }
X_API Bool X_API Bool
YapIsPairTerm(Term t) YAP_IsPairTerm(Term t)
{ {
return (IsPairTerm(t)); return (IsPairTerm(t));
} }
X_API Bool X_API Bool
YapIsApplTerm(Term t) YAP_IsApplTerm(Term t)
{ {
return (IsApplTerm(t) && !IsExtensionFunctor(FunctorOfTerm(t))); return (IsApplTerm(t) && !IsExtensionFunctor(FunctorOfTerm(t)));
} }
X_API Term X_API Term
YapMkIntTerm(Int n) YAP_MkIntTerm(Int n)
{ {
Term I; Term I;
BACKUP_H(); BACKUP_H();
@ -200,7 +201,7 @@ YapMkIntTerm(Int n)
} }
X_API Int X_API Int
YapIntOfTerm(Term t) YAP_IntOfTerm(Term t)
{ {
if (!IsApplTerm(t)) if (!IsApplTerm(t))
return (IntOfTerm(t)); return (IntOfTerm(t));
@ -209,7 +210,7 @@ YapIntOfTerm(Term t)
} }
X_API Term X_API Term
YapMkFloatTerm(double n) YAP_MkFloatTerm(double n)
{ {
Term t; Term t;
BACKUP_H(); BACKUP_H();
@ -221,13 +222,13 @@ YapMkFloatTerm(double n)
} }
X_API flt X_API flt
YapFloatOfTerm(Term t) YAP_FloatOfTerm(Term t)
{ {
return (FloatOfTerm(t)); return (FloatOfTerm(t));
} }
X_API Term X_API Term
YapMkAtomTerm(Atom n) YAP_MkAtomTerm(Atom n)
{ {
Term t; Term t;
@ -236,14 +237,14 @@ YapMkAtomTerm(Atom n)
} }
X_API Atom X_API Atom
YapAtomOfTerm(Term t) YAP_AtomOfTerm(Term t)
{ {
return (AtomOfTerm(t)); return (AtomOfTerm(t));
} }
X_API char * X_API char *
YapAtomName(Atom a) YAP_AtomName(Atom a)
{ {
char *o; char *o;
@ -252,13 +253,13 @@ YapAtomName(Atom a)
} }
X_API Atom X_API Atom
YapLookupAtom(char *c) YAP_LookupAtom(char *c)
{ {
return(LookupAtom(c)); return(LookupAtom(c));
} }
X_API Atom X_API Atom
YapFullLookupAtom(char *c) YAP_FullLookupAtom(char *c)
{ {
Atom at; Atom at;
@ -267,7 +268,7 @@ YapFullLookupAtom(char *c)
} }
X_API Term X_API Term
YapMkVarTerm(void) YAP_MkVarTerm(void)
{ {
CELL t; CELL t;
BACKUP_H(); BACKUP_H();
@ -279,7 +280,7 @@ YapMkVarTerm(void)
} }
X_API Term X_API Term
YapMkPairTerm(Term t1, Term t2) YAP_MkPairTerm(Term t1, Term t2)
{ {
Term t; Term t;
BACKUP_H(); BACKUP_H();
@ -291,7 +292,7 @@ YapMkPairTerm(Term t1, Term t2)
} }
X_API Term X_API Term
YapMkNewPairTerm() YAP_MkNewPairTerm()
{ {
Term t; Term t;
BACKUP_H(); BACKUP_H();
@ -303,19 +304,19 @@ YapMkNewPairTerm()
} }
X_API Term X_API Term
YapHeadOfTerm(Term t) YAP_HeadOfTerm(Term t)
{ {
return (HeadOfTerm(t)); return (HeadOfTerm(t));
} }
X_API Term X_API Term
YapTailOfTerm(Term t) YAP_TailOfTerm(Term t)
{ {
return (TailOfTerm(t)); return (TailOfTerm(t));
} }
X_API Term X_API Term
YapMkApplTerm(Functor f,unsigned int arity, Term args[]) YAP_MkApplTerm(Functor f,unsigned long int arity, Term args[])
{ {
Term t; Term t;
BACKUP_H(); BACKUP_H();
@ -327,7 +328,7 @@ YapMkApplTerm(Functor f,unsigned int arity, Term args[])
} }
X_API Term X_API Term
YapMkNewApplTerm(Functor f,unsigned int arity) YAP_MkNewApplTerm(Functor f,unsigned long int arity)
{ {
Term t; Term t;
BACKUP_H(); BACKUP_H();
@ -339,14 +340,14 @@ YapMkNewApplTerm(Functor f,unsigned int arity)
} }
X_API Functor X_API Functor
YapFunctorOfTerm(Term t) YAP_FunctorOfTerm(Term t)
{ {
return (FunctorOfTerm(t)); return (FunctorOfTerm(t));
} }
X_API Term X_API Term
YapArgOfTerm(Int n, Term t) YAP_ArgOfTerm(Int n, Term t)
{ {
return (ArgOfTerm(n, t)); return (ArgOfTerm(n, t));
} }
@ -354,25 +355,25 @@ YapArgOfTerm(Int n, Term t)
X_API Functor X_API Functor
YapMkFunctor(Atom a, Int n) YAP_MkFunctor(Atom a, Int n)
{ {
return (MkFunctor(a, n)); return (MkFunctor(a, n));
} }
X_API Atom X_API Atom
YapNameOfFunctor(Functor f) YAP_NameOfFunctor(Functor f)
{ {
return (NameOfFunctor(f)); return (NameOfFunctor(f));
} }
X_API Int X_API Int
YapArityOfFunctor(Functor f) YAP_ArityOfFunctor(Functor f)
{ {
return (ArityOfFunctor(f)); return (ArityOfFunctor(f));
} }
X_API void * X_API void *
YapExtraSpace(void) YAP_ExtraSpace(void)
{ {
void *ptr; void *ptr;
BACKUP_B(); BACKUP_B();
@ -385,7 +386,7 @@ YapExtraSpace(void)
} }
X_API Int X_API Int
Yapcut_fail(void) YAP_cut_fail(void)
{ {
BACKUP_B(); BACKUP_B();
@ -397,7 +398,7 @@ Yapcut_fail(void)
} }
X_API Int X_API Int
Yapcut_succeed(void) YAP_cut_succeed(void)
{ {
BACKUP_B(); BACKUP_B();
@ -409,7 +410,7 @@ Yapcut_succeed(void)
} }
X_API Int X_API Int
YapUnify(Term t1, Term t2) YAP_Unify(Term t1, Term t2)
{ {
Int out; Int out;
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
@ -421,7 +422,7 @@ YapUnify(Term t1, Term t2)
} }
X_API long X_API long
YapNewSlots(int n) YAP_NewSlots(int n)
{ {
Int old_slots = IntOfTerm(ASP[0]), oldn = n; Int old_slots = IntOfTerm(ASP[0]), oldn = n;
while (n > 0) { while (n > 0) {
@ -434,7 +435,7 @@ YapNewSlots(int n)
} }
X_API long X_API long
YapInitSlot(Term t) YAP_InitSlot(Term t)
{ {
Int old_slots = IntOfTerm(ASP[0]); Int old_slots = IntOfTerm(ASP[0]);
*ASP = t; *ASP = t;
@ -444,7 +445,7 @@ YapInitSlot(Term t)
} }
X_API void X_API void
YapRecoverSlots(int n) YAP_RecoverSlots(int n)
{ {
Int old_slots = IntOfTerm(ASP[0]); Int old_slots = IntOfTerm(ASP[0]);
ASP += n; ASP += n;
@ -452,19 +453,19 @@ YapRecoverSlots(int n)
} }
X_API Term X_API Term
YapGetFromSlot(long slot) YAP_GetFromSlot(long slot)
{ {
return(Deref(LCL0[slot])); return(Deref(LCL0[slot]));
} }
X_API Term * X_API Term *
YapAddressFromSlot(long slot) YAP_AddressFromSlot(long slot)
{ {
return(LCL0+slot); return(LCL0+slot);
} }
X_API void X_API void
YapPutInSlot(long slot, Term t) YAP_PutInSlot(long slot, Term t)
{ {
LCL0[slot] = 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); typedef Int (*CPredicate8)(long,long,long,long,long,long,long,long);
Int Int
YapExecute(PredEntry *pe, CPredicate exec_code) YAP_Execute(PredEntry *pe, CPredicate exec_code)
{ {
if (pe->PredFlags & CArgsPredFlag) { if (pe->PredFlags & CArgsPredFlag) {
switch (pe->ArityOfPE) { switch (pe->ArityOfPE) {
@ -492,69 +493,70 @@ YapExecute(PredEntry *pe, CPredicate exec_code)
case 1: case 1:
{ {
CPredicate1 code1 = (CPredicate1)exec_code; CPredicate1 code1 = (CPredicate1)exec_code;
return ((code1)(YapInitSlot(Deref(ARG1)))); return ((code1)(YAP_InitSlot(Deref(ARG1))));
} }
case 2: case 2:
{ {
CPredicate2 code2 = (CPredicate2)exec_code; CPredicate2 code2 = (CPredicate2)exec_code;
return ((code2)(YapInitSlot(Deref(ARG1)), return ((code2)(YAP_InitSlot(Deref(ARG1)),
YapInitSlot(Deref(ARG2)))); YAP_InitSlot(Deref(ARG2))));
} }
case 3: case 3:
{ {
CPredicate3 code3 = (CPredicate3)exec_code; CPredicate3 code3 = (CPredicate3)exec_code;
return ((code3)(YapInitSlot(Deref(ARG1)), return ((code3)(YAP_InitSlot(Deref(ARG1)),
YapInitSlot(Deref(ARG2)), YAP_InitSlot(Deref(ARG2)),
YapInitSlot(Deref(ARG3)))); YAP_InitSlot(Deref(ARG3))));
} }
case 4: case 4:
{ {
CPredicate4 code4 = (CPredicate4)exec_code; CPredicate4 code4 = (CPredicate4)exec_code;
return ((code4)(YapInitSlot(Deref(ARG1)), return ((code4)(YAP_InitSlot(Deref(ARG1)),
YapInitSlot(Deref(ARG2)), YAP_InitSlot(Deref(ARG2)),
YapInitSlot(Deref(ARG3)), YAP_InitSlot(Deref(ARG3)),
YapInitSlot(Deref(ARG4)))); YAP_InitSlot(Deref(ARG4))));
} }
case 5: case 5:
{ {
CPredicate5 code5 = (CPredicate5)exec_code; CPredicate5 code5 = (CPredicate5)exec_code;
return ((code5)(YapInitSlot(Deref(ARG1)), return ((code5)(YAP_InitSlot(Deref(ARG1)),
YapInitSlot(Deref(ARG2)), YAP_InitSlot(Deref(ARG2)),
YapInitSlot(Deref(ARG3)), YAP_InitSlot(Deref(ARG3)),
YapInitSlot(Deref(ARG4)),YapInitSlot(Deref(ARG5)))); YAP_InitSlot(Deref(ARG4)),
YAP_InitSlot(Deref(ARG5))));
} }
case 6: case 6:
{ {
CPredicate6 code6 = (CPredicate6)exec_code; CPredicate6 code6 = (CPredicate6)exec_code;
return ((code6)(YapInitSlot(Deref(ARG1)), return ((code6)(YAP_InitSlot(Deref(ARG1)),
YapInitSlot(Deref(ARG2)), YAP_InitSlot(Deref(ARG2)),
YapInitSlot(Deref(ARG3)), YAP_InitSlot(Deref(ARG3)),
YapInitSlot(Deref(ARG4)), YAP_InitSlot(Deref(ARG4)),
YapInitSlot(Deref(ARG5)), YAP_InitSlot(Deref(ARG5)),
YapInitSlot(Deref(ARG6)))); YAP_InitSlot(Deref(ARG6))));
} }
case 7: case 7:
{ {
CPredicate7 code7 = (CPredicate7)exec_code; CPredicate7 code7 = (CPredicate7)exec_code;
return ((code7)(YapInitSlot(Deref(ARG1)), return ((code7)(YAP_InitSlot(Deref(ARG1)),
YapInitSlot(Deref(ARG2)), YAP_InitSlot(Deref(ARG2)),
YapInitSlot(Deref(ARG3)), YAP_InitSlot(Deref(ARG3)),
YapInitSlot(Deref(ARG4)), YAP_InitSlot(Deref(ARG4)),
YapInitSlot(Deref(ARG5)), YAP_InitSlot(Deref(ARG5)),
YapInitSlot(Deref(ARG6)), YAP_InitSlot(Deref(ARG6)),
YapInitSlot(Deref(ARG7)))); YAP_InitSlot(Deref(ARG7))));
} }
case 8: case 8:
{ {
CPredicate8 code8 = (CPredicate8)exec_code; CPredicate8 code8 = (CPredicate8)exec_code;
return ((code8)(YapInitSlot(Deref(ARG1)), return ((code8)(YAP_InitSlot(Deref(ARG1)),
YapInitSlot(Deref(ARG2)), YAP_InitSlot(Deref(ARG2)),
YapInitSlot(Deref(ARG3)), YAP_InitSlot(Deref(ARG3)),
YapInitSlot(Deref(ARG4)), YAP_InitSlot(Deref(ARG4)),
YapInitSlot(Deref(ARG5)), YAP_InitSlot(Deref(ARG5)),
YapInitSlot(Deref(ARG6)), YAP_InitSlot(Deref(ARG6)),
YapInitSlot(Deref(ARG7)), YAP_InitSlot(Deref(ARG7)),
YapInitSlot(Deref(ARG8)))); YAP_InitSlot(Deref(ARG8))));
} }
default: default:
return(FALSE); return(FALSE);
@ -565,7 +567,7 @@ YapExecute(PredEntry *pe, CPredicate exec_code)
} }
X_API Int X_API Int
YapCallProlog(Term t) YAP_CallProlog(Term t)
{ {
Int out; Int out;
SMALLUNSGN mod = CurrentModule; SMALLUNSGN mod = CurrentModule;
@ -586,7 +588,7 @@ YapCallProlog(Term t)
} }
X_API void * X_API void *
YapAllocSpaceFromYap(unsigned int size) YAP_AllocSpaceFromYap(unsigned int size)
{ {
void *ptr; void *ptr;
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
@ -603,14 +605,14 @@ YapAllocSpaceFromYap(unsigned int size)
} }
X_API void X_API void
YapFreeSpaceFromYap(void *ptr) YAP_FreeSpaceFromYap(void *ptr)
{ {
FreeCodeSpace(ptr); FreeCodeSpace(ptr);
} }
/* copy a string to a buffer */ /* copy a string to a buffer */
X_API int X_API int
YapStringToBuffer(Term t, char *buf, unsigned int bufsize) YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize)
{ {
unsigned int j = 0; unsigned int j = 0;
@ -652,7 +654,7 @@ YapStringToBuffer(Term t, char *buf, unsigned int bufsize)
/* copy a string to a buffer */ /* copy a string to a buffer */
X_API Term X_API Term
YapBufferToString(char *s) YAP_BufferToString(char *s)
{ {
Term t; Term t;
BACKUP_H(); BACKUP_H();
@ -665,7 +667,7 @@ YapBufferToString(char *s)
/* copy a string to a buffer */ /* copy a string to a buffer */
X_API Term X_API Term
YapBufferToAtomList(char *s) YAP_BufferToAtomList(char *s)
{ {
Term t; Term t;
BACKUP_H(); BACKUP_H();
@ -678,7 +680,7 @@ YapBufferToAtomList(char *s)
X_API void X_API void
YapError(char *buf) YAP_Error(char *buf)
{ {
Error(SYSTEM_ERROR,TermNil,buf); Error(SYSTEM_ERROR,TermNil,buf);
} }
@ -689,7 +691,7 @@ static void myputc (int ch)
} }
X_API int X_API int
YapRunGoal(Term t) YAP_RunGoal(Term t)
{ {
int out; int out;
yamop *old_CP = CP; yamop *old_CP = CP;
@ -701,6 +703,7 @@ YapRunGoal(Term t)
ENV = (CELL *)ENV[E_E]; ENV = (CELL *)ENV[E_E];
CP = old_CP; CP = old_CP;
} else { } else {
if (B != NULL) /* restore might have destroyed B */
B = B->cp_b; B = B->cp_b;
} }
@ -709,7 +712,7 @@ YapRunGoal(Term t)
} }
X_API int X_API int
YapRestartGoal(void) YAP_RestartGoal(void)
{ {
int out; int out;
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
@ -727,7 +730,7 @@ YapRestartGoal(void)
} }
X_API int X_API int
YapContinueGoal(void) YAP_ContinueGoal(void)
{ {
int out; int out;
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
@ -739,7 +742,7 @@ YapContinueGoal(void)
} }
X_API void X_API void
YapPruneGoal(void) YAP_PruneGoal(void)
{ {
BACKUP_B(); BACKUP_B();
@ -752,7 +755,7 @@ YapPruneGoal(void)
} }
X_API int X_API int
YapGoalHasException(Term *t) YAP_GoalHasException(Term *t)
{ {
int out = FALSE; int out = FALSE;
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
@ -765,7 +768,7 @@ YapGoalHasException(Term *t)
} }
X_API void X_API void
YapInitConsult(int mode, char *filename) YAP_InitConsult(int mode, char *filename)
{ {
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
@ -778,7 +781,7 @@ YapInitConsult(int mode, char *filename)
} }
X_API void X_API void
YapEndConsult(void) YAP_EndConsult(void)
{ {
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
@ -788,7 +791,7 @@ YapEndConsult(void)
} }
X_API Term X_API Term
YapRead(int (*mygetc)(void)) YAP_Read(int (*mygetc)(void))
{ {
Term t; Term t;
tr_fr_ptr old_TR; tr_fr_ptr old_TR;
@ -812,7 +815,7 @@ YapRead(int (*mygetc)(void))
} }
X_API void X_API void
YapWrite(Term t, void (*myputc)(int), int flags) YAP_Write(Term t, void (*myputc)(int), int flags)
{ {
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
@ -823,7 +826,7 @@ YapWrite(Term t, void (*myputc)(int), int flags)
} }
X_API char * X_API char *
YapCompileClause(Term t) YAP_CompileClause(Term t)
{ {
char *ErrorMessage; char *ErrorMessage;
CODEADDR codeaddr; CODEADDR codeaddr;
@ -847,7 +850,7 @@ YapCompileClause(Term t)
that wants to control Yap */ that wants to control Yap */
X_API Int X_API Int
YapInit(yap_init_args *yap_init) YAP_Init(YAP_init_args *yap_init)
{ {
int restore_result; int restore_result;
int Trail = 0, Stack = 0, Heap = 0; int Trail = 0, Stack = 0, Heap = 0;
@ -952,9 +955,9 @@ YapInit(yap_init_args *yap_init)
} }
X_API Int 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.SavedState = saved_state;
init_args.HeapSize = 0; init_args.HeapSize = 0;
@ -970,23 +973,23 @@ YapFastInit(char saved_state[])
init_args.Argc = 0; init_args.Argc = 0;
init_args.Argv = NULL; init_args.Argv = NULL;
return(YapInit(&init_args)); return(YAP_Init(&init_args));
} }
X_API void X_API void
YapPutValue(Atom at, Term t) YAP_PutValue(Atom at, Term t)
{ {
PutValue(at, t); PutValue(at, t);
} }
X_API Term X_API Term
YapGetValue(Atom at) YAP_GetValue(Atom at)
{ {
return(GetValue(at)); return(GetValue(at));
} }
X_API int X_API int
YapReset(void) YAP_Reset(void)
{ {
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
@ -1006,13 +1009,13 @@ YapReset(void)
} }
X_API void X_API void
YapExit(int retval) YAP_Exit(int retval)
{ {
exit_yap(retval); exit_yap(retval);
} }
X_API void X_API void
YapInitSocks(char *host, long port) YAP_InitSocks(char *host, long port)
{ {
#if USE_SOCKET #if USE_SOCKET
init_socks(host, port); init_socks(host, port);
@ -1020,7 +1023,7 @@ YapInitSocks(char *host, long port)
} }
X_API void X_API void
YapSetOutputMessage(void) YAP_SetOutputMessage(void)
{ {
#if DEBUG #if DEBUG
output_msg = TRUE; output_msg = TRUE;
@ -1028,13 +1031,13 @@ YapSetOutputMessage(void)
} }
X_API int X_API int
YapStreamToFileNo(Term t) YAP_StreamToFileNo(Term t)
{ {
return(StreamToFileNo(t)); return(StreamToFileNo(t));
} }
X_API void X_API void
YapCloseAllOpenStreams(void) YAP_CloseAllOpenStreams(void)
{ {
BACKUP_H(); BACKUP_H();
@ -1044,7 +1047,7 @@ YapCloseAllOpenStreams(void)
} }
X_API Term X_API Term
YapOpenStream(void *fh, char *name, Term nm, int flags) YAP_OpenStream(void *fh, char *name, Term nm, int flags)
{ {
Term retv; Term retv;
@ -1057,7 +1060,7 @@ YapOpenStream(void *fh, char *name, Term nm, int flags)
} }
X_API void X_API void
YapThrow(Term t) YAP_Throw(Term t)
{ {
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
JumpToEnv(t); JumpToEnv(t);
@ -1065,31 +1068,31 @@ YapThrow(Term t)
} }
X_API int X_API int
YapLookupModule(Term t) YAP_LookupModule(Term t)
{ {
return(LookupModule(t)); return(LookupModule(t));
} }
X_API Term X_API Term
YapModuleName(int i) YAP_ModuleName(int i)
{ {
return(ModuleName[i]); return(ModuleName[i]);
} }
X_API void X_API void
YapHalt(int i) YAP_Halt(int i)
{ {
exit_yap(i); exit_yap(i);
} }
X_API CELL * X_API CELL *
YapTopOfLocalStack(void) YAP_TopOfLocalStack(void)
{ {
return(ASP); return(ASP);
} }
X_API void * X_API void *
YapPredicate(Atom a, Int arity, Int m) YAP_Predicate(Atom a, unsigned long int arity, int m)
{ {
if (arity == 0) { if (arity == 0) {
return((void *)RepPredProp(PredPropByAtom(a,m))); return((void *)RepPredProp(PredPropByAtom(a,m)));
@ -1100,7 +1103,7 @@ YapPredicate(Atom a, Int arity, Int m)
} }
X_API void 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; PredEntry *pd = (PredEntry *)p;
if (pd->ArityOfPE) { if (pd->ArityOfPE) {
@ -1114,12 +1117,25 @@ YapPredicateInfo(void *p, Atom* a, Int* arity, Int* m)
} }
X_API void 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; PredEntry *pe;
SMALLUNSGN cm = CurrentModule; SMALLUNSGN cm = CurrentModule;
CurrentModule = mod; CurrentModule = mod;
UserCPredicate(a,f,arity); YAP_UserCPredicate(a,f,arity);
if (arity == 0) { if (arity == 0) {
pe = RepPredProp(PredPropByAtom(LookupAtom(a),mod)); pe = RepPredProp(PredPropByAtom(LookupAtom(a),mod));
} else { } else {
@ -1131,7 +1147,8 @@ YapUserCPredicateWithArgs(char *a, CPredicate f, Int arity, Int mod)
} }
X_API Int X_API Int
YapCurrentModule(void) YAP_CurrentModule(void)
{ {
return(CurrentModule); 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_set, (void));
STATIC_PROTO(Int p_call_count_reset, (void)); STATIC_PROTO(Int p_call_count_reset, (void));
STATIC_PROTO(Int p_toggle_static_predicates_in_use, (void)); STATIC_PROTO(Int p_toggle_static_predicates_in_use, (void));
#ifdef DEBUG
STATIC_PROTO(void list_all_predicates_in_use, (void)); STATIC_PROTO(void list_all_predicates_in_use, (void));
#endif
#define PredArity(p) (p->ArityOfPE) #define PredArity(p) (p->ArityOfPE)
#define TRYCODE(G,F,N) ( (N)<5 ? (op_numbers)((int)F+(N)*3) : G) #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 #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 static void
mark_pred(int mark, PredEntry *pe) mark_pred(int mark, PredEntry *pe)
{ {
@ -2097,6 +2145,22 @@ PredForCode(CODEADDR codeptr, Atom *pat, Int *parity, SMALLUNSGN *pmodule) {
return(0); 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 static Int
p_is_profiled(void) p_is_profiled(void)
{ {
@ -2504,5 +2568,7 @@ InitCdMgr(void)
InitCPred("$cut_transparent", 1, p_cut_transparent, SafePredFlag); InitCPred("$cut_transparent", 1, p_cut_transparent, SafePredFlag);
InitCPred("$hide_predicate", 2, p_hide_predicate, SafePredFlag); InitCPred("$hide_predicate", 2, p_hide_predicate, SafePredFlag);
InitCPred("$hidden_predicate", 2, p_hidden_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,...) Error (yap_error_number type, Term where, char *format,...)
{ {
va_list ap; va_list ap;
CELL nt[2]; CELL nt[3];
Functor fun; Functor fun;
int serious; int serious;
char *tp = tmpbuf; char *tp = tmpbuf;
@ -445,11 +445,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("array_overflow")); ti[0] = MkAtomTerm(LookupAtom("array_overflow"));
ti[1] = where; ti[1] = where;
@ -465,11 +460,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("array_type")); ti[0] = MkAtomTerm(LookupAtom("array_type"));
ti[1] = where; ti[1] = where;
@ -485,11 +475,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("io_mode")); ti[0] = MkAtomTerm(LookupAtom("io_mode"));
ti[1] = where; ti[1] = where;
@ -505,11 +490,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("mutable")); ti[0] = MkAtomTerm(LookupAtom("mutable"));
ti[1] = where; ti[1] = where;
@ -525,11 +505,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("non_empty_list")); ti[0] = MkAtomTerm(LookupAtom("non_empty_list"));
ti[1] = where; ti[1] = where;
@ -545,11 +520,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("not_less_than_zero")); ti[0] = MkAtomTerm(LookupAtom("not_less_than_zero"));
ti[1] = where; ti[1] = where;
@ -565,11 +535,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("not_newline")); ti[0] = MkAtomTerm(LookupAtom("not_newline"));
ti[1] = where; ti[1] = where;
@ -585,11 +550,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("not_zero")); ti[0] = MkAtomTerm(LookupAtom("not_zero"));
ti[1] = where; ti[1] = where;
@ -605,11 +565,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("out_of_range")); ti[0] = MkAtomTerm(LookupAtom("out_of_range"));
ti[1] = where; ti[1] = where;
@ -625,11 +580,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("operator_priority")); ti[0] = MkAtomTerm(LookupAtom("operator_priority"));
ti[1] = where; ti[1] = where;
@ -645,11 +595,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("operator_specifier")); ti[0] = MkAtomTerm(LookupAtom("operator_specifier"));
ti[1] = where; ti[1] = where;
@ -665,11 +610,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("radix")); ti[0] = MkAtomTerm(LookupAtom("radix"));
ti[1] = where; ti[1] = where;
@ -685,11 +625,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("shift_count_overflow")); ti[0] = MkAtomTerm(LookupAtom("shift_count_overflow"));
ti[1] = where; ti[1] = where;
@ -705,11 +640,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("source_sink")); ti[0] = MkAtomTerm(LookupAtom("source_sink"));
ti[1] = where; ti[1] = where;
@ -725,11 +655,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("stream")); ti[0] = MkAtomTerm(LookupAtom("stream"));
ti[1] = where; ti[1] = where;
@ -745,11 +670,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("stream_or_alias")); ti[0] = MkAtomTerm(LookupAtom("stream_or_alias"));
ti[1] = where; ti[1] = where;
@ -765,11 +685,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("stream_position")); ti[0] = MkAtomTerm(LookupAtom("stream_position"));
ti[1] = where; ti[1] = where;
@ -785,11 +700,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("syntax_error_handler")); ti[0] = MkAtomTerm(LookupAtom("syntax_error_handler"));
ti[1] = where; ti[1] = where;
@ -805,11 +715,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("time_out_spec")); ti[0] = MkAtomTerm(LookupAtom("time_out_spec"));
ti[1] = where; ti[1] = where;
@ -825,11 +730,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("source_sink")); ti[0] = MkAtomTerm(LookupAtom("source_sink"));
ti[1] = where; ti[1] = where;
@ -845,11 +745,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("array")); ti[0] = MkAtomTerm(LookupAtom("array"));
ti[1] = where; ti[1] = where;
@ -865,11 +760,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("stream")); ti[0] = MkAtomTerm(LookupAtom("stream"));
ti[1] = where; ti[1] = where;
@ -885,11 +775,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[1]; Term ti[1];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("float_overflow")); ti[0] = MkAtomTerm(LookupAtom("float_overflow"));
nt[0] = MkApplTerm(MkFunctor(LookupAtom("evaluation_error"),1), 1, ti); 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; int i;
Term ti[1]; Term ti[1];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("int_overflow")); ti[0] = MkAtomTerm(LookupAtom("int_overflow"));
nt[0] = MkApplTerm(MkFunctor(LookupAtom("evaluation_error"),1), 1, ti); 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; int i;
Term ti[1]; Term ti[1];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("undefined")); ti[0] = MkAtomTerm(LookupAtom("undefined"));
nt[0] = MkApplTerm(MkFunctor(LookupAtom("evaluation_error"),1), 1, ti); 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; int i;
Term ti[1]; Term ti[1];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("float_underflow")); ti[0] = MkAtomTerm(LookupAtom("float_underflow"));
nt[0] = MkApplTerm(MkFunctor(LookupAtom("evaluation_error"),1), 1, ti); 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; int i;
Term ti[1]; Term ti[1];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("underflow")); ti[0] = MkAtomTerm(LookupAtom("underflow"));
nt[0] = MkApplTerm(MkFunctor(LookupAtom("evaluation_error"),1), 1, ti); 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; int i;
Term ti[1]; Term ti[1];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("zero_divisor")); ti[0] = MkAtomTerm(LookupAtom("zero_divisor"));
nt[0] = MkApplTerm(MkFunctor(LookupAtom("evaluation_error"),1), 1, ti); 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; int i;
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
nt[0] = MkAtomTerm(LookupAtom("instantiation_error")); nt[0] = MkAtomTerm(LookupAtom("instantiation_error"));
tp = tmpbuf+i; tp = tmpbuf+i;
@ -1016,11 +871,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[3]; Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("access")); ti[0] = MkAtomTerm(LookupAtom("access"));
ti[1] = MkAtomTerm(LookupAtom("private_procedure")); ti[1] = MkAtomTerm(LookupAtom("private_procedure"));
@ -1037,11 +887,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[3]; Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("create")); ti[0] = MkAtomTerm(LookupAtom("create"));
ti[1] = MkAtomTerm(LookupAtom("array")); ti[1] = MkAtomTerm(LookupAtom("array"));
@ -1058,11 +903,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[3]; Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("create")); ti[0] = MkAtomTerm(LookupAtom("create"));
ti[1] = MkAtomTerm(LookupAtom("operator")); ti[1] = MkAtomTerm(LookupAtom("operator"));
@ -1079,11 +919,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[3]; Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("input")); ti[0] = MkAtomTerm(LookupAtom("input"));
ti[1] = MkAtomTerm(LookupAtom("binary_stream")); ti[1] = MkAtomTerm(LookupAtom("binary_stream"));
@ -1100,11 +935,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[3]; Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("input")); ti[0] = MkAtomTerm(LookupAtom("input"));
ti[1] = MkAtomTerm(LookupAtom("past_end_of_stream")); ti[1] = MkAtomTerm(LookupAtom("past_end_of_stream"));
@ -1121,11 +951,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[3]; Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("input")); ti[0] = MkAtomTerm(LookupAtom("input"));
ti[1] = MkAtomTerm(LookupAtom("stream")); ti[1] = MkAtomTerm(LookupAtom("stream"));
@ -1142,11 +967,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[3]; Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("input")); ti[0] = MkAtomTerm(LookupAtom("input"));
ti[1] = MkAtomTerm(LookupAtom("text_stream")); ti[1] = MkAtomTerm(LookupAtom("text_stream"));
@ -1163,11 +983,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[3]; Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("modify")); ti[0] = MkAtomTerm(LookupAtom("modify"));
ti[1] = MkAtomTerm(LookupAtom("static_procedure")); ti[1] = MkAtomTerm(LookupAtom("static_procedure"));
@ -1184,11 +999,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[3]; Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("new")); ti[0] = MkAtomTerm(LookupAtom("new"));
ti[1] = MkAtomTerm(LookupAtom("alias")); ti[1] = MkAtomTerm(LookupAtom("alias"));
@ -1205,11 +1015,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[3]; Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("open")); ti[0] = MkAtomTerm(LookupAtom("open"));
ti[1] = MkAtomTerm(LookupAtom("source_sink")); ti[1] = MkAtomTerm(LookupAtom("source_sink"));
@ -1226,11 +1031,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[3]; Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("output")); ti[0] = MkAtomTerm(LookupAtom("output"));
ti[1] = MkAtomTerm(LookupAtom("binary_stream")); ti[1] = MkAtomTerm(LookupAtom("binary_stream"));
@ -1247,11 +1047,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[3]; Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("output")); ti[0] = MkAtomTerm(LookupAtom("output"));
ti[1] = MkAtomTerm(LookupAtom("stream")); ti[1] = MkAtomTerm(LookupAtom("stream"));
@ -1268,11 +1063,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[3]; Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("output")); ti[0] = MkAtomTerm(LookupAtom("output"));
ti[1] = MkAtomTerm(LookupAtom("text_stream")); ti[1] = MkAtomTerm(LookupAtom("text_stream"));
@ -1289,11 +1079,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[3]; Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("reposition")); ti[0] = MkAtomTerm(LookupAtom("reposition"));
ti[1] = MkAtomTerm(LookupAtom("stream")); ti[1] = MkAtomTerm(LookupAtom("stream"));
@ -1310,11 +1095,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[3]; Term ti[3];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("resize")); ti[0] = MkAtomTerm(LookupAtom("resize"));
ti[1] = MkAtomTerm(LookupAtom("array")); ti[1] = MkAtomTerm(LookupAtom("array"));
@ -1331,11 +1111,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[1]; Term ti[1];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("character")); ti[0] = MkAtomTerm(LookupAtom("character"));
nt[0] = MkApplTerm(MkFunctor(LookupAtom("representation_error"),1), 1, ti); 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; int i;
Term ti[1]; Term ti[1];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("character_code")); ti[0] = MkAtomTerm(LookupAtom("character_code"));
nt[0] = MkApplTerm(MkFunctor(LookupAtom("representation_error"),1), 1, ti); 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; int i;
Term ti[1]; Term ti[1];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("max_arity")); ti[0] = MkAtomTerm(LookupAtom("max_arity"));
nt[0] = MkApplTerm(MkFunctor(LookupAtom("representation_error"),1), 1, ti); 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; int i;
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
nt[0] = where; nt[0] = where;
tp = tmpbuf+i; tp = tmpbuf+i;
@ -1404,11 +1164,6 @@ Error (yap_error_number type, Term where, char *format,...)
{ {
int i; int i;
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
nt[0] = MkAtomTerm(LookupAtom("system_error")); nt[0] = MkAtomTerm(LookupAtom("system_error"));
tp = tmpbuf+i; tp = tmpbuf+i;
@ -1422,11 +1177,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("array")); ti[0] = MkAtomTerm(LookupAtom("array"));
ti[1] = where; ti[1] = where;
@ -1442,11 +1192,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("atom")); ti[0] = MkAtomTerm(LookupAtom("atom"));
ti[1] = where; ti[1] = where;
@ -1462,11 +1207,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("atomic")); ti[0] = MkAtomTerm(LookupAtom("atomic"));
ti[1] = where; ti[1] = where;
@ -1482,11 +1222,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("byte")); ti[0] = MkAtomTerm(LookupAtom("byte"));
ti[1] = where; ti[1] = where;
@ -1502,11 +1237,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("callable")); ti[0] = MkAtomTerm(LookupAtom("callable"));
ti[1] = where; ti[1] = where;
@ -1522,11 +1252,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("character")); ti[0] = MkAtomTerm(LookupAtom("character"));
ti[1] = where; ti[1] = where;
@ -1542,11 +1267,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("compound")); ti[0] = MkAtomTerm(LookupAtom("compound"));
ti[1] = where; ti[1] = where;
@ -1562,11 +1282,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("db_reference")); ti[0] = MkAtomTerm(LookupAtom("db_reference"));
ti[1] = where; ti[1] = where;
@ -1582,11 +1297,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("db_term")); ti[0] = MkAtomTerm(LookupAtom("db_term"));
ti[1] = where; ti[1] = where;
@ -1602,11 +1312,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("evaluable")); ti[0] = MkAtomTerm(LookupAtom("evaluable"));
ti[1] = where; ti[1] = where;
@ -1622,11 +1327,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("float")); ti[0] = MkAtomTerm(LookupAtom("float"));
ti[1] = where; ti[1] = where;
@ -1642,11 +1342,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("integer")); ti[0] = MkAtomTerm(LookupAtom("integer"));
ti[1] = where; ti[1] = where;
@ -1662,11 +1357,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("key")); ti[0] = MkAtomTerm(LookupAtom("key"));
ti[1] = where; ti[1] = where;
@ -1682,11 +1372,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("list")); ti[0] = MkAtomTerm(LookupAtom("list"));
ti[1] = where; ti[1] = where;
@ -1702,11 +1387,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("number")); ti[0] = MkAtomTerm(LookupAtom("number"));
ti[1] = where; ti[1] = where;
@ -1722,11 +1402,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("predicate_indicator")); ti[0] = MkAtomTerm(LookupAtom("predicate_indicator"));
ti[1] = where; ti[1] = where;
@ -1742,11 +1417,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("pointer")); ti[0] = MkAtomTerm(LookupAtom("pointer"));
ti[1] = where; ti[1] = where;
@ -1762,11 +1432,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("unsigned_byte")); ti[0] = MkAtomTerm(LookupAtom("unsigned_byte"));
ti[1] = where; ti[1] = where;
@ -1782,11 +1447,6 @@ Error (yap_error_number type, Term where, char *format,...)
int i; int i;
Term ti[2]; Term ti[2];
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
ti[0] = MkAtomTerm(LookupAtom("variable")); ti[0] = MkAtomTerm(LookupAtom("variable"));
ti[1] = where; ti[1] = where;
@ -1801,11 +1461,6 @@ Error (yap_error_number type, Term where, char *format,...)
{ {
int i; int i;
#if HAVE_STRNCAT
strncat(tmpbuf, " in ", psize);
#else
strcat(tmpbuf, " in ");
#endif
i = strlen(tmpbuf); i = strlen(tmpbuf);
nt[0] = MkAtomTerm(LookupAtom("system_error")); nt[0] = MkAtomTerm(LookupAtom("system_error"));
tp = tmpbuf+i; tp = tmpbuf+i;
@ -1817,9 +1472,8 @@ Error (yap_error_number type, Term where, char *format,...)
if (type != PURE_ABORT) { if (type != PURE_ABORT) {
/* This is used by some complex procedures to detect there was an error */ /* This is used by some complex procedures to detect there was an error */
ErrorMessage = RepAtom(AtomOfTerm(nt[0]))->StrOfAE; 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 (serious) {
if (type == PURE_ABORT) if (type == PURE_ABORT)
JumpToEnv(MkAtomTerm(LookupAtom("abort"))); JumpToEnv(MkAtomTerm(LookupAtom("abort")));

20
C/exec.c
View File

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

24
C/init.c
View File

@ -262,19 +262,6 @@ DebugGetc()
#endif #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 IsOpType(char *type)
{ {
int i; int i;
@ -503,7 +490,7 @@ InitDebug(void)
} }
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); Atom atom = LookupAtom(Name);
PredEntry *pe; PredEntry *pe;
@ -540,11 +527,14 @@ InitCPred(char *Name, int Arity, CPredicate code, int flags)
c_predicates[NUMBER_OF_CPREDS] = code; c_predicates[NUMBER_OF_CPREDS] = code;
pe->StateOfPred = NUMBER_OF_CPREDS; pe->StateOfPred = NUMBER_OF_CPREDS;
NUMBER_OF_CPREDS++; NUMBER_OF_CPREDS++;
if (NUMBER_OF_CPREDS >= MAX_C_PREDS) {
Error(SYSTEM_ERROR, TermNil, "Too Many C-Predicates");
}
} }
} }
void 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); Atom atom = LookupAtom(Name);
PredEntry *pe; PredEntry *pe;
@ -585,7 +575,7 @@ InitCmpPred(char *Name, int Arity, CmpPredicate cmp_code, CPredicate code, int f
} }
void 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); Atom atom = LookupAtom(Name);
PredEntry *pe; PredEntry *pe;
@ -660,7 +650,7 @@ CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont)
void 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; PredEntry *pe;
Atom atom = LookupAtom(Name); Atom atom = LookupAtom(Name);

6
C/save.c
View File

@ -608,9 +608,9 @@ check_header(void)
get_cell(); get_cell();
/* now, check whether we got enough enough space to load the /* now, check whether we got enough enough space to load the
saved space */ saved space */
if ((hp_size = get_cell()) > Unsigned(AuxTop) - Unsigned(HeapBase)) { hp_size = get_cell();
Error(SYSTEM_ERROR,TermNil,"out of heap space, Yap needs %d", hp_size); while (hp_size > Unsigned(AuxTop) - Unsigned(HeapBase)) {
return(FAIL_RESTORE); growheap(FALSE);
} }
if (mode == DO_EVERYTHING) { if (mode == DO_EVERYTHING) {
if ((lc_size = get_cell())+(gb_size=get_cell()) > Unsigned(LocalBase) - Unsigned(GlobalBase)) { 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 static Int
p_opdec(void) p_opdec(void)
{ /* '$op'(p,type,atom) */ { /* '$opdec'(p,type,atom) */
/* we know the arguments are integer, atom, atom */ /* we know the arguments are integer, atom, atom */
Term p = Deref(ARG1), t = Deref(ARG2), at = Deref(ARG3); Term p = Deref(ARG1), t = Deref(ARG2), at = Deref(ARG3);
return (OpDec((int) IntOfTerm(p), RepAtom(AtomOfTerm(t))->StrOfAE, 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++; vsc_count++;
/* if (vsc_count < 123808900) return; */ /* if (vsc_count < 123808900) return; */
/* if (vsc_count == 134) { if (vsc_count == 59) {
printf("Here I go\n"); printf("Here I go\n");
} */ }
/* if (vsc_count > 500000) exit(0); */ /* if (vsc_count > 500000) exit(0); */
/* if (gc_calls < 1) return;*/ /* if (gc_calls < 1) return;*/
#if defined(__GNUC__) #if defined(__GNUC__)

15
H/Yapproto.h
View File

@ -10,7 +10,7 @@
* File: Yap.proto * * File: Yap.proto *
* mods: * * mods: *
* comments: Function declarations for YAP * * 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 */ /* prototype file for Yap */
@ -104,9 +104,10 @@ void STD_PROTO(InitBBPreds,(void));
void STD_PROTO(InitBigNums,(void)); void STD_PROTO(InitBigNums,(void));
/* c_interface.c */ /* c_interface.c */
Int STD_PROTO(YapExecute,(struct pred_entry *, CPredicate)); Int STD_PROTO(YAP_Execute,(struct pred_entry *, CPredicate));
/* cdmgr.c */ /* cdmgr.c */
Term STD_PROTO(all_calls,(void));
void STD_PROTO(mark_as_fast,(Term)); void STD_PROTO(mark_as_fast,(Term));
void STD_PROTO(IPred,(CODEADDR sp)); void STD_PROTO(IPred,(CODEADDR sp));
Int STD_PROTO(PredForCode,(CODEADDR, Atom *, Int *, SMALLUNSGN *)); Int STD_PROTO(PredForCode,(CODEADDR, Atom *, Int *, SMALLUNSGN *));
@ -187,15 +188,13 @@ int STD_PROTO(DebugGetc,(void));
#endif #endif
int STD_PROTO(IsOpType,(char *)); int STD_PROTO(IsOpType,(char *));
void STD_PROTO(InitStacks,(int,int,int,int,int,int)); void STD_PROTO(InitStacks,(int,int,int,int,int,int));
void STD_PROTO(InitCPred,(char *, int, CPredicate, int)); void STD_PROTO(InitCPred,(char *, unsigned long int, CPredicate, int));
void STD_PROTO(InitAsmPred,(char *, int, int, CPredicate, int)); void STD_PROTO(InitAsmPred,(char *, unsigned long int, int, CPredicate, int));
void STD_PROTO(InitCmpPred,(char *, int, CmpPredicate, CPredicate, int)); void STD_PROTO(InitCmpPred,(char *, unsigned long int, CmpPredicate, CPredicate, int));
void STD_PROTO(InitCPredBack,(char *, int, int, CPredicate,CPredicate,int)); void STD_PROTO(InitCPredBack,(char *, unsigned long int, unsigned int, CPredicate,CPredicate,int));
void STD_PROTO(InitYaamRegs,(void)); void STD_PROTO(InitYaamRegs,(void));
void STD_PROTO(ReInitWallTime, (void)); void STD_PROTO(ReInitWallTime, (void));
int STD_PROTO(OpDec,(int,char *,Atom)); 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 */ /* iopreds.c */
void STD_PROTO(CloseStreams,(int)); void STD_PROTO(CloseStreams,(int));

84
console/yap.c
View File

@ -17,7 +17,7 @@
/* static char SccsId[] = "X 4.3.3"; */ /* static char SccsId[] = "X 4.3.3"; */
#include "config.h" #include "config.h"
#include "c_interface.h" #include "YapInterface.h"
#if (DefTrailSpace < MinTrailSpace) #if (DefTrailSpace < MinTrailSpace)
#undef DefTrailSpace #undef DefTrailSpace
@ -66,7 +66,7 @@
static int PROTO(mygetc, (void)); static int PROTO(mygetc, (void));
static void PROTO(do_bootfile, (char *)); 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 *)); static void PROTO(exec_top_level,(int, char *));
#ifndef LIGHT #ifndef LIGHT
@ -127,25 +127,25 @@ mygetc (void)
} }
static void static void
do_top_goal (Term Goal) do_top_goal (YAP_Term Goal)
{ {
#ifdef DEBUG #ifdef DEBUG
if (output_msg) if (output_msg)
fprintf(stderr,"Entering absmi\n"); fprintf(stderr,"Entering absmi\n");
#endif #endif
/* PlPutc(0,'a'); PlPutc(0,'\n'); */ /* PlPutc(0,'a'); PlPutc(0,'\n'); */
YapRunGoal(Goal); YAP_RunGoal(Goal);
} }
/* do initial boot by consulting the file boot.yap */ /* do initial boot by consulting the file boot.yap */
static void static void
do_bootfile (char *bootfilename) do_bootfile (char *bootfilename)
{ {
Term t; YAP_Term t;
Term term_nil = MkAtomTerm(YapLookupAtom("[]")); YAP_Term term_nil = YAP_MkAtomTerm(YAP_LookupAtom("[]"));
Term term_end_of_file = MkAtomTerm(YapLookupAtom("end_of_file")); YAP_Term term_end_of_file = YAP_MkAtomTerm(YAP_LookupAtom("end_of_file"));
Term term_true = MkAtomTerm(YapLookupAtom("true")); YAP_Term term_true = YAP_MkAtomTerm(YAP_LookupAtom("true"));
Functor functor_query = MkFunctor(YapLookupAtom("?-"),1); YAP_Functor functor_query = YAP_MkFunctor(YAP_LookupAtom("?-"),1);
fprintf(stderr,"Entering Yap\n"); fprintf(stderr,"Entering Yap\n");
@ -158,13 +158,13 @@ do_bootfile (char *bootfilename)
} }
/* the consult mode does not matter here, really */ /* 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. 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) while (!eof_found)
{ {
t = YapRead(mygetc); t = YAP_Read(mygetc);
if (eof_found) { if (eof_found) {
break; break;
} }
@ -173,37 +173,37 @@ do_bootfile (char *bootfilename)
fprintf(stderr, "[ SYNTAX ERROR: while parsing bootfile %s at line %d ]\n", bootfilename, yap_lineno); fprintf(stderr, "[ SYNTAX ERROR: while parsing bootfile %s at line %d ]\n", bootfilename, yap_lineno);
exit(1); exit(1);
} }
if (IsVarTerm (t) || t == term_nil) if (YAP_IsVarTerm (t) || t == term_nil)
{ {
continue; continue;
} }
else if (t == term_true) else if (t == term_true)
{ {
YapExit(0); YAP_Exit(0);
} }
else if (t == term_end_of_file) else if (t == term_end_of_file)
{ {
break; break;
} }
else if (IsPairTerm (t)) else if (YAP_IsPairTerm (t))
{ {
fprintf(stderr, "[ SYSTEM ERROR: consult not allowed in boot file ]\n"); 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)); 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 else
{ {
char *ErrorMessage = YapCompileClause(t); char *ErrorMessage = YAP_CompileClause(t);
if (ErrorMessage) if (ErrorMessage)
fprintf(stderr, ErrorMessage); fprintf(stderr, ErrorMessage);
} }
/* do backtrack */ /* do backtrack */
YapReset(); YAP_Reset();
} }
YapEndConsult(); YAP_EndConsult();
fclose (bootfile); fclose (bootfile);
#ifdef DEBUG #ifdef DEBUG
if (output_msg) if (output_msg)
@ -215,7 +215,7 @@ static char *filename;
static void 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,"\n[ Valid switches for command line arguments: ]\n");
fprintf(stderr," -? Shows this screen\n"); fprintf(stderr," -? Shows this screen\n");
@ -246,7 +246,7 @@ print_usage(const yap_init_args *init_args)
*/ */
static int 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; char *p;
int BootMode = YAP_BOOT_FROM_SAVED_CODE; 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; host = *++argv;
argc--; argc--;
if (host != NULL && host[0] == '-') if (host != NULL && host[0] == '-')
YapError("sockets must receive host to connect to"); YAP_Error("sockets must receive host to connect to");
p1 = *++argv; p1 = *++argv;
argc--; argc--;
if (p1[0] == '-') 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); port = strtol(p1, &ptr, 10);
if (ptr == NULL || ptr[0] != '\0') if (ptr == NULL || ptr[0] != '\0')
YapError("port argument to socket must be a number"); YAP_Error("port argument to socket must be a number");
YapInitSocks(host,port); YAP_InitSocks(host,port);
} }
break; break;
#endif #endif
@ -355,14 +355,14 @@ parse_yap_arguments(int argc, char *argv[], yap_init_args *init_args)
if (ch) if (ch)
{ {
fprintf(stderr,"[ YAP unrecoverable error: illegal size specification %s ]", argv[-1]); fprintf(stderr,"[ YAP unrecoverable error: illegal size specification %s ]", argv[-1]);
YapExit(1); YAP_Exit(1);
} }
*ssize = i; *ssize = i;
} }
break; break;
#ifdef DEBUG #ifdef DEBUG
case 'p': case 'p':
YapSetOutputMessage(); YAP_SetOutputMessage();
output_msg = TRUE; output_msg = TRUE;
break; break;
#endif #endif
@ -420,7 +420,7 @@ static int
init_standard_system(int argc, char *argv[]) init_standard_system(int argc, char *argv[])
{ {
int BootMode; int BootMode;
yap_init_args init_args; YAP_init_args init_args;
init_args.SavedState = NULL; init_args.SavedState = NULL;
init_args.HeapSize = 0; init_args.HeapSize = 0;
@ -442,7 +442,7 @@ init_standard_system(int argc, char *argv[])
if (BootMode == YAP_BOOT_FROM_PROLOG) if (BootMode == YAP_BOOT_FROM_PROLOG)
{ {
YapInit(&init_args); YAP_Init(&init_args);
} }
else else
@ -452,7 +452,7 @@ init_standard_system(int argc, char *argv[])
else else
init_args.SavedState = filename; 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 static void
exec_top_level(int BootMode, char *filename) exec_top_level(int BootMode, char *filename)
{ {
Term atomfalse; YAP_Term atomfalse;
Atom livegoal; YAP_Atom livegoal;
if (BootMode == YAP_BOOT_FROM_SAVED_STACKS) if (BootMode == YAP_BOOT_FROM_SAVED_STACKS)
{ {
/* continue executing from the frozen stacks */ /* continue executing from the frozen stacks */
YapContinueGoal(); YAP_ContinueGoal();
} }
else if (BootMode == YAP_BOOT_FROM_PROLOG) else if (BootMode == YAP_BOOT_FROM_PROLOG)
{ {
Atom livegoal; YAP_Atom livegoal;
/* read the bootfile */ /* read the bootfile */
do_bootfile (filename ? filename : BootFile); do_bootfile (filename ? filename : BootFile);
livegoal = FullLookupAtom("$live"); livegoal = YAP_FullLookupAtom("$live");
/* initialise the top-level */ /* initialise the top-level */
YapPutValue(livegoal, MkAtomTerm (LookupAtom("true"))); YAP_PutValue(livegoal, YAP_MkAtomTerm (YAP_LookupAtom("true")));
} }
/* the top-level is now ready */ /* the top-level is now ready */
/* read it before case someone, that is, Ashwin, hides /* read it before case someone, that is, Ashwin, hides
the atom false away ;-). the atom false away ;-).
*/ */
livegoal = FullLookupAtom("$live"); livegoal = YAP_FullLookupAtom("$live");
atomfalse = MkAtomTerm (LookupAtom("false")); atomfalse = YAP_MkAtomTerm (YAP_LookupAtom("false"));
while (YapGetValue (livegoal) != atomfalse) { while (YAP_GetValue (livegoal) != atomfalse) {
do_top_goal (MkAtomTerm (livegoal)); do_top_goal (YAP_MkAtomTerm (livegoal));
} }
YapExit(EXIT_SUCCESS); YAP_Exit(EXIT_SUCCESS);
} }
#ifdef LIGHT #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 Notice that either the project is named yapdll or you must replace the
preprocessor's variable @var{YAPDLL_EXPORTS} to match your project names 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 @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 @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. exception when @code{l/0} performs more than 10000 reductions.
@node Arrays, Preds, Profiling , Top @node Arrays, Preds, Call Countingf , Top
@section Arrays @section Arrays
The YAP system includes experimental support for arrays. The The YAP system includes experimental support for arrays. The
@ -12465,18 +12465,18 @@ C-code described below.
@example @example
@cartouche @cartouche
#include "../c_interface.h" #include "Yap/YapInterface.h"
static int my_process_id(void) static int my_process_id(void)
@{ @{
Term pid = MkIntTerm(getpid()); YAP_Term pid = YAP_MkIntTerm(getpid());
Term out = ARG1; YAP_Term out = YAP_ARG1;
return(unify(out,pid)); return(YAP_Unify(out,pid));
@} @}
void init_my_predicates() void init_my_predicates()
@{ @{
UserCPredicate("my_process_id",my_process_id,1); YAP_UserCPredicate("my_process_id",my_process_id,1);
@} @}
@end cartouche @end cartouche
@end example @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 of failure of the goal and also that it has no arguments even though the
predicate being defined has one. predicate being defined has one.
In fact the arguments of a prolog predicate written in C are accessed In fact the arguments of a prolog predicate written in C are accessed
through macros, defined in the include file, with names @var{ARG1}, through macros, defined in the include file, with names @var{YAP_ARG1},
@var{ARG2}, ..., @var{ARG16} or with @var{ARG}(@var{N}) where @var{N} is @var{YAP_ARG2}, ..., @var{YAP_ARG16} or with @var{YAP_A}(@var{N})
the argument number (starting with 1). In the present case the function where @var{N} is the argument number (starting with 1). In the present
uses just one local variable of type @code{ Term}, the type used for case the function uses just one local variable of type @code{YAP_Term}, the
holding Yap terms, where the integer returned by the standard unix type used for holding Yap terms, where the integer returned by the
function @code{getpid()} is stored as an integer term (the conversion is standard unix function @code{getpid()} is stored as an integer term (the
done by @code{MkIntTerm(Int))}. Then it calls the pre-defined routine conversion is done by @code{YAP_MkIntTerm(Int))}. Then it calls the
@code{unify(Term*, Term*)} which in turn returns an integer denoting pre-defined routine @code{YAP_Unify(YAP_Term, YAP_Term)} which in turn returns an
success or failure of the unification. integer denoting success or failure of the unification.
The role of the procedure @code{init_my_predicates} is to make known to 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, 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{init_my_predicates} was passed as the third argument to
@code{load_foreign_files}. @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 This section provides information about the primitives available to the C
programmer for manipulating prolog terms. 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. describe, in a portable way, the C representation of prolog terms.
The user should write is programs using this macros to ensure portability of The user should write is programs using this macros to ensure portability of
code across different versions of YAP. code across different versions of YAP.
The more important typedef is @var{Term} which is used to denote the type of a The more important typedef is @var{YAP_Term} which is used to denote the
prolog term. type of a prolog term.
Terms, from a point of view of the C-programmer, can be classified as Terms, from a point of view of the C-programmer, can be classified as
follows follows
@ -12600,24 +12600,17 @@ follows
@item compound terms @item compound terms
@end table @end table
Before trying to find out the kind of a term, the C-programmer should insure @findex YAP_IsVarTerm (C-Interface function)
it is not an instantiated variable using the interface primitive The primitive
@example @example
Term Deref(Term) YAP_Bool YAP_IsVarTerm(YAP_Term @var{t})
@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)
@end example @end example
@noindent @noindent
@findex YAP_IsNonVarTerm (C-Interface function)
returns true iff its argument is an uninstantiated variable. Conversely the returns true iff its argument is an uninstantiated variable. Conversely the
primitive primitive
@example @example
Bool IsGroundTerm(Term) YAP_Bool YAP_NonVarTerm(YAP_Term @var{t})
@end example @end example
@noindent @noindent
returns true iff its argument is not a variable. 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 The user can create a new uninstantiated variable using the primitive
@example @example
Term MkVarTerm() Term YAP_MkVarTerm()
@end example @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: of non-variable terms:
@example @example
Bool IsIntTerm(Term) YAP_Bool YAP_IsIntTerm(YAP_Term @var{t})
Bool IsFloatTerm(Term) YAP_Bool YAP_IsFloatTerm(YAP_Term @var{t})
Bool IsDbRefTerm(Term) YAP_Bool YAP_IsDbRefTerm(YAP_Term @var{t})
Bool IsAtomTerm(Term) YAP_Bool YAP_IsAtomTerm(YAP_Term @var{t})
Bool IsPairTerm(Term) YAP_Bool YAP_IsPairTerm(YAP_Term @var{t})
Bool IsApplTerm(Term) YAP_Bool YAP_IsApplTerm(YAP_Term @var{t})
@end example @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 The following primitives are provided for creating an integer term from an
integer and to access the value of an integer term. integer and to access the value of an integer term.
@example @example
Term MkIntTerm(Int) YAP_Term YAP_MkIntTerm(YAP_Int @var{i})
Int IntOfTerm(Term) YAP_Int YAP_IntOfTerm(YAP_YAP_Term @var{t})
@end example @end example
@noindent @noindent
where @code{Int} is a typedef for the C integer type appropriate for the where @code{YAP_Int} is a typedef for the C integer type appropriate for
machine or compiler in question (normally a 32 bit integer). Note that the machine or compiler in question (normally a long integer). The size
the size of the allowed integers is implementation dependent but is always of the allowed integers is implementation dependent but is always
greater or equal to 24 bits. 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 The two following primitives play a similar role for floating-point terms
@example @example
Term MkFloatTerm(flt) YAP_Term YAP_MkFloatTerm(YAP_flt @var{double})
flt FloatOfTerm(Term) YAP_flt YAP_FloatOfTerm(YAP_YAP_Term @var{t})
@end example @end example
@noindent @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}
Currently, no primitives are supplied to users for manipulating data base
No primitives are supplied to users for manipulating data base
references. references.
A special typedef @code{Atom} is provided to describe prolog @i{atoms} and the @findex YAP_MkAtomTerm (C-Interface function)
two following primitives can be used to manipulate atom terms @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 @example
Term MkAtomTerm(Atom) YAP_Term YAP_MkAtomTerm(YAP_Atom at)
Atom AtomOfTerm(Term) YAP_Atom YAP_AtomOfTerm(YAP_YAP_Term @var{t})
@end example @end example
@noindent @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 names
@example @example
Atom LookupAtom(char *) YAP_Atom YAP_LookupAtom(char * @var{s})
Atom FullLookupAtom(char *) YAP_Atom YAP_FullLookupAtom(char * @var{s})
char* AtomName(Atom) char *YAP_AtomName(YAP_Atom @var{t})
@end example @end example
The function @code{LookupAtom} looks up an atom in the standard hash The function @code{YAP_LookupAtom} looks up an atom in the standard hash
table. The function @code{FullLookupAtom} will also search if the atom table. The function @code{YAP_FullLookupAtom} will also search if the
had been "hidden". 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.
@findex YAP_MkPairTerm (C-Interface function)
A @i{pair} is a Prolog term which consists of a pair of prolog terms designated @findex YAP_MkNewPairTerm (C-Interface function)
as the @i{head} and the @i{tail} of the term. The following primitives can @findex YAP_HeadOfTerm (C-Interface function)
be used to manipulate pairs @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 @example
Term MkPairTerm(Term Head, Term Tail) YAP_Term YAP_MkPairTerm(YAP_Term @var{Head}, YAP_Term @var{Tail})
Term HeadOfTerm(Term) YAP_Term YAP_MkNewPairTerm(void)
Term TailOfTerm(Term) YAP_Term YAP_HeadOfTerm(YAP_Term @var{t})
YAP_Term YAP_TailOfTerm(YAP_Term @var{t})
@end example @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 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 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 typedef @code{Functor}, consists of an atom and of an integer.
The following primitives were designed to manipulate compound terms and The following primitives were designed to manipulate compound terms and
functors functors
@example @example
Term MkApplTerm(Functor f, int n, Term[] args) YAP_Term YAP_MkApplTerm(YAP_Functor @var{f}, unsigned long int @var{n}, YAP_Term[] @var{args})
Functor FunctorOfTerm(Term) YAP_Term YAP_MkNewApplTerm(YAP_Functor @var{f}, int @var{n})
Term ArgOfTerm(int argno,Term t) YAP_Term YAP_ArgOfTerm(int argno,YAP_Term @var{ts})
Functor MkFunctor(Atom a,int arity) YAP_Functor YAP_FunctorOfTerm(YAP_YAP_Term @var{ts})
Atom NameOfFunctor(Functor)
Int ArityOfFunctor(Functor)
@end example @end example
@noindent @noindent
where @code{args} should be an array of @code{n} terms with @code{n} equal to the The @code{YAP_MkApplTerm} function constructs a new term, with functor
arity of the functor, and @code{argno} should be greater or equal to 1 and less @var{f} (of arity @var{n}), and using an array @var{args} of @var{n}
or equal to the arity of the functor. 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 YAP allows one to manipulate the functors of compound term. The function
result is @i{dereferenced}, i.e. that it is not an instantiated variable. @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 @node Unifying Terms, Manipulating Strings, Manipulating Terms, C-Interface
@section Unification @section Unification
The following routine is provided for attempting the unification of two @findex YAP_Unify (C-Interface function)
prolog terms YAP provides a single routine to attempt the unification of two prolog
terms. The routine may succeed or fail:
@example @example
Int unify(Term a, Term b) Int YAP_Unify(YAP_Term @var{a}, YAP_Term @var{b})
@end example @end example
@noindent @noindent
which attempts to unify the terms pointed to by @code{a} and @code{b} returning The routine attempts to unify the terms @var{a} and
a non-zero value if the unification succeeds and zero otherwise. @var{b} returning @code{TRUE} if the unification succeeds and @code{FALSE}
otherwise.
@node Manipulating Strings, Memory Allocation, Unifying Terms, C-Interface @node Manipulating Strings, Memory Allocation, Unifying Terms, C-Interface
@section Strings @section Strings
@findex YAP_StringToBuffer (C-Interface function)
The YAP C-interface now includes an utility routine to copy a string 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 represented as a list of a character codes to a previously allocated buffer
@example @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 @end example
@noindent @noindent
The routine copies the list of character codes @code{String} to a The routine copies the list of character codes @var{String} to a
previously allocated buffer @code{buf}. The string including a previously allocated buffer @var{buf}. The string including a
terminating null character must fit in @code{bufsize} characters, terminating null character must fit in @var{bufsize} characters,
otherwise the routine will simply fail. The @code{StringToBuffer} otherwise the routine will simply fail. The @var{StringToBuffer} routine
routine fails and generates an exception if @code{String} is not a valid fails and generates an exception if @var{String} is not a valid string.
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 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 is, to copy a from a buffer to a list of character codes or to a list of
character atomsr character atomsr
@example @example
Term BufferToString(char *buf) YAP_Term YAP_BufferToString(char *@var{buf})
Term BufferToAtomList(char *buf) YAP_Term YAP_BufferToAtomList(char *@var{buf})
@end example @end example
@noindent @noindent
The user-provided string must include a terminating null character. 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 @node Memory Allocation, Controlling Streams, Manipulating Strings, C-Interface
@section Memory Allocation @section Memory Allocation
@findex YAP_AllocSpaceFromYap (C-Interface function)
The next routine can be used to ask space from the Prolog data-base: The next routine can be used to ask space from the Prolog data-base:
@example @example
void *AllocSpaceFromYap(int size) void *YAP_AllocSpaceFromYap(int @var{size})
@end example @end example
@noindent @noindent
The routine returns a pointer to a buffer allocated from the code area, 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 @example
void FreeSpaceFromYap(void *buf) void YAP_FreeSpaceFromYap(void *@var{buf})
@end example @end example
@noindent @noindent
The routine releases a buffer allocated from the code area. The system 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 @node Controlling Streams, Calling Yap From C, Memory Allocation, C-Interface
@section Controlling Yap Streams from @code{C} @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 The C-Interface also provides the C-application with a measure of
control over the Yap Input/Output system. The first routine allows one control over the Yap Input/Output system. The first routine allows one
to find a file number given a current stream: to find a file number given a current stream:
@example @example
int YapStreamToFileNo(Term stream) int YAP_StreamToFileNo(YAP_Term @var{stream})
@end example @end example
@noindent @noindent
This function gives the file descriptor for a currently available 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 this stream, so information on, say, current stream position, may become
stale. stale.
@findex YAP_CloseAllOpenStreams (C-Interface function)
A second routine that is sometimes useful is: A second routine that is sometimes useful is:
@example @example
void YapCloseAllOpenStreams(void) void YAP_CloseAllOpenStreams(void)
@end example @end example
@noindent @noindent
This routine closes the Yap Input/Output system except for the first This routine closes the Yap Input/Output system except for the first
three streams, that are always associated with the three standard Unix three streams, that are always associated with the three standard Unix
streams. It is most useful if you are doing @code{fork()}. 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 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 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: string, an atom with the yser name, and a set of flags:
@example @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 @end example
@noindent @noindent
The available flags are @code{YAP_INPUT_STREAM}, The available flags are @code{YAP_INPUT_STREAM},
@code{YAP_OUTPUT_STREAM}, @code{YAP_APPEND_STREAM}, @code{YAP_OUTPUT_STREAM}, @code{YAP_APPEND_STREAM},
@code{YAP_PIPE_STREAM}, @code{YAP_TTY_STREAM}, @code{YAP_POPEN_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 @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 @node Calling Yap From C, Writing C, Controlling Streams, C-Interface
@section From @code{C} back to Prolog @section From @code{C} back to Prolog
@findex YAP_CallProlog (C-Interface function)
Newer versions of YAP allow for calling the Prolog interpreter from 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 @code{C}. One must first construct a goal @code{G}, and then it is
sufficient to perform: sufficient to perform:
@example @example
Int YapCallProlog(Term G) YAP_Bool YapCallProlog(YAP_Term @var{G})
@end example @end example
@noindent @noindent
the result will be @code{0}, if the goal failed, or @code{1}, if the the result will be @code{FALSE}, if the goal failed, or @code{TRUE}, if
goal succeeded. In this case, the variables in @var{G} will store the the goal succeeded. In this case, the variables in @var{G} will store
values they have been unified with. Execution only proceeds until the values they have been unified with. Execution only proceeds until
finding the first solution to the goal, but you can call finding the first solution to the goal, but you can call
@code{findall/3} or friends if you need all the solutions. @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. predicates which can succeed more than once.
@end table @end table
@findex YAP_UserCPredicate (C-Interface function)
The first kind of predicates should be implemented as a C function with 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 no arguments which should return zero if the predicate fails and a
non-zero value otherwise. The predicate should be declared to non-zero value otherwise. The predicate should be declared to
YAP, in the initialization routine, with a call to YAP, in the initialization routine, with a call to
@example @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 @end example
@noindent @noindent
where @code{name} is the name of the predicate, @code{fn} is the C function where @var{name} is the name of the predicate, @var{fn} is the C function
implementing the predicate and @code{arity} is its arity. 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 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 which is called when the predicate is first activated, and the second one
to be called on backtracking to provide (possibly) other solutions. Note 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 @example
typedef struct @{ typedef struct @{
Term next_solution; /* the next solution */ YAP_Term next_solution; /* the next solution */
@} n100_data_type; @} n100_data_type;
n100_data_type *n100_data; n100_data_type *n100_data;
@ -12894,25 +12952,27 @@ We now write the @code{C} function to handle the first call:
@example @example
static int start_n100() static int start_n100()
@{ @{
Term t = ARG1; YAP_Term t = ARG1;
PRESERVE_DATA(n100_data,n100_data_type); YAP_PRESERVE_DATA(n100_data,n100_data_type);
if(IsVarTerm(t)) @{ if(YAP_IsVarTerm(t)) @{
n100_data->next_solution = MkIntTerm(0); n100_data->next_solution = YAP_MkIntTerm(0);
return(continue_n100()); return(continue_n100());
@} @}
if(!IsIntTerm(t) || IntOfTerm(t)<0 || IntOfTerm(t)>100) @{ if(!YAP_IsIntTerm(t) || YAP_IntOfTerm(t)<0 || YAP_IntOfTerm(t)>100) @{
cut_fail(); YAP_cut_fail();
@} else @{ @} else @{
cut_succeed(); YAP_cut_succeed();
@} @}
@} @}
@end example @end example
The routine starts by getting the dereference value of the argument. 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 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 If the argument of the predicate is a variable, the routine initializes the
structure to be preserved across backtracking with the information 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 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 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 it exits, denoting success, with @code{YAP_cut_succeed}, or otherwise exits with
@code{cut_fail} denoting failure. @code{YAP_cut_fail} denoting failure.
The reason for using for using the macros @code{cut_succeed} and @code{cut_fail} The reason for using for using the functions @code{YAP_cut_succeed} and
instead of just returning a non-zero value in the first case, and zero in the @code{YAP_cut_fail} instead of just returning a non-zero value in the
second case, is that otherwise, if backtracking occurred later, the routine first case, and zero in the second case, is that otherwise, if
@code{continue_n100} would be called to provide additional solutions. backtracking occurred later, the routine @code{continue_n100} would be
called to provide additional solutions.
The code required for the second function is The code required for the second function is
@example @example
@ -12936,46 +12997,47 @@ static int continue_n100()
int n; int n;
Term t; Term t;
Term sol = ARG1; Term sol = ARG1;
PRESERVED_DATA(n100_data,n100_data_type); YAP_PRESERVED_DATA(n100_data,n100_data_type);
n = IntOfTerm(n100_data->next_solution); n = YAP_IntOfTerm(n100_data->next_solution);
if( n == 100) @{ if( n == 100) @{
t = MkIntTerm(n); t = YAP_MkIntTerm(n);
unify(&sol,&t); YAP_Unify(&sol,&t);
cut_succeed(); YAP_cut_succeed();
@} @}
else @{ else @{
unify(&sol,&(n100_data->next_solution)); YAP_Unify(&sol,&(n100_data->next_solution));
n100_data->next_solution = MkIntTerm(n+1); n100_data->next_solution = YAP_MkIntTerm(n+1);
return(1); return(TRUE);
@} @}
@} @}
@end example @end example
Note that again the macro @code{PRESERVED_DATA} is used at the beginning of Note that again the macro @code{YAP_PRESERVED_DATA} is used at the
the function to access the data preserved from the previous solution. beginning of the function to access the data preserved from the previous
Then it checks if the last solution was found and in that case exits solution. Then it checks if the last solution was found and in that
with @code{cut_succeed} in order to cut any further backtracking. If this case exits with @code{YAP_cut_succeed} in order to cut any further
is not the last solution then we save the value for the next solution in backtracking. If this is not the last solution then we save the value
the data structure and exit normally with 1 denoting success. Note also for the next solution in the data structure and exit normally with 1
that in any of the two cases we use the function @code{unify} to bind the denoting success. Note also that in any of the two cases we use the
argument of the call to the value saved in @code{ function @code{YAP_nify} to bind the argument of the call to the value
n100_state->next_solution}. saved in @code{ n100_state->next_solution}.
Note also that the only correct way to signal failure in a backtrackable 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 Backtrackable predicates should be declared to YAP, in a way
similar to what happened with deterministic ones, but using instead a similar to what happened with deterministic ones, but using instead a
call to call to
@example @example
void UserBackCPredicate(char *name, void YAP_UserBackCPredicate(char *@var{name},
int *init(), int *cont(), int arity, int sizeof); int *@var{init}(), int *@var{cont}(),
unsigned long int @var{arity}, unsigned int @var{sizeof});
@end example @end example
@noindent @noindent
where @code{name} is a string with the name of the predicate, @code{init} and where @var{name} is a string with the name of the predicate, @var{init} and
@code{cont} are the C functions used to start and continue the execution of @var{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 the predicate, @var{arity} is the predicate arity, and @var{sizeof} is
the size of the data to be preserved in the stack. the size of the data to be preserved in the stack.
@node Loading Objects, Sav&Rest, Writing C, C-Interface @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 interface. These changes were required to support the new binary code
formats, such as ELF used in Solaris2 and Linux. formats, such as ELF used in Solaris2 and Linux.
@itemize @bullet @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 @item Access to elements in the new interface always goes through
@emph{functions}. This includes access to the argument registers, @emph{functions}. This includes access to the argument registers,
@code{ARG1} to @code{ARG16}. This change breaks code such as @code{YAP_ARG1} to @code{YAP_ARG16}. This change breaks code such as
@code{unify(&ARG1,&t)}: @code{unify(&ARG1,&t)}, which is nowadays:
@example @example
@{ @{
unify(ARG1, t); YAP_Unify(ARG1, t);
@} @}
@end example @end example
@ -13065,7 +13132,7 @@ To actually use this library you must follow a five step process:
@enumerate @enumerate
@item @item
You must initialise the YAP environment. A single function, 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 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 execution registers. You can use a saved space from a standard system by
calling @code{save_program/1}. 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 YAP. A query is a Prolog term, and you just have to use the same
functions that are available in the C-interface. 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 query. The argument is the query term @code{query}, and the result is 1
if the query succeeded, and 0 if it failed. 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. arguments were instantiated.
@item If you want extra solutions, you can use @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 @end enumerate
@ -13092,16 +13159,16 @@ program contains two facts for the procedure @t{b}:
@example @example
@cartouche @cartouche
#include <stdio.h> #include <stdio.h>
#include "Yap/c_interface.h" #include "Yap/YapInterface.h"
int int
main(int argc, char *argv[]) @{ 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); exit(1);
if (YapRunGoal(MkAtomTerm(LookupAtom("do")))) @{ if (YAP_RunGoal(YAP_MkAtomTerm(LookupAtom("do")))) @{
printf("Success\n"); printf("Success\n");
while (YapRestartGoal()) while (YAP_RestartGoal())
printf("Success\n"); printf("Success\n");
@} @}
printf("NO\n"); printf("NO\n");

836
include/c_interface.h
View File

@ -14,734 +14,294 @@
* * * *
*************************************************************************/ *************************************************************************/
/******************* IMPORTANT ******************** #ifndef _c_interface_h
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
****************************************************/
#include "yap_structs.h" #define _c_interface_h 1
#ifndef _Yap_c_interface_h #include "YapInterface.h"
#define _Yap_c_interface_h 1
/* #define CELL YAP_CELL
__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 #ifndef Bool
at the end of C declarations. #define Bool YAP_Bool
*/
#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 */
#endif #endif
__BEGIN_DECLS #define Int long int
#if defined(_MSC_VER) && defined(YAP_EXPORTS) #define flt double
#define X_API __declspec(dllexport)
#else
#define X_API
#endif
/* Primitive Functions */ #define Term YAP_Term
/* Term Deref(Term) */ #define Functor YAP_Functor
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)
/* Term Deref(Term) */ #define Atom YAP_Atom
extern X_API Term PROTO(Deref,(Term));
#ifdef IndirectCalls
static Term (*YapIDeref)() = Deref;
#define Deref(T) (*YapIDeref)(T)
#endif
/* Bool IsVarTerm(Term) */ #define yap_init_args YAP_init_args
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
/* Bool IsNonVarTerm(Term) */ #define A(X) YAP_A(X)
extern X_API Bool PROTO(YapIsNonVarTerm,(Term)); #define ARG1 YAP_ARG1
#ifdef IndirectCalls #define ARG2 YAP_ARG2
static Bool (*YapIIsNonVarTerm)() = YapIsNonVarTerm; #define ARG3 YAP_ARG3
#define IsNonVarTerm(T) (*YapIIsNonVarTerm)(T) #define ARG4 YAP_ARG4
#else #define ARG5 YAP_ARG5
#define IsNonVarTerm(T) YapIsNonVarTerm(T) #define ARG6 YAP_ARG6
#endif #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() */ /* YAP_Term Deref(YAP_Term) */
extern X_API Term PROTO(YapMkVarTerm,(void)); #define Deref(t) YAP_Deref(t)
#ifdef IndirectCalls #define YapDeref(t) YAP_Deref(t)
static Term (*YapIMkVarTerm)() = YapMkVarTerm;
#define MkVarTerm() (*YapIMkVarTerm)()
#else
#define MkVarTerm() YapMkVarTerm()
#endif
/* Bool IsIntTerm(Term) */ /* YAP_Bool IsVarTerm(YAP_Term) */
extern X_API Bool PROTO(YapIsIntTerm,(Term)); #define IsVarTerm(t) YAP_IsVarTerm(t)
#ifdef IndirectCalls #define YapIsVarTerm(t) YAP_IsVarTerm(t)
static Bool (*YapIIsIntTerm)() = YapIsIntTerm;
#define IsIntTerm(T) (*YapIIsIntTerm)(T)
#else
#define IsIntTerm(T) YapIsIntTerm(T)
#endif
/* Bool IsFloatTerm(Term) */ /* YAP_Bool IsNonVarTerm(YAP_Term) */
extern X_API Bool PROTO(YapIsFloatTerm,(Term)); #define IsNonVarTerm(t) YAP_IsNonVarTerm(t)
#ifdef IndirectCalls #define YapIsNonVarTerm(t) YAP_IsNonVarTerm(t)
static Bool (*YapIIsFloatTerm)() = YapIsFloatTerm;
#define IsFloatTerm(T) (*YapIIsFloatTerm)(T)
#else
#define IsFloatTerm(T) YapIsFloatTerm(T)
#endif
/* Bool IsDbRefTerm(Term) */ /* YAP_Term MkVarTerm() */
extern X_API Bool PROTO(YapIsDbRefTerm,(Term)); #define MkVarTerm() YAP_MkVarTerm()
#ifdef IndirectCalls #define YapMkVarTerm() YAP_MkVarTerm()
static Bool (*YapIIsDbRefTerm)() = YapIsDbRefTerm;
#define IsDbRefTerm(T) (*YapIIsDbRefTerm)(T)
#else
#define IsDbRefTerm(T) YapIsDbRefTerm(T)
#endif
/* Bool IsAtomTerm(Term) */ /* YAP_Bool IsIntTerm(YAP_Term) */
extern X_API Bool PROTO(YapIsAtomTerm,(Term)); #define IsIntTerm(t) YAP_IsIntTerm(t)
#ifdef IndirectCalls #define YapIsIntTerm(t) YAP_IsIntTerm(t)
static Bool (*YapIIsAtomTerm)() = YapIsAtomTerm;
#define IsAtomTerm(T) (*YapIIsAtomTerm)(T)
#else
#define IsAtomTerm(T) YapIsAtomTerm(T)
#endif
/* Bool IsPairTerm(Term) */ /* YAP_Bool IsFloatTerm(YAP_Term) */
extern X_API Bool PROTO(YapIsPairTerm,(Term)); #define IsFloatTerm(t) YAP_IsFloatTerm(t)
#ifdef IndirectCalls #define YapIsFloatTerm(t) YAP_IsFloatTerm(t)
static Bool (*YapIIsPairTerm)() = YapIsPairTerm;
#define IsPairTerm(T) (*YapIIsPairTerm)(T)
#else
#define IsPairTerm(T) YapIsPairTerm(T)
#endif
/* Bool IsApplTerm(Term) */ /* YAP_Bool IsDbRefTerm(YAP_Term) */
extern X_API Bool PROTO(YapIsApplTerm,(Term)); #define IsDbRefTerm(t) YAP_IsDbRefTerm(t)
#ifdef IndirectCalls #define YapIsDbRefTerm(t) YAP_IsDbRefTerm(t)
static Bool (*YapIIsApplTerm)() = YapIsApplTerm;
#define IsApplTerm(T) (*YapIIsApplTerm)(T)
#else
#define IsApplTerm(T) YapIsApplTerm(T)
#endif
/* Term MkIntTerm(Int) */ /* YAP_Bool IsAtomTerm(YAP_Term) */
extern X_API Term PROTO(YapMkIntTerm,(Int)); #define IsAtomTerm(t) YAP_IsAtomTerm(t)
#ifdef IndirectCalls #define YapIsAtomTerm(t) YAP_IsAtomTerm(t)
static Term (*YapIMkIntTerm)() = YapMkIntTerm;
#define MkIntTerm(T) (*YapIMkIntTerm)(T)
#else
#define MkIntTerm(T) YapMkIntTerm(T)
#endif
/* Int IntOfTerm(Term) */ /* YAP_Bool IsPairTerm(YAP_Term) */
extern X_API Int PROTO(YapIntOfTerm,(Term)); #define IsPairTerm(t) YAP_IsPairTerm(t)
#ifdef IndirectCalls #define YapIsPairTerm(t) YAP_IsPairTerm(t)
static Int (*YapIIntOfTerm)() = YapIntOfTerm;
#define IntOfTerm(T) (*YapIIntOfTerm)(T)
#else
#define IntOfTerm(T) YapIntOfTerm(T)
#endif
/* Term MkFloatTerm(flt) */ /* YAP_Bool IsApplTerm(YAP_Term) */
extern X_API Term PROTO(YapMkFloatTerm,(flt)); #define IsApplTerm(t) YAP_IsApplTerm(t)
#ifdef IndirectCalls #define YapIsApplTerm(t) YAP_IsApplTerm(t)
static Term (*YapIMkFloatTerm)() = YapMkFloatTerm;
#define MkFloatTerm(T) (*YapIMkFloatTerm)(T)
#else
#define MkFloatTerm(T) YapMkFloatTerm(T)
#endif
/* flt FloatOfTerm(Term) */ /* Term MkIntTerm(YAP_Int) */
extern X_API flt PROTO(YapFloatOfTerm,(Term)); #define MkIntTerm(t) YAP_MkIntTerm(t)
#ifdef IndirectCalls #define YapMkIntTerm(t) YAP_MkIntTerm(t)
static flt (*YapIFloatOfTerm)() = YapFloatOfTerm;
#define FloatOfTerm(T) (*YapIFloatOfTerm)(T) /* YAP_Int IntOfTerm(Term) */
#else #define IntOfTerm(t) YAP_IntOfTerm(t)
#define FloatOfTerm(T) YapFloatOfTerm(T) #define YapIntOfTerm(t) YAP_IntOfTerm(t)
#endif
/* 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) */ /* Term MkAtomTerm(Atom) */
extern X_API Term PROTO(YapMkAtomTerm,(Atom)); #define MkAtomTerm(a) YAP_MkAtomTerm(a)
#ifdef IndirectCalls #define YapMkAtomTerm(a) YAP_MkAtomTerm(a)
static Term (*YapIMkAtomTerm)() = YapMkAtomTerm;
#define MkAtomTerm(T) (*YapIMkAtomTerm)(T)
#else
#define MkAtomTerm(T) YapMkAtomTerm(T)
#endif
/* Atom AtomOfTerm(Term) */ /* YAP_Atom AtomOfTerm(Term) */
extern X_API Atom PROTO(YapAtomOfTerm,(Term)); #define AtomOfTerm(t) YAP_AtomOfTerm(t)
#ifdef IndirectCalls #define YapAtomOfTerm(t) YAP_AtomOfTerm(t)
static Atom (*YapIAtomOfTerm)() = YapAtomOfTerm;
#define AtomOfTerm(T) (*YapIAtomOfTerm)(T)
#else
#define AtomOfTerm(T) YapAtomOfTerm(T)
#endif
/* Atom LookupAtom(char *) */ /* YAP_Atom LookupAtom(char *) */
extern X_API Atom PROTO(YapLookupAtom,(char *)); #define LookupAtom(s) YAP_LookupAtom(s)
#ifdef IndirectCalls #define YapLookupAtom(s) YAP_LookupAtom(s)
static Atom (*YapILookupAtom)() = YapLookupAtom;
#define LookupAtom(T) (*YapILookupAtom)(T)
#else
#define LookupAtom(T) YapLookupAtom(T)
#endif
/* Atom FullLookupAtom(char *) */ /* YAP_Atom FullLookupAtom(char *) */
extern X_API Atom PROTO(YapFullLookupAtom,(char *)); #define FullLookupAtom(s) YAP_FullLookupAtom(s)
#ifdef IndirectCalls #define YapFullLookupAtom(s) YAP_FullLookupAtom(s)
static Atom (*YapIFullLookupAtom)() = YapFullLookupAtom;
#define FullLookupAtom(T) (*YapIFullLookupAtom)(T)
#else
#define FullLookupAtom(T) YapFullLookupAtom(T)
#endif
/* char* AtomName(Atom) */ /* char* AtomName(YAP_Atom) */
extern X_API char *PROTO(YapAtomName,(Atom)); #define AtomName(a) YAP_AtomName(a)
#ifdef IndirectCalls #define YapAtomName(a) YAP_AtomName(a)
static char *((*YapIAtomName)()) = YapAtomName;
#define AtomName(T) (*YapIAtomName)(T)
#else
#define AtomName(T) YapAtomName(T)
#endif
/* Term MkPairTerm(Term Head, Term Tail) */ /* YAP_Term MkPairTerm(YAP_Term Head, YAP_Term Tail) */
extern X_API Term PROTO(YapMkPairTerm,(Term,Term)); #define MkPairTerm(h,t) YAP_MkPairTerm(h,t)
#ifdef IndirectCalls #define YapMkPairTerm(h,t) YAP_MkPairTerm(h,t)
static Term (*YapIMkPairTerm)() = YapMkPairTerm;
#define MkPairTerm(T1,T2) (*YapIMkPairTerm)(T1,T2)
#else
#define MkPairTerm(T1,T2) YapMkPairTerm(T1,T2)
#endif
/* Term MkNewPairTerm(void) */ /* YAP_Term MkNewPairTerm(void) */
extern X_API Term PROTO(YapMkNewPairTerm,(void)); #define MkNewPairTerm() YAP_MkNewPairTerm()
#ifdef IndirectCalls #define YapMkNewPairTerm() YAP_MkNewPairTerm()
static Term (*YapIMkNewPairTerm)() = YapMkNewPairTerm;
#define MkNewPairTerm() (*YapIMkNewPairTerm)()
#else
#define MkNewPairTerm() YapMkNewPairTerm()
#endif
/* Term HeadOfTerm(Term) */ /* Term HeadOfTerm(Term) */
extern X_API Term PROTO(YapHeadOfTerm,(Term)); #define HeadOfTerm(t) YAP_HeadOfTerm(t)
#ifdef IndirectCalls #define YapHeadOfTerm(t) YAP_HeadOfTerm(t)
static Term (*YapIHeadOfTerm)() = YapHeadOfTerm;
#define HeadOfTerm(T) (*YapIHeadOfTerm)(T)
#else
#define HeadOfTerm(T) YapHeadOfTerm(T)
#endif
/* Term TailOfTerm(Term) */ /* Term TailOfTerm(Term) */
extern X_API Term PROTO(YapTailOfTerm,(Term)); #define TailOfTerm(t) YAP_TailOfTerm(t)
#ifdef IndirectCalls #define YapTailOfTerm(t) YAP_TailOfTerm(t)
static Term (*YapITailOfTerm)() = YapTailOfTerm;
#define TailOfTerm(T) (*YapITailOfTerm)(T)
#else
#define TailOfTerm(T) YapTailOfTerm(T)
#endif
/* 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) */ /* YAP_Term MkNewApplTerm(YAP_Functor f, int n) */
extern X_API Term PROTO(YapMkApplTerm,(Functor,int,Term *)); #define MkNewApplTerm(f,i) YAP_MkNewApplTerm(f,i)
#ifdef IndirectCalls #define YapMkNewApplTerm(f,i) YAP_MkNewApplTerm(f,i)
static Term (*YapIMkApplTerm)() = YapMkApplTerm;
#define MkApplTerm(F,N,As) (*YapIMkApplTerm)(F,N,As)
#else
#define MkApplTerm(F,N,As) YapMkApplTerm(F,N,As)
#endif
/* Term MkNewApplTerm(Functor f, int n) */ /* YAP_Functor YAP_FunctorOfTerm(Term) */
extern X_API Term PROTO(YapMkNewApplTerm,(Functor,int)); #define FunctorOfTerm(t) YAP_FunctorOfTerm(t)
#ifdef IndirectCalls #define YapFunctorOfTerm(t) YAP_FunctorOfTerm(t)
static Term (*YapIMkNewApplTerm)() = YapMkNewApplTerm;
#define MkNewApplTerm(F,N) (*YapIMkNewApplTerm)(F,N)
#else
#define MkNewApplTerm(F,N) YapMkNewApplTerm(F,N)
#endif
/* 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) */ /* YAP_Functor MkFunctor(YAP_Atom a,int arity) */
extern X_API Functor PROTO(YapFunctorOfTerm,(Term)); #define MkFunctor(a,i) YAP_MkFunctor(a,i)
#ifdef IndirectCalls #define YapMkFunctor(a,i) YAP_MkFunctor(a,i)
static Functor (*YapIFunctorOfTerm)() = YapFunctorOfTerm;
#define FunctorOfTerm(T) (*YapIFunctorOfTerm)(T)
#else
#define FunctorOfTerm(T) YapFunctorOfTerm(T)
#endif
/* Term ArgOfTerm(int argno,Term t) */ /* YAP_Atom NameOfFunctor(Functor) */
extern X_API Term PROTO(YapArgOfTerm,(int,Term)); #define NameOfFunctor(f) YAP_NameOfFunctor(f)
#ifdef IndirectCalls #define YapNameOfFunctor(f) YAP_NameOfFunctor(f)
static Term (*YapIArgOfTerm)() = YapArgOfTerm;
#define ArgOfTerm(N,T) (*YapIArgOfTerm)(N,T)
#else
#define ArgOfTerm(N,T) YapArgOfTerm(N,T)
#endif
/* Functor MkFunctor(Atom a,int arity) */ /* YAP_Int YAP_ArityOfFunctor(Functor) */
extern X_API Functor PROTO(YapMkFunctor,(Atom,int)); #define ArityOfFunctor(f) YAP_ArityOfFunctor(f)
#ifdef IndirectCalls #define YapArityOfFunctor(f) YAP_ArityOfFunctor(f)
static Functor (*YapIMkFunctor)() = YapMkFunctor;
#define MkFunctor(A,N) (*YapIMkFunctor)(A,N)
#else
#define MkFunctor(A,N) YapMkFunctor(A,N)
#endif
/* Atom NameOfFunctor(Functor) */ #define PRESERVE_DATA(ptr, type) (ptr = (type *)YAP_ExtraSpace())
extern X_API Atom PROTO(YapNameOfFunctor,(Functor)); #define PRESERVED_DATA(ptr, type) (ptr = (type *)YAP_ExtraSpace())
#ifdef IndirectCalls
static Atom (*YapINameOfFunctor)() = YapNameOfFunctor;
#define NameOfFunctor(T) (*YapINameOfFunctor)(T)
#else
#define NameOfFunctor(T) YapNameOfFunctor(T)
#endif
/* Int ArityOfFunctor(Functor) */ /* YAP_Int unify(YAP_Term a, YAP_Term b) */
extern X_API Int PROTO(YapArityOfFunctor,(Functor)); #define unify() YAP_Unify(t, t)
#ifdef IndirectCalls #define YapUnify() YAP_Unify(t, t)
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
/* void UserCPredicate(char *name, int *fn(), int arity) */ /* void UserCPredicate(char *name, int *fn(), int arity) */
extern X_API void PROTO(UserCPredicate,(char *, int (*)(void), int)); #define UserCPredicate(s,f,i) YAP_UserCPredicate(s,f,i);
#ifdef IndirectCalls
static void (*YapIUserCPredicate)() = UserCPredicate;
#define UserCPredicate(N,F,A) (*YapIUserCPredicate)(N,F,A)
#endif
/* void UserBackCPredicate(char *name, int *init(), int *cont(), int /* void UserBackCPredicate(char *name, int *init(), int *cont(), int
arity, int extra) */ arity, int extra) */
extern X_API void PROTO(UserBackCPredicate,(char *, int (*)(void), int (*)(void), int, int)); #define UserBackCPredicate(s,f1,f2,i,i2) YAP_UserBackCPredicate(s,f,i,i2)
#ifdef IndirectCalls
static void (*YapIUserBackCPredicate)() = UserBackCPredicate;
#define UserBackCPredicate(N,F,G,A,B) (*YapIUserBackCPredicate)(N,F,G,A,B)
#endif
/* void UserCPredicate(char *name, int *fn(), int arity) */ /* void UserCPredicate(char *name, int *fn(), int arity) */
extern X_API void PROTO(YapUserCPredicateWithArgs,(char *, int (*)(void), Int,Int)); #define UserCPredicateWithArgs(s,f,i1,i2) YAP_UserCPredicateWithArgs(s,f,i1,i2)
#ifdef IndirectCalls /* void CallProlog(YAP_Term t) */
static void (*YapIUserCPredicateWithArgs)() = UserCPredicateWithArgs; #define CallProlog(t) YAP_CallProlog(t)
#define YapUserCPredicateWithArgs(N,F,A,M) (*YapIUserCPredicateWithArgs)(N,F,A,M) #define YapCallProlog(t) YAP_CallProlog(t)
#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
/* void cut_fail(void) */ /* void cut_fail(void) */
extern X_API Int PROTO(Yapcut_fail,(void)); #define cut_fail() YAP_cutfail()
#ifdef IndirectCalls
static Int (*YapIcut_fail)() = Yapcut_fail;
#define cut_fail() (*YapIcut_fail)()
#else
#define cut_fail() Yapcut_fail()
#endif
/* void cut_succeed(void) */ /* void cut_succeed(void) */
extern X_API Int PROTO(Yapcut_succeed,(void)); #define cut_succeed() YAP_cutsucceed()
#ifdef IndirectCalls
static Int (*YapIcut_succeed)() = Yapcut_succeed;
#define cut_succeed() (*YapIcut_succeed)()
#else
#define cut_succeed() Yapcut_succeed()
#endif
/* void *AllocSpaceFromYap(int) */ /* void *AllocSpaceFromYap(int) */
extern X_API void *PROTO(YapAllocSpaceFromYap,(unsigned int)); #define AllocSpaceFromYap(s) YAP_AllocSpaceFromYap(s)
#ifdef IndirectCalls
static void (*YapIAllocSpaceFromYap)() = YapAllocSpaceFromYap;
#define AllocSpaceFromYap(SIZE) (*YapIAllocSpaceFromYap)(SIZE)
#else
#define AllocSpaceFromYap(SIZE) YapAllocSpaceFromYap(SIZE)
#endif
/* void FreeSpaceFromYap(void *) */ /* void FreeSpaceFromYap(void *) */
extern X_API void PROTO(YapFreeSpaceFromYap,(void *)); #define FreeSpaceFromYap(s) YAP_FreeSpaceFromYap(s)
#ifdef IndirectCalls
static void (YapIFreeSpaceFromYap)() = YapFreeSpaceFromYap;
#define FreeSpaceFromYap(PTR) (*YapIFreeSpaceFromYap)(PTR)
#else
#define FreeSpaceFromYap(PTR) YapFreeSpaceFromYap(PTR)
#endif
/* int YapRunGoal(Term) */ /* int YAP_RunGoal(YAP_Term) */
extern X_API int PROTO(YapRunGoal,(Term)); #define RunGoal(t) YAP_RunGoal(t)
#ifdef IndirectCalls #define YapRunGoal(t) YAP_RunGoal(t)
static int (YapIRunGoal)() = YapRunGoal;
#define YapRunGoal(T) (*YapIRunGoal)(T)
#endif
/* int YapRestartGoal(void) */ /* int YAP_RestartGoal(void) */
extern X_API int PROTO(YapRestartGoal,(void)); #define RestartGoal() YAP_RestartGoal()
#ifdef IndirectCalls #define YapRestartGoal() YAP_RestartGoal()
static int (YapIRestartGoal)() = YapRestartGoal;
#define YapRestartGoal() (*YapIRestartGoal)()
#endif
/* int YapContinueGoal(void) */ /* int YAP_ContinueGoal(void) */
extern X_API int PROTO(YapContinueGoal,(void)); #define ContinueGoal() YAP_ContinueGoal()
#ifdef IndirectCalls #define YapContinueGoal() YAP_ContinueGoal()
static int (YapIContinueGoal)() = YapContinueGoal;
#define YapContinueGoal() (*YapIContinueGoal)()
#endif
/* void YapPruneGoal(void) */ /* void YAP_PruneGoal(void) */
extern X_API void PROTO(YapPruneGoal,(void)); #define PruneGoal() YAP_PruneGoal()
#ifdef IndirectCalls #define YapPruneGoal() YAP_PruneGoal()
static void (YapIPruneGoal)() = YapPruneGoal;
#define YapPruneGoal() (*YapIPruneGoal)()
#endif
/* int YapGoalHasException(void) */ /* int YAP_GoalHasException(void) */
extern X_API int PROTO(YapGoalHasException,(Term *)); #define GoalHasException(tp) YAP_GoalHasException(tp)
#ifdef IndirectCalls #define YapGoalHasException(tp) YAP_GoalHasException(tp)
static int (YapIGoalHasException)(TP) = YapGoalHasException;
#define YapGoalHasException(TP) (*YapIGoalHasException)(TP)
#endif
/* int YapReset(void) */ /* int YAP_Reset(void) */
extern X_API void PROTO(YapReset,(void)); #define YapReset() YAP_Reset()
#ifdef IndirectCalls
static void (YapIReset)() = YapReset;
#define YapReset() (*YapIReset)()
#endif
/* void YapError(char *) */ /* void YAP_Error(char *) */
extern X_API void PROTO(YapError,(char *)); #define YapError(s) YAP_Error(s)
#ifdef IndirectCalls
static void (YapIError)() = YapError;
#define YapError(T) (*YapIError)(T)
#endif
/* Term YapRead(int (*)(void)) */ /* YAP_Term YAP_Read(int (*)(void)) */
extern X_API Term PROTO(YapRead,(int (*)(void))); #define YapRead(f) YAP_Read(f);
#ifdef IndirectCalls
static Term (YapIRead)() = YapRead;
#define YapRead(F) (*YapIRead)(F)
#endif
/* void YapWrite(Term,void (*)(int),int) */ /* void YAP_Write(YAP_Term,void (*)(int),int) */
extern X_API void PROTO(YapWrite,(Term,void (*)(int),int)); #define YapWrite(t,f) YAP_Write(t,f);
#ifdef IndirectCalls
static void (YapIWrite)() = YapWrite;
#define YapWrite(T,W,F) (*YapIWrite)(T,W,F)
#endif
/* char *YapCompileClause(Term) */ /* char *YAP_CompileClause(YAP_Term) */
extern X_API char *PROTO(YapCompileClause,(Term)); #define CompileClause(t) YAP_CompileClause(t)
#ifdef IndirectCalls #define YapCompileClause(t) YAP_CompileClause(t)
static char *(YapICompileClause)() = YapCompileClause;
#define YapCompileClause(C) (*YapICompileClause)(C)
#endif
/* int YapInit(yap_init_args *) */ /* int YAP_Init(YAP_init_args *) */
extern X_API int PROTO(YapInit,(yap_init_args *)); #define YapInit(as) YAP_Init(as)
#ifdef IndirectCalls
static int (YapIInit)() = YapInit;
#define YapInit(T) (*YapIInit)(T)
#endif
/* int YapFastInit(char *) */ /* int YAP_FastInit(char *) */
extern X_API int PROTO(YapFastInit,(char *)); #define YapFastInit(s) YAP_FastInit(s)
#ifdef IndirectCalls
static int (YapIFastInit)() = YapFastInit;
#define YapFastInit(S) (*YapIFastInit)(S)
#endif
/* int YapInitConsult(int, char *) */ /* int YAP_InitConsult(int, char *) */
extern X_API int PROTO(YapInitConsult,(int, char *)); #define YapInitConsult(i,s) YAP_InitConsult(i,s)
#ifdef IndirectCalls
static int (YapIInitConsult)() = YapInitConsult;
#define YapInitConsult(M,F) (*YapIInitConsult)(M,F)
#endif
/* int YapStartConsult(int, char *) */ /* int YAP_StartConsult(int, char *) */
extern X_API int PROTO(YapEndConsult,(void)); #define YapEndConsult() YAP_EndConsult()
#ifdef IndirectCalls
static int (YapIEndConsult)() = YapEndConsult;
#define YapEndConsult(M,F) (*YapIEndConsult)(M,F)
#endif
/* void YapExit(int) */ /* void YAP_Exit(int) */
extern X_API void PROTO(YapExit,(int)); #define YapExit(code) YAP_Exit(code)
#ifdef IndirectCalls
static int (YapIExit)() = YapExit;
#define YapExit(I) (*YapIExit)(I)
#endif
/* void YapPutValue(Atom, Term) */ /* void YAP_PutValue(YAP_Atom, YAP_Term) */
extern X_API void PROTO(YapPutValue,(Atom, Term)); #define PutValue() YAP_PutValue(a, t)
#ifdef IndirectCalls #define YapPutValue() YAP_PutValue(a, t)
static Term (YapIPutValue)() = YapPutValue;
#define YapPutValue(A,T) (*YapIPutValue)(A,T)
#endif
/* Term YapGetValue(Atom) */ /* YAP_Term YAP_GetValue(YAP_Atom) */
extern X_API Term PROTO(YapGetValue,(Atom)); #define GetValue(a) YAP_GetValue(a)
#ifdef IndirectCalls #define YapGetValue(a) YAP_GetValue(a)
static Term (YapIGetValue)() = YapGetValue;
#define YapGetValue(A) (*YapIGetValue)(A)
#endif
/* int StringToBuffer(Term,char *,unsigned int) */ /* int StringToBuffer(YAP_Term,char *,unsigned int) */
extern X_API int PROTO(YapStringToBuffer,(Term,char *,unsigned int)); #define StringToBuffer(t,s,l) YAP_StringToBuffer(t,s,l)
#ifdef IndirectCalls #define YapStringToBuffer(t,s,l) YAP_StringToBuffer(t,s,l)
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 BufferToString(char *) */ /* int BufferToString(char *) */
extern X_API Term PROTO(YapBufferToString,(char *)); #define BufferToString(s) YAP_BufferToString(s)
#ifdef IndirectCalls #define YapBufferToString(s) YAP_BufferToString(s)
static void (YapIBufferToString)() = YapBufferToString;
#define BufferToString(BUF) (*YapIBufferToString)(BUF)
#else
#define BufferToString(BUF) YapBufferToString(BUF)
#endif
/* int BufferToAtomList(char *) */ /* int BufferToAtomList(char *) */
extern X_API Term PROTO(YapBufferToAtomList,(char *)); #define BufferToAtomList(s) YAP_BufferToAtomList(s)
#ifdef IndirectCalls #define YapBufferToAtomList(s) YAP_BufferToAtomList(s)
static void (YapIBufferToAtomList)() = YapBufferToAtomList;
#define BufferToAtomList(BUF) (*YapIBufferToAtomList)(BUF)
#else
#define BufferToAtomList(BUF) YapBufferToAtomList(BUF)
#endif
/* void YapInitSocks(char *,long) */ /* void YAP_InitSocks(char *,long) */
extern X_API int PROTO(YapInitSocks,(char *,long)); #define InitSocks(s,l) YAP_InitSocks(s,l)
#ifdef IndirectCalls #define YapInitSocks(s,l) YAP_InitSocks(s,l)
static int (YapIInitSocks)(char *,long) = YapInitSocks;
#define YapInitSocks(S,I) (*YapIInitSocks)(S,I)
#endif
#ifdef SFUNC #ifdef SFUNC
#define SFArity 0 #define SFArity 0
extern X_API Term *ArgsOfSFTerm(); #define ArgsOfSFTerm(s,t) YAP_ArgsOfSFTerm(s,t)
#ifdef IndirectCalls
static Term *((*YapIArgsOfSFTerm)()) = ArgsOfSFTerm; extern MkSFTerm(t) YAP_MkSFTerm(t)
#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
#endif /* SFUNC */ #endif /* SFUNC */
/* Term YapSetOutputMessage() */ /* YAP_Term YAP_SetOutputMessage() */
extern X_API void PROTO(YapSetOutputMessage,(void)); #define YapSetOutputMessage(s) YAP_SetOutputMessage(s)
#ifdef IndirectCalls
static void (*YapISetOutputMessage)() = YapSetOutputMessage;
#define YapSetOutputMessage() (*YapISetOutputMessage)()
#endif
/* Term YapSetOutputMessage() */ /* YAP_Term YAP_SetOutputMessage() */
extern X_API int PROTO(YapStreamToFileNo,(Term)); #define YapStreamToFileNo(st) YAP_StreamToFileNo(st)
#ifdef IndirectCalls
static void (*YapIStreamToFileNo)() = YapStreamToFileNo;
#define YapStreamToFileNo() (*YapIStreamToFileNo)()
#endif
/* Term YapSetOutputMessage() */ /* YAP_Term YAP_SetOutputMessage() */
extern X_API void PROTO(YapCloseAllOpenStreams,(void)); #define YapCloseAllOpenStreams() YAP_CloseAllOpenStreams()
#ifdef IndirectCalls
static void (*YapICloseAllOpenStreams)() = YapCloseAllOpenStreams;
#define YapCloseAllOpenStreams() (*YapICloseAllOpenStreams)()
#endif
#define YAP_INPUT_STREAM 0x01 /* YAP_Term YAP_OpenStream() */
#define YAP_OUTPUT_STREAM 0x02 #define YapOpenStream(st, s, t, i) YAP_OpenStream(st, s, t, i)
#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
#endif #endif

16
include/yap_structs.h
View File

@ -28,19 +28,15 @@
/* Type definitions */ /* 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 AtomEntry *YAP_Atom;
typedef struct FunctorEntry *Functor;
typedef struct AtomEntry *Atom;
#ifndef TRUE #ifndef TRUE
#define TRUE 1 #define TRUE 1
@ -93,5 +89,5 @@ typedef struct {
int Argc; int Argc;
/* array of arguments as seen by Prolog */ /* array of arguments as seen by Prolog */
char **Argv; char **Argv;
} yap_init_args; } YAP_init_args;

26
library/random/random.c
View File

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

92
library/regex/regexp.c
View File

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

370
library/system/sys.c
View File

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

166
misc/yap.def
View File

@ -1,85 +1,85 @@
EXPORTS EXPORTS
YapA YAP_A
YapInit YAP_Init
YapRunGoal YAP_RunGoal
YapRestartGoal YAP_RestartGoal
YapReset YAP_Reset
Deref YAP_Deref
YapIsVarTerm YAP_IsVarTerm
YapIsNonVarTerm YAP_IsNonVarTerm
YapMkVarTerm YAP_MkVarTerm
YapIsIntTerm YAP_IsIntTerm
YapIsFloatTerm YAP_IsFloatTerm
YapIsDbRefTerm YAP_IsDbRefTerm
YapIsAtomTerm YAP_IsAtomTerm
YapIsPairTerm YAP_IsPairTerm
YapIsApplTerm YAP_IsApplTerm
YapMkIntTerm YAP_MkIntTerm
YapIntOfTerm YAP_IntOfTerm
YapMkFloatTerm YAP_MkFloatTerm
YapFloatOfTerm YAP_FloatOfTerm
YapMkAtomTerm YAP_MkAtomTerm
YapAtomOfTerm YAP_AtomOfTerm
YapLookupAtom YAP_LookupAtom
YapFullLookupAtom YAP_FullLookupAtom
YapAtomName YAP_AtomName
YapMkPairTerm YAP_MkPairTerm
YapMkNewPairTerm YAP_MkNewPairTerm
YapHeadOfTerm YAP_HeadOfTerm
YapTailOfTerm YAP_TailOfTerm
YapMkApplTerm YAP_MkApplTerm
YapMkNewApplTerm YAP_MkNewApplTerm
YapFunctorOfTerm YAP_FunctorOfTerm
YapArgOfTerm YAP_ArgOfTerm
YapMkFunctor YAP_MkFunctor
YapNameOfFunctor YAP_NameOfFunctor
YapArityOfFunctor YAP_ArityOfFunctor
YapExtraSpace YAP_ExtraSpace
YapUnify YAP_Unify
UserCPredicate YAP_UserCPredicate
UserBackCPredicate YAP_UserCPredicateWithArgs
YapCallProlog YAP_UserBackCPredicate
Yapcut_fail YAP_CallProlog
Yapcut_succeed YAP_cut_fail
YapAllocSpaceFromYap YAP_cut_succeed
YapFreeSpaceFromYap YAP_AllocSpaceFromYap
YapStringToBuffer YAP_FreeSpaceFromYap
YapBufferToString YAP_StringToBuffer
YapBufferToAtomList YAP_BufferToString
YapError YAP_BufferToAtomList
YapRunGoal YAP_Error
YapContinueGoal YAP_RunGoal
YapPruneGoal YAP_ContinueGoal
YapGoalHasException YAP_PruneGoal
YapRead YAP_GoalHasException
YapCompileClause YAP_Read
YapInit YAP_CompileClause
YapFastInit YAP_Init
YapPutValue YAP_FastInit
YapGetValue YAP_PutValue
YapReset YAP_GetValue
YapExit YAP_Reset
YapInitSocks YAP_Exit
YapSetOutputMessage YAP_InitSocks
YapWrite YAP_SetOutputMessage
YapInitConsult YAP_Write
YapEndConsult YAP_InitConsult
YapStreamToFileNo YAP_EndConsult
YapCloseAllOpenStreams YAP_StreamToFileNo
YapOpenStream YAP_CloseAllOpenStreams
YapNewSlots YAP_OpenStream
YapInitSlot YAP_NewSlots
YapGetFromSlot YAP_InitSlot
YapAddressFromSlot YAP_GetFromSlot
YapPutInSlot YAP_AddressFromSlot
YapRecoverSlots YAP_PutInSlot
YapThrow YAP_RecoverSlots
YapLookupModule YAP_Throw
YapModuleName YAP_LookupModule
YapHalt YAP_ModuleName
YapTopOfLocalStack YAP_Halt
YapPredicate YAP_TopOfLocalStack
YapCurrentModule YAP_Predicate
YapPredicateInfo YAP_CurrentModule
YapUserCPredicateWithArgs 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. % Hack in case expand_term has created a list of commands.
% %
'$execute_commands'(V,_,_) :- var(V), !, '$execute_commands'(V,_,_) :- var(V), !,
throw(error(instantiation_error,meta_call(V))). '$do_error'(instantiation_error,meta_call(V)).
'$execute_commands'([],_,_) :- !, fail. '$execute_commands'([],_,_) :- !, fail.
'$execute_commands'([C|_],VL,Con) :- '$execute_commands'([C|_],VL,Con) :-
'$execute_command'(C,VL,Con). '$execute_command'(C,VL,Con).
@ -263,12 +263,12 @@ repeat :- '$repeat'.
% %
'$execute_command'(C,_,top) :- var(C), !, '$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'(end_of_file,_,_).
'$execute_command'(C,_,top) :- number(C), !, '$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), !, '$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) :- !, '$execute_command'((:-G),_,Option) :- !,
'$current_module'(M), '$current_module'(M),
'$process_directive'(G, Option, M), '$process_directive'(G, Option, M),
@ -288,7 +288,7 @@ repeat :- '$repeat'.
'$access_yap_flags'(8, 0), !, % YAP mode, go in and do it, '$access_yap_flags'(8, 0), !, % YAP mode, go in and do it,
'$process_directive'(G, consult, M). '$process_directive'(G, consult, M).
'$process_directive'(G, top, _) :- !, '$process_directive'(G, top, _) :- !,
throw(error(context_error((:- G),clause),query)). '$do_error'(context_error((:- G),clause),query).
% %
% always allow directives. % always allow directives.
% %
@ -313,7 +313,7 @@ repeat :- '$repeat'.
% %
'$process_directive'(D, _, M) :- '$process_directive'(D, _, M) :-
'$access_yap_flags'(8, 1), !, % ISO Prolog mode, go in and do it, '$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. % but YAP and SICStus does.
% %
@ -706,7 +706,7 @@ not(A) :-
\+ '$execute_within'(A). \+ '$execute_within'(A).
'$call'(M:_,_,G0,_) :- var(M), !, '$call'(M:_,_,G0,_) :- var(M), !,
throw(error(instantiation_error,call(G0))). '$do_error'(instantiation_error,call(G0)).
'$call'(M:G,CP,G0,_) :- !, '$call'(M:G,CP,G0,_) :- !,
'$call'(G,CP,G0,M). '$call'(G,CP,G0,M).
'$call'((X,Y),CP,G0,M) :- !, '$call'((X,Y),CP,G0,M) :- !,
@ -819,13 +819,13 @@ not(A) :-
'$check_callable'(V,G) :- var(V), !, '$check_callable'(V,G) :- var(V), !,
'$current_module'(Mod), '$current_module'(Mod),
throw(error(instantiation_error,Mod:G)). '$do_error'(instantiation_error,Mod:G).
'$check_callable'(A,G) :- number(A), !, '$check_callable'(A,G) :- number(A), !,
'$current_module'(Mod), '$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), !, '$check_callable'(R,G) :- db_reference(R), !,
'$current_module'(Mod), '$current_module'(Mod),
throw(error(type_error(callable,R),Mod:G)). '$do_error'(type_error(callable,R),Mod:G).
'$check_callable'(_,_). '$check_callable'(_,_).
% Called by the abstract machine, if no clauses exist for a predicate % 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), !, '$csult'(V, _) :- var(V), !,
throw(error(instantiation_error,consult(V))). '$do_error'(instantiation_error,consult(V)).
'$csult'([], _) :- !. '$csult'([], _) :- !.
'$csult'([-F|L], M) :- !, '$reconsult'(M:F), '$csult'(L, M). '$csult'([-F|L], M) :- !, '$reconsult'(M:F), '$csult'(L, M).
'$csult'([F|L], M) :- '$consult'(M:F), '$csult'(L, M). '$csult'([F|L], M) :- '$consult'(M:F), '$csult'(L, M).
'$consult'(V) :- var(V), !, '$consult'(V) :- var(V), !,
throw(error(instantiation_error,consult(V))). '$do_error'(instantiation_error,consult(V)).
'$consult'([]) :- !. '$consult'([]) :- !.
'$consult'([F|Fs]) :- !, '$consult'([F|Fs]) :- !,
'$consult'(F), '$consult'(F),
@ -898,7 +898,7 @@ break :- '$get_value'('$break',BL), NBL is BL+1,
'$consult'(X,Stream), '$consult'(X,Stream),
'$close'(Stream). '$close'(Stream).
'$consult'(X) :- '$consult'(X) :-
throw(error(permission_error(input,stream,X),consult(X))). '$do_error'(permission_error(input,stream,X),consult(X)).
'$consult'(_,Stream) :- '$consult'(_,Stream) :-
@ -1002,7 +1002,7 @@ break :- '$get_value'('$break',BL), NBL is BL+1,
'$command'(Command,Vars,Status). '$command'(Command,Vars,Status).
'$abort_loop'(Stream) :- '$abort_loop'(Stream) :-
throw(error(permission_error(input,closed_stream,Stream), loop)). '$do_error'(permission_error(input,closed_stream,Stream), loop).
/* General purpose predicates */ /* General purpose predicates */
@ -1018,11 +1018,11 @@ break :- '$get_value'('$break',BL), NBL is BL+1,
'$check_head'(H,P). '$check_head'(H,P).
'$check_head'(H,P) :- var(H), !, '$check_head'(H,P) :- var(H), !,
throw(error(instantiation_error,P)). '$do_error'(instantiation_error,P).
'$check_head'(H,P) :- number(H), !, '$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), !, '$check_head'(H,P) :- db_reference(H), !,
throw(error(type_error(callable,H),P)). '$do_error'(type_error(callable,H),P).
'$check_head'(_,_). '$check_head'(_,_).
% Path predicates % Path predicates
@ -1044,7 +1044,7 @@ break :- '$get_value'('$break',BL), NBL is BL+1,
'$find_in_path'(File,NewFile,_) :- atom(File), !, '$find_in_path'(File,NewFile,_) :- atom(File), !,
'$search_in_path'(File,NewFile),!. '$search_in_path'(File,NewFile),!.
'$find_in_path'(File,_,Call) :- '$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) :- '$search_in_path'(New,New) :-
'$exists'(New,'$csult'), !. '$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, 1) :- integer(Calls), !.
'$check_if_call_count_on'(Calls, 0) :- var(Calls), !. '$check_if_call_count_on'(Calls, 0) :- var(Calls), !.
'$check_if_call_count_on'(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). nl(user_error).
'$multifile'(V, _) :- var(V), !, '$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'((X,Y), M) :- '$multifile'(X, M), '$multifile'(Y, M).
'$multifile'(Mod:PredSpec, _) :- !, '$multifile'(Mod:PredSpec, _) :- !,
'$multifile'(PredSpec, Mod). '$multifile'(PredSpec, Mod).
@ -201,10 +201,10 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
'$multifile'(N/A, M) :- !, '$multifile'(N/A, M) :- !,
'$new_multifile'(N,A,M). '$new_multifile'(N,A,M).
'$multifile'(P, 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), !, '$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,Y),M) :- !,
'$discontiguous'(X,M), '$discontiguous'(X,M),
'$discontiguous'(Y,M). '$discontiguous'(Y,M).
@ -217,7 +217,7 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
true true
). ).
'$discontiguous'(P,M) :- '$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? % did we declare multifile properly?

24
pl/consult.yap
View File

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

26
pl/debug.yap
View File

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

64
pl/directives.yap
View File

@ -190,9 +190,9 @@ yap_flag(bounded,X) :-
'$transl_to_true_false'(X1,X). '$transl_to_true_false'(X1,X).
yap_flag(bounded,X) :- !, yap_flag(bounded,X) :- !,
(X = true ; X = false), !, (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) :- 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 % do or do not indexation
yap_flag(index,X) :- var(X), !, 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,on) :- !, '$set_value'('$verbose',on).
yap_flag(informational_messages,off) :- !, '$set_value'('$verbose',off). yap_flag(informational_messages,off) :- !, '$set_value'('$verbose',off).
yap_flag(informational_messages,X) :- 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) :- yap_flag(integer_rounding_function,X) :-
var(X), !, var(X), !,
@ -213,9 +213,9 @@ yap_flag(integer_rounding_function,X) :-
'$transl_to_rounding_function'(X1,X). '$transl_to_rounding_function'(X1,X).
yap_flag(integer_rounding_function,X) :- yap_flag(integer_rounding_function,X) :-
(X = down; X = toward_zero), !, (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) :- 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) :- yap_flag(max_arity,X) :-
var(X), !, var(X), !,
@ -223,15 +223,15 @@ yap_flag(max_arity,X) :-
'$transl_to_arity'(X1,X). '$transl_to_arity'(X1,X).
yap_flag(max_arity,X) :- yap_flag(max_arity,X) :-
integer(X), X > 0, !, 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) :- 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) :- yap_flag(version,X) :-
var(X), !, var(X), !,
'$get_value'('$version_name',X). '$get_value'('$version_name',X).
yap_flag(version,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) :- yap_flag(max_integer,X) :-
var(X), !, var(X), !,
@ -239,9 +239,9 @@ yap_flag(max_integer,X) :-
'$access_yap_flags'(3, X). '$access_yap_flags'(3, X).
yap_flag(max_integer,X) :- yap_flag(max_integer,X) :-
integer(X), X > 0, !, 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) :- 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) :- yap_flag(min_integer,X) :-
var(X), !, var(X), !,
@ -249,9 +249,9 @@ yap_flag(min_integer,X) :-
'$access_yap_flags'(4, X). '$access_yap_flags'(4, X).
yap_flag(min_integer,X) :- yap_flag(min_integer,X) :-
integer(X), X < 0, !, 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) :- 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) :- yap_flag(char_conversion,X) :-
var(X), !, var(X), !,
@ -266,7 +266,7 @@ yap_flag(char_conversion,X) :-
'$disable_char_conversion' '$disable_char_conversion'
). ).
yap_flag(char_conversion,X) :- 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) :- yap_flag(double_quotes,X) :-
var(X), !, var(X), !,
@ -276,7 +276,7 @@ yap_flag(double_quotes,X) :-
'$transl_to_trl_types'(X1,X), !, '$transl_to_trl_types'(X1,X), !,
'$set_yap_flags'(6,X1). '$set_yap_flags'(6,X1).
yap_flag(double_quotes,X) :- 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) :- yap_flag(n_of_integer_keys_in_db,X) :-
var(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, !, yap_flag(n_of_integer_keys_in_db,X) :- integer(X), X > 0, !,
'$resize_int_keys'(X). '$resize_int_keys'(X).
yap_flag(n_of_integer_keys_in_db,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) :- yap_flag(n_of_integer_keys_in_bb,X) :-
var(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, !, yap_flag(n_of_integer_keys_in_bb,X) :- integer(X), X > 0, !,
'$resize_bb_int_keys'(X). '$resize_bb_int_keys'(X).
yap_flag(n_of_integer_keys_in_bb,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) :- yap_flag(strict_iso,OUT) :-
var(OUT), !, var(OUT), !,
@ -306,7 +306,7 @@ yap_flag(strict_iso,off) :- !,
'$transl_to_on_off'(X,off), '$transl_to_on_off'(X,off),
'$set_yap_flags'(9,X). '$set_yap_flags'(9,X).
yap_flag(strict_iso,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) :- yap_flag(language,X) :-
var(X), !, var(X), !,
@ -317,7 +317,7 @@ yap_flag(language,X) :-
'$set_yap_flags'(8,N), '$set_yap_flags'(8,N),
'$adjust_language'(X). '$adjust_language'(X).
yap_flag(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) :- yap_flag(debug,X) :-
var(X), !, var(X), !,
@ -330,7 +330,7 @@ yap_flag(debug,X) :-
'$transl_to_on_off'(_,X), !, '$transl_to_on_off'(_,X), !,
(X = on -> debug ; nodebug). (X = on -> debug ; nodebug).
yap_flag(debug,X) :- 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) :- yap_flag(discontiguous_warnings,X) :-
var(X), !, var(X), !,
@ -347,7 +347,7 @@ yap_flag(discontiguous_warnings,X) :-
; ;
'$syntax_check_discontiguous'(_,off)). '$syntax_check_discontiguous'(_,off)).
yap_flag(discontiguous_warnings,X) :- 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) :- yap_flag(redefine_warnings,X) :-
var(X), !, var(X), !,
@ -364,7 +364,7 @@ yap_flag(redefine_warnings,X) :-
; ;
'$syntax_check_multiple'(_,off)). '$syntax_check_multiple'(_,off)).
yap_flag(redefine_warnings,X) :- 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) :- yap_flag(single_var_warnings,X) :-
var(X), !, var(X), !,
@ -381,7 +381,7 @@ yap_flag(single_var_warnings,X) :-
; ;
'$syntax_check_single_var'(_,off)). '$syntax_check_single_var'(_,off)).
yap_flag(single_var_warnings,X) :- 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) :- yap_flag(unknown,X) :-
var(X), !, var(X), !,
@ -397,7 +397,7 @@ yap_flag(to_chars_mode,quintus) :- !,
yap_flag(to_chars_mode,iso) :- !, yap_flag(to_chars_mode,iso) :- !,
'$set_yap_flags'(7,1). '$set_yap_flags'(7,1).
yap_flag(to_chars_mode,X) :- 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) :- yap_flag(character_escapes,X) :-
var(X), !, var(X), !,
@ -407,7 +407,7 @@ yap_flag(character_escapes,X) :- !,
'$transl_to_character_escape_modes'(Y,X), !, '$transl_to_character_escape_modes'(Y,X), !,
'$set_yap_flags'(12,Y). '$set_yap_flags'(12,Y).
yap_flag(character_escapes,X) :- 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) :- yap_flag(update_semantics,X) :-
var(X), !, var(X), !,
@ -419,7 +419,7 @@ yap_flag(update_semantics,logical_assert) :- !,
yap_flag(update_semantics,immediate) :- !, yap_flag(update_semantics,immediate) :- !,
'$switch_log_upd'(0). '$switch_log_upd'(0).
yap_flag(update_semantics,X) :- 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) :- yap_flag(toplevel_hook,X) :-
var(X), !, var(X), !,
@ -444,7 +444,7 @@ yap_flag(write_strings,off) :- !,
'$transl_to_on_off'(X,off), '$transl_to_on_off'(X,off),
'$set_yap_flags'(13,X). '$set_yap_flags'(13,X).
yap_flag(write_strings,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) :- yap_flag(user_input,OUT) :-
var(OUT), !, var(OUT), !,
@ -492,7 +492,7 @@ yap_flag(fileerrors,on) :- !,
yap_flag(fileerrors,off) :- !, yap_flag(fileerrors,off) :- !,
'$set_value'(fileerrors,0). '$set_value'(fileerrors,0).
yap_flag(fileerrors,X) :- 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)]),_). :- '$recorda'('$print_options','$toplevel'([quoted(true),numbervars(true),portrayed(true)]),_).
@ -631,23 +631,23 @@ current_prolog_flag(V,Out) :-
yap_flag(V,NOut), yap_flag(V,NOut),
NOut = Out. NOut = Out.
current_prolog_flag(V,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) :- set_prolog_flag(F,V) :-
var(F), !, 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) :- set_prolog_flag(F,V) :-
var(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) :- set_prolog_flag(F,V) :-
\+ atom(F), !, \+ 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) :- set_prolog_flag(F,V) :-
yap_flag(F,V). yap_flag(F,V).
prolog_flag(F, Old, New) :- prolog_flag(F, Old, New) :-
var(F), !, 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) :- prolog_flag(F, Old, New) :-
current_prolog_flag(F, Old), current_prolog_flag(F, Old),
set_prolog_flag(F, New). 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) :- '$Error'(E) :-
'$LoopError'(E). '$LoopError'(E).
@ -47,8 +51,13 @@ print_message(Level, Mss) :-
'$print_message'(Severity, Msg) :- '$print_message'(Severity, Msg) :-
\+ '$undefined'(portray_message(Severity, Msg), user), \+ '$undefined'(portray_message(Severity, Msg), user),
user:portray_message(Severity, Msg), !. user:portray_message(Severity, Msg), !.
'$print_message'(error,error(Msg,Where)) :- '$print_message'(error,error(syntax_error(A,B,C,D,E,F),_)) :- !,
'$output_error_message'(Msg, Where), !. '$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) :- '$print_message'(error,Throw) :-
'$format'(user_error,"[ No handler for error ~w ]~n", [Throw]). '$format'(user_error,"[ No handler for error ~w ]~n", [Throw]).
'$print_message'(informational,M) :- '$print_message'(informational,M) :-
@ -127,6 +136,50 @@ print_message(Level, Mss) :-
'$format'(user_error,"~n ~w",[P]), '$format'(user_error,"~n ~w",[P]),
'$print_list_of_preds'(L). '$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) :- '$output_error_message'(context_error(Goal,Who),Where) :-
'$format'(user_error,"[ CONTEXT ERROR- ~w: ~w appeared in ~w ]~n", '$format'(user_error,"[ CONTEXT ERROR- ~w: ~w appeared in ~w ]~n",
[Goal,Who,Where]). [Goal,Who,Where]).

4
pl/grammar.yap
View File

@ -108,10 +108,10 @@ phrase(PhraseDef, WordList) :-
phrase(P, S0, S) :- phrase(P, S0, S) :-
var(P), !, var(P), !,
throw(error(instantiation_error,phrase(P,S0,S))). '$do_error'(instantiation_error,phrase(P,S0,S)).
phrase(P, S0, S) :- phrase(P, S0, S) :-
( primitive(P), \+ atom(P) ), !, ( 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) :- !, phrase([], S0, S) :- !,
S0 = S. S0 = S.
phrase([H|T], 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). '$load_foreign_files'(NewObjs,Libs,Entry).
'$check_objs_for_load_foreign_files'(V,_,G) :- var(V), !, '$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'([],[],_) :- !.
'$check_objs_for_load_foreign_files'([Obj|Objs],[NObj|NewObjs],G) :- !, '$check_objs_for_load_foreign_files'([Obj|Objs],[NObj|NewObjs],G) :- !,
'$check_obj_for_load_foreign_files'(Obj,NObj,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,NewObjs,G).
'$check_objs_for_load_foreign_files'(Objs,_,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), !, '$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), !, '$check_obj_for_load_foreign_files'(Obj,NewObj,_) :- atom(Obj), !,
atom_codes(Obj,ObjCodes), atom_codes(Obj,ObjCodes),
'$process_obj_suffix'(ObjCodes,NewObjCodes), '$process_obj_suffix'(ObjCodes,NewObjCodes),
atom_codes(NewObj,NewObjCodes). atom_codes(NewObj,NewObjCodes).
'$check_obj_for_load_foreign_files'(Obj,_,G) :- '$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), !, '$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'([],_) :- !.
'$check_libs_for_load_foreign_files'([Lib|Libs],G) :- !, '$check_libs_for_load_foreign_files'([Lib|Libs],G) :- !,
'$check_lib_for_load_foreign_files'(Lib,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).
'$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), !, '$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,_) :- atom(Lib), !.
'$check_lib_for_load_foreign_files'(Lib,G) :- '$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), !, '$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,_) :- atom(Entry), !.
'$check_entry_for_load_foreign_files'(Entry,G) :- '$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) :- '$process_obj_suffix'(ObjCodes,ObjCodes) :-

26
pl/modules.yap
View File

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

132
pl/preds.yap
View File

@ -19,29 +19,29 @@
% to dynamic code % to dynamic code
asserta(V) :- var(V), !, asserta(V) :- var(V), !,
throw(error(instantiation_error,asserta(V))). '$do_error'(instantiation_error,asserta(V)).
asserta(C) :- asserta(C) :-
'$current_module'(Mod), '$current_module'(Mod),
'$assert'(C,Mod,first,_,asserta(C)). '$assert'(C,Mod,first,_,asserta(C)).
assertz(V) :- var(V), !, assertz(V) :- var(V), !,
throw(error(instantiation_error,assertz(V))). '$do_error'(instantiation_error,assertz(V)).
assertz(C) :- assertz(C) :-
'$current_module'(Mod), '$current_module'(Mod),
'$assert'(C,Mod,last,_,assertz(C)). '$assert'(C,Mod,last,_,assertz(C)).
assert(V) :- var(V), !, assert(V) :- var(V), !,
throw(error(instantiation_error,assert(V))). '$do_error'(instantiation_error,assert(V)).
assert(C) :- assert(C) :-
'$current_module'(Mod), '$current_module'(Mod),
'$assert'(C,Mod,last,_,assert(C)). '$assert'(C,Mod,last,_,assert(C)).
'$assert'(V,Mod,_,_,_) :- var(V), !, '$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'(M:C,_,Where,R,P) :- !,
'$assert'(C,M,Where,R,P). '$assert'(C,M,Where,R,P).
'$assert'((H:-G),M1,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 -> ( M1 = M ->
'$assert'((C:-G),M1,Where,R,P) '$assert'((C:-G),M1,Where,R,P)
; ;
@ -63,16 +63,16 @@ assert(C) :-
'$assert1'(Where,C,C0,Mod,H) '$assert1'(Where,C,C0,Mod,H)
; ;
functor(H, Na, Ar), 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), !, '$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'(M:C,_,Where,R,P) :- !,
'$assert_dynamic'(C,M,Where,R,P). '$assert_dynamic'(C,M,Where,R,P).
'$assert_dynamic'((H:-G),M1,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 -> ( M1 = M ->
'$assert_dynamic'((C:-G),M1,Where,R,P) '$assert_dynamic'((C:-G),M1,Where,R,P)
; ;
@ -91,33 +91,33 @@ assert(C) :-
'$assertat_d'(Where,H,B,C0,Mod,R) '$assertat_d'(Where,H,B,C0,Mod,R)
; ;
functor(H,Na,Ar), 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), !, assert_static(V) :- var(V), !,
throw(error(instantiation_error,assert_static(V))). '$do_error'(instantiation_error,assert_static(V)).
assert_static(C) :- assert_static(C) :-
'$current_module'(Mod), '$current_module'(Mod),
'$assert_static'(C,Mod,last,_,assert_static(C)). '$assert_static'(C,Mod,last,_,assert_static(C)).
asserta_static(V) :- var(V), !, asserta_static(V) :- var(V), !,
throw(error(instantiation_error,asserta_static(V))). '$do_error'(instantiation_error,asserta_static(V)).
asserta_static(C) :- asserta_static(C) :-
'$current_module'(Mod), '$current_module'(Mod),
'$assert_static'(C,Mod,first,_,asserta_static(C)). '$assert_static'(C,Mod,first,_,asserta_static(C)).
assertz_static(V) :- var(V), !, assertz_static(V) :- var(V), !,
throw(error(instantiation_error,assertz_static(V))). '$do_error'(instantiation_error,assertz_static(V)).
assertz_static(C) :- assertz_static(C) :-
'$current_module'(Mod), '$current_module'(Mod),
'$assert_static'(C,Mod,last,_,assertz_static(C)). '$assert_static'(C,Mod,last,_,assertz_static(C)).
'$assert_static'(V,M,_,_,_) :- var(V), !, '$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'(M:C,_,Where,R,P) :- !,
'$assert_static'(C,M,Where,R,P). '$assert_static'(C,M,Where,R,P).
'$assert_static'((H:-G),M1,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 -> ( M1 = M ->
'$assert_static'((C:-G),M1,Where,R,P) '$assert_static'((C:-G),M1,Where,R,P)
; ;
@ -128,7 +128,7 @@ assertz_static(C) :-
'$expand_clause'(CI,C0,C,Mod), '$expand_clause'(CI,C0,C,Mod),
'$check_head_and_body'(C,H,B,P), '$check_head_and_body'(C,H,B,P),
( '$is_dynamic'(H, Mod) -> ( '$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) -> '$undefined'(H,Mod), '$get_value'('$full_iso',true) ->
functor(H,Na,Ar), '$dynamic'(Na/Ar, Mod), '$assertat_d'(Where,H,B,C0,Mod,R) 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'(_,_,_). '$erase_all_mf_dynamic'(_,_,_).
asserta(V,R) :- var(V), !, asserta(V,R) :- var(V), !,
throw(error(instantiation_error,asserta(V,R))). '$do_error'(instantiation_error,asserta(V,R)).
asserta(C,R) :- asserta(C,R) :-
'$current_module'(M), '$current_module'(M),
'$assert_dynamic'(C,M,first,R,asserta(C,R)). '$assert_dynamic'(C,M,first,R,asserta(C,R)).
assertz(V,R) :- var(V), !, assertz(V,R) :- var(V), !,
throw(error(instantiation_error,assertz(V,R))). '$do_error'(instantiation_error,assertz(V,R)).
assertz(C,R) :- assertz(C,R) :-
'$current_module'(M), '$current_module'(M),
'$assert_dynamic'(C,M,last,R,assertz(C,R)). '$assert_dynamic'(C,M,last,R,assertz(C,R)).
assert(V,R) :- var(V), !, assert(V,R) :- var(V), !,
throw(error(instantiation_error,assert(V,R))). '$do_error'(instantiation_error,assert(V,R)).
assert(C,R) :- assert(C,R) :-
'$current_module'(M), '$current_module'(M),
'$assert_dynamic'(C,M,last,R,assert(C,R)). '$assert_dynamic'(C,M,last,R,assert(C,R)).
@ -234,11 +234,11 @@ clause(V,Q) :-
'$clause'(V,M,Q). '$clause'(V,M,Q).
'$clause'(V,M,Q) :- var(V), !, '$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), !, '$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), !, '$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'(M:P,_,Q) :- !,
'$clause'(P,M,Q). '$clause'(P,M,Q).
'$clause'(P,Mod,Q) :- '$is_dynamic'(P, Mod), !, '$clause'(P,Mod,Q) :- '$is_dynamic'(P, Mod), !,
@ -250,19 +250,19 @@ clause(V,Q) :-
( '$system_predicate'(P,M) -> true ; ( '$system_predicate'(P,M) -> true ;
'$number_of_clauses'(P,M,N), N > 0 ), '$number_of_clauses'(P,M,N), N > 0 ),
functor(P,Name,Arity), functor(P,Name,Arity),
throw(error(permission_error(access,private_procedure,Name/Arity), '$do_error'(permission_error(access,private_procedure,Name/Arity),
clause(M:P,Q))). clause(M:P,Q)).
clause(V,Q,R) :- clause(V,Q,R) :-
'$current_module'(V,M,Q,R), '$current_module'(V,M,Q,R),
'$clause'(V,M,Q,R). '$clause'(V,M,Q,R).
'$clause'(V,M,Q,R) :- var(V), !, '$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), !, '$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), !, '$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'(M:P,_,Q,R) :- !,
'$clause'(P,M,Q,R). '$clause'(P,M,Q,R).
'$clause'(P,Mod,Q,R) :- '$clause'(P,Mod,Q,R) :-
@ -270,8 +270,8 @@ clause(V,Q,R) :-
'$recordedp'(Mod:P,(P:-Q),R) '$recordedp'(Mod:P,(P:-Q),R)
; ;
functor(P,N,A), functor(P,N,A),
throw(error(permission_error(access,private_procedure,N/A), '$do_error'(permission_error(access,private_procedure,N/A),
clause(Mod:P,Q,R))) clause(Mod:P,Q,R))
). ).
retract(C) :- retract(C) :-
@ -280,7 +280,7 @@ retract(C) :-
'$retract'(V,_) :- var(V), !, '$retract'(V,_) :- var(V), !,
throw(error(instantiation_error,retract(V))). '$do_error'(instantiation_error,retract(V)).
'$retract'(M:C,_) :- !, '$retract'(M:C,_) :- !,
'$retract'(C,M). '$retract'(C,M).
'$retract'(C,M) :- '$retract'(C,M) :-
@ -295,7 +295,7 @@ retract(C) :-
fail. fail.
'$retract'(C,M) :- '$retract'(C,M) :-
'$fetch_predicate_indicator_from_clause'(C, PI), '$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) :- !, retract(C,R) :- !,
'$current_module'(M), '$current_module'(M),
@ -303,7 +303,7 @@ retract(C,R) :- !,
'$retract'(V,M,R) :- var(V), !, '$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'(M:C,_,R) :- !,
'$retract'(C,M,R). '$retract'(C,M,R).
'$retract'(C, M, R) :- '$retract'(C, M, R) :-
@ -324,7 +324,7 @@ retract(C,R) :- !,
fail. fail.
'$retract'(C,M,_) :- '$retract'(C,M,_) :-
'$fetch_predicate_indicator_from_clause'(C, PI), '$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) :- !, '$fetch_predicate_indicator_from_clause'((C :- _), Na/Ar) :- !,
functor(C, Na, Ar). functor(C, Na, Ar).
@ -337,7 +337,7 @@ retractall(V) :- !,
'$retractall'(V,M). '$retractall'(V,M).
'$retractall'(V,M) :- var(V), !, '$retractall'(V,M) :- var(V), !,
throw(error(instantiation_error,retract(M:V))). '$do_error'(instantiation_error,retract(M:V)).
'$retractall'(M:V,_) :- !, '$retractall'(M:V,_) :- !,
'$retractall'(V,M). '$retractall'(V,M).
'$retractall'(T,M) :- '$retractall'(T,M) :-
@ -347,7 +347,7 @@ retractall(V) :- !,
'$retractall'(T,M) :- '$retractall'(T,M) :-
\+ '$is_dynamic'(T,M), !, \+ '$is_dynamic'(T,M), !,
functor(T,Na,Ar), 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) :- '$retractall'(T,M) :-
'$erase_all_clauses_for_dynamic'(T, M). '$erase_all_clauses_for_dynamic'(T, M).
@ -364,9 +364,9 @@ abolish(N,A) :-
'$abolish'(N,A,Mod). '$abolish'(N,A,Mod).
'$abolish'(N,A,M) :- var(N), !, '$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), !, '$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) :- '$abolish'(N,A,M) :-
( '$recorded'('$predicate_defs','$predicate_defs'(N,A,M,_),R) -> erase(R) ), ( '$recorded'('$predicate_defs','$predicate_defs'(N,A,M,_),R) -> erase(R) ),
fail. fail.
@ -396,9 +396,9 @@ abolish(X) :-
functor(T, Na, Ar), functor(T, Na, Ar),
'$undefined'(T, M), !. '$undefined'(T, M), !.
'$new_abolish'(Na/Ar, 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) :- '$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) :- '$abolish_all'(M) :-
'$current_predicate'(M,Na,Ar), '$current_predicate'(M,Na,Ar),
@ -414,49 +414,49 @@ abolish(X) :-
'$check_error_in_predicate_indicator'(V, Msg) :- '$check_error_in_predicate_indicator'(V, Msg) :-
var(V), !, var(V), !,
throw(error(instantiation_error, Msg)). '$do_error'(instantiation_error, Msg).
'$check_error_in_predicate_indicator'(M:S, Msg) :- !, '$check_error_in_predicate_indicator'(M:S, Msg) :- !,
'$check_error_in_module'(M, Msg), '$check_error_in_module'(M, Msg),
'$check_error_in_predicate_indicator'(S, Msg). '$check_error_in_predicate_indicator'(S, Msg).
'$check_error_in_predicate_indicator'(S, Msg) :- '$check_error_in_predicate_indicator'(S, Msg) :-
S \= _/_, !, S \= _/_, !,
throw(error(type_error(predicate_indicator,S), Msg)). '$do_error'(type_error(predicate_indicator,S), Msg).
'$check_error_in_predicate_indicator'(Na/_, Msg) :- '$check_error_in_predicate_indicator'(Na/_, Msg) :-
var(Na), !, var(Na), !,
throw(error(instantiation_error, Msg)). '$do_error'(instantiation_error, Msg).
'$check_error_in_predicate_indicator'(Na/_, Msg) :- '$check_error_in_predicate_indicator'(Na/_, Msg) :-
\+ atom(Na), !, \+ atom(Na), !,
throw(error(type_error(atom,Na), Msg)). '$do_error'(type_error(atom,Na), Msg).
'$check_error_in_predicate_indicator'(_/Ar, Msg) :- '$check_error_in_predicate_indicator'(_/Ar, Msg) :-
var(Ar), !, var(Ar), !,
throw(error(instantiation_error, Msg)). '$do_error'(instantiation_error, Msg).
'$check_error_in_predicate_indicator'(_/Ar, Msg) :- '$check_error_in_predicate_indicator'(_/Ar, Msg) :-
\+ integer(Ar), !, \+ integer(Ar), !,
throw(error(type_error(integer,Ar), Msg)). '$do_error'(type_error(integer,Ar), Msg).
'$check_error_in_predicate_indicator'(_/Ar, Msg) :- '$check_error_in_predicate_indicator'(_/Ar, Msg) :-
Ar < 0, !, 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! % not yet implemented!
%'$check_error_in_predicate_indicator'(Na/Ar, Msg) :- %'$check_error_in_predicate_indicator'(Na/Ar, Msg) :-
% Ar < maxarity, !, % 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) :- '$check_error_in_module'(M, Msg) :-
var(M), !, var(M), !,
throw(error(instantiation_error, Msg)). '$do_error'(instantiation_error, Msg).
'$check_error_in_module'(M, Msg) :- '$check_error_in_module'(M, Msg) :-
\+ atom(M), !, \+ atom(M), !,
throw(error(type_error(atom,M), Msg)). '$do_error'(type_error(atom,M), Msg).
'$old_abolish'(V,M) :- var(V), !, '$old_abolish'(V,M) :- var(V), !,
( '$access_yap_flags'(8, 1) -> ( '$access_yap_flags'(8, 1) ->
throw(error(instantiation_error,abolish(M:V))) '$do_error'(instantiation_error,abolish(M:V))
; ;
'$abolish_all_old'(M) '$abolish_all_old'(M)
). ).
'$old_abolish'(A,M) :- atom(A), !, '$old_abolish'(A,M) :- atom(A), !,
( '$access_yap_flags'(8, 1) -> ( '$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) '$abolish_all_atoms_old'(A,M)
). ).
@ -467,7 +467,7 @@ abolish(X) :-
'$old_abolish'(N/A, M) :- !, '$old_abolish'(N/A, M) :- !,
'$abolish'(N, A, M). '$abolish'(N, A, M).
'$old_abolish'(T, 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) :- '$abolish_all_old'(M) :-
'$current_predicate'(M, Na, Ar), '$current_predicate'(M, Na, Ar),
@ -487,7 +487,7 @@ abolish(X) :-
'$abolishs'(G, M) :- '$system_predicate'(G,M), !, '$abolishs'(G, M) :- '$system_predicate'(G,M), !,
functor(G,Name,Arity), 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) :- '$abolishs'(G, Module) :-
'$access_yap_flags'(8, 2), % only do this in sicstus mode '$access_yap_flags'(8, 2), % only do this in sicstus mode
'$undefined'(G, Module), '$undefined'(G, Module),
@ -499,7 +499,7 @@ abolish(X) :-
'$abolishs'(G, Module) :- '$abolishs'(G, Module) :-
'$has_yap_or', !, '$has_yap_or', !,
functor(G,A,N), 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) :- '$abolishs'(G, M) :-
'$purge_clauses'(G, M), '$purge_clauses'(G, M),
'$recordedp'(M:G,_,R), erase(R), fail. '$recordedp'(M:G,_,R), erase(R), fail.
@ -512,10 +512,10 @@ dynamic(X) :- '$access_yap_flags'(8, 0), !,
'$current_module'(M), '$current_module'(M),
'$dynamic'(X, M). '$dynamic'(X, M).
dynamic(X) :- dynamic(X) :-
throw(error(context_error(dynamic(X),declaration),query)). '$do_error'(context_error(dynamic(X),declaration),query).
'$dynamic'(X,M) :- var(X), !, '$dynamic'(X,M) :- var(X), !,
throw(error(instantiation_error,dynamic(M:X))). '$do_error'(instantiation_error,dynamic(M:X)).
'$dynamic'(Mod:Spec,_) :- !, '$dynamic'(Mod:Spec,_) :- !,
'$dynamic'(Spec,Mod). '$dynamic'(Spec,Mod).
'$dynamic'([], _) :- !. '$dynamic'([], _) :- !.
@ -532,10 +532,10 @@ dynamic(X) :-
'$is_dynamic'(T,Mod) -> true; '$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'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 ; 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) :- '$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), !, '$logical_updatable'(A/N,Mod) :- integer(N), atom(A), !,
@ -544,10 +544,10 @@ dynamic(X) :-
'$is_dynamic'(T,Mod) -> true; '$is_dynamic'(T,Mod) -> true;
F /\ 16'400 =:= 16'400 , '$undefined'(T,Mod) -> NF is F \/ 0x8, '$flags'(T,Mod,F,NF); F /\ 16'400 =:= 16'400 , '$undefined'(T,Mod) -> NF is F \/ 0x8, '$flags'(T,Mod,F,NF);
F /\ 16'8=:= 16'8 -> true ; 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) :- '$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) :- dynamic_predicate(P,Sem) :-
@ -561,10 +561,10 @@ dynamic_predicate(P,Sem) :-
'$bad_if_is_semantics'(Sem, Goal) :- '$bad_if_is_semantics'(Sem, Goal) :-
var(Sem), !, var(Sem), !,
throw(error(instantiation_error,Goal)). '$do_error'(instantiation_error,Goal).
'$bad_if_is_semantics'(Sem, Goal) :- '$bad_if_is_semantics'(Sem, Goal) :-
Sem \= immediate, Sem \= logical, !, 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) :- '$expand_clause'(C0,C1,C2,Mod) :-
@ -576,7 +576,7 @@ dynamic_predicate(P,Sem) :-
). ).
'$public'(X, _) :- var(X), !, '$public'(X, _) :- var(X), !,
throw(error(instantiation_error,public(X))). '$do_error'(instantiation_error,public(X)).
'$public'(Mod:Spec, _) :- !, '$public'(Mod:Spec, _) :- !,
'$public'(Spec,Mod). '$public'(Spec,Mod).
'$public'((A,B), M) :- !, '$public'(A,M), '$public'(B,M). '$public'((A,B), M) :- !, '$public'(A,M), '$public'(B,M).
@ -586,7 +586,7 @@ dynamic_predicate(P,Sem) :-
functor(T,A,N), functor(T,A,N),
'$do_make_public'(T, Mod). '$do_make_public'(T, Mod).
'$public'(X, 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) :- '$do_make_public'(T, Mod) :-
'$is_dynamic'(T, Mod), !. % all dynamic predicates are public. '$is_dynamic'(T, Mod), !. % all dynamic predicates are public.
@ -602,7 +602,7 @@ dynamic_predicate(P,Sem) :-
F\/16'400000 \== 0. F\/16'400000 \== 0.
hide_predicate(V) :- var(V), !, hide_predicate(V) :- var(V), !,
throw(error(instantiation_error,hide_predicate(X))). '$do_error'(instantiation_error,hide_predicate(X)).
hide_predicate(M:P) :- !, hide_predicate(M:P) :- !,
'$hide_predicate2'(P, M). '$hide_predicate2'(P, M).
hide_predicate(P) :- hide_predicate(P) :-
@ -610,12 +610,12 @@ hide_predicate(P) :-
'$hide_predicate2'(M, P). '$hide_predicate2'(M, P).
'$hide_predicate2'(V, M) :- var(V), !, '$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) :- !, '$hide_predicate2'(N/A, M) :- !,
functor(S,N,A), functor(S,N,A),
'$hide_predicate'(S, M) . '$hide_predicate'(S, M) .
'$hide_predicate2'(PredDesc, 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, !, profile_data(P, Parm, Data) :- P = M:D, !,
( (
var(M) -> 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) '$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'(B,T). '$check_list_for_bags'(B,T).
'$check_list_for_bags'(S, 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 whether a list of options is valid */
'$check_list_for_sockets'(V,G) :- var(V), !, '$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'([],_) :- !.
'$check_list_for_sockets'([_|T],G) :- !, '$check_list_for_sockets'([_|T],G) :- !,
  '$check_list_for_sockets'(T,G).   '$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'([], Fds, Fds).
'$select_cp_fds'([_-Fd|L], Fds0, [Fd|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) :- '$check_select_time'(V, _, _, Goal) :-
var(V), !, var(V), !,
throw(error(instantiation_error,Goal)). '$do_error'(instantiation_error,Goal).
'$check_select_time'(off, -1, -1, _). '$check_select_time'(off, -1, -1, _).
'$check_select_time'(Sec0:USec0, Sec, USec, _) :- '$check_select_time'(Sec0:USec0, Sec, USec, _) :-
Sec is Sec0, Sec is Sec0,
@ -68,7 +68,7 @@ socket_select(Socks, OutSocks, TimeOut, Streams, OutStreams) :-
socket_buffering(Sock, Flag, InSize, OutSize) :- socket_buffering(Sock, Flag, InSize, OutSize) :-
var(OutSize), OutSize \= InSize, !, 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) :- socket_buffering(Sock, Flag, InSize, OutSize) :-
'$convert_sock_buff'(OutSize, OutNumb), '$convert_sock_buff'(OutSize, OutNumb),
'$socket_buffering'(Sock, Flag, InNumb, OutNumb), '$socket_buffering'(Sock, Flag, InNumb, OutNumb),

18
pl/strict_iso.yap
View File

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

2
pl/tabling.yap
View File

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

2
pl/yapor.yap
View File

@ -70,7 +70,7 @@ default_sequential(_).
fail. fail.
'$parallel_directive'(X,M) :- var(X), !, '$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,B),M) :- !,
'$parallel_directive'(A,M), '$parallel_directive'(A,M),
'parallel_directive'(B,M). 'parallel_directive'(B,M).

138
pl/yio.yap
View File

@ -18,11 +18,11 @@
/* stream predicates */ /* stream predicates */
open(Source,M,T) :- var(Source), !, 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), !, 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), !, 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) :-
'$open'(File,Mode,Stream,0). '$open'(File,Mode,Stream,0).
@ -34,7 +34,7 @@ open(File,Mode,Stream) :-
*/ */
close(V) :- var(V), !, close(V) :- var(V), !,
throw(error(instantiation_error,close(V))). '$do_error'(instantiation_error,close(V)).
close(File) :- close(File) :-
atom(File), !, atom(File), !,
( (
@ -50,7 +50,7 @@ close(Stream) :-
'$close'(Stream). '$close'(Stream).
close(V,Opts) :- var(V), !, close(V,Opts) :- var(V), !,
throw(error(instantiation_error,close(V,Opts))). '$do_error'(instantiation_error,close(V,Opts)).
close(S,Opts) :- close(S,Opts) :-
'$check_io_opts'(Opts,close(S,Opts)), '$check_io_opts'(Opts,close(S,Opts)),
/* YAP ignores the force/1 flag */ /* YAP ignores the force/1 flag */
@ -63,11 +63,11 @@ open(F,T,S,Opts) :-
'$process_open_aliases'(Aliases,S). '$process_open_aliases'(Aliases,S).
'$open2'(Source,M,T,N) :- var(Source), !, '$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), !, '$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), !, '$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) :- '$open2'(File,Mode,Stream,N) :-
'$open'(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 whether a list of options is valid */
'$check_io_opts'(V,G) :- var(V), !, '$check_io_opts'(V,G) :- var(V), !,
throw(error(instantiation_error,G)). '$do_error'(instantiation_error,G).
'$check_io_opts'([],_) :- !. '$check_io_opts'([],_) :- !.
'$check_io_opts'([H|_],G) :- var(H), !, '$check_io_opts'([H|_],G) :- var(H), !,
throw(error(instantiation_error,G)). '$do_error'(instantiation_error,G).
'$check_io_opts'([Opt|T],G) :- !, '$check_io_opts'([Opt|T],G) :- !,
'$check_opt'(G,Opt,G), '$check_opt'(G,Opt,G),
'$check_io_opts'(T,G). '$check_io_opts'(T,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) :- !, '$check_opt'(close(_,_),Opt,G) :- !,
(Opt = force(X) -> (Opt = force(X) ->
'$check_force_opt_arg'(X,G) ; '$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) :- !,
'$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_opt_open'(eof_action(T), G) :- !,
'$check_open_eof_action_arg'(T, G). '$check_open_eof_action_arg'(T, G).
'$check_opt_open'(A, 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'(variables(_), _) :- !.
'$check_opt_read'(variable_names(_), _) :- !. '$check_opt_read'(variable_names(_), _) :- !.
@ -149,7 +149,7 @@ open(F,T,S,Opts) :-
'$check_read_syntax_errors_arg'(T, G). '$check_read_syntax_errors_arg'(T, G).
'$check_opt_read'(term_position(_), G) :- !. '$check_opt_read'(term_position(_), G) :- !.
'$check_opt_read'(A, 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'(file_name(_), _) :- !.
'$check_opt_sp'(mode(_), _) :- !. '$check_opt_sp'(mode(_), _) :- !.
@ -162,7 +162,7 @@ open(F,T,S,Opts) :-
'$check_opt_sp'(reposition(_), _) :- !. '$check_opt_sp'(reposition(_), _) :- !.
'$check_opt_sp'(type(_), _) :- !. '$check_opt_sp'(type(_), _) :- !.
'$check_opt_sp'(A, G) :- '$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_opt_write'(quoted(T), G) :- !,
'$check_write_quoted_arg'(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_opt_write'(max_depth(T), G) :- !,
'$check_write_max_depth'(T, G). '$check_write_max_depth'(T, G).
'$check_opt_write'(A, 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 arg
% %
'$check_force_opt_arg'(X,G) :- var(X), !, '$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'(true,_) :- !.
'$check_force_opt_arg'(false,_) :- !. '$check_force_opt_arg'(false,_) :- !.
'$check_force_opt_arg'(X,G) :- '$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), !, '$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'(text,_) :- !.
'$check_open_type_arg'(binary,_) :- !. '$check_open_type_arg'(binary,_) :- !.
'$check_open_opt_arg'(X,G) :- '$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), !, '$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'(true,_) :- !.
'$check_open_reposition_arg'(false,_) :- !. '$check_open_reposition_arg'(false,_) :- !.
'$check_open_reposition_arg'(X,G) :- '$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), !, '$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_open_alias_arg'(X,G) :- atom(X), !,
( '$check_if_valid_new_alias'(X), X \= user -> ( '$check_if_valid_new_alias'(X), X \= user ->
true ; 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) :- '$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), !, '$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'(error,_) :- !.
'$check_open_eof_action_arg'(eof_code,_) :- !. '$check_open_eof_action_arg'(eof_code,_) :- !.
'$check_open_eof_action_arg'(reset,_) :- !. '$check_open_eof_action_arg'(reset,_) :- !.
'$check_open_eof_action_arg'(X,G) :- '$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), !, '$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'(dec10,_) :- !.
'$check_read_syntax_errors_arg'(fail,_) :- !. '$check_read_syntax_errors_arg'(fail,_) :- !.
'$check_read_syntax_errors_arg'(error,_) :- !. '$check_read_syntax_errors_arg'(error,_) :- !.
'$check_read_syntax_errors_arg'(quiet,_) :- !. '$check_read_syntax_errors_arg'(quiet,_) :- !.
'$check_read_syntax_errors_arg'(X,G) :- '$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), !, '$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'(true,_) :- !.
'$check_write_quoted_arg'(false,_) :- !. '$check_write_quoted_arg'(false,_) :- !.
'$check_write_quoted_arg'(X,G) :- '$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), !, '$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'(true,_) :- !.
'$check_write_ignore_ops_arg'(false,_) :- !. '$check_write_ignore_ops_arg'(false,_) :- !.
'$check_write_ignore_ops_arg'(X,G) :- '$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), !, '$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'(true,_) :- !.
'$check_write_numbervars_arg'(false,_) :- !. '$check_write_numbervars_arg'(false,_) :- !.
'$check_write_numbervars_arg'(X,G) :- '$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), !, '$check_write_portrayed'(X, G) :- var(X), !,
throw(error(instantiation_error,G)). '$do_error'(instantiation_error,G).
'$check_write_portrayed'(true,_) :- !. '$check_write_portrayed'(true,_) :- !.
'$check_write_portrayed'(false,_) :- !. '$check_write_portrayed'(false,_) :- !.
'$check_write_portrayed'(X,G) :- '$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), !, '$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'(I,_) :- integer(I), I > 0, !.
'$check_write_max_depth'(X,G) :- '$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) :-
'$set_input'(Stream). '$set_input'(Stream).
@ -280,7 +280,7 @@ exists(F) :- '$exists'(F,read).
see(user) :- !, set_input(user_input). see(user) :- !, set_input(user_input).
see(F) :- var(F), !, see(F) :- var(F), !,
throw(error(instantiation_error,see(F))). '$do_error'(instantiation_error,see(F)).
see(F) :- current_input(Stream), see(F) :- current_input(Stream),
'$user_file_name'(Stream,F). '$user_file_name'(Stream,F).
see(F) :- current_stream(_,read,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(user) :- !, set_output(user_output).
tell(F) :- var(F), !, tell(F) :- var(F), !,
throw(error(instantiation_error,tell(F))). '$do_error'(instantiation_error,tell(F)).
tell(F) :- current_output(Stream), tell(F) :- current_output(Stream),
'$user_file_name'(Stream,F), !. '$user_file_name'(Stream,F), !.
tell(F) :- current_stream(_,write,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) :- get_byte(V) :-
\+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !, \+ 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) :- get_byte(V) :-
current_input(S), current_input(S),
'$get_byte'(S,V). '$get_byte'(S,V).
get_byte(S,V) :- get_byte(S,V) :-
\+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !, \+ 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) :-
'$get_byte'(S,V). '$get_byte'(S,V).
peek_byte(V) :- peek_byte(V) :-
\+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !, \+ 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) :- peek_byte(V) :-
current_input(S), current_input(S),
'$peek_byte'(S,V). '$peek_byte'(S,V).
peek_byte(S,V) :- peek_byte(S,V) :-
\+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !, \+ 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) :-
'$peek_byte'(S,V). '$peek_byte'(S,V).
get_char(V) :- get_char(V) :-
\+ var(V), \+ var(V),
( atom(V) -> atom_codes(V,[_,_|_]), V \= end_of_file ; true ), !, ( 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) :- get_char(V) :-
current_input(S), current_input(S),
'$get0'(S,I), '$get0'(S,I),
@ -560,7 +560,7 @@ get_char(V) :-
get_char(S,V) :- get_char(S,V) :-
\+ var(V), \+ var(V),
( atom(V) -> atom_codes(V,[_,_|_]), V \= end_of_file ; true ), !, ( 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) :- get_char(S,V) :-
'$get0'(S,I), '$get0'(S,I),
( I = -1 -> V = end_of_file ; atom_codes(V,[I])). ( I = -1 -> V = end_of_file ; atom_codes(V,[I])).
@ -568,7 +568,7 @@ get_char(S,V) :-
peek_char(V) :- peek_char(V) :-
\+ var(V), \+ var(V),
( atom(V) -> atom_codes(V,[_,_|_]), V \= end_of_file ; true ), !, ( 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) :- peek_char(V) :-
current_input(S), current_input(S),
'$peek'(S,I), '$peek'(S,I),
@ -577,89 +577,89 @@ peek_char(V) :-
peek_char(S,V) :- peek_char(S,V) :-
\+ var(V), \+ var(V),
( atom(V) -> atom_codes(V,[_,_|_]), V \= end_of_file ; true ), !, ( 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_char(S,V) :-
'$peek'(S,I), '$peek'(S,I),
( I = -1 -> V = end_of_file ; atom_codes(V,[I])). ( I = -1 -> V = end_of_file ; atom_codes(V,[I])).
get_code(S,V) :- get_code(S,V) :-
\+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !, \+ 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) :- get_code(S,V) :-
'$get0'(S,V). '$get0'(S,V).
get_code(V) :- get_code(V) :-
\+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !, \+ 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) :- get_code(V) :-
current_input(S), current_input(S),
'$get0'(S,V). '$get0'(S,V).
peek_code(S,V) :- peek_code(S,V) :-
\+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !, \+ 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_code(S,V) :-
'$peek'(S,V). '$peek'(S,V).
peek_code(V) :- peek_code(V) :-
\+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !, \+ 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) :- peek_code(V) :-
current_input(S), current_input(S),
'$peek'(S,V). '$peek'(S,V).
put_byte(V) :- var(V), !, put_byte(V) :- var(V), !,
throw(error(instantiation_error,put_byte(V))). '$do_error'(instantiation_error,put_byte(V)).
put_byte(V) :- put_byte(V) :-
(\+ integer(V) ; V < 0 ; V > 256), !, (\+ 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) :- put_byte(V) :-
current_output(S), current_output(S),
'$put_byte'(S,V). '$put_byte'(S,V).
put_byte(S,V) :- var(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) :- put_byte(S,V) :-
(\+ integer(V) ; V < 0 ; V > 256), !, (\+ 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_byte'(S,V). '$put_byte'(S,V).
put_char(V) :- var(V), !, put_char(V) :- var(V), !,
throw(error(instantiation_error,put_char(V))). '$do_error'(instantiation_error,put_char(V)).
put_char(V) :- put_char(V) :-
( atom(V) -> atom_codes(V,[_,_|_]) ; true ), !, ( 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) :- put_char(V) :-
current_output(S), current_output(S),
atom_codes(V,[I]), atom_codes(V,[I]),
'$put'(S,I). '$put'(S,I).
put_char(S,V) :- var(V), !, 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) :- put_char(S,V) :-
( atom(V) -> atom_codes(V,[_,_|_]) ; true ), !, ( 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) :- put_char(S,V) :-
atom_codes(V,[I]), atom_codes(V,[I]),
'$put'(S,I). '$put'(S,I).
put_code(V) :- var(V), !, put_code(V) :- var(V), !,
throw(error(instantiation_error,put_code(V))). '$do_error'(instantiation_error,put_code(V)).
put_code(V) :- put_code(V) :-
(\+ integer(V) ; V < 0 ; V > 256), !, (\+ 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) :- put_code(V) :-
current_output(S), current_output(S),
'$put'(S,V). '$put'(S,V).
put_code(S,V) :- var(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) :- put_code(S,V) :-
(\+ integer(V) ; V < 0 ; V > 256), !, (\+ 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_code(S,V) :-
'$put'(S,V). '$put'(S,V).
@ -768,7 +768,7 @@ stream_position(S,N,M) :-
set_stream_position(S,N) :- var(S), !, 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,N) :- !,
'$set_stream_position'(user_input,N). '$set_stream_position'(user_input,N).
set_stream_position(A,N) :- set_stream_position(A,N) :-
@ -789,7 +789,7 @@ stream_property(Stream, Props) :-
'$current_stream'(_,_,Stream), !, '$current_stream'(_,_,Stream), !,
'$stream_property'(Stream, Props). '$stream_property'(Stream, Props).
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'(file_name(_F)).
'$generate_prop'(mode(_M)). '$generate_prop'(mode(_M)).
@ -804,7 +804,7 @@ stream_property(Stream, Props) :-
'$stream_property'(Stream, Props) :- '$stream_property'(Stream, Props) :-
var(Props), !, var(Props), !,
throw(error(instantiation_error, stream_properties(Stream, Props))). '$do_error'(instantiation_error, stream_properties(Stream, Props)).
'$stream_property'(Stream, Props0) :- '$stream_property'(Stream, Props0) :-
'$check_stream_props'(Props0, Props), '$check_stream_props'(Props0, Props),
'$check_io_opts'(Props, stream_property(Stream, 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). consult_depth(LV) :- '$show_consult_level'(LV).
absolute_file_name(V,Out) :- var(V), !, 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(user,user) :- !.
absolute_file_name(RelFile,AbsFile) :- absolute_file_name(RelFile,AbsFile) :-
'$find_in_path'(RelFile,PathFile,absolute_file_name(RelFile,AbsFile)), '$find_in_path'(RelFile,PathFile,absolute_file_name(RelFile,AbsFile)),