diff --git a/C/atomic.c b/C/atomic.c index c6e1bae85..c13005da8 100755 --- a/C/atomic.c +++ b/C/atomic.c @@ -1341,6 +1341,7 @@ restart_aux: while (t1 != TermNil) { inpv[i].type = YAP_STRING_ATOM, inpv[i].val.t = HeadOfTerm(t1); + inpv[i].enc = ENC_ISO_UTF8; i++; t1 = TailOfTerm(t1); } @@ -1389,6 +1390,7 @@ restart_aux: while (t1 != TermNil) { inpv[i].type = YAP_STRING_STRING; inpv[i].val.t = HeadOfTerm(t1); + inpv[i].enc = ENC_ISO_UTF8; i++; t1 = TailOfTerm(t1); } @@ -1428,8 +1430,6 @@ restart_aux: if (*tailp != TermNil) { LOCAL_Error_TYPE = TYPE_ERROR_LIST; } else { - seq_tv_t *inpv = (seq_tv_t *)Malloc(n * sizeof(seq_tv_t)); - seq_tv_t *out = (seq_tv_t *)Malloc(sizeof(seq_tv_t)); int i = 0; Atom at; @@ -1438,6 +1438,8 @@ restart_aux: pop_text_stack(l); return rc; } + seq_tv_t *inpv = (seq_tv_t *)Malloc(n * sizeof(seq_tv_t)); + seq_tv_t *out = (seq_tv_t *)Malloc(sizeof(seq_tv_t)); if (!inpv) { LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; goto error; @@ -1448,6 +1450,7 @@ restart_aux: YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_CHARS | YAP_STRING_CODES; inpv[i].val.t = HeadOfTerm(t1); + inpv[i].enc = ENC_ISO_UTF8; i++; t1 = TailOfTerm(t1); } @@ -1464,6 +1467,7 @@ restart_aux: } error: /* Error handling */ + pop_text_stack(l); if (LOCAL_Error_TYPE && Yap_HandleError("atom_concat/3")) { goto restart_aux; } @@ -1494,6 +1498,7 @@ restart_aux: inpv[i].type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; inpv[i].val.t = HeadOfTerm(t1); + inpv[i].enc = ENC_ISO_UTF8; i++; t1 = TailOfTerm(t1); } @@ -1543,10 +1548,12 @@ restart_aux: inpv[i].type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; inpv[i].val.t = HeadOfTerm(t1); + inpv[i].enc = ENC_ISO_UTF8; i++; inpv[i].type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; inpv[i].val.t = t2; + inpv[i].enc = ENC_ISO_UTF8; i++; t1 = TailOfTerm(t1); } diff --git a/C/cdmgr.c b/C/cdmgr.c index 3d578ddb4..c0952f03c 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -74,6 +74,49 @@ static void kill_first_log_iblock(LogUpdIndex *, LogUpdIndex *, PredEntry *); #define PredArity(p) (p->ArityOfPE) #define TRYCODE(G, F, N) ((N) < 5 ? (op_numbers)((int)F + (N)*3) : G) +PredEntry *Yap_get_pred(Term t, Term tmod, const char *pname) { + Term t0 = t; + +restart: + if (IsVarTerm(t)) { + Yap_ThrowError(INSTANTIATION_ERROR, t0, pname); + return NULL; + } else if (IsAtomTerm(t)) { + PredEntry *ap = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod)); + return ap; + } else if (IsIntegerTerm(t) && tmod == IDB_MODULE) { + return Yap_FindLUIntKey(IntegerOfTerm(t)); + } else if (IsPairTerm(t)) { + t = Yap_MkApplTerm(FunctorCsult, 1, &t); + goto restart; + } else if (IsApplTerm(t)) { + Functor fun = FunctorOfTerm(t); + if (IsExtensionFunctor(fun)) { + Yap_ThrowError(TYPE_ERROR_CALLABLE, t, pname); + return NULL; + } + if (fun == FunctorModule) { + Term tmod = ArgOfTerm(1, t); + if (IsVarTerm(tmod)) { + Yap_ThrowError(INSTANTIATION_ERROR, t0, pname); + return NULL; + } + if (!IsAtomTerm(tmod)) { + Yap_ThrowError(TYPE_ERROR_ATOM, t0, pname); + return NULL; + } + t = ArgOfTerm(2, t); + goto restart; + } + PredEntry *ap = RepPredProp(Yap_GetPredPropByFunc(fun, tmod)); + return ap; + } else { + Yap_ThrowError(TYPE_ERROR_CALLABLE, t0, pname); + } + return NULL; +} + + static void InitConsultStack(void) { CACHE_REGS LOCAL_ConsultLow = (consult_obj *)Yap_AllocCodeSpace(sizeof(consult_obj) * @@ -120,47 +163,6 @@ bool Yap_Consulting(USES_REGS1) { * assertz are supported for static predicates no database predicates are * supportted for fast predicates */ -PredEntry *Yap_get_pred(Term t, Term tmod, const char *pname) { - Term t0 = t; - -restart: - if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR, t0, pname); - return NULL; - } else if (IsAtomTerm(t)) { - PredEntry *ap = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod)); - return ap; - } else if (IsIntegerTerm(t) && tmod == IDB_MODULE) { - return Yap_FindLUIntKey(IntegerOfTerm(t)); - } else if (IsPairTerm(t)) { - t = Yap_MkApplTerm(FunctorCsult, 1, &t); - goto restart; - } else if (IsApplTerm(t)) { - Functor fun = FunctorOfTerm(t); - if (IsExtensionFunctor(fun)) { - Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), pname); - return NULL; - } - if (fun == FunctorModule) { - Term tmod = ArgOfTerm(1, t); - if (IsVarTerm(tmod)) { - Yap_Error(INSTANTIATION_ERROR, t0, pname); - return NULL; - } - if (!IsAtomTerm(tmod)) { - Yap_Error(TYPE_ERROR_ATOM, t0, pname); - return NULL; - } - t = ArgOfTerm(2, t); - goto restart; - } - PredEntry *ap = RepPredProp(Yap_GetPredPropByFunc(fun, tmod)); - return ap; - } else { - Yap_Error(TYPE_ERROR_CALLABLE, t0, pname); - } - return NULL; -} /** Look for a predicate with same functor as t, create a new one of it cannot find it. @@ -179,7 +181,7 @@ restart: } else if (IsApplTerm(t)) { Functor fun = FunctorOfTerm(t); if (IsExtensionFunctor(fun)) { - Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), pname); + Yap_Error(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), pname); return NULL; } if (fun == FunctorModule) { @@ -349,7 +351,7 @@ static void split_megaclause(PredEntry *ap) { mcl = ClauseCodeToMegaClause(ap->cs.p_code.FirstClause); if (mcl->ClFlags & ExoMask) { - Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateIndicator(CurrentModule,ap), + Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateToIndicator(ap), "while deleting clause from exo predicate %s/%d\n", RepAtom(NameOfFunctor(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE); @@ -1468,7 +1470,7 @@ static yamop *addcl_permission_error(const char *file, const char *function, int lineno, PredEntry *ap, int in_use) { CACHE_REGS - Term culprit = Yap_PredicateIndicator(CurrentModule, ap); + Term culprit = Yap_PredicateToIndicator( ap); return in_use ? (ap->ArityOfPE == 0 ? Yap_Error__(false, file, function, lineno, @@ -4102,7 +4104,11 @@ static Int | TabledPredFlag #endif /* TABLING */ )) { +<<<<<<< HEAD Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateIndicator(CurrentModule, t), +======= + Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateToIndicator(ap), +>>>>>>> ab56074bb1a1f428c5c0c2a1781e00b02bb58f03 "dbload_get_space/4"); return FALSE; } diff --git a/C/dbase.c b/C/dbase.c index 70c6deea2..aa7b973a3 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -3977,6 +3977,7 @@ static void EraseLogUpdCl(LogUpdClause *clau) { ap->cs.p_code.LastClause = clau->ClPrev->ClCode; } } + clau->ClTimeEnd = ap->TimeStampOfPred; ap->cs.p_code.NOfClauses--; } #ifndef THREADS diff --git a/C/errors.c b/C/errors.c index 8c5dd6a72..d64e1210c 100755 --- a/C/errors.c +++ b/C/errors.c @@ -616,7 +616,6 @@ yap_error_descriptor_t *Yap_popErrorContext(bool mdnew, bool pass) { memmove(ep, e, sizeof(*e)); ep->top_error = epp; } - free(e); return LOCAL_ActiveError; } /** diff --git a/C/exec.c b/C/exec.c index 38caee798..3d9aae042 100755 --- a/C/exec.c +++ b/C/exec.c @@ -115,14 +115,18 @@ static inline bool CallPredicate(PredEntry *pen, choiceptr cut_pt, inline static bool CallMetaCall(Term t, Term mod USES_REGS) { // we have a creep requesr waiting - ARG1 = t; + if (IsVarTerm(t)) + Yap_ThrowError(INSTANTIATION_ERROR, t, "meta-call"); + if (IsIntTerm(t) || (IsApplTerm(t) && IsExtensionFunctor(FunctorOfTerm(t)))) + Yap_ThrowError(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, mod), "meta-call"); +ARG1 = t; ARG2 = cp_as_integer(B PASS_REGS); /* p_current_choice_point */ ARG3 = t; if (mod) { ARG4 = mod; } else { ARG4 = TermProlog; - } +} if (Yap_GetGlobal(AtomDebugMeta) == TermOn) { return CallPredicate(PredTraceMetaCall, B, PredTraceMetaCall->CodeOfPred PASS_REGS); @@ -141,6 +145,10 @@ inline static bool CallMetaCall(Term t, Term mod USES_REGS) { Term Yap_ExecuteCallMetaCall(Term g, Term mod) { CACHE_REGS Term ts[4]; + if (IsVarTerm(g)) + Yap_ThrowError(INSTANTIATION_ERROR, g, "meta-call"); + if (IsIntTerm(g) || (IsApplTerm(g) && IsExtensionFunctor(FunctorOfTerm(g)))) + Yap_ThrowError(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(g, mod), "meta-call"); ts[0] = g; ts[1] = cp_as_integer(B PASS_REGS); /* p_current_choice_point */ ts[2] = g; @@ -151,7 +159,8 @@ Term Yap_ExecuteCallMetaCall(Term g, Term mod) { return Yap_MkApplTerm(PredMetaCall->FunctorOfPred, 4, ts); } -Term Yap_PredicateIndicator(Term t, Term mod) { + +Term Yap_TermToIndicator(Term t, Term mod) { CACHE_REGS // generate predicate indicator in this case Term ti[2]; @@ -167,7 +176,28 @@ Term Yap_PredicateIndicator(Term t, Term mod) { ti[1] = MkIntTerm(0); } t = Yap_MkApplTerm(FunctorSlash, 2, ti); - if (mod != CurrentModule) { + if (mod != PROLOG_MODULE && mod != USER_MODULE && mod != TermProlog) { + ti[0] = mod; + ti[1] = t; + return Yap_MkApplTerm(FunctorModule, 2, ti); + } + return t; +} + +Term Yap_PredicateToIndicator(PredEntry *pe) { + CACHE_REGS + // generate predicate indicator in this case + Term ti[2]; + if (pe->ArityOfPE) { + ti[0] = MkAtomTerm(NameOfFunctor(pe->FunctorOfPred)); + ti[1] = MkIntegerTerm(ArityOfFunctor(pe->FunctorOfPred)); + } else { + ti[0] = MkAtomTerm((Atom)(pe->FunctorOfPred)); + ti[1] = MkIntTerm(0); + } + Term t = Yap_MkApplTerm(FunctorSlash, 2, ti); + Term mod = pe->ModuleOfPred; + if (mod != PROLOG_MODULE && mod != USER_MODULE && mod != TermProlog) { ti[0] = mod; ti[1] = t; return Yap_MkApplTerm(FunctorModule, 2, ti); @@ -282,7 +312,7 @@ restart: } else if (IsApplTerm(t)) { Functor fun = FunctorOfTerm(t); if (IsExtensionFunctor(fun)) { - Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), pname); + Yap_Error(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), pname); return NULL; } if (fun == FunctorModule) { @@ -1897,7 +1927,7 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) { pt = RepAppl(t) + 1; arity = ArityOfFunctor(f); } else { - Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), "call/1"); + Yap_Error(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), "call/1"); LOCAL_PrologMode &= ~TopGoalMode; return (FALSE); } diff --git a/C/flags.c b/C/flags.c index 2fa06b596..ed4a78699 100644 --- a/C/flags.c +++ b/C/flags.c @@ -1772,6 +1772,8 @@ void Yap_InitFlags(bool bootstrap) { CACHE_REGS tr_fr_ptr tr0 = TR; flag_info *f = global_flags_setup; + int lvl = push_text_stack(); + char *buf = Malloc(4098); GLOBAL_flagCount = 0; if (bootstrap) { GLOBAL_Flags = (union flagTerm *)Yap_AllocCodeSpace( @@ -1794,7 +1796,16 @@ void Yap_InitFlags(bool bootstrap) { (union flagTerm *)Yap_AllocCodeSpace(sizeof(union flagTerm) * nflags); f = local_flags_setup; while (f->name != NULL) { - bool itf = setInitialValue(bootstrap, f->def, f->init, + char *s; + if (f->init == NULL || f->init[0] == '\0') s = NULL; + else if (strlen(f->init) < 4096) { + s = buf; + strcpy(buf, f->init); + } else { + s = Malloc(strlen(f->init)+1); + strcpy(s, f->init); + } + bool itf = setInitialValue(bootstrap, f->def, s, LOCAL_Flags + LOCAL_flagCount); // Term itf = Yap_BufferToTermWithPrioBindings(f->init, // strlen(f->init)+1, @@ -1809,7 +1820,7 @@ void Yap_InitFlags(bool bootstrap) { if (GLOBAL_Stream[StdInStream].status & Readline_Stream_f) { setBooleanGlobalPrologFlag(READLINE_FLAG, true); } - + pop_text_stack(lvl); if (!bootstrap) { Yap_InitCPredBack("current_prolog_flag", 2, 1, current_prolog_flag, cont_yap_flag, 0); diff --git a/C/lu_absmi_insts.h b/C/lu_absmi_insts.h index bc67bebdf..96b25f44b 100644 --- a/C/lu_absmi_insts.h +++ b/C/lu_absmi_insts.h @@ -470,7 +470,7 @@ LogUpdClause *lcl = PREG->y_u.OtILl.d; UInt timestamp = IntegerOfTerm(((CELL *)(B_YREG+1))[ap->ArityOfPE]); - /* fprintf(stderr,"- %p/%p %d %d %p\n",PREG,ap,timestamp,ap->TimeStampOfPred,PREG->y_u.OtILl.d->ClCode);*/ + fprintf(stderr,"- %p/%p %lu/%lu %lu-%lu\n",PREG,ap,timestamp,ap->TimeStampOfPred,PREG->y_u.OtILl.d->ClTimeStart,PREG->y_u.OtILl.d->ClTimeEnd); #if defined(YAPOR) || defined(THREADS) if (PP != ap) { if (PP) UNLOCKPE(16,PP); diff --git a/C/parser.c b/C/parser.c index 85a2ddb2b..85ee7aa88 100755 --- a/C/parser.c +++ b/C/parser.c @@ -64,8 +64,6 @@ static void syntax_msg(const char *msg, ...) { if (!LOCAL_ErrorMessage) { LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE + 1); } - LOCAL_ActiveError->parserLine = LOCAL_toktide->TokLine; - LOCAL_ActiveError->parserPos = LOCAL_toktide->TokPos; va_start(ap, msg); vsnprintf(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, msg, ap); va_end(ap); diff --git a/C/scanner.c b/C/scanner.c index 2e052c8f4..eea251712 100755 --- a/C/scanner.c +++ b/C/scanner.c @@ -1592,10 +1592,12 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments, while (TRUE) { if (charp > TokImage + (sz - 1)) { + size_t sz = charp-TokImage; TokImage = Realloc(TokImage, Yap_Min(sz * 2, sz + MBYTE)); if (TokImage == NULL) { return CodeSpaceError(t, p, l); } + charp = TokImage+sz; break; } if (ch == 10 && trueGlobalPrologFlag(ISO_FLAG)) { diff --git a/C/stack.c b/C/stack.c index d393cde7e..3418c0ef1 100644 --- a/C/stack.c +++ b/C/stack.c @@ -90,7 +90,7 @@ static PredEntry *get_pred(Term t, Term tmod, char *pname) { } else if (IsApplTerm(t)) { Functor fun = FunctorOfTerm(t); if (IsExtensionFunctor(fun)) { - Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), pname); + Yap_Error(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), pname); return NULL; } if (fun == FunctorModule) { diff --git a/C/terms.c b/C/terms.c index ebce29029..92f91b17f 100644 --- a/C/terms.c +++ b/C/terms.c @@ -37,9 +37,6 @@ #include "string.h" #endif -#define Malloc malloc -#define Realloc realloc - extern int cs[10]; int cs[10]; diff --git a/C/text.c b/C/text.c index ddb1ba01d..f7effd524 100644 --- a/C/text.c +++ b/C/text.c @@ -18,6 +18,7 @@ #include "Yap.h" #include "YapEval.h" #include "YapHeap.h" +#include "YapStreams.h" #include "YapText.h" #include "Yatom.h" #include "yapio.h" @@ -191,6 +192,8 @@ void *MallocAtLevel(size_t sz, int atL USES_REGS) { void *Realloc(void *pt, size_t sz USES_REGS) { struct mblock *old = pt, *o; + if (!pt) + return Malloc(sz PASS_REGS); old--; sz = ALIGN_BY_TYPE(sz + sizeof(struct mblock), Yap_Max(CELLSIZE,sizeof(struct mblock))); o = realloc(old, sz); @@ -464,10 +467,11 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) { } } if (err0 != LOCAL_Error_TYPE) { - Yap_ThrowError(LOCAL_Error_TYPE, inp->val.t, "while reading text in"); + Yap_ThrowError(LOCAL_Error_TYPE, + inp->val.t, "while converting term %s", Yap_TermToBuffer( + inp->val.t, Handle_cyclics_f|Quote_illegal_f | Handle_vars_f)); } } - if ((inp->val.t == TermNil) && inp->type & YAP_STRING_PREFER_LIST ) { out = Malloc(4); @@ -580,6 +584,7 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) { } pop_text_stack(lvl); + return inp->val.uc; } if (inp->type & YAP_STRING_WCHARS) { @@ -591,7 +596,10 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) { } static Term write_strings(unsigned char *s0, seq_tv_t *out USES_REGS) { - size_t min = 0, max = strlen((char *)s0); + size_t min = 0, max; + + if (s0 && s0[0]) max = strlen((char *)s0); + else max = 0; if (out->type & (YAP_STRING_NCHARS | YAP_STRING_TRUNC)) { if (out->type & YAP_STRING_NCHARS) @@ -962,7 +970,6 @@ bool Yap_CVT_Text(seq_tv_t *inp, seq_tv_t *out USES_REGS) { // else if (out->type & YAP_STRING_NCHARS && // const unsigned char *ptr = skip_utf8(buf) } - if (out->type & (YAP_STRING_UPCASE | YAP_STRING_DOWNCASE)) { if (out->type & YAP_STRING_UPCASE) { if (!upcase(buf, out)) { diff --git a/C/write.c b/C/write.c index 79dca5220..b171942da 100644 --- a/C/write.c +++ b/C/write.c @@ -1115,7 +1115,6 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, /* protect slots for portray */ writeTerm(tp, priority, 1, false, &wglb, &rwt); - tp = Yap_CyclesInTerm(t PASS_REGS); if (flags & New_Line_f) { if (flags & Fullstop_f) { wrputc('.', wglb.stream); diff --git a/CXX/yapi.cpp b/CXX/yapi.cpp index 076c88054..fe3a3789c 100644 --- a/CXX/yapi.cpp +++ b/CXX/yapi.cpp @@ -82,7 +82,7 @@ restart: Functor fun = FunctorOfTerm(t); if (IsExtensionFunctor(fun)) { throw YAPError(SOURCE(), TYPE_ERROR_CALLABLE, - Yap_PredicateIndicator(t, tmod), pname); + Yap_TermToIndicator(t, tmod), pname); } if (fun == FunctorModule) { tmod = ArgOfTerm(1, t); diff --git a/H/YapGFlagInfo.h b/H/YapGFlagInfo.h index 83d8d7aa3..73cc33054 100644 --- a/H/YapGFlagInfo.h +++ b/H/YapGFlagInfo.h @@ -434,7 +434,7 @@ vxu `on` consider `$` a lower case character. */ YAP_FLAG(PROFILING_FLAG, "profiling", true, booleanFlag, "false", NULL), - /**< `prompt_alternatives_on(atom, + /**< ` pt_alternatives_on(atom, changeable) ` SWI-Compatible option, determines prompting for alternatives in the Prolog diff --git a/H/Yapproto.h b/H/Yapproto.h index 309e9eaa7..1d2a87302 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -212,7 +212,8 @@ extern void Yap_PrepGoal(UInt, CELL *, choiceptr USES_REGS); extern bool Yap_execute_pred(struct pred_entry *ppe, CELL *pt, bool pass_exception USES_REGS); extern int Yap_dogc(int extra_args, Term *tp USES_REGS); -extern Term Yap_PredicateIndicator(Term t, Term mod); +extern Term Yap_PredicateToIndicator(struct pred_entry *pe); +extern Term Yap_TermToIndicator(Term t, Term mod); extern bool Yap_Execute(Term t USES_REGS); /* exo.c */ diff --git a/H/clause.h b/H/clause.h index 1b2d55903..0889798d6 100644 --- a/H/clause.h +++ b/H/clause.h @@ -95,8 +95,9 @@ INLINE_ONLY int VALID_TIMESTAMP(UInt, struct logic_upd_clause *); INLINE_ONLY int VALID_TIMESTAMP(UInt timestamp, struct logic_upd_clause *cl) { + // printf("%lu %lu %lu\n",cl->ClTimeStart, timestamp, cl->ClTimeEnd); return IN_BETWEEN(cl->ClTimeStart, timestamp, cl->ClTimeEnd); -} + } typedef struct dynamic_clause { /* A set of flags describing info on the clause */ diff --git a/library/tries.yap b/library/tries.yap index 8153bd249..46cbb7284 100644 --- a/library/tries.yap +++ b/library/tries.yap @@ -2,7 +2,7 @@ * @file tries.yap * @author Ricardo Rocha * - * @brief + * @brief YAP tries interface * * */ @@ -63,6 +63,8 @@ @ingroup library @{ +@brief Engine Independent trie library + The next routines provide a set of utilities to create and manipulate prefix trees of Prolog terms. Tries were originally proposed to implement tabling in Logic Programming, but can be used for other @@ -76,130 +78,6 @@ for efficiency. They are available through the */ -/** @pred trie_check_entry(+ _Trie_,+ _Term_,- _Ref_) - - - -Succeeds if a variant of term _Term_ is in trie _Trie_. An handle - _Ref_ gives a reference to the term. - - -*/ -/** @pred trie_close(+ _Id_) - - - -Close trie with identifier _Id_. - - -*/ -/** @pred trie_close_all - - - -Close all available tries. - - -*/ -/** @pred trie_get_entry(+ _Ref_,- _Term_) - - -Unify _Term_ with the entry for handle _Ref_. - - -*/ -/** @pred trie_load(+ _Trie_,+ _FileName_) - - -Load trie _Trie_ from the contents of file _FileName_. - - -*/ -/** @pred trie_max_stats(- _Memory_,- _Tries_,- _Entries_,- _Nodes_) - - -Give maximal statistics on tries, including the amount of memory, - _Memory_, the number of tries, _Tries_, the number of entries, - _Entries_, and the total number of nodes, _Nodes_. - - -*/ -/** @pred trie_mode(? _Mode_) - - - -Unify _Mode_ with trie operation mode. Allowed values are either -`std` (default) or `rev`. - - -*/ -/** @pred trie_open(- _Id_) - - - -Open a new trie with identifier _Id_. - - -*/ -/** @pred trie_print(+ _Trie_) - - -Print trie _Trie_ on standard output. - - - - - */ -/** @pred trie_put_entry(+ _Trie_,+ _Term_,- _Ref_) - - - -Add term _Term_ to trie _Trie_. The handle _Ref_ gives -a reference to the term. - - -*/ -/** @pred trie_remove_entry(+ _Ref_) - - - -Remove entry for handle _Ref_. - - -*/ -/** @pred trie_remove_subtree(+ _Ref_) - - - -Remove subtree rooted at handle _Ref_. - - -*/ -/** @pred trie_save(+ _Trie_,+ _FileName_) - - -Dump trie _Trie_ into file _FileName_. - - -*/ -/** @pred trie_stats(- _Memory_,- _Tries_,- _Entries_,- _Nodes_) - - -Give generic statistics on tries, including the amount of memory, - _Memory_, the number of tries, _Tries_, the number of entries, - _Entries_, and the total number of nodes, _Nodes_. - - -*/ -/** @pred trie_usage(+ _Trie_,- _Entries_,- _Nodes_,- _VirtualNodes_) - - -Give statistics on trie _Trie_, the number of entries, - _Entries_, and the total number of nodes, _Nodes_, and the -number of _VirtualNodes_. - - -*/ :- load_foreign_files([tries], [], init_tries). diff --git a/library/tries/tries.c b/library/tries/tries.c index f0f28e2e3..698576567 100644 --- a/library/tries/tries.c +++ b/library/tries/tries.c @@ -4,8 +4,17 @@ Comments: Tries module for Yap Prolog version: $ID$ ****************************************/ +/** + @file tries.c + @brief yap-C wrapper for tries. +*/ +/** +@addtogroup tries + +@{ +*/ /* -------------------------- */ /* Includes */ @@ -164,6 +173,15 @@ static YAP_Bool p_close_all_tries(void) { /* put_trie_entry(+Mode,+Trie,+Entry,-Ref) */ +/** @pred trie_put_entry(+Mode,+ _Trie_,+ _Term_,- _Ref_) + + + +Add term _Term_ to trie _Trie_. The handle _Ref_ gives +a reference to the term. + + +*/ #define arg_mode YAP_ARG1 #define arg_trie YAP_ARG2 #define arg_entry YAP_ARG3 @@ -198,6 +216,13 @@ static YAP_Bool p_put_trie_entry(void) { /* get_trie_entry(+Mode,+Ref,-Entry) */ +/** @pred trie_get_entry(+ _Ref_,- _Term_) + + +Unify _Term_ with the entry for handle _Ref_. + + +*/ #define arg_mode YAP_ARG1 #define arg_ref YAP_ARG2 #define arg_entry YAP_ARG3 @@ -228,7 +253,6 @@ static YAP_Bool p_get_trie_entry(void) { #undef arg_ref #undef arg_entry - /* remove_trie_entry(+Ref) */ static YAP_Bool p_remove_trie_entry(void) { return p_trie_remove_entry(); @@ -263,6 +287,14 @@ static YAP_Bool p_trie_open(void) { /* trie_close(+Trie) */ +/** @pred trie_close(+ _Id_) + + + +Close trie with identifier _Id_. + + +*/ #define arg_trie YAP_ARG1 static YAP_Bool p_trie_close(void) { /* check arg */ @@ -277,6 +309,14 @@ static YAP_Bool p_trie_close(void) { /* trie_close_all() */ +/** @pred trie_close_all + + + +Close all available tries. + + +*/ static YAP_Bool p_trie_close_all(void) { trie_close_all(); return TRUE; @@ -284,6 +324,15 @@ static YAP_Bool p_trie_close_all(void) { /* trie_mode(?Mode) */ +/** @pred trie_mode(? _Mode_) + + + +Unify _Mode_ with trie operation mode. Allowed values are either +`std` (default) or `rev`. + + +*/ #define arg_mode YAP_ARG1 static YAP_Bool p_trie_mode(void) { YAP_Term mode_term; @@ -337,6 +386,15 @@ static YAP_Bool p_trie_put_entry(void) { /* trie_check_entry(+Trie,+Entry,-Ref) */ +/** @pred trie_check_entry(+ _Trie_,+ _Term_,- _Ref_) + + + +Succeeds if a variant of term _Term_ is in trie _Trie_. An handle + _Ref_ gives a reference to the term. + + +*/ #define arg_trie YAP_ARG1 #define arg_entry YAP_ARG2 #define arg_ref YAP_ARG3 @@ -458,6 +516,14 @@ static YAP_Bool p_trie_traverse_cont(void) { /* trie_remove_entry(+Ref) */ +/** @pred trie_remove_entry(+ _Ref_) + + + +Remove entry for handle _Ref_. + + +*/ #define arg_ref YAP_ARG1 static YAP_Bool p_trie_remove_entry(void) { /* check arg */ @@ -472,6 +538,14 @@ static YAP_Bool p_trie_remove_entry(void) { /* trie_remove_subtree(+Ref) */ +/** @pred trie_remove_subtree(+ _Ref_) + + + +Remove subtree rooted at handle _Ref_. + + +*/ #define arg_ref YAP_ARG1 static YAP_Bool p_trie_remove_subtree(void) { /* check arg */ @@ -564,8 +638,13 @@ static YAP_Bool p_trie_count_intersect(void) { #undef arg_trie2 #undef arg_entries +/** @pred trie_save(+ _Trie_,+ _FileName_) -/* trie_save(+Trie,+FileName) */ + +Dump trie _Trie_ into file _FileName_. + + +*/ #define arg_trie YAP_ARG1 #define arg_file YAP_ARG2 static YAP_Bool p_trie_save(void) { @@ -594,6 +673,13 @@ static YAP_Bool p_trie_save(void) { /* trie_load(-Trie,+FileName) */ +/** @pred trie_load(- _Trie_,+ _FileName_) + + +Load trie _Trie_ from the contents of file _FileName_. + + +*/ #define arg_trie YAP_ARG1 #define arg_file YAP_ARG2 static YAP_Bool p_trie_load(void) { @@ -622,6 +708,15 @@ static YAP_Bool p_trie_load(void) { #undef arg_trie #undef arg_file +/** @pred trie_stats(- _Memory_,- _Tries_,- _Entries_,- _Nodes_) + + +Give generic statistics on tries, including the amount of memory, + _Memory_, the number of tries, _Tries_, the number of entries, + _Entries_, and the total number of nodes, _Nodes_. + + +*/ /* trie_stats(-Memory,-Tries,-Entries,-Nodes) */ #define arg_memory YAP_ARG1 @@ -650,6 +745,15 @@ static YAP_Bool p_trie_stats(void) { /* trie_max_stats(-Memory,-Tries,-Entries,-Nodes) */ +/** @pred trie_max_stats(- _Memory_,- _Tries_,- _Entries_,- _Nodes_) + + +Give maximal statistics on tries, including the amount of memory, + _Memory_, the number of tries, _Tries_, the number of entries, + _Entries_, and the total number of nodes, _Nodes_. + + +*/ #define arg_memory YAP_ARG1 #define arg_tries YAP_ARG2 #define arg_entries YAP_ARG3 @@ -675,6 +779,15 @@ static YAP_Bool p_trie_max_stats(void) { #undef arg_nodes +/** @pred trie_usage(+ _Trie_,- _Entries_,- _Nodes_,- _VirtualNodes_) + + +Give statistics on trie _Trie_, the number of entries, + _Entries_, and the total number of nodes, _Nodes_, and the +number of _VirtualNodes_. + + +*/ /* trie_usage(+Trie,-Entries,-Nodes,-VirtualNodes) */ #define arg_trie YAP_ARG1 #define arg_entries YAP_ARG2 @@ -704,6 +817,15 @@ static YAP_Bool p_trie_usage(void) { /* trie_print(+Trie) */ +/** @pred trie_print(+ _Trie_) + + +Print trie _Trie_ on standard output. + + + + + */ #define arg_trie YAP_ARG1 static YAP_Bool p_trie_print(void) { /* check arg */ @@ -979,3 +1101,5 @@ int WINAPI win_tries(HANDLE hinst, DWORD reason, LPVOID reserved) return 1; } #endif + +/// @} diff --git a/os/readterm.c b/os/readterm.c index aeef31efe..11fe6548c 100644 --- a/os/readterm.c +++ b/os/readterm.c @@ -376,9 +376,9 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool Yap_MkErrorRecord(LOCAL_ActiveError, __FILE__, __FUNCTION__, __LINE__, SYNTAX_ERROR, 0, NULL); TokEntry *tok = LOCAL_tokptr; Int start_line = tok->TokLine; - Int err_line = errtok->TokLine; + Int err_line = LOCAL_toktide->TokLine; Int startpos = tok->TokPos; - Int errpos = errtok->TokPos; + Int errpos = LOCAL_toktide->TokPos; Int end_line = GetCurInpLine(GLOBAL_Stream + sno); Int endpos = GetCurInpPos(GLOBAL_Stream + sno); @@ -1144,7 +1144,8 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool LOCAL_Error_TYPE = YAP_NO_ERROR; return YAP_PARSING_FINISHED; } - Term t = syntax_error(fe->toklast, inp_stream, fe->cmod, re->cpos, fe->reading_clause, fe->msg); + + syntax_error(fe->toklast, inp_stream, fe->cmod, re->cpos, fe->reading_clause, fe->msg); if (ParserErrorStyle == TermException) { if (LOCAL_RestartEnv && !LOCAL_delay) @@ -1162,7 +1163,7 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool LOCAL_Error_TYPE = YAP_NO_ERROR; if (ParserErrorStyle == TermDec10) { - return YAP_SCANNING; + return YAP_START_PARSING; } return YAP_PARSING_FINISHED; } @@ -1201,69 +1202,74 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool */ Term Yap_read_term(int sno, Term opts, bool clause) { - FEnv fe; - REnv re; - #if EMACS int emacs_cares = FALSE; #endif - - yap_error_descriptor_t *new = malloc(sizeof *new); - bool err = Yap_pushErrorContext(true, new); int lvl = push_text_stack(); + Term rc; + yap_error_descriptor_t *new = malloc(sizeof *new); + FEnv *fe = Malloc(sizeof *fe); + REnv *re = Malloc(sizeof *re); + bool err = Yap_pushErrorContext(true, new); parser_state_t state = YAP_START_PARSING; + yhandle_t yopts = Yap_InitHandle(opts); while (true) { switch (state) { case YAP_START_PARSING: - state = initParser(opts, &fe, &re, sno, clause); + opts = Yap_GetFromHandle(yopts); + state = initParser(opts, fe, re, sno, clause); if (state == YAP_PARSING_FINISHED) { - pop_text_stack(lvl); + Yap_PopHandle(yopts); + pop_text_stack(lvl); Yap_popErrorContext(err, true); return 0; } break; case YAP_SCANNING: - state = scan(&re, &fe, sno); + state = scan(re, fe, sno); break; case YAP_SCANNING_ERROR: - state = scanError(&re, &fe, sno); + state = scanError(re, fe, sno); break; case YAP_PARSING: - state = parse(&re, &fe, sno); + state = parse(re, fe, sno); break; case YAP_PARSING_ERROR: - state = parseError(&re, &fe, sno); + state = parseError(re, fe, sno); break; case YAP_PARSING_FINISHED: { CACHE_REGS bool done; - if (fe.reading_clause) - done = complete_clause_processing(&fe, LOCAL_tokptr); + if (fe->reading_clause) + done = complete_clause_processing(fe, LOCAL_tokptr); else - done = complete_processing(&fe, LOCAL_tokptr); + done = complete_processing(fe, LOCAL_tokptr); if (!done) { state = YAP_PARSING_ERROR; - fe.t = 0; + rc = fe->t = 0; break; } #if EMACS first_char = tokstart->TokPos; #endif /* EMACS */ + rc = fe->t; pop_text_stack(lvl); Yap_popErrorContext(err, true); - return fe.t; + Yap_PopHandle(yopts); + return rc; } } } + Yap_PopHandle(yopts); Yap_popErrorContext(err, true); pop_text_stack(lvl); return 0; diff --git a/packages/ProbLog/CMakeLists.txt b/packages/ProbLog/CMakeLists.txt index 0a397543c..1a5e419fb 100644 --- a/packages/ProbLog/CMakeLists.txt +++ b/packages/ProbLog/CMakeLists.txt @@ -5,6 +5,7 @@ set (PROGRAMS dtproblog.yap aproblog.yap problog_learning.yap + problog_lbfgs.yap problog_learning_lbdd.yap ) diff --git a/packages/ProbLog/problog.yap b/packages/ProbLog/problog.yap index 199b6e752..23e527daa 100644 --- a/packages/ProbLog/problog.yap +++ b/packages/ProbLog/problog.yap @@ -521,7 +521,12 @@ every 5th iteration only. atom_concat(PD0, '../../bin', PD), set_problog_path(PD). -:- PD = '/usr/local/bin', +:- yap_flag(executable, Bin), + file_directory_name(Bin, PD), + set_problog_path(PD). + + +:- PD = '/usxor/local/bin', set_problog_path(PD). @@ -2444,7 +2449,7 @@ and the facts used in achieving this explanation. explanation probability - returns list of facts used or constant 'unprovable' as third argument problog_max(+Goal,-Prob,-Facts) -uses iterative deepening with samw parameters as bounding algorithm +uses iterative deepening with same parameters as bounding algorithm threshold gets adapted whenever better proof is found uses local dynamic predicates max_probability/1 and max_proof/1 @@ -2453,8 +2458,8 @@ uses local dynamic predicates max_probability/1 and max_proof/1 problog_max(Goal, Prob, Facts) :- problog_flag(first_threshold,InitT), init_problog_max(InitT), - problog_control(off,up), % - problog_max_id(Goal, Prob, FactIDs), %theo todo + problog_control(off,up), + problog_max_id(Goal, Prob, FactIDs),% theo todo ( FactIDs = [_|_] -> get_fact_list(FactIDs, Facts); Facts = FactIDs). diff --git a/packages/ProbLog/problog/flags.yap b/packages/ProbLog/problog/flags.yap index 9564d7515..975f4ae71 100644 --- a/packages/ProbLog/problog/flags.yap +++ b/packages/ProbLog/problog/flags.yap @@ -204,7 +204,7 @@ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% @file problog/flags.yap +%% @file problog/flags :-module(flags, [problog_define_flag/4, problog_define_flag/5, diff --git a/packages/ProbLog/problog_examples/learn_graph.pl b/packages/ProbLog/problog_examples/learn_graph.pl index 4e15cfedf..c8f391a5f 100644 --- a/packages/ProbLog/problog_examples/learn_graph.pl +++ b/packages/ProbLog/problog_examples/learn_graph.pl @@ -15,19 +15,20 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% :- use_module(library(matrix)). -:- use_module(('../problog_lbfgs')). +:- use_module(('../problog_learning')). +:- stop_low_level_trace. %%%% % background knowledge -%%%% +%%%% % definition of acyclic path using list of visited nodes 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(X,Y,A,R) :- + X\==Y, + edge(X,Z), + absent(Z,A), path(Z,Y,[Z|A],R). % using directed edges in both directions @@ -39,7 +40,7 @@ absent(_,[]). absent(X,[Y|Z]):-X \= Y, absent(X,Z). %%%% -% probabilistic facts +% 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 %%%% @@ -53,7 +54,7 @@ t(0.7)::dir_edge(5,3). t(0.2)::dir_edge(5,4). %%%%%%%%%%%%%% -% training examples of form example(ID,Query,DesiredProbability) +% training examples of form example(ID,Query,DesiredProbability) %%%%%%%%%%%%%% example(1,path(1,2),0.94). @@ -79,7 +80,7 @@ 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) +% test examples of form test_example(ID,Query,DesiredProbability) % note: ID namespace is shared with training example IDs %%%%%%%%%%%%%% @@ -99,7 +100,7 @@ test_example(33,path(5,4),0.57). test_example(34,path(6,4),0.51). test_example(35,path(6,5),0.69). -:- set_problog_flag(init_method,(Query,_,BDD, - problog_exact_lbdd(user:Query,BDD))). +%:- set_problog_flag(init_method,(Query,_,BDD, +% problog_exact(user:Query,_,BDD))). diff --git a/packages/ProbLog/problog_examples/learn_graph_lbdd.pl b/packages/ProbLog/problog_examples/learn_graph_lbdd.pl index b495c9b17..1e30c9285 100644 --- a/packages/ProbLog/problog_examples/learn_graph_lbdd.pl +++ b/packages/ProbLog/problog_examples/learn_graph_lbdd.pl @@ -14,8 +14,7 @@ % will run 20 iterations of learning with default settings %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -:- use_module(library(problog)). -:- use_module(library(problog_learning_lbdd)). +:- use_module(library(problog_learning)). %%%% % background knowledge @@ -99,3 +98,4 @@ test_example(33,path(5,4),0.57). test_example(34,path(6,4),0.51). test_example(35,path(6,5),0.69). +:- set_problog_flag(init_method,([Query,X,Y],N,Bdd,graph2bdd(X,Y,N,Bdd))). diff --git a/packages/ProbLog/problog_lbfgs.yap b/packages/ProbLog/problog_lbfgs.yap index a07140187..3dc2f541a 100644 --- a/packages/ProbLog/problog_lbfgs.yap +++ b/packages/ProbLog/problog_lbfgs.yap @@ -507,7 +507,7 @@ init_learning :- %======================================================================== %= Updates all values of query_probability/2 and query_gradient/4 %= should be called always before these predicates are accessed -%= if the old values are still valid, nothing happens +%= if the old values are still valid, nothing happensv %======================================================================== update_values :- @@ -518,8 +518,6 @@ update_values :- retractall(query_gradient_intern(_,_,_,_)). - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Check, if continuous facts are used. % if yes, switch to problog_exact @@ -573,7 +571,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) :- @@ -581,63 +579,70 @@ bdd_input_file(Filename) :- concat_path_with_filename(Dir,'input.txt',Filename). init_one_query(QueryID,Query,_Type) :- -% format_learning(3,' ~q example ~q: ~q~n',[Type,QueryID,Query]), + % format_learning(3,' ~q example ~q: ~q~n',[Type,QueryID,Query]), %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % if BDD file does not exist, call ProbLog %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - ( - recorded(QueryID, _, _) - -> - format_learning(3,' Reuse existing BDD ~q~n~n',[QueryID]) - ; b_setval(problog_required_keep_ground_ids,false), (QueryID mod 100 =:= 0 -> writeln(QueryID) ; true), - problog_flag(init_method,(Query,N,Bdd,graph2bdd(X,Y,N,Bdd))), - Query =.. [_,X,Y] - -> - Bdd = bdd(Dir, Tree, MapList), - ( - graph2bdd(X,Y,N,Bdd) - -> + Query =.. [_|Args], + % problog_flag(init_method,(Query,N,Bdd,M:graph2bdd(Args,N,Bdd))), + Bdd = bdd(Dir, Tree, + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + u3777777777/....777;;;;;;;;;;;;;;;;;;;666666666MapList), + user:graph2bdd(Args,N,Bdd), rb_new(H0), maplist_to_hash(MapList, H0, Hash), - tree_to_grad(Tree, Hash, [], Grad) + tree_to_grad(Tree, Hash, [], Grad), % ; % Bdd = bdd(-1,[],[]), % Grad=[] - ), write('.'), - recordz(QueryID,bdd(Dir, Grad, MapList),_) - ; - problog_flag(init_method,(Query,NOf,Bdd,problog_kbest_as_bdd(Call,NOf,Bdd))) -> - b_setval(problog_required_keep_ground_ids,false), - rb_new(H0), - strip_module(Call,_,Goal), - !, - Bdd = bdd(Dir, Tree, MapList), -% trace, - problog:problog_kbest_as_bdd(Goal,NOf,Bdd), - maplist_to_hash(MapList, H0, Hash), - Tree \= [], - %put_code(0'.), - tree_to_grad(Tree, Hash, [], Grad), - recordz(QueryID,bdd(Dir, Grad, MapList),_) - ; - problog_flag(init_method,(Query,NOf,Bdd,Call)) -> - b_setval(problog_required_keep_ground_ids,false), - rb_new(H0), - Bdd = bdd(Dir, Tree, MapList), -% trace, - problog:Call, - maplist_to_hash(MapList, H0, Hash), - Tree \= [], - %put_code(0'.), - tree_to_grad(Tree, Hash, [], Grad), - recordz(QueryID,bdd(Dir, Grad, MapList),_) - ). - - + recordz(QueryID,bdd(Dir, Grad, MapList),_). %======================================================================== @@ -1010,7 +1015,7 @@ user:progress(FX,X,_G,X_Norm,G_Norm,Step,_N,_Iteration,Ls,0) :- %======================================================================== init_flags :- - prolog_file_name(queries,Queries_Folder), % get absolute file name for './queries' +% prolog_file_name(queries,Queries_Folder), % get absolute file name for './queries' prolog_file_name(output,Output_Folder), % get absolute file name for './output' problog_define_flag(bdd_directory, problog_flag_validate_directory, 'directory for BDD scripts', Queries_Folder,learning_general), problog_define_flag(output_directory, problog_flag_validate_directory, 'directory for logfiles etc', Output_Folder,learning_general,flags:learning_output_dir_handler), diff --git a/packages/ProbLog/problog_learning.yap b/packages/ProbLog/problog_learning.yap index 5d60bf244..019463a57 100644 --- a/packages/ProbLog/problog_learning.yap +++ b/packages/ProbLog/problog_learning.yap @@ -220,7 +220,7 @@ :- use_module(library(system), [file_exists/1, shell/2]). % load our own modules -:- use_module(problog). +:- reexport(problog). :- use_module('problog/logger'). :- use_module('problog/flags'). :- use_module('problog/os'). @@ -363,7 +363,7 @@ reset_learning :- retractall(current_iteration(_)), retractall(example_count(_)), retractall(query_probability_intern(_,_)), - retractall(query_gradient_intern(_,_,_)), + retractall(query_gradient_intern(_,_,_,_)), retractall(last_mse(_)), retractall(query_is_similar(_,_)), retractall(query_md5(_,_,_)), @@ -392,7 +392,7 @@ do_learning(Iterations,Epsilon) :- Iterations>0, do_learning_intern(Iterations,Epsilon). do_learning(_,_) :- - format(user_error,'~n~Error: No training examples specified.~n~n',[]). + format(user_error,'~n~Error: Not raining examples specified.~n~n',[]). do_learning_intern(0,_) :- @@ -430,6 +430,7 @@ do_learning_intern(Iterations,Epsilon) :- ( retractall(last_mse(_)), logger_get_variable(mse_trainingset,Current_MSE), + writeln(Current_MSE:Last_MSE), assertz(last_mse(Current_MSE)), !, MSE_Diff is abs(Last_MSE-Current_MSE) @@ -444,7 +445,6 @@ do_learning_intern(Iterations,Epsilon) :- (problog_flag(rebuild_bdds,BDDFreq),BDDFreq>0,0 =:= CurrentIteration mod BDDFreq) -> ( - retractall(values_correct), retractall(query_is_similar(_,_)), retractall(query_md5(_,_,_)), empty_bdd_directory, @@ -627,12 +627,13 @@ init_one_query(QueryID,Query,Type) :- % check wether this BDD is similar to another BDD %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ( - problog_flag(check_duplicate_bdds,true) +listing(query_md5), + problog_flag(check_duplicate_bdds,true) -> ( - calc_md5(Filename,Query_MD5), + calc_md5(Filename,Query_MD5), ( - query_md5(OtherQueryID,Query_MD5,Type) + query_md5(OtherQueryID,Query_MD5,Type) -> ( assertz(query_is_similar(QueryID,OtherQueryID)), @@ -682,7 +683,7 @@ update_values :- problog:dynamic_probability_fact_extract(Term, Prob2), inv_sigmoid(Prob2,Value), format(Handle, '@x~q_~q~n~10f~n', [ID,GID, Value]))) - ; non_ground_fact(ID) -> + ; non_ground_fact(ID) -> inv_sigmoid(Prob,Value), format(Handle,'@x~q_*~n~10f~n',[ID,Value]) ; @@ -699,7 +700,6 @@ update_values :- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % stop write current probabilities to file %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - assertz(values_correct). @@ -710,7 +710,7 @@ update_values :- %= %======================================================================== -update_query_cleanup(QueryID) :- + listing( ( (query_is_similar(QueryID,_) ; query_is_similar(_,QueryID)) -> @@ -734,7 +734,7 @@ update_query(QueryID,Symbol,What_To_Update) :- ( problog_flag(sigmoid_slope,Slope), ((What_To_Update=all;query_is_similar(_,QueryID)) -> Method='g' ; Method='l'), - convert_filename_to_problog_path('simplecudd', Simplecudd), + convert_filename_to_problog_path('simplecudd', Simplecudd), atomic_concat([Simplecudd, ' -i "', Probabilities_File, '"', ' -l "', Query_Directory,'/query_',QueryID, '"', @@ -744,7 +744,6 @@ update_query(QueryID,Symbol,What_To_Update) :- ' > "', Output_Directory, 'values.pl"'],Command), - shell(Command,Error), %shell('cat /home/vsc/Yap/bins/devel/outputvalues.pl',_), @@ -816,7 +815,7 @@ my_load_intern(query_gradient(QueryID,XFactID,Type,Value),Handle,QueryID) :- !, atomic_concat(x,FactID,XFactID), % atom_number(StringFactID,FactID), - assertz(query_gradient_intern(QueryID,FactID,Type,Value)), + assertz(query_gradient_intern(QueryID,XFactID,Type,Value)), read(Handle,X), my_load_intern(X,Handle,QueryID). my_load_intern(X,Handle,QueryID) :- @@ -1335,7 +1334,7 @@ lineSearch(Final_X,Final_Value) :- line_search_evaluate_point(InitLeft,Value_InitLeft), -i Parameters=ls(A,B,InitLeft,InitRight,Value_A,Value_B,Value_InitLeft,Value_InitRight,1), + Parameters=ls(A,B,InitLeft,InitRight,Value_A,Value_B,Value_InitLeft,Value_InitRight,1), %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% BEGIN BACK TRACKING @@ -1487,10 +1486,12 @@ my_5_min(V1,V2,V3,V4,V5,F1,F2,F3,F4,F5,VMin,FMin) :- %======================================================================== init_flags :- + writeln(10), prolog_file_name('queries',Queries_Folder), % get absolute file name for './queries' prolog_file_name('output',Output_Folder), % get absolute file name for './output' problog_define_flag(bdd_directory, problog_flag_validate_directory, 'directory for BDD scripts', Queries_Folder,learning_general), problog_define_flag(output_directory, problog_flag_validate_directory, 'directory for logfiles etc', Output_Folder,learning_general,flags:learning_output_dir_handler), + writeln(10), problog_define_flag(log_frequency, problog_flag_validate_posint, 'log results every nth iteration', 1, learning_general), problog_define_flag(rebuild_bdds, problog_flag_validate_nonegint, 'rebuild BDDs every nth iteration', 0, learning_general), problog_define_flag(reuse_initialized_bdds,problog_flag_validate_boolean, 'Reuse BDDs from previous runs',false, learning_general), @@ -1529,3 +1530,4 @@ init_logger :- :- initialization(init_flags). :- initialization(init_logger). + diff --git a/packages/python/swig/setup.py b/packages/python/swig/setup.py index b5cd8eb28..6d7a94de5 100644 --- a/packages/python/swig/setup.py +++ b/packages/python/swig/setup.py @@ -69,7 +69,7 @@ elif platform.system() == 'Darwin': win_libs = [] local_libs = ['Py4YAP'] elif platform.system() == 'Linux': - my_extra_link_args = ['-L','..','-Wl,-rpath,'+abspath(join(sysconfig.get_path('platlib'),'yap4py')),'-Wl,-rpath,/lib','-Wl,-rpath,'+join('/lib','..'),'-Wl,-rpath,../yap4py'] + my_extra_link_args = ['-L','..','-Wl,-rpath,'+abspath(join(sysconfig.get_path('platlib'),'yap4py')),'-L','/lib','-Wl,-rpath,/lib','-Wl,-rpath,'+join('/lib','..'),'-Wl,-rpath,../yap4py'] win_libs = [] local_libs = ['Py4YAP'] diff --git a/pl/consult.yap b/pl/consult.yap index 4581a3202..b5c09eb82 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -42,6 +42,7 @@ use_module/3], ['$add_multifile'/3, '$csult'/2, + '$do_startup_reconsult'/1, '$elif'/2, '$else'/1, '$endif'/1, @@ -515,8 +516,8 @@ load_files(Files0,Opts) :- '$start_lf'(_, Mod, PlStream, TOpts, _UserFile, File, Reexport, ImportList) :- % check if there is a qly file % start_low_level_trace, - '$pred_exists'(absolute_file_name__(File,[],F),prolog), - absolute_file_name__(File,[access(read),file_type(qly),file_errors(fail),solutions(first),expand(true)],F), + '$pred_exists'('$absolute_file_name'(File,[],F),prolog), + '$absolute_file_name'(File,[access(read),file_type(qly),file_errors(fail),solutions(first),expand(true)],F), open( F, read, Stream , [type(binary)] ), ( '$q_header'( Stream, Type ), @@ -769,6 +770,7 @@ db_files(Fs) :- '$lf_opt'(imports, TOpts, Imports), '$import_to_current_module'(File, ContextModule, Imports, _, TOpts), '$current_module'(Mod, SourceModule), + %`writeln(( ContextModule/Mod )), set_prolog_flag(verbose_load, VerboseLoad), H is heapused-H0, '$cputime'(TF,_), T is TF-T0, print_message(informational, loaded(EndMsg, File, Mod, T, H)), @@ -803,7 +805,7 @@ db_files(Fs) :- '$lf_opt'('$source_pos', TOpts, Pos), '$lf_opt'('$from_stream', TOpts, false), ( QComp == auto ; QComp == large, Pos > 100*1024), - absolute_file_name__(UserF,[file_type(qly),solutions(first),expand(true)],F), + '$absolute_file_name'(UserF,[file_type(qly),solutions(first),expand(true)],F), !, '$qsave_file_'( File, UserF, F ). '$q_do_save_file'(_File, _, _TOpts ). @@ -927,6 +929,14 @@ nb_setval('$if_level',0). % % reconsult at startup... % +'$do_startup_reconsult'(_X) :- + '$init_win_graphics', + fail. +'$do_startup_reconsult'(X) :- + catch(load_files(user:X, [silent(true)]), Error, '$LoopError'(Error, consult)), + !, + ( current_prolog_flag(halt_after_consult, false) -> true ; halt). +'$do_startup_reconsult'(_). '$skip_unix_header'(Stream) :- peek_code(Stream, 0'#), !, % 35 is ASCII for '# @@ -1033,7 +1043,7 @@ prolog_load_context(stream, Stream) :- %format( 'L=~w~n', [(F0)] ), ( atom_concat(Prefix, '.qly', F0 ), - absolute_file_name__(Prefix,[access(read),file_type(prolog),file_errors(fail),solutions(first),expand(true)],F) + '$absolute_file_name'(Prefix,[access(read),file_type(prolog),file_errors(fail),solutions(first),expand(true)],F) ; F0 = F ), @@ -1140,11 +1150,11 @@ exists_source(File) :- '$full_filename'(F0, F) :- - '$undefined'(absolute_file_name__(F0,[],F),prolog_complete), + '$undefined'(absolute_file_name(F0,[],F),prolog), !, absolute_file_system_path(F0, F). '$full_filename'(F0, F) :- - absolute_file_name__(F0,[access(read), + absolute_file_name(F0,[access(read), file_type(prolog), file_errors(fail), solutions(first), @@ -1263,7 +1273,6 @@ module(Mod, Decls) :- % prevent modules within the kernel module... - /** @pred use_module(? _M_,? _F_,+ _L_) is directive SICStus compatible way of using a module @@ -1493,6 +1502,9 @@ initialization(_G,_OPT). @} */ +%% @{ + + /** @@ -1500,9 +1512,6 @@ initialization(_G,_OPT). @ingroup YAPCompilerSettings -%% @{ - - Conditional compilation builds on the same principle as term_expansion/2, goal_expansion/2 and the expansion of grammar rules to compile sections of the source-code @@ -1625,7 +1634,6 @@ no test succeeds the else branch is processed. '$elif'(_,_). /** @pred endif - End of conditional compilation. */ @@ -1678,7 +1686,7 @@ End of conditional compilation. current_prolog_flag(source, true), !. '$fetch_comp_status'(compact). -/** @pred consult_depth(-int:_LV_) +/** consult_depth(-int:_LV_) * * Unify _LV_ with the number of files being consulted. */ diff --git a/pl/corout.yap b/pl/corout.yap index 406ea8959..e62bad6cb 100644 --- a/pl/corout.yap +++ b/pl/corout.yap @@ -304,9 +304,8 @@ prolog:when(_,Goal) :- % % '$declare_when'(Cond, G) :- - generate_code_for_when(Cond, G, Code), - '$current_module'(Module), - '$$compile'(Code, Code, 5, Module), fail. + generate_code_for_when(Cond, G, Code), + '$$compile'(Code, assertz, Code, _), fail. '$declare_when'(_,_). % @@ -434,8 +433,7 @@ suspend_when_goals([_|_], _). % prolog:'$block'(Conds) :- generate_blocking_code(Conds, _, Code), - '$current_module'(Module), - '$$compile'(Code, Code, 5, Module), fail. + '$$compile'(Code, assertz, Code, _), fail. prolog:'$block'(_). generate_blocking_code(Conds, G, Code) :- @@ -515,8 +513,7 @@ generate_for_each_arg_in_block([V|L], (var(V),If), (nonvar(V);Whens)) :- prolog:'$wait'(Na/Ar) :- functor(S, Na, Ar), arg(1, S, A), - '$current_module'(M), - '$$compile'((S :- var(A), !, freeze(A, S)), (S :- var(A), !, freeze(A, S)), 5, M), fail. + '$$compile'((S :- var(A), !, freeze(A, S)), assertz, (S :- var(A), !, freeze(A, S)), _), fail. prolog:'$wait'(_). /** @pred frozen( _X_, _G_) diff --git a/pl/dbload.yap b/pl/dbload.yap index 5e3354a4d..75cd96d99 100644 --- a/pl/dbload.yap +++ b/pl/dbload.yap @@ -20,8 +20,6 @@ :- module('$db_load', []). -:- use_system_module( '$_boot', ['$$compile'/4]). - :- use_system_module( '$_errors', ['$do_error'/2]). :- use_system_module( attributes, [get_module_atts/2, diff --git a/pl/debug.yap b/pl/debug.yap index e66816119..5889ebe90 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -16,7 +16,7 @@ *************************************************************************/ -:- system_module( '$_debug', [], ['$trace_plan'/4, +:- system_module( '$_debug', [], ['$trace_query'/4, '$init_debugger'/0, '$skipeol'/1]). @@ -254,7 +254,7 @@ be lost. * * The debugger is an interpreter. with main predicates: * - $trace: this is the API - * - $trace_plan: reduce a query to a goal + * - $trace_query: reduce a query to a goal * - $trace_goal: execute: * + using the source, Luke * + hooking into the WAM procedure call mechanism @@ -308,7 +308,7 @@ be lost. '$execute_nonstop'(G,Mod). '$trace'(Mod:G) :- '$$save_by'(CP), - '$trace_plan'(G, Mod, CP, G, EG), + '$trace_query'(G, Mod, CP, G, EG), gated_call( '$debugger_io', EG, @@ -415,53 +415,42 @@ be lost. '$trace_meta_call'( G, M, CP ) :- - '$trace_plan'(G, M, CP, G, EG ), + '$trace_query'(G, M, CP, G, EG ), call(EG). -%% @pred '$trace_plan'( +G, +M, +CP, +Expanded) +%% @pred '$trace_query'( +G, +M, +CP, +Expanded) % % debug a complex query % -'$trace_plan'(V, M, _CP, _, call(M:V)) :- +'$trace_query'(V, M, _CP, _, call(M:V)) :- var(V), !. -'$trace_plan'(!, _, CP, _, '$$cut_by'(CP)) :- +'$trace_query'(!, _, CP, _, '$$cut_by'(CP)) :- !. -'$trace_plan'('$cut_by'(M), _, _, _, '$$cut_by'(M)) :- +'$trace_query'('$cut_by'(M), _, _, _, '$$cut_by'(M)) :- !. -'$trace_plan'('$$cut_by'(M), _, _, _, '$$cut_by'(M)) :- +'$trace_query'('$$cut_by'(M), _, _, _, '$$cut_by'(M)) :- !. -'$trace_plan'(true, _, _, _, true) :- !. -'$trace_plan'(fail, _, _, _, '$trace'(fail)) :- !. -'$trace_plan'((A,B), M, CP, S, (EA,EB)) :- !, - '$trace_plan'(A, M, CP, S, EA), - '$trace_plan'(B, M, CP, S, EB). -'$trace_plan'((A->B), M, CP, S, (EA->EB)) :- !, - '$trace_plan'(A, M, CP, S, EA), - '$trace_plan'(B, M, CP, S, EB). -'$trace_plan'((A;B), M, CP, S, (EA;EB)) :- !, - '$trace_plan'(A, M, CP, S, EA), - '$trace_plan'(B, M, CP, S, EB). -'$trace_plan'((A|B), M, CP, S, (EA|EB)) :- !, - '$trace_plan'(A, M, CP, S, EA), - '$trace_plan'(B, M, CP, S, EB). -'$trace_plan'((A*->B), M, CP, S, (EA->EB)) :- !, - '$trace_plan'(A, M, CP, S, EA), - '$trace_plan'(B, M, CP, S, EB). -'$trace_plan'((A*->B;C), M, CP, S, (EA->EB;EC)) :- !, - '$trace_plan'(A, M, CP, S, EA), - '$trace_plan'(B, M, CP, S, EB), - '$trace_plan'(C, M, CP, S, EC). -'$trace_plan'(if(A,B,C), M, CP, S, (EA->EB;EC)) :- !, - '$trace_plan'(A, M, CP, S, EA), - '$trace_plan'(B, M, CP, S, EB), - '$trace_plan'(C, M, CP, S, EC). -'$trace_plan'((\+ A), M, CP, S, ( EA -> fail ; true)) :- !, - '$trace_plan'(A, M, CP, S, EA). -'$trace_plan'(once(A), M, CP, S, ( EA -> true)) :- !, - '$trace_plan'(A, M, CP, S, EA). -'$trace_plan'(ignore(A), M, CP, S, ( EA -> true; true)) :- !, - '$trace_plan'(A, M, CP, S, EA). -'$trace_plan'(G, M, _CP, _, ( +'$trace_query'(true, _, _, _, true) :- !. +'$trace_query'(fail, _, _, _, '$trace'(fail)) :- !. +'$trace_query'(M:G, _, CP,S, Expanded) :- + !, + '$yap_strip_module'(M:G, M0, G0), + '$trace_query'(G0, M0, CP,S, Expanded ). +'$trace_query'((A,B), M, CP, S, (EA,EB)) :- !, + '$trace_query'(A, M, CP, S, EA), + '$trace_query'(B, M, CP, S, EB). +'$trace_query'((A->B), M, CP, S, (EA->EB)) :- !, + '$trace_query'(A, M, CP, S, EA), + '$trace_query'(B, M, CP, S, EB). +'$trace_query'((A;B), M, CP, S, (EA;EB)) :- !, + '$trace_query'(A, M, CP, S, EA), + '$trace_query'(B, M, CP, S, EB). +'$trace_query'((A|B), M, CP, S, (EA|EB)) :- !, + '$trace_query'(A, M, CP, S, EA), + '$trace_query'(B, M, CP, S, EB). +'$trace_query'((\+ A), M, CP, S, (\+ EA)) :- !, + '$trace_query'(A, M, CP, S, EA). +'$trace_query'(G, M, _CP, _, ( % spy a literal '$id_goal'(L), catch( @@ -472,7 +461,7 @@ be lost. %% @pred $trace_goal( +Goal, +Module, +CallId, +CallInfo) %% -%% Actually debugs a +%% Actuallb sy debugs a %% goal! '$trace_goal'(G, M, GoalNumber, _H) :- ( @@ -488,7 +477,7 @@ be lost. '$trace_goal'(G, M, GoalNumber, H) :- '$undefined'(G, M), !, - '$get_undefined_pred'(M:G, NM:Goal), + '$get_predicate_definition'(M:G, NM:Goal), ( ( M == NM ; NM == prolog), G == Goal -> yap_flag( unknown, Action ), @@ -498,9 +487,9 @@ be lost. ). % meta system '$trace_goal'(G, M, GoalNumber, H) :- - '$is_metapredicate'(G, prolog), - !, - '$debugger_expand_meta_call'(M:G, [], G1), + '$is_metapredicate'(G, prolog), + !, + '$debugger_expand_meta_call'(M:G, [], G1), strip_module(G1, MF, NG), gated_call( '$enter_trace'(GoalNumber, G, M, H), @@ -615,7 +604,7 @@ be lost. '$$save_by'(CP), clause(M:G, Cl, _), '$retry_clause'(GoalNumber, G, M, Info, X), - '$trace_plan'(Cl, M, CP, Cl, ECl), + '$trace_query'(Cl, M, CP, Cl, ECl), '$execute0'(ECl,M). '$creep_step'(GoalNumber, G, M, Info) :- @@ -665,7 +654,7 @@ be lost. %%% - abort: forward throw while the call is newer than goal -%% @pred '$re_trace_plan'( Exception, +Goal, +Mod, +GoalID ) +%% @pred '$re_trace_query'( Exception, +Goal, +Mod, +GoalID ) % % debugger code for exceptions. Recognised cases are: % - abort always forwarded @@ -1057,10 +1046,10 @@ be lost. '$cps'([]). -'$debugger_skip_trace_plan'([CP|CPs],CPs1) :- - yap_hacks:choicepoint(CP,_,prolog,'$trace_plan',4,(_;_),_), !, - '$debugger_skip_trace_plan'(CPs,CPs1). -'$debugger_skip_trace_plan'(CPs,CPs). +'$debugger_skip_trace_query'([CP|CPs],CPs1) :- + yap_hacks:choicepoint(CP,_,prolog,'$trace_query',4,(_;_),_), !, + '$debugger_skip_trace_query'(CPs,CPs1). +'$debugger_skip_trace_query'(CPs,CPs). '$debugger_skip_traces'([CP|CPs],CPs1) :- yap_hacks:choicepoint(CP,_,prolog,'$port',4,(_;_),_), !, diff --git a/pl/imports.yap b/pl/imports.yap index 9dc3433d3..31856c77a 100644 --- a/pl/imports.yap +++ b/pl/imports.yap @@ -33,50 +33,75 @@ fail. %:- start_low_level_trace. % parent module mechanism -'$get_undefined_predicates'(ImportingMod:G,ExportingMod:G0) :- - recorded('$import','$import'(ExportingMod,ImportingMod,G,G0,_,_),_) - -> - true - ; - %% this should have been caught before - '$is_system_predicate'(G, ImportingMod) - -> - true - ; -% autoload - current_prolog_flag(autoload, true) --> - '$autoload'(G, ImportingMod, ExportingMod, swi) -; - '$parent_module'(ImportingMod, NewImportingMod) - -> - '$get_undefined_predicates'(NewImportingMod:G, ExportingMod:G0). +%% system has priority +'$get_predicate_definition'(_ImportingMod:G,prolog:G) :- + '$pred_exists'(G,prolog). +%% I am there, no need to import +'$get_predicate_definition'(Mod:Pred,Mod:Pred) :- + '$pred_exists'(Pred, Mod). +%% 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) :- + ( '$parent_module'(ImportingMod, PMod) ), %; PMod = user), + ('$pred_exists'(PMod,G0), PMod:G0 = ExportingMod:G; + recorded('$import','$import'(ExportingMod,PMod,G0,G,_,_),_) + ). +%% autoload` +'$get_predicate_definition'(ImportingMod:G,ExportingMod:G) :- + current_prolog_flag(autoload, true), + '$autoload'(G, ImportingMod, ExportingMod, swi). -'$continue_imported'(Mod:Pred,Mod,Pred) :- - '$pred_exists'(Pred, Mod), + +'$predicate_definition'(Imp:Pred,Exp:NPred) :- + '$predicate_definition'(Imp:Pred,[],Exp:NPred), +%writeln((Imp:Pred -> Exp:NPred )). !. -'$continue_imported'(FM:FPred,Mod:Pred) :- - '$get_undefined_predicates'(FM:FPred, ModI:PredI), - '$continue_imported'(ModI:PredI,Mod:Pred). + +'$one_predicate_definition'(Imp:Pred,Exp:NPred) :- + '$predicate_definition'(Imp:Pred,[],Exp:NPred), +%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) + ; + Mod = ModF, Pred = PredF + ). % -'$get_undefined_pred'(ImportingMod:G, ExportingMod:G0) :- - must_be_callable( ImportingMod:G ), - '$get_undefined_predicates'(ImportingMod:G, ExportingMod:G0). +'$get_undefined_predicate'(ImportingMod:G, ExportingMod:G0) :- + is_callable( ImportingMod:G ), + '$predicate_definition'(ImportingMod:G,[], ExportingMod:G0), + ImportingMod:G \= ExportingMod:G0, + !. % be careful here not to generate an undefined exception. '$imported_predicate'(ImportingMod:G, ExportingMod:G0) :- - var(G) -> - '$current_predicate'(_,G,ImportingMod,_), - '$imported_predicate'(ImportingMod:G, ExportingMod:G0) - ; - var(ImportingMod) -> - current_module(ImportingMod), - '$imported_predicate'(ImportingMod:G, ExportingMod:G0) - ; - '$undefined'(G, ImportingMod), - '$get_undefined_predicates'(ImportingMod:G, ExportingMod:G0), - ExportingMod \= ImportingMod. + ( var(ImportingMod) -> + current_module(ImportingMod) + ; + true + ), + ( + var(G) -> + '$current_predicate'(_,G,ImportingMod,_) + ; + true + ), + ( + '$undefined'(G, ImportingMod) + -> + '$predicate_definition'(ImportingMod:G, ExportingMod:G0), + ExportingMod \= ImportingMod + ; + ExportingMod = ImportingMod, G = G0 + ). % check if current module redefines an imported predicate. @@ -92,16 +117,6 @@ fail. '$not_imported'(_, _). -'$verify_import'(_M:G, prolog:G) :- - '$is_system_predicate'(G, prolog). -'$verify_import'(M:G, NM:NG) :- - '$get_undefined_predicates'(M:G, M, NM:NG), - !. -'$verify_import'(MG, MG). - - - - '$autoload'(G, _mportingMod, ExportingMod, Dialect) :- functor(G, Name, Arity), '$pred_exists'(index(Name,Arity,ExportingMod,_),Dialect), diff --git a/pl/meta.yap b/pl/meta.yap index 93b4a5e12..fc6e91444 100644 --- a/pl/meta.yap +++ b/pl/meta.yap @@ -201,7 +201,7 @@ meta_predicate(P) :- '$yap_strip_module'(CM:G, NCM, NG). '$match_mod'(G, _HMod, _SMod, M, O) :- - '$is_system_predicate'(G,M), + M = prolog, !, O = G. '$match_mod'(G, M, M, M, G) :- !. @@ -463,8 +463,9 @@ meta_predicate(P) :- % A4: module for body of clause (this is the one used in looking up predicates) % % has to be last!!! -'$expand_a_clause'(MHB, SM0, Cl1, ClO) :- % MHB is the original clause, SM0 the current source, Cl1 and ClO output clauses - '$yap_strip_module'(SM0:MHB, SM, HB), % remove layers of modules over the clause. SM is the source module. +'$expand_a_clause'(MHB, Cl1, ClO) :- % MHB is the original clause, SM0 the current source, Cl1 and ClO output clauses + source_module(SM0), + '$yap_strip_module'(MHB, SM, HB), % remove layers of modules over the clause. SM is the head module. '$head_and_body'(HB, H, B), % HB is H :- B. '$yap_strip_module'(SM:H, HM, NH), % further module expansion '$not_imported'(NH, HM), diff --git a/pl/modules.yap b/pl/modules.yap index 87fb38cbd..2f4a4166a 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -41,7 +41,6 @@ '$convert_for_export'/7, '$do_import'/3, '$extend_exports'/3, - '$get_undefined_pred'/4, '$imported_predicate'/2, '$meta_expand'/6, '$meta_predicate'/2, @@ -85,6 +84,8 @@ /** @pred use_module( +Files ) is directive + + @brief load a module file This predicate loads the file specified by _Files_, importing all @@ -311,16 +312,6 @@ use_module(F,Is) :- '$not_imported'(_, _). -'$verify_import'(_M:G, prolog:G) :- - '$is_system_predicate'(G, prolog). -'$verify_import'(M:G, NM:NG) :- - '$get_undefined_pred'(G, M, NG, NM), - !. -'$verify_import'(MG, MG). - - - - /** @pred current_module( ? Mod:atom) is nondet @@ -453,38 +444,35 @@ export_list(Module, List) :- '$add_to_imports'(Tab, Module, ContextModule). %'$do_import'(K, _, _) :- writeln(K), fail. -'$do_import'(op(Prio,Assoc,Name), _Mod, ContextMod) :- - op(Prio,Assoc,ContextMod:Name). +'$do_import'(op(Prio,Assoc,Name), Mod, ContextMod) :- + op(Prio,Assoc,Mod:Name), + op(Prio,Assoc,ContextMod:Name), +!. '$do_import'(N0/K0-N0/K0, Mod, Mod) :- !. '$do_import'(N0/K0-N0/K0, _Mod, prolog) :- !. -'$do_import'(_N/K-N1/K, _Mod, ContextMod) :- - recorded('$module','$module'(_F, ContextMod, _SourceF, MyExports,_),_), - once(lists:member(N1/K, MyExports)), - functor(S, N1, K), - % reexport predicates if they are undefined in the current module. - \+ '$undefined'(S,ContextMod), !. -'$do_import'( N/K-N1/K, Mod, ContextMod) :- - functor(G,N,K), - '$follow_import_chain'(Mod,G,M0,G0), - G0=..[_N0|Args], - G1=..[N1|Args], - ( '$check_import'(M0,ContextMod,N1,K) -> - ( ContextMod == prolog -> - recordzifnot('$import','$import'(M0,user,G0,G1,N1,K),_), - \+ '$is_system_predicate'(G1, prolog), - '$compile'((G1:-M0:G0), reconsult,(user:G1:-M0:G0) , user, R), - fail - ; - recordaifnot('$import','$import'(M0,ContextMod,G0,G1,N1,K),_), - \+ '$is_system_predicate'(G1, prolog), - '$compile'((G1:-M0:G0), reconsult,(ContextMod:G1:-M0:G0) , ContextMod, R), - fail - ; - true - ) +% '$do_import'(_N/K-N1/K, _Mod, ContextMod) :- +% recorded('$module','$module'(_F, ContextMod, _SourceF, MyExports,_),_), +% once(lists:member(N1/K, MyExports)), +% functor(S, N1, K), +% % reexport predicates if they are undefined in the current module. +% \+ '$undefined'(S,ContextMod), !. +'$do_import'( N0/K-N1/K, M0, ContextMod) :- + %'$one_predicate_definition'(Mod:G,M0:G0), +% M0\=prolog, + (M0==ContextMod->N0\=N1;true), + functor(G1,N1,K), + (N0 == N1 + -> + G0=G1 ; - true - ). + G1=..[N1|Args], + G0=..[N0|Args] + ), + %writeln((ContextMod:G1:-M0:G0)), + recordaifnot('$import','$import'(M0,ContextMod,G0,G1,N1,K),_), + !. +'$do_import'( _,_,_ ). + '$follow_import_chain'(M,G,M0,G0) :- recorded('$import','$import'(M1,M,G1,G,_,_),_), M \= M1, !, @@ -496,7 +484,7 @@ export_list(Module, List) :- recorded('$import','$import'(MI, ContextM, _, _, N,K),_R), % dereference MI to M1, in order to find who % is actually generating - ( '$module_produced by'(M1, MI, N, K) -> true ; MI = M1 ), + ( '$module_produced by'(M1, MI, N, K) -> true ; MI = M1 ), ( '$module_produced by'(M2, Mod, N, K) -> true ; Mod = M2 ), M2 \= M1, !, '$redefine_import'( M1, M2, Mod, ContextM, N/K). @@ -743,4 +731,5 @@ module_state :- fail. module_state. -%% @} +%% @}imports + diff --git a/pl/preddyns.yap b/pl/preddyns.yap index ab4aee3f0..3a0292d46 100644 --- a/pl/preddyns.yap +++ b/pl/preddyns.yap @@ -50,7 +50,6 @@ assert(Clause) :- '$assert'(Clause, assertz, _). '$assert'(Clause, Where, R) :- - '$yap_strip_clause'(Clause, _, _Clause0), '$expand_clause'(Clause,C0,C), '$$compile'(C, Where, C0, R). diff --git a/pl/preds.yap b/pl/preds.yap index 379230edd..dae99f594 100644 --- a/pl/preds.yap +++ b/pl/preds.yap @@ -388,22 +388,9 @@ or built-in. */ predicate_property(Pred,Prop) :- - ( - current_predicate(_,Pred), - '$yap_strip_module'(Pred, Mod, TruePred) - ; - '$current_predicate'(_,M,Pred,system), - '$yap_strip_module'(M:Pred, Mod, TruePred) - ), - - ( - '$pred_exists'(TruePred, Mod) - -> - M = Mod, - NPred = TruePred - ; - '$get_undefined_pred'(Mod:TruePred, M:NPred) - ), + '$yap_strip_module'(Pred, Mod, TruePred), + (var(Mod) -> current_module(Mod) ; true ), + '$predicate_definition'(Mod:TruePred, M:NPred), '$predicate_property'(NPred,M,Mod,Prop). '$predicate_property'(P,M,_,built_in) :- @@ -486,27 +473,26 @@ predicate_erased_statistics(P0,NCls,Sz,ISz) :- Defines the relation: _P_ is a currently defined predicate whose name is the atom _A_. */ -current_predicate(A,T0) :- - '$yap_strip_module'(T0, M, T), - ( var(M) - -> - '$all_current_modules'(M) - ; - true - ), - (nonvar(T) -> functor(T, A, _) ; true ), +current_predicate(A0,T0) :- + + ( nonvar(T0) -> '$yap_strip_module'(T0, M, T) ; T0 = T ), + ( nonvar(A0) -> '$yap_strip_module'(A0, MA0, A) ; A0 = A ), + M = MA0, ( - '$current_predicate'(A,M, T, user) - ; - (nonvar(T) + var(M) -> - '$imported_predicate'(M:T, M1:T1) + true ; - '$imported_predicate'(M:T, M1:T1) + '$all_current_modules'(M) ), - functor(T1, A, _), - \+ '$is_system_predicate'(T1,M1) - ). + % M is bound + ( + '$current_predicate'(A,M,T,user) + ; + '$imported_predicate'(M:T, M1T1), M1T1 \= M:T + ), + functor(T, A, _). + /** @pred system_predicate( ?_P_ ) diff --git a/pl/top.yap b/pl/top.yap index a318890c5..157730be2 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -223,17 +223,17 @@ live :- throw(error(system, compilation_failed(G))). '$$compile'(C, Where, C0, R) :- - '$head_and_body'( C, MH, B ), - strip_module( MH, Mod, H), + '$head_and_body'( C, H, B ), + '$yap_strip_module'(H,Mod,H0), ( - '$undefined'(H, Mod) + '$undefined'(H0, Mod) -> - '$init_pred'(H, Mod, Where) + '$init_pred'(H0, Mod, Where) ; true ), % writeln(Mod:((H:-B))), - '$compile'((H:-B), Where, C0, Mod, R). + '$compile'((H0:-B), Where, C0, Mod, R). '$init_pred'(H, Mod, _Where ) :- recorded('$import','$import'(NM,Mod,NH,H,_,_),RI), @@ -875,8 +875,7 @@ gated_call(Setup, Goal, Catcher, Cleanup) :- '$precompile_term'(Term, Term, Term). '$expand_clause'(InputCl, C1, CO) :- - '$yap_strip_clause'(InputCl, M, ICl), - '$expand_a_clause'( M:ICl, M, C1, CO), + '$expand_a_clause'( InputCl, C1, CO), !. '$expand_clause'(Cl, Cl, Cl). diff --git a/pl/undefined.yap b/pl/undefined.yap index 980259645..b93b9dd77 100644 --- a/pl/undefined.yap +++ b/pl/undefined.yap @@ -91,33 +91,22 @@ undefined_query(G0, M0, Cut) :- user:unknown_predicate_handler(GM0,EM0,MG), !. '$undefp_search'(M0:G0, MG) :- - '$get_undefined_predicates'(M0:G0, MG), !. + '$predicate_definition'(M0:G0, MG), !. % undef handler -'$undefp'([M0|G0],MG) :- +'$undefp'([M0|G0],true) :- % make sure we do not loop on undefined predicates setup_call_cleanup( - '$undef_setup'(M0:G0, Action,Debug,Current, MGI), - ignore('$get_undefined_predicates'( MGI, MG )), + '$undef_setup'(Action,Debug,Current), + '$get_undefined_predicate'( M0:G0, MG ), '$undef_cleanup'(Action,Debug,Current) ), - '$undef_error'(Action, M0:G0, MGI, MG). + '$undef_error'(Action, M0:G0, MG). -'$undef_setup'(G0,Action,Debug,Current,GI) :- +'$undef_setup'(Action,Debug,Current) :- yap_flag( unknown, Action, fail), yap_flag( debug, Debug, false), - '$stop_creeping'(Current), - '$g2i'(G0,GI). - -'$g2i'(user:G, Na/Ar ) :- - !, - functor(G, Na, Ar). -'$g2i'(prolog:G, Na/Ar ) :- - !, - functor(G, Na, Ar). -'$g2i'(M:G, M:Na/Ar ) :- - !, - functor(G, Na, Ar). + '$stop_creeping'(Current). '$undef_cleanup'(Action,Debug, _Current) :- yap_flag( unknown, _, Action), @@ -137,26 +126,26 @@ The unknown predicate, informs about what the user wants to be done */ -'$undef_error'(_, _, _, M:G) :- +'$undef_error'(_, _, M:G) :- nonvar(M), nonvar(G), !, - '$start_creep'([prolog|true], creep). -'$undef_error'(_, M0:G0, _, MG) :- + '$start_creep'([M|G], creep). +'$undef_error'(_, M0:G0, M:G) :- '$pred_exists'(unknown_predicate_handler(_,_,_,_), user), '$yap_strip_module'(M0:G0, EM0, GM0), - user:unknown_predicate_handler(GM0,EM0,MG), + user:unknown_predicate_handler(GM0,EM0,M:G), !, - '$start_creep'([prolog|true], creep). -'$undef_error'(error, Mod:Goal, I,_) :- - '$do_error'(existence_error(procedure,I), Mod:Goal). -'$undef_error'(warning,Mod:Goal,I,_) :- - 'program_continuation'(PMod,PName,PAr), - print_message(warning,error(existence_error(procedure,I), context(Mod:Goal,PMod:PName/PAr))), - '$start_creep'([fail|true], creep), + '$start_creep'([M|G], creep). +'$undef_error'(error, Mod:Goal,_) :- + '$do_error'(existence_error(procedure,Mod:Goal), Mod:Goal). +'$undef_error'(warning,Mod:Goal,_) :- + '$program_continuation'(PMod,PName,PAr), + print_message(warning,error(existence_error(procedure,Mod:Goal), context(Mod:Goal,PMod:PName/PAr))), + %'$start_creep'([prolog|fail], creep), fail. '$undef_error'(fail,_Goal,_,_Mod) :- - '$start_creep'([fail|true], creep), + % '$start_creep'([prolog|fail], creep), fail. unknown(P, NP) :-