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

small fixes

Browse Source
This commit is contained in:
Vitor Santos Costa 2018-10-07 14:27:01 +01:00
parent ba6e0728ae
commit 6d0b702d1c
8 changed files with 473 additions and 490 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
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) {
@ -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)) {
@ -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;
@ -1753,7 +1761,9 @@ X_API bool YAP_EnterGoal(YAP_PredEntryPtr ape, CELL *ptr, YAP_dogoalinfo *dgi) {
// 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;
@ -1801,8 +1811,7 @@ 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];
@ -1821,26 +1830,26 @@ 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; handler = B;
while (handler while (handler &&
&& LCL0-LOCAL_CBorder > (CELL *)handler LCL0 - LOCAL_CBorder > (CELL *)handler
//&& handler->cp_ap != NOCODE //&& handler->cp_ap != NOCODE
&& handler->cp_b != NULL && handler->cp_b != NULL && handler != myB) {
&& handler != myB
) {
if (handler < myB) { if (handler < myB) {
handler->cp_ap = TRUSTFAILCODE; handler->cp_ap = TRUSTFAILCODE;
} }
@ -1859,7 +1868,9 @@ X_API bool YAP_LeaveGoal(bool successful, YAP_dogoalinfo *dgi) {
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;
} }
@ -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;
} }
@ -2143,13 +2156,14 @@ X_API int YAP_InitConsult(int mode, const char *fname, char **full, int *osnop)
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();
@ -2186,7 +2200,10 @@ X_API void YAP_EndConsult(int sno, int *osnop, const char *full) {
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
? "prolog"
: RepAtom(AtomOfTerm(CurrentModule))->StrOfAE,
full, *osnop, sno);
// LOCAL_CurSlot); // LOCAL_CurSlot);
pop_text_stack(lvl); 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;
} }

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

15
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) */
@ -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);

1
os/iopreds.c
View File

@ -1307,7 +1307,6 @@ static bool fill_stream(int sno, StreamDesc *st, Term tin, const char *io_mode,
st->status |= Popen_Stream_f; st->status |= Popen_Stream_f;
pop_text_stack(i); pop_text_stack(i);
} else { } else {
pop_text_stack(i);
Yap_ThrowError(DOMAIN_ERROR_SOURCE_SINK, tin, "open"); Yap_ThrowError(DOMAIN_ERROR_SOURCE_SINK, tin, "open");
} }
} }

22
packages/ProbLog/problog_lbfgs.yap
View File

