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

Merge https://github.com/vscosta/yap-6.3

Browse Source
This commit is contained in:
Vítor Santos Costa 2019-05-28 22:42:17 +01:00
commit 92181e534e
23 changed files with 247 additions and 165 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
C/exec.c
View File

@ -980,7 +980,7 @@ static bool watch_retry(Term d0 USES_REGS) {
while (B->cp_ap->opc == FAIL_OPCODE)
B = B->cp_b;
ASP = (CELL *) PROTECT_FROZEN_B(B);
// just do the frrpest
if (B >= B0 && !ex_mode && !active)
return true;

12
C/fail_absmi_insts.h
View File

@ -215,10 +215,7 @@ failloop:
}
/* pointer to code space */
/* or updatable variable */
#if defined(TERM_EXTENSIONS) || defined(FROZEN_STACKS) || \
defined(MULTI_ASSIGNMENT_VARIABLES)
if (IsPairTerm(d1))
#endif /* TERM_EXTENSIONS || FROZEN_STACKS || MULTI_ASSIGNMENT_VARIABLES */
{
register CELL flags;
CELL *pt1 = RepPair(d1);
@ -245,19 +242,20 @@ failloop:
goto failloop;
} else
#endif /* FROZEN_STACKS */
if (IN_BETWEEN(H0, pt1, HR)) {
if (IN_BETWEEN(H0, pt1, LCL0)) {
if (IsAttVar(pt1)) {
goto failloop;
} else {
TR = pt0;
Yap_CleanOpaqueVariable(d1);
Yap_CleanOpaqueVariable(d1);
goto failloop;
}
}
#ifdef FROZEN_STACKS /* TRAIL */
/* don't reset frozen variables */
if (pt0 < TR_FZ)
else if (pt0 < TR_FZ)
goto failloop;
#endif
flags = *pt1;
@ -306,9 +304,7 @@ hence we don't need to have a lock it */
} else {
LogUpdClause *cl = ClauseFlagsToLogUpdClause(pt1);
int erase;
#if PARALLEL_YAP
PredEntry *ap = cl->ClPred;
#endif
/* BB support */
if (ap) {

78
C/globals.c
View File

@ -286,10 +286,9 @@ static Term GrowArena(Term arena, size_t size,
XREGS[arity + 1] = arena;
if (!Yap_gcl(size * sizeof(CELL), arity + 1, ENV, gc_P(P, CP))) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return false;
return 0;
}
arena = XREGS[arity + 1];
adjust_cps(size PASS_REGS);
}
pt = ArenaLimit(arena);
if (pt == HR) {
@ -301,8 +300,8 @@ static Term GrowArena(Term arena, size_t size,
}
arena = XREGS[arity + 1];
}
CreateNewArena(RepAppl(arena), size+old_size);
return size+old_size;
arena = CreateNewArena(RepAppl(arena), size+old_size);
return arena;
}
CELL *Yap_GetFromArena(Term *arenap, UInt cells, UInt arity) {
@ -329,11 +328,11 @@ CELL *Yap_GetFromArena(Term *arenap, UInt cells, UInt arity) {
}
}
static Term CloseArena(cell_space_t *region, Term arena,
static Term CloseArena(cell_space_t *region,
UInt old_size USES_REGS) {
UInt new_size;
new_size = old_size - (HR - RepAppl(arena));
arena = CreateNewArena(HR, new_size);
new_size = old_size - (HR - HB);
Term arena = CreateNewArena(HR, new_size);
exit_cell_space( region );
return arena;
}
@ -649,10 +648,10 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
cell_space_t cspace;
int res = 0, restarts = 0;
Term tn;
old_size = ArenaSz(arena);
restart:
enter_cell_space(&cspace);
old_size = ArenaSz(arena);
t = Deref(t);
if (IsVarTerm(t)) {
ASP = ArenaLimit(arena);
@ -668,12 +667,12 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
Hi PASS_REGS)) < 0) {
goto error_handler;
}
*newarena = CloseArena(&cspace, arena, old_size PASS_REGS);
*newarena = CloseArena(&cspace, old_size PASS_REGS);
return Hi[0];
}
#endif
if (share && VarOfTerm(t) > ArenaPt(arena)) {
*newarena = CloseArena(&cspace, arena, old_size PASS_REGS);
*newarena = CloseArena(&cspace, old_size PASS_REGS);
return t;
}
tn = MkVarTerm();
@ -681,7 +680,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
res = -1;
goto error_handler;
}
*newarena = CloseArena(&cspace, arena, old_size PASS_REGS);
*newarena = CloseArena(&cspace, old_size PASS_REGS);
return tn;
} else if (IsAtomOrIntTerm(t)) {
return t;
@ -703,7 +702,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
Hi PASS_REGS)) < 0) {
goto error_handler;
}
*newarena = CloseArena(&cspace, arena, old_size PASS_REGS);
*newarena = CloseArena(&cspace, old_size PASS_REGS);
return tf;
} else {
Functor f;
@ -724,7 +723,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
if (IsExtensionFunctor(f)) {
switch ((CELL) f) {
case (CELL) FunctorDBRef:
*newarena = CloseArena(&cspace, arena, old_size PASS_REGS);
*newarena = CloseArena(&cspace, old_size PASS_REGS);
return t;
case (CELL) FunctorLongInt:
if (HR > ASP - (MIN_ARENA_SIZE + 3)) {
@ -783,32 +782,32 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
goto error_handler;
}
}
*newarena = CloseArena(&cspace, arena, old_size PASS_REGS);
*newarena = CloseArena(&cspace, old_size PASS_REGS);
return tf;
}
error_handler:
XREGS[arity + 1] = t;
XREGS[arity + 2] = arena;
exit_cell_space(&cspace);
switch (res) {
case -1:
if (arena == LOCAL_GlobalArena)
LOCAL_GlobalArenaOverflows++;
restarts++;
min_grow += (restarts < 16 ? 16*1024*restarts*restarts : 128*1024*1024);
CreateNewArena (RepAppl(arena),old_size);
if((arena=GrowArena(arena, min_grow, arity + 2, &cspace PASS_REGS))==0) {
HR = HB;
arena = CloseArena (&cspace, old_size PASS_REGS);
if((arena=GrowArena(arena, min_grow, arity + 1, &cspace PASS_REGS))==0) {
Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return 0L;
}
break;
t = XREGS[arity+1];
enter_cell_space(&cspace);
old_size = ArenaSz(arena);
break;
default: /* temporary space overflow */
return 0;
exit_cell_space(&cspace);
return 0;
}
enter_cell_space(&cspace);
arena = Deref(XREGS[arity + 2]);
t = XREGS[arity + 1];
goto restart;
}
@ -836,7 +835,7 @@ restart:
// CELL *old_top = ArenaLimit(*nsizeof(CELL)ewarena);
if (arena == LOCAL_GlobalArena)
LOCAL_GlobalArenaOverflows++;
CreateNewArena (RepAppl(arena),old_size);
arena = CreateNewArena (RepAppl(arena),old_size);
if ((arena=GrowArena(arena, Nar * sizeof(CELL),
arity + 1, &cells PASS_REGS))==0) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil,
@ -856,7 +855,7 @@ restart:
HB0[i] = init;
}
}
*newarena = CloseArena(&cells, arena, ArenaSz(arena) PASS_REGS);
*newarena = CloseArena(&cells, ArenaSz(arena) PASS_REGS);
return tf;
}
@ -1658,19 +1657,18 @@ static Int p_nb_queue_enqueue(USES_REGS1) {
} else {
min_size = 0L;
}
to = CopyTermToArena(ARG2, arena, FALSE, TRUE, 2, qd + QUEUE_ARENA,
Term newarena = arena;
to = CopyTermToArena(Deref(ARG2), arena, FALSE, TRUE, 2, &newarena,
min_size PASS_REGS);
if (to == 0L)
return FALSE;
cell_space_t cspace;
qd = GetQueue(ARG1, "enqueue");
arena = GetQueueArena(qd, "enqueue");
arena = newarena;
/* garbage collection ? */
enter_cell_space(&cspace);
HR = HB = ArenaPt(arena);
old_sz = ArenaSz(arena);
qd = GetQueue(ARG1, "enqueue");
qsize = IntegerOfTerm(qd[QUEUE_SIZE]);
qd[QUEUE_SIZE] = Global_MkIntegerTerm(qsize + 1);
if (qsize == 0) {
qd[QUEUE_HEAD] = AbsPair(HR);
@ -1681,7 +1679,7 @@ static Int p_nb_queue_enqueue(USES_REGS1) {
RESET_VARIABLE(HR);
qd[QUEUE_TAIL] = (CELL)HR;
HR++;
qd[QUEUE_ARENA] = CloseArena(&cspace, qd[ QUEUE_ARENA ], old_sz PASS_REGS);
qd[QUEUE_ARENA] =CloseArena(&cspace, old_sz PASS_REGS);
return TRUE;
}
@ -1705,7 +1703,7 @@ static Int p_nb_queue_dequeue(USES_REGS1) {
/* garbage collection ? */
enter_cell_space(&cspace);
qd[QUEUE_SIZE] = Global_MkIntegerTerm(qsz - 1);
qd[QUEUE_ARENA] = CloseArena(&cspace, arena, old_sz PASS_REGS);
qd[QUEUE_ARENA] = CloseArena(&cspace, old_sz PASS_REGS);
return Yap_unify(out, ARG2);
}
@ -1955,7 +1953,7 @@ restart:
old_sz = ArenaSz(arena);
HR = HB = ArenaPt(arena);
qd[HEAP_MAX] = Global_MkIntegerTerm(hmsize);
qd[HEAP_ARENA] = CloseArena(&cspace, arena, old_sz PASS_REGS);
qd[HEAP_ARENA] = CloseArena(&cspace, old_sz PASS_REGS);
goto restart;
}
arena = qd[HEAP_ARENA];
@ -1966,14 +1964,14 @@ restart:
mingrow PASS_REGS);
qd = GetHeap(ARG1, "add_to_heap");
arena = qd[HEAP_ARENA];
to = CopyTermToArena(ARG3, arena, FALSE, TRUE, 3, qd + HEAP_ARENA,
to = CopyTermToArena(ARG3, arena, FALSE, TRUE, 3, &arena,
mingrow PASS_REGS);
/* protect key in ARG2 in case there is an overflow while copying to */
key = ARG2;
if (key == 0 || to == 0L)
return FALSE;
qd = GetHeap(ARG1, "add_to_heap");
arena = qd[HEAP_ARENA];
qd[HEAP_ARENA] = arena;
/* garbage collection ? */
enter_cell_space(&cspace);
HR = HB = ArenaPt(arena);
@ -1987,7 +1985,7 @@ restart:
gsiz = 1024;
}
ARG3 = to;
CreateNewArena (RepAppl(arena),old_sz);
arena = CreateNewArena (RepAppl(arena),old_sz);
if ((arena=GrowArena(arena, gsiz, 3, &cspace PASS_REGS))==0) {
Yap_Error(RESOURCE_ERROR_STACK, arena, LOCAL_ErrorMessage);
return 0L;
@ -2003,7 +2001,7 @@ restart:
pt[2 * hsize + 1] = to;
PushHeap(pt, hsize);
qd[HEAP_SIZE] = Global_MkIntegerTerm(hsize + 1);
qd[HEAP_ARENA] = CloseArena(&cspace, qd[ HEAP_ARENA ], old_sz PASS_REGS);
qd[HEAP_ARENA] = CloseArena(&cspace, old_sz PASS_REGS);
return TRUE;
}
@ -2347,7 +2345,7 @@ cell_space_t cspace;
}
ARG3 = to;
/* fprintf(stderr,"growing %ld cells\n",(unsigned long int)gsiz);*/
CreateNewArena (RepAppl(arena),old_sz);
arena = CreateNewArena (RepAppl(arena),old_sz);
if (!GrowArena(arena, gsiz, 3, &cspace PASS_REGS)) {
Yap_Error(RESOURCE_ERROR_STACK, arena, LOCAL_ErrorMessage);
return 0L;
@ -2360,7 +2358,7 @@ cell_space_t cspace;
pt = qd + HEAP_START;
PushBeam(pt, pt + 2 * hmsize, hsize, key, to);
qd[HEAP_SIZE] = Global_MkIntegerTerm(hsize + 1);
qd[HEAP_ARENA] = CloseArena(&cspace, qd[ HEAP_ARENA ], old_sz PASS_REGS);
qd[HEAP_ARENA] = CloseArena(&cspace, old_sz PASS_REGS);
return TRUE;
}
@ -2383,7 +2381,7 @@ static Int p_nb_beam_del(USES_REGS1) {
/* garbage collection ? */
enter_cell_space(&cspace);
qd[HEAP_SIZE] = Global_MkIntegerTerm(qsz - 1);
qd[ HEAP_ARENA] = CloseArena(&cspace, arena, old_sz PASS_REGS);
qd[ HEAP_ARENA] = CloseArena(&cspace, old_sz PASS_REGS);
tk = qd[HEAP_START];
tv = DelBeamMin(qd + HEAP_START,
qd + (HEAP_START + 2 * IntegerOfTerm(qd[HEAP_MAX])), qsz);

1
C/stdpreds.c
View File

@ -1576,6 +1576,7 @@ void Yap_InitCPreds(void) {
Yap_InitDBPreds();
Yap_InitErrorPreds();
Yap_InitExecFs();
Yap_InitErrorPreds();
Yap_InitGlobals();
Yap_InitInlines();
Yap_InitIOPreds();

16
C/write.c
View File

@ -77,7 +77,6 @@ typedef struct write_globs {
UInt last_atom_minus;
UInt MaxDepth, MaxArgs;
wtype lw;
CELL *visited, *visited0, *visited_top;
} wglbs;
#define lastw wglb->lw
@ -732,9 +731,10 @@ static void write_list(Term t, int direction, int depth,
struct rewind_term nrwt;
nrwt.parent = rwt;
nrwt.u_sd.s.ptr = 0;
bool loop = true;
while (loop) {
loop = false;
while (1) {
PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt));
ti = TailOfTerm(t);
if (IsVarTerm(ti))
break;
@ -786,6 +786,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
if (IsVarTerm(t)) {
write_var((CELL *)t, wglb, &nrwt);
} else if (IsIntTerm(t)) {
wrputn((Int)IntOfTerm(t), wglb);
} else if (IsAtomTerm(t)) {
putAtom(AtomOfTerm(t), wglb->Quote_illegal, wglb);
@ -876,8 +877,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
return;
}
}
if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp)) {
if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp)) {
Term tright = ArgOfTerm(1, t);
int bracket_right = !IsVarTerm(tright) && IsAtomTerm(tright) &&
Yap_IsOp(AtomOfTerm(tright));
@ -1110,8 +1110,8 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
wglb.lw = separator;
Term tp;
if ( 0&& (flags & Handle_cyclics_f) ){
tp = Yap_BreakCyclesInTerm(t PASS_REGS);
if ((flags & Handle_cyclics_f) ){
tp = Yap_CyclesInTerm(t PASS_REGS);
} else {
tp = t;
}

1
H/Yapproto.h
View File

@ -175,6 +175,7 @@ extern int Yap_DBTrailOverflow(void);
extern CELL Yap_EvalMasks(Term, CELL *);
extern void Yap_InitBackDB(void);
extern void Yap_InitDBPreds(void);
extern void Yap_InitDBLoadPreds(void);
/* errors.c */
#if DEBUG

6
H/absmi.h
View File

@ -31,6 +31,12 @@
#define register
#endif
#if TABLING
#define FROZEN_STACKS 1
//#define MULTIPLE_STACKS 1
#endif
/***************************************************************
* Macros for register manipulation *
***************************************************************/

1
H/amidefs.h
View File

@ -48,6 +48,7 @@ typedef struct regstore_t *regstruct_ptr;
#endif
typedef Int (*CPredicate)(CACHE_TYPE1);
typedef Int (*CmpPredicate)(Term, Term);

53
H/trim_trail.h
View File

@ -1,17 +1,17 @@
#ifdef FROZEN_STACKS
#define RESET_TRAIL_ENTRY(pt) { TrailTerm(pt) = (CELL)(pt); TrailVal(pt) = (CELL)(pt); }
{
tr_fr_ptr pt0, pt1, pbase, ptop;
pbase = B->cp_tr, ptop = TR;
pt0 = pt1 = TR - 1;
tr_fr_ptr pt1, pbase;
pbase = B->cp_tr;
pt1 = TR - 1;
while (pt1 >= pbase) {
BEGD(d1);
d1 = TrailTerm(pt1);
if (IsVarTerm(d1)) {
if (d1 < (CELL)HBREG || d1 > Unsigned(B->cp_b)) {
TrailTerm(pt0) = d1;
TrailVal(pt0) = TrailVal(pt1);
pt0--;
if (d1 >= (CELL)HBREG && d1 < Unsigned(HR)) {
RESET_TRAIL_ENTRY(pt1);
}
pt1--;
} else if (IsPairTerm(d1)) {
@ -28,14 +28,14 @@
/* skip, this is a problem because we lose information,
namely active references */
pt1 = (tr_fr_ptr)pt;
} else if (IN_BETWEEN(H0, pt, HR) && IsApplTerm(HeadOfTerm(d1))) {
} else if (IN_BETWEEN(H0, pt, LCL0) && IsApplTerm(HeadOfTerm(d1))) {
Term t = HeadOfTerm(d1);
Functor f = FunctorOfTerm(t);
if (f == FunctorBigInt) {
Int tag = Yap_blob_tag(t);
GLOBAL_OpaqueHandlers[tag].cut_handler(d1);
} else {
pt0--;
RESET_TRAIL_ENTRY(pt1);
}
pt1--;
continue;
@ -48,6 +48,7 @@
LOCK(ap->PELock);
DEC_CLREF_COUNT(cl);
RESET_TRAIL_ENTRY(pt1);
cl->ClFlags &= ~InUseMask;
erase = (cl->ClFlags & (ErasedMask | DirtyMask)) && !(cl->ClRefCount);
if (erase) {
@ -59,43 +60,23 @@
Yap_CleanUpIndex(cl);
}
UNLOCK(ap->PELock);
} else {
TrailTerm(pt0) = d1;
TrailVal(pt0) = TrailVal(pt1);
pt0--;
}
pt1--;
} else if (IsApplTerm(d1)) {
if (IN_BETWEEN(HBREG, RepAppl(d1), B->cp_b)) {
/* deterministic binding to multi-assignment variable */
pt1 -= 2;
RESET_TRAIL_ENTRY(pt1);
pt1--;
RESET_TRAIL_ENTRY(pt1);
/* deterministic binding to multi-assignment variable */
pt1 --;
} else {
TrailVal(pt0) = TrailVal(pt1);
TrailTerm(pt0) = d1;
TrailVal(pt0 - 1) = TrailVal(pt1 - 1);
TrailTerm(pt0 - 1) = TrailTerm(pt1 - 1);
pt0 -= 2;
pt1 -= 2;
}
} else {
TrailTerm(pt0) = d1;
TrailVal(pt0) = TrailVal(pt1);
pt0--;
pt1--;
pt1--;
}
ENDD(d1);
}
if (pt0 != pt1) {
int size;
pt0++;
size = ptop - pt0;
memmove(pbase, pt0, size * sizeof(struct trail_frame));
if (ptop != TR) {
memmove(pbase + size, ptop, (TR - ptop) * sizeof(struct trail_frame));
size += (TR - ptop);
}
TR = pbase + size;
}
}
#else
{

2
packages/ProbLog/problog.yap
View File

@ -845,7 +845,7 @@ term_expansion_intern(Head :: Goal,Module,problog:ProbFact) :-
% handles probabilistic facts
term_expansion_intern(P :: Goal,Module,problog:ProbFact) :-
copy_term((P,Goal),(P_Copy,Goal_Copy)),
copy_term((P,Goal),(P_Copy,Goal_Copy)),
functor(Goal, Name, Arity),
atomic_concat([problog_,Name],ProblogName),
Goal =.. [Name|Args],

3
packages/ProbLog/problog/lbdd.yap
View File

@ -91,6 +91,7 @@ gradient(QueryID, g, Slope) :-
query_probabilities( DBDD, Prob) :-
DBDD = bdd(Dir, Tree, _MapList),
findall(P, evalp(Tree,P), [Prob0]),
% nonvar(Prob0),
(Dir == 1 -> Prob0 = Prob ; Prob is 1.0-Prob0).
evalp( Tree, Prob0) :-
@ -104,7 +105,7 @@ query_gradients(bdd(Dir, Tree, MapList),I,IProb,Grad) :-
evalp( pn(P, _-X, PL, PR), _,P ):-
P is X*PL+ (1.0-X)*(1.0-PR).
evalp( pp(P, _-X, PL, PR), _,P ):-
evalp( pp(P, _-X, PL, PR), _,P ):-
P is X*PL+ (1.0-X)*PR.
evalg( I, pp(P-G, J-X, L, R), _, G ):-

14
packages/ProbLog/problog_examples/learn_graph_lbdd.pl
View File

@ -14,20 +14,9 @@
% will run 20 iterations of learning with default settings
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- use_module('../problog_lbfgs').
:- use_module('../problog_learning_lbdd').
:- if(true).
:- use_module('kbgraph').
%%%%
% background knowledge
%%%%
% definition of acyclic path using list of visited nodes
:- else.
:- Query=path(X,Y), set_problog_flag(init_method,(Query,K,Bdd,problog:problog_exact_lbdd(Query,Bdd))).
@ -48,7 +37,6 @@ edge(X,Y) :- dir_edge(X,Y).
absent(_,[]).
absent(X,[Y|Z]):-X \= Y, absent(X,Z).
:- endif.
%%%%
% probabilistic facts

113
packages/ProbLog/problog_examples/learn_graph_lbfgs.pl Normal file
View File

@ -0,0 +1,113 @@
%%% -*- mode: Prolog; -*-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% ProbLog program describing a probabilistic graph
% (running example from ProbLog presentations)
% $Id: learn_graph.pl 4875 2010-10-05 15:28:35Z theo $
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% example for parameter learning with LeProbLog
%
% training and test examples are included at the end of the file
% query ?- do_learning(20).
% will run 20 iterations of learning with default settings
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- use_module('../problog_lbfgs').
:- if(true).
:- use_module('kbgraph').
%%%%
% background knowledge
%%%%
% definition of acyclic path using list of visited nodes
:- else.
:- Query=path(X,Y), set_problog_flag(init_method,(Query,K,Bdd,problog:problog_exact_lbdd(Query,Bdd))).
path(X,Y) :- path(X,Y,[X],_).
path(X,X,A,A).
path(X,Y,A,R) :-
X\==Y,
edge(X,Z),
absent(Z,A),
path(Z,Y,[Z|A],R).
% using directed edges in both directions
edge(X,Y) :- dir_edge(Y,X).
edge(X,Y) :- dir_edge(X,Y).
% checking whether node hasn't been visited before
absent(_,[]).
absent(X,[Y|Z]):-X \= Y, absent(X,Z).
:- endif.
%%%%
% probabilistic facts
% - probability represented by t/1 term means learnable parameter
% - argument of t/1 is real value (used to compare against in evaluation when known), use t(_) if unknown
%%%%
t(0.9)::dir_edge(1,2).
t(0.8)::dir_edge(2,3).
t(0.6)::dir_edge(3,4).
t(0.7)::dir_edge(1,6).
t(0.5)::dir_edge(2,6).
t(0.4)::dir_edge(6,5).
t(0.7)::dir_edge(5,3).
t(0.2)::dir_edge(5,4).
%%%%%%%%%%%%%%
% training examples of form example(ID,Query,DesiredProbability)
%%%%%%%%%%%%%%
example(1,path(1,2),0.94).
example(2,path(1,3),0.81).
example(3,path(1,4),0.54).
example(4,path(1,5),0.70).
example(5,path(1,6),0.87).
example(6,path(2,3),0.85).
example(7,path(2,4),0.57).
example(8,path(2,5),0.72).
example(9,path(2,6),0.86).
example(10,path(3,4),0.66).
example(11,path(3,5),0.80).
example(12,path(3,6),0.75).
example(13,path(4,5),0.57).
example(14,path(4,6),0.51).
example(15,path(5,6),0.69).
% some examples for learning from proofs:
/*example(16,(dir_edge(2,3),dir_edge(2,6),dir_edge(6,5),dir_edge(5,4)),0.032).
example(17,(dir_edge(1,6),dir_edge(2,6),dir_edge(2,3),dir_edge(3,4)),0.168).
example(18,(dir_edge(5,3),dir_edge(5,4)),0.14).
example(19,(dir_edge(2,6),dir_edge(6,5)),0.2).
example(20,(dir_edge(1,2),dir_edge(2,3),dir_edge(3,4)),0.432).
*/
%%%%%%%%%%%%%%
% test examples of form test_example(ID,Query,DesiredProbability)
% note: ID namespace is shared with training example IDs
%%%%%%%%%%%%%%
test_example(21,path(2,1),0.94).
test_example(22,path(3,1),0.81).
test_example(23,path(4,1),0.54).
test_example(24,path(5,1),0.70).
test_example(25,path(6,1),0.87).
test_example(26,path(3,2),0.85).
test_example(27,path(4,2),0.57).
test_example(28,path(5,2),0.72).
test_example(29,path(6,2),0.86).
test_example(30,path(4,3),0.66).
test_example(31,path(5,3),0.80).
test_example(32,path(6,3),0.75).
test_example(33,path(5,4),0.57).
test_example(34,path(6,4),0.51).
test_example(35,path(6,5),0.69).

29
packages/ProbLog/problog_lbfgs.yap
View File

@ -553,7 +553,7 @@ empty_bdd_directory.
init_queries :-
empty_bdd_directory,
format_learning(2,'Build BDDs for examples~n',[]),
forall(user:test_example(ID,Query,_Prob,_),init_one_query(ID,Query,test)),
forall(user:test_example(ID,Query,_Prob,_),init_one_query(ID,Query,test)),
forall(user:example(ID,Query,_Prob,_),init_one_query(ID,Query,training)).
bdd_input_file(Filename) :-
@ -835,7 +835,7 @@ update_values :-
% delete old values
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
retractall(query_probability_intern(_,_)),
retractall(query_gradient_intern(_,_,_,_)),
retractall(query_gradient_intern(_,_,_,_)),
assertz(values_correct).
@ -847,7 +847,7 @@ update_values :-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% start calculate gradient
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
user:evaluate(LLH_Training_Queries, X,Grad,N,_,_) :-
user:evaluate(LLH_Training_Queries, X,Grad,N,_,_) :-
%Handle = user_error,
N1 is N-1,
forall(between(0,N1,I),(Grad[I]<==0.0)),
@ -893,13 +893,11 @@ compute_gradient( Grad, X, Slope, LL) :-
BDD = bdd(_,_,MapList),
MapList = [_|_],
bind_maplist(MapList, Slope, X),
%writeln(QueryID:MapList),
query_probabilities( BDD, BDDProb),
(isnan(BDDProb) -> writeln((nan::QueryID)), fail;true),
writeln(BDDProb),
LL is (BDDProb-QueryProb)*(BDDProb-QueryProb),
forall(
query_gradients(BDD,I,IProb,GradValue),
query_gradients(BDD,I,IProb,GradValue),
gradient_pair(BDDProb, QueryProb, Grad, GradValue, I, IProb)
).
@ -925,8 +923,9 @@ wrap( _X, _Grad, _GradCount).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
user:progress(FX,_X,_G, _X_Norm,_G_Norm,_Step,_N,_CurrentIteration,_Ls,-1) :-
FX < 0, !,
format('stopped on bad FX=~4f~n',[FX]).
format('Bad FX=~4f~n',[FX]).
user:progress(FX,X,G,X_Norm,G_Norm,Step,_N, LBFGSIteration,Ls,0) :-
writeln(fx=FX),
problog_flag(sigmoid_slope,Slope),
save_state(X, Slope, G),
logger_set_variable(mse_trainingset, FX),
@ -946,22 +945,6 @@ save_state(X,Slope,_Grad) :-
tunable_fact(FactID,_GroundTruth),
set_tunable(FactID,Slope,X),
fail.
save_state(X, Slope, _) :-
user:example(QueryID,_Query,_QueryProb),
recorded(QueryID,BDD,_),
BDD = bdd(_,_,MapList),
bind_maplist(MapList, Slope, X),
query_probabilities( BDD, BDDProb),
assert( query_probability_intern(QueryID,BDDProb)),
fail.
save_state(X, Slope, _) :-
user:test_example(QueryID,_Query,_QueryProb),
recorded(QueryID,BDD,_),
BDD = bdd(_,_,MapList),
bind_maplist(MapList, Slope, X),
query_probabilities( BDD, BDDProb),
assert( query_probability_intern(QueryID,BDDProb)),
fail.
save_state(_X, _Slope, _).
%========================================================================

3
packages/ProbLog/problog_learning.yap
View File

@ -710,7 +710,7 @@ update_values :-
%=
%========================================================================
listing(
update_query_cleanup(QueryID) :-
(
(query_is_similar(QueryID,_) ; query_is_similar(_,QueryID))
->
@ -893,7 +893,6 @@ ground_truth_difference :-
%=
%= -Float
%========================================================================
mse_trainingset_only_for_linesearch(MSE) :-
update_values,

1
packages/ProbLog/problog_learning_lbdd.yap
View File

@ -228,6 +228,7 @@
:- use_module('problog/utils_lbdd').
:- use_module('problog/utils').
:- use_module('problog/tabling').
:- use_module('problog/lbdd').
% used to indicate the state of the system
:- dynamic(values_correct/0).

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

@ -24,6 +24,7 @@
lbfgs_initialize/4,
lbfgs_run/3,
lbfgs_fx/1,
lbfgs_finalize/1,
lbfgs_set_parameter/2,
@ -180,7 +181,8 @@ lbfgs_finalize(_N).
run the algorithm. output the final score of the function being optimised
*/
lbfgs_run(N,X,FX) :-
lbfgs(N,X, FX).
lbfgs(N,X),
lbfgs_fx(FX).

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

@ -35,7 +35,7 @@ X_API void init_lbfgs_predicates(void);
YAP_Functor fevaluate, fprogress, fmodule, ffloats;
YAP_Term tuser;
lbfgsfloatval_t *x_p;
lbfgsfloatval_t *x_p, f_x;
static lbfgsfloatval_t evaluate(void *instance, const lbfgsfloatval_t *x,
lbfgsfloatval_t *g_tmp, const int n,
@ -43,7 +43,7 @@ static lbfgsfloatval_t evaluate(void *instance, const lbfgsfloatval_t *x,
YAP_Term call;
YAP_Bool result;
lbfgsfloatval_t rc=0.0;
YAP_Term v=YAP_MkVarTerm(), t1, t12;
YAP_Term t12;
YAP_Term t[6], t2[2];
YAP_Term t_0 = YAP_MkIntTerm((YAP_Int)&rc);
@ -60,8 +60,6 @@ static lbfgsfloatval_t evaluate(void *instance, const lbfgsfloatval_t *x,
t2[1] = YAP_MkApplTerm(fevaluate, 6, t);
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;
@ -72,8 +70,6 @@ static lbfgsfloatval_t evaluate(void *instance, const lbfgsfloatval_t *x,
return FALSE;
}
YAP_ShutdownGoal(true);
YAP_RecoverSlots(1, sl);
fprintf(stderr,"%gxo\n",rc);
return rc;
}
@ -183,7 +179,7 @@ value will terminate the optimization process.
*/
static YAP_Bool p_lbfgs(void) {
YAP_Term t1 = YAP_ARG1, t;
int n, sl;
int n;
lbfgsfloatval_t *x;
lbfgsfloatval_t fx;
@ -196,7 +192,6 @@ static YAP_Bool p_lbfgs(void) {
if (n < 1) {
return FALSE;
}
sl = YAP_InitSlot(YAP_ARG3);
if (!x_p)
x_p = lbfgs_malloc(n+1);
@ -206,15 +201,17 @@ static YAP_Bool p_lbfgs(void) {
lbfgs_parameter_t *param = &parms;
void *ui = NULL; //(void *)YAP_IntOfTerm(YAP_ARG4);
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)
f_x = fx;
if (ret == 0)
return true;
fprintf(stderr, "optimization terminated with code %d\n ",ret);
return true;
}
static YAP_Bool lbfgs_fx(void) {
return YAP_Unify(YAP_ARG1, YAP_MkFloatTerm(f_x));
}
static YAP_Bool lbfgs_grab(void) {
int n = YAP_IntOfTerm(YAP_ARG1);
@ -468,8 +465,9 @@ X_API void init_lbfgs_predicates(void) {
lbfgs_parameter_init(&parms);
YAP_UserCPredicate("lbfgs_grab", lbfgs_grab, 2);
YAP_UserCPredicate("lbfgs", p_lbfgs, 3);
YAP_UserCPredicate("lbfgs_release", lbfgs_release, 1);
YAP_UserCPredicate("lbfgs", p_lbfgs, 2);
YAP_UserCPredicate("lbfgs_release", lbfgs_release, 1);
YAP_UserCPredicate("lbfgs_fx", lbfgs_fx, 1);
YAP_UserCPredicate("lbfgs_defaults", lbfgs_defaults, 0);

2
pl/consult.yap
View File

@ -1011,7 +1011,7 @@ prolog_load_context(file, FileName) :-
).
prolog_load_context(module, X) :-
'__NB_getval__'('$consulting_file', _, fail),
'current_module'(X).
current_source_module(X,X).
prolog_load_context(source, F0) :-
( source_location(F0, _) /*,
'$input_context'(Context),

22
pl/imports.yap
View File

@ -35,20 +35,17 @@ fail.
% parent module mechanism
%% system has priority
'$get_predicate_definition'(_ImportingMod:G,prolog:G) :-
nonvar(G),
'$pred_exists'(G,prolog).
nonvar(G).
%% I am there, no need to import
'$get_predicate_definition'(Mod:Pred,Mod:Pred) :-
nonvar(Pred),
'$pred_exists'(Pred, Mod).
nonvar(Pred).
%% export table
'$get_predicate_definition'(ImportingMod:G,ExportingMod:G0) :-
recorded('$import','$import'(ExportingMod,ImportingMod,G0,G,_,_),_).
%% parent/user
'$get_predicate_definition'(ImportingMod:G,ExportingMod:G0) :-
'$get_predicate_definition'(ImportingMod:G,PMod:G) :-
( '$parent_module'(ImportingMod, PMod) ; PMod = user ),
ImportingMod \= PMod,
'$get_predicate_definition'(PMod:G, ExportingMod:G0).
ImportingMod \= PMod.
%% autoload`
%'$get_predicate_definition'(ImportingMod:G,ExportingMod:G) :-
% current_prolog_flag(autoload, true),
@ -57,22 +54,25 @@ fail.
'$predicate_definition'(Imp:Pred,Exp:NPred) :-
'$predicate_definition'(Imp:Pred,[],Exp:NPred),
'$pred_exists'(NPred,Exp),
%writeln((Imp:Pred -> Exp:NPred )).
!.
'$one_predicate_definition'(Imp:Pred,Exp:NPred) :-
'$predicate_definition'(Imp:Pred,[],Exp:NPred),
'$get_predicate_definition'(Imp:Pred,[],Exp:NPred),
'$pred_exists'(NPred,Exp),
%writeln((Imp:Pred -> Exp:NPred )).
!.
'$one_predicate_definition'(Exp:Pred,Exp:Pred).
'$predicate_definition'(M0:Pred0,Path,ModF:PredF) :-
'$get_predicate_definition'(M0:Pred0, Mod:Pred),
\+ lists:member(Mod:Pred,Path),
(
'$predicate_definition'(Mod:Pred,[Mod:Pred|Path],ModF:PredF)
'$pred_exists'(Pred,Mod), Mod = ModF, Pred = PredF
;
Mod = ModF, Pred = PredF
\+ lists:member(Mod:Pred,Path),
'$predicate_definition'(Mod:Pred,[Mod:Pred|Path], ModF:PredF)
).
%

4
pl/meta.yap
View File

@ -405,6 +405,10 @@ meta_predicate(P) :-
'$expand_goals'(B,B1,BO,HM,SM,BM,HVars),
'$expand_goals'(C,C1,CO,HM,SM,BM,HVars),
'$clean_cuts'(AO0, DCP, AO).
'$expand_goals'(forall(A,B), forall(A1,B1),
(A0 , ( B0 -> fail ; true ) -> fail; true ),HM,SM,BM,HVars) :- !,
'$expand_goals'(A,A1,AO,HM,SM,BM,HVars),
'$expand_goals'(B,B1,BO,HM,SM,BM,HVars).
'$expand_goals'((A*->B;C),(A1*->B1;C1),
('$current_choice_point'(DCP),AO,yap_hacks:cut_at(DCP),BO; CO),HM,SM,BM,HVars) :- !,
'$expand_goals'(A,A1,AO0,HM,SM,BM,HVars),

2
pl/preds.yap
View File

@ -490,7 +490,7 @@ current_predicate(A0,T0) :-
'$current_predicate'(A,M,T,_),
functor(T, A, _)
;
'$get_predicate_definition'(M:T,M1:_T1),
'$predicate_definition'(M:T,M1:_T1),
M\=M1,
functor(T, A, _)
).

17
pl/top.yap
View File

@ -602,7 +602,7 @@ write_query_answer( Bindings ) :-
expand_goal(M:G, NG),
must_be_callable(NG),
'$yap_strip_module'(NG,NM,NC),
'$yap_strip_module'(M:NG,NM,NC),
'$call'(NC,CP,G0,NM).
'$call'((X,Y),CP,G0,M) :- !,
'$call'(X,CP,G0,M),
@ -614,8 +614,11 @@ write_query_answer( Bindings ) :-
'$call'(Y,CP,G0,M)
).
'$call'((X*->Y),CP,G0,M) :- !,
'$call'(X,CP,G0,M),
'$call'(Y,CP,G0,M).
(
'$call'(X,CP,G0,M)
*->
'$call'(Y,CP,G0,M)
).
'$call'((X->Y; Z),CP,G0,M) :- !,
(
'$call'(X,CP,G0,M)
@ -671,6 +674,13 @@ write_query_answer( Bindings ) :-
'$call'(X,CP,G0,M) ).
'$call'(!, CP, _G0, _m) :- !,
'$$cut_by'(CP).
'$call'(forall(X,Y), CP, _G0, _m) :- !,
\+ ('$call'(X, CP, G0, M),
\+ '$call'(Y, CP, G0, M) ).
'$call'(once(X), CP, G0, M) :- !,
( '$call'(X, CP, G0, M) -> true).
'$call'(!, CP, _G0, _m) :- !,
'$$cut_by'(CP).
'$call'([X|Y], _, _, M) :-
(Y == [] ->
consult(M:X)
@ -853,7 +863,6 @@ rules: first try term_expansion/2 in the current module, and then try to use th
for DCG rules is applied, together with the arithmetic optimizer
whenever the compilation of arithmetic expressions is in progress.
*/
expand_term(Term,Expanded) :-
(