Merge branch 'master' of ssh://git.code.sf.net/p/yap/yap-6.3
This commit is contained in:
commit
dde4830ceb
@ -991,7 +991,7 @@ Yap_absmi(int inp)
|
||||
ENDOp();
|
||||
|
||||
/* check if enough space between trail and codespace */
|
||||
/* try_exo Pred,Label */
|
||||
/* try_exo_udi Pred,Label */
|
||||
Op(try_exo_udi, lp);
|
||||
/* check if enough space between trail and codespace */
|
||||
check_trail(TR);
|
||||
|
47
C/parser.c
47
C/parser.c
@ -70,7 +70,7 @@ typedef struct jmp_buff_struct {
|
||||
|
||||
static void GNextToken( CACHE_TYPE1 );
|
||||
static void checkfor(Term, JMPBUFF * CACHE_TYPE);
|
||||
static Term ParseArgs(Atom, JMPBUFF * CACHE_TYPE);
|
||||
static Term ParseArgs(Atom, Term, JMPBUFF *, Term CACHE_TYPE);
|
||||
static Term ParseList(JMPBUFF * CACHE_TYPE);
|
||||
static Term ParseTerm(int, JMPBUFF * CACHE_TYPE);
|
||||
|
||||
@ -324,7 +324,7 @@ checkfor(Term c, JMPBUFF *FailBuff USES_REGS)
|
||||
}
|
||||
|
||||
static Term
|
||||
ParseArgs(Atom a, JMPBUFF *FailBuff USES_REGS)
|
||||
ParseArgs(Atom a, Term close, JMPBUFF *FailBuff, Term arg1 USES_REGS)
|
||||
{
|
||||
int nargs = 0;
|
||||
Term *p, t;
|
||||
@ -335,6 +335,27 @@ ParseArgs(Atom a, JMPBUFF *FailBuff USES_REGS)
|
||||
|
||||
NextToken;
|
||||
p = (Term *) ParserAuxSp;
|
||||
if (arg1) {
|
||||
*p = arg1;
|
||||
nargs++;
|
||||
ParserAuxSp = (char *)(p+1);
|
||||
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)
|
||||
&& LOCAL_tokptr->TokInfo == close) {
|
||||
|
||||
func = Yap_MkFunctor(a, 1);
|
||||
if (func == NULL) {
|
||||
LOCAL_ErrorMessage = "Heap Overflow";
|
||||
FAIL;
|
||||
}
|
||||
t = Yap_MkApplTerm(func, nargs, p);
|
||||
if (H > ASP-4096) {
|
||||
LOCAL_ErrorMessage = "Stack Overflow";
|
||||
return TermNil;
|
||||
}
|
||||
NextToken;
|
||||
return t;
|
||||
}
|
||||
}
|
||||
while (1) {
|
||||
Term *tp = (Term *)ParserAuxSp;
|
||||
if (ParserAuxSp+1 > LOCAL_TrailTop) {
|
||||
@ -380,7 +401,7 @@ ParseArgs(Atom a, JMPBUFF *FailBuff USES_REGS)
|
||||
return TermNil;
|
||||
}
|
||||
/* check for possible overflow against local stack */
|
||||
checkfor((Term) ')', FailBuff PASS_REGS);
|
||||
checkfor(close, FailBuff PASS_REGS);
|
||||
return t;
|
||||
}
|
||||
|
||||
@ -519,7 +540,7 @@ ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS)
|
||||
}
|
||||
if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)
|
||||
&& Unsigned(LOCAL_tokptr->TokInfo) == 'l')
|
||||
t = ParseArgs((Atom) t, FailBuff PASS_REGS);
|
||||
t = ParseArgs((Atom) t, (Term)')', FailBuff, 0L PASS_REGS);
|
||||
else
|
||||
t = MkAtomTerm((Atom)t);
|
||||
break;
|
||||
@ -710,6 +731,24 @@ ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS)
|
||||
}
|
||||
curprio = opprio;
|
||||
continue;
|
||||
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '(' &&
|
||||
IsPosfixOp(AtomEmptyBrackets, &opprio, &oplprio PASS_REGS)
|
||||
&& opprio <= prio && oplprio >= curprio) {
|
||||
t = ParseArgs(AtomEmptyBrackets, (Term)')', FailBuff, t PASS_REGS);
|
||||
curprio = opprio;
|
||||
continue;
|
||||
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '[' &&
|
||||
IsPosfixOp(AtomEmptySquareBrackets, &opprio, &oplprio PASS_REGS)
|
||||
&& opprio <= prio && oplprio >= curprio) {
|
||||
t = ParseArgs(AtomEmptySquareBrackets, (Term)']', FailBuff, t PASS_REGS);
|
||||
curprio = opprio;
|
||||
continue;
|
||||
} else if (Unsigned(LOCAL_tokptr->TokInfo) == '{' &&
|
||||
IsPosfixOp(AtomEmptyCurlyBrackets, &opprio, &oplprio PASS_REGS)
|
||||
&& opprio <= prio && oplprio >= curprio) {
|
||||
t = ParseArgs(AtomEmptyCurlyBrackets, (Term)'}', FailBuff, t PASS_REGS);
|
||||
curprio = opprio;
|
||||
continue;
|
||||
}
|
||||
}
|
||||
if (LOCAL_tokptr->Tok <= Ord(WString_tok))
|
||||
|
41
C/write.c
41
C/write.c
@ -320,7 +320,7 @@ wrputf(Float f, struct write_globs *wglb) /* writes a float */
|
||||
ob = protect_open_number(wglb, last_minus, sgn);
|
||||
#if THREADS
|
||||
/* old style writing */
|
||||
int found_dot = FALSE, found_exp = FALSE;
|
||||
int found_dot = FALSE;
|
||||
char *pt = s;
|
||||
int ch;
|
||||
|
||||
@ -348,7 +348,6 @@ wrputf(Float f, struct write_globs *wglb) /* writes a float */
|
||||
found_dot = TRUE;
|
||||
wrputs(".0", stream);
|
||||
}
|
||||
found_exp = TRUE;
|
||||
default:
|
||||
wrputc(ch, stream);
|
||||
}
|
||||
@ -751,7 +750,6 @@ check_infinite_loop(Term t, struct rewind_term *x, struct write_globs *wglb)
|
||||
static void
|
||||
write_list(Term t, int direction, int depth, struct write_globs *wglb, struct rewind_term *rwt)
|
||||
{
|
||||
CACHE_REGS
|
||||
Term ti;
|
||||
struct rewind_term nrwt;
|
||||
nrwt.parent = rwt;
|
||||
@ -975,7 +973,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
|
||||
wrclose_bracket(wglb, TRUE);
|
||||
}
|
||||
} else if (!wglb->Ignore_ops &&
|
||||
Arity == 1 &&
|
||||
( Arity == 1 || atom == AtomEmptyBrackets || atom == AtomEmptyCurlyBrackets || atom == AtomEmptySquareBrackets) &&
|
||||
Yap_IsPosfixOp(atom, &op, &lp)) {
|
||||
Term tleft = ArgOfTerm(1, t);
|
||||
|
||||
@ -995,7 +993,40 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
|
||||
if (bracket_left) {
|
||||
wrclose_bracket(wglb, TRUE);
|
||||
}
|
||||
putAtom(atom, wglb->Quote_illegal, wglb);
|
||||
if (Arity > 1) {
|
||||
if (atom == AtomEmptyBrackets) {
|
||||
wrputc('(', wglb->stream);
|
||||
} else if (atom == AtomEmptySquareBrackets) {
|
||||
wrputc('[', wglb->stream);
|
||||
} else if (atom == AtomEmptyCurlyBrackets) {
|
||||
wrputc('{', wglb->stream);
|
||||
}
|
||||
lastw = separator;
|
||||
for (op = 2; op <= Arity; ++op) {
|
||||
if (op == wglb->MaxArgs) {
|
||||
wrputc('.', wglb->stream);
|
||||
wrputc('.', wglb->stream);
|
||||
wrputc('.', wglb->stream);
|
||||
break;
|
||||
}
|
||||
writeTerm(from_pointer(RepAppl(t)+op, &nrwt, wglb), 999, depth + 1, FALSE, wglb, &nrwt);
|
||||
restore_from_write(&nrwt, wglb);
|
||||
if (op != Arity) {
|
||||
wrputc(',', wglb->stream);
|
||||
lastw = separator;
|
||||
}
|
||||
}
|
||||
if (atom == AtomEmptyBrackets) {
|
||||
wrputc(')', wglb->stream);
|
||||
} else if (atom == AtomEmptySquareBrackets) {
|
||||
wrputc(']', wglb->stream);
|
||||
} else if (atom == AtomEmptyCurlyBrackets) {
|
||||
wrputc('}', wglb->stream);
|
||||
}
|
||||
lastw = separator;
|
||||
} else {
|
||||
putAtom(atom, wglb->Quote_illegal, wglb);
|
||||
}
|
||||
if (op > p) {
|
||||
wrclose_bracket(wglb, TRUE);
|
||||
}
|
||||
|
@ -20,6 +20,9 @@
|
||||
AtomArrayType = Yap_LookupAtom("array_type");
|
||||
AtomArrow = Yap_LookupAtom("->");
|
||||
AtomAssert = Yap_LookupAtom(":-");
|
||||
AtomEmptyBrackets = Yap_LookupAtom("()");
|
||||
AtomEmptySquareBrackets = Yap_LookupAtom("[]");
|
||||
AtomEmptyCurlyBrackets = Yap_LookupAtom("{}");
|
||||
AtomAt = Yap_LookupAtom("at");
|
||||
AtomAtom = Yap_LookupAtom("atom");
|
||||
AtomAtomic = Yap_LookupAtom("atomic");
|
||||
|
@ -20,6 +20,9 @@
|
||||
AtomArrayType = AtomAdjust(AtomArrayType);
|
||||
AtomArrow = AtomAdjust(AtomArrow);
|
||||
AtomAssert = AtomAdjust(AtomAssert);
|
||||
AtomEmptyBrackets = AtomAdjust(AtomEmptyBrackets);
|
||||
AtomEmptySquareBrackets = AtomAdjust(AtomEmptySquareBrackets);
|
||||
AtomEmptyCurlyBrackets = AtomAdjust(AtomEmptyCurlyBrackets);
|
||||
AtomAt = AtomAdjust(AtomAt);
|
||||
AtomAtom = AtomAdjust(AtomAtom);
|
||||
AtomAtomic = AtomAdjust(AtomAtomic);
|
||||
|
@ -38,6 +38,12 @@
|
||||
#define AtomArrow Yap_heap_regs->AtomArrow_
|
||||
Atom AtomAssert_;
|
||||
#define AtomAssert Yap_heap_regs->AtomAssert_
|
||||
Atom AtomEmptyBrackets_;
|
||||
#define AtomEmptyBrackets Yap_heap_regs->AtomEmptyBrackets_
|
||||
Atom AtomEmptySquareBrackets_;
|
||||
#define AtomEmptySquareBrackets Yap_heap_regs->AtomEmptySquareBrackets_
|
||||
Atom AtomEmptyCurlyBrackets_;
|
||||
#define AtomEmptyCurlyBrackets Yap_heap_regs->AtomEmptyCurlyBrackets_
|
||||
Atom AtomAt_;
|
||||
#define AtomAt Yap_heap_regs->AtomAt_
|
||||
Atom AtomAtom_;
|
||||
|
14
docs/yap.tex
14
docs/yap.tex
@ -9976,6 +9976,13 @@ Unify @var{Elems} with the list including all the elements in @var{Matrix}.
|
||||
Unify @var{Elem} with the element of @var{Matrix} at position
|
||||
@var{Position}.
|
||||
|
||||
@item matrix_get(+@var{Matrix}[+@var{Position}],-@var{Elem})
|
||||
@findex matrix_get/2
|
||||
@snindex matrix_get/2
|
||||
@cnindex matrix_get/2
|
||||
|
||||
Unify @var{Elem} with the element @var{Matrix}[@var{Position}].
|
||||
|
||||
@item matrix_set(+@var{Matrix},+@var{Position},+@var{Elem})
|
||||
@findex matrix_set/3
|
||||
@snindex matrix_set/3
|
||||
@ -9984,6 +9991,13 @@ Unify @var{Elem} with the element of @var{Matrix} at position
|
||||
Set the element of @var{Matrix} at position
|
||||
@var{Position} to @var{Elem}.
|
||||
|
||||
@item matrix_set(+@var{Matrix}[+@var{Position}],+@var{Elem})
|
||||
@findex matrix_set/2
|
||||
@snindex matrix_set/2
|
||||
@cnindex matrix_set/2
|
||||
|
||||
Set the element of @var{Matrix}[@var{Position}] to @var{Elem}.
|
||||
|
||||
@item matrix_set_all(+@var{Matrix},+@var{Elem})
|
||||
@findex matrix_set_all/2
|
||||
@snindex matrix_set_all/2
|
||||
|
@ -84,7 +84,10 @@ typedef enum {
|
||||
matrix_set_all_that_disagree/5,
|
||||
matrix_expand/3,
|
||||
matrix_select/4,
|
||||
matrix_column/3
|
||||
matrix_column/3,
|
||||
matrix_get/2,
|
||||
matrix_set/2,
|
||||
op(100, fy, '[]')
|
||||
]).
|
||||
|
||||
:- load_foreign_files([matrix], [], init_matrix).
|
||||
|
@ -220,6 +220,30 @@ scan_dims(int ndims, YAP_Term tl, int dims[MAX_DIMS])
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
static int
|
||||
scan_dims_args(int ndims, YAP_Term tl, int dims[MAX_DIMS])
|
||||
{
|
||||
int i;
|
||||
|
||||
for (i = 0; i < ndims; i++) {
|
||||
YAP_Term th;
|
||||
int d;
|
||||
|
||||
th = YAP_ArgOfTerm(2+i, tl);
|
||||
if (!YAP_IsIntTerm(th)) {
|
||||
/* ERROR */
|
||||
return FALSE;
|
||||
}
|
||||
d = YAP_IntOfTerm(th);
|
||||
if (d < 0) {
|
||||
/* ERROR */
|
||||
return FALSE;
|
||||
}
|
||||
dims[i] = d;
|
||||
}
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
static int
|
||||
cp_int_matrix(YAP_Term tl,YAP_Term matrix)
|
||||
{
|
||||
@ -607,6 +631,44 @@ matrix_set(void)
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
static int
|
||||
matrix_set2(void)
|
||||
{
|
||||
int dims[MAX_DIMS], *mat;
|
||||
YAP_Term tf, t = YAP_ARG1;
|
||||
|
||||
mat = (int *)YAP_BlobOfTerm(YAP_ArgOfTerm(1,t));
|
||||
if (!mat) {
|
||||
/* Error */
|
||||
return FALSE;
|
||||
}
|
||||
if (!scan_dims_args(mat[MAT_NDIMS], t, dims)) {
|
||||
/* Error */
|
||||
return FALSE;
|
||||
}
|
||||
tf = YAP_ARG2;
|
||||
if (mat[MAT_TYPE] == INT_MATRIX) {
|
||||
if (YAP_IsIntTerm(tf)) {
|
||||
matrix_long_set(mat, dims, YAP_IntOfTerm(tf));
|
||||
} else if (YAP_IsFloatTerm(tf)) {
|
||||
matrix_long_set(mat, dims, YAP_FloatOfTerm(tf));
|
||||
} else {
|
||||
/* Error */
|
||||
return FALSE;
|
||||
}
|
||||
} else {
|
||||
if (YAP_IsIntTerm(tf)) {
|
||||
matrix_float_set(mat, dims, YAP_IntOfTerm(tf));
|
||||
} else if (YAP_IsFloatTerm(tf)) {
|
||||
matrix_float_set(mat, dims, YAP_FloatOfTerm(tf));
|
||||
} else {
|
||||
/* Error */
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
static int
|
||||
matrix_set_all(void)
|
||||
{
|
||||
@ -698,6 +760,25 @@ do_matrix_access(void)
|
||||
return YAP_Unify(tf, YAP_ARG3);
|
||||
}
|
||||
|
||||
static int
|
||||
do_matrix_access2(void)
|
||||
{
|
||||
int dims[MAX_DIMS], *mat;
|
||||
YAP_Term tf, t = YAP_ARG1;
|
||||
|
||||
mat = (int *)YAP_BlobOfTerm(YAP_ArgOfTerm(1, t));
|
||||
if (!mat) {
|
||||
/* Error */
|
||||
return FALSE;
|
||||
}
|
||||
if (!scan_dims_args(mat[MAT_NDIMS], t, dims)) {
|
||||
/* Error */
|
||||
return FALSE;
|
||||
}
|
||||
tf = matrix_access(mat, dims);
|
||||
return YAP_Unify(tf, YAP_ARG2);
|
||||
}
|
||||
|
||||
static int
|
||||
do_matrix_inc(void)
|
||||
{
|
||||
@ -2989,9 +3070,11 @@ init_matrix(void)
|
||||
YAP_UserCPredicate("new_floats_matrix", new_floats_matrix, 4);
|
||||
YAP_UserCPredicate("new_floats_matrix_set", new_floats_matrix_set, 4);
|
||||
YAP_UserCPredicate("matrix_set", matrix_set, 3);
|
||||
YAP_UserCPredicate("matrix_set", matrix_set2, 2);
|
||||
YAP_UserCPredicate("matrix_set_all", matrix_set_all, 2);
|
||||
YAP_UserCPredicate("matrix_add", matrix_add, 3);
|
||||
YAP_UserCPredicate("matrix_get", do_matrix_access, 3);
|
||||
YAP_UserCPredicate("matrix_get", do_matrix_access2, 2);
|
||||
YAP_UserCPredicate("matrix_inc", do_matrix_inc, 2);
|
||||
YAP_UserCPredicate("matrix_dec", do_matrix_dec, 2);
|
||||
YAP_UserCPredicate("matrix_inc", do_matrix_inc2, 3);
|
||||
|
@ -25,6 +25,9 @@ A ArrayOverflow N "array_overflow"
|
||||
A ArrayType N "array_type"
|
||||
A Arrow N "->"
|
||||
A Assert N ":-"
|
||||
A EmptyBrackets N "()"
|
||||
A EmptySquareBrackets N "[]"
|
||||
A EmptyCurlyBrackets N "{}"
|
||||
A At N "at"
|
||||
A Atom N "atom"
|
||||
A Atomic N "atomic"
|
||||
|
@ -77,6 +77,7 @@ CLPBN_LEARNING_PROGRAMS= \
|
||||
$(CLPBN_LEARNING_SRCDIR)/bnt_parms.yap \
|
||||
$(CLPBN_LEARNING_SRCDIR)/em.yap \
|
||||
$(CLPBN_LEARNING_SRCDIR)/learn_utils.yap \
|
||||
$(CLPBN_LEARNING_SRCDIR)/learn_mln_wgts.yap \
|
||||
$(CLPBN_LEARNING_SRCDIR)/mle.yap
|
||||
|
||||
CLPBN_EXAMPLES= \
|
||||
|
@ -116,7 +116,7 @@ graph_representation([V|Vs], Graph, I0, Keys, TGraph) :-
|
||||
length(Vals,Sz),
|
||||
project_evidence_out([V|Parents],[V|Parents],Table,[Sz|Szs],Variables,NewTable),
|
||||
% all variables are parents
|
||||
propagate2parents(Variables, NewTable, Variables, Graph, Keys),
|
||||
maplist( propagate2parent(NewTable, Variables, Graph, Keys), Variables),
|
||||
graph_representation(Vs, Graph, I0, Keys, TGraph).
|
||||
graph_representation([V|Vs], Graph, I0, Keys, [I-IParents|TGraph]) :-
|
||||
I is I0+1,
|
||||
@ -129,7 +129,7 @@ graph_representation([V|Vs], Graph, I0, Keys, [I-IParents|TGraph]) :-
|
||||
sort_according_to_indices(NewParents,Keys,SortedNVs,SortedIndices),
|
||||
reorder_CPT(Variables,NewTable,[V|SortedNVs],NewTable2,_),
|
||||
add2graph(V, Vals, NewTable2, SortedIndices, Graph, Keys),
|
||||
propagate2parents(NewParents, NewTable, Variables, Graph,Keys),
|
||||
maplist( propagate2parent(NewTable, Variables, Graph,Keys), NewParents),
|
||||
maplist(parent_index(Keys), NewParents, IVariables0),
|
||||
sort(IVariables0, IParents),
|
||||
arg(I, Graph, var(_,_,_,_,_,_,_,NewTable2,SortedIndices)),
|
||||
@ -158,13 +158,11 @@ project_evidence_out([V|Parents],Deps,Table,Szs,NewDeps,NewTable) :-
|
||||
project_evidence_out([_Par|Parents],Deps,Table,Szs,NewDeps,NewTable) :-
|
||||
project_evidence_out(Parents,Deps,Table,Szs,NewDeps,NewTable).
|
||||
|
||||
propagate2parents([], _, _, _, _).
|
||||
propagate2parents([V|NewParents], Table, Variables, Graph, Keys) :-
|
||||
propagate2parent(Table, Variables, Graph, Keys, V) :-
|
||||
delete(Variables,V,NVs),
|
||||
sort_according_to_indices(NVs,Keys,SortedNVs,SortedIndices),
|
||||
reorder_CPT(Variables,Table,[V|SortedNVs],NewTable,_),
|
||||
add2graph(V, _, NewTable, SortedIndices, Graph, Keys),
|
||||
propagate2parents(NewParents,Table, Variables, Graph, Keys).
|
||||
add2graph(V, _, NewTable, SortedIndices, Graph, Keys).
|
||||
|
||||
add2graph(V, Vals, Table, IParents, Graph, Keys) :-
|
||||
rb_lookup(V, Index, Keys),
|
||||
@ -298,14 +296,12 @@ init_chains(I,VarOrder,Len,Graph,[Chain|Chains]) :-
|
||||
|
||||
init_chain(VarOrder,Len,Graph,Chain) :-
|
||||
functor(Chain,sample,Len),
|
||||
gen_sample(VarOrder,Graph,Chain).
|
||||
maplist( gen_sample(Graph,Chain), VarOrder).
|
||||
|
||||
gen_sample([],_,_) :- !.
|
||||
gen_sample([I|Vs],Graph,Chain) :-
|
||||
arg(I,Graph,var(_,I,_,_,Sz,_,_,_,_)),
|
||||
gen_sample(Graph, Chain, I) :-
|
||||
arg(I, Graph, var(_,I,_,_,Sz,_,_,_,_)),
|
||||
Pos is integer(random*Sz),
|
||||
arg(I,Chain,Pos),
|
||||
gen_sample(Vs,Graph,Chain).
|
||||
arg(I, Chain, Pos).
|
||||
|
||||
|
||||
init_estimates(0,_,_,[]) :- !.
|
||||
|
@ -152,6 +152,7 @@ optimize :-
|
||||
compile :-
|
||||
init_compiler,
|
||||
mln(ParFactor, _Type, _Els, _G),
|
||||
writeln(ParFactor),
|
||||
factor(markov, ParFactor, Ks, _, _Phi, Constraints),
|
||||
maplist(call, Constraints),
|
||||
nth(_L, Ks, VId),
|
||||
|
@ -2,6 +2,7 @@
|
||||
[op(1150,fx,mln),
|
||||
op(1150,fx,mln_domain),
|
||||
mln_domain/1,
|
||||
mln_literal/1,
|
||||
mln/1,
|
||||
mln/4,
|
||||
mln_w/2]).
|
||||
@ -10,13 +11,21 @@
|
||||
:- use_module(library(maplist)).
|
||||
:- use_module(library(lists)).
|
||||
|
||||
:- dynamic mln/1, mln/2, mln_domain/4, mln/4, mln_w/2.
|
||||
:- dynamic mln/1, mln/2, mln_domain/4, mln/4, mln_w/2, mln_domain/5, mln_type_def/1.
|
||||
|
||||
user:term_expansion(mln_domain(P),[]) :-
|
||||
expand_domain(P).
|
||||
|
||||
user:term_expansion( mln(W: D), pfl:factor(markov,Id,FList,FV,Phi,Constraints)) :-
|
||||
translate_to_factor(W, D, FList, Id, FV, Phi, Constraints).
|
||||
translate_to_factor(W, D, FList, Id, FV, Phi, Constraints), !.
|
||||
user:term_expansion( mln(W: D), _) :-
|
||||
throw(error(domain_error(mln,W:D),error)).
|
||||
|
||||
user:term_expansion(end_of_file,_) :-
|
||||
mln_domain(TypeG, NP, I0, A, Type),
|
||||
add_mln_domain(TypeG, NP, I0, A, Type),
|
||||
fail.
|
||||
user:term_expansion(end_of_file,end_of_file).
|
||||
|
||||
expand_domain((P1,P2)) :- !,
|
||||
expand_domain(P1),
|
||||
@ -31,8 +40,26 @@ do_type(NP, Type, I0, I) :-
|
||||
I is I0+1,
|
||||
arg(I0, NP, A),
|
||||
TypeG =.. [Type, A],
|
||||
assert(mln_domain(TypeG, NP, I0, A, Type)),
|
||||
assert(mln_domain(I0, NP, TypeG, A)).
|
||||
|
||||
add_mln_domain(TypeG, NP, I0, A, _) :-
|
||||
mln_type_def(TypeG), !,
|
||||
functor(NP, G, Ar),
|
||||
functor(NNP, G, Ar),
|
||||
arg(I0, NNP, A),
|
||||
assert_static(user:(TypeG :- NNP)).
|
||||
add_mln_domain(TypeG, _NP, _I0, _A, _) :-
|
||||
predicate_property(user:TypeG, _), !.
|
||||
add_mln_domain(TypeG, NP, I0, A, Type) :-
|
||||
assert(mln_type_def(TypeG)), !,
|
||||
functor(NP, G, Ar),
|
||||
functor(NNP, G, Ar),
|
||||
arg(I0, NNP, A),
|
||||
table(user:Type/1),
|
||||
assert_static(user:(TypeG :- NNP)).
|
||||
|
||||
|
||||
translate_to_factor(W, D, Lits, Id, Vs, Phi, Domain) :-
|
||||
W0 is exp(W),
|
||||
(
|
||||
@ -128,8 +155,8 @@ disj_to_list2((C1+C2), L1, L10, L, L0) :-
|
||||
disj_to_list2(C2, L1I, L10, LI, L0).
|
||||
disj_to_list2((_C1,_C2), _L1, _L10, _L, _L0) :- !, fail.
|
||||
disj_to_list2((_C1*_C2), _L1, _L10, _L, _L0) :- !, fail.
|
||||
disj_to_list2((\+ C), [(-C)|L1], L1, [C|L], L) :- literal(C), !.
|
||||
disj_to_list2((- C), [(-C)|L1], L1, [C|L], L) :- literal(C), !.
|
||||
disj_to_list2((\+ C), [(-C)|L1], L1, [C|L], L) :- !.
|
||||
disj_to_list2((- C), [(-C)|L1], L1, [C|L], L) :- !.
|
||||
disj_to_list2(C, [C|L1], L1, [C|L], L).
|
||||
|
||||
conj_to_list((C1,C2), L1, L10, L, L0) :-
|
||||
@ -151,8 +178,8 @@ conj_to_list2((C1*C2), L1, L10, L, L0) :-
|
||||
!,
|
||||
conj_to_list2(C1, L1, L1I, L, LI),
|
||||
conj_to_list2(C2, L1I, L10, LI, L0).
|
||||
conj_to_list2((\+ C), [(C)|L1], L1, [C|L], L) :- literal(C), !.
|
||||
conj_to_list2((- C), [(C)|L1], L1, [C|L], L) :- literal(C), !.
|
||||
conj_to_list2((\+ C), [(C)|L1], L1, [C|L], L) :- !.
|
||||
conj_to_list2((- C), [(C)|L1], L1, [C|L], L) :- !.
|
||||
conj_to_list2(C, [-C|L1], L1, [C|L], L).
|
||||
|
||||
remove_not(-G, G) :- !.
|
||||
|
@ -167,16 +167,24 @@ process_arg(Sk, Id, _I) -->
|
||||
},
|
||||
[Sk].
|
||||
|
||||
%
|
||||
% redefinition
|
||||
%
|
||||
new_skolem(Sk, D) :-
|
||||
copy_term(Sk, Sk1),
|
||||
skolem(Sk1, D1),
|
||||
functor(Sk1, N, A),
|
||||
functor(Sk , N, A),
|
||||
!,
|
||||
functor(Sk , N, A), !,
|
||||
( D1 = D -> true ; throw(pfl(permission_error(redefining_domain(Sk),D:D1)))).
|
||||
%
|
||||
%
|
||||
% create interface and skolem descriptor
|
||||
%
|
||||
new_skolem(Sk, D) :-
|
||||
functor(Sk, N, A),
|
||||
functor(NSk, N, A),
|
||||
% [f,t] is special for evidence
|
||||
( D = [f,t] -> assert((evidence(NSk, 1) :- call(user:NSk))) ; true ),
|
||||
interface_predicate(NSk),
|
||||
assert(skolem(NSk, D)).
|
||||
|
||||
|
@ -159,11 +159,13 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
|
||||
'$handle_multiple'(F,A,NM),
|
||||
fail.
|
||||
'$check_term'(_, T,_,_,M) :-
|
||||
once((
|
||||
(
|
||||
get_value('$syntaxcheckdiscontiguous',on)
|
||||
->
|
||||
true
|
||||
;
|
||||
get_value('$syntaxcheckmultiple',on)
|
||||
)),
|
||||
),
|
||||
nb_getval('$consulting_file',File),
|
||||
'$xtract_head'(T,M,NM,_,F,A),
|
||||
\+ (
|
||||
|
@ -92,11 +92,11 @@
|
||||
'$do_error'(instantiation_error,G).
|
||||
'$check_op_name'(_,_,',',G) :- !,
|
||||
'$do_error'(permission_error(modify,operator,','),G).
|
||||
'$check_op_name'(_,_,'[]',G) :- !,
|
||||
'$check_op_name'(_,_,'[]',G) :- T \= yf, T\= xf, !,
|
||||
'$do_error'(permission_error(create,operator,'[]'),G).
|
||||
'$check_op_name'(_,_,'{}',G) :- !,
|
||||
'$check_op_name'(_,_,'{}',G) :- T \= yf, T\= xf, !,
|
||||
'$do_error'(permission_error(create,operator,'{}'),G).
|
||||
'$check_op_name'(P,T,'|',G) :-
|
||||
'$check_op_name'(P,T,'|',G) :-
|
||||
(
|
||||
integer(P),
|
||||
P < 1001, P > 0
|
||||
|
@ -106,7 +106,7 @@ encode([I0, I1, I2|Rest]) --> !,
|
||||
},
|
||||
encode(Rest).
|
||||
encode([I0, I1]) --> !,
|
||||
[O0, O1, O2, 0'=],
|
||||
[O0, O1, O2, 0'=], %'
|
||||
{ A is (I0<<16)+(I1<<8),
|
||||
O00 is (A>>18) /\ 0x3f,
|
||||
O01 is (A>>12) /\ 0x3f,
|
||||
|
Reference in New Issue
Block a user