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

Merge ssh://ssh.dcc.fc.up.pt:31064//home/vsc/yap

Browse Source
This commit is contained in:
Vitor Santos Costa 2018-10-07 17:00:51 +01:00
commit be12fb92d6
16 changed files with 1608 additions and 473 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

191
C/c_interface.c
View File

@ -218,6 +218,11 @@ X_API YAP_Term YAP_A(int i) {
return (Deref(XREGS[i])); return (Deref(XREGS[i]));
} }
X_API YAP_Term YAP_SetA(int i, YAP_Term t) {
CACHE_REGS
return (Deref(XREGS[i]));
}
X_API YAP_Bool YAP_IsIntTerm(YAP_Term t) { return IsIntegerTerm(t); } X_API YAP_Bool YAP_IsIntTerm(YAP_Term t) { return IsIntegerTerm(t); }
X_API YAP_Bool YAP_IsNumberTerm(YAP_Term t) { X_API YAP_Bool YAP_IsNumberTerm(YAP_Term t) {
@ -288,23 +293,23 @@ X_API Term YAP_MkIntTerm(Int n) {
} }
X_API Term YAP_MkStringTerm(const char *n) { X_API Term YAP_MkStringTerm(const char *n) {
CACHE_REGS CACHE_REGS
Term I; Term I;
BACKUP_H(); BACKUP_H();
I = MkStringTerm(n); I = MkStringTerm(n);
RECOVER_H(); RECOVER_H();
return I; return I;
} }
X_API Term YAP_MkCharPTerm( char *n) { X_API Term YAP_MkCharPTerm(char *n) {
CACHE_REGS CACHE_REGS
Term I; Term I;
BACKUP_H(); BACKUP_H();
I = MkStringTerm(n); I = MkStringTerm(n);
RECOVER_H(); RECOVER_H();
return I; return I;
} }
X_API Term YAP_MkUnsignedStringTerm(const unsigned char *n) { X_API Term YAP_MkUnsignedStringTerm(const unsigned char *n) {
@ -1352,8 +1357,8 @@ X_API void YAP_FreeSpaceFromYap(void *ptr) { Yap_FreeCodeSpace(ptr); }
* @param bufsize bu * @param bufsize bu
* *
* @return * @return
*/ X_API char * */
YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize) { X_API char *YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize) {
CACHE_REGS CACHE_REGS
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
seq_tv_t inp, out; seq_tv_t inp, out;
@ -1464,7 +1469,8 @@ X_API Term YAP_ReadBuffer(const char *s, Term *tp) {
else else
tv = (Term)0; tv = (Term)0;
LOCAL_ErrorMessage = NULL; LOCAL_ErrorMessage = NULL;
while (!(t = Yap_BufferToTermWithPrioBindings(s, TermNil, tv, strlen(s) + 1, GLOBAL_MaxPriority))) { while (!(t = Yap_BufferToTermWithPrioBindings(s, TermNil, tv, strlen(s) + 1,
GLOBAL_MaxPriority))) {
if (LOCAL_ErrorMessage) { if (LOCAL_ErrorMessage) {
if (!strcmp(LOCAL_ErrorMessage, "Stack Overflow")) { if (!strcmp(LOCAL_ErrorMessage, "Stack Overflow")) {
if (!Yap_dogc(0, NULL PASS_REGS)) { if (!Yap_dogc(0, NULL PASS_REGS)) {
@ -1492,7 +1498,7 @@ X_API Term YAP_ReadBuffer(const char *s, Term *tp) {
return 0L; return 0L;
} }
LOCAL_ErrorMessage = NULL; LOCAL_ErrorMessage = NULL;
RECOVER_H(); RECOVER_H();
return 0; return 0;
} else { } else {
break; break;
@ -1731,7 +1737,9 @@ X_API bool YAP_EnterGoal(YAP_PredEntryPtr ape, CELL *ptr, YAP_dogoalinfo *dgi) {
CACHE_REGS CACHE_REGS
PredEntry *pe = ape; PredEntry *pe = ape;
bool out; bool out;
// fprintf(stderr,"EnterGoal: H=%d ENV=%p B=%d TR=%d P=%p CP=%p Slots=%d\n",HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot); // fprintf(stderr,"EnterGoal: H=%d ENV=%p B=%d TR=%d P=%p CP=%p
// Slots=%d\n",HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP,
// LOCAL_CurSlot);
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
LOCAL_ActiveError->errorNo = YAP_NO_ERROR; LOCAL_ActiveError->errorNo = YAP_NO_ERROR;
@ -1748,12 +1756,14 @@ X_API bool YAP_EnterGoal(YAP_PredEntryPtr ape, CELL *ptr, YAP_dogoalinfo *dgi) {
// slot=%d", pe, pe->CodeOfPred->opc, FAILCODE, Deref(ARG1), Deref(ARG2), // slot=%d", pe, pe->CodeOfPred->opc, FAILCODE, Deref(ARG1), Deref(ARG2),
// LOCAL_CurSlot); // LOCAL_CurSlot);
dgi->b = LCL0 - (CELL *)B; dgi->b = LCL0 - (CELL *)B;
dgi->h = HR-H0; dgi->h = HR - H0;
dgi->tr = (CELL*)TR-LCL0; dgi->tr = (CELL *)TR - LCL0;
//fprintf(stderr,"PrepGoal: H=%d ENV=%p B=%d TR=%d P=%p CP=%p Slots=%d\n", // fprintf(stderr,"PrepGoal: H=%d ENV=%p B=%d TR=%d P=%p CP=%p Slots=%d\n",
// HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot); // HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot);
out = Yap_exec_absmi(true, false); out = Yap_exec_absmi(true, false);
// fprintf(stderr,"EnterGoal success=%d: H=%d ENV=%p B=%d TR=%d P=%p CP=%p Slots=%d\n", out,HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot); // fprintf(stderr,"EnterGoal success=%d: H=%d ENV=%p B=%d TR=%d P=%p CP=%p
// Slots=%d\n", out,HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP,
// LOCAL_CurSlot);
dgi->b = LCL0 - (CELL *)B; dgi->b = LCL0 - (CELL *)B;
if (out) { if (out) {
dgi->EndSlot = LOCAL_CurSlot; dgi->EndSlot = LOCAL_CurSlot;
@ -1768,13 +1778,13 @@ X_API bool YAP_EnterGoal(YAP_PredEntryPtr ape, CELL *ptr, YAP_dogoalinfo *dgi) {
X_API bool YAP_RetryGoal(YAP_dogoalinfo *dgi) { X_API bool YAP_RetryGoal(YAP_dogoalinfo *dgi) {
CACHE_REGS CACHE_REGS
choiceptr myB, myB0; choiceptr myB, myB0;
bool out; bool out;
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
myB = (choiceptr)(LCL0 - dgi->b); myB = (choiceptr)(LCL0 - dgi->b);
myB0 = (choiceptr)(LCL0 - dgi->b0); myB0 = (choiceptr)(LCL0 - dgi->b0);
CP = myB->cp_cp; CP = myB->cp_cp;
/* sanity check */ /* sanity check */
if (B >= myB0) { if (B >= myB0) {
return false; return false;
@ -1783,8 +1793,8 @@ X_API bool YAP_RetryGoal(YAP_dogoalinfo *dgi) {
// get rid of garbage choice-points // get rid of garbage choice-points
B = myB; B = myB;
} }
//fprintf(stderr,"RetryGoal: H=%d ENV=%p B=%d TR=%d P=%p CP=%p Slots=%d\n", // fprintf(stderr,"RetryGoal: H=%d ENV=%p B=%d TR=%d P=%p CP=%p Slots=%d\n",
// HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot); // HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot);
P = FAILCODE; P = FAILCODE;
/* make sure we didn't leave live slots when we backtrack */ /* make sure we didn't leave live slots when we backtrack */
ASP = (CELL *)B; ASP = (CELL *)B;
@ -1792,7 +1802,7 @@ X_API bool YAP_RetryGoal(YAP_dogoalinfo *dgi) {
out = run_emulator(PASS_REGS1); out = run_emulator(PASS_REGS1);
if (out) { if (out) {
dgi->EndSlot = LOCAL_CurSlot; dgi->EndSlot = LOCAL_CurSlot;
dgi->b = LCL0-(CELL *)B; dgi->b = LCL0 - (CELL *)B;
} else { } else {
LOCAL_CurSlot = LOCAL_CurSlot =
dgi->CurSlot; // ignore any slots created within the called goal dgi->CurSlot; // ignore any slots created within the called goal
@ -1801,9 +1811,8 @@ X_API bool YAP_RetryGoal(YAP_dogoalinfo *dgi) {
return out; return out;
} }
static void completeInnerCall( bool on_cut, yamop *old_CP, yamop *old_P) static void completeInnerCall(bool on_cut, yamop *old_CP, yamop *old_P) {
{ if (on_cut) {
if (on_cut) {
P = old_P; P = old_P;
ENV = (CELL *)ENV[E_E]; ENV = (CELL *)ENV[E_E];
CP = old_CP; CP = old_CP;
@ -1821,45 +1830,47 @@ static void completeInnerCall( bool on_cut, yamop *old_CP, yamop *old_P)
SET_ASP(ENV, E_CB * sizeof(CELL)); SET_ASP(ENV, E_CB * sizeof(CELL));
// make sure the slots are ok. // make sure the slots are ok.
} }
} }
X_API bool YAP_LeaveGoal(bool successful, YAP_dogoalinfo *dgi) { X_API bool YAP_LeaveGoal(bool successful, YAP_dogoalinfo *dgi) {
CACHE_REGS CACHE_REGS
choiceptr myB, handler; choiceptr myB, handler;
// fprintf(stderr,"LeaveGoal success=%d: H=%d ENV=%p B=%ld myB=%ld TR=%d P=%p CP=%p Slots=%d\n", successful,HR-H0,LCL0-ENV,LCL0-(CELL*)B,dgi->b0,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot); // fprintf(stderr,"LeaveGoal success=%d: H=%d ENV=%p B=%ld myB=%ld TR=%d
// P=%p CP=%p Slots=%d\n",
// successful,HR-H0,LCL0-ENV,LCL0-(CELL*)B,dgi->b0,(CELL*)TR-LCL0, P, CP,
// LOCAL_CurSlot);
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
myB = (choiceptr)(LCL0 - dgi->b); myB = (choiceptr)(LCL0 - dgi->b);
if (LOCAL_PrologMode & AsyncIntMode) { if (LOCAL_PrologMode & AsyncIntMode) {
Yap_signal(YAP_FAIL_SIGNAL); Yap_signal(YAP_FAIL_SIGNAL);
}
handler = B;
while (handler
&& LCL0-LOCAL_CBorder > (CELL *)handler
//&& handler->cp_ap != NOCODE
&& handler->cp_b != NULL
&& handler != myB
) {
if (handler < myB ) {
handler->cp_ap = TRUSTFAILCODE;
}
B = handler;
handler = handler->cp_b;
if (successful) {
Yap_TrimTrail();
} else if (!(LOCAL_PrologMode & AsyncIntMode)) {
P=FAILCODE;
Yap_exec_absmi(true, YAP_EXEC_ABSMI);
} }
handler = B;
while (handler &&
LCL0 - LOCAL_CBorder > (CELL *)handler
//&& handler->cp_ap != NOCODE
&& handler->cp_b != NULL && handler != myB) {
if (handler < myB) {
handler->cp_ap = TRUSTFAILCODE;
}
B = handler;
handler = handler->cp_b;
if (successful) {
Yap_TrimTrail();
} else if (!(LOCAL_PrologMode & AsyncIntMode)) {
P = FAILCODE;
Yap_exec_absmi(true, YAP_EXEC_ABSMI);
}
} }
if (LOCAL_PrologMode & AsyncIntMode) { if (LOCAL_PrologMode & AsyncIntMode) {
Yap_signal(YAP_FAIL_SIGNAL); Yap_signal(YAP_FAIL_SIGNAL);
} }
P=dgi->p; P = dgi->p;
CP = dgi->cp; CP = dgi->cp;
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
// fprintf(stderr,"LeftGoal success=%d: H=%d ENV=%p B=%d TR=%d P=%p CP=%p Slots=%d\n", successful,HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot); // fprintf(stderr,"LeftGoal success=%d: H=%d ENV=%p B=%d TR=%d P=%p CP=%p
// Slots=%d\n", successful,HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P,
// CP, LOCAL_CurSlot);
return TRUE; return TRUE;
} }
@ -1875,7 +1886,7 @@ X_API Int YAP_RunGoal(Term t) {
LOCAL_PrologMode = UserCCallMode; LOCAL_PrologMode = UserCCallMode;
// should we catch the exception or pass it through? // should we catch the exception or pass it through?
// We'll pass it through // We'll pass it through
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
LOCAL_CurSlot = cslot; LOCAL_CurSlot = cslot;
return out; return out;
} }
@ -1958,7 +1969,7 @@ X_API Int YAP_RunGoalOnce(Term t) {
CSlot = Yap_StartSlots(); CSlot = Yap_StartSlots();
LOCAL_PrologMode = UserMode; LOCAL_PrologMode = UserMode;
// Yap_heap_regs->yap_do_low_level_trace=true; // Yap_heap_regs->yap_do_low_level_trace=true;
out = Yap_RunTopGoal(t, true); out = Yap_RunTopGoal(t, true);
LOCAL_PrologMode = oldPrologMode; LOCAL_PrologMode = oldPrologMode;
// Yap_CloseSlots(CSlot); // Yap_CloseSlots(CSlot);
if (!(oldPrologMode & UserCCallMode)) { if (!(oldPrologMode & UserCCallMode)) {
@ -2114,14 +2125,16 @@ X_API void YAP_ClearExceptions(void) {
Yap_ResetException(worker_id); Yap_ResetException(worker_id);
} }
X_API int YAP_InitConsult(int mode, const char *fname, char **full, int *osnop) { X_API int YAP_InitConsult(int mode, const char *fname, char **full,
int *osnop) {
CACHE_REGS CACHE_REGS
int sno; int sno;
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
const char *fl = NULL; const char *fl = NULL;
int lvl = push_text_stack(); int lvl = push_text_stack();
if (mode == YAP_BOOT_MODE) { if (mode == YAP_BOOT_MODE) {
mode = YAP_CONSULT_MODE; } mode = YAP_CONSULT_MODE;
}
if (fname == NULL || fname[0] == '\0') { if (fname == NULL || fname[0] == '\0') {
fl = Yap_BOOTFILE; fl = Yap_BOOTFILE;
} }
@ -2132,26 +2145,27 @@ X_API int YAP_InitConsult(int mode, const char *fname, char **full, int *osnop)
*full = NULL; *full = NULL;
return -1; return -1;
} else { } else {
*full = pop_output_text_stack(lvl,fl); *full = pop_output_text_stack(lvl, fl);
} }
} else { } else {
pop_text_stack(lvl); pop_text_stack(lvl);
} }
lvl = push_text_stack(); lvl = push_text_stack();
char *d = Malloc(strlen(fl)+1); char *d = Malloc(strlen(fl) + 1);
strcpy(d,fl); strcpy(d, fl);
bool consulted = (mode == YAP_CONSULT_MODE); bool consulted = (mode == YAP_CONSULT_MODE);
Term tat = MkAtomTerm(Yap_LookupAtom(d)); Term tat = MkAtomTerm(Yap_LookupAtom(d));
sno = Yap_OpenStream(tat, "r", MkAtomTerm(Yap_LookupAtom(fname)), LOCAL_encoding); sno = Yap_OpenStream(tat, "r", MkAtomTerm(Yap_LookupAtom(fname)),
if (sno < 0 || LOCAL_encoding);
!Yap_ChDir(dirname((char *)d))) { if (sno < 0 || !Yap_ChDir(dirname((char *)d))) {
pop_text_stack(lvl); pop_text_stack(lvl);
*full = NULL; *full = NULL;
return -1; return -1;
} LOCAL_PrologMode = UserMode; }
LOCAL_PrologMode = UserMode;
Yap_init_consult(consulted, pop_output_text_stack__(lvl,fl)); Yap_init_consult(consulted, pop_output_text_stack__(lvl, fl));
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return sno; return sno;
@ -2179,16 +2193,19 @@ X_API void YAP_EndConsult(int sno, int *osnop, const char *full) {
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
Yap_CloseStream(sno); Yap_CloseStream(sno);
int lvl = push_text_stack(); int lvl = push_text_stack();
char *d = Malloc(strlen(full)+1); char *d = Malloc(strlen(full) + 1);
strcpy(d,full); strcpy(d, full);
Yap_ChDir(dirname(d)); Yap_ChDir(dirname(d));
if (osnop >= 0) if (osnop >= 0)
Yap_AddAlias(AtomLoopStream, *osnop); Yap_AddAlias(AtomLoopStream, *osnop);
Yap_end_consult(); Yap_end_consult();
__android_log_print(ANDROID_LOG_INFO, "YAPDroid ", " closing %s:%s(%d), %d", __android_log_print(ANDROID_LOG_INFO, "YAPDroid ", " closing %s:%s(%d), %d",
CurrentModule == 0? "prolog": RepAtom(AtomOfTerm(CurrentModule))->StrOfAE, full, *osnop, sno); CurrentModule == 0
// LOCAL_CurSlot); ? "prolog"
pop_text_stack(lvl); : RepAtom(AtomOfTerm(CurrentModule))->StrOfAE,
full, *osnop, sno);
// LOCAL_CurSlot);
pop_text_stack(lvl);
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
} }
@ -2215,7 +2232,13 @@ X_API Term YAP_ReadFromStream(int sno) {
X_API Term YAP_ReadClauseFromStream(int sno, Term vs, Term pos) { X_API Term YAP_ReadClauseFromStream(int sno, Term vs, Term pos) {
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
Term t = Yap_read_term(sno,MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames,1),1,&vs), MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomTermPosition,1),1,&pos), TermNil)), true); Term t = Yap_read_term(
sno,
MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1, &vs),
MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomTermPosition, 1),
1, &pos),
TermNil)),
true);
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
return t; return t;
} }
@ -2275,7 +2298,7 @@ X_API int YAP_WriteDynamicBuffer(YAP_Term t, char *buf, size_t sze,
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
b = Yap_TermToBuffer(t, flags); b = Yap_TermToBuffer(t, flags);
strncpy(buf, b, sze-1); strncpy(buf, b, sze - 1);
buf[sze] = 0; buf[sze] = 0;
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
return true; return true;
@ -2315,7 +2338,7 @@ X_API bool YAP_CompileClause(Term t) {
} }
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
if (!ok) { if (!ok) {
return NULL; return NULL;
} }
return ok; return ok;
} }
@ -2540,12 +2563,12 @@ X_API int YAP_HaltRegisterHook(HaltHookFunc hook, void *closure) {
X_API char *YAP_cwd(void) { X_API char *YAP_cwd(void) {
CACHE_REGS CACHE_REGS
char *buf = Yap_AllocCodeSpace(FILENAME_MAX+1); char *buf = Yap_AllocCodeSpace(FILENAME_MAX + 1);
int len; int len;
if (!Yap_getcwd(buf, FILENAME_MAX)) if (!Yap_getcwd(buf, FILENAME_MAX))
return FALSE; return FALSE;
len = strlen(buf); len = strlen(buf);
buf = Yap_ReallocCodeSpace(buf,len+1); buf = Yap_ReallocCodeSpace(buf, len + 1);
return buf; return buf;
} }

2
C/cdmgr.c
View File

@ -85,7 +85,7 @@ static void InitConsultStack(void) {
LOCAL_ConsultCapacity = InitialConsultCapacity; LOCAL_ConsultCapacity = InitialConsultCapacity;
LOCAL_ConsultBase = LOCAL_ConsultSp = LOCAL_ConsultBase = LOCAL_ConsultSp =
LOCAL_ConsultLow + LOCAL_ConsultCapacity; LOCAL_ConsultLow + LOCAL_ConsultCapacity;
s }
void Yap_ResetConsultStack(void) { void Yap_ResetConsultStack(void) {
CACHE_REGS CACHE_REGS

2
C/exec.c
View File

@ -327,7 +327,7 @@ inline static bool do_execute(Term t, Term mod USES_REGS) {
/* I cannot use the standard macro here because /* I cannot use the standard macro here because
otherwise I would dereference the argument and otherwise I would dereference the argument and
might skip a svar */ might skip a svar */
if (pen->PredFlags & (MetaPredFlag | UndefPredFlag)) { if (pen->PredFlags & (MetaPredFlag | UndefPredFlag | SpiedPredFlag)) {
return CallMetaCall(t0, mod0 PASS_REGS); return CallMetaCall(t0, mod0 PASS_REGS);
} }
pt = RepAppl(t) + 1; pt = RepAppl(t) + 1;

1
H/YapFlags.h
View File

@ -354,6 +354,7 @@ static inline bool verboseMode(void) {
return GLOBAL_Flags[VERBOSE_FLAG].at != TermSilent; return GLOBAL_Flags[VERBOSE_FLAG].at != TermSilent;
} }
static inline void setVerbosity(Term val) { static inline void setVerbosity(Term val) {
GLOBAL_Flags[VERBOSE_FLAG].at = val; GLOBAL_Flags[VERBOSE_FLAG].at = val;
} }

17
include/YapInterface.h
View File

@ -102,6 +102,9 @@ extern YAP_Term YAP_A(int);
#define YAP_ARG15 YAP_A(15) #define YAP_ARG15 YAP_A(15)
#define YAP_ARG16 YAP_A(16) #define YAP_ARG16 YAP_A(16)
X_API
extern YAP_Term YAP_SetA(int, YAP_Term);
/* YAP_Bool IsVarTerm(YAP_Term) */ /* YAP_Bool IsVarTerm(YAP_Term) */
extern X_API YAP_Bool YAP_IsVarTerm(YAP_Term); extern X_API YAP_Bool YAP_IsVarTerm(YAP_Term);
@ -268,7 +271,6 @@ extern X_API void YAP_UserCPredicateWithArgs(const char *, YAP_UserCPred,
extern X_API void YAP_UserBackCPredicate(const char *, YAP_UserCPred, extern X_API void YAP_UserBackCPredicate(const char *, YAP_UserCPred,
YAP_UserCPred, YAP_Arity, YAP_Arity); YAP_UserCPred, YAP_Arity, YAP_Arity);
/* void UserBackCPredicate(char *name, int *init(), int *cont(), int *cut(), /* void UserBackCPredicate(char *name, int *init(), int *cont(), int *cut(),
int int
arity, int extra) */ arity, int extra) */
@ -371,7 +373,7 @@ extern X_API YAP_Term YAP_CopyTerm(YAP_Term t);
/* bool YAP_CompileClause(YAP_Term) /* bool YAP_CompileClause(YAP_Term)
@short compile the clause _Cl_; on failure it may call the exception handler. */ @short compile the clause _Cl_; on failure it may call the exception handler. */
extern X_API bool YAP_CompileClause(YAP_Term Cl); extern X_API bool YAP_CompileClause(YAP_Term Cl);
extern X_API int YAP_NewExo(YAP_PredEntryPtr ap, size_t data, void *user_di); extern X_API int YAP_NewExo(YAP_PredEntryPtr ap, size_t data, void *user_di);
@ -383,8 +385,7 @@ extern X_API int YAP_AssertTuples(YAP_PredEntryPtr pred, const YAP_Term *ts,
extern X_API void YAP_Init(YAP_init_args *); extern X_API void YAP_Init(YAP_init_args *);
/* int YAP_FastInit(const char *) */ /* int YAP_FastInit(const char *) */
extern X_API void YAP_FastInit(char saved_state[], int argc, extern X_API void YAP_FastInit(char saved_state[], int argc, char *argv[]);
char *argv[]);
#ifndef _PL_STREAM_H #ifndef _PL_STREAM_H
// if we don't know what a stream is, just don't assume nothing about the // if we don't know what a stream is, just don't assume nothing about the
@ -402,7 +403,8 @@ extern X_API YAP_Term YAP_ReadFromStream(int s);
/// read a Prolog clause from a Prolog opened stream $s$. Similar to /// read a Prolog clause from a Prolog opened stream $s$. Similar to
/// YAP_ReadFromStream() but takes /// default options from read_clause/3. /// YAP_ReadFromStream() but takes /// default options from read_clause/3.
extern X_API YAP_Term YAP_ReadClauseFromStream(int s, YAP_Term varNames, YAP_Term); extern X_API YAP_Term YAP_ReadClauseFromStream(int s, YAP_Term varNames,
YAP_Term);
extern X_API void YAP_Write(YAP_Term t, FILE *s, int); extern X_API void YAP_Write(YAP_Term t, FILE *s, int);
@ -411,7 +413,8 @@ extern X_API FILE *YAP_TermToStream(YAP_Term t);
extern X_API int YAP_InitConsult(int mode, const char *filename, char **buf, extern X_API int YAP_InitConsult(int mode, const char *filename, char **buf,
int *previous_sno); int *previous_sno);
extern X_API void YAP_EndConsult(int s, int *previous_sno, const char *previous_cwd); extern X_API void YAP_EndConsult(int s, int *previous_sno,
const char *previous_cwd);
extern X_API void YAP_Exit(int); extern X_API void YAP_Exit(int);
@ -477,7 +480,6 @@ extern X_API void YAP_SetOutputMessage(void);
extern X_API int YAP_StreamToFileNo(YAP_Term); extern X_API int YAP_StreamToFileNo(YAP_Term);
/** /**
* Utility routine to Obtain a pointer to the YAP representation of a stream. * Utility routine to Obtain a pointer to the YAP representation of a stream.
* *
@ -486,7 +488,6 @@ extern X_API int YAP_StreamToFileNo(YAP_Term);
*/ */
extern X_API void *YAP_RepStreamFromId(int sno); extern X_API void *YAP_RepStreamFromId(int sno);
extern X_API void YAP_CloseAllOpenStreams(void); extern X_API void YAP_CloseAllOpenStreams(void);
extern X_API void YAP_FlushAllStreams(void); extern X_API void YAP_FlushAllStreams(void);

8
packages/ProbLog/problog_examples/learn_graph.pl
View File

@ -14,8 +14,8 @@
% will run 20 iterations of learning with default settings % will run 20 iterations of learning with default settings
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- use_module(library(problog)). :- use_module(library(matrix)).
:- use_module(library(problog_learning)). :- use_module(('../problog_lbfgs')).
%%%% %%%%
% background knowledge % background knowledge
@ -99,3 +99,7 @@ test_example(33,path(5,4),0.57).
test_example(34,path(6,4),0.51). test_example(34,path(6,4),0.51).
test_example(35,path(6,5),0.69). test_example(35,path(6,5),0.69).
:- set_problog_flag(init_method,(Query,_,BDD,
problog_exact_lbdd(user:Query,BDD))).

30
packages/ProbLog/problog_lbdd.yap
View File

@ -6,24 +6,23 @@
:- use_module(library(bdd)). :- use_module(library(bdd)).
:- use_module(library(bhash)). :- use_module(library(bhash)).
problog_exact_lbdd(Goal,Prob,Status) :- problog_exact_lbdd(Goal,BDD) :-
problog_control(on, exact), problog_low_lbdd(Goal, 0, _, _, BDD).
problog_low_lbdd(Goal,0,Prob,Status),
problog_control(off, exact).
problog_low_lbdd(Goal, Threshold, _, _) :- problog_low_lbdd(Goal, Threshold, _, _, _) :-
init_problog_low(Threshold), init_problog_low(Threshold),
problog_control(off, up), problog_control(off, up),
timer_start(sld_time), timer_start(sld_time),
problog_call(Goal), problog_call(Goal),
add_solution, add_solution,
fail. fail.
problog_low_lbdd(_, _, Prob, ok) :- problog_low_lbdd(_, _, Prob, ok, bdd(Dir, Tree, MapList)) :-
timer_stop(sld_time,SLD_Time), timer_stop(sld_time,SLD_Time),
problog_var_set(sld_time, SLD_Time), problog_var_set(sld_time, SLD_Time),
nb_getval(problog_completed_proofs, Trie_Completed_Proofs), nb_getval(problog_completed_proofs, Trie_Completed_Proofs),
tabled_trie_to_bdd(Trie_Completed_Proofs, BDD, MapList), trie_to_bdd(Trie_Completed_Proofs, BDD, MapList),
bind_maplist(MapList, BoundVars), bind_maplist(MapList, BoundVars),
bdd_tree(BDD, bdd(Dir, Tree, _Vars)),
bdd_to_probability_sum_product(BDD, BoundVars, Prob), bdd_to_probability_sum_product(BDD, BoundVars, Prob),
(problog_flag(verbose, true)-> (problog_flag(verbose, true)->
problog_statistics problog_statistics
@ -73,6 +72,23 @@ problog_fl_bdd(_,Prob) :-
(problog_flag(retain_tables, true) -> retain_tabling; true), (problog_flag(retain_tables, true) -> retain_tabling; true),
clear_tabling. clear_tabling.
problog_full_bdd(Goal,_K, _) :-
init_problog_low(0.0),
problog_control(off, up),
timer_start(sld_time),
problog_call(Goal),
add_solution,
fail.
problog_full_bdd(_,Prob) :-
timer_stop(sld_time,SLD_Time),
problog_var_set(sld_time, SLD_Time),
nb_getval(problog_completed_proofs, Trie_Completed_Proofs),
tabled_trie_to_bdd(Trie_Completed_Proofs, BDD, MapList),
bind_maplist(MapList, BoundVars),
bdd_to_probability_sum_product(BDD, BoundVars, Prob),
(problog_flag(retain_tables, true) -> retain_tabling; true),
clear_tabling.
bind_maplist([], []). bind_maplist([], []).
bind_maplist([Node-_|MapList], [ProbFact|BoundVars]) :- bind_maplist([Node-_|MapList], [ProbFact|BoundVars]) :-
get_fact_probability(Node,ProbFact), get_fact_probability(Node,ProbFact),

1012
packages/ProbLog/problog_lbfgs.yap Normal file
View File

File diff suppressed because it is too large Load Diff

29
packages/yap-lbfgs/ex1.pl
View File

@ -22,35 +22,34 @@
:- use_module(library(matrix)). :- use_module(library(matrix)).
% This is the call back function which evaluates F and the gradient of F % This is the call back function which evaluates F and the gradient of F
evaluate(FX,X,G,_N,_Step) :- evaluate(FX,X,G,_N,_Step,_User) :-
X0 <== X[0], X0 <== X[0],
FX is sin(X0), FX is sin(X0),
G0 is cos(X0), G0 is cos(X0),
G[0] <== G0. G[0] <== G0.
% This is the call back function which is invoked to report the progress % This is the call back function which is invoked to report the progress
% if the last argument is set to anywhting else than 0, the optimizer will % if the last argument is set to anything else than 0, the lbfgs will
% stop right now % stop right now
progress(FX,X,G,X_Norm,G_Norm,Step,_N,Iteration,Ls, 0) :- progress(FX,X,G,X_Norm,G_Norm,Step,_N,Iteration,Ls,0) :-
X0 <== X[0], X0 <== X[0],
format('~d. Iteration : x0=~4f f(X)=~4f |X|=~4f |X\'|=~4f Step=~4f Ls=~4f~n', format('~d. Iteration : x0=~4f f(X)=~4f |X|=~4f
[Iteration,X0,FX,X_Norm,G_Norm,Step,Ls]). |X\'|=~4f Step=~4f Ls=~4f~n',
[Iteration,X0,FX,X_Norm,G_Norm,Step,Ls]).
demo :- demo :-
format('Optimizing the function f(x0) = sin(x0)~n',[]), format('Optimizing the function f(x0) = sin(x0)~n',[]),
optimizer_initialize(1,X,Status), lbfgs_initialize(1,X,FX,Solver),
StartX is random*10, StartX is random*10,
format('We start the search at the random position x0=~5f~2n',[StartX]), format('We start the search at the random position x0=~5f~2n',[StartX]),
X[0] <== StartX, X[0] <== StartX,
lbfgs_run(Solver,BestF),
optimizer_run(Status, BestF, BestX0, O),
BestX0 <== X[0], BestX0 <== X[0],
optimizer_finalize(Status), lbfgs_finalize(Solver),
format('~2nOptimization done~nWe found a minimum at f(~f)=~f~2nLBFGS Status=~w~n',[BestX0,BestF,O]). format('~2nOptimization done~nWe found a minimum at
f(~f)=~f~2nLBFGS Status=~w~n',[BestX0,BestF,Status]).

24
packages/yap-lbfgs/ex2.pl
View File

@ -20,13 +20,14 @@
:- use_module(library(lbfgs)). :- use_module(library(lbfgs)).
:- use_module(library(matrix)). :- use_module(library(matrix)).
f(X0,X1,FX) :-
FX is (X0-2)*(X0-2) + (X1-1)*(X1-1).
% This is the call back function which evaluates F and the gradient of F % This is the call back function which evaluates F and the gradient of F
evaluate(FX,X,G,_N,_Step) :- evaluate(FX,X,G,_N,_Step,_U) :-
X0 <== X[0], X0 <== X[0],
X1 <== X[1], X1 <== X[1],
f(X0,X1,FX),
FX is (X0-2)*(X0-2) + (X1-1)*(X1-1),
G0 is 2*(X0-2), G0 is 2*(X0-2),
G1 is 2*(X1-2), G1 is 2*(X1-2),
G[0] <== G0, G[0] <== G0,
@ -38,28 +39,27 @@ evaluate(FX,X,G,_N,_Step) :-
progress(FX,X,_G,X_Norm,G_Norm,Step,_N,Iteration,Ls,0) :- progress(FX,X,_G,X_Norm,G_Norm,Step,_N,Iteration,Ls,0) :-
X0 <== X[0], X0 <== X[0],
X1 <== X[1], X1 <== X[1],
format('~d. Iteration : (x0,x1)=(~4f,~4f) f(X)=~4f |X|=~4f |X\'|=~4f Step=~4f Ls=~4f~n',[Iteration,X0,X1,FX,X_Norm,G_Norm,Step,Ls]). format('~d. Iteration : (x0,x1)=(~4f,~4f) f(X)=~4f |X|=~4f |X\'|=~4f Step=~4f Ls=~4f~n',[Iteration,X0,X1,FX,X_Norm,G_Norm,Step,Ls]).
demo :- demo :-
format('Optimizing the function f(x0,x1) = (x0-2)^2 + (x1-1)^2~n',[]), format('Optimizing the function f(x0,x1) = (x0-2)^2 + (x1-1)^2~n',[]),
optimizer_initialize(2,X,Status),
lbfgs_initialize(2,X,0,Solver),
StartX0 is random*1000-500, StartX0 is random*1000-500,
StartX1 is random*1000-500, StartX1 is random*1000-500,
format('We start the search at the random position (x0,x1)=(~5f,~5f)~2n',[StartX0,StartX1]), format('We start the search at the random position (x0,x1)=(~5f,~5f)~2n',[StartX0,StartX1]),
X[0] <== StartX0, X[0] <== StartX0,
X[1] <== StartX1, X[1] <== StartX1,
lbfgs_run(Solver,BestF,Status),
optimizer_run(Status,BestF,BestX0, O),
BestX0 <== X[0], BestX0 <== X[0],
BestX1 <== X[1], BestX1 <== X[1],
optimizer_finalize, optimizer_finalize(Solver),
format('~2nOptimization done~nWe found a minimum at f(~f,~f)=~f~2nLBFGS Status=~w~n',[BestX0,BestX1,BestF,Status]). format('~2nOptimization done~nWe found a minimum at f(~f,~f)=~f~2nLBFGS Status=~w~n',[BestX0,BestX1,BestF,Status]).

145
packages/yap-lbfgs/lbfgs.pl
View File

@ -20,14 +20,16 @@
:- module(lbfgs,[optimizer_initialize/3, :- module(lbfgs,[lbfgs_initialize/3,
optimizer_run/4, lbfgs_initialize/4,
lbfgs_run/2,
optimizer_finalize/1, lbfgs_finalize/1,
optimizer_set_parameter/3, lbfgs_set_parameter/3,
optimizer_get_parameter/3, lbfgs_get_parameter/3,
optimizer_parameters/1]). lbfgs_parameters/0,
lbfgs_parameters/1]).
% switch on all the checks to reduce bug searching time % switch on all the checks to reduce bug searching time
% :- yap_flag(unknown,error). % :- yap_flag(unknown,error).
@ -48,9 +50,11 @@ minimization problem:
~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~
### Contact ### Contact YAP-LBFGS has been developed by Bernd Gutmann. In case you
YAP-LBFGS has been developed by Bernd Gutmann. In case you publish something using YAP-LBFGS, please give credit to me and to libLBFGS. And if you find YAP-LBFGS useful, or if you find a bug, or if you publish something using YAP-LBFGS, please give credit to me and to
port it to another system, ... please send me an email. libLBFGS. And if you find YAP-LBFGS useful, or if you find a bug, or
if you port it to another system, ... please send me an email.
### License ### License
@ -67,14 +71,14 @@ port it to another system, ... please send me an email.
### Usage</h2> ### Usage</h2>
The module lbfgs provides the following predicates after you loaded The module lbfgs provides the following predicates after you loaded
it by it by
~~~~ ~~~~
:-use_module(library(lbfgs)). :-use_module(library(lbfgs)).
~~~~ ~~~~
+ use optimizer_set_paramater(Name,Value) to change parameters + use lbfgs_set_paramater(Name,Value) to change parameters
+ use optimizer_get_parameter(Name,Value) to see current parameters + use lbfgs_get_parameter(Name,Value) to see current parameters
+ use optimizer_parameters to print this overview + use lbfgs_parameters to print this overview
@ -89,17 +93,18 @@ calculates `f(x0)` and the gradient `d/dx0 f=cos(x0)`.
:- use_module(lbfgs). :- use_module(lbfgs).
% This is the call back function which evaluates F and the gradient of F % This is the call back function which evaluates F and the gradient of F
evaluate(FX,_N,_Step) :- evaluate(FX,X,G,_N,_Step,_User) :-
optimizer_get_x(0,X0), X0 <== X[0],
FX is sin(X0), F is sin(X0),
FX[0] <== F,
G0 is cos(X0), G0 is cos(X0),
optimizer_set_g(0,G0). G[0] <== G0.
% This is the call back function which is invoked to report the progress % This is the call back function which is invoked to report the progress
% if the last argument is set to anything else than 0, the optimizer will % if the last argument is set to anything else than 0, the lbfgs will
% stop right now % stop right now
progress(FX,X_Norm,G_Norm,Step,_N,Iteration,Ls,0) :- progress(FX,X,X_Norm,G_Norm,Step,_N,Iteration,Ls,0) :-
optimizer_get_x(0,X0), X0 <== X[0],
format('~d. Iteration : x0=~4f f(X)=~4f |X|=~4f format('~d. Iteration : x0=~4f f(X)=~4f |X|=~4f
|X\'|=~4f Step=~4f Ls=~4f~n', |X\'|=~4f Step=~4f Ls=~4f~n',
[Iteration,X0,FX,X_Norm,G_Norm,Step,Ls]). [Iteration,X0,FX,X_Norm,G_Norm,Step,Ls]).
@ -108,16 +113,16 @@ progress(FX,X_Norm,G_Norm,Step,_N,Iteration,Ls,0) :-
demo :- demo :-
format('Optimizing the function f(x0) = sin(x0)~n',[]), format('Optimizing the function f(x0) = sin(x0)~n',[]),
optimizer_initialize(1,evaluate,progress), lbfgs_initialize(1,X,0,Solver),
StartX is random*10, StartX is random*10,
format('We start the search at the random position x0=~5f~2n',[StartX]), format('We start the search at the random position x0=~5f~2n',[StartX]),
optimizer_set_x(0,StartX), X[0] <== StartX,
optimizer_run(BestF,Status), lbfgs_run(Solver,BestF,Status),
optimizer_get_x(0,BestX0), BestX0 <== X[0],
optimizer_finalize, lbfgs_finalize(Solver),
format('~2nOptimization done~nWe found a minimum at format('~2nOptimization done~nWe found a minimum at
f(~f)=~f~2nLBFGS Status=~w~n',[BestX0,BestF,Status]). f(~f)=~f~2nLBFGS Status=~w~n',[BestX0,BestF,Status]).
~~~~~ ~~~~~
@ -146,63 +151,65 @@ yes
@{ @{
*/ */
:- dynamic initialized/0.
:- load_foreign_files(['libLBFGS'],[],'init_lbfgs_predicates'). :- load_foreign_files(['libLBFGS'],[],'init_lbfgs_predicates').
/** @pred optimizer_initialize(+N,+Evaluate,+Progress) /** @pred lbfgs_initialize(+N, -SolverInfo)
The same as before, except that the user module is the default The same as before, except that the user module is the default
value. value.
Example Example
~~~~ ~~~~
optimizer_initialize(1) lbfgs_initialize(1, Block)
~~~~~ ~~~~~
*/ */
lbfgs_initialize(N,X,t(N,X,U,Params)) :-
lbfgs_initialize(N,X,0,t(N,X,U,Params)).
optimizer_initialize(N,X,t(N,X,XO,Params)) :- lbfgs_initialize(N,X,U,t(N,X,U,Params)) :-
lbfgs_defaults(Params),
integer(N), integer(N),
N>0, N>0,
% check whether there are such call back functions % check whether there are such call back functions
optimizer_reserve_memory(N,X,XO,Params). lbfgs_grab(N,X).
% install call back predicates in the user module which call % install call back predicates in the user module which call
% the predicates given by the arguments % the predicates given by the arguments
/** @pred optimizer_finalize/0
/** @pred lbfgs_finalize/0
Clean up the memory. Clean up the memory.
*/ */
optimizer_finalize(t(N,X,XO,Params)) :- lbfgs_finalize(t(N,X,U,Params)) :-
initialized, lbfgs_release(X) ,
optimizer_free_memory(X,XO,Params) , lbfgs_release_parameters(Params) .
retractall(initialized).
/** @pred optimizer_run/3 /** @pred lbfgs_run/2
Do the work. Do the work.
*/ */
optimizer_run(t(N,X,XO,Params),FX,XO,Status) :- lbfgs_run(t(N,X,U,Params),FX) :-
optimizer_run(N,X, FX, XO, Status, Params). lbfgs(N,X, Params, U, FX).
/** @pred optimizer_parameters/1 /** @pred lbfgs_parameters/1
Prints a table with the current parameters. See the <a href="http://www.chokkan.org/software/liblbfgs/structlbfgs__parameter__t.html#_details">documentation Prints a table with the current parameters. See the <a href="http://www.chokkan.org/software/liblbfgs/structlbfgs__parameter__t.html#_details">documentation
of libLBFGS</a> for the meaning of each parameter. of libLBFGS</a> for the meaning of each parameter.
~~~~ ~~~~
?- optimizer_parameters. ?- lbfgs_parameters.
========================================================================================== ==========================================================================================
Type Name Value Description Type Name Value Description
========================================================================================== ==========================================================================================
int m 6 The number of corrections to approximate the inverse hessian matrix. int m 6 The number of corrections to approximate the inverse hessian matrix.
float epsilon 1e-05 Epsilon for convergence test. float epsilon 1e-05 Epsilon for convergence test.
int past 0 Distance for delta-based convergence test. int past 0 Distance for delta-based convergence test.
float delta 1e-05 Delta for convergence test. float delta 1e-05 Delta for convergence test.
int max_iterations 0 The maximum number of iterations int max_iterations 0 The maximum number of iterations
int linesearch 0 The line search algorithm. int linesearch 0 The line search algorithm.
int max_linesearch 40 The maximum number of trials for the line search. int max_linesearch 40 The maximum number of trials for the line search.
float min_step 1e-20 The minimum step of the line search routine. float min_step 1e-20 The minimum step of the line search routine.
float max_step 1e+20 The maximum step of the line search. float max_step 1e+20 The maximum step of the line search.
@ -213,24 +220,28 @@ float orthantwise_c 0.0 Coefficient for the L1 norm of varia
int orthantwise_start 0 Start index for computing the L1 norm of the variables. int orthantwise_start 0 Start index for computing the L1 norm of the variables.
int orthantwise_end -1 End index for computing the L1 norm of the variables. int orthantwise_end -1 End index for computing the L1 norm of the variables.
========================================================================================== ==========================================================================================
~~~~ ~~~~
*/ */
optimizer_parameterse(t(X,XO,Params)) :- lbfgs_parameters :-
optimizer_get_parameter(m,M ,Params), lbfgs_defaults(Params),
optimizer_get_parameter(epsilon,Epsilon ,Params), lbfgs_parameters(t(_X,_,_,Params)).
optimizer_get_parameter(past,Past ,Params),
optimizer_get_parameter(delta,Delta ,Params), lbfgs_parameters(t(_,_,_,Params)) :-
optimizer_get_parameter(max_iterations,Max_Iterations ,Params), lbfgs_get_parameter(m,M ,Params),
optimizer_get_parameter(linesearch,Linesearch ,Params), lbfgs_get_parameter(epsilon,Epsilon ,Params),
optimizer_get_parameter(max_linesearch,Max_Linesearch ,Params), lbfgs_get_parameter(past,Past ,Params),
optimizer_get_parameter(min_step,Min_Step ,Params), lbfgs_get_parameter(delta,Delta ,Params),
optimizer_get_parameter(max_step,Max_Step ,Params), lbfgs_get_parameter(max_iterations,Max_Iterations ,Params),
optimizer_get_parameter(ftol,Ftol ,Params), lbfgs_get_parameter(linesearch,Linesearch ,Params),
optimizer_get_parameter(gtol,Gtol ,Params), lbfgs_get_parameter(max_linesearch,Max_Linesearch ,Params),
optimizer_get_parameter(xtol,Xtol ,Params), lbfgs_get_parameter(min_step,Min_Step ,Params),
optimizer_get_parameter(orthantwise_c,Orthantwise_C ,Params), lbfgs_get_parameter(max_step,Max_Step ,Params),
optimizer_get_parameter(orthantwise_start,Orthantwise_Start ,Params), lbfgs_get_parameter(ftol,Ftol ,Params),
optimizer_get_parameter(orthantwise_end,Orthantwise_End ,Params), lbfgs_get_parameter(gtol,Gtol ,Params),
lbfgs_get_parameter(xtol,Xtol ,Params),
lbfgs_get_parameter(orthantwise_c,Orthantwise_C ,Params),
lbfgs_get_parameter(orthantwise_start,Orthantwise_Start ,Params),
lbfgs_get_parameter(orthantwise_end,Orthantwise_End ,Params),
format('/******************************************************************************************~n',[] ), format('/******************************************************************************************~n',[] ),
print_param('Name','Value','Description','Type' ,Params), print_param('Name','Value','Description','Type' ,Params),
@ -251,9 +262,9 @@ optimizer_parameterse(t(X,XO,Params)) :-
print_param(orthantwise_start,Orthantwise_Start,'Start index for computing the L1 norm of the variables.',int ,Params), print_param(orthantwise_start,Orthantwise_Start,'Start index for computing the L1 norm of the variables.',int ,Params),
print_param(orthantwise_end,Orthantwise_End,'End index for computing the L1 norm of the variables.',int ,Params), print_param(orthantwise_end,Orthantwise_End,'End index for computing the L1 norm of the variables.',int ,Params),
format('******************************************************************************************/~n',[]), format('******************************************************************************************/~n',[]),
format(' use optimizer_set_paramater(Name,Value) to change parameters~n',[]), format(' use lbfgs_set_parameter(Name,Value,Solver) to change parameters~n',[]),
format(' use optimizer_get_parameter(Name,Value) to see current parameters~n',[]), format(' use lbfgs_get_parameter(Name,Value,Solver) to see current parameters~n',[]),
format(' use optimizer_parameters to print this overview~2n',[]). format(' use lbfgs_parameters to print this overview~2n',[]).
print_param(Name,Value,Text,Dom) :- print_param(Name,Value,Text,Dom) :-

570
packages/yap-lbfgs/yap_lbfgs.c
View File

@ -1,7 +1,7 @@
#include <string.h>
#include "YapInterface.h" #include "YapInterface.h"
#include <lbfgs.h> #include <lbfgs.h>
#include <stdio.h> #include <stdio.h>
#include <string.h>
/* /*
This file is part of YAP-LBFGS. This file is part of YAP-LBFGS.
@ -21,103 +21,72 @@
along with YAP-LBFGS. If not, see <http://www.gnu.org/licenses/>. along with YAP-LBFGS. If not, see <http://www.gnu.org/licenses/>.
*/ */
// These constants describe the internal state // These constants describe the internal state
#define OPTIMIZER_STATUS_NONE 0 #define LBFGS_STATUS_NONE 0
#define OPTIMIZER_STATUS_INITIALIZED 1 #define LBFGS_STATUS_INITIALIZED 1
#define OPTIMIZER_STATUS_RUNNING 2 #define LBFGS_STATUS_RUNNING 2
#define OPTIMIZER_STATUS_CB_EVAL 3 #define LBFGS_STATUS_CB_EVAL 3
#define OPTIMIZER_STATUS_CB_PROGRESS 4 #define LBFGS_STATUS_CB_PROGRESS 4
X_API void init_lbfgs_predicates( void ) ; X_API void init_lbfgs_predicates(void);
YAP_Functor fevaluate, fprogress, fmodule, ffloats; YAP_Functor fevaluate, fprogress, fmodule, ffloats;
YAP_Term tuser; YAP_Term tuser;
static lbfgsfloatval_t evaluate( static lbfgsfloatval_t evaluate(void *instance, const lbfgsfloatval_t *x,
void *instance, lbfgsfloatval_t *g_tmp, const int n,
const lbfgsfloatval_t *x, const lbfgsfloatval_t step) {
lbfgsfloatval_t *g_tmp,
const int n,
const lbfgsfloatval_t step
)
{
YAP_Term call; YAP_Term call;
YAP_Term v, a1;
YAP_Bool result; YAP_Bool result;
YAP_Int s1; lbfgsfloatval_t rc;
YAP_Term v;
YAP_Term t[5], t2[2]; YAP_Term t[6], t2[2];
t[0] = v = YAP_MkVarTerm(); t[0] = v = YAP_MkVarTerm();
t[1] = YAP_MkIntTerm((YAP_Int)x); t[1] = YAP_MkIntTerm((YAP_Int)x);
t[1] = YAP_MkApplTerm(ffloats, 1, t+1); t[1] = YAP_MkApplTerm(ffloats, 1, t + 1);
t[2] = YAP_MkIntTerm((YAP_Int)g_tmp); t[2] = YAP_MkIntTerm((YAP_Int)g_tmp);
t[2] = YAP_MkApplTerm(ffloats, 1, t+2); t[2] = YAP_MkApplTerm(ffloats, 1, t + 2);
t[3] = YAP_MkIntTerm(n); t[3] = YAP_MkIntTerm(n);
t[4] = YAP_MkFloatTerm(step); t[4] = YAP_MkFloatTerm(step);
t[5] = YAP_MkIntTerm((YAP_Int)instance);
t2[0] = tuser; t2[0] = tuser;
t2[1] = YAP_MkApplTerm(fevaluate, 5, t); t2[1] = YAP_MkApplTerm(fevaluate, 6, t);
call = YAP_MkApplTerm(fmodule, 2, t2);
call = YAP_MkApplTerm( fmodule, 2, t2 ); int sl = YAP_InitSlot(v);
// lbfgs_status=LBFGS_STATUS_CB_EVAL;
result = YAP_RunGoalOnce(call);
// lbfgs_status=LBFGS_STATUS_RUNNING;
if (result == FALSE) {
s1 = YAP_InitSlot(v);
//optimizer_status=OPTIMIZER_STATUS_CB_EVAL;
result=YAP_RunGoal(call);
//optimizer_status=OPTIMIZER_STATUS_RUNNING;
if (result==FALSE) {
printf("ERROR: the evaluate call failed in YAP.\n"); printf("ERROR: the evaluate call failed in YAP.\n");
// Goal did not succeed // Goal did not succeed
YAP_ShutdownGoal( false ); return FALSE;
return FALSE;
} }
rc = YAP_FloatOfTerm(YAP_GetFromSlot(sl));
a1 = YAP_GetFromSlot( s1 ); YAP_RecoverSlots(1, sl);
lbfgsfloatval_t rc;
if (YAP_IsFloatTerm(a1)) {
rc = (lbfgsfloatval_t) YAP_FloatOfTerm(a1);
} else if (YAP_IsIntTerm(a1)) {
rc = (lbfgsfloatval_t) YAP_IntOfTerm(a1);
} else {
fprintf(stderr, "ERROR: The evaluate call back function did not return a number as first argument.\n");
rc = false;
}
YAP_ShutdownGoal( false );
return rc; return rc;
} }
static int progress( static int progress(void *instance, const lbfgsfloatval_t *local_x,
void *instance, const lbfgsfloatval_t *local_g,
const lbfgsfloatval_t *local_x,
const lbfgsfloatval_t *local_g,
const lbfgsfloatval_t fx, const lbfgsfloatval_t fx, const lbfgsfloatval_t xnorm,
const lbfgsfloatval_t xnorm, const lbfgsfloatval_t gnorm, const lbfgsfloatval_t step,
const lbfgsfloatval_t gnorm, int n, int k, int ls) {
const lbfgsfloatval_t step,
int n,
int k,
int ls
)
{
YAP_Term call; YAP_Term call;
YAP_Bool result; YAP_Bool result;
YAP_Int s1; YAP_Int s1;
YAP_Term t[10],t2[2], v; YAP_Term t[10], t2[2], v;
t[0] = YAP_MkFloatTerm(fx); t[0] = YAP_MkFloatTerm(fx);
t[1] = YAP_MkIntTerm((YAP_Int)local_x); t[1] = YAP_MkIntTerm((YAP_Int)local_x);
t[1] = YAP_MkApplTerm(ffloats, 1, t+1); t[1] = YAP_MkApplTerm(ffloats, 1, t + 1);
t[2] = YAP_MkIntTerm((YAP_Int)local_g); t[2] = YAP_MkIntTerm((YAP_Int)local_g);
t[2] = YAP_MkApplTerm(ffloats, 1, t+2); t[2] = YAP_MkApplTerm(ffloats, 1, t + 2);
t[3] = YAP_MkFloatTerm(xnorm); t[3] = YAP_MkFloatTerm(xnorm);
t[4] = YAP_MkFloatTerm(gnorm); t[4] = YAP_MkFloatTerm(gnorm);
t[5] = YAP_MkFloatTerm(step); t[5] = YAP_MkFloatTerm(step);
@ -127,34 +96,34 @@ static int progress(
t[9] = v = YAP_MkVarTerm(); t[9] = v = YAP_MkVarTerm();
t2[0] = tuser; t2[0] = tuser;
t2[1] = YAP_MkApplTerm( fprogress, 10, t); t2[1] = YAP_MkApplTerm(fprogress, 10, t);
call = YAP_MkApplTerm( fmodule, 2, t2 ); call = YAP_MkApplTerm(fmodule, 2, t2);
s1 = YAP_InitSlot(v); s1 = YAP_InitSlot(v);
//optimizer_status=OPTIMIZER_STATUS_CB_PROGRESS; // lbfgs_status=LBFGS_STATUS_CB_PROGRESS;
result=YAP_RunGoal(call); result = YAP_RunGoalOnce(call);
//optimizer_status=OPTIMIZER_STATUS_RUNNING; // lbfgs_status=LBFGS_STATUS_RUNNING;
YAP_Term o = YAP_GetFromSlot( s1 ); YAP_Term o = YAP_GetFromSlot(s1);
YAP_ShutdownGoal( false );
if (result==FALSE) { if (result == FALSE) {
printf("ERROR: the progress call failed in YAP.\n"); printf("ERROR: the progress call failed in YAP.\n");
// Goal did not succeed // Goal did not succeed
return -1; return -1;
} }
if (YAP_IsIntTerm(o)) { if (YAP_IsIntTerm(o)) {
int v = YAP_IntOfTerm(o); int v = YAP_IntOfTerm(o);
return (int)v; return (int)v;
} }
fprintf(stderr, "ERROR: The progress call back function did not return an integer as last argument\n"); fprintf(stderr, "ERROR: The progress call back function did not return an "
"integer as last argument\n");
return 1; return 1;
} }
/** @pred optimizer_initialize(+N,+Module,+Evaluate,+Progress) /** @pred lbfgs_initialize(+N,+Module,+Evaluate,+Progress)
Create space to optimize a function with _N_ variables (_N_ has to be Create space to optimize a function with _N_ variables (_N_ has to be
integer). integer).
@ -169,7 +138,7 @@ to evaluate the function math <span class="math">_F</span>_,
Example Example
~~~~ ~~~~
optimizer_initialize(1,user,evaluate,progress,e,g)</span> lbfgs_initialize(1,user,evaluate,progress,e,g)</span>
~~~~ ~~~~
@ -179,328 +148,431 @@ value _F_. _N_ is the
size of the parameter vector (the value which was used to initialize size of the parameter vector (the value which was used to initialize
LBFGS) and _Step_ is the current state of the LBFGS) and _Step_ is the current state of the
line search. The call back predicate can access the current values of line search. The call back predicate can access the current values of
`x[i]` by calling `optimizer_get_x(+I,-Xi)`. Finally, the call back `x[i]` by calling `lbfgs_get_x(+I,-Xi)`. Finally, the call back
predicate has to calculate the gradient of _F</span>_ predicate has to calculate the gradient of _F</span>_
and set its value by calling `optimizer_set_g(+I,+Gi)` for every `1<=I<=N`. and set its value by calling `lbfgs_set_g(+I,+Gi)` for every `1<=I<=N`.
The progress call back predicate has to be of the type The progress call back predicate has to be of the type
`progress(+F,+X_Norm,+G_Norm,+Step,+N,+Iteration,+LS,-Continue)`. It `progress(+F,+X_Norm,+G_Norm,+Step,+N,+Iteration,+LS,-Continue)`. It
is called after every iteration. The call back predicate can access is called after every iteration. The call back predicate can access
the current values of _X_ and of the gradient by calling the current values of _X_ and of the gradient by calling
`optimizer_get_x(+I,-Xi)` and `optimizer_get_g`(+I,-Gi)` `lbfgs_get_x(+I,-Xi)` and `lbfgs_get_g`(+I,-Gi)`
respectively. However, it must not call the setter predicates for <span respectively. However, it must not call the setter predicates for <span
class="code"_X_ or _G_. If it tries to do so, the optimizer will class="code"_X_ or _G_. If it tries to do so, the lbfgs will
terminate with an error. If _Continue_ is set to 0 (int) the terminate with an error. If _Continue_ is set to 0 (int) the
optimization process will continue for one more iteration, any other optimization process will continue for one more iteration, any other
value will terminate the optimization process. value will terminate the optimization process.
*/ */
static YAP_Bool optimizer_initialize(void) { /**
YAP_Term t1 = YAP_ARG1; * @pred lbfgs( N, X, U, FX )
int temp_n=0; *
lbfgsfloatval_t *temp_x, *temp_ox; * @Arg1 N: number of variables in problem
lbfgs_parameter_t *temp_p; * @Arg[X0]: input vector
* @Arg[FX]: function value,
* @Arg[FX]: parameter
* @Arg[X0]: user data
* @Arg[FX]: status
*/
static YAP_Bool p_lbfgs(void) {
YAP_Term t1 = YAP_ARG1, t;
int n, sl;
lbfgsfloatval_t *x;
lbfgsfloatval_t fx;
if (!YAP_IsIntTerm(t1)) {
if (! YAP_IsIntTerm(t1)) {
return false; return false;
} }
temp_n=YAP_IntOfTerm(t1); n = YAP_IntOfTerm(t1);
if (temp_n<1) { if (n < 1) {
return FALSE; return FALSE;
} }
sl = YAP_InitSlot(YAP_ARG6);
temp_n = 16*(temp_n/16+15); x = (lbfgsfloatval_t *)YAP_IntOfTerm(YAP_ArgOfTerm(1, YAP_ARG2));
lbfgs_parameter_init((temp_p=(lbfgs_parameter_t *)malloc(sizeof(lbfgs_parameter_t)))); lbfgs_parameter_t *param = (lbfgs_parameter_t *)YAP_IntOfTerm(YAP_ARG3);
temp_ox = lbfgs_malloc(temp_n); void *ui = (void *)YAP_IntOfTerm(YAP_ARG4);
YAP_Term tox = YAP_MkIntTerm((YAP_Int)temp_ox); int ret = lbfgs(n, x, &fx, evaluate, progress, ui, param);
temp_x = lbfgs_malloc(temp_n); t = YAP_GetFromSlot(sl);
YAP_Term tx = YAP_MkIntTerm((YAP_Int)temp_x); YAP_Unify(t, YAP_MkFloatTerm(fx));
tx = YAP_MkApplTerm(ffloats, 1, &tx); YAP_RecoverSlots(1, sl);
tox = YAP_MkApplTerm(ffloats, 1, &tox); if (ret == 0)
YAP_Term tp = YAP_MkIntTerm((YAP_Int)temp_p); return true;
const char *s;
switch (ret) {
case LBFGS_CONVERGENCE:
case LBFGS_STOP:
return true;
/** The initial variables already minimize the objective function. */
case LBFGS_ALREADY_MINIMIZED:
s = "The initial variables already minimize the objective function.";
break;
case LBFGSERR_UNKNOWNERROR:
s = "Unknownerror";
break;
case LBFGSERR_LOGICERROR:
s = "logic error.";
break;
case LBFGSERR_OUTOFMEMORY:
return YAP_Unify(YAP_ARG2,tx) && YAP_Unify(YAP_ARG3,tox) && YAP_Unify(YAP_ARG4,tp) ; s = "out of memory";
break;
case LBFGSERR_CANCELED:
s = "canceled.";
break;
case LBFGSERR_INVALID_N:
s = "Invalid number of variables specified.";
break;
case LBFGSERR_INVALID_N_SSE:
s = "Invalid number of variables (for SSE) specified.";
break;
case LBFGSERR_INVALID_X_SSE:
s = "The array x must be aligned to 16 (for SSE).";
break;
case LBFGSERR_INVALID_EPSILON:
s = "Invalid parameter lbfgs_parameter_t::epsilon specified.";
break;
case LBFGSERR_INVALID_TESTPERIOD:
s = "Invalid parameter lbfgs_parameter_t::past specified.";
break;
case LBFGSERR_INVALID_DELTA:
s = "Invalid parameter lbfgs_parameter_t::delta specified.";
break;
case LBFGSERR_INVALID_LINESEARCH:
s = "Invalid parameter lbfgs_parameter_t::linesearch specified.";
break;
case LBFGSERR_INVALID_MINSTEP:
s = "Invalid parameter lbfgs_parameter_t::max_step specified.";
break;
case LBFGSERR_INVALID_MAXSTEP:
s = "Invalid parameter lbfgs_parameter_t::max_step specified.";
break;
case LBFGSERR_INVALID_FTOL:
s = "Invalid parameter lbfgs_parameter_t::ftol specified.";
break;
case LBFGSERR_INVALID_WOLFE:
s = "Invalid parameter lbfgs_parameter_t::wolfe specified.";
break;
case LBFGSERR_INVALID_GTOL:
s = "Invalid parameter lbfgs_parameter_t::gtol specified.";
break;
case LBFGSERR_INVALID_XTOL:
s = "Invalid parameter lbfgs_parameter_t::xtol specified.";
break;
case LBFGSERR_INVALID_MAXLINESEARCH:
s = "Invalid parameter lbfgs_parameter_t::max_linesearch specified.";
break;
case LBFGSERR_INVALID_ORTHANTWISE:
s = "Invalid parameter lbfgs_parameter_t::orthantwise_c specified.";
break;
case LBFGSERR_INVALID_ORTHANTWISE_START:
s = "Invalid parameter lbfgs_parameter_t::orthantwise_start specified.";
break;
case LBFGSERR_INVALID_ORTHANTWISE_END:
s = "Invalid parameter lbfgs_parameter_t::orthantwise_end specified.";
break;
case LBFGSERR_OUTOFINTERVAL:
s = "The line-search step went out of the interval of uncertainty.";
break;
case LBFGSERR_INCORRECT_TMINMAX:
s = "A logic error occurred; alternatively, the interval of uncertaity "
"became too small.";
break;
case LBFGSERR_ROUNDING_ERROR:
s = "A rounding error occurred; alternatively, no line-search s";
break;
case LBFGSERR_MINIMUMSTEP:
s = "The line-search step became smaller than lbfgs_parameter_t::min_step.";
break;
case LBFGSERR_MAXIMUMSTEP:
s = "The line-search step became larger than lbfgs_parameter_t::max_step.";
break;
case LBFGSERR_MAXIMUMLINESEARCH:
s = "The line-search routine reaches the maximum number of evaluations.";
break;
case LBFGSERR_MAXIMUMITERATION:
s = "The algorithm routine reaches the maximum number of iterations "
"lbfgs_parameter_t::xtol.";
break;
case LBFGSERR_WIDTHTOOSMALL:
s = "Relative width of the interval of uncertainty is at m";
break;
case LBFGSERR_INVALIDPARAMETERS:
s = "A logic error (negative line-search step) occurred.";
break;
}
fprintf(stderr, "optimization terminated with code %d: %s\n", ret, s);
return true;
} }
static YAP_Bool lbfgs_grab(void) {
int n = YAP_IntOfTerm(YAP_ARG1);
if (n < 1) {
/** @pred optimizer_run(-F,-Status) return FALSE;
Runs the optimization, _F is the best (minimal) function value and }
Status (int) is the status code returned by libLBFGS. Anything except lbfgsfloatval_t *x = lbfgs_malloc(n);
0 indicates an error, see the documentation of libLBFGS for the YAP_Term t = YAP_MkIntTerm((YAP_Int)x);
meaning. return YAP_Unify(YAP_ARG2, YAP_MkApplTerm(ffloats, 1, &t));
*/
static YAP_Bool optimizer_run(void) {
int ret = 0;
int n = YAP_IntOfTerm(YAP_ARG1);
YAP_Int s1, s2;
lbfgsfloatval_t fx;
lbfgsfloatval_t *temp_x = ( lbfgsfloatval_t *)YAP_IntOfTerm( YAP_ArgOfTerm(1, YAP_ARG2)),
*temp_ox = ( lbfgsfloatval_t *) YAP_IntOfTerm(YAP_ArgOfTerm(1,YAP_ARG4));
lbfgs_parameter_t *temp_p = (lbfgs_parameter_t * ) YAP_IntOfTerm(YAP_ARG6);
ret = lbfgs(n, temp_x, &fx, evaluate, progress, temp_ox, temp_p);
return YAP_Unify(YAP_MkIntTerm(ret), YAP_ARG5) &&
YAP_Unify(YAP_MkFloatTerm(fx), YAP_ARG3);
} }
static YAP_Bool lbfgs_parameters(void) {
lbfgs_parameter_t *x = malloc(sizeof(lbfgs_parameter_t));
lbfgs_parameter_init(x);
return YAP_Unify(YAP_ARG1, YAP_MkIntTerm((YAP_Int)x));
}
static YAP_Bool lbfgs_release_parameters(void) {
free((void *)YAP_IntOfTerm(YAP_ARG1));
return true;
}
static YAP_Bool optimizer_finalize( void ) { static YAP_Bool lbfgs_release(void) {
/* if (optimizer_status == OPTIMIZER_STATUS_NONE) { */ /* if (lbfgs_status == LBFGS_STATUS_NONE) { */
/* printf("Error: Optimizer is not initialized.\n"); */ /* printf("Error: Lbfgs is not initialized.\n"); */
/* return FALSE; */ /* return FALSE; */
/* } */ /* } */
/* if (optimizer_status == OPTIMIZER_STATUS_INITIALIZED) { */ /* if (lbfgs_status == LBFGS_STATUS_INITIALIZED) { */
lbfgs_free((void *)YAP_IntOfTerm(YAP_ArgOfTerm(1,YAP_ARG1))); lbfgs_free((lbfgsfloatval_t *)YAP_IntOfTerm(YAP_ArgOfTerm(1, (YAP_ARG1))));
lbfgs_free((void *)YAP_IntOfTerm(YAP_ArgOfTerm(1,YAP_ARG2)));
lbfgs_free((void *)YAP_IntOfTerm(YAP_ARG3));
return TRUE; return TRUE;
/* } */
/* printf("ERROR: Optimizer is running right now. Please wait till it is finished.\n"); */
/* return FALSE; */ /* return FALSE; */
} }
/** @pred lbfgs_set_parameter(+Name,+Value,+Parameters)
Set the parameter Name to Value. Only possible while the lbfgs
/** @pred optimizer_set_parameter(+Name,+Value,+Parameters)
Set the parameter Name to Value. Only possible while the optimizer
is not running. is not running.
*/ */
static YAP_Bool optimizer_set_parameter( void ) { static YAP_Bool lbfgs_set_parameter(void) {
YAP_Term t1 = YAP_ARG1; YAP_Term t1 = YAP_ARG1;
YAP_Term t2 = YAP_ARG2; YAP_Term t2 = YAP_ARG2;
lbfgs_parameter_t *param = (lbfgs_parameter_t *) YAP_IntOfTerm(YAP_ARG3); lbfgs_parameter_t *param = (lbfgs_parameter_t *)YAP_IntOfTerm(YAP_ARG3);
/* if (optimizer_status != OPTIMIZER_STATUS_NONE && optimizer_status != OPTIMIZER_STATUS_INITIALIZED){ */ /* if (lbfgs_status != LBFGS_STATUS_NONE && lbfgs_status !=
/* printf("ERROR: Optimizer is running right now. Please wait till it is finished.\n"); */ * LBFGS_STATUS_INITIALIZED){ */
/* printf("ERROR: Lbfgs is running right now. Please wait till it is
* finished.\n"); */
/* return FALSE; */ /* return FALSE; */
/* } */ /* } */
if (!YAP_IsAtomTerm(t1)) {
if (! YAP_IsAtomTerm(t1)) {
return FALSE; return FALSE;
} }
const char* name=YAP_AtomName(YAP_AtomOfTerm(t1)); const char *name = YAP_AtomName(YAP_AtomOfTerm(t1));
if ((strcmp(name, "m") == 0)) { if ((strcmp(name, "m") == 0)) {
if (! YAP_IsIntTerm(t2)) { if (!YAP_IsIntTerm(t2)) {
return FALSE; return FALSE;
} }
param->m = YAP_IntOfTerm(t2); param->m = YAP_IntOfTerm(t2);
} else if ((strcmp(name, "epsilon") == 0)) { } else if ((strcmp(name, "epsilon") == 0)) {
lbfgsfloatval_t v; lbfgsfloatval_t v;
if (YAP_IsFloatTerm(t2)) { if (YAP_IsFloatTerm(t2)) {
v=YAP_FloatOfTerm(t2); v = YAP_FloatOfTerm(t2);
} else if (YAP_IsIntTerm(t2)) { } else if (YAP_IsIntTerm(t2)) {
v=(lbfgsfloatval_t) YAP_IntOfTerm(t2); v = (lbfgsfloatval_t)YAP_IntOfTerm(t2);
} else { } else {
return FALSE; return FALSE;
} }
param->epsilon=v; param->epsilon = v;
} else if ((strcmp(name, "past") == 0)) { } else if ((strcmp(name, "past") == 0)) {
if (! YAP_IsIntTerm(t2)) { if (!YAP_IsIntTerm(t2)) {
return FALSE; return FALSE;
} }
param->past = YAP_IntOfTerm(t2); param->past = YAP_IntOfTerm(t2);
} else if ((strcmp(name, "delta") == 0)) { } else if ((strcmp(name, "delta") == 0)) {
lbfgsfloatval_t v; lbfgsfloatval_t v;
if (YAP_IsFloatTerm(t2)) { if (YAP_IsFloatTerm(t2)) {
v=YAP_FloatOfTerm(t2); v = YAP_FloatOfTerm(t2);
} else if (YAP_IsIntTerm(t2)) { } else if (YAP_IsIntTerm(t2)) {
v=(lbfgsfloatval_t) YAP_IntOfTerm(t2); v = (lbfgsfloatval_t)YAP_IntOfTerm(t2);
} else { } else {
return FALSE; return FALSE;
} }
param->delta=v; param->delta = v;
} else if ((strcmp(name, "max_iterations") == 0)) { } else if ((strcmp(name, "max_iterations") == 0)) {
if (! YAP_IsIntTerm(t2)) { if (!YAP_IsIntTerm(t2)) {
return FALSE; return FALSE;
} }
param->max_iterations = YAP_IntOfTerm(t2); param->max_iterations = YAP_IntOfTerm(t2);
} else if ((strcmp(name, "linesearch") == 0)) { } else if ((strcmp(name, "linesearch") == 0)) {
if (! YAP_IsIntTerm(t2)) { if (!YAP_IsIntTerm(t2)) {
return FALSE; return FALSE;
} }
param->linesearch = YAP_IntOfTerm(t2); param->linesearch = YAP_IntOfTerm(t2);
} else if ((strcmp(name, "max_linesearch") == 0)) { } else if ((strcmp(name, "max_linesearch") == 0)) {
if (! YAP_IsIntTerm(t2)) { if (!YAP_IsIntTerm(t2)) {
return FALSE; return FALSE;
} }
param->max_linesearch = YAP_IntOfTerm(t2); param->max_linesearch = YAP_IntOfTerm(t2);
} else if ((strcmp(name, "min_step") == 0)) { } else if ((strcmp(name, "min_step") == 0)) {
lbfgsfloatval_t v; lbfgsfloatval_t v;
if (YAP_IsFloatTerm(t2)) { if (YAP_IsFloatTerm(t2)) {
v=YAP_FloatOfTerm(t2); v = YAP_FloatOfTerm(t2);
} else if (YAP_IsIntTerm(t2)) { } else if (YAP_IsIntTerm(t2)) {
v=(lbfgsfloatval_t) YAP_IntOfTerm(t2); v = (lbfgsfloatval_t)YAP_IntOfTerm(t2);
} else { } else {
return FALSE; return FALSE;
} }
param->min_step=v; param->min_step = v;
} else if ((strcmp(name, "max_step") == 0)) { } else if ((strcmp(name, "max_step") == 0)) {
lbfgsfloatval_t v; lbfgsfloatval_t v;
if (YAP_IsFloatTerm(t2)) { if (YAP_IsFloatTerm(t2)) {
v=YAP_FloatOfTerm(t2); v = YAP_FloatOfTerm(t2);
} else if (YAP_IsIntTerm(t2)) { } else if (YAP_IsIntTerm(t2)) {
v=(lbfgsfloatval_t) YAP_IntOfTerm(t2); v = (lbfgsfloatval_t)YAP_IntOfTerm(t2);
} else { } else {
return FALSE; return FALSE;
} }
param->max_step=v; param->max_step = v;
} else if ((strcmp(name, "ftol") == 0)) { } else if ((strcmp(name, "ftol") == 0)) {
lbfgsfloatval_t v; lbfgsfloatval_t v;
if (YAP_IsFloatTerm(t2)) { if (YAP_IsFloatTerm(t2)) {
v=YAP_FloatOfTerm(t2); v = YAP_FloatOfTerm(t2);
} else if (YAP_IsIntTerm(t2)) { } else if (YAP_IsIntTerm(t2)) {
v=(lbfgsfloatval_t) YAP_IntOfTerm(t2); v = (lbfgsfloatval_t)YAP_IntOfTerm(t2);
} else { } else {
return FALSE; return FALSE;
} }
param->ftol=v; param->ftol = v;
} else if ((strcmp(name, "gtol") == 0)) { } else if ((strcmp(name, "gtol") == 0)) {
lbfgsfloatval_t v; lbfgsfloatval_t v;
if (YAP_IsFloatTerm(t2)) { if (YAP_IsFloatTerm(t2)) {
v=YAP_FloatOfTerm(t2); v = YAP_FloatOfTerm(t2);
} else if (YAP_IsIntTerm(t2)) { } else if (YAP_IsIntTerm(t2)) {
v=(lbfgsfloatval_t) YAP_IntOfTerm(t2); v = (lbfgsfloatval_t)YAP_IntOfTerm(t2);
} else { } else {
return FALSE; return FALSE;
} }
param->gtol=v; param->gtol = v;
} else if ((strcmp(name, "xtol") == 0)) { } else if ((strcmp(name, "xtol") == 0)) {
lbfgsfloatval_t v; lbfgsfloatval_t v;
if (YAP_IsFloatTerm(t2)) { if (YAP_IsFloatTerm(t2)) {
v=YAP_FloatOfTerm(t2); v = YAP_FloatOfTerm(t2);
} else if (YAP_IsIntTerm(t2)) { } else if (YAP_IsIntTerm(t2)) {
v=(lbfgsfloatval_t) YAP_IntOfTerm(t2); v = (lbfgsfloatval_t)YAP_IntOfTerm(t2);
} else { } else {
return FALSE; return FALSE;
} }
param->xtol=v; param->xtol = v;
} else if ((strcmp(name, "orthantwise_c") == 0)) { } else if ((strcmp(name, "orthantwise_c") == 0)) {
lbfgsfloatval_t v; lbfgsfloatval_t v;
if (YAP_IsFloatTerm(t2)) { if (YAP_IsFloatTerm(t2)) {
v=YAP_FloatOfTerm(t2); v = YAP_FloatOfTerm(t2);
} else if (YAP_IsIntTerm(t2)) { } else if (YAP_IsIntTerm(t2)) {
v=(lbfgsfloatval_t) YAP_IntOfTerm(t2); v = (lbfgsfloatval_t)YAP_IntOfTerm(t2);
} else { } else {
return FALSE; return FALSE;
} }
param->orthantwise_c=v; param->orthantwise_c = v;
} else if ((strcmp(name, "orthantwise_start") == 0)) { } else if ((strcmp(name, "orthantwise_start") == 0)) {
if (! YAP_IsIntTerm(t2)) { if (!YAP_IsIntTerm(t2)) {
return FALSE; return FALSE;
} }
param->orthantwise_start = YAP_IntOfTerm(t2); param->orthantwise_start = YAP_IntOfTerm(t2);
} else if ((strcmp(name, "orthantwise_end") == 0)) { } else if ((strcmp(name, "orthantwise_end") == 0)) {
if (! YAP_IsIntTerm(t2)) { if (!YAP_IsIntTerm(t2)) {
return FALSE; return FALSE;
} }
param->orthantwise_end = YAP_IntOfTerm(t2); param->orthantwise_end = YAP_IntOfTerm(t2);
} else { } else {
printf("ERROR: The parameter %s is unknown.\n",name); printf("ERROR: The parameter %s is unknown.\n", name);
return FALSE; return FALSE;
} }
return TRUE; return TRUE;
} }
/** @pred lbfgs_get_parameter(+Name,-Value)</h3>
/** @pred optimizer_get_parameter(+Name,-Value)</h3>
Get the current Value for Name Get the current Value for Name
*/ */
static YAP_Bool optimizer_get_parameter( void ) { static YAP_Bool lbfgs_get_parameter(void) {
YAP_Term t1 = YAP_ARG1; YAP_Term t1 = YAP_ARG1;
YAP_Term t2 = YAP_ARG2; YAP_Term t2 = YAP_ARG2;
lbfgs_parameter_t *param = (lbfgs_parameter_t *) YAP_IntOfTerm(YAP_ARG3); lbfgs_parameter_t *param = (lbfgs_parameter_t *)YAP_IntOfTerm(YAP_ARG3);
if (! YAP_IsAtomTerm(t1)) { if (!YAP_IsAtomTerm(t1)) {
return FALSE; return FALSE;
} }
const char* name=YAP_AtomName(YAP_AtomOfTerm(t1)); const char *name = YAP_AtomName(YAP_AtomOfTerm(t1));
if ((strcmp(name, "m") == 0)) { if ((strcmp(name, "m") == 0)) {
return YAP_Unify(t2,YAP_MkIntTerm(param->m)); return YAP_Unify(t2, YAP_MkIntTerm(param->m));
} else if ((strcmp(name, "epsilon") == 0)) { } else if ((strcmp(name, "epsilon") == 0)) {
return YAP_Unify(t2,YAP_MkFloatTerm(param->epsilon)); return YAP_Unify(t2, YAP_MkFloatTerm(param->epsilon));
} else if ((strcmp(name, "past") == 0)) { } else if ((strcmp(name, "past") == 0)) {
return YAP_Unify(t2,YAP_MkIntTerm(param->past)); return YAP_Unify(t2, YAP_MkIntTerm(param->past));
} else if ((strcmp(name, "delta") == 0)) { } else if ((strcmp(name, "delta") == 0)) {
return YAP_Unify(t2,YAP_MkFloatTerm(param->delta)); return YAP_Unify(t2, YAP_MkFloatTerm(param->delta));
} else if ((strcmp(name, "max_iterations") == 0)) { } else if ((strcmp(name, "max_iterations") == 0)) {
return YAP_Unify(t2,YAP_MkIntTerm(param->max_iterations)); return YAP_Unify(t2, YAP_MkIntTerm(param->max_iterations));
} else if ((strcmp(name, "linesearch") == 0)) { } else if ((strcmp(name, "linesearch") == 0)) {
return YAP_Unify(t2,YAP_MkIntTerm(param->linesearch)); return YAP_Unify(t2, YAP_MkIntTerm(param->linesearch));
} else if ((strcmp(name, "max_linesearch") == 0)) { } else if ((strcmp(name, "max_linesearch") == 0)) {
return YAP_Unify(t2,YAP_MkIntTerm(param->max_linesearch)); return YAP_Unify(t2, YAP_MkIntTerm(param->max_linesearch));
} else if ((strcmp(name, "min_step") == 0)) { } else if ((strcmp(name, "min_step") == 0)) {
return YAP_Unify(t2,YAP_MkFloatTerm(param->min_step)); return YAP_Unify(t2, YAP_MkFloatTerm(param->min_step));
} else if ((strcmp(name, "max_step") == 0)) { } else if ((strcmp(name, "max_step") == 0)) {
return YAP_Unify(t2,YAP_MkFloatTerm(param->max_step)); return YAP_Unify(t2, YAP_MkFloatTerm(param->max_step));
} else if ((strcmp(name, "ftol") == 0)) { } else if ((strcmp(name, "ftol") == 0)) {
return YAP_Unify(t2,YAP_MkFloatTerm(param->ftol)); return YAP_Unify(t2, YAP_MkFloatTerm(param->ftol));
} else if ((strcmp(name, "gtol") == 0)) { } else if ((strcmp(name, "gtol") == 0)) {
return YAP_Unify(t2,YAP_MkFloatTerm(param->gtol)); return YAP_Unify(t2, YAP_MkFloatTerm(param->gtol));
} else if ((strcmp(name, "xtol") == 0)) { } else if ((strcmp(name, "xtol") == 0)) {
return YAP_Unify(t2,YAP_MkFloatTerm(param->xtol)); return YAP_Unify(t2, YAP_MkFloatTerm(param->xtol));
} else if ((strcmp(name, "orthantwise_c") == 0)) { } else if ((strcmp(name, "orthantwise_c") == 0)) {
return YAP_Unify(t2,YAP_MkFloatTerm(param->orthantwise_c)); return YAP_Unify(t2, YAP_MkFloatTerm(param->orthantwise_c));
} else if ((strcmp(name, "orthantwise_start") == 0)) { } else if ((strcmp(name, "orthantwise_start") == 0)) {
return YAP_Unify(t2,YAP_MkIntTerm(param->orthantwise_start)); return YAP_Unify(t2, YAP_MkIntTerm(param->orthantwise_start));
} else if ((strcmp(name, "orthantwise_end") == 0)) { } else if ((strcmp(name, "orthantwise_end") == 0)) {
return YAP_Unify(t2,YAP_MkIntTerm(param->orthantwise_end)); return YAP_Unify(t2, YAP_MkIntTerm(param->orthantwise_end));
} }
printf("ERROR: The parameter %s is unknown.\n",name); printf("ERROR: The parameter %s is unknown.\n", name);
return false; return false;
} }
X_API void init_lbfgs_predicates(void) {
fevaluate = YAP_MkFunctor(YAP_LookupAtom("evaluate"), 6);
X_API void init_lbfgs_predicates( void )
{
fevaluate = YAP_MkFunctor(YAP_LookupAtom("evaluate"), 5);
fprogress = YAP_MkFunctor(YAP_LookupAtom("progress"), 10); fprogress = YAP_MkFunctor(YAP_LookupAtom("progress"), 10);
fmodule = YAP_MkFunctor(YAP_LookupAtom(":"), 2); fmodule = YAP_MkFunctor(YAP_LookupAtom(":"), 2);
ffloats = YAP_MkFunctor(YAP_LookupAtom("floats"), 1); ffloats = YAP_MkFunctor(YAP_LookupAtom("floats"), 1);
tuser = YAP_MkAtomTerm(YAP_LookupAtom("user")); tuser = YAP_MkAtomTerm(YAP_LookupAtom("user"));
//Initialize the parameters for the L-BFGS optimization. // Initialize the parameters for the L-BFGS optimization.
// lbfgs_parameter_init(&param); // lbfgs_parameter_init(&param);
YAP_UserCPredicate("lbfgs_grab", lbfgs_grab, 2);
YAP_UserCPredicate("lbfgs", p_lbfgs, 5);
YAP_UserCPredicate("lbfgs_release", lbfgs_release, 1);
YAP_UserCPredicate("optimizer_reserve_memory",optimizer_initialize,4); YAP_UserCPredicate("lbfgs_defaults", lbfgs_parameters, 1);
YAP_UserCPredicate("optimizer_run",optimizer_run,6); YAP_UserCPredicate("lbfgs_release_parameters", lbfgs_release_parameters, 1);
YAP_UserCPredicate("optimizer_free_memory",optimizer_finalize,3); YAP_UserCPredicate("lbfgs_set_parameter", lbfgs_set_parameter, 3);
YAP_UserCPredicate("lbfgs_get_parameter", lbfgs_get_parameter, 3);
YAP_UserCPredicate("optimizer_set_parameter",optimizer_set_parameter,3);
YAP_UserCPredicate("optimizer_get_parameter",optimizer_get_parameter,3);
} }

31
pl/debug.yap
View File

@ -298,24 +298,22 @@ be lost.
* @param _Mod_:_Goal_ is the goal to be examined. * @param _Mod_:_Goal_ is the goal to be examined.
* @return `call(Goal)` * @return `call(Goal)`
*/ */
%% '$trace'([Mod|G]) :-
%% '$stop_creeping'(_),
% set_prolog_flag(debug, true),
%% !,
%% '$execute_nonstop'(G,Mod).
'$trace'([Mod|G]) :- '$trace'([Mod|G]) :-
'$stop_creeping'(_), CP is '$last_choice_pt',
current_prolog_flag(debug, false), '$trace_query'(G, Mod, CP, G, EG),
!, gated_call(
'$execute_nonstop'(G,Mod). '$debugger_input',
'$trace'([Mod|G]) :- EG,
CP is '$last_choice_pt', E,
'$trace_query'(G, Mod, CP, G, EG), '$continue_debugging'(E)
gated_call( ).
'$debugger_input',
EG,
E,
'$continue_debugging'(E)
).
'$continue_debugging'(_) :- !,
current_prolog_flag(debug, false).
'$continue_debugging'(exit) :- !, '$creep'. '$continue_debugging'(exit) :- !, '$creep'.
'$continue_debugging'(answer) :- !, '$creep'. '$continue_debugging'(answer) :- !, '$creep'.
'$continue_debugging'(fail) :- !, '$creep'. '$continue_debugging'(fail) :- !, '$creep'.
@ -694,9 +692,6 @@ be lost.
CP is '$last_choice_point', CP is '$last_choice_point',
Goal. Goal.
'$port'(_P,_G,_Module,_L,_Determinic, _Info ) :- %%> debugging done
current_prolog_flag(debug, false),
!.
'$port'(_P, _G, _M,GoalNumber,_Determinic, _Info ) :- %%> leap '$port'(_P, _G, _M,GoalNumber,_Determinic, _Info ) :- %%> leap
'__NB_getval__'('$debug_status',state(leap,Border,_), fail), '__NB_getval__'('$debug_status',state(leap,Border,_), fail),
GoalNumber > Border, GoalNumber > Border,

3
pl/errors.yap
View File

@ -94,7 +94,8 @@ error_handler(Error, Level) :-
'$LoopError'(Error, Level). '$LoopError'(Error, Level).
'$LoopError'(_, _) :- '$LoopError'(_, _) :-
flush_output(user_output), stop_low_level_trace,
flush_output(user_output),
flush_output(user_error), flush_output(user_error),
fail. fail.
'$LoopError'(Error, Level) :- !, '$LoopError'(Error, Level) :- !,

6
pl/qly.yap
View File

@ -558,11 +558,11 @@ Restores a previously saved state of YAP contaianing a qly file _F_.
*/ */
qload_file( F0 ) :- qload_file( F0 ) :-
( current_prolog_flag(verbose_load, false) ( current_prolog_flag(verbose_load, true)
-> ->
Verbosity = silent
;
Verbosity = informational Verbosity = informational
;
Verbosity = silent
), ),
StartMsg = loading_module, StartMsg = loading_module,
EndMsg = module_loaded, EndMsg = module_loaded,

10
pl/spy.yap
View File

@ -241,13 +241,13 @@ Switches on the debugger and enters tracing mode.
*/ */
trace :- trace :-
'$init_debugger', '$init_debugger',
fail. fail.
trace :- trace :-
'__NB_setval__'('$trace',on), '__NB_setval__'('$trace',on),
'$start_debugging'(on), '$start_debugging'(on),
print_message(informational,debug(trace)), print_message(informational,debug(trace)),
'$creep'. '$creep'.
/** @pred notrace /** @pred notrace