Merge branch 'master' of ../yap-6.2
This commit is contained in:
Vítor Santos Costa
commit
f840ee307d
104
C/absmi.c
104
C/absmi.c
@ -792,7 +792,6 @@ Yap_absmi(int inp)
|
||||
noheapleft:
|
||||
{
|
||||
CELL cut_b = LCL0-(CELL *)(SREG[E_CB]);
|
||||
|
||||
#ifdef SHADOW_S
|
||||
S = SREG;
|
||||
#endif
|
||||
@ -2214,7 +2213,15 @@ Yap_absmi(int inp)
|
||||
|
||||
/* cut */
|
||||
Op(cut, e);
|
||||
PREG = NEXTOP(PREG, e);
|
||||
#ifdef COROUTINING
|
||||
if (FALSE) {
|
||||
CACHE_Y_AS_ENV(YREG);
|
||||
check_stack(NoStackCut, H);
|
||||
ENDCACHE_Y_AS_ENV();
|
||||
}
|
||||
do_cut:
|
||||
#endif
|
||||
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, e),Osbpp),l);
|
||||
{
|
||||
choiceptr d0;
|
||||
/* assume cut is always in stack */
|
||||
@ -2254,7 +2261,15 @@ Yap_absmi(int inp)
|
||||
/* cut_t */
|
||||
/* cut_t does the same as cut */
|
||||
Op(cut_t, e);
|
||||
PREG = NEXTOP(PREG, e);
|
||||
#ifdef COROUTINING
|
||||
if (FALSE) {
|
||||
CACHE_Y_AS_ENV(YREG);
|
||||
check_stack(NoStackCutT, H);
|
||||
ENDCACHE_Y_AS_ENV();
|
||||
}
|
||||
do_cut_t:
|
||||
#endif
|
||||
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, e),Osbpp),l);
|
||||
{
|
||||
choiceptr d0;
|
||||
|
||||
@ -2309,7 +2324,15 @@ Yap_absmi(int inp)
|
||||
|
||||
/* cut_e */
|
||||
Op(cut_e, e);
|
||||
PREG = NEXTOP(PREG, e);
|
||||
#ifdef COROUTINING
|
||||
if (FALSE) {
|
||||
CACHE_Y_AS_ENV(YREG);
|
||||
check_stack(NoStackCutE, H);
|
||||
ENDCACHE_Y_AS_ENV();
|
||||
}
|
||||
do_cut_e:
|
||||
#endif
|
||||
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, e),Osbpp),l);
|
||||
{
|
||||
choiceptr d0;
|
||||
/* we assume dealloc leaves in S the previous env */
|
||||
@ -2511,6 +2534,7 @@ Yap_absmi(int inp)
|
||||
PP = PREG->u.pp.p0;
|
||||
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
|
||||
ASP = YREG+E_CB;
|
||||
SREG = YENV;
|
||||
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
|
||||
ASP = (CELL *)PROTECT_FROZEN_B(B);
|
||||
goto noheapleft;
|
||||
@ -2666,6 +2690,7 @@ Yap_absmi(int inp)
|
||||
SREG = (CELL *) PREG->u.Osbpp.p;
|
||||
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
|
||||
ASP = (CELL *) (((char *) YREG) + PREG->u.Osbpp.s);
|
||||
SREG = YENV;
|
||||
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
|
||||
ASP = (CELL *)PROTECT_FROZEN_B(B);
|
||||
goto noheapleft;
|
||||
@ -2702,7 +2727,9 @@ Yap_absmi(int inp)
|
||||
/*
|
||||
don't do a creep here; also, if our instruction is followed by
|
||||
a execute_c, just wait a bit more */
|
||||
if (ActiveSignals & YAP_CREEP_SIGNAL ||
|
||||
if ( (ActiveSignals & YAP_CREEP_SIGNAL &&
|
||||
/* keep on going if there is something else */
|
||||
!(ActiveSignals & ~YAP_CREEP_SIGNAL)) ||
|
||||
(PREG->opc != Yap_opcode(_procceed) &&
|
||||
PREG->opc != Yap_opcode(_cut_e))) {
|
||||
GONext();
|
||||
@ -2740,6 +2767,66 @@ Yap_absmi(int inp)
|
||||
|
||||
#ifdef COROUTINING
|
||||
|
||||
/* This is easier: I know there is an environment so I cannot do allocate */
|
||||
NoStackCut:
|
||||
/* find something to fool S */
|
||||
if (!ActiveSignals || ActiveSignals & YAP_CDOVF_SIGNAL) {
|
||||
goto do_cut;
|
||||
}
|
||||
if (ActiveSignals & YAP_FAIL_SIGNAL) {
|
||||
ActiveSignals &= ~YAP_FAIL_SIGNAL;
|
||||
if (!ActiveSignals)
|
||||
CreepFlag = CalculateStackGap();
|
||||
FAIL();
|
||||
}
|
||||
if (!(ActiveSignals & YAP_CREEP_SIGNAL)) {
|
||||
SREG = (CELL *)PredRestoreRegs;
|
||||
XREGS[0] = MkIntegerTerm(LCL0-(CELL *)YREG[E_CB]);
|
||||
PREG = NEXTOP(PREG,e);
|
||||
goto creep_either;
|
||||
}
|
||||
/* don't do debugging and friends here */
|
||||
goto do_cut;
|
||||
|
||||
NoStackCutT:
|
||||
/* find something to fool S */
|
||||
if (!ActiveSignals || ActiveSignals & YAP_CDOVF_SIGNAL) {
|
||||
goto do_cut_t;
|
||||
}
|
||||
if (ActiveSignals & YAP_FAIL_SIGNAL) {
|
||||
ActiveSignals &= ~YAP_FAIL_SIGNAL;
|
||||
if (!ActiveSignals)
|
||||
CreepFlag = CalculateStackGap();
|
||||
FAIL();
|
||||
}
|
||||
if (!(ActiveSignals & YAP_CREEP_SIGNAL)) {
|
||||
SREG = (CELL *)PredRestoreRegs;
|
||||
XREGS[0] = MkIntegerTerm(LCL0-(CELL *)SREG[E_CB]);
|
||||
PREG = NEXTOP(PREG,e);
|
||||
goto creep_either;
|
||||
}
|
||||
/* don't do debugging and friends here */
|
||||
goto do_cut_t;
|
||||
|
||||
NoStackCutE:
|
||||
if (!ActiveSignals || ActiveSignals & YAP_CDOVF_SIGNAL) {
|
||||
goto do_cut_t;
|
||||
}
|
||||
if (ActiveSignals & YAP_FAIL_SIGNAL) {
|
||||
ActiveSignals &= ~YAP_FAIL_SIGNAL;
|
||||
if (!ActiveSignals)
|
||||
CreepFlag = CalculateStackGap();
|
||||
FAIL();
|
||||
}
|
||||
if (!(ActiveSignals & YAP_CREEP_SIGNAL)) {
|
||||
SREG = (CELL *)PredRestoreRegs;
|
||||
XREGS[0] = MkIntegerTerm(LCL0-(CELL *)SREG[E_CB]);
|
||||
PREG = NEXTOP(PREG,e);
|
||||
goto creep_either;
|
||||
}
|
||||
/* don't do debugging and friends here */
|
||||
goto do_cut_e;
|
||||
|
||||
/* This is easier: I know there is an environment so I cannot do allocate */
|
||||
NoStackCommitY:
|
||||
PP = PREG->u.yp.p0;
|
||||
@ -2754,7 +2841,7 @@ Yap_absmi(int inp)
|
||||
FAIL();
|
||||
}
|
||||
if (!(ActiveSignals & YAP_CREEP_SIGNAL)) {
|
||||
SREG = (CELL *)RepPredProp(Yap_GetPredPropByFunc(FunctorRestoreRegs,0));
|
||||
SREG = (CELL *)PredRestoreRegs;
|
||||
XREGS[0] = YREG[PREG->u.yp.y];
|
||||
PREG = NEXTOP(PREG,yp);
|
||||
goto creep_either;
|
||||
@ -2776,7 +2863,7 @@ Yap_absmi(int inp)
|
||||
FAIL();
|
||||
}
|
||||
if (!(ActiveSignals & YAP_CREEP_SIGNAL)) {
|
||||
SREG = (CELL *)RepPredProp(Yap_GetPredPropByFunc(FunctorRestoreRegs,0));
|
||||
SREG = (CELL *)PredRestoreRegs;
|
||||
#if USE_THREADED_CODE
|
||||
if (PREG->opc == (OPCODE)OpAddress[_fcall])
|
||||
#else
|
||||
@ -2840,6 +2927,7 @@ Yap_absmi(int inp)
|
||||
ASP = (CELL *) (((char *) YREG) + PREG->u.Osbpp.s);
|
||||
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
|
||||
ASP = (CELL *)PROTECT_FROZEN_B(B);
|
||||
SREG = YENV;
|
||||
goto noheapleft;
|
||||
}
|
||||
if (ActiveSignals) {
|
||||
@ -2963,6 +3051,7 @@ Yap_absmi(int inp)
|
||||
ASP = YREG+E_CB;
|
||||
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
|
||||
ASP = (CELL *)PROTECT_FROZEN_B(B);
|
||||
SREG = YENV;
|
||||
goto noheapleft;
|
||||
}
|
||||
if (ActiveSignals)
|
||||
@ -14472,6 +14561,7 @@ Yap_absmi(int inp)
|
||||
if (ActiveSignals) {
|
||||
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
|
||||
UNLOCK(SignalLock);
|
||||
SREG = YENV;
|
||||
goto noheapleft;
|
||||
}
|
||||
UNLOCK(SignalLock);
|
||||
|
||||
3
C/agc.c
3
C/agc.c
@ -143,6 +143,7 @@ static Term AdjustDBTerm(Term, Term *);
|
||||
#define OpcodeAdjust(P) (P)
|
||||
#define ModuleAdjust(P) (P)
|
||||
#define ExternalFunctionAdjust(P) (P)
|
||||
#define DBRecordAdjust(P) (P)
|
||||
#define PredEntryAdjust(P) (P)
|
||||
#define ModEntryPtrAdjust(P) (P)
|
||||
#define AtomEntryAdjust(P) (P)
|
||||
@ -200,6 +201,8 @@ static Term AdjustDBTerm(Term, Term *);
|
||||
|
||||
#include "rheap.h"
|
||||
|
||||
|
||||
|
||||
static void
|
||||
RestoreHashPreds(void)
|
||||
{
|
||||
|
||||
26
C/alloc.c
26
C/alloc.c
@ -1595,15 +1595,29 @@ Yap_ExtendWorkSpaceThroughHole(UInt s)
|
||||
WorkSpaceTop = WorkSpaceTop0;
|
||||
return -1;
|
||||
}
|
||||
#endif
|
||||
#elif SIZEOF_INT_P==8
|
||||
{
|
||||
int n = 1024*1024;
|
||||
while (n) {
|
||||
/* progress 1 MB */
|
||||
WorkSpaceTop += 512*1024;
|
||||
if (ExtendWorkSpace(s, MAP_FIXED)) {
|
||||
Yap_add_memory_hole((ADDR)WorkSpaceTop0, (ADDR)WorkSpaceTop-s);
|
||||
Yap_ErrorMessage = NULL;
|
||||
return WorkSpaceTop-WorkSpaceTop0;
|
||||
}
|
||||
#if defined(_WIN32)
|
||||
/* 487 happens when you step over someone else's memory */
|
||||
if (GetLastError() != 487) {
|
||||
WorkSpaceTop = WorkSpaceTop0;
|
||||
return -1;
|
||||
}
|
||||
#endif
|
||||
}
|
||||
#endif
|
||||
}
|
||||
WorkSpaceTop = WorkSpaceTop0;
|
||||
#endif
|
||||
if (ExtendWorkSpace(s, 0)) {
|
||||
Yap_add_memory_hole((ADDR)WorkSpaceTop0, (ADDR)WorkSpaceTop-s);
|
||||
Yap_ErrorMessage = NULL;
|
||||
return WorkSpaceTop-WorkSpaceTop0;
|
||||
}
|
||||
#endif
|
||||
return -1;
|
||||
}
|
||||
|
||||
@ -3397,8 +3397,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
|
||||
code_p = a_cnp(_native_me, code_p, pass_no, cip);
|
||||
break;
|
||||
case cutexit_op:
|
||||
code_p = a_cut(&clinfo, code_p, pass_no, cip);
|
||||
if (cip->CurrentPred->PredFlags & LogUpdatePredFlag &&
|
||||
if (cip->CurrentPred->PredFlags & LogUpdatePredFlag &&
|
||||
(*clause_has_blobsp || *clause_has_dbtermp) &&
|
||||
!clinfo.alloc_found)
|
||||
code_p = a_cle(_alloc_for_logical_pred, code_p, pass_no, cip);
|
||||
@ -3409,7 +3408,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
|
||||
!clinfo.alloc_found)
|
||||
code_p = a_e(_unlock_lu, code_p, pass_no);
|
||||
#endif
|
||||
code_p = a_pl(_procceed, cip->CurrentPred, code_p, pass_no);
|
||||
code_p = a_cut(&clinfo, code_p, pass_no, cip);
|
||||
break;
|
||||
case allocate_op:
|
||||
clinfo.alloc_found = 2;
|
||||
|
||||
@ -1413,8 +1413,13 @@ YAP_Execute(PredEntry *pe, CPredicate exec_code)
|
||||
if (pe->PredFlags & SWIEnvPredFlag) {
|
||||
CPredicateV codev = (CPredicateV)exec_code;
|
||||
struct foreign_context ctx;
|
||||
UInt i;
|
||||
Int sl = 0;
|
||||
ctx.engine = NULL;
|
||||
return ((codev)((&ARG1)-LCL0,0,&ctx));
|
||||
for (i=pe->ArityOfPE; i > 0; i--) {
|
||||
sl = Yap_InitSlot(XREGS[i]);
|
||||
}
|
||||
return ((codev)(sl,0,&ctx));
|
||||
}
|
||||
if (pe->PredFlags & CArgsPredFlag) {
|
||||
Int out = execute_cargs(pe, exec_code);
|
||||
@ -3147,20 +3152,77 @@ YAP_FileDescriptorFromStream(Term t)
|
||||
X_API void *
|
||||
YAP_Record(Term t)
|
||||
{
|
||||
|
||||
return (void *)Yap_StoreTermInDB(Deref(t), 0);
|
||||
DBTerm *dbterm;
|
||||
DBRecordList *dbt;
|
||||
|
||||
dbterm = Yap_StoreTermInDB(Deref(t), 0);
|
||||
if (dbterm == NULL)
|
||||
return NULL;
|
||||
dbt = (struct record_list *)Yap_AllocCodeSpace(sizeof(struct record_list));
|
||||
while (dbt == NULL) {
|
||||
if (!Yap_growheap(FALSE, sizeof(struct record_list), NULL)) {
|
||||
/* be a good neighbor */
|
||||
Yap_FreeCodeSpace((void *)dbterm);
|
||||
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "using YAP_Record");
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
if (Yap_Records) {
|
||||
Yap_Records->prev_rec = dbt;
|
||||
}
|
||||
dbt->next_rec = Yap_Records;
|
||||
dbt->prev_rec = NULL;
|
||||
dbt->dbrecord = dbterm;
|
||||
Yap_Records = dbt;
|
||||
return dbt;
|
||||
}
|
||||
|
||||
X_API Term
|
||||
YAP_Recorded(void *handle)
|
||||
{
|
||||
return Yap_FetchTermFromDB((DBTerm *)handle);
|
||||
Term t;
|
||||
DBTerm *dbterm = ((DBRecordList *)handle)->dbrecord;
|
||||
|
||||
BACKUP_MACHINE_REGS();
|
||||
do {
|
||||
Yap_Error_TYPE = YAP_NO_ERROR;
|
||||
t = Yap_FetchTermFromDB(dbterm);
|
||||
if (Yap_Error_TYPE == YAP_NO_ERROR) {
|
||||
RECOVER_MACHINE_REGS();
|
||||
return t;
|
||||
} else if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
|
||||
Yap_Error_TYPE = YAP_NO_ERROR;
|
||||
if (!Yap_growglobal(NULL)) {
|
||||
Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage);
|
||||
RECOVER_MACHINE_REGS();
|
||||
return FALSE;
|
||||
}
|
||||
} else {
|
||||
Yap_Error_TYPE = YAP_NO_ERROR;
|
||||
if (!Yap_growstack(dbterm->NOfCells*CellSize)) {
|
||||
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
|
||||
RECOVER_MACHINE_REGS();
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
} while (t == (CELL)0);
|
||||
RECOVER_MACHINE_REGS();
|
||||
return t;
|
||||
}
|
||||
|
||||
X_API int
|
||||
YAP_Erase(void *handle)
|
||||
{
|
||||
Yap_ReleaseTermFromDB((DBTerm *)handle);
|
||||
DBRecordList *dbr = (DBRecordList *)handle;
|
||||
Yap_ReleaseTermFromDB(dbr->dbrecord);
|
||||
if (dbr->next_rec)
|
||||
dbr->next_rec->prev_rec = dbr->prev_rec;
|
||||
if (dbr->prev_rec)
|
||||
dbr->next_rec->prev_rec = dbr->next_rec;
|
||||
else if (Yap_Records == dbr) {
|
||||
Yap_Records = dbr->next_rec;
|
||||
}
|
||||
Yap_FreeCodeSpace(handle);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
@ -918,6 +918,7 @@ split_megaclause(PredEntry *ap)
|
||||
}
|
||||
return;
|
||||
}
|
||||
break;
|
||||
}
|
||||
Yap_ClauseSpace += sizeof(StaticClause)+mcl->ClItemSize+(UInt)NEXTOP((yamop *)NULL,p);
|
||||
new->ClFlags = StaticMask|FactMask;
|
||||
|
||||
@ -1495,12 +1495,19 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
|
||||
PELOCK(42,cglobs->cint.CurrentPred);
|
||||
if (is_tabled(cglobs->cint.CurrentPred)) {
|
||||
Yap_emit_3ops(cut_op, Zero, Zero, Zero, &cglobs->cint);
|
||||
/* needs to adjust previous commits */
|
||||
Yap_emit(empty_call_op, Zero, Zero, &cglobs->cint);
|
||||
Yap_emit(restore_tmps_and_skip_op, Zero, Zero, &cglobs->cint);
|
||||
Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint);
|
||||
}
|
||||
else
|
||||
#endif /* TABLING */
|
||||
{
|
||||
Yap_emit_3ops(cutexit_op, Zero, Zero, Zero, &cglobs->cint);
|
||||
/* needs to adjust previous commits */
|
||||
Yap_emit(empty_call_op, Zero, Zero, &cglobs->cint);
|
||||
Yap_emit(restore_tmps_and_skip_op, Zero, Zero, &cglobs->cint);
|
||||
Yap_emit(procceed_op, Zero, Zero, &cglobs->cint);
|
||||
}
|
||||
#ifdef TABLING
|
||||
UNLOCK(cglobs->cint.CurrentPred->PELock);
|
||||
@ -1509,6 +1516,8 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
|
||||
else {
|
||||
Yap_emit_3ops(cut_op, Zero, Zero, Zero, &cglobs->cint);
|
||||
/* needs to adjust previous commits */
|
||||
Yap_emit(empty_call_op, Zero, Zero, &cglobs->cint);
|
||||
Yap_emit(restore_tmps_and_skip_op, Zero, Zero, &cglobs->cint);
|
||||
adjust_current_commits(cglobs);
|
||||
}
|
||||
return;
|
||||
|
||||
15
C/index.c
15
C/index.c
@ -2430,18 +2430,15 @@ count_consts(GroupDef *grp)
|
||||
static UInt
|
||||
count_blobs(GroupDef *grp)
|
||||
{
|
||||
Term current = MkAtomTerm(AtomFoundVar);
|
||||
UInt i = 0;
|
||||
ClauseDef *cl = grp->FirstClause;
|
||||
UInt i = 1;
|
||||
ClauseDef *cl = grp->FirstClause+1;
|
||||
Term current = grp->FirstClause->Tag;
|
||||
|
||||
while (TRUE) {
|
||||
while (cl <= grp->LastClause) {
|
||||
if (current != cl->Tag) {
|
||||
i++;
|
||||
current = cl->Tag;
|
||||
}
|
||||
if (cl == grp->LastClause) {
|
||||
return i;
|
||||
}
|
||||
cl++;
|
||||
}
|
||||
return i;
|
||||
@ -3224,7 +3221,7 @@ do_dbref_index(ClauseDef *min, ClauseDef* max, Term t, struct intermediates *cin
|
||||
Yap_emit(label_op, labl, Zero, cint);
|
||||
Yap_emit(index_dbref_op, Zero, Zero, cint);
|
||||
sort_group(group,(CELL *)(group+1),cint);
|
||||
do_blobs(group, t, cint, argno, first, fail_l, clleft, (CELL *)group+1);
|
||||
do_blobs(group, t, cint, argno, first, fail_l, clleft, (CELL *)(group+1));
|
||||
return labl;
|
||||
}
|
||||
}
|
||||
@ -3261,7 +3258,7 @@ do_blob_index(ClauseDef *min, ClauseDef* max, Term t, struct intermediates *cint
|
||||
else
|
||||
Yap_emit(index_long_op, Zero, Zero, cint);
|
||||
sort_group(group,(CELL *)(group+1),cint);
|
||||
do_blobs(group, t, cint, argno, first, fail_l, clleft, (CELL *)group+1);
|
||||
do_blobs(group, t, cint, argno, first, fail_l, clleft, (CELL *)(group+1));
|
||||
return labl;
|
||||
}
|
||||
}
|
||||
|
||||
23
C/iopreds.c
23
C/iopreds.c
@ -827,12 +827,16 @@ IOSWIPutc(int sno, int ch)
|
||||
static int
|
||||
IOSWIGetc(int sno)
|
||||
{
|
||||
int i;
|
||||
int ch;
|
||||
Yap_StartSlots();
|
||||
i = (SWIGetc)(Stream[sno].u.swi_stream.swi_ptr);
|
||||
ch = (SWIGetc)(Stream[sno].u.swi_stream.swi_ptr);
|
||||
if (ch == EOF) {
|
||||
return post_process_eof(Stream+sno);
|
||||
}
|
||||
return post_process_read_char(ch, Stream+sno);
|
||||
Yap_CloseSlots();
|
||||
YENV = ENV;
|
||||
return i;
|
||||
return ch;
|
||||
}
|
||||
|
||||
/* static */
|
||||
@ -851,12 +855,16 @@ IOSWIWidePutc(int sno, int ch)
|
||||
static int
|
||||
IOSWIWideGetc(int sno)
|
||||
{
|
||||
int i;
|
||||
int ch;
|
||||
Yap_StartSlots();
|
||||
i = (SWIWideGetc)(Stream[sno].u.swi_stream.swi_ptr);
|
||||
ch = (SWIWideGetc)(Stream[sno].u.swi_stream.swi_ptr);
|
||||
if (ch == EOF) {
|
||||
return post_process_eof(Stream+sno);
|
||||
}
|
||||
return post_process_read_char(ch, Stream+sno);
|
||||
Yap_CloseSlots();
|
||||
YENV = ENV;
|
||||
return i;
|
||||
return ch;
|
||||
}
|
||||
|
||||
#if USE_SOCKET
|
||||
@ -4759,6 +4767,9 @@ StreamPosition(int sno)
|
||||
Term sargs[5];
|
||||
Int cpos;
|
||||
cpos = Stream[sno].charcount;
|
||||
if (Stream[sno].status & SWI_Stream_f) {
|
||||
return Yap_get_stream_position(Stream[sno].u.swi_stream.swi_ptr);
|
||||
}
|
||||
if (Stream[sno].stream_getc == PlUnGetc) {
|
||||
cpos--;
|
||||
}
|
||||
|
||||
15
C/save.c
15
C/save.c
@ -1691,6 +1691,20 @@ UnmarkTrEntries(void)
|
||||
|
||||
int in_limbo = FALSE;
|
||||
|
||||
/* cleanup any records we had in the saved state. They are now inaccessible */
|
||||
static void
|
||||
FreeRecords(void) {
|
||||
struct record_list *ptr;
|
||||
|
||||
ptr = Yap_Records;
|
||||
Yap_Records = NULL;
|
||||
while (ptr) {
|
||||
struct record_list *optr = ptr;
|
||||
Yap_ReleaseTermFromDB(ptr->dbrecord);
|
||||
ptr = ptr->next_rec;
|
||||
Yap_FreeCodeSpace((void *)optr);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* This function is called when wanting only to restore the heap and
|
||||
@ -1748,6 +1762,7 @@ Restore(char *s, char *lib_dir)
|
||||
Yap_InitPreAllocCodeSpace();
|
||||
}
|
||||
#endif
|
||||
FreeRecords();
|
||||
CloseRestore();
|
||||
if (which_save == 2) {
|
||||
Yap_unify(ARG2, MkIntTerm(0));
|
||||
|
||||
@ -636,10 +636,6 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
|
||||
char *sp0 = sp;
|
||||
char cbuff = ch;
|
||||
|
||||
if (yap_flags[STRICT_ISO_FLAG] && ch == 'E') {
|
||||
Yap_ErrorMessage = "Float format not allowed in ISO mode";
|
||||
return TermNil;
|
||||
}
|
||||
if (--max_size == 0) {
|
||||
Yap_ErrorMessage = "Number Too Long";
|
||||
return TermNil;
|
||||
@ -721,6 +717,9 @@ Yap_scan_num(int (*Nxtch) (int))
|
||||
return TermNil;
|
||||
}
|
||||
ch = Nxtch(-1);
|
||||
while (chtype(ch) == BS) {
|
||||
ch = Nxtch(-1);
|
||||
}
|
||||
if (ch == '-') {
|
||||
sign = -1;
|
||||
ch = Nxtch(-1);
|
||||
|
||||
@ -172,6 +172,8 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
|
||||
LOCK(Yap_heap_regs->low_level_trace_lock);
|
||||
sc = Yap_heap_regs;
|
||||
vsc_count++;
|
||||
if (vsc_count==29)
|
||||
jmp_deb(1);
|
||||
#ifdef THREADS
|
||||
MY_ThreadHandle.thread_inst_count++;
|
||||
#endif
|
||||
|
||||
2
H/Yap.h
2
H/Yap.h
@ -268,6 +268,8 @@ extern char Yap_Option[20];
|
||||
#define MMAP_ADDR 0x200000000
|
||||
#elif defined(__APPLE__) && !__LP64__
|
||||
#define MMAP_ADDR 0x20000000
|
||||
#elif defined(__powerpc__)
|
||||
#define MMAP_ADDR 0x20000000
|
||||
#else
|
||||
#define MMAP_ADDR 0x10000000
|
||||
#endif
|
||||
|
||||
@ -29,6 +29,7 @@ typedef int (*SWI_GetWideFunction)(void *);
|
||||
typedef int (*SWI_CloseFunction)(void *);
|
||||
typedef int (*SWI_FlushFunction)(void *);
|
||||
typedef int (*SWI_PLGetStreamFunction)(void *);
|
||||
typedef int (*SWI_PLGetStreamPositionFunction)(void *);
|
||||
|
||||
#include "../include/dswiatoms.h"
|
||||
|
||||
@ -94,6 +95,12 @@ typedef struct scratch_block_struct {
|
||||
UInt sz, msz;
|
||||
} scratch_block;
|
||||
|
||||
typedef struct record_list {
|
||||
/* a list of dbterms associated with a clause */
|
||||
struct DB_TERM *dbrecord;
|
||||
struct record_list *next_rec, *prev_rec;
|
||||
} DBRecordList;
|
||||
|
||||
typedef struct restore_info {
|
||||
Int base_diff;
|
||||
Int cl_diff;
|
||||
|
||||
@ -462,6 +462,7 @@ void STD_PROTO(Yap_InitMYDDAS_TopLevelPreds,(void));
|
||||
void STD_PROTO(Yap_swi_install,(void));
|
||||
void STD_PROTO(Yap_InitSWIHash,(void));
|
||||
int STD_PROTO(Yap_get_stream_handle,(Term, int, int, void *));
|
||||
Term STD_PROTO(Yap_get_stream_position,(void *));
|
||||
|
||||
/* ypsocks.c */
|
||||
void STD_PROTO(Yap_InitSockets,(void));
|
||||
|
||||
@ -188,6 +188,7 @@
|
||||
#define SWIClose Yap_global->swi_close
|
||||
#define SWIFlush Yap_global->swi_flush
|
||||
#define SWIGetStream Yap_global->swi_get_stream_f
|
||||
#define SWIGetStreamPosition Yap_global->swi_get_stream_position_f
|
||||
|
||||
#define Yap_AllowLocalExpansion Yap_global->allow_local_expansion
|
||||
#define Yap_AllowGlobalExpansion Yap_global->allow_global_expansion
|
||||
|
||||
@ -133,6 +133,7 @@
|
||||
#define PredHandleThrow Yap_heap_regs->pred_handle_throw
|
||||
#define PredIs Yap_heap_regs->pred_is
|
||||
#define PredSafeCallCleanup Yap_heap_regs->pred_safe_call_cleanup
|
||||
#define PredRestoreRegs Yap_heap_regs->pred_restore_regs
|
||||
#ifdef YAPOR
|
||||
#define PredGetwork Yap_heap_regs->pred_getwork
|
||||
#define PredGetworkSeq Yap_heap_regs->pred_getwork_seq
|
||||
@ -297,6 +298,8 @@
|
||||
#define ForeignCodeTop Yap_heap_regs->foreign_code_top
|
||||
#define ForeignCodeMax Yap_heap_regs->foreign_code_max
|
||||
|
||||
#define Yap_Records Yap_heap_regs->yap_records
|
||||
|
||||
#define SWI_Atoms Yap_heap_regs->swi_atoms
|
||||
#define SWI_Functors Yap_heap_regs->swi_functors
|
||||
#define SWI_ReverseHash Yap_heap_regs->swi_reverse_hash
|
||||
|
||||
@ -190,6 +190,7 @@ typedef struct worker_shared {
|
||||
SWI_CloseFunction swi_close;
|
||||
SWI_FlushFunction swi_flush;
|
||||
SWI_PLGetStreamFunction swi_get_stream_f;
|
||||
SWI_PLGetStreamPositionFunction swi_get_stream_position_f;
|
||||
|
||||
int allow_local_expansion;
|
||||
int allow_global_expansion;
|
||||
|
||||
@ -133,6 +133,7 @@
|
||||
struct pred_entry *pred_handle_throw;
|
||||
struct pred_entry *pred_is;
|
||||
struct pred_entry *pred_safe_call_cleanup;
|
||||
struct pred_entry *pred_restore_regs;
|
||||
#ifdef YAPOR
|
||||
struct pred_entry *pred_getwork;
|
||||
struct pred_entry *pred_getwork_seq;
|
||||
@ -297,6 +298,8 @@
|
||||
ADDR foreign_code_top;
|
||||
ADDR foreign_code_max;
|
||||
|
||||
struct record_list *yap_records;
|
||||
|
||||
Atom swi_atoms[N_SWI_ATOMS];
|
||||
Functor swi_functors[N_SWI_FUNCTORS];
|
||||
struct swi_reverse_hash swi_reverse_hash[N_SWI_HASH];
|
||||
|
||||
@ -188,6 +188,7 @@ static void InitGlobal(void) {
|
||||
Yap_global->swi_close = NULL;
|
||||
Yap_global->swi_flush = NULL;
|
||||
Yap_global->swi_get_stream_f = NULL;
|
||||
Yap_global->swi_get_stream_position_f = NULL;
|
||||
|
||||
Yap_global->allow_local_expansion = TRUE;
|
||||
Yap_global->allow_global_expansion = TRUE;
|
||||
|
||||
@ -133,6 +133,7 @@
|
||||
Yap_heap_regs->pred_handle_throw = RepPredProp(PredPropByFunc(FunctorHandleThrow,PROLOG_MODULE));
|
||||
Yap_heap_regs->pred_is = RepPredProp(PredPropByFunc(FunctorIs,PROLOG_MODULE));
|
||||
Yap_heap_regs->pred_safe_call_cleanup = RepPredProp(PredPropByFunc(FunctorSafeCallCleanup,PROLOG_MODULE));
|
||||
Yap_heap_regs->pred_restore_regs = RepPredProp(PredPropByFunc(FunctorRestoreRegs,PROLOG_MODULE));
|
||||
#ifdef YAPOR
|
||||
Yap_heap_regs->pred_getwork = RepPredProp(PredPropByAtom(AtomGetwork,PROLOG_MODULE));
|
||||
Yap_heap_regs->pred_getwork_seq = RepPredProp(PredPropByAtom(AtomGetworkSeq,PROLOG_MODULE));
|
||||
@ -297,6 +298,8 @@
|
||||
Yap_heap_regs->foreign_code_top = NULL;
|
||||
Yap_heap_regs->foreign_code_max = NULL;
|
||||
|
||||
Yap_heap_regs->yap_records = NULL;
|
||||
|
||||
InitSWIAtoms();
|
||||
|
||||
|
||||
|
||||
@ -199,6 +199,7 @@ static void RestoreGlobal(void) {
|
||||
|
||||
|
||||
|
||||
|
||||
#if HAVE_LIBREADLINE
|
||||
|
||||
|
||||
|
||||
15
H/rheap.h
15
H/rheap.h
@ -983,6 +983,21 @@ RestoreForeignCode(void)
|
||||
}
|
||||
}
|
||||
|
||||
static void
|
||||
RestoreYapRecords(void)
|
||||
{
|
||||
struct record_list *ptr;
|
||||
|
||||
Yap_Records = DBRecordAdjust(Yap_Records);
|
||||
ptr = Yap_Records;
|
||||
while (ptr) {
|
||||
ptr->next_rec = DBRecordAdjust(ptr->next_rec);
|
||||
ptr->prev_rec = DBRecordAdjust(ptr->prev_rec);
|
||||
ptr->dbrecord = DBTermAdjust(ptr->dbrecord);
|
||||
RestoreDBTerm(ptr->dbrecord, FALSE);
|
||||
}
|
||||
}
|
||||
|
||||
static void
|
||||
RestoreBallTerm(int wid)
|
||||
{
|
||||
|
||||
@ -133,6 +133,7 @@
|
||||
Yap_heap_regs->pred_handle_throw = PtoPredAdjust(Yap_heap_regs->pred_handle_throw);
|
||||
Yap_heap_regs->pred_is = PtoPredAdjust(Yap_heap_regs->pred_is);
|
||||
Yap_heap_regs->pred_safe_call_cleanup = PtoPredAdjust(Yap_heap_regs->pred_safe_call_cleanup);
|
||||
Yap_heap_regs->pred_restore_regs = PtoPredAdjust(Yap_heap_regs->pred_restore_regs);
|
||||
#ifdef YAPOR
|
||||
Yap_heap_regs->pred_getwork = PtoPredAdjust(Yap_heap_regs->pred_getwork);
|
||||
Yap_heap_regs->pred_getwork_seq = PtoPredAdjust(Yap_heap_regs->pred_getwork_seq);
|
||||
@ -297,6 +298,8 @@
|
||||
|
||||
|
||||
|
||||
RestoreYapRecords();
|
||||
|
||||
RestoreSWIAtoms();
|
||||
|
||||
|
||||
|
||||
10
H/sshift.h
10
H/sshift.h
@ -309,6 +309,16 @@ HoldEntryAdjust (HoldEntry * ptr)
|
||||
return (HoldEntry *) (((HoldEntry *) (CharP (ptr) + HDiff)));
|
||||
}
|
||||
|
||||
inline EXTERN struct record_list *DBRecordAdjust (struct record_list *);
|
||||
|
||||
inline EXTERN struct record_list *
|
||||
DBRecordAdjust (struct record_list * ptr)
|
||||
{
|
||||
if (!ptr)
|
||||
return ptr;
|
||||
return (struct record_list *) (CharP (ptr) + HDiff);
|
||||
}
|
||||
|
||||
|
||||
#if USE_OFFSETS
|
||||
|
||||
|
||||
14
Makefile.in
14
Makefile.in
@ -28,7 +28,7 @@ INCLUDEDIR=$(ROOTDIR)/include/Yap
|
||||
#
|
||||
INFODIR=$(SHAREDIR)/info
|
||||
#
|
||||
# where to store documentaion files
|
||||
# where to store documentation files
|
||||
#
|
||||
DOCSDIR=$(SHAREDIR)/doc/Yap
|
||||
|
||||
@ -96,6 +96,7 @@ TEXI2DVI=texi2dvi
|
||||
TEXI2HTML=texi2html
|
||||
TEXI2PDF=texi2pdf
|
||||
YAPLIB=@YAPLIB@
|
||||
SONAMEFLAG=@SONAMEFLAG@
|
||||
|
||||
#4.1VPATH=@srcdir@:@srcdir@/OPTYap
|
||||
CWD=$(PWD)
|
||||
@ -539,7 +540,7 @@ libYap.a: $(LIB_OBJECTS)
|
||||
$(RANLIB) libYap.a
|
||||
|
||||
@DYNYAPLIB@: $(LIB_OBJECTS)
|
||||
@YAPLIB_LD@ -o @YAPLIB@ $(LIB_OBJECTS) $(LIBS) $(LDFLAGS)
|
||||
@YAPLIB_LD@ -o @YAPLIB@ $(LIB_OBJECTS) $(LIBS) $(LDFLAGS) $(SONAMEFLAG)
|
||||
|
||||
install: install_bin install_data
|
||||
|
||||
@ -635,7 +636,11 @@ install_library: @YAPLIB@
|
||||
mkdir -p $(DESTDIR)$(INCLUDEDIR)
|
||||
for h in $(HEADERS); do $(INSTALL) $$h $(DESTDIR)$(INCLUDEDIR); done
|
||||
|
||||
install_data:
|
||||
install_data: install_copied_files install_bin
|
||||
@ENABLE_CHR@ (cd packages/chr ; $(MAKE) install)
|
||||
@ENABLE_CHR@ (cd packages/clpqr ; $(MAKE) install)
|
||||
|
||||
install_copied_files:
|
||||
(cd library ; $(MAKE) install)
|
||||
(cd packages/swi-minisat2; $(MAKE) install)
|
||||
(cd LGPL ; $(MAKE) install)
|
||||
@ -646,9 +651,6 @@ install_data:
|
||||
(cd packages/CLPBN ; $(MAKE) install)
|
||||
(cd packages/meld; $(MAKE) install)
|
||||
(cd packages/ProbLog ; $(MAKE) install)
|
||||
@ENABLE_CHR@ (cd packages/chr ; $(MAKE) install)
|
||||
@ENABLE_CHR@ (cd packages/clpqr ; $(MAKE) install)
|
||||
|
||||
|
||||
##########
|
||||
TAGS: $(C_SOURCES) $(PL_SOURCES) $(HEADERS)
|
||||
|
||||
15
configure
vendored
15
configure
vendored
@ -643,6 +643,7 @@ ENABLE_CLPQR
|
||||
ENABLE_CHR
|
||||
NO_BUILTIN_REGEXP
|
||||
YAP_EXTRAS
|
||||
SONAMEFLAG
|
||||
DYNYAPLIB
|
||||
YAPLIB
|
||||
EXTRA_LIBS_FOR_SWIDLLS
|
||||
@ -6932,6 +6933,7 @@ fi
|
||||
fi
|
||||
LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)"
|
||||
DYNYAPLIB=libYap."$SO"
|
||||
SONAMEFLAG="-Wl,-soname=$DYNYAPLIB"
|
||||
fi
|
||||
if test "$have_nsl" = yes
|
||||
then
|
||||
@ -6961,6 +6963,7 @@ fi
|
||||
INSTALL_DLLS=""
|
||||
LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)"
|
||||
DYNYAPLIB=libYap."$SO"
|
||||
SONAMEFLAG=""
|
||||
EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-R,\$(YAPLIBDIR) -Wl,-R,\$(LIBDIR)"
|
||||
PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)"
|
||||
INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
|
||||
@ -7004,6 +7007,7 @@ fi
|
||||
fi
|
||||
LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)"
|
||||
DYNYAPLIB=libYap."$SO"
|
||||
SONAMEFLAG=""
|
||||
EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-R,\$(YAPLIBDIR) -Wl,-R,\$(LIBDIR)"
|
||||
PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)"
|
||||
INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
|
||||
@ -7017,6 +7021,7 @@ fi
|
||||
#INSTALL_DLLS=""
|
||||
LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)"
|
||||
DYNYAPLIB=libYap."$SO"
|
||||
SONAMEFLAG=""
|
||||
EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-R,\$(YAPLIBDIR) -Wl,\$(LIBDIR)"
|
||||
PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)"
|
||||
INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
|
||||
@ -7073,6 +7078,7 @@ fi
|
||||
fi
|
||||
LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)"
|
||||
DYNYAPLIB=libYap."$SO"
|
||||
SONAMEFLAG=""
|
||||
EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-R,\$(YAPLIBDIR) -Wl,-R,\$(LIBDIR)"
|
||||
PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)"
|
||||
INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
|
||||
@ -7087,6 +7093,7 @@ fi
|
||||
INSTALL_DLLS=""
|
||||
LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)"
|
||||
DYNYAPLIB=libYap."$SO"
|
||||
SONAMEFLAG=""
|
||||
EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-R,\$(YAPLIBDIR) -Wl,-R,\$(LIBDIR)"
|
||||
PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)"
|
||||
INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
|
||||
@ -7164,7 +7171,8 @@ fi
|
||||
fi
|
||||
CC="$CC -fstrict-aliasing -freorder-blocks -fsched-interblock -Wall -Wstrict-aliasing=2"
|
||||
DYNYAPLIB=libYap."$SO"
|
||||
YAPLIB_LD="$CC -dynamiclib -Wl,-install_name,$prefix/lib/libYap.dylib"
|
||||
SONAMEFLAG=""
|
||||
YAPLIB_LD="$CC -dynamiclib -Wl,-install_name,$prefix/lib/libYap.$SO"
|
||||
PRE_INSTALL_ENV="DYLD_LIBRARY_PATH=\$(abs_top_builddir)"
|
||||
;;
|
||||
*netbsd*|*openbsd*|*freebsd*|*dragonfly*)
|
||||
@ -7187,6 +7195,7 @@ fi
|
||||
fi
|
||||
LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR)"
|
||||
DYNYAPLIB=libYap."$SO"
|
||||
SONAMEFLAG="-Wl,--soname=$DYNYAPLIB"
|
||||
EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -Wl,-R,\$(YAPLIBDIR)"
|
||||
PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)"
|
||||
INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
|
||||
@ -7203,6 +7212,7 @@ fi
|
||||
INSTALL_DLLS=""
|
||||
LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)"
|
||||
DYNYAPLIB=libYap."$SO"
|
||||
SONAMEFLAG="-Wl,--soname=$DYNYAPLIB"
|
||||
if test "$dynamic_loading" = "yes"
|
||||
then
|
||||
YAPLIB_LD="\$(CC)"
|
||||
@ -7221,6 +7231,7 @@ fi
|
||||
# and -fomit-frame-point -DBP_FREE
|
||||
YAPLIB="yap.dll"
|
||||
DYNYAPLIB="yap.dll"
|
||||
SONAMEFLAG=""
|
||||
SHLIB_CFLAGS="$CFLAGS"
|
||||
SHLIB_CXXFLAGS="$CXXFLAGS"
|
||||
if test "$target_win64" = no
|
||||
@ -7300,6 +7311,7 @@ fi
|
||||
fi
|
||||
LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)"
|
||||
DYNYAPLIB=libYap."$SO"
|
||||
SONAMEFLAG=""
|
||||
EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-R,\$(YAPLIBDIR) -Wl,-R,\$(LIBDIR)"
|
||||
PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)"
|
||||
INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
|
||||
@ -8442,6 +8454,7 @@ fi
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for gcc threaded code" >&5
|
||||
|
||||
14
configure.in
14
configure.in
@ -915,6 +915,7 @@ case "$target_os" in
|
||||
fi
|
||||
LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)"
|
||||
DYNYAPLIB=libYap."$SO"
|
||||
SONAMEFLAG="-Wl,-soname=$DYNYAPLIB"
|
||||
fi
|
||||
if test "$have_nsl" = yes
|
||||
then
|
||||
@ -944,6 +945,7 @@ case "$target_os" in
|
||||
INSTALL_DLLS=""
|
||||
LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)"
|
||||
DYNYAPLIB=libYap."$SO"
|
||||
SONAMEFLAG=""
|
||||
EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-R,\$(YAPLIBDIR) -Wl,-R,\$(LIBDIR)"
|
||||
PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)"
|
||||
INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
|
||||
@ -983,6 +985,7 @@ case "$target_os" in
|
||||
fi
|
||||
LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)"
|
||||
DYNYAPLIB=libYap."$SO"
|
||||
SONAMEFLAG=""
|
||||
EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-R,\$(YAPLIBDIR) -Wl,-R,\$(LIBDIR)"
|
||||
PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)"
|
||||
INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
|
||||
@ -996,6 +999,7 @@ case "$target_os" in
|
||||
#INSTALL_DLLS=""
|
||||
LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)"
|
||||
DYNYAPLIB=libYap."$SO"
|
||||
SONAMEFLAG=""
|
||||
EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-R,\$(YAPLIBDIR) -Wl,\$(LIBDIR)"
|
||||
PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)"
|
||||
INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
|
||||
@ -1014,6 +1018,7 @@ dnl Linux has both elf and a.out, in this case we found elf
|
||||
fi
|
||||
LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)"
|
||||
DYNYAPLIB=libYap."$SO"
|
||||
SONAMEFLAG=""
|
||||
EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-R,\$(YAPLIBDIR) -Wl,-R,\$(LIBDIR)"
|
||||
PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)"
|
||||
INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
|
||||
@ -1028,6 +1033,7 @@ dnl Linux has both elf and a.out, in this case we found elf
|
||||
INSTALL_DLLS=""
|
||||
LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)"
|
||||
DYNYAPLIB=libYap."$SO"
|
||||
SONAMEFLAG=""
|
||||
EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-R,\$(YAPLIBDIR) -Wl,-R,\$(LIBDIR)"
|
||||
PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)"
|
||||
INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
|
||||
@ -1066,7 +1072,8 @@ dnl Linux has both elf and a.out, in this case we found elf
|
||||
fi
|
||||
CC="$CC -fstrict-aliasing -freorder-blocks -fsched-interblock -Wall -Wstrict-aliasing=2"
|
||||
DYNYAPLIB=libYap."$SO"
|
||||
YAPLIB_LD="$CC -dynamiclib -Wl,-install_name,$prefix/lib/libYap.dylib"
|
||||
SONAMEFLAG=""
|
||||
YAPLIB_LD="$CC -dynamiclib -Wl,-install_name,$prefix/lib/libYap.$SO"
|
||||
PRE_INSTALL_ENV="DYLD_LIBRARY_PATH=\$(abs_top_builddir)"
|
||||
;;
|
||||
*netbsd*|*openbsd*|*freebsd*|*dragonfly*)
|
||||
@ -1089,6 +1096,7 @@ dnl Linux has both elf and a.out, in this case we found elf
|
||||
fi
|
||||
LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR)"
|
||||
DYNYAPLIB=libYap."$SO"
|
||||
SONAMEFLAG="-Wl,--soname=$DYNYAPLIB"
|
||||
EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -Wl,-R,\$(YAPLIBDIR)"
|
||||
PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)"
|
||||
INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
|
||||
@ -1105,6 +1113,7 @@ dnl Linux has both elf and a.out, in this case we found elf
|
||||
INSTALL_DLLS=""
|
||||
LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)"
|
||||
DYNYAPLIB=libYap."$SO"
|
||||
SONAMEFLAG="-Wl,--soname=$DYNYAPLIB"
|
||||
if test "$dynamic_loading" = "yes"
|
||||
then
|
||||
YAPLIB_LD="\$(CC)"
|
||||
@ -1123,6 +1132,7 @@ dnl Linux has both elf and a.out, in this case we found elf
|
||||
# and -fomit-frame-point -DBP_FREE
|
||||
YAPLIB="yap.dll"
|
||||
DYNYAPLIB="yap.dll"
|
||||
SONAMEFLAG=""
|
||||
SHLIB_CFLAGS="$CFLAGS"
|
||||
SHLIB_CXXFLAGS="$CXXFLAGS"
|
||||
if test "$target_win64" = no
|
||||
@ -1163,6 +1173,7 @@ dnl Linux has both elf and a.out, in this case we found elf
|
||||
fi
|
||||
LDFLAGS="$LDFLAGS -L\$(abs_top_builddir) -Wl,-R,\$(LIBDIR) -Wl,-R,\$(YAPLIBDIR)"
|
||||
DYNYAPLIB=libYap."$SO"
|
||||
SONAMEFLAG=""
|
||||
EXTRA_LIBS_FOR_DLLS="$EXTRA_LIBS_FOR_DLLS -L\$(abs_top_builddir) -lYap -Wl,-R,\$(YAPLIBDIR) -Wl,-R,\$(LIBDIR)"
|
||||
PRE_INSTALL_ENV="LD_LIBRARY_PATH=\$(abs_top_builddir)"
|
||||
INSTALL_ENV="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR):\$(DESTDIR)\$(YAPLIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
|
||||
@ -1469,6 +1480,7 @@ dnl objects in YAP library
|
||||
AC_SUBST(YAPLIB)
|
||||
AC_SUBST(DYNYAPLIB)
|
||||
AC_SUBST(LDFLAGS)
|
||||
AC_SUBST(SONAMEFLAG)
|
||||
dnl install_info
|
||||
AC_SUBST(INSTALL_INFO)
|
||||
dnl let YAP_EXTRAS fall through configure, from the env into Makefile
|
||||
|
||||
14
docs/yap.tex
14
docs/yap.tex
@ -1,4 +1,4 @@
|
||||
<EFBFBD>a\input texinfo @c -*- mode: texinfo; coding: latin-1; -*-
|
||||
\input texinfo @c -*- mode: texinfo; coding: latin-1; -*-
|
||||
|
||||
@c %**start of header
|
||||
@setfilename yap.info
|
||||
@ -9267,6 +9267,18 @@ Succeeds if @var{Set3} unifies with the intersection of @var{Set1} and
|
||||
need not be ordered.
|
||||
@end table
|
||||
|
||||
@item subtract(+@var{Set}, +@var{Delete}, ?@var{Result})
|
||||
@findex subtract/3
|
||||
@syindex subtract/3
|
||||
@cnindex subtract/3
|
||||
Delete all elements from @var{Set} that occur in @var{Delete} (a set)
|
||||
and unify the result with @var{Result}. Deletion is based on
|
||||
unification using @code{memberchk/2}. The complexity is
|
||||
@code{|Delete|*|Set|}.
|
||||
|
||||
See @code{ord_subtract/3}.
|
||||
@end table
|
||||
|
||||
@node LineUtilities, MapList, Lists, Library
|
||||
@section Line Manipulation Utilities
|
||||
@cindex Line Utilities Library
|
||||
|
||||
@ -699,6 +699,7 @@ typedef struct SWI_IO {
|
||||
void *flush_s;
|
||||
void *close_s;
|
||||
void *get_stream_handle;
|
||||
void *get_stream_position;
|
||||
} swi_io_struct;
|
||||
|
||||
/* SWI stream info */
|
||||
|
||||
@ -77,6 +77,8 @@ PROGRAMS= \
|
||||
$(srcdir)/wundgraphs.yap \
|
||||
$(srcdir)/lam_mpi.yap \
|
||||
$(srcdir)/ypp.yap \
|
||||
$(srcdir)/c_alarms.yap \
|
||||
$(srcdir)/flags.yap \
|
||||
$(srcdir)/block_diagram.yap
|
||||
|
||||
MYDDAS_PROGRAMS= $(srcdir)/MYDDAS/myddas.ypp \
|
||||
|
||||
397
library/c_alarms.yap
Normal file
397
library/c_alarms.yap
Normal file
@ -0,0 +1,397 @@
|
||||
%%% -*- Mode: Prolog; -*-
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
%
|
||||
% Concurrent alarms was developed at Katholieke Universiteit Leuven
|
||||
%
|
||||
% Copyright 2010
|
||||
% Katholieke Universiteit Leuven
|
||||
%
|
||||
% Contributions to this file:
|
||||
% Author: Theofrastos Mantadelis
|
||||
% $Date: 2011-02-01 18:36:41 +0100 (Tue, 01 Feb 2011) $
|
||||
% $Revision: 7 $
|
||||
% Contributions: The timer implementation is inspired by Bernd Gutmann's timers
|
||||
%
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
%
|
||||
% Artistic License 2.0
|
||||
%
|
||||
% Copyright (c) 2000-2006, The Perl Foundation.
|
||||
%
|
||||
% Everyone is permitted to copy and distribute verbatim copies of this
|
||||
% license document, but changing it is not allowed. Preamble
|
||||
%
|
||||
% This license establishes the terms under which a given free software
|
||||
% Package may be copied, modified, distributed, and/or
|
||||
% redistributed. The intent is that the Copyright Holder maintains some
|
||||
% artistic control over the development of that Package while still
|
||||
% keeping the Package available as open source and free software.
|
||||
%
|
||||
% You are always permitted to make arrangements wholly outside of this
|
||||
% license directly with the Copyright Holder of a given Package. If the
|
||||
% terms of this license do not permit the full use that you propose to
|
||||
% make of the Package, you should contact the Copyright Holder and seek
|
||||
% a different licensing arrangement. Definitions
|
||||
%
|
||||
% "Copyright Holder" means the individual(s) or organization(s) named in
|
||||
% the copyright notice for the entire Package.
|
||||
%
|
||||
% "Contributor" means any party that has contributed code or other
|
||||
% material to the Package, in accordance with the Copyright Holder's
|
||||
% procedures.
|
||||
%
|
||||
% "You" and "your" means any person who would like to copy, distribute,
|
||||
% or modify the Package.
|
||||
%
|
||||
% "Package" means the collection of files distributed by the Copyright
|
||||
% Holder, and derivatives of that collection and/or of those files. A
|
||||
% given Package may consist of either the Standard Version, or a
|
||||
% Modified Version.
|
||||
%
|
||||
% "Distribute" means providing a copy of the Package or making it
|
||||
% accessible to anyone else, or in the case of a company or
|
||||
% organization, to others outside of your company or organization.
|
||||
%
|
||||
% "Distributor Fee" means any fee that you charge for Distributing this
|
||||
% Package or providing support for this Package to another party. It
|
||||
% does not mean licensing fees.
|
||||
%
|
||||
% "Standard Version" refers to the Package if it has not been modified,
|
||||
% or has been modified only in ways explicitly requested by the
|
||||
% Copyright Holder.
|
||||
%
|
||||
% "Modified Version" means the Package, if it has been changed, and such
|
||||
% changes were not explicitly requested by the Copyright Holder.
|
||||
%
|
||||
% "Original License" means this Artistic License as Distributed with the
|
||||
% Standard Version of the Package, in its current version or as it may
|
||||
% be modified by The Perl Foundation in the future.
|
||||
%
|
||||
% "Source" form means the source code, documentation source, and
|
||||
% configuration files for the Package.
|
||||
%
|
||||
% "Compiled" form means the compiled bytecode, object code, binary, or
|
||||
% any other form resulting from mechanical transformation or translation
|
||||
% of the Source form.
|
||||
%
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
%
|
||||
% Permission for Use and Modification Without Distribution
|
||||
%
|
||||
% (1) You are permitted to use the Standard Version and create and use
|
||||
% Modified Versions for any purpose without restriction, provided that
|
||||
% you do not Distribute the Modified Version.
|
||||
%
|
||||
% Permissions for Redistribution of the Standard Version
|
||||
%
|
||||
% (2) You may Distribute verbatim copies of the Source form of the
|
||||
% Standard Version of this Package in any medium without restriction,
|
||||
% either gratis or for a Distributor Fee, provided that you duplicate
|
||||
% all of the original copyright notices and associated disclaimers. At
|
||||
% your discretion, such verbatim copies may or may not include a
|
||||
% Compiled form of the Package.
|
||||
%
|
||||
% (3) You may apply any bug fixes, portability changes, and other
|
||||
% modifications made available from the Copyright Holder. The resulting
|
||||
% Package will still be considered the Standard Version, and as such
|
||||
% will be subject to the Original License.
|
||||
%
|
||||
% Distribution of Modified Versions of the Package as Source
|
||||
%
|
||||
% (4) You may Distribute your Modified Version as Source (either gratis
|
||||
% or for a Distributor Fee, and with or without a Compiled form of the
|
||||
% Modified Version) provided that you clearly document how it differs
|
||||
% from the Standard Version, including, but not limited to, documenting
|
||||
% any non-standard features, executables, or modules, and provided that
|
||||
% you do at least ONE of the following:
|
||||
%
|
||||
% (a) make the Modified Version available to the Copyright Holder of the
|
||||
% Standard Version, under the Original License, so that the Copyright
|
||||
% Holder may include your modifications in the Standard Version. (b)
|
||||
% ensure that installation of your Modified Version does not prevent the
|
||||
% user installing or running the Standard Version. In addition, the
|
||||
% modified Version must bear a name that is different from the name of
|
||||
% the Standard Version. (c) allow anyone who receives a copy of the
|
||||
% Modified Version to make the Source form of the Modified Version
|
||||
% available to others under (i) the Original License or (ii) a license
|
||||
% that permits the licensee to freely copy, modify and redistribute the
|
||||
% Modified Version using the same licensing terms that apply to the copy
|
||||
% that the licensee received, and requires that the Source form of the
|
||||
% Modified Version, and of any works derived from it, be made freely
|
||||
% available in that license fees are prohibited but Distributor Fees are
|
||||
% allowed.
|
||||
%
|
||||
% Distribution of Compiled Forms of the Standard Version or
|
||||
% Modified Versions without the Source
|
||||
%
|
||||
% (5) You may Distribute Compiled forms of the Standard Version without
|
||||
% the Source, provided that you include complete instructions on how to
|
||||
% get the Source of the Standard Version. Such instructions must be
|
||||
% valid at the time of your distribution. If these instructions, at any
|
||||
% time while you are carrying out such distribution, become invalid, you
|
||||
% must provide new instructions on demand or cease further
|
||||
% distribution. If you provide valid instructions or cease distribution
|
||||
% within thirty days after you become aware that the instructions are
|
||||
% invalid, then you do not forfeit any of your rights under this
|
||||
% license.
|
||||
%
|
||||
% (6) You may Distribute a Modified Version in Compiled form without the
|
||||
% Source, provided that you comply with Section 4 with respect to the
|
||||
% Source of the Modified Version.
|
||||
%
|
||||
% Aggregating or Linking the Package
|
||||
%
|
||||
% (7) You may aggregate the Package (either the Standard Version or
|
||||
% Modified Version) with other packages and Distribute the resulting
|
||||
% aggregation provided that you do not charge a licensing fee for the
|
||||
% Package. Distributor Fees are permitted, and licensing fees for other
|
||||
% components in the aggregation are permitted. The terms of this license
|
||||
% apply to the use and Distribution of the Standard or Modified Versions
|
||||
% as included in the aggregation.
|
||||
%
|
||||
% (8) You are permitted to link Modified and Standard Versions with
|
||||
% other works, to embed the Package in a larger work of your own, or to
|
||||
% build stand-alone binary or bytecode versions of applications that
|
||||
% include the Package, and Distribute the result without restriction,
|
||||
% provided the result does not expose a direct interface to the Package.
|
||||
%
|
||||
% Items That are Not Considered Part of a Modified Version
|
||||
%
|
||||
% (9) Works (including, but not limited to, modules and scripts) that
|
||||
% merely extend or make use of the Package, do not, by themselves, cause
|
||||
% the Package to be a Modified Version. In addition, such works are not
|
||||
% considered parts of the Package itself, and are not subject to the
|
||||
% terms of this license.
|
||||
%
|
||||
% General Provisions
|
||||
%
|
||||
% (10) Any use, modification, and distribution of the Standard or
|
||||
% Modified Versions is governed by this Artistic License. By using,
|
||||
% modifying or distributing the Package, you accept this license. Do not
|
||||
% use, modify, or distribute the Package, if you do not accept this
|
||||
% license.
|
||||
%
|
||||
% (11) If your Modified Version has been derived from a Modified Version
|
||||
% made by someone other than you, you are nevertheless required to
|
||||
% ensure that your Modified Version complies with the requirements of
|
||||
% this license.
|
||||
%
|
||||
% (12) This license does not grant you the right to use any trademark,
|
||||
% service mark, tradename, or logo of the Copyright Holder.
|
||||
%
|
||||
% (13) This license includes the non-exclusive, worldwide,
|
||||
% free-of-charge patent license to make, have made, use, offer to sell,
|
||||
% sell, import and otherwise transfer the Package with respect to any
|
||||
% patent claims licensable by the Copyright Holder that are necessarily
|
||||
% infringed by the Package. If you institute patent litigation
|
||||
% (including a cross-claim or counterclaim) against any party alleging
|
||||
% that the Package constitutes direct or contributory patent
|
||||
% infringement, then this Artistic License to you shall terminate on the
|
||||
% date that such litigation is filed.
|
||||
%
|
||||
% (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT
|
||||
% HOLDER AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED
|
||||
% WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A
|
||||
% PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT
|
||||
% PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT
|
||||
% HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT,
|
||||
% INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE
|
||||
% OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
%
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
|
||||
:- module(c_alarms, [set_alarm/3,
|
||||
unset_alarm/1,
|
||||
time_out_call_once/3,
|
||||
timer_start/1,
|
||||
timer_restart/1,
|
||||
timer_stop/2,
|
||||
timer_elapsed/2,
|
||||
timer_pause/2]).
|
||||
|
||||
% set_alarm(+Seconds, +Execute, -ID)
|
||||
% calls Executes after a time interval of Seconds
|
||||
% ID is returned to be able to unset the alarm (the call will not be executed)
|
||||
% set_alarm/3 supports multiple & nested settings of alarms.
|
||||
% Known Bug: There is the case that an alarm might trigger +-1 second of the set time.
|
||||
%
|
||||
% unset_alarm(+ID)
|
||||
% It will unschedule the alarm.
|
||||
% It will not affect other concurrent alarms.
|
||||
%
|
||||
% time_out_call(+Seconds, +Goal, -Return)
|
||||
% It will will execute the closure Goal and returns its success or failure at Return.
|
||||
% If the goal times out in Seconds then Return = timeout.
|
||||
|
||||
:- use_module(library(lists), [member/2, memberchk/2, delete/3]).
|
||||
:- use_module(library(ordsets), [ord_add_element/3]).
|
||||
:- use_module(library(apply_macros), [maplist/3]).
|
||||
|
||||
:- dynamic('$timer'/3).
|
||||
|
||||
:- meta_predicate(set_alarm(+, 0, -)).
|
||||
:- meta_predicate(time_out_call_once(+, 0, -)).
|
||||
:- meta_predicate(prove_once(0)).
|
||||
|
||||
:- initialization(local_init).
|
||||
|
||||
local_init:-
|
||||
bb_put(alarms, []),
|
||||
bb_put(identity, 0).
|
||||
|
||||
get_next_identity(ID):-
|
||||
bb_get(identity, ID),
|
||||
NID is ID + 1,
|
||||
bb_put(identity, NID).
|
||||
|
||||
set_alarm(Seconds, Execute, ID):-
|
||||
bb_get(alarms, []),
|
||||
get_next_identity(ID), !,
|
||||
bb_put(alarms, [alarm(Seconds, ID, Execute)]),
|
||||
alarm(Seconds, alarm_handler, _).
|
||||
set_alarm(Seconds, Execute, ID):-
|
||||
get_next_identity(ID), !,
|
||||
bb_get(alarms, [alarm(CurrentSeconds, CurrentID, CurrentExecute)|Alarms]),
|
||||
alarm(0, true, Remaining),
|
||||
Elapsed is CurrentSeconds - Remaining - 1,
|
||||
maplist(subtract(Elapsed), [alarm(CurrentSeconds, CurrentID, CurrentExecute)|Alarms], RemainingAlarms),
|
||||
ord_add_element(RemainingAlarms, alarm(Seconds, ID, Execute), [alarm(NewSeconds, NewID, NewToExecute)|NewAlarms]),
|
||||
bb_put(alarms, [alarm(NewSeconds, NewID, NewToExecute)|NewAlarms]),
|
||||
alarm(NewSeconds, alarm_handler, _).
|
||||
set_alarm(Seconds, Execute, ID):-
|
||||
throw(error(permission_error(create, alarm, set_alarm(Seconds, Execute, ID)), 'Non permitted alarm identifier.')).
|
||||
|
||||
subtract(Elapsed, alarm(Seconds, ID, Execute), alarm(NewSeconds, ID, Execute)):-
|
||||
NewSeconds is Seconds - Elapsed.
|
||||
|
||||
unset_alarm(ID):-
|
||||
\+ ground(ID),
|
||||
throw(error(instantiation_error, 'Alarm ID needs to be instantiated.')).
|
||||
unset_alarm(ID):-
|
||||
bb_get(alarms, Alarms),
|
||||
\+ memberchk(alarm(_Seconds, ID, _Execute), Alarms),
|
||||
throw(error(existence_error(alarm, unset_alarm(ID)), 'Alarm does not exist.')).
|
||||
unset_alarm(ID):-
|
||||
alarm(0, true, Remaining),
|
||||
bb_get(alarms, Alarms),
|
||||
[alarm(Seconds, _, _)|_] = Alarms,
|
||||
Elapsed is Seconds - Remaining - 1,
|
||||
delete_alarm(Alarms, ID, NewAlarms),
|
||||
bb_put(alarms, NewAlarms),
|
||||
(NewAlarms = [alarm(NewSeconds, _, _)|_] ->
|
||||
RemainingSeconds is NewSeconds - Elapsed,
|
||||
alarm(RemainingSeconds, alarm_handler, _)
|
||||
;
|
||||
true
|
||||
).
|
||||
|
||||
delete_alarm(Alarms, ID, NewAlarms):-
|
||||
memberchk(alarm(Seconds, ID, Execute), Alarms),
|
||||
delete(Alarms, alarm(Seconds, ID, Execute), NewAlarms).
|
||||
|
||||
alarm_handler:-
|
||||
bb_get(alarms, [alarm(_, _, CurrentExecute)|[]]),
|
||||
bb_put(alarms, []),
|
||||
call(CurrentExecute).
|
||||
alarm_handler:-
|
||||
bb_get(alarms, [alarm(Elapsed, CurrentID, CurrentExecute)|Alarms]),
|
||||
maplist(subtract(Elapsed), Alarms, NewAlarms),
|
||||
find_zeros(NewAlarms, ZeroAlarms),
|
||||
findall(alarm(S, ID, E), (member(alarm(S, ID, E), NewAlarms), S > 0), NonZeroAlarms),
|
||||
bb_put(alarms, NonZeroAlarms),
|
||||
(NonZeroAlarms = [alarm(NewSeconds, _, _)|_] ->
|
||||
alarm(NewSeconds, alarm_handler, _)
|
||||
;
|
||||
true
|
||||
),
|
||||
execute([alarm(0, CurrentID, CurrentExecute)|ZeroAlarms]).
|
||||
|
||||
find_zeros([], []).
|
||||
find_zeros([alarm(0, ID, E)|T], [alarm(0, ID, E)|R]):-
|
||||
find_zeros(T, R).
|
||||
find_zeros([alarm(S, _, _)|T], R):-
|
||||
S > 0,
|
||||
find_zeros(T, R).
|
||||
|
||||
execute([]).
|
||||
execute([alarm(_, _, Execute)|R]):-
|
||||
call(Execute),
|
||||
execute(R).
|
||||
|
||||
time_out_call_once(Seconds, Goal, Return):-
|
||||
bb_get(identity, ID),
|
||||
set_alarm(Seconds, throw(timeout(ID)), ID),
|
||||
catch((
|
||||
prove_once(Goal, Return),
|
||||
unset_alarm(ID))
|
||||
, Exception, (
|
||||
(Exception == timeout(ID) ->
|
||||
Return = timeout
|
||||
;
|
||||
unset_alarm(ID),
|
||||
throw(Exception)
|
||||
))).
|
||||
|
||||
prove_once(Goal, success):-
|
||||
once(Goal), !.
|
||||
prove_once(_Goal, failure).
|
||||
|
||||
timer_start(Name):-
|
||||
\+ ground(Name),
|
||||
throw(error(instantiation_error, 'Timer name needs to be instantiated.')).
|
||||
timer_start(Name):-
|
||||
'$timer'(Name, _, _),
|
||||
throw(error(permission_error(create, timer, timer_start(Name)), 'Timer already exists.')).
|
||||
timer_start(Name):-
|
||||
statistics(walltime, [StartTime, _]),
|
||||
assertz('$timer'(Name, running, StartTime)).
|
||||
|
||||
timer_restart(Name):-
|
||||
\+ ground(Name),
|
||||
throw(error(instantiation_error, 'Timer name needs to be instantiated.')).
|
||||
timer_restart(Name):-
|
||||
\+ '$timer'(Name, _, _), !,
|
||||
statistics(walltime, [StartTime, _]),
|
||||
assertz('$timer'(Name, running, StartTime)).
|
||||
timer_restart(Name):-
|
||||
retract('$timer'(Name, running, _)), !,
|
||||
statistics(walltime, [StartTime, _]),
|
||||
assertz('$timer'(Name, running, StartTime)).
|
||||
timer_restart(Name):-
|
||||
retract('$timer'(Name, paused, Duration)),
|
||||
statistics(walltime, [StartTime, _]),
|
||||
Elapsed is StartTime - Duration,
|
||||
assertz('$timer'(Name, running, Elapsed)).
|
||||
|
||||
timer_stop(Name, Elapsed):-
|
||||
\+ '$timer'(Name, _, _),
|
||||
throw(error(existence_error(timer, timer_stop(Name, Elapsed)), 'Timer does not exist.')).
|
||||
timer_stop(Name, Elapsed):-
|
||||
retract('$timer'(Name, running, StartTime)), !,
|
||||
statistics(walltime, [EndTime, _]),
|
||||
Elapsed is EndTime - StartTime.
|
||||
timer_stop(Name, Elapsed):-
|
||||
retract('$timer'(Name, paused, Elapsed)).
|
||||
|
||||
timer_elapsed(Name, Elapsed):-
|
||||
\+ '$timer'(Name, _, _),
|
||||
throw(error(existence_error(timer, timer_elapsed(Name, Elapsed)), 'Timer does not exist.')).
|
||||
timer_elapsed(Name, Elapsed):-
|
||||
'$timer'(Name, running, StartTime), !,
|
||||
statistics(walltime, [EndTime, _]),
|
||||
Elapsed is EndTime - StartTime.
|
||||
timer_elapsed(Name, Elapsed):-
|
||||
'$timer'(Name, paused, Elapsed).
|
||||
|
||||
timer_pause(Name, Elapsed):-
|
||||
\+ '$timer'(Name, _, _),
|
||||
throw(error(existence_error(timer, timer_pause(Name, Elapsed)), 'Timer does not exist.')).
|
||||
timer_pause(Name, Elapsed):-
|
||||
'$timer'(Name, paused, _),
|
||||
throw(error(permission_error(timer, timer_pause(Name, Elapsed)), 'Timer already paused.')).
|
||||
timer_pause(Name, Elapsed):-
|
||||
retract('$timer'(Name, _, StartTime)),
|
||||
statistics(walltime, [EndTime, _]),
|
||||
Elapsed is EndTime - StartTime,
|
||||
assert('$timer'(Name, paused, Elapsed)).
|
||||
@ -49,13 +49,6 @@ format_to_chars(Form, Args, OUT, L0) :-
|
||||
write_to_chars(Term, OUT) :-
|
||||
write_to_chars(Term, [], OUT).
|
||||
|
||||
write_to_chars(Term, L0, OUT) :-
|
||||
open_mem_write_stream(Stream),
|
||||
write(Stream, Term),
|
||||
peek_mem_write_stream(Stream, L0, O),
|
||||
close(Stream),
|
||||
O = OUT.
|
||||
|
||||
atom_to_chars(Atom, OUT) :-
|
||||
atom_to_chars(Atom, [], OUT).
|
||||
|
||||
@ -88,12 +81,6 @@ number_to_chars(Number, L0, OUT) :-
|
||||
number_to_chars(Number, L0, OUT) :-
|
||||
throw(error(type_error(number,Number),number_to_chars(Number, L0, OUT))).
|
||||
|
||||
read_from_chars(Chars, Term) :-
|
||||
open_mem_read_stream(Chars, Stream),
|
||||
read(Stream, T),
|
||||
close(Stream),
|
||||
T = Term.
|
||||
|
||||
open_chars_stream(Chars, Stream) :-
|
||||
open_mem_read_stream(Chars, Stream).
|
||||
|
||||
|
||||
@ -459,22 +459,35 @@ X_API int PL_get_chars(term_t l, char **sp, unsigned flags)
|
||||
if (!(flags & (CVT_ATOM|CVT_ATOMIC|CVT_WRITE|CVT_WRITE_CANONICAL|CVT_ALL)))
|
||||
return cv_error(flags);
|
||||
if (IsWideAtom(at)) {
|
||||
size_t sz = wcslen(RepAtom(at)->WStrOfAE)*sizeof(wchar_t);
|
||||
if (!(tmp = ensure_space(sp, (sz+1)*sizeof(wchar_t), flags)))
|
||||
wchar_t* s = RepAtom(at)->WStrOfAE;
|
||||
size_t sz = wcslen(s)+1;
|
||||
if (!(tmp = ensure_space(sp, sz*sizeof(wchar_t), flags)))
|
||||
return 0;
|
||||
memcpy(*sp,s,sz*sizeof(wchar_t));
|
||||
} else {
|
||||
char *s = RepAtom(at)->StrOfAE;
|
||||
size_t sz = strlen(RepAtom(at)->StrOfAE)+1;
|
||||
size_t sz = strlen(s)+1;
|
||||
|
||||
if (!(tmp = ensure_space(sp, sz, flags)))
|
||||
return 0;
|
||||
strncpy(*sp,s,sz);
|
||||
memcpy(*sp,s,sz);
|
||||
}
|
||||
} else if (IsNumTerm(t)) {
|
||||
if (IsFloatTerm(t)) {
|
||||
if (!(flags & (CVT_FLOAT|CVT_NUMBER|CVT_ATOMIC|CVT_WRITE|CVT_WRITE_CANONICAL|CVT_ALL)))
|
||||
return cv_error(flags);
|
||||
snprintf(tmp,SWI_BUF_SIZE,"%f",FloatOfTerm(t));
|
||||
#if USE_GMP
|
||||
} else if (YAP_IsBigNumTerm(t)) {
|
||||
if (!(flags & (CVT_FLOAT|CVT_NUMBER|CVT_ATOMIC|CVT_WRITE|CVT_WRITE_CANONICAL|CVT_ALL)))
|
||||
return cv_error(flags);
|
||||
MP_INT g;
|
||||
YAP_BigNumOfTerm(t, (void *)&g);
|
||||
if (mpz_sizeinbase(&g,2) > SWI_BUF_SIZE-1) {
|
||||
return 0;
|
||||
}
|
||||
mpz_get_str (tmp, 10, &g);
|
||||
#endif
|
||||
} else {
|
||||
if (!(flags & (CVT_INTEGER|CVT_NUMBER|CVT_ATOMIC|CVT_WRITE|CVT_WRITE_CANONICAL|CVT_ALL)))
|
||||
return cv_error(flags);
|
||||
@ -520,7 +533,7 @@ X_API int PL_get_chars(term_t l, char **sp, unsigned flags)
|
||||
char *nbf = PL_malloc(sz+1);
|
||||
if (!nbf)
|
||||
return 0;
|
||||
strncpy(nbf,tmp,sz+1);
|
||||
memcpy(nbf,tmp,sz+1);
|
||||
free(tmp);
|
||||
*sp = nbf;
|
||||
}
|
||||
@ -890,7 +903,7 @@ X_API atom_t PL_new_atom_nchars(size_t len, const char *c)
|
||||
return 0L;
|
||||
}
|
||||
}
|
||||
strncpy(pt, c, len);
|
||||
memcpy(pt, c, len);
|
||||
pt[len] = '\0';
|
||||
} else {
|
||||
pt = (char *)c;
|
||||
@ -1102,7 +1115,8 @@ X_API int PL_put_atom_nchars(term_t t, size_t len, const char *s)
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
strncpy(buf, s, len);
|
||||
memcpy(buf, s, len);
|
||||
buf[len] = 0;
|
||||
} else {
|
||||
buf = (char *)s;
|
||||
}
|
||||
@ -1547,7 +1561,7 @@ X_API int PL_unify_atom_nchars(term_t t, size_t len, const char *s)
|
||||
|
||||
if (!buf)
|
||||
return FALSE;
|
||||
strncpy(buf, s, len);
|
||||
memcpy(buf, s, len);
|
||||
buf[len] = '\0';
|
||||
while (!(catom = Yap_LookupAtom(buf))) {
|
||||
if (!Yap_growheap(FALSE, 0L, NULL)) {
|
||||
@ -1857,7 +1871,7 @@ LookupMaxAtom(size_t n, char *s)
|
||||
|
||||
if (!buf)
|
||||
return FALSE;
|
||||
strncpy(buf, s, n);
|
||||
memcpy(buf, s, n);
|
||||
buf[n] = '\0';
|
||||
while (!(catom = Yap_LookupAtom(buf))) {
|
||||
if (!Yap_growheap(FALSE, 0L, NULL)) {
|
||||
@ -1910,15 +1924,16 @@ typedef struct {
|
||||
X_API int PL_unify_term(term_t l,...)
|
||||
{
|
||||
va_list ap;
|
||||
int type;
|
||||
int type, res;
|
||||
int nels = 1;
|
||||
int depth = 1;
|
||||
Term a[1], *pt;
|
||||
stack_el stack[MAX_DEPTH];
|
||||
|
||||
|
||||
BACKUP_MACHINE_REGS();
|
||||
if (Unsigned(H) > Unsigned(ASP)-CreepFlag) {
|
||||
if (!Yap_gc(0, ENV, CP)) {
|
||||
RECOVER_MACHINE_REGS();
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
@ -2123,7 +2138,9 @@ X_API int PL_unify_term(term_t l,...)
|
||||
}
|
||||
}
|
||||
va_end (ap);
|
||||
return YAP_Unify(Yap_GetFromSlot(l),a[0]);
|
||||
res = Yap_unify(Yap_GetFromSlot(l),a[0]);
|
||||
RECOVER_MACHINE_REGS();
|
||||
return res;
|
||||
}
|
||||
|
||||
/* end PL_unify_* functions =============================*/
|
||||
@ -2212,7 +2229,7 @@ X_API int PL_is_float(term_t ts)
|
||||
X_API int PL_is_integer(term_t ts)
|
||||
{
|
||||
YAP_Term t = Yap_GetFromSlot(ts);
|
||||
return YAP_IsIntTerm(t);
|
||||
return YAP_IsIntTerm(t) || YAP_IsBigNumTerm(t);
|
||||
}
|
||||
|
||||
X_API int PL_is_list(term_t ts)
|
||||
@ -2224,7 +2241,7 @@ X_API int PL_is_list(term_t ts)
|
||||
X_API int PL_is_number(term_t ts)
|
||||
{
|
||||
YAP_Term t = Yap_GetFromSlot(ts);
|
||||
return YAP_IsIntTerm(t) || YAP_IsFloatTerm(t);
|
||||
return YAP_IsIntTerm(t) || YAP_IsBigNumTerm(t) || YAP_IsFloatTerm(t);
|
||||
}
|
||||
|
||||
X_API int PL_is_string(term_t ts)
|
||||
@ -2312,23 +2329,25 @@ X_API record_t
|
||||
PL_record(term_t ts)
|
||||
{
|
||||
Term t = Yap_GetFromSlot(ts);
|
||||
return (record_t)Yap_StoreTermInDB(t, 0);
|
||||
return (record_t)YAP_Record(t);
|
||||
}
|
||||
|
||||
X_API int
|
||||
PL_recorded(record_t db, term_t ts)
|
||||
{
|
||||
Term t = Yap_FetchTermFromDB((DBTerm *)db);
|
||||
if (t == 0L)
|
||||
Term t = YAP_Recorded((void *)db);
|
||||
fprintf(stderr,"PL_recorded %ld\n", t);
|
||||
if (t == ((CELL)0))
|
||||
return FALSE;
|
||||
Yap_PutInSlot(ts,t);
|
||||
fprintf(stderr,"PL_recorded\n");
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
X_API void
|
||||
PL_erase(record_t db)
|
||||
{
|
||||
Yap_ReleaseTermFromDB((DBTerm *)db);
|
||||
YAP_Erase((void *)db);
|
||||
}
|
||||
|
||||
X_API void PL_halt(int e)
|
||||
@ -3096,6 +3115,7 @@ PL_YAP_InitSWIIO(struct SWI_IO *swio)
|
||||
SWIFlush = swio->flush_s;
|
||||
SWIClose = swio->close_s;
|
||||
SWIGetStream = swio->get_stream_handle;
|
||||
SWIGetStreamPosition = swio->get_stream_position;
|
||||
}
|
||||
|
||||
typedef int (*GetStreamF)(term_t, int, int, IOSTREAM **s);
|
||||
@ -3115,6 +3135,23 @@ Yap_get_stream_handle(Term t0, int read_mode, int write_mode, void *s){
|
||||
}
|
||||
|
||||
|
||||
typedef int (*GetStreamPosF)(IOSTREAM *s, term_t);
|
||||
|
||||
Term
|
||||
Yap_get_stream_position(void *s){
|
||||
term_t t;
|
||||
Term t0;
|
||||
GetStreamPosF f = (GetStreamPosF)SWIGetStreamPosition;
|
||||
|
||||
t = (term_t)Yap_NewSlots(1);
|
||||
if (!(*f)(s, t))
|
||||
return 0L;
|
||||
t0 = Yap_GetFromSlot((Int)t);
|
||||
Yap_RecoverSlots(1);
|
||||
return t0;
|
||||
}
|
||||
|
||||
|
||||
X_API void (*PL_signal(int sig, void (*func)(int)))(int)
|
||||
{
|
||||
// return Yap_signal2(sig,func);
|
||||
|
||||
561
library/flags.yap
Normal file
561
library/flags.yap
Normal file
@ -0,0 +1,561 @@
|
||||
%%% -*- Mode: Prolog; -*-
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
%
|
||||
% Flags was developed at Katholieke Universiteit Leuven
|
||||
%
|
||||
% Copyright 2010
|
||||
% Katholieke Universiteit Leuven
|
||||
%
|
||||
% Contributions to this file:
|
||||
% Author: Theofrastos Mantadelis
|
||||
% Sugestions: Bernd Gutmann, Paulo Moura
|
||||
% Version: 0.1
|
||||
% Date: 19/11/2010
|
||||
%
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
%
|
||||
% Artistic License 2.0
|
||||
%
|
||||
% Copyright (c) 2000-2006, The Perl Foundation.
|
||||
%
|
||||
% Everyone is permitted to copy and distribute verbatim copies of this
|
||||
% license document, but changing it is not allowed. Preamble
|
||||
%
|
||||
% This license establishes the terms under which a given free software
|
||||
% Package may be copied, modified, distributed, and/or
|
||||
% redistributed. The intent is that the Copyright Holder maintains some
|
||||
% artistic control over the development of that Package while still
|
||||
% keeping the Package available as open source and free software.
|
||||
%
|
||||
% You are always permitted to make arrangements wholly outside of this
|
||||
% license directly with the Copyright Holder of a given Package. If the
|
||||
% terms of this license do not permit the full use that you propose to
|
||||
% make of the Package, you should contact the Copyright Holder and seek
|
||||
% a different licensing arrangement. Definitions
|
||||
%
|
||||
% "Copyright Holder" means the individual(s) or organization(s) named in
|
||||
% the copyright notice for the entire Package.
|
||||
%
|
||||
% "Contributor" means any party that has contributed code or other
|
||||
% material to the Package, in accordance with the Copyright Holder's
|
||||
% procedures.
|
||||
%
|
||||
% "You" and "your" means any person who would like to copy, distribute,
|
||||
% or modify the Package.
|
||||
%
|
||||
% "Package" means the collection of files distributed by the Copyright
|
||||
% Holder, and derivatives of that collection and/or of those files. A
|
||||
% given Package may consist of either the Standard Version, or a
|
||||
% Modified Version.
|
||||
%
|
||||
% "Distribute" means providing a copy of the Package or making it
|
||||
% accessible to anyone else, or in the case of a company or
|
||||
% organization, to others outside of your company or organization.
|
||||
%
|
||||
% "Distributor Fee" means any fee that you charge for Distributing this
|
||||
% Package or providing support for this Package to another party. It
|
||||
% does not mean licensing fees.
|
||||
%
|
||||
% "Standard Version" refers to the Package if it has not been modified,
|
||||
% or has been modified only in ways explicitly requested by the
|
||||
% Copyright Holder.
|
||||
%
|
||||
% "Modified Version" means the Package, if it has been changed, and such
|
||||
% changes were not explicitly requested by the Copyright Holder.
|
||||
%
|
||||
% "Original License" means this Artistic License as Distributed with the
|
||||
% Standard Version of the Package, in its current version or as it may
|
||||
% be modified by The Perl Foundation in the future.
|
||||
%
|
||||
% "Source" form means the source code, documentation source, and
|
||||
% configuration files for the Package.
|
||||
%
|
||||
% "Compiled" form means the compiled bytecode, object code, binary, or
|
||||
% any other form resulting from mechanical transformation or translation
|
||||
% of the Source form.
|
||||
%
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
%
|
||||
% Permission for Use and Modification Without Distribution
|
||||
%
|
||||
% (1) You are permitted to use the Standard Version and create and use
|
||||
% Modified Versions for any purpose without restriction, provided that
|
||||
% you do not Distribute the Modified Version.
|
||||
%
|
||||
% Permissions for Redistribution of the Standard Version
|
||||
%
|
||||
% (2) You may Distribute verbatim copies of the Source form of the
|
||||
% Standard Version of this Package in any medium without restriction,
|
||||
% either gratis or for a Distributor Fee, provided that you duplicate
|
||||
% all of the original copyright notices and associated disclaimers. At
|
||||
% your discretion, such verbatim copies may or may not include a
|
||||
% Compiled form of the Package.
|
||||
%
|
||||
% (3) You may apply any bug fixes, portability changes, and other
|
||||
% modifications made available from the Copyright Holder. The resulting
|
||||
% Package will still be considered the Standard Version, and as such
|
||||
% will be subject to the Original License.
|
||||
%
|
||||
% Distribution of Modified Versions of the Package as Source
|
||||
%
|
||||
% (4) You may Distribute your Modified Version as Source (either gratis
|
||||
% or for a Distributor Fee, and with or without a Compiled form of the
|
||||
% Modified Version) provided that you clearly document how it differs
|
||||
% from the Standard Version, including, but not limited to, documenting
|
||||
% any non-standard features, executables, or modules, and provided that
|
||||
% you do at least ONE of the following:
|
||||
%
|
||||
% (a) make the Modified Version available to the Copyright Holder of the
|
||||
% Standard Version, under the Original License, so that the Copyright
|
||||
% Holder may include your modifications in the Standard Version. (b)
|
||||
% ensure that installation of your Modified Version does not prevent the
|
||||
% user installing or running the Standard Version. In addition, the
|
||||
% modified Version must bear a name that is different from the name of
|
||||
% the Standard Version. (c) allow anyone who receives a copy of the
|
||||
% Modified Version to make the Source form of the Modified Version
|
||||
% available to others under (i) the Original License or (ii) a license
|
||||
% that permits the licensee to freely copy, modify and redistribute the
|
||||
% Modified Version using the same licensing terms that apply to the copy
|
||||
% that the licensee received, and requires that the Source form of the
|
||||
% Modified Version, and of any works derived from it, be made freely
|
||||
% available in that license fees are prohibited but Distributor Fees are
|
||||
% allowed.
|
||||
%
|
||||
% Distribution of Compiled Forms of the Standard Version or
|
||||
% Modified Versions without the Source
|
||||
%
|
||||
% (5) You may Distribute Compiled forms of the Standard Version without
|
||||
% the Source, provided that you include complete instructions on how to
|
||||
% get the Source of the Standard Version. Such instructions must be
|
||||
% valid at the time of your distribution. If these instructions, at any
|
||||
% time while you are carrying out such distribution, become invalid, you
|
||||
% must provide new instructions on demand or cease further
|
||||
% distribution. If you provide valid instructions or cease distribution
|
||||
% within thirty days after you become aware that the instructions are
|
||||
% invalid, then you do not forfeit any of your rights under this
|
||||
% license.
|
||||
%
|
||||
% (6) You may Distribute a Modified Version in Compiled form without the
|
||||
% Source, provided that you comply with Section 4 with respect to the
|
||||
% Source of the Modified Version.
|
||||
%
|
||||
% Aggregating or Linking the Package
|
||||
%
|
||||
% (7) You may aggregate the Package (either the Standard Version or
|
||||
% Modified Version) with other packages and Distribute the resulting
|
||||
% aggregation provided that you do not charge a licensing fee for the
|
||||
% Package. Distributor Fees are permitted, and licensing fees for other
|
||||
% components in the aggregation are permitted. The terms of this license
|
||||
% apply to the use and Distribution of the Standard or Modified Versions
|
||||
% as included in the aggregation.
|
||||
%
|
||||
% (8) You are permitted to link Modified and Standard Versions with
|
||||
% other works, to embed the Package in a larger work of your own, or to
|
||||
% build stand-alone binary or bytecode versions of applications that
|
||||
% include the Package, and Distribute the result without restriction,
|
||||
% provided the result does not expose a direct interface to the Package.
|
||||
%
|
||||
% Items That are Not Considered Part of a Modified Version
|
||||
%
|
||||
% (9) Works (including, but not limited to, modules and scripts) that
|
||||
% merely extend or make use of the Package, do not, by themselves, cause
|
||||
% the Package to be a Modified Version. In addition, such works are not
|
||||
% considered parts of the Package itself, and are not subject to the
|
||||
% terms of this license.
|
||||
%
|
||||
% General Provisions
|
||||
%
|
||||
% (10) Any use, modification, and distribution of the Standard or
|
||||
% Modified Versions is governed by this Artistic License. By using,
|
||||
% modifying or distributing the Package, you accept this license. Do not
|
||||
% use, modify, or distribute the Package, if you do not accept this
|
||||
% license.
|
||||
%
|
||||
% (11) If your Modified Version has been derived from a Modified Version
|
||||
% made by someone other than you, you are nevertheless required to
|
||||
% ensure that your Modified Version complies with the requirements of
|
||||
% this license.
|
||||
%
|
||||
% (12) This license does not grant you the right to use any trademark,
|
||||
% service mark, tradename, or logo of the Copyright Holder.
|
||||
%
|
||||
% (13) This license includes the non-exclusive, worldwide,
|
||||
% free-of-charge patent license to make, have made, use, offer to sell,
|
||||
% sell, import and otherwise transfer the Package with respect to any
|
||||
% patent claims licensable by the Copyright Holder that are necessarily
|
||||
% infringed by the Package. If you institute patent litigation
|
||||
% (including a cross-claim or counterclaim) against any party alleging
|
||||
% that the Package constitutes direct or contributory patent
|
||||
% infringement, then this Artistic License to you shall terminate on the
|
||||
% date that such litigation is filed.
|
||||
%
|
||||
% (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT
|
||||
% HOLDER AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED
|
||||
% WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A
|
||||
% PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT
|
||||
% PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT
|
||||
% HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT,
|
||||
% INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE
|
||||
% OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
%
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
|
||||
|
||||
:- module(flags, [flag_define/2,
|
||||
flag_define/5,
|
||||
flag_define/7,
|
||||
flag_set/2,
|
||||
flag_set/3,
|
||||
flag_unsafe_set/2,
|
||||
flag_get/2,
|
||||
flags_reset/0,
|
||||
flags_reset/1,
|
||||
flags_save/1,
|
||||
flags_load/1,
|
||||
flag_groups/1,
|
||||
flag_group_chk/1,
|
||||
flag_help/0,
|
||||
flags_print/0,
|
||||
defined_flag/7]).
|
||||
|
||||
:- use_module(library(lists), [append/3, memberchk/2, member/2]).
|
||||
|
||||
:- style_check(all).
|
||||
:- yap_flag(unknown, error).
|
||||
|
||||
:- dynamic(['$defined_flag$'/7, '$store_flag_value$'/2]).
|
||||
:- meta_predicate(flag_define(+, +, +, ?, ?, ?, :)).
|
||||
:- meta_predicate(flag_define(+, :)).
|
||||
:- meta_predicate(validate(+, :, ?, +)).
|
||||
:- multifile(flags_type_definition/3).
|
||||
|
||||
flag_define(FlagName, InputOptions):-
|
||||
strip_module(InputOptions, Module, UserOptions),
|
||||
Defaults = [flag_group(general), flag_type(nonvar), default_value(true), description(FlagName), access(read_write), handler(true)],
|
||||
append(UserOptions, Defaults, Options),
|
||||
memberchk(flag_group(FlagGroup), Options),
|
||||
memberchk(flag_type(FlagType), Options),
|
||||
memberchk(default_value(DefaultValue), Options),
|
||||
memberchk(description(Description), Options),
|
||||
memberchk(access(Access), Options),
|
||||
memberchk(handler(Handler), Options),
|
||||
flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler).
|
||||
|
||||
flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description):-
|
||||
flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, read_write, true).
|
||||
|
||||
flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, MHandler):-
|
||||
strip_module(MHandler, Module, Handler),
|
||||
nonvar(FlagName),
|
||||
nonvar(FlagGroup),
|
||||
nonvar(FlagType),
|
||||
nonvar(Access),
|
||||
nonvar(Handler), !,
|
||||
(\+ atom(FlagName) ->
|
||||
throw(error(type_error(atom, FlagName), message('Flag name needs to be an atom.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler))))
|
||||
; \+ atom(FlagGroup) ->
|
||||
throw(error(type_error(atom, FlagGroup), message('Flag group needs to be an atom.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler))))
|
||||
; \+ flag_type(FlagType) ->
|
||||
throw(error(domain_error(flag_type, FlagType), message('Unknown flag type.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Module:Handler))))
|
||||
; \+ validate_type(FlagType) ->
|
||||
throw(error(evaluation_error(type_validation), message('Validation of flag type failed, check custom domain.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler))))
|
||||
; '$defined_flag$'(FlagName, _FlagGroup, _FlagType, _DefaultValue, _Description, _Access, _Handler) ->
|
||||
throw(error(permission_error(create, flag, FlagName), message('Re-defining a flag is not allowed.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler))))
|
||||
; \+ memberchk(Access, [read_write, read_only, hidden, hidden_read_only]),
|
||||
throw(error(domain_error(access, Access), message('Wrong access attribute, available are: read_write, read_only, hidden, hidden_read_only.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler))))
|
||||
; \+ callable(Handler) ->
|
||||
throw(error(type_error(callable, Handler), message('Flag handler needs to be callable.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler))))
|
||||
;
|
||||
validate(FlagType, Module:Handler, DefaultValue, FlagName),
|
||||
assertz('$defined_flag$'(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler)),
|
||||
assertz('$store_flag_value$'(FlagName, DefaultValue)),
|
||||
(Handler == true ->
|
||||
true
|
||||
;
|
||||
call(Module:Handler, stored, DefaultValue)
|
||||
)
|
||||
).
|
||||
flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Handler):-
|
||||
throw(error(instantiation_error, message('Flag name, group, type, access and handler need to be instantiated.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Handler)))).
|
||||
|
||||
flag_groups(FlagGroups):-
|
||||
all(FlagGroup, ('$defined_flag$'(_FlagName, FlagGroup, _FlagType, _DefaultValue, _Description, Access, _Handler), Access \== hidden, Access \== hidden_read_only), FlagGroups).
|
||||
|
||||
flag_group_chk(FlagGroup):-
|
||||
nonvar(FlagGroup),
|
||||
'$defined_flag$'(_FlagName, FlagGroup, _FlagType, _DefaultValue, _Description, _Access, _Handler), !.
|
||||
|
||||
flag_type(Type):-
|
||||
flags_type_definition(Type, _, _).
|
||||
|
||||
% flags_type_definition(TypeName, TypeHandler, TypeValidator).
|
||||
flags_type_definition(nonvar, nonvar, true).
|
||||
flags_type_definition(atom, atom, true).
|
||||
flags_type_definition(atomic, atomic, true).
|
||||
flags_type_definition(integer, integer, true).
|
||||
flags_type_definition(float, float, true).
|
||||
flags_type_definition(number, number, true).
|
||||
flags_type_definition(ground, ground, true).
|
||||
flags_type_definition(compound, compound, true).
|
||||
flags_type_definition(is_list, is_list, true).
|
||||
flags_type_definition(callable, callable, true).
|
||||
flags_type_definition(in_interval(Type, Interval), in_interval(Type, Interval), in_interval(Type, Interval)).
|
||||
flags_type_definition(integer_in_interval(Interval), in_interval(integer, Interval), in_interval(integer, Interval)).
|
||||
flags_type_definition(positive_integer, in_interval(integer, (0, (+inf))), true).
|
||||
flags_type_definition(non_negative_integer, in_interval(integer, ([0], (+inf))), true).
|
||||
flags_type_definition(negative_integer, in_interval(integer, ((-inf), 0)), true).
|
||||
flags_type_definition(float_in_interval(Interval), in_interval(float, Interval), in_interval(float, Interval)).
|
||||
flags_type_definition(positive_float, in_interval(float, (0.0, (+inf))), true).
|
||||
flags_type_definition(non_negative_float, in_interval(float, ([0.0], (+inf))), true).
|
||||
flags_type_definition(negative_float, in_interval(float, ((-inf), 0.0)), true).
|
||||
flags_type_definition(number_in_interval(Interval), in_interval(number, Interval), in_interval(number, Interval)).
|
||||
flags_type_definition(positive_number, in_interval(number, (0.0, (+inf))), true).
|
||||
flags_type_definition(non_negative_number, in_interval(number, ([0.0], (+inf))), true).
|
||||
flags_type_definition(negative_number, in_interval(number, ((-inf), 0.0)), true).
|
||||
flags_type_definition(in_domain(Domain), in_domain(Domain), in_domain(Domain)).
|
||||
flags_type_definition(boolean, in_domain([true, false]), true).
|
||||
flags_type_definition(switch, in_domain([on, off]), true).
|
||||
|
||||
in_domain(Domain):-
|
||||
ground(Domain),
|
||||
is_list(Domain).
|
||||
in_domain(Domain, Value):-
|
||||
ground(Value),
|
||||
memberchk(Value, Domain).
|
||||
|
||||
in_interval(Type, Interval):-
|
||||
is_list(Interval), !,
|
||||
Interval \== [],
|
||||
in_interval_conj(Type, Interval).
|
||||
in_interval(Type, Interval):-
|
||||
in_interval_single(Type, Interval).
|
||||
|
||||
in_interval_conj(_Type, []).
|
||||
in_interval_conj(Type, [Interval|Rest]):-
|
||||
in_interval_single(Type, Interval),
|
||||
in_interval_conj(Type, Rest).
|
||||
|
||||
in_interval_single(Type, ([Min], [Max])):-
|
||||
!, call(Type, Min),
|
||||
call(Type, Max),
|
||||
Min =< Max.
|
||||
|
||||
in_interval_single(Type, ([Min], Max)):-
|
||||
!, call(Type, Min),
|
||||
call(Type, Max),
|
||||
Min < Max.
|
||||
|
||||
in_interval_single(Type, (Min, [Max])):-
|
||||
!, call(Type, Min),
|
||||
call(Type, Max),
|
||||
Min < Max.
|
||||
|
||||
in_interval_single(Type, (Min, Max)):-
|
||||
call(Type, Min),
|
||||
call(Type, Max),
|
||||
Min < Max,
|
||||
Max - Min > 0.0.
|
||||
|
||||
in_interval(Type, [Interval|_Rest], Value):-
|
||||
in_interval(Type, Interval, Value), !.
|
||||
in_interval(Type, [_Interval|Rest], Value):-
|
||||
in_interval(Type, Rest, Value).
|
||||
|
||||
in_interval(Type, ([Min], [Max]), Value):-
|
||||
!, call(Type, Value),
|
||||
Value >= Min,
|
||||
Value =< Max.
|
||||
|
||||
in_interval(Type, ([Min], Max), Value):-
|
||||
!, call(Type, Value),
|
||||
Value >= Min,
|
||||
Value < Max.
|
||||
|
||||
in_interval(Type, (Min, [Max]), Value):-
|
||||
!, call(Type, Value),
|
||||
Value > Min,
|
||||
Value =< Max.
|
||||
|
||||
in_interval(Type, (Min, Max), Value):-
|
||||
call(Type, Value),
|
||||
Value > Min,
|
||||
Value < Max.
|
||||
|
||||
validate_type(Type):-
|
||||
flags_type_definition(Type, _, TypeValidater),
|
||||
call(TypeValidater).
|
||||
|
||||
validate(FlagType, Handler, Value, FlagName):-
|
||||
strip_module(Handler, _Module, true),
|
||||
!, flags_type_definition(FlagType, FlagValidator, _),
|
||||
(call(FlagValidator, Value) ->
|
||||
true
|
||||
;
|
||||
throw(error(validation_error(FlagType, Value), message('Validation of value fails.', validate(FlagType, Value, FlagName))))
|
||||
).
|
||||
validate(FlagType, Handler, Value, FlagName):-
|
||||
flags_type_definition(FlagType, FlagValidator, _),
|
||||
((call(Handler, validating, Value), (call(FlagValidator, Value); call(Handler, validate, Value))) ->
|
||||
call(Handler, validated, Value)
|
||||
;
|
||||
throw(error(validation_error(FlagType, Value), message('Validation of value fails.', validate(FlagType, Handler, Value, FlagName))))
|
||||
).
|
||||
|
||||
flag_set(FlagName, FlagValue):-
|
||||
flag_set(FlagName, _OldValue, FlagValue).
|
||||
flag_set(FlagName, OldValue, FlagValue):-
|
||||
atom(FlagName),
|
||||
'$defined_flag$'(FlagName, _FlagGroup, FlagType, _DefaultValue, _Description, Access, Module:Handler), !,
|
||||
(Access \== read_only, Access \== hidden_read_only ->
|
||||
validate(FlagType, Module:Handler, FlagValue, FlagName),
|
||||
retract('$store_flag_value$'(FlagName, OldValue)),
|
||||
assertz('$store_flag_value$'(FlagName, FlagValue)),
|
||||
(Handler == true ->
|
||||
true
|
||||
;
|
||||
call(Module:Handler, stored, FlagValue)
|
||||
)
|
||||
;
|
||||
throw(error(permission_error(set, flag, FlagName), message('Setting the flag value is not allowed.',flag_set(FlagName, OldValue, FlagValue))))
|
||||
).
|
||||
flag_set(FlagName, OldValue, FlagValue):-
|
||||
throw(error(existence_error(flag, FlagName), message('The flag is not defined.', flag_set(FlagName, OldValue, FlagValue)))).
|
||||
|
||||
flag_unsafe_set(FlagName, FlagValue):-
|
||||
retract('$store_flag_value$'(FlagName, _)),
|
||||
assertz('$store_flag_value$'(FlagName, FlagValue)).
|
||||
|
||||
flag_get(FlagName, FlagValue):-
|
||||
'$store_flag_value$'(FlagName, FlagValue).
|
||||
flag_get(FlagName, FlagValue):-
|
||||
\+ '$store_flag_value$'(FlagName, _),
|
||||
throw(error(existence_error(flag, FlagName), message('The flag is not defined.', flag_get(FlagName, FlagValue)))).
|
||||
|
||||
flags_reset:-
|
||||
retractall('$store_flag_value$'(_, _)),
|
||||
'$defined_flag$'(FlagName, _FlagGroup, _FlagType, DefaultValue, _Description, _Access, Module:Handler),
|
||||
assertz('$store_flag_value$'(FlagName, DefaultValue)),
|
||||
(Handler == true ->
|
||||
true
|
||||
;
|
||||
call(Module:Handler, stored, DefaultValue)
|
||||
),
|
||||
fail.
|
||||
flags_reset.
|
||||
|
||||
flags_reset(FlagGroup):-
|
||||
'$defined_flag$'(FlagName, FlagGroup, _FlagType, DefaultValue, _Description, _Access, Module:Handler),
|
||||
retractall('$store_flag_value$'(FlagName, _)),
|
||||
assertz('$store_flag_value$'(FlagName, DefaultValue)),
|
||||
(Handler == true ->
|
||||
true
|
||||
;
|
||||
call(Module:Handler, stored, DefaultValue)
|
||||
),
|
||||
fail.
|
||||
flags_reset(_).
|
||||
|
||||
flags_save(FileName):-
|
||||
tell(FileName),
|
||||
catch(('$store_flag_value$'(FlagName, Value),
|
||||
write_canonical('$store_flag_value$'(FlagName, Value)),
|
||||
write('.'), nl),
|
||||
Exception, clean_and_throw(told, Exception)),
|
||||
fail.
|
||||
flags_save(_FileName):-
|
||||
told.
|
||||
|
||||
flags_load(FileName):-
|
||||
see(FileName),
|
||||
catch((read('$store_flag_value$'(FlagName, Value)),
|
||||
flag_set(FlagName, Value)),
|
||||
Exception, clean_and_throw(seen, Exception)),
|
||||
fail.
|
||||
flags_load(_FileName):-
|
||||
seen.
|
||||
|
||||
clean_and_throw(Action, Exception):-
|
||||
Action,
|
||||
throw(Exception).
|
||||
|
||||
flag_help:-
|
||||
format('This is a short tutorial for the flags library.~nExported predicates:~n'),
|
||||
format(' flag_define/5 : defines a new flag without a handler~n'),
|
||||
format(' flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description)~n'),
|
||||
format(' flag_define/6 : defines a new flag with a handler~n'),
|
||||
format(' flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Handler)~n'),
|
||||
format(' FlagName : the name of the flag~n'),
|
||||
format(' FlagGroup : the name of the flag group~n'),
|
||||
format(' FlagType : the type of the flag available types are:~n'),
|
||||
flag_help_types,
|
||||
format(' DefaultValue : the default value for the flag~n'),
|
||||
format(' Description : a flag description~n'),
|
||||
format(' Handler : a handler~n'),
|
||||
flags:flag_help_handler,
|
||||
format(' flag_groups/1 : returns all the flag groups in a list~n'),
|
||||
format(' flag_group_chk/1 : checks if a group exists~n'),
|
||||
format(' flag_set/2 : sets the value of a flag~n'),
|
||||
format(' flag_get/2 : gets the value of a flag~n'),
|
||||
format(' flag_store/2 : sets the value of a flag ignoring all tests and handlers~n'),
|
||||
format(' flag_reset/0 : resets all flags to their default value~n'),
|
||||
format(' flag_reset/1 : resets all flags of a group to their default value~n'),
|
||||
format(' flag_help/0 : this screen~n'),
|
||||
format(' flags_print/0 : shows the current flags/values~n').
|
||||
flag_help_types:-
|
||||
flag_type(FlagType),
|
||||
format(' ~w~n', [FlagType]),
|
||||
fail.
|
||||
flag_help_types.
|
||||
|
||||
flag_help_handler:-
|
||||
format(' Handler important notes:~n'),
|
||||
format(' Conjuction: external_handler(validating, Value):-...~n'),
|
||||
format(' Disjunction: external_handler(validate, Value):-...~n'),
|
||||
format(' After: external_handler(validated, Value):-...~n'),
|
||||
format(' After set: external_handler(stored, Value):-...~n'),
|
||||
format(' this is implemented as (validating,(original;validated))~n'),
|
||||
format(' validating|original|validate|result~n'),
|
||||
format(' true | true | true | true~n'),
|
||||
format(' true | true | fail | true~n'),
|
||||
format(' true | fail | true | true~n'),
|
||||
format(' true | fail | fail | fail~n'),
|
||||
format(' fail | true | true | fail~n'),
|
||||
format(' fail | true | fail | fail~n'),
|
||||
format(' fail | fail | true | fail~n'),
|
||||
format(' fail | fail | fail | fail~n'),
|
||||
format(' Default behaviour is validating->true, validate->fail~n'),
|
||||
format(' To completly replace original set validate->true~n'),
|
||||
format(' To add new values to original set validating->true~n'),
|
||||
format(' To remove values from original set validate->fail~n'),
|
||||
format(' Example definition with a handler:~n'),
|
||||
format(' flag_define(myflag, mygroup, in_interval(integer, [(-5, 5),([15],[25])]), 0, description, my_handler).~n'),
|
||||
format(' my_handler(validate, Value):-Value is 10.~n'),
|
||||
format(' my_handler(validating, Value).~n'),
|
||||
format(' my_handler(validated, Value).~n'),
|
||||
format(' my_handler(stored, Value).~n'),
|
||||
format(' This has defined a flag that accepts integers (-5,5)v[15,25].~n'),
|
||||
format(' The handler adds the value 10 in those.~n').
|
||||
|
||||
flags_print:-
|
||||
flag_groups(Groups),
|
||||
forall(member(Group, Groups), flags_print(Group)).
|
||||
flags_print(Group):-
|
||||
format(' ~w:~n~w~38+ ~w~19+ ~w~10+ ~w~10+~n', [Group, 'Description', 'Domain', 'Flag', 'Value']),
|
||||
fail.
|
||||
flags_print(FlagGroup):-
|
||||
'$defined_flag$'(FlagName, FlagGroup, FlagType, _DefaultValue, Description, Access, _Handler),
|
||||
Access \== hidden, Access \== hidden_read_only,
|
||||
flag_get(FlagName, Value),
|
||||
format('~w~38+ ~w~19+ ~w~10+ ~q~10+~n', [Description, FlagType, FlagName, Value]),
|
||||
fail.
|
||||
flags_print(_).
|
||||
|
||||
defined_flag(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Handler):-
|
||||
'$defined_flag$'(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Handler),
|
||||
Access \== hidden, Access \== hidden_read_only.
|
||||
defined_flag(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Handler):-
|
||||
nonvar(FlagName), nonvar(FlagGroup),
|
||||
'$defined_flag$'(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Handler).
|
||||
|
||||
|
||||
@ -8,9 +8,14 @@
|
||||
append/3,
|
||||
append/2,
|
||||
delete/3,
|
||||
intersection/3,
|
||||
flatten/2,
|
||||
last/2,
|
||||
list_concat/2,
|
||||
max_list/2,
|
||||
member/2,
|
||||
memberchk/2,
|
||||
min_list/2,
|
||||
nextto/3,
|
||||
nth/3,
|
||||
nth/4,
|
||||
@ -18,6 +23,7 @@
|
||||
nth0/4,
|
||||
nth1/3,
|
||||
nth1/4,
|
||||
numlist/3,
|
||||
permutation/2,
|
||||
prefix/2,
|
||||
remove_duplicates/2,
|
||||
@ -27,16 +33,11 @@
|
||||
selectchk/3,
|
||||
sublist/2,
|
||||
substitute/4,
|
||||
subtract/3,
|
||||
suffix/2,
|
||||
sum_list/2,
|
||||
sum_list/3,
|
||||
suffix/2,
|
||||
sumlist/2,
|
||||
list_concat/2,
|
||||
flatten/2,
|
||||
max_list/2,
|
||||
min_list/2,
|
||||
numlist/3,
|
||||
intersection/3
|
||||
sumlist/2
|
||||
]).
|
||||
|
||||
:- use_module(library(error),
|
||||
@ -400,3 +401,17 @@ intersection([X|T], L, Intersect) :-
|
||||
intersection([_|T], L, R) :-
|
||||
intersection(T, L, R).
|
||||
|
||||
%% subtract(+Set, +Delete, -Result) is det.
|
||||
%
|
||||
% Delete all elements from `Set' that occur in `Delete' (a set)
|
||||
% and unify the result with `Result'. Deletion is based on
|
||||
% unification using memberchk/2. The complexity is |Delete|*|Set|.
|
||||
%
|
||||
% @see ord_subtract/3.
|
||||
|
||||
subtract([], _, []) :- !.
|
||||
subtract([E|T], D, R) :-
|
||||
memberchk(E, D), !,
|
||||
subtract(T, D, R).
|
||||
subtract([H|T], D, [H|R]) :-
|
||||
subtract(T, D, R).
|
||||
|
||||
@ -20,6 +20,7 @@ YAPLIBDIR=@libdir@/Yap
|
||||
#
|
||||
CC=@CC@
|
||||
CFLAGS= @SHLIB_CFLAGS@ $(YAP_EXTRAS) $(DEFS) -I$(srcdir) -I../.. -I$(srcdir)/../../include
|
||||
LDFLAGS=@LDFLAGS@
|
||||
#
|
||||
#
|
||||
# You shouldn't need to change what follows.
|
||||
@ -47,10 +48,10 @@ matrix.o: $(srcdir)/matrix.c
|
||||
$(CC) -c $(CFLAGS) $(srcdir)/matrix.c -o matrix.o
|
||||
|
||||
@DO_SECOND_LD@%.@SO@: %.o
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ -o $@ $< @EXTRA_LIBS_FOR_DLLS@
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o $@ $< @EXTRA_LIBS_FOR_DLLS@
|
||||
|
||||
@DO_SECOND_LD@matrix.@SO@: matrix.o
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ -o matrix.@SO@ matrix.o @EXTRA_LIBS_FOR_DLLS@
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o matrix.@SO@ matrix.o @EXTRA_LIBS_FOR_DLLS@
|
||||
|
||||
install: all
|
||||
$(INSTALL_PROGRAM) $(SOBJS) $(DESTDIR)$(YAPLIBDIR)
|
||||
|
||||
@ -20,6 +20,7 @@ YAPLIBDIR=@libdir@/Yap
|
||||
#
|
||||
CC=@CC@
|
||||
CFLAGS= @SHLIB_CFLAGS@ $(YAP_EXTRAS) $(DEFS) -I$(srcdir) -I../.. -I$(srcdir)/../../include
|
||||
LDFLAGS=@LDFLAGS@
|
||||
#
|
||||
#
|
||||
# You shouldn't need to change what follows.
|
||||
@ -47,10 +48,10 @@ yap_random.o: $(srcdir)/yap_random.c
|
||||
$(CC) -c $(CFLAGS) $(srcdir)/yap_random.c -o yap_random.o
|
||||
|
||||
@DO_SECOND_LD@%.@SO@: %.o
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ -o $@ $< @EXTRA_LIBS_FOR_DLLS@
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o $@ $< @EXTRA_LIBS_FOR_DLLS@
|
||||
|
||||
@DO_SECOND_LD@yap_random.@SO@: yap_random.o
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ -o yap_random.@SO@ yap_random.o @EXTRA_LIBS_FOR_DLLS@
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o yap_random.@SO@ yap_random.o @EXTRA_LIBS_FOR_DLLS@
|
||||
|
||||
install: all
|
||||
$(INSTALL_PROGRAM) $(SOBJS) $(DESTDIR)$(YAPLIBDIR)
|
||||
|
||||
@ -20,6 +20,7 @@ YAPLIBDIR=@libdir@/Yap
|
||||
#
|
||||
CC=@CC@
|
||||
CFLAGS= @SHLIB_CFLAGS@ $(YAP_EXTRAS) $(DEFS) -I$(srcdir) -I../.. -I$(srcdir)/../../include
|
||||
LDFLAGS=@LDFLAGS@
|
||||
#
|
||||
#
|
||||
# You shouldn't need to change what follows.
|
||||
@ -59,22 +60,22 @@ regexec.o: $(srcdir)/regexec.c
|
||||
$(CC) -c $(CFLAGS) $(srcdir)/regexec.c -o regexec.o
|
||||
|
||||
@DO_SECOND_LD@%.@SO@: %.o
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ -o $@ $< @EXTRA_LIBS_FOR_DLLS@
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o $@ $< @EXTRA_LIBS_FOR_DLLS@
|
||||
|
||||
@DO_SECOND_LD@regexp.@SO@: regexp.o @MERGE_DLL_OBJS@ regcomp.o regerror.o regfree.o regexec.o
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ -o regexp.@SO@ regexp.o @EXTRA_LIBS_FOR_DLLS@ @MERGE_DLL_OBJS@ regcomp.o regerror.o regfree.o regexec.o
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o regexp.@SO@ regexp.o @EXTRA_LIBS_FOR_DLLS@ @MERGE_DLL_OBJS@ regcomp.o regerror.o regfree.o regexec.o
|
||||
|
||||
@DO_SECOND_LD@regcomp.@SO@: regcomp.o @MERGE_DLL_OBJS@ regfree.o
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ -o regcomp.@SO@ regcomp.o @MERGE_DLL_OBJS@ regfree.o @EXTRA_LIBS_FOR_DLLS@
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o regcomp.@SO@ regcomp.o @MERGE_DLL_OBJS@ regfree.o @EXTRA_LIBS_FOR_DLLS@
|
||||
|
||||
@DO_SECOND_LD@regerror.@SO@: regerror.o
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ -o regerror.@SO@ regerror.o @EXTRA_LIBS_FOR_DLLS@
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o regerror.@SO@ regerror.o @EXTRA_LIBS_FOR_DLLS@
|
||||
|
||||
@DO_SECOND_LD@regfree.@SO@: regfree.o
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ -o regfree.@SO@ regfree.o @EXTRA_LIBS_FOR_DLLS@
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o regfree.@SO@ regfree.o @EXTRA_LIBS_FOR_DLLS@
|
||||
|
||||
@DO_SECOND_LD@regexec.@SO@: regexec.o
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ -o regexec.@SO@ regexec.o @EXTRA_LIBS_FOR_DLLS@
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o regexec.@SO@ regexec.o @EXTRA_LIBS_FOR_DLLS@
|
||||
|
||||
install: all
|
||||
$(INSTALL_PROGRAM) $(SOBJS) $(DESTDIR)$(YAPLIBDIR)
|
||||
|
||||
@ -25,6 +25,7 @@ YAPLIBDIR=@libdir@/Yap
|
||||
CC=@CC@
|
||||
MPI_CC=mpicc
|
||||
CFLAGS= @SHLIB_CFLAGS@ $(YAP_EXTRAS) $(DEFS) -I$(srcdir) -I../.. -I$(srcdir)/../../include
|
||||
LDFLAGS=@LDFLAGS@
|
||||
#
|
||||
#
|
||||
# You shouldn't need to change what follows.
|
||||
@ -52,10 +53,10 @@ yaprl.o: $(srcdir)/yap_rl.c
|
||||
$(CC) -c $(CFLAGS) $(srcdir)/yap_rl.c -o yaprl.o
|
||||
|
||||
@DO_SECOND_LD@%.@SO@: %.o
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ -o $@ $< @EXTRA_LIBS_FOR_DLLS@
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o $@ $< @EXTRA_LIBS_FOR_DLLS@
|
||||
|
||||
@DO_SECOND_LD@yap_rl.@SO@: $(OBJS)
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ -o yap_rl.@SO@ $(OBJS) @EXTRA_LIBS_FOR_DLLS@
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o yap_rl.@SO@ $(OBJS) @EXTRA_LIBS_FOR_DLLS@
|
||||
|
||||
install: all
|
||||
@if test "$(SOBJS)" = "no"; then echo ""; else $(INSTALL_PROGRAM) $(SOBJS) $(DESTDIR)$(YAPLIBDIR); fi
|
||||
|
||||
@ -43,6 +43,7 @@
|
||||
mktime/2,
|
||||
tmpnam/1,
|
||||
tmp_file/2,
|
||||
tmpdir/1,
|
||||
wait/2,
|
||||
working_directory/2
|
||||
]).
|
||||
@ -138,7 +139,7 @@ rm_directory(File, Ignore) :-
|
||||
|
||||
delete_directory(on, File, Ignore) :-
|
||||
directory_files(File, FileList, Ignore),
|
||||
dir_separator(D),
|
||||
path_separator(D),
|
||||
atom_concat(File, D, FileP),
|
||||
delete_dirfiles(FileList, FileP, Ignore),
|
||||
rmdir(File, Ignore).
|
||||
@ -501,13 +502,13 @@ tmp_file(Base,X) :-
|
||||
throw(error(instantiation_error,tmp_file(Base,X))).
|
||||
tmp_file(Base,X) :-
|
||||
atom(Base), !,
|
||||
tmpdir(Dir, Error),
|
||||
handle_system_error(Error, off, tmp_file(Base,Error)),
|
||||
tmpdir(Dir),
|
||||
handle_system_error(Error, off, tmp_file(Base,X)),
|
||||
pid(PID, Error),
|
||||
handle_system_error(Error, off, tmp_file(Base,Error)),
|
||||
handle_system_error(Error, off, tmp_file(Base,X)),
|
||||
tmp_file_sequence(I),
|
||||
dir_separator(D),
|
||||
atomic_concat([Dir,D,yap_,Base,'_',PID,'_',I],X).
|
||||
% path_separator(D),
|
||||
atomic_concat([Dir,yap_,Base,'_',PID,'_',I],X).
|
||||
tmp_file(Base,X) :-
|
||||
throw(error(type_error(atom,Base),tmp_file(Base,X))).
|
||||
|
||||
@ -518,3 +519,18 @@ tmp_file_sequence(X) :-
|
||||
tmp_file_sequence(0) :-
|
||||
assert(tmp_file_sequence_counter(1)).
|
||||
|
||||
%%% Added from Theo, path_seperator is used to replace the c predicate dir_separator which is not OS aware
|
||||
|
||||
tmpdir(TmpDir):-
|
||||
tmpdir(Dir, Error),
|
||||
handle_system_error(Error, off, tmpdir(Dir)),
|
||||
path_separator(D),
|
||||
(atom_concat(_, D, Dir) ->
|
||||
TmpDir = Dir
|
||||
;
|
||||
atom_concat(Dir, D, TmpDir)
|
||||
).
|
||||
|
||||
path_separator('\\'):-
|
||||
win, !.
|
||||
path_separator('/').
|
||||
|
||||
@ -20,6 +20,7 @@ YAPLIBDIR=@libdir@/Yap
|
||||
#
|
||||
CC=@CC@
|
||||
CFLAGS= @SHLIB_CFLAGS@ $(YAP_EXTRAS) $(DEFS) -I$(srcdir) -I../.. -I$(srcdir)/../../include
|
||||
LDFLAGS=@LDFLAGS@
|
||||
#
|
||||
#
|
||||
# You shouldn't need to change what follows.
|
||||
@ -47,10 +48,10 @@ sys.o: $(srcdir)/sys.c
|
||||
$(CC) -c $(CFLAGS) $(srcdir)/sys.c -o sys.o
|
||||
|
||||
@DO_SECOND_LD@@DO_SECOND_LD@%.@SO@: %.o
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ -o $@ $< @EXTRA_LIBS_FOR_DLLS@
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o $@ $< @EXTRA_LIBS_FOR_DLLS@
|
||||
|
||||
@DO_SECOND_LD@sys.@SO@: sys.o
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ -o sys.@SO@ sys.o @EXTRA_LIBS_FOR_DLLS@
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o sys.@SO@ sys.o @EXTRA_LIBS_FOR_DLLS@
|
||||
|
||||
install: all
|
||||
$(INSTALL_PROGRAM) $(SOBJS) $(DESTDIR)$(YAPLIBDIR)
|
||||
|
||||
@ -20,6 +20,7 @@ YAPLIBDIR=@libdir@/Yap
|
||||
#
|
||||
CC=@CC@
|
||||
CFLAGS= @SHLIB_CFLAGS@ $(YAP_EXTRAS) $(DEFS) -I$(srcdir) -I../.. -I$(srcdir)/../../include
|
||||
LDFLAGS=@LDFLAGS@
|
||||
#
|
||||
#
|
||||
# You shouldn't need to change what follows.
|
||||
@ -60,13 +61,13 @@ itries.o: $(srcdir)/core_tries.h $(srcdir)/base_itries.h $(srcdir)/itries.c
|
||||
$(CC) -c $(CFLAGS) $(SHLIB_CFLAGS) $(srcdir)/itries.c -o itries.o
|
||||
|
||||
@DO_SECOND_LD@%.@SO@: %.o
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ -o $@ $< @EXTRA_LIBS_FOR_DLLS@
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o $@ $< @EXTRA_LIBS_FOR_DLLS@
|
||||
|
||||
@DO_SECOND_LD@tries.@SO@: core_tries.o base_tries.o tries.o
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ -o tries.@SO@ core_tries.o base_tries.o tries.o @EXTRA_LIBS_FOR_DLLS@
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o tries.@SO@ core_tries.o base_tries.o tries.o @EXTRA_LIBS_FOR_DLLS@
|
||||
|
||||
@DO_SECOND_LD@itries.@SO@: core_tries.o base_itries.o itries.o
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ -o itries.@SO@ core_tries.o base_itries.o itries.o @EXTRA_LIBS_FOR_DLLS@
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o itries.@SO@ core_tries.o base_itries.o itries.o @EXTRA_LIBS_FOR_DLLS@
|
||||
|
||||
install: all
|
||||
$(INSTALL_PROGRAM) $(SOBJS) $(DESTDIR)$(YAPLIBDIR)
|
||||
|
||||
@ -211,6 +211,7 @@ SWI_PutWideFunction swi_wputc SWIWidePutc =NULL
|
||||
SWI_CloseFunction swi_close SWIClose =NULL
|
||||
SWI_FlushFunction swi_flush SWIFlush =NULL
|
||||
SWI_PLGetStreamFunction swi_get_stream_f SWIGetStream =NULL
|
||||
SWI_PLGetStreamPositionFunction swi_get_stream_position_f SWIGetStreamPosition =NULL
|
||||
|
||||
// stack overflow expansion/gc control
|
||||
int allow_local_expansion Yap_AllowLocalExpansion =TRUE
|
||||
|
||||
@ -141,6 +141,7 @@ struct pred_entry *pred_throw PredThrow MkPred FunctorThrow PROLOG_MODULE
|
||||
struct pred_entry *pred_handle_throw PredHandleThrow MkPred FunctorHandleThrow PROLOG_MODULE
|
||||
struct pred_entry *pred_is PredIs MkPred FunctorIs PROLOG_MODULE
|
||||
struct pred_entry *pred_safe_call_cleanup PredSafeCallCleanup MkPred FunctorSafeCallCleanup PROLOG_MODULE
|
||||
struct pred_entry *pred_restore_regs PredRestoreRegs MkPred FunctorRestoreRegs PROLOG_MODULE
|
||||
#ifdef YAPOR
|
||||
struct pred_entry *pred_getwork PredGetwork MkPred AtomGetwork 0 PROLOG_MODULE
|
||||
struct pred_entry *pred_getwork_seq PredGetworkSeq MkPred AtomGetworkSeq 0 PROLOG_MODULE
|
||||
@ -338,6 +339,9 @@ ADDR foreign_code_base ForeignCodeBase =NULL void
|
||||
ADDR foreign_code_top ForeignCodeTop =NULL void
|
||||
ADDR foreign_code_max ForeignCodeMax =NULL void
|
||||
|
||||
/* recorded terms */
|
||||
struct record_list *yap_records Yap_Records =NULL RestoreYapRecords()
|
||||
|
||||
/* SWI atoms and functors */
|
||||
Atom swi_atoms[N_SWI_ATOMS] SWI_Atoms InitSWIAtoms() RestoreSWIAtoms()
|
||||
Functor swi_functors[N_SWI_FUNCTORS] SWI_Functors void void
|
||||
|
||||
@ -22,6 +22,7 @@ YAPLIBDIR=@libdir@/Yap
|
||||
DEFS=@DEFS@ -D_YAP_NOT_INSTALLED_=1
|
||||
CC=@CC@
|
||||
CFLAGS= @SHLIB_CFLAGS@ $(YAP_EXTRAS) $(DEFS) -I$(srcdir) -I../.. -I$(srcdir)/../../include @CPPFLAGS@
|
||||
LDFLAGS=@LDFLAGS@
|
||||
#
|
||||
#
|
||||
# You shouldn't need to change what follows.
|
||||
@ -78,10 +79,10 @@ uxnt.o: $(srcdir)/uxnt/uxnt.c
|
||||
$(CC) -c $(CFLAGS) $< -o $@
|
||||
|
||||
@DO_SECOND_LD@%.@SO@: %.o
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ -o $@ $< @EXTRA_LIBS_FOR_DLLS@
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o $@ $< @EXTRA_LIBS_FOR_DLLS@
|
||||
|
||||
@DO_SECOND_LD@libplstream.@SO@: $(OBJS)
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ -o libplstream.@SO@ $(OBJS) @EXTRA_LIBS_FOR_DLLS@
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o libplstream.@SO@ $(OBJS) @EXTRA_LIBS_FOR_DLLS@
|
||||
|
||||
install: all
|
||||
$(INSTALL_PROGRAM) $(SOBJS) $(DESTDIR)$(YAPLIBDIR)
|
||||
|
||||
@ -4344,12 +4344,18 @@ get_stream_handle_no_errors(term_t t, int read, int write, IOSTREAM **s)
|
||||
{ GET_LD
|
||||
if ( t == 0 )
|
||||
{ if (write) *s = getStream(Scurout);
|
||||
else *s = getStream(Scurout);
|
||||
else *s = getStream(Scurin);
|
||||
return TRUE;
|
||||
}
|
||||
return get_stream_handle(t, s, SH_ALIAS);
|
||||
}
|
||||
|
||||
static int
|
||||
get_stream_position(IOSTREAM *s, term_t t)
|
||||
{ GET_LD
|
||||
return stream_position_prop(s, t);
|
||||
}
|
||||
|
||||
static void
|
||||
init_yap_extras(void)
|
||||
{
|
||||
@ -4363,6 +4369,7 @@ init_yap_extras(void)
|
||||
swiio.flush_s = Sflush;
|
||||
swiio.close_s = closeStream;
|
||||
swiio.get_stream_handle = get_stream_handle_no_errors;
|
||||
swiio.get_stream_position = get_stream_position;
|
||||
PL_YAP_InitSWIIO(&swiio);
|
||||
initCharTypes();
|
||||
initFiles();
|
||||
|
||||
@ -2,8 +2,8 @@
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
%
|
||||
% $Date: 2010-12-15 11:12:48 +0100 (Wed, 15 Dec 2010) $
|
||||
% $Revision: 5138 $
|
||||
% $Date: 2011-01-16 19:24:10 +0100 (Sun, 16 Jan 2011) $
|
||||
% $Revision: 5260 $
|
||||
%
|
||||
% This file is part of ProbLog
|
||||
% http://dtai.cs.kuleuven.be/problog
|
||||
@ -521,6 +521,7 @@ init_global_params :-
|
||||
problog_define_flag(bdd_result, problog_flag_validate_file, 'file to store result calculated from BDD', example_bdd_res, bdd, flags:working_file_handler),
|
||||
problog_define_flag(bdd_file, problog_flag_validate_file, 'file for BDD script', example_bdd, bdd, flags:bdd_file_handler),
|
||||
problog_define_flag(static_order_file, problog_flag_validate_file, 'file for BDD static order', example_bdd_order, bdd, flags:working_file_handler),
|
||||
problog_define_flag(map_file, problog_flag_validate_file, 'the file to output the variable map', map_file, output, flags:working_file_handler),
|
||||
%%%%%%%%%%%%
|
||||
% montecarlo: recalculate current approximation after N samples
|
||||
% montecarlo: write log to this file
|
||||
@ -2458,6 +2459,7 @@ montecarlo(Goal,Delta,K,File) :-
|
||||
format(Log,'# goal: ~q~n#delta: ~w~n',[Goal,Delta]),
|
||||
format(Log,'# num_programs prob low high diff time~2n',[]),
|
||||
close(Log),
|
||||
timer_reset(monte_carlo),
|
||||
timer_start(monte_carlo),
|
||||
format_if_verbose(user,'search for ~q~n',[Goal]),
|
||||
montecarlo(Goal,Delta,K,0,File,0),
|
||||
|
||||
@ -2,8 +2,8 @@
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
%
|
||||
% $Date: 2010-12-16 13:33:43 +0100 (Thu, 16 Dec 2010) $
|
||||
% $Revision: 5156 $
|
||||
% $Date: 2011-01-16 19:24:10 +0100 (Sun, 16 Jan 2011) $
|
||||
% $Revision: 5260 $
|
||||
%
|
||||
% This file is part of ProbLog
|
||||
% http://dtai.cs.kuleuven.be/problog
|
||||
@ -282,7 +282,8 @@
|
||||
problog_define_flag(use_naive_trie, problog_flag_validate_boolean, 'use the naive algorithm to generate bdd scripts', false),
|
||||
problog_define_flag(use_old_trie, problog_flag_validate_boolean, 'use the old trie 2 trie transformation no nested', true),
|
||||
problog_define_flag(use_dec_trie, problog_flag_validate_boolean, 'use the decomposition method', false),
|
||||
problog_define_flag(deref_terms, problog_flag_validate_boolean, 'deref BDD terms after last use', false)
|
||||
problog_define_flag(deref_terms, problog_flag_validate_boolean, 'deref BDD terms after last use', false),
|
||||
problog_define_flag(export_map_file, problog_flag_validate_boolean, 'activates export of a variable map file', false, output)
|
||||
)).
|
||||
|
||||
|
||||
@ -657,40 +658,52 @@ bdd_ptree_script(Trie, FileBDD, FileParam) :-
|
||||
retractall(compression(_, _)).
|
||||
|
||||
% write parameter file by iterating over all var/not(var) occuring in the tree
|
||||
bdd_vars_script([]).
|
||||
bdd_vars_script([A|B]) :-
|
||||
(
|
||||
A=not(ID)
|
||||
->
|
||||
bdd_vars_script_intern(ID);
|
||||
bdd_vars_script_intern(A)
|
||||
),
|
||||
bdd_vars_script(B).
|
||||
bdd_vars_script_intern(A) :-
|
||||
(
|
||||
number(A)
|
||||
->
|
||||
(
|
||||
% it's a ground fact
|
||||
get_var_name(A,NameA),
|
||||
(problog:decision_fact(A,_) ->
|
||||
% it's a ground decision
|
||||
(problog:problog_control(check,internal_strategy) ->
|
||||
problog:get_fact_probability(A,P),
|
||||
format('@~w~n~12f~n~w~n',[NameA,P,1])
|
||||
;
|
||||
format('@~w~n~12f~n~w~n',[NameA,0,1])
|
||||
)
|
||||
;
|
||||
% it's a normal ProbLog fact
|
||||
|
||||
bdd_vars_script(Vars):-
|
||||
bdd_vars_script(Vars, Names),
|
||||
(problog_flag(export_map_file, true) ->
|
||||
problog_flag(map_file, MapFile),
|
||||
os:convert_filename_to_working_path(MapFile, MapFileName),
|
||||
flush_output,
|
||||
tell(MapFileName),
|
||||
problog:get_fact_list(Vars, Facts),
|
||||
writemap(Names, Facts),
|
||||
flush_output,
|
||||
told
|
||||
;
|
||||
true
|
||||
).
|
||||
writemap([],[]).
|
||||
writemap([Name|Names],[Fact|Facts]):-
|
||||
write(map(Name,Fact)),nl,
|
||||
writemap(Names, Facts).
|
||||
|
||||
bdd_vars_script([], []).
|
||||
bdd_vars_script([not(A)|B], Names) :-
|
||||
!, bdd_vars_script([A|B], Names).
|
||||
bdd_vars_script([A|B], [NameA|Names]) :-
|
||||
bdd_vars_script_intern(A, NameA),
|
||||
bdd_vars_script(B, Names).
|
||||
|
||||
bdd_vars_script_intern(A, NameA) :-
|
||||
(number(A) -> % it's a ground fact
|
||||
get_var_name(A,NameA),
|
||||
(problog:decision_fact(A,_) -> % it's a ground decision
|
||||
(problog:problog_control(check,internal_strategy) ->
|
||||
problog:get_fact_probability(A,P),
|
||||
format('@~w~n~12f~n',[NameA,P])
|
||||
format('@~w~n~12f~n~w~n',[NameA,P,1])
|
||||
;
|
||||
format('@~w~n~12f~n~w~n',[NameA,0,1])
|
||||
)
|
||||
); % it's somethin else, call the specialist
|
||||
% it's a non-ground or continuous fact
|
||||
bdd_vars_script_intern2(A)
|
||||
).
|
||||
bdd_vars_script_intern2(A) :-
|
||||
; % it's a normal ProbLog fact
|
||||
problog:get_fact_probability(A,P),
|
||||
format('@~w~n~12f~n',[NameA,P])
|
||||
)
|
||||
; % it's somethin else, call the specialist - it's a non-ground or continuous fact
|
||||
bdd_vars_script_intern2(A, NameA)
|
||||
).
|
||||
|
||||
bdd_vars_script_intern2(A, NameA) :-
|
||||
get_var_name(A,NameA),
|
||||
atom_codes(A,A_Codes),
|
||||
|
||||
|
||||
@ -39,7 +39,7 @@ CRYPTLIBS=@CLIB_CRYPTLIBS@
|
||||
PTHREADLIBS=@CLIB_PTHREADS@
|
||||
|
||||
LD=@DO_SECOND_LD@ @SHLIB_LD@
|
||||
LDFLAGS=@EXTRA_LIBS_FOR_SWIDLLS@
|
||||
LDFLAGS=@EXTRA_LIBS_FOR_SWIDLLS@ @LDFLAGS@
|
||||
|
||||
BINTARGET=$(DESTDIR)$(YAPLIBDIR)
|
||||
PLTARGET=$(DESTDIR)$(SHAREDIR)
|
||||
|
||||
@ -39,7 +39,7 @@ CWD=$(PWD)
|
||||
#
|
||||
|
||||
LD=@DO_SECOND_LD@ @SHLIB_LD@
|
||||
LDFLAGS=@EXTRA_LIBS_FOR_SWIDLLS@
|
||||
LDFLAGS=@EXTRA_LIBS_FOR_SWIDLLS@ @LDFLAGS@
|
||||
|
||||
BINTARGET=$(DESTDIR)$(YAPLIBDIR)
|
||||
PLTARGET=$(DESTDIR)$(SHAREDIR)/http
|
||||
|
||||
@ -1 +1 @@
|
||||
Subproject commit 73e4e086d06c54210100f0faaeccbea276c707eb
|
||||
Subproject commit 29151b2fe68f2dc727cdc07040e1fa1ad4fcca20
|
||||
@ -48,7 +48,7 @@ CWD=$(PWD)
|
||||
#
|
||||
|
||||
LD=@DO_SECOND_LD@ @SHLIB_LD@
|
||||
LDFLAGS=@EXTRA_LIBS_FOR_SWIDLLS@
|
||||
LDFLAGS=@EXTRA_LIBS_FOR_SWIDLLS@ @LDFLAGS@
|
||||
|
||||
BINTARGET=$(DESTDIR)$(YAPLIBDIR)
|
||||
PLTARGET=$(DESTDIR)$(SHAREDIR)/semweb
|
||||
|
||||
@ -31,6 +31,7 @@ LN_S=@LN_S@
|
||||
DEFS=@DEFS@ -D_YAP_NOT_INSTALLED_=1
|
||||
CC=@CC@
|
||||
CFLAGS= @SHLIB_CFLAGS@ $(YAP_EXTRAS) $(DEFS) -I$(srcdir) -I../.. -I$(srcdir)/../../include @CPPFLAGS@
|
||||
LDFLAGS=@LDFLAGS@
|
||||
MKINDEX=true
|
||||
|
||||
LD=$(CC)
|
||||
@ -117,7 +118,7 @@ ifeq (@PROLOG_SYSTEM@,yap)
|
||||
$(CC) $(CFLAGS) -o $@ -c $<
|
||||
|
||||
@DO_SECOND_LD@sgml2pl.@SO@: $(PLOBJ)
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ -o sgml2pl.@SO@ $(PLOBJ) @EXTRA_LIBS_FOR_SWIDLLS@
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o sgml2pl.@SO@ $(PLOBJ) @EXTRA_LIBS_FOR_SWIDLLS@
|
||||
|
||||
all: $(TARGETS) $(PROGRAMS)
|
||||
|
||||
|
||||
@ -23,6 +23,7 @@ DEFS=@DEFS@ -D_YAP_NOT_INSTALLED_=1
|
||||
CC=@CC@
|
||||
CXX=@CXX@
|
||||
CXXFLAGS= @SHLIB_CXXFLAGS@ $(YAP_EXTRAS) $(DEFS) -I$(srcdir) -I../../.. -I$(srcdir)/../../../include @CPPFLAGS@
|
||||
LDFLAGS=@LDFLAGS@
|
||||
#
|
||||
#
|
||||
# You shouldn't need to change what follows.
|
||||
@ -70,7 +71,7 @@ pl-minisat.o : $(srcdir)/pl-minisat.C
|
||||
$(CXX) -c $(CXXFLAGS) $(srcdir)/pl-minisat.C -o pl-minisat.o
|
||||
|
||||
@DO_SECOND_LD@pl-minisat.@SO@: $(OBJS)
|
||||
@DO_SECOND_LD@ @SHLIB_CXX_LD@ -o pl-minisat.@SO@ $(OBJS) @EXTRA_LIBS_FOR_SWIDLLS@
|
||||
@DO_SECOND_LD@ @SHLIB_CXX_LD@ $(LDFLAGS) -o pl-minisat.@SO@ $(OBJS) @EXTRA_LIBS_FOR_SWIDLLS@
|
||||
|
||||
install: all
|
||||
$(INSTALL_PROGRAM) $(SOBJS) $(DESTDIR)$(YAPLIBDIR)
|
||||
|
||||
@ -49,7 +49,7 @@ pl-tai.o: $(srcdir)/pl-tai.c
|
||||
$(CC) -c $(CFLAGS) $(srcdir)/pl-tai.c -o pl-tai.o
|
||||
|
||||
@DO_SECOND_LD@pl-tai.@SO@: pl-tai.o
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ -o pl-tai.@SO@ pl-tai.o libtai/libtai.a @EXTRA_LIBS_FOR_SWIDLLS@
|
||||
@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o pl-tai.@SO@ pl-tai.o libtai/libtai.a @EXTRA_LIBS_FOR_SWIDLLS@
|
||||
|
||||
install: all
|
||||
$(INSTALL_PROGRAM) $(SOBJS) $(DESTDIR)$(YAPLIBDIR)
|
||||
|
||||
@ -46,7 +46,7 @@ CWD=$(PWD)
|
||||
#
|
||||
|
||||
LD=@DO_SECOND_LD@ @SHLIB_LD@
|
||||
LDFLAGS=@EXTRA_LIBS_FOR_SWIDLLS@
|
||||
LDFLAGS=@EXTRA_LIBS_FOR_SWIDLLS@ @LDFLAGS@
|
||||
|
||||
BINTARGET=$(DESTDIR)$(YAPLIBDIR)
|
||||
PLTARGET=$(DESTDIR)$(SHAREDIR)
|
||||
|
||||
@ -515,7 +515,7 @@ true :- true.
|
||||
X == '$', !,
|
||||
( recorded('$reconsulting',_,R) -> erase(R) ).
|
||||
|
||||
'$prompt_alternatives_on'(groundness).
|
||||
'$prompt_alternatives_on'(determinism).
|
||||
|
||||
/* Executing a query */
|
||||
|
||||
@ -536,7 +536,8 @@ true :- true.
|
||||
% end of YAPOR
|
||||
|
||||
'$query'(G,[]) :-
|
||||
'$prompt_alternatives_on'(groundness), !,
|
||||
'$prompt_alternatives_on'(OPT),
|
||||
( OPT = groundness ; OPT = determinism), !,
|
||||
'$yes_no'(G,(?-)).
|
||||
'$query'(G,V) :-
|
||||
(
|
||||
|
||||
@ -149,7 +149,7 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
|
||||
;
|
||||
get_value('$syntaxcheckmultiple',on)
|
||||
)),
|
||||
recorded('$reconsulting',File,_),
|
||||
nb_getval('$consulting_file',File),
|
||||
'$xtract_head'(T,M,NM,_,F,A),
|
||||
\+ (
|
||||
% allow duplicates if we are not the last predicate to have
|
||||
|
||||
@ -206,5 +206,5 @@ file_search_path(system, Dir) :-
|
||||
prolog_flag(host_type, Dir).
|
||||
file_search_path(foreign, yap('lib/Yap')).
|
||||
|
||||
%:- yap_flag(unknown,error).
|
||||
:- yap_flag(unknown,error).
|
||||
|
||||
|
||||
@ -191,11 +191,21 @@
|
||||
Run \= off,
|
||||
'$zip'(-1, G, Mod), !,
|
||||
'$signal_creep',
|
||||
'$execute_nonstop'(G,Mod).
|
||||
'$execute_goal'(G, Mod).
|
||||
'$start_creep'([Mod|G]) :-
|
||||
CP is '$last_choice_pt',
|
||||
'$do_spy'(G, Mod, CP, no).
|
||||
|
||||
'$execute_goal'(G, Mod) :-
|
||||
(
|
||||
'$is_metapredicate'(G, Mod)
|
||||
->
|
||||
'$meta_call'(G,Mod)
|
||||
;
|
||||
'$execute_nonstop'(G,Mod)
|
||||
).
|
||||
|
||||
|
||||
'$signal_do'(Sig, Goal) :-
|
||||
recorded('$signal_handler', action(Sig,Goal), _), !.
|
||||
'$signal_do'(Sig, Goal) :-
|
||||
|
||||
23
pl/utils.yap
23
pl/utils.yap
@ -668,10 +668,14 @@ sub_atom(At, Bef, Size, After, SubAt) :-
|
||||
atom_to_term(Atom, Term, Bindings) :-
|
||||
atom_codes(Atom, Chars),
|
||||
charsio:open_mem_read_stream(Chars, Stream),
|
||||
read_term(Stream, T, [variable_names(Bindings)]),
|
||||
catch(read_term(Stream, T, [variable_names(Bindings)]),Error,'$handle_atom_to_term_error'(Stream, Error)),
|
||||
close(Stream),
|
||||
T = Term.
|
||||
|
||||
'$handle_atom_to_term_error'(Stream, Error) :-
|
||||
close(Stream),
|
||||
throw(Error).
|
||||
|
||||
term_to_atom(Term,Atom) :-
|
||||
nonvar(Atom), !,
|
||||
atom_codes(Atom,S),
|
||||
@ -680,6 +684,23 @@ term_to_atom(Term,Atom) :-
|
||||
charsio:write_to_chars(Term,S),
|
||||
atom_codes(Atom,S).
|
||||
|
||||
%
|
||||
% hack this here.
|
||||
%
|
||||
charsio:write_to_chars(Term, L0, OUT) :-
|
||||
charsio:open_mem_write_stream(Stream),
|
||||
prolog:write(Stream, Term),
|
||||
charsio:peek_mem_write_stream(Stream, L0, O),
|
||||
prolog:close(Stream),
|
||||
O = OUT.
|
||||
|
||||
charsio:read_from_chars(Chars, Term) :-
|
||||
charsio:open_mem_read_stream(Chars, Stream),
|
||||
prolog:read(Stream, T),
|
||||
prolog:close(Stream),
|
||||
T = Term.
|
||||
|
||||
|
||||
simple(V) :- var(V), !.
|
||||
simple(A) :- atom(A), !.
|
||||
simple(N) :- number(N).
|
||||
|
||||
Reference in New Issue
Block a user