diff --git a/C/absmi.c b/C/absmi.c index b9616b55a..5a96cf4fe 100755 --- a/C/absmi.c +++ b/C/absmi.c @@ -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); diff --git a/C/parser.c b/C/parser.c index 523efc26a..050e6898e 100644 --- a/C/parser.c +++ b/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)) diff --git a/C/write.c b/C/write.c index f362341b7..3a1ee7c65 100644 --- a/C/write.c +++ b/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); } diff --git a/H/iatoms.h b/H/iatoms.h index 1e41143a5..4e9ad227c 100644 --- a/H/iatoms.h +++ b/H/iatoms.h @@ -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"); diff --git a/H/ratoms.h b/H/ratoms.h index 807d4d0b6..816990b4e 100644 --- a/H/ratoms.h +++ b/H/ratoms.h @@ -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); diff --git a/H/tatoms.h b/H/tatoms.h index 1e859e4ad..8c8b3998b 100644 --- a/H/tatoms.h +++ b/H/tatoms.h @@ -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_; diff --git a/docs/yap.tex b/docs/yap.tex index 2db5b4a27..743b4270d 100644 --- a/docs/yap.tex +++ b/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 diff --git a/library/matrix.yap b/library/matrix.yap index 926d8c183..c8fe890c7 100644 --- a/library/matrix.yap +++ b/library/matrix.yap @@ -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). diff --git a/library/matrix/matrix.c b/library/matrix/matrix.c index be680a6ca..c47cd329b 100644 --- a/library/matrix/matrix.c +++ b/library/matrix/matrix.c @@ -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); diff --git a/misc/ATOMS b/misc/ATOMS index 17c1bdc10..0e198499d 100644 --- a/misc/ATOMS +++ b/misc/ATOMS @@ -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" diff --git a/packages/CLPBN/Makefile.in b/packages/CLPBN/Makefile.in index 9ce9c4122..c7402504d 100644 --- a/packages/CLPBN/Makefile.in +++ b/packages/CLPBN/Makefile.in @@ -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= \ diff --git a/packages/CLPBN/clpbn/gibbs.yap b/packages/CLPBN/clpbn/gibbs.yap index ac8a88285..ce82f0140 100644 --- a/packages/CLPBN/clpbn/gibbs.yap +++ b/packages/CLPBN/clpbn/gibbs.yap @@ -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,_,_,[]) :- !. diff --git a/packages/CLPBN/learning/learn_mln_wgts.yap b/packages/CLPBN/learning/learn_mln_wgts.yap index d080af7e2..07aea7dd8 100644 --- a/packages/CLPBN/learning/learn_mln_wgts.yap +++ b/packages/CLPBN/learning/learn_mln_wgts.yap @@ -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), diff --git a/packages/CLPBN/mlns.yap b/packages/CLPBN/mlns.yap index 7d625f9fc..f007748a5 100644 --- a/packages/CLPBN/mlns.yap +++ b/packages/CLPBN/mlns.yap @@ -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) :- !. diff --git a/packages/CLPBN/pfl.yap b/packages/CLPBN/pfl.yap index da3fc1bd2..e26ae3b3e 100644 --- a/packages/CLPBN/pfl.yap +++ b/packages/CLPBN/pfl.yap @@ -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)). diff --git a/pl/checker.yap b/pl/checker.yap index 457d9160a..cccb97f85 100644 --- a/pl/checker.yap +++ b/pl/checker.yap @@ -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), \+ ( diff --git a/pl/utils.yap b/pl/utils.yap index e12175a2b..66381a7e2 100644 --- a/pl/utils.yap +++ b/pl/utils.yap @@ -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 diff --git a/swi/library/base64.pl b/swi/library/base64.pl index 81b34ecdf..d31baee46 100644 --- a/swi/library/base64.pl +++ b/swi/library/base64.pl @@ -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,