@ -612,12 +612,12 @@ init_one_query(QueryID,Query,Type) :-
-> ->
rb_new(H0), rb_new(H0),
maplist_to_hash(MapList, H0, Hash), maplist_to_hash(MapList, H0, Hash),
Tree \= [],
tree_to_grad(Tree, Hash, [], Grad) tree_to_grad(Tree, Hash, [], Grad)
; % ;
Bdd = bdd(-1,[],[]), % Bdd = bdd(-1,[],[]),
Grad=[] % Grad=[]
), ),
write('.'),
recordz(QueryID,bdd(Dir, Grad, MapList),_) recordz(QueryID,bdd(Dir, Grad, MapList),_)
; ;
problog_flag(init_method,(Query,NOf,Bdd,problog_kbest_as_bdd(Call,NOf,Bdd))) -> problog_flag(init_method,(Query,NOf,Bdd,problog_kbest_as_bdd(Call,NOf,Bdd))) ->
@ -888,10 +888,8 @@ gradient_descent :-
N1 is N-1, N1 is N-1,
forall(tunable_fact(FactID,GroundTruth), (X[FactID] <== 0.5)), forall(tunable_fact(FactID,GroundTruth), (X[FactID] <== 0.5)),
problog_flag(sigmoid_slope,Slope), problog_flag(sigmoid_slope,Slope),
lbfgs_run(Solver,BestFA), lbfgs_run(Solver,BestF),
BestF <== BestFA[0], format('~2nOptimization done~nWe found a minimum ~4f.~n',[BestF]),
format('~2nOptimization done~nWe found a minimum ~4f
.~2n',[BestF]),
forall(tunable_fact(FactID,GroundTruth), set_tunable(FactID,GroundTruth,X)), forall(tunable_fact(FactID,GroundTruth), set_tunable(FactID,GroundTruth,X)),
lbfgs_finalize(Solver). lbfgs_finalize(Solver).
@ -917,9 +915,12 @@ bind_maplist([Node-Theta|MapList], Slope, X) :-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% start calculate gradient % start calculate gradient
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
user:evaluate(L, X,Grad,N,_,_) :- user:evaluate(L, X0,Grad,N,_,_) :-
Handle = user_error, Handle = user_error,
problog_flag(sigmoid_slope,Slope), problog_flag(sigmoid_slope,Slope),
forall(between(0,N1,I),
(V is random, X[I] <== V) %, sigmoid(X[I],Slope,Probs[I]) )
)
Probs = X, %<== array[N] of floats, Probs = X, %<== array[N] of floats,
N1 is N-1, N1 is N-1,
forall(between(0,N1,I), forall(between(0,N1,I),
@ -931,7 +932,7 @@ user:evaluate(L, X,Grad,N,_,_) :-
), ),
sum_list(LLs,LLH_Training_Queries), sum_list(LLs,LLH_Training_Queries),
forall(tunable_fact(FactID,GroundTruth), (Z<==X[FactID],W<==Grad[FactID])), forall(tunable_fact(FactID,GroundTruth), (Z<==X[FactID],W<==Grad[FactID])),
L[0] <== LLH_Training_Queries. L = LLH_Training_Queries.
compute_grad(N, X, Grad, Probs, Slope, Handle, LL) :- compute_grad(N, X, Grad, Probs, Slope, Handle, LL) :-
user:example(QueryID,Query,QueryProb,Type), user:example(QueryID,Query,QueryProb,Type),
@ -1009,4 +1010,3 @@ init_logger :-
:- initialization(init_flags). :- initialization(init_flags).
:- initialization(init_logger). :- initialization(init_logger).

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

@ -44,13 +44,11 @@ progress(FX,X,G,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',[]),
lbfgs_initialize(1,X,0,Solver), 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,Status), lbfgs_run(Solver,BestF),
BestX0 <== X[0], BestX0 <== X[0],
lbfgs_finalize(Solver), lbfgs_finalize(Solver),
format('~2nOptimization done~nWe found a minimum at format('~2nOptimization done~nWe found a minimum at

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

@ -151,7 +151,6 @@ yes
@{ @{
*/ */
:- dynamic initialized/0.
:- load_foreign_files(['libLBFGS'],[],'init_lbfgs_predicates'). :- load_foreign_files(['libLBFGS'],[],'init_lbfgs_predicates').
@ -185,10 +184,8 @@ lbfgs_initialize(N,X,U,t(N,X,U,Params)) :-
Clean up the memory. Clean up the memory.
*/ */
lbfgs_finalize(t(N,X,U,Params)) :- lbfgs_finalize(t(N,X,U,Params)) :-
initialized,
lbfgs_release(X) , lbfgs_release(X) ,
lbfgs_release_parameters(Params) , lbfgs_release_parameters(Params) .
retractall(initialized).
/** @pred lbfgs_run/2 /** @pred lbfgs_run/2
Do the work. Do the work.

105
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,8 +21,6 @@
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 LBFGS_STATUS_NONE 0 #define LBFGS_STATUS_NONE 0
#define LBFGS_STATUS_INITIALIZED 1 #define LBFGS_STATUS_INITIALIZED 1
@ -35,22 +33,16 @@ 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_Bool result; YAP_Bool result;
lbfgsfloatval_t rc; lbfgsfloatval_t rc;
YAP_Term v;
YAP_Term t[6], t2[2]; YAP_Term t[6], t2[2];
t[0] = YAP_MkIntTerm((YAP_Int)&rc); t[0] = v = YAP_MkVarTerm();
t[0] = YAP_MkApplTerm(ffloats, 1, t);
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);
@ -62,11 +54,9 @@ static lbfgsfloatval_t evaluate(
t2[0] = tuser; t2[0] = tuser;
t2[1] = YAP_MkApplTerm(fevaluate, 6, 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);
// s1 = YAP_InitSlot(v);
// lbfgs_status=LBFGS_STATUS_CB_EVAL; // lbfgs_status=LBFGS_STATUS_CB_EVAL;
result = YAP_RunGoalOnce(call); result = YAP_RunGoalOnce(call);
// lbfgs_status=LBFGS_STATUS_RUNNING; // lbfgs_status=LBFGS_STATUS_RUNNING;
@ -76,24 +66,17 @@ static lbfgsfloatval_t evaluate(
// Goal did not succeed // Goal did not succeed
return FALSE; return FALSE;
} }
rc = YAP_FloatOfTerm(YAP_GetFromSlot(sl));
YAP_RecoverSlots(1, sl);
return rc; return rc;
} }
static int progress( static int progress(void *instance, const lbfgsfloatval_t *local_x,
void *instance,
const lbfgsfloatval_t *local_x,
const lbfgsfloatval_t *local_g, 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;
@ -135,7 +118,8 @@ static int progress(
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;
} }
@ -190,10 +174,9 @@ value will terminate the optimization process.
* @Arg[X0]: user data * @Arg[X0]: user data
* @Arg[FX]: status * @Arg[FX]: status
*/ */
static YAP_Bool p_lbfgs(void) static YAP_Bool p_lbfgs(void) {
{ YAP_Term t1 = YAP_ARG1, t;
YAP_Term t1 = YAP_ARG1; int n, sl;
int n;
lbfgsfloatval_t *x; lbfgsfloatval_t *x;
lbfgsfloatval_t fx; lbfgsfloatval_t fx;
@ -206,16 +189,15 @@ static YAP_Bool p_lbfgs(void)
if (n < 1) { if (n < 1) {
return FALSE; return FALSE;
} }
sl = YAP_InitSlot(YAP_ARG6);
x = (lbfgsfloatval_t *)YAP_IntOfTerm(YAP_ArgOfTerm(1, YAP_ARG2)); x = (lbfgsfloatval_t *)YAP_IntOfTerm(YAP_ArgOfTerm(1, YAP_ARG2));
lbfgs_parameter_t *param = (lbfgs_parameter_t *)YAP_IntOfTerm(YAP_ARG3); lbfgs_parameter_t *param = (lbfgs_parameter_t *)YAP_IntOfTerm(YAP_ARG3);
void *ui = (void *)YAP_IntOfTerm(YAP_ARG4); void *ui = (void *)YAP_IntOfTerm(YAP_ARG4);
{
YAP_Term t = YAP_MkIntTerm((YAP_Int)&fx);
if (!YAP_Unify(YAP_ARG5,YAP_MkApplTerm(ffloats,1,&t)))
return false;
}
signal(SIGFPE, SIG_IGN);
int ret = lbfgs(n, x, &fx, evaluate, progress, ui, param); int ret = lbfgs(n, x, &fx, evaluate, progress, ui, param);
t = YAP_GetFromSlot(sl);
YAP_Unify(t, YAP_MkFloatTerm(fx));
YAP_RecoverSlots(1, sl);
if (ret == 0) if (ret == 0)
return true; return true;
const char *s; const char *s;
@ -298,7 +280,8 @@ static YAP_Bool p_lbfgs(void)
break; break;
case LBFGSERR_INCORRECT_TMINMAX: case LBFGSERR_INCORRECT_TMINMAX:
s = "A logic error occurred; alternatively, the interval of uncertaity became too small."; s = "A logic error occurred; alternatively, the interval of uncertaity "
"became too small.";
break; break;
case LBFGSERR_ROUNDING_ERROR: case LBFGSERR_ROUNDING_ERROR:
s = "A rounding error occurred; alternatively, no line-search s"; s = "A rounding error occurred; alternatively, no line-search s";
@ -313,7 +296,8 @@ break;
s = "The line-search routine reaches the maximum number of evaluations."; s = "The line-search routine reaches the maximum number of evaluations.";
break; break;
case LBFGSERR_MAXIMUMITERATION: case LBFGSERR_MAXIMUMITERATION:
s = "The algorithm routine reaches the maximum number of iterations lbfgs_parameter_t::xtol."; s = "The algorithm routine reaches the maximum number of iterations "
"lbfgs_parameter_t::xtol.";
break; break;
case LBFGSERR_WIDTHTOOSMALL: case LBFGSERR_WIDTHTOOSMALL:
s = "Relative width of the interval of uncertainty is at m"; s = "Relative width of the interval of uncertainty is at m";
@ -321,17 +305,13 @@ break;
case LBFGSERR_INVALIDPARAMETERS: case LBFGSERR_INVALIDPARAMETERS:
s = "A logic error (negative line-search step) occurred."; s = "A logic error (negative line-search step) occurred.";
break; break;
} }
fprintf(stderr, "optimization terminated with code %d: %s\n", ret, s); fprintf(stderr, "optimization terminated with code %d: %s\n", ret, s);
return true; return true;
} }
static YAP_Bool lbfgs_grab(void) {
static YAP_Bool lbfgs_grab (void)
{
int n = YAP_IntOfTerm(YAP_ARG1); int n = YAP_IntOfTerm(YAP_ARG1);
if (n < 1) { if (n < 1) {
@ -340,24 +320,17 @@ static YAP_Bool lbfgs_grab (void)
lbfgsfloatval_t *x = lbfgs_malloc(n); lbfgsfloatval_t *x = lbfgs_malloc(n);
YAP_Term t = YAP_MkIntTerm((YAP_Int)x); YAP_Term t = YAP_MkIntTerm((YAP_Int)x);
return YAP_Unify(YAP_ARG2, YAP_MkApplTerm(ffloats, 1, &t)); return YAP_Unify(YAP_ARG2, YAP_MkApplTerm(ffloats, 1, &t));
} }
static YAP_Bool lbfgs_parameters(void) {
static YAP_Bool lbfgs_parameters( void )
{
lbfgs_parameter_t *x = malloc(sizeof(lbfgs_parameter_t)); lbfgs_parameter_t *x = malloc(sizeof(lbfgs_parameter_t));
lbfgs_parameter_init(x); lbfgs_parameter_init(x);
return YAP_Unify(YAP_ARG1, YAP_MkIntTerm((YAP_Int)x)); return YAP_Unify(YAP_ARG1, YAP_MkIntTerm((YAP_Int)x));
} }
static YAP_Bool lbfgs_release_parameters( void ) static YAP_Bool lbfgs_release_parameters(void) {
{
free((void *)YAP_IntOfTerm(YAP_ARG1)); free((void *)YAP_IntOfTerm(YAP_ARG1));
return true; return true;
} }
static YAP_Bool lbfgs_release(void) { static YAP_Bool lbfgs_release(void) {
@ -373,8 +346,6 @@ static YAP_Bool lbfgs_release( void ) {
/* return FALSE; */ /* return FALSE; */
} }
/** @pred lbfgs_set_parameter(+Name,+Value,+Parameters) /** @pred lbfgs_set_parameter(+Name,+Value,+Parameters)
Set the parameter Name to Value. Only possible while the lbfgs Set the parameter Name to Value. Only possible while the lbfgs
is not running. is not running.
@ -383,12 +354,13 @@ 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 (lbfgs_status != LBFGS_STATUS_NONE && lbfgs_status != LBFGS_STATUS_INITIALIZED){ */ /* if (lbfgs_status != LBFGS_STATUS_NONE && lbfgs_status !=
/* printf("ERROR: Lbfgs 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;
} }
@ -534,7 +506,6 @@ static YAP_Bool lbfgs_set_parameter( void ) {
return TRUE; return TRUE;
} }
/** @pred lbfgs_get_parameter(+Name,-Value)</h3> /** @pred lbfgs_get_parameter(+Name,-Value)</h3>
Get the current Value for Name Get the current Value for Name
*/ */
@ -586,12 +557,7 @@ static YAP_Bool lbfgs_get_parameter( void ) {
return false; return false;
} }
X_API void init_lbfgs_predicates(void) {
X_API void init_lbfgs_predicates( void )
{
fevaluate = YAP_MkFunctor(YAP_LookupAtom("evaluate"), 6); fevaluate = YAP_MkFunctor(YAP_LookupAtom("evaluate"), 6);
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);
@ -601,7 +567,6 @@ X_API void init_lbfgs_predicates( void )
// 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_grab", lbfgs_grab, 2);
YAP_UserCPredicate("lbfgs", p_lbfgs, 5); YAP_UserCPredicate("lbfgs", p_lbfgs, 5);
YAP_UserCPredicate("lbfgs_release", lbfgs_release, 1); YAP_UserCPredicate("lbfgs_release", lbfgs_release, 1);