diff --git a/C/alloc.c b/C/alloc.c index e9d5789d4..33093f018 100644 --- a/C/alloc.c +++ b/C/alloc.c @@ -378,16 +378,6 @@ ADDR Yap_ExpandPreAllocCodeSpace(UInt sz0, void *cip, int safe) { struct various_codes *Yap_heap_regs; -static void InitHeap(void) { - Yap_heap_regs = - (struct various_codes *)calloc(1, sizeof(struct various_codes)); -} - -void Yap_InitHeap(void *heap_addr) { - InitHeap(); - Yap_HoleSize = 0; - HeapMax = 0; -} // get an approximation to total memory data-base size. size_t Yap_HeapUsed(void) @@ -400,9 +390,9 @@ void Yap_InitHeap(void *heap_addr) { #endif } -static void InitExStacks(int wid, int Trail, int Stack) { +static void InitExStacks(int wid, size_t Trail, size_t Stack) { CACHE_REGS - UInt pm, sa; + size_t pm, sa; /* sanity checking for data areas */ if (Trail < MinTrailSpace) @@ -428,7 +418,7 @@ static void InitExStacks(int wid, int Trail, int Stack) { #if DEBUG if (Yap_output_msg) { - UInt ta; + size_t ta; fprintf(stderr, "HeapBase = %p GlobalBase = %p\n LocalBase = %p TrailTop = %p\n", @@ -443,7 +433,7 @@ static void InitExStacks(int wid, int Trail, int Stack) { #endif /* DEBUG */ } -void Yap_InitExStacks(int wid, int Trail, int Stack) { +void Yap_InitExStacks(int wid, size_t Trail, size_t Stack) { InitExStacks(wid, Trail, Stack); } @@ -464,7 +454,12 @@ void Yap_KillStacks(int wid) { } #endif -void Yap_InitMemory(UInt Trail, UInt Heap, UInt Stack) { InitHeap(); } +void Yap_InitMemory(size_t Trail, size_t Heap, size_t Stack) { + Yap_HoleSize = 0; + HeapMax = 0; + Yap_heap_regs = + (struct various_codes *)calloc(1, sizeof(struct various_codes)); + } int Yap_ExtendWorkSpace(Int s) { CACHE_REGS diff --git a/C/c_interface.c b/C/c_interface.c index cafa94147..b757f8b93 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -101,7 +101,7 @@ X_API int YAP_Reset(yap_reset_t mode, bool reset_global); #define X_API __declspec(dllexport) #endif -#define BootFilePath NULL +#define SOURCEBOOTPath NULL #if __ANDROID__ #define BOOT_FROM_SAVED_STATE true #endif @@ -1799,7 +1799,7 @@ X_API bool YAP_RetryGoal(YAP_dogoalinfo *dgi) { /* make sure we didn't leave live slots when we backtrack */ ASP = (CELL *)B; LOCAL_CurSlot = dgi->EndSlot; - out = run_emulator(PASS_REGS1); + out = Yap_exec_absmi(true, true ); if (out) { dgi->EndSlot = LOCAL_CurSlot; dgi->b = LCL0 - (CELL *)B; @@ -2114,7 +2114,7 @@ X_API int YAP_InitConsult(int mode, const char *fname, char **full, mode = YAP_CONSULT_MODE; } if (fname == NULL || fname[0] == '\0') { - fl = Yap_BOOTFILE; + fl = Yap_SOURCEBOOT; } if (!fname || !(fl = Yap_AbsoluteFile(fname, true)) || !fl[0]) { __android_log_print( @@ -2249,7 +2249,7 @@ X_API char *YAP_WriteBuffer(Term t, char *buf, size_t sze, int flags) { inp.val.t = t; inp.type = YAP_STRING_TERM | YAP_STRING_DATUM; out.type = YAP_STRING_CHARS; - out.val.c = buf; + out.val.c = NULL; out.max = sze - 1; out.enc = LOCAL_encoding; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) { @@ -2261,7 +2261,11 @@ X_API char *YAP_WriteBuffer(Term t, char *buf, size_t sze, int flags) { if (buf == out.val.c) { return buf; } else { - return pop_output_text_stack(l, out.val.c); + if ( strlen(out.val.c ) < sze) { + strcpy( buf, out.val.c); + pop_text_stack(l); + return buf; + } } } } diff --git a/C/cdmgr.c b/C/cdmgr.c index 3304483a8..f9f7cdcef 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -2536,7 +2536,7 @@ static Int // pe = Yap_get_pred(t1, Deref(ARG2), "system_predicate"); // if (!pe) pe = Yap_get_pred(t1, Deref(ARG2), "system_predicate"); - // if (!pe) pe = Yap_get_pred(t1, USER_MODULE, "system_predicate"); + // if (!pe) pe = Yap_get_pred(t1, Deref(ARG2), "system_predicate"); if (EndOfPAEntr(pe)) return FALSE; return (pe->ModuleOfPred == 0); diff --git a/C/exec.c b/C/exec.c index 0638134e3..fa757cc39 100755 --- a/C/exec.c +++ b/C/exec.c @@ -2174,7 +2174,7 @@ void Yap_InitYaamRegs(int myworker_id, bool full_reset) { #endif STATIC_PREDICATES_MARKED = FALSE; if (full_reset) { - HR = H0 + 1; + HB = HR = H0 + 1; h0var = MkVarTerm(); REMOTE_GcGeneration(myworker_id) = Yap_NewTimedVar(h0var); REMOTE_GcCurrentPhase(myworker_id) = 0L; @@ -2185,7 +2185,8 @@ void Yap_InitYaamRegs(int myworker_id, bool full_reset) { h0var = MkVarTerm(); REMOTE_AttsMutableList(myworker_id) = Yap_NewTimedVar(h0var); #endif - Yap_AllocateDefaultArena(128 * 1024, 2, myworker_id); + size_t defsz = 128*1024; + Yap_AllocateDefaultArena(defsz, myworker_id); } else { HR = Yap_ArenaLimit(REMOTE_GlobalArena(myworker_id)); } diff --git a/C/globals.c b/C/globals.c index 1e77bf2d1..5f5ec6963 100644 --- a/C/globals.c +++ b/C/globals.c @@ -145,13 +145,13 @@ threads that are created after the registration. #define Global_MkIntegerTerm(I) MkIntegerTerm(I) -static UInt big2arena_sz(CELL *arena_base) { +static size_t big2arena_sz(CELL *arena_base) { return (((MP_INT *)(arena_base + 2))->_mp_alloc * sizeof(mp_limb_t) + sizeof(MP_INT) + sizeof(Functor) + 2 * sizeof(CELL)) / sizeof(CELL); } -static UInt arena2big_sz(UInt sz) { +static size_t arena2big_sz(size_t sz) { return sz - (sizeof(MP_INT) + sizeof(Functor) + 2 * sizeof(CELL)) / sizeof(CELL); } @@ -159,7 +159,7 @@ static UInt arena2big_sz(UInt sz) { /* pointer to top of an arena */ static inline CELL *ArenaLimit(Term arena) { CELL *arena_base = RepAppl(arena); - UInt sz = big2arena_sz(arena_base); + size_t sz = big2arena_sz(arena_base); return arena_base + sz; } @@ -171,9 +171,9 @@ CELL *Yap_ArenaLimit(Term arena) { /* pointer to top of an arena */ static inline CELL *ArenaPt(Term arena) { return (CELL *)RepAppl(arena); } -static inline UInt ArenaSz(Term arena) { return big2arena_sz(RepAppl(arena)); } +static inline size_t ArenaSz(Term arena) { return big2arena_sz(RepAppl(arena)); } -static Term CreateNewArena(CELL *ptr, UInt size) { +static Term CreateNewArena(CELL *ptr, size_t size) { Term t = AbsAppl(ptr); MP_INT *dst; @@ -186,9 +186,9 @@ static Term CreateNewArena(CELL *ptr, UInt size) { return t; } -static Term NewArena(UInt size, int wid, UInt arity, CELL *where) { +static Term NewArena(size_t size, int wid, UInt arity, CELL *where) { Term t; - UInt new_size; + size_t new_size; WORKER_REGS(wid) if (where == NULL || where == HR) { @@ -228,11 +228,11 @@ static Int p_default_arena_size(USES_REGS1) { return Yap_unify(ARG1, MkIntegerTerm(ArenaSz(LOCAL_GlobalArena))); } -void Yap_AllocateDefaultArena(Int gsize, Int attsize, int wid) { +void Yap_AllocateDefaultArena(size_t gsize, int wid) { REMOTE_GlobalArena(wid) = NewArena(gsize, wid, 2, NULL); } -static void adjust_cps(UInt size USES_REGS) { +static void adjust_cps(size_t size USES_REGS) { /* adjust possible back pointers in choice-point stack */ choiceptr b_ptr = B; while (b_ptr->cp_h == HR) { @@ -290,14 +290,14 @@ static int GrowArena(Term arena, CELL *pt, size_t old_size, size_t size, return TRUE; } -CELL *Yap_GetFromArena(Term *arenap, UInt cells, UInt arity) { +CELL *Yap_GetFromArena(Term *arenap, size_t cells, UInt arity) { CACHE_REGS restart : { Term arena = *arenap; CELL *max = ArenaLimit(arena); CELL *base = ArenaPt(arena); CELL *newH; - UInt old_sz = ArenaSz(arena), new_size; + size_t old_sz = ArenaSz(arena), new_size; if (IN_BETWEEN(base, HR, max)) { base = HR; @@ -319,8 +319,8 @@ restart : { } static void CloseArena(CELL *oldH, CELL *oldHB, CELL *oldASP, Term *oldArenaP, - UInt old_size USES_REGS) { - UInt new_size; + size_t old_size USES_REGS) { + size_t new_size; if (HR == oldH) return; @@ -357,7 +357,7 @@ static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { SP = S0+used; SF = S0+sz; } static int copy_complex_term(register CELL *pt0, register CELL *pt0_end, - int share, int copy_att_vars, CELL *ptf, + bool share, bool copy_att_vars, CELL *ptf, CELL *HLow USES_REGS) { int lvl = push_text_stack(); @@ -480,7 +480,7 @@ loop: break; default: { /* big int */ - UInt sz = (sizeof(MP_INT) + 3 * CellSize + + size_t sz = (sizeof(MP_INT) + 3 * CellSize + ((MP_INT *)(ap2 + 2))->_mp_alloc * sizeof(mp_limb_t)) / CellSize, i; diff --git a/C/init.c b/C/init.c index 7fbc7d7db..403ac8372 100755 --- a/C/init.c +++ b/C/init.c @@ -1321,8 +1321,8 @@ const char *Yap_version(void) { } void Yap_InitWorkspace(struct yap_boot_params *yapi, - UInt Heap, UInt Stack, UInt Trail, UInt Atts, - UInt max_table_size, int n_workers, int sch_loop, + UInt Heap, size_t Stack, size_t Trail, size_t Atts, + size_t max_table_size, int n_workers, int sch_loop, int delay_load) { CACHE_REGS @@ -1364,11 +1364,7 @@ void Yap_InitWorkspace(struct yap_boot_params *yapi, Stack = MinStackSpace; Stack = AdjustPageSize(Stack * K); Stack /= (K); - if (!Atts) - Atts = 2048 * sizeof(CELL); - else - Atts = AdjustPageSize(Atts * K); - Atts /= (K); + Atts = 0; #if defined(THREADS) || defined(YAPOR) worker_id = 0; #endif /* YAPOR || THREADS */ diff --git a/C/load_foreign.c b/C/load_foreign.c index ed18c3a4a..bb3904a3f 100644 --- a/C/load_foreign.c +++ b/C/load_foreign.c @@ -45,9 +45,6 @@ Int p_load_foreign(USES_REGS1) { StringList new; bool returncode = FALSE; yhandle_t CurSlot = Yap_StartSlots(); -#if __ANDROID__ -return true; -#endif // Yap_DebugPlWrite(ARG1); printf("%s\n", " \n"); // Yap_DebugPlWrite(ARG2); printf("%s\n", " \n"); @@ -246,7 +243,28 @@ static Int p_open_shared_objects(USES_REGS1) { #endif } +static Int check_embedded(USES_REGS1) +{ + const char *s = Yap_TextTermToText(Deref(ARG1)); + if (!s) + return false; +#if EMBEDDED_MYDDAS + if (!strcmp("init_myddas",s)) { + init_myddas(); +return true; + } +#endif +#if EMBEDDED_SQLITE3 + if (!strcmp("init_sqlite3",s)) { + init_sqlite3(); +return true; + } +#endif +return false; +} + void Yap_InitLoadForeign(void) { + Yap_InitCPred("$check_embedded", 1, check_embedded, SafePredFlag); Yap_InitCPred("$load_foreign_files", 3, p_load_foreign, SafePredFlag | SyncPredFlag); Yap_InitCPred("$open_shared_objects", 0, p_open_shared_objects, SafePredFlag); diff --git a/C/modules.c b/C/modules.c index 7a55aacfd..3aac99e55 100644 --- a/C/modules.c +++ b/C/modules.c @@ -197,6 +197,7 @@ Term Yap_Module(Term tmod) { ModEntry *Yap_GetModuleEntry(Term mod) { ModEntry *me; + if (!(me = LookupModule(mod))) return NULL; return me; diff --git a/C/qlyr.c b/C/qlyr.c index 9fd35c3e9..53907c602 100755 --- a/C/qlyr.c +++ b/C/qlyr.c @@ -1110,7 +1110,7 @@ YAP_file_type_t Yap_Restore(const char *s) { return -1; GLOBAL_RestoreFile = s; if (do_header(stream) == NIL) - return YAP_BOOT_PL; + return YAP_PL; read_module(stream); setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, true); fclose(stream); diff --git a/C/stack.c b/C/stack.c index bba9ad55d..4c67b57e4 100644 --- a/C/stack.c +++ b/C/stack.c @@ -1,3 +1,5 @@ + + /************************************************************************* * * * YAP Prolog * @@ -67,13 +69,13 @@ static LogUpdIndex *find_owner_log_index(LogUpdIndex *, yamop *); static StaticIndex *find_owner_static_index(StaticIndex *, yamop *); -#define IN_BLOCK(P, B, SZ) \ +#define IN_BLOCK(P, B, SZ) \ ((CODEADDR)(P) >= (CODEADDR)(B) && (CODEADDR)(P) < (CODEADDR)(B) + (SZ)) static PredEntry *get_pred(Term t, Term tmod, char *pname) { Term t0 = t; -restart: + restart: if (IsVarTerm(t)) { Yap_Error(INSTANTIATION_ERROR, t0, pname); return NULL; @@ -105,7 +107,7 @@ restart: return NULL; } - extern char * Yap_output_bug_location(yamop *yap_pc, int where_from, int psize); +extern char * Yap_output_bug_location(yamop *yap_pc, int where_from, int psize); static PredEntry *PredForChoicePt(yamop *p_code, op_numbers *opn) { while (TRUE) { @@ -277,9 +279,14 @@ bool Yap_search_for_static_predicate_in_use(PredEntry *p, yamop *cp = (yamop *)env_ptr[E_CP]; PredEntry *pe; + if (!cp) + return true; pe = EnvPreg(cp); if (p == pe) return true; + if( env_ptr == (CELL *)(env_ptr[E_E])) + return false; + if (env_ptr != NULL) env_ptr = (CELL *)(env_ptr[E_E]); } @@ -577,33 +584,33 @@ static Int find_code_in_clause(PredEntry *pp, yamop *codeptr, void **startp, static Term clause_loc(void *clcode, PredEntry *pp) { CACHE_REGS - if (pp->PredFlags & LogUpdatePredFlag) { - LogUpdClause *cl = clcode; + if (pp->PredFlags & LogUpdatePredFlag) { + LogUpdClause *cl = clcode; - if (cl->ClFlags & FactMask) { - return MkIntegerTerm(cl->lusl.ClLine); - } else { - return MkIntegerTerm(cl->lusl.ClSource->ag.line_number); - } - } else if (pp->PredFlags & DynamicPredFlag) { - // DynamicClause *cl; - // cl = ClauseCodeToDynamicClause(clcode); + if (cl->ClFlags & FactMask) { + return MkIntegerTerm(cl->lusl.ClLine); + } else { + return MkIntegerTerm(cl->lusl.ClSource->ag.line_number); + } + } else if (pp->PredFlags & DynamicPredFlag) { + // DynamicClause *cl; + // cl = ClauseCodeToDynamicClause(clcode); - return MkIntTerm(0); - } else if (pp->PredFlags & MegaClausePredFlag) { - MegaClause *mcl = ClauseCodeToMegaClause(pp->cs.p_code.FirstClause); - return MkIntTerm(mcl->ClLine); - } else { - StaticClause *cl; - cl = clcode; - - if (cl->ClFlags & FactMask) { - return MkIntTerm(cl->usc.ClLine); - } else if (cl->ClFlags & SrcMask) { - return MkIntTerm(cl->usc.ClSource->ag.line_number); - } else return MkIntTerm(0); - } + } else if (pp->PredFlags & MegaClausePredFlag) { + MegaClause *mcl = ClauseCodeToMegaClause(pp->cs.p_code.FirstClause); + return MkIntTerm(mcl->ClLine); + } else { + StaticClause *cl; + cl = clcode; + + if (cl->ClFlags & FactMask) { + return MkIntTerm(cl->usc.ClLine); + } else if (cl->ClFlags & SrcMask) { + return MkIntTerm(cl->usc.ClSource->ag.line_number); + } else + return MkIntTerm(0); + } return MkIntTerm(0); } @@ -616,15 +623,15 @@ static int cl_code_in_pred(PredEntry *pp, yamop *codeptr, void **startp, if (pp->PredFlags & IndexedPredFlag) { if (pp->PredFlags & LogUpdatePredFlag) { if (code_in_pred_lu_index( - ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, - startp, endp)) { + ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, + startp, endp)) { UNLOCK(pp->PELock); return TRUE; } } else { if (code_in_pred_s_index( - ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, - startp, endp)) { + ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, + startp, endp)) { UNLOCK(pp->PELock); return TRUE; } @@ -661,16 +668,16 @@ static Int code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, if (pp->PredFlags & IndexedPredFlag && pp->OpcodeOfPred != INDEX_OPCODE) { if (pp->PredFlags & LogUpdatePredFlag) { if (code_in_pred_lu_index( - ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, - NULL, NULL)) { + ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, + NULL, NULL)) { code_in_pred_info(pp, pat, parity); UNLOCK(pp->PELock); return -1; } } else { if (code_in_pred_s_index( - ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, - NULL, NULL)) { + ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, + NULL, NULL)) { code_in_pred_info(pp, pat, parity); UNLOCK(pp->PELock); return -1; @@ -823,8 +830,8 @@ static PredEntry *found_owner_op(yamop *pc, void **startp, static PredEntry *found_expand(yamop *pc, void **startp, void **endp USES_REGS) { PredEntry *pp = - ((PredEntry *)(Unsigned(pc) - - (CELL)(&(((PredEntry *)NULL)->cs.p_code.ExpandCode)))); + ((PredEntry *)(Unsigned(pc) - + (CELL)(&(((PredEntry *)NULL)->cs.p_code.ExpandCode)))); *startp = (CODEADDR) & (pp->cs.p_code.ExpandCode); *endp = (CODEADDR)NEXTOP((yamop *)&(pp->cs.p_code.ExpandCode), e); return pp; @@ -900,19 +907,19 @@ static PredEntry *ClauseInfoForCode(yamop *codeptr, void **startp, PredEntry *Yap_PredEntryForCode(yamop *codeptr, find_pred_type where_from, void **startp, void **endp) { CACHE_REGS - if (where_from == FIND_PRED_FROM_CP) { - PredEntry *pp = PredForChoicePt(codeptr, NULL); - if (cl_code_in_pred(pp, codeptr, startp, endp)) { - return pp; + if (where_from == FIND_PRED_FROM_CP) { + PredEntry *pp = PredForChoicePt(codeptr, NULL); + if (cl_code_in_pred(pp, codeptr, startp, endp)) { + return pp; + } + } else if (where_from == FIND_PRED_FROM_ENV) { + PredEntry *pp = EnvPreg(codeptr); + if (cl_code_in_pred(pp, codeptr, startp, endp)) { + return pp; + } + } else { + return ClauseInfoForCode(codeptr, startp, endp PASS_REGS); } - } else if (where_from == FIND_PRED_FROM_ENV) { - PredEntry *pp = EnvPreg(codeptr); - if (cl_code_in_pred(pp, codeptr, startp, endp)) { - return pp; - } - } else { - return ClauseInfoForCode(codeptr, startp, endp PASS_REGS); - } return NULL; } @@ -1099,7 +1106,7 @@ static Int p_all_envs(USES_REGS1) { static Term clause_info(yamop *codeptr, PredEntry *pp) { CACHE_REGS - Term ts[2]; + Term ts[2]; void *begin; if (pp->ArityOfPE == 0) { @@ -1127,7 +1134,7 @@ yap_error_descriptor_t *set_clause_info(yap_error_descriptor_t *t, yamop *codeptr, PredEntry *pp) { CACHE_REGS - void *begin; + void *begin; if (pp->ArityOfPE == 0) { t->prologPredName = AtomName((Atom)pp->FunctorOfPred); t->prologPredArity = 0; @@ -1136,8 +1143,8 @@ yap_error_descriptor_t *set_clause_info(yap_error_descriptor_t *t, t->prologPredArity = pp->ArityOfPE; } t->prologPredModule = - (pp->ModuleOfPred ? RepAtom(AtomOfTerm(pp->ModuleOfPred))->StrOfAE - : "prolog"); + (pp->ModuleOfPred ? RepAtom(AtomOfTerm(pp->ModuleOfPred))->StrOfAE + : "prolog"); t->prologPredFile = RepAtom(pp->src.OwnerFile)->StrOfAE; if (codeptr->opc == UNDEF_OPCODE) { t->prologPredLine = 0; @@ -1247,7 +1254,7 @@ static Term all_calls(bool internal USES_REGS) { Term Yap_all_calls(void) { CACHE_REGS - return all_calls(true PASS_REGS); + return all_calls(true PASS_REGS); } /** @@ -1390,8 +1397,8 @@ void Yap_dump_code_area_for_profiler(void) { me = me->NextME; } Yap_inform_profiler_of_clause( - COMMA_CODE, FAILCODE, RepPredProp(Yap_GetPredPropByFunc(FunctorComma, 0)), - GPROF_INIT_COMMA); + COMMA_CODE, FAILCODE, RepPredProp(Yap_GetPredPropByFunc(FunctorComma, 0)), + GPROF_INIT_COMMA); Yap_inform_profiler_of_clause(FAILCODE, FAILCODE + 1, RepPredProp(Yap_GetPredPropByAtom(AtomFail, 0)), GPROF_INIT_FAIL); @@ -1424,7 +1431,7 @@ static Int program_continuation(USES_REGS1) { static Term BuildActivePred(PredEntry *ap, CELL *vect) { CACHE_REGS - arity_t i; + arity_t i; if (!ap->ArityOfPE) { return MkAtomTerm((Atom)ap->FunctorOfPred); @@ -1472,8 +1479,8 @@ static int UnifyPredInfo(PredEntry *pe, int start_arg USES_REGS) { } return Yap_unify(XREGS[start_arg], tmod) && - Yap_unify(XREGS[start_arg + 1], tname) && - Yap_unify(XREGS[start_arg + 2], MkIntegerTerm(arity)); + Yap_unify(XREGS[start_arg + 1], tname) && + Yap_unify(XREGS[start_arg + 2], MkIntegerTerm(arity)); } static Int ClauseId(yamop *ipc, PredEntry *pe) { @@ -1495,7 +1502,7 @@ static Int env_info(USES_REGS1) { /* pe = PREVOP(env_cp,Osbpp)->y_u.Osbpp.p0; */ taddr = MkIntegerTerm((Int)env); return Yap_unify(ARG3, MkIntegerTerm((Int)env_cp)) && - Yap_unify(ARG2, taddr) && Yap_unify(ARG4, env_b); + Yap_unify(ARG2, taddr) && Yap_unify(ARG4, env_b); } static Int p_cpc_info(USES_REGS1) { @@ -1504,18 +1511,18 @@ static Int p_cpc_info(USES_REGS1) { pe = PREVOP(ipc, Osbpp)->y_u.Osbpp.p0; return UnifyPredInfo(pe, 2 PASS_REGS) && - Yap_unify(ARG5, MkIntegerTerm(ClauseId(ipc, pe))); + Yap_unify(ARG5, MkIntegerTerm(ClauseId(ipc, pe))); } -static Int p_choicepoint_info(USES_REGS1) { - choiceptr cptr = (choiceptr)(LCL0 - IntegerOfTerm(Deref(ARG1))); - PredEntry *pe = NULL; +static PredEntry *choicepoint_owner(choiceptr cptr, Term *tp, yamop **nclp) +{ + PredEntry *pe = + NULL; int go_on = TRUE; yamop *ipc = cptr->cp_ap; yamop *ncl = NULL; - Term t = TermNil, taddr; + Term t = TermNil; - taddr = MkIntegerTerm((Int)cptr); while (go_on) { op_numbers opnum = Yap_op_from_opcode(ipc->opc); go_on = FALSE; @@ -1545,10 +1552,10 @@ static Int p_choicepoint_info(USES_REGS1) { t = MkVarTerm(); } else #endif /* DETERMINISTIC_TABLING */ - { - pe = GEN_CP(cptr)->cp_pred_entry; - t = BuildActivePred(pe, (CELL *)(GEN_CP(B) + 1)); - } + { + pe = GEN_CP(cptr)->cp_pred_entry; + t = BuildActivePred(pe, (CELL *)(GEN_CP(B) + 1)); + } #else pe = UndefCode; t = MkVarTerm(); @@ -1680,12 +1687,27 @@ static Int p_choicepoint_info(USES_REGS1) { } break; case _Ystop: default: - return FALSE; + pe = NULL; } } + if (tp) + *tp = t; + if (nclp) + *nclp = ncl; + return pe; +} + +static Int p_choicepoint_info(USES_REGS1) { + PredEntry *pe; + Term t, taddr; + yamop *ncl; + + choiceptr cptr = (choiceptr)(LCL0 - IntegerOfTerm(Deref(ARG1))); + taddr = MkIntegerTerm((Int)cptr); + pe = choicepoint_owner(cptr, &t, &ncl); return UnifyPredInfo(pe, 3 PASS_REGS) && Yap_unify(ARG2, taddr) && - Yap_unify(ARG6, t) && - Yap_unify(ARG7, MkIntegerTerm(ClauseId(ncl, pe))); + Yap_unify(ARG6, t) && + Yap_unify(ARG7, MkIntegerTerm(ClauseId(ncl, pe))); } static Int /* $parent_pred(Module, Name, Arity) */ @@ -1697,11 +1719,11 @@ parent_pred(USES_REGS1) { Term module; if (!PredForCode(P_before_spy, &at, &arity, &module, NULL)) { return Yap_unify(ARG1, MkIntTerm(0)) && - Yap_unify(ARG2, MkAtomTerm(AtomMetaCall)) && - Yap_unify(ARG3, MkIntTerm(0)); + Yap_unify(ARG2, MkAtomTerm(AtomMetaCall)) && + Yap_unify(ARG3, MkIntTerm(0)); } return Yap_unify(ARG1, MkIntTerm(module)) && - Yap_unify(ARG2, MkAtomTerm(at)) && Yap_unify(ARG3, MkIntTerm(arity)); + Yap_unify(ARG2, MkAtomTerm(at)) && Yap_unify(ARG3, MkIntTerm(arity)); } void DumpActiveGoals(CACHE_TYPE1); @@ -1710,7 +1732,7 @@ static int hidden(Atom); static int legal_env(CELL *CACHE_TYPE); -#define ONLOCAL(ptr) \ +#define ONLOCAL(ptr) \ (CellPtr(ptr) > CellPtr(HR) && CellPtr(ptr) < CellPtr(LOCAL_LocalBase)) static int hidden(Atom at) { @@ -1770,529 +1792,591 @@ static bool handled_exception(USES_REGS1) { #endif -#define ADDBUF( CMD ) { \ -while (true) { \ - size_t sz = CMD; \ - if (sz < lbufsz-256) { \ - lbuf += sz; \ - lbufsz -= sz; \ - break; \ - } \ - char *nbuf = Realloc(buf, bufsize += 1024); \ - lbuf = nbuf + (lbuf-buf); \ - buf = nbuf; \ - lbufsz += 1024; \ - } \ -} +typedef struct buf_struct_t { + char *buf_; + char *lbuf_; + size_t bufsize_; + size_t lbufsz_; +} buf_t; -const char *Yap_dump_stack(void) { - CACHE_REGS - choiceptr b_ptr = B; - CELL *env_ptr = ENV; - char *tp; +#define buf bufp->buf_ +#define lbuf bufp->lbuf_ +#define bufsize bufp->bufsize_ +#define lbufsz bufp->lbufsz_ + + +#define ADDBUF( CMD ) { \ + while (true) { \ + size_t sz = CMD; \ + if (sz < lbufsz-256) { \ + lbuf += sz; \ + lbufsz -= sz; \ + break; \ + } \ + char *nbuf = Realloc(buf, bufsize += 1024); \ + lbuf = nbuf + (lbuf-buf); \ + buf = nbuf; \ + lbufsz += 1024; \ + } \ + } + + +static char *ADDSTR( const char *STR, struct buf_struct_t *bufp ) { \ + while (true) { \ + size_t sz = strlen(STR); \ + if (sz < lbufsz-256){ \ + strcpy(lbuf, STR); + lbuf += sz; \ + lbufsz -= sz; \ + break; \ + } \ + char *nbuf = Realloc(buf, bufsize += 1024); \ + lbuf = nbuf + (lbuf-buf); \ + buf = nbuf; \ + lbufsz += 1024; \ + } \ +return lbuf; + } + + + +#if UNDEFINED +static void shortstack( choiceptr b_ptr, CELL * env_ptr , buf_struct_t *bufp) { yamop *ipc = CP; int max_count = 200; int lvl = push_text_stack(); - char *buf = Malloc(4096), *lbuf = buf; - size_t bufsize = 4096, lbufsz = bufsize-256; - /* check if handled */ - // if (handled_exception(PASS_REGS1)) - // return; + while (b_ptr != NULL) { + while (env_ptr && env_ptr <= (CELL *)b_ptr) { + tp = Yap_output_bug_location(ipc, FIND_PRED_FROM_ENV, 256); + if (env_ptr == (CELL *)b_ptr && (choiceptr)env_ptr[E_CB] > b_ptr) { + b_ptr = b_ptr->cp_b; + ADDBUF(snprintf(lbuf, lbufsz , "%% %s\n", tp)); + } else { + ADDBUF(snprintf(lbuf, lbufsz , "%% %s\n", tp)); + } + if (!max_count--) { + ADDBUF(snprintf(lbuf, lbufsz , "%% .....\n")); + return pop_output_text_stack(lvl, buf); + } + ipc = (yamop *)(env_ptr[E_CP]); + env_ptr = (CELL *)(env_ptr[E_E]); + } + if (b_ptr) { + if (!max_count--) { + ADDBUF(snprintf(lbuf, lbufsz , "// .....\n")); + return pop_output_text_stack(lvl, buf); + } + if (b_ptr->cp_ap && /* tabling */ + b_ptr->cp_ap->opc != Yap_opcode(_or_else) && + b_ptr->cp_ap->opc != Yap_opcode(_or_last) && + b_ptr->cp_ap->opc != Yap_opcode(_Nstop)) { + /* we can safely ignore ; because there is always an upper env */ + Term tp = Yap_output_bug_location(b_ptr->cp_ap, FIND_PRED_FROM_CP, 256); + ADDBUF(snprintf(lbuf, lbufsz , "%% %s (%luKB--%luKB)\n!!!", tp, + (unsigned long int)((b_ptr->cp_h - H0) * sizeof(CELL) / 1024), + (unsigned long int)((ADDR)LCL0 - (ADDR)b_ptr) / 1024)); + } + b_ptr = b_ptr->cp_b; + } + } + +#endif + + const char *Yap_dump_stack(void) { + CACHE_REGS + int lvl = push_text_stack(); + struct buf_struct_t b, *bufp = &b; + buf = Malloc(4096); + lbuf = buf; + bufsize = 4096; + lbufsz = bufsize-256; + /* check if handled */ + // if (handled_exception(PASS_REGS1)) + // return; #if DEBUG - ADDBUF(snprintf(lbuf, lbufsz , - "%% YAP regs: P=%p, CP=%p, ASP=%p, H=%p, TR=%p, HeapTop=%p~n", P, - CP, ASP, HR, TR, HeapTop)); - - ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% =====================================~n%%~n")); - ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% YAP Status:~n")); - ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n")); - yap_error_number errnbr = LOCAL_Error_TYPE; - yap_error_class_number classno = Yap_errorClass(errnbr); - - ADDBUF(snprintf(lbuf, lbufsz , "%% Error STATUS: %s/%s~n~n", Yap_errorName(errnbr), - Yap_errorClassName(classno))); - - ADDBUF(snprintf(lbuf, lbufsz , "%% Execution mode~n")); - if (LOCAL_PrologMode & BootMode) - ADDBUF(snprintf(lbuf, lbufsz , "%% Bootstrap~n")); - if (LOCAL_PrologMode & UserMode) - ADDBUF(snprintf(lbuf, lbufsz , "%% User Prolo~n")); - if (LOCAL_PrologMode & CritMode) - ADDBUF(snprintf(lbuf, lbufsz , "%% Exclusive Access Mode~n")); - if (LOCAL_PrologMode & AbortMode) - ADDBUF(snprintf(lbuf, lbufsz , "%% Abort~n")); - if (LOCAL_PrologMode & InterruptMode) - ADDBUF(snprintf(lbuf, lbufsz , "%% Interrupt~n")); - if (LOCAL_PrologMode & InErrorMode) - ADDBUF(snprintf(lbuf, lbufsz , "%% Error~n")); - if (LOCAL_PrologMode & ConsoleGetcMode) - ADDBUF(snprintf(lbuf, lbufsz , "%% Prompt Console~n")); - if (LOCAL_PrologMode & ExtendStackMode) - ADDBUF(snprintf(lbuf, lbufsz , "%% Stack expansion ~n")); - if (LOCAL_PrologMode & GrowHeapMode) - ADDBUF(snprintf(lbuf, lbufsz , "%% Data Base Expansion~n")); - if (LOCAL_PrologMode & GrowStackMode) - ADDBUF(snprintf(lbuf, lbufsz , "%% User Prolog~n")); - if (LOCAL_PrologMode & GCMode) - ADDBUF(snprintf(lbuf, lbufsz , "%% Garbage Collection~n")); - if (LOCAL_PrologMode & ErrorHandlingMode) - ADDBUF(snprintf(lbuf, lbufsz , "%% Error handler~n")); - if (LOCAL_PrologMode & CCallMode) - ADDBUF(snprintf(lbuf, lbufsz , "%% System Foreign Code~n")); - if (LOCAL_PrologMode & UnifyMode) - ADDBUF(snprintf(lbuf, lbufsz , "%% Off-line Foreign Code~n")); - if (LOCAL_PrologMode & UserCCallMode) - ADDBUF(snprintf(lbuf, lbufsz , "%% User Foreig C~n")); - if (LOCAL_PrologMode & MallocMode) - ADDBUF(snprintf(lbuf, lbufsz , "%% Heap Allocaror~n")); - if (LOCAL_PrologMode & SystemMode) - ADDBUF(snprintf(lbuf, lbufsz , "%% Prolog Internals~n")); - if (LOCAL_PrologMode & AsyncIntMode) - ADDBUF(snprintf(lbuf, lbufsz , "%% Async Interruot mode~n")); - if (LOCAL_PrologMode & InReadlineMode) - ADDBUF(snprintf(lbuf, lbufsz , "%% Readline Console~n")); - if (LOCAL_PrologMode & TopGoalMode) - ADDBUF(snprintf(lbuf, lbufsz , "%% Creating new query~n")); -#endif - ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n")); - ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% YAP Program:~n")); - ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n")); - ADDBUF(snprintf(lbuf, lbufsz , "%% Program Position: %s~n~n", Yap_errorName(errno))); - ADDBUF(snprintf(lbuf, lbufsz , "%% PC: %s~n", (char *)HR)); - Yap_output_bug_location(CP, FIND_PRED_FROM_ANYWHERE, 256); - ADDBUF(snprintf(lbuf, lbufsz , "%% Continuation: %s~n", (char *)HR)); - Yap_output_bug_location(B->cp_ap, FIND_PRED_FROM_ANYWHERE, 256); - ADDBUF(snprintf(lbuf, lbufsz , "%% Alternative: %s~n", (char *)HR)); - - ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n")); - ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% YAP Stack Usage:~n")); - ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n")); - if (HR > ASP || HR > LCL0) { - ADDBUF(snprintf(lbuf, lbufsz , "%% YAP ERROR: Global Collided against Local (%p--%p)~n", - HR, ASP)); - } else if (HeapTop > (ADDR)LOCAL_GlobalBase) { ADDBUF(snprintf(lbuf, lbufsz , - "%% YAP ERROR: Code Space Collided against Global (%p--%p)~n", - HeapTop, LOCAL_GlobalBase)); - } else { + "%% YAP regs: P=%p, CP=%p, ASP=%p, H=%p, TR=%p, HeapTop=%p\n", P, + CP, ASP, HR, TR, HeapTop)); + + ADDSTR( "%% \n%% =====================================\n%%\n", bufp); + ADDSTR( "%% \n%% YAP Status:\n", bufp); + ADDSTR( "%% \n%% -------------------------------------\n%%\n", bufp); + yap_error_number errnbr = LOCAL_Error_TYPE; + yap_error_class_number classno = Yap_errorClass(errnbr); + + ADDBUF(snprintf(lbuf, lbufsz , "%% Error STATUS: %s/%s\n\n", Yap_errorName(errnbr), + Yap_errorClassName(classno))); + + ADDSTR( "%% Execution mode\n", bufp ); + if (LOCAL_PrologMode & BootMode) + ADDSTR( "%% Bootstrap\n", bufp ); + if (LOCAL_PrologMode & UserMode) + ADDSTR( "%% User Prologg\n", bufp ); + if (LOCAL_PrologMode & CritMode) + ADDSTR( "%% Exclusive Access Mode\n", bufp ); + if (LOCAL_PrologMode & AbortMode) + ADDSTR( "%% Abort\n", bufp ); + if (LOCAL_PrologMode & InterruptMode) + ADDSTR( "%% Interrupt\n", bufp ); + if (LOCAL_PrologMode & InErrorMode) + ADDSTR( "%% Error\n", bufp ); + if (LOCAL_PrologMode & ConsoleGetcMode) + ADDSTR( "%% Prompt Console\n", bufp ); + if (LOCAL_PrologMode & ExtendStackMode) + ADDSTR( "%% Stack expansion \n", bufp ); + if (LOCAL_PrologMode & GrowHeapMode) + ADDSTR( "%% Data Base Expansion\n", bufp ); + if (LOCAL_PrologMode & GrowStackMode) + ADDSTR( "%% User Prolog\n", bufp ); + if (LOCAL_PrologMode & GCMode) + ADDSTR( "%% Garbage Collection\n", bufp ); + if (LOCAL_PrologMode & ErrorHandlingMode) + ADDSTR( "%% Error handler\n", bufp ); + if (LOCAL_PrologMode & CCallMode) + ADDSTR( "%% System Foreign Code\n", bufp ); + if (LOCAL_PrologMode & UnifyMode) + ADDSTR( "%% Off-line Foreign Code\n", bufp ); + if (LOCAL_PrologMode & UserCCallMode) + ADDSTR( "%% User Foreig C\n", bufp ); + if (LOCAL_PrologMode & MallocMode) + ADDSTR( "%% Heap Allocaror\n", bufp ); + if (LOCAL_PrologMode & SystemMode) + ADDSTR( "%% Prolog Internals\n", bufp ); + if (LOCAL_PrologMode & AsyncIntMode) + ADDSTR( "%% Async Interruot mode\n", bufp ); + if (LOCAL_PrologMode & InReadlineMode) + ADDSTR( "%% Readline Console\n", bufp ); + if (LOCAL_PrologMode & TopGoalMode) + ADDSTR( "%% Creating new query\n", bufp ); +#endif + ADDSTR( "%% \n%% -------------------------------------\n%%\n", bufp ); + ADDSTR( "%% \n%% YAP Program:\n", bufp ); + ADDSTR( "%% \n%% -------------------------------------\n%%\n", bufp ); + ADDBUF(snprintf(lbuf, lbufsz , "%% Program Position: %s\n\n", Yap_errorName(errno))); + char *o = Yap_output_bug_location(P, FIND_PRED_FROM_ANYWHERE, 256); + ADDBUF(snprintf(lbuf, lbufsz , "%% PC: %s\n", o) ); + o = Yap_output_bug_location(CP, FIND_PRED_FROM_ANYWHERE, 256); + ADDBUF(snprintf(lbuf, lbufsz , "%% Continuation: %s\n", o) ); + o = Yap_output_bug_location(B->cp_ap, FIND_PRED_FROM_ANYWHERE, 256); + ADDBUF(snprintf(lbuf, lbufsz , "%% Alternative: %s\n", o) ); + + ADDSTR( "%% \n%% -------------------------------------\n%%\n", bufp ); + ADDSTR( "%% \n%% YAP Stack Usage:\n", bufp ); + ADDSTR( "%% \n%% -------------------------------------\n%%\n", bufp ); + if (HR > ASP || HR > LCL0) { + ADDBUF(snprintf(lbuf, lbufsz , "%% YAP ERROR: Global Collided against Local (%p--%p)\n", + HR, ASP)); + } else if (HeapTop > (ADDR)LOCAL_GlobalBase) { + ADDBUF(snprintf(lbuf, lbufsz , + "%% YAP ERROR: Code Space Collided against Global (%p--%p)\n", + HeapTop, LOCAL_GlobalBase)); + } else { #if !USE_SYSTEM_MALLOC - ADDBUF(snprintf(lbuf, lbufsz , "%%ldKB of Code Space (%p--%p)~n", - (long int)((CELL)HeapTop - (CELL)Yap_HeapBase) / 1024, Yap_HeapBase, - HeapTop)); + ADDBUF(snprintf(lbuf, lbufsz , "%%ldKB of Code Space (%p--%p)\n", + (long int)((CELL)HeapTop - (CELL)Yap_HeapBase) / 1024, Yap_HeapBase, + HeapTop)); #if USE_DL_MALLOC - if (Yap_NOfMemoryHoles) { - UInt i; + if (Yap_NOfMemoryHoles) { + UInt i; - for (i = 0; i < Yap_NOfMemoryHoles; i++) - ADDBUF(snprintf(lbuf, lbufsz , " Current hole: %p--%p~n", Yap_MemoryHoles[i].start, - Yap_MemoryHoles[i].end)); - } + for (i = 0; i < Yap_NOfMemoryHoles; i++) + ADDBUF(snprintf(lbuf, lbufsz , " Current hole: %p--%p\n", Yap_MemoryHoles[i].start, + Yap_MemoryHoles[i].end)); + } #endif #endif - ADDBUF(snprintf(lbuf, lbufsz , "%% %luKB of Global Stack (%p--%p)~n", - (unsigned long int)(sizeof(CELL) * (HR - H0)) / 1024, H0, HR)); - ADDBUF(snprintf(lbuf, lbufsz , "%% %luKB of Local Stack (%p--%p)~n", - (unsigned long int)(sizeof(CELL) * (LCL0 - ASP)) / 1024, ASP, LCL0)); - ADDBUF(snprintf(lbuf, lbufsz , "%% %luKB of Trail (%p--%p)~n", - (unsigned long int)((ADDR)TR - LOCAL_TrailBase) / 1024, - LOCAL_TrailBase, TR)); - ADDBUF(snprintf(lbuf, lbufsz , "%% Performed %ld garbage collections~n", - (unsigned long int)LOCAL_GcCalls)); + ADDBUF(snprintf(lbuf, lbufsz , "%% %luKB of Global Stack (%p--%p)\n", + (unsigned long int)(sizeof(CELL) * (HR - H0)) / 1024, H0, HR)); + ADDBUF(snprintf(lbuf, lbufsz , "%% %luKB of Local Stack (%p--%p)\n", + (unsigned long int)(sizeof(CELL) * (LCL0 - ASP)) / 1024, ASP, LCL0)); + ADDBUF(snprintf(lbuf, lbufsz , "%% %luKB of Trail (%p--%p)\n", + (unsigned long int)((ADDR)TR - LOCAL_TrailBase) / 1024, + LOCAL_TrailBase, TR)); + ADDBUF(snprintf(lbuf, lbufsz , "%% Performed %ld garbage collections\n", + (unsigned long int)LOCAL_GcCalls)); #if LOW_LEVEL_TRACER - { - extern long long vsc_count; + { + extern long long vsc_count; - if (vsc_count) { + if (vsc_count) { #if _WIN32 - ADDBUF(snprintf(lbuf, lbufsz , "Trace Counter at %I64d~n", vsc_count)); + ADDBUF(snprintf(lbuf, lbufsz , "Trace Counter at %I64d\n", vsc_count)); #else - ADDBUF(snprintf(lbuf, lbufsz , "Trace Counter at %lld~n", vsc_count)); + ADDBUF(snprintf(lbuf, lbufsz , "Trace Counter at %lld\n", vsc_count)); #endif + } } - } #endif - ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n")); - ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% YAP Stack:~n")); - ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n")); - ADDBUF(snprintf(lbuf, lbufsz , "%% All Active Calls and~n")); - ADDBUF(snprintf(lbuf, lbufsz , "%% Goals With Alternatives Open (Global In " - "Use--Local In Use)~n%%~n")); - while (b_ptr != NULL) { - while (env_ptr && env_ptr <= (CELL *)b_ptr) { - tp = Yap_output_bug_location(ipc, FIND_PRED_FROM_ENV, 256); - if (env_ptr == (CELL *)b_ptr && (choiceptr)env_ptr[E_CB] > b_ptr) { - b_ptr = b_ptr->cp_b; - ADDBUF(snprintf(lbuf, lbufsz , "%% %s~n", tp)); - } else { - ADDBUF(snprintf(lbuf, lbufsz , "%% %s~n", tp)); - } - if (!max_count--) { - ADDBUF(snprintf(lbuf, lbufsz , "%% .....~n")); - return pop_output_text_stack(lvl, buf); - } - ipc = (yamop *)(env_ptr[E_CP]); - env_ptr = (CELL *)(env_ptr[E_E]); - } - if (b_ptr) { - if (!max_count--) { - ADDBUF(snprintf(lbuf, lbufsz , "// .....~n")); - return pop_output_text_stack(lvl, buf); - } - if (b_ptr->cp_ap && /* tabling */ - b_ptr->cp_ap->opc != Yap_opcode(_or_else) && - b_ptr->cp_ap->opc != Yap_opcode(_or_last) && - b_ptr->cp_ap->opc != Yap_opcode(_Nstop)) { - /* we can safely ignore ; because there is always an upper env */ - tp = Yap_output_bug_location(b_ptr->cp_ap, FIND_PRED_FROM_CP, 256); - ADDBUF(snprintf(lbuf, lbufsz , "%% %s (%luKB--%luKB)~n", tp, - (unsigned long int)((b_ptr->cp_h - H0) * sizeof(CELL) / 1024), - (unsigned long int)((ADDR)LCL0 - (ADDR)b_ptr) / 1024)); - } - b_ptr = b_ptr->cp_b; - } + ADDSTR( "%% \n%% -------------------------------------\n%%\n", bufp ); + ADDSTR( "%% \n%% YAP Stack:\n", bufp ); + ADDSTR( "%% \n%% -------------------------------------\n%%\n", bufp ); + ADDSTR( "%% All Active Calls and\n", bufp ); + ADDSTR( "%% Goals With Alternatives Open (Global In " + "Use--Local In Use)\n%%\n", bufp); } + return pop_output_text_stack(lvl, buf); } - return pop_output_text_stack(lvl, buf); -} -void DumpActiveGoals(USES_REGS1) { - /* try to dump active goals */ - CELL *ep = YENV; /* and current environment */ - choiceptr b_ptr = B; - CELL cp; - PredEntry *pe; - int first = 1; - if (legal_env(YENV PASS_REGS) && YENV < ENV) - ep = YENV; - else if (legal_env(ENV PASS_REGS)) - ep = ENV; - while (TRUE) { + static bool outputep( CELL *ep, struct buf_struct_t *bufp) { + PredEntry *pe = EnvPreg((yamop *)ep); if (!ONLOCAL(ep) || (Unsigned(ep) & (sizeof(CELL) - 1))) - break; - cp = ep[E_CP]; - if (!ONHEAP(cp) || (Unsigned(cp) & (sizeof(CELL) - 1))) - break; - pe = EnvPreg((yamop *)cp); - if (!ONHEAP(pe) || Unsigned(pe) & (sizeof(CELL) - 1)) - break; - PELOCK(71, pe); - if (pe->KindOfPE & 0xff00) { - UNLOCK(pe->PELock); - break; + return false; + Functor f; + UNLOCK(pe->PELock); + f = pe->FunctorOfPred; + if (pe->KindOfPE && hidden(NameOfFunctor(f))) { + return true; } - if (pe->PredFlags & (CompiledPredFlag | DynamicPredFlag)) { - Functor f; + Term mod = pe->ModuleOfPred; + if (mod == PROLOG_MODULE) + mod = TermProlog; + arity_t arity = ArityOfFunctor(f); - UNLOCK(pe->PELock); - f = pe->FunctorOfPred; - if (pe->KindOfPE && hidden(NameOfFunctor(f))) - goto next; - if (first++ == 1) - fprintf(stderr, "Active ancestors:\n"); - Term mod = pe->ModuleOfPred; - if (mod == PROLOG_MODULE) - mod = TermProlog; - Term t = Yap_MkNewApplTerm(f, pe->ArityOfPE); - Yap_plwrite(Yap_PredicateIndicator(t, mod), GLOBAL_Stream + 2, 0, 0, - GLOBAL_MaxPriority); - fputc('\n', stderr); - } else { - UNLOCK(pe->PELock); + int i; + ADDSTR( RepAtom(AtomOfTerm(mod))->StrOfAE, bufp ); + if (arity == 0) { + ADDSTR( RepAtom(((Atom)f))->StrOfAE, bufp ); + return true; } - next: - ep = (CELL *)ep[E_E]; + Atom At = NameOfFunctor(f); + ADDBUF(snprintf(lbuf, lbufsz, "%s(", RepAtom(At)->StrOfAE)); + for (i = 0; i < arity; i++) { + if (i > 0) ADDSTR("...,", bufp); + } + ADDSTR( "...)", bufp); + return true; } - first = 1; - fprintf(stderr, "Active Choice-Points:\n"); - while (TRUE) { - PredEntry *pe; - op_numbers opnum; - if (!ONLOCAL(b_ptr) || b_ptr->cp_b == NULL) - break; - fprintf(stderr, "%% %p ", b_ptr); - pe = Yap_PredForChoicePt(b_ptr, &opnum); + + static bool outputcp( choiceptr cp, struct buf_struct_t *bufp) { + choiceptr b_ptr = cp; + PredEntry *pe = Yap_PredForChoicePt(b_ptr,NULL); + ADDBUF(snprintf(lbuf, lbufsz, "%% %p ", cp)); + op_numbers opnum = Yap_op_from_opcode(b_ptr->cp_ap->opc); if (opnum == _Nstop) { - fprintf(stderr, " ********** C-Code Interface Boundary ***********\n"); - } else { - Functor f; - Term mod = PROLOG_MODULE; + bool rc = outputep( (CELL *)cp, bufp); + ADDSTR( " ********** C-Code Interface Boundary ***********\n", bufp); + return rc; + } + Functor f; + Term mod = PROLOG_MODULE; - f = pe->FunctorOfPred; - if (pe->ModuleOfPred) - mod = pe->ModuleOfPred; - else - mod = TermProlog; - if (mod != TermProlog && mod != MkAtomTerm(AtomUser)) { - Yap_plwrite(mod, GLOBAL_Stream + 2, 0, 0, GLOBAL_MaxPriority); - fputc(':', stderr); - } - if (mod == IDB_MODULE) { - if (pe->PredFlags & NumberDBPredFlag) { - Int id = pe->src.IndxId; - Yap_plwrite(MkIntegerTerm(id), GLOBAL_Stream + 2, 0, 0, - GLOBAL_MaxPriority); - } else if (pe->PredFlags & AtomDBPredFlag) { - Atom At = (Atom)pe->FunctorOfPred; - Yap_plwrite(MkAtomTerm(At), GLOBAL_Stream + 2, 0, 0, - GLOBAL_MaxPriority); - } else { - Functor f = pe->FunctorOfPred; - Atom At = NameOfFunctor(f); - arity_t arity = ArityOfFunctor(f); - int i; - - Yap_plwrite(MkAtomTerm(At), GLOBAL_Stream + 2, 0, 0, - GLOBAL_MaxPriority); - fputc('(', stderr); - for (i = 0; i < arity; i++) { - if (i > 0) - fputc(',', stderr); - fputc('_', stderr); - } - fputc(')', stderr); - } - fputc('(', stderr); - Yap_plwrite(b_ptr->cp_a2, GLOBAL_Stream + 2, 0, 0, GLOBAL_MaxPriority); - fputc(')', stderr); - } else if (pe->ArityOfPE == 0) { - Yap_plwrite(MkAtomTerm((Atom)f), GLOBAL_Stream + 2, 0, 0, - GLOBAL_MaxPriority); + f = pe->FunctorOfPred; + if (pe->ModuleOfPred) + mod = pe->ModuleOfPred; + else + mod = TermProlog; + if (mod != TermProlog && mod != MkAtomTerm(AtomUser)) { + ADDBUF(snprintf(lbuf, lbufsz, "%s:", RepAtom(AtomOfTerm(mod))->StrOfAE)); + } + if (mod == IDB_MODULE) { + if (pe->PredFlags & NumberDBPredFlag) { + Term t = MkIntegerTerm(pe->src.IndxId); + char *b = Yap_TermToBuffer(t, 0); + if (!b) + return false; + ADDSTR( b, bufp); + } else if (pe->PredFlags & AtomDBPredFlag) { + Atom At = (Atom)pe->FunctorOfPred; + ADDSTR( RepAtom(At)->StrOfAE, bufp); } else { - Int i = 0, arity = pe->ArityOfPE; - if (opnum == _or_last || opnum == _or_else) { - Yap_plwrite(MkAtomTerm(NameOfFunctor(f)), GLOBAL_Stream + 2, 0, 0, - GLOBAL_MaxPriority); - fputc('(', stderr); - for (i = 0; i < arity; i++) { - if (i > 0) - fputc(',', stderr); - fputc('_', stderr); + Functor f = pe->FunctorOfPred; + arity_t arity = ArityOfFunctor(f); + int i; + + ADDBUF(snprintf(lbuf, lbufsz, "%s(", RepAtom((Atom)f)->StrOfAE)); + for (i = 0; i < arity; i++) { + if (i > 0) ADDSTR( "_,", bufp); + } + ADDSTR( "), ", bufp); + } + char *b = Yap_TermToBuffer(b_ptr->cp_a2, 0); + if (!b) + return false; + ADDSTR( b, bufp); + ADDSTR( ",_)", bufp); + } else { + ADDSTR(RepAtom((Atom)f)->StrOfAE, bufp); + if (pe->ArityOfPE == 0) { + Int i = 0, arity = pe->ArityOfPE; + if (opnum == _or_last || opnum == _or_else) { + /* skip, it should be in the list as an environment } + Yap_plwrite(MkAtomTerm(NameOfFunctor(f)), GLOBAL_Stream + 2, 0, 0, + GLOBAL_MaxPriority); + fputc('(', stderr); + for (i = 0; i < arity; i++) { + if (i > 0) + fputc(',', stderr); + fputc('_', stderr); + } + fputs(") :- ... ( _ ; _ ", stderr); + */ + } else { + Term *args = &(b_ptr->cp_a1); + ADDBUF(snprintf(lbuf, lbufsz, "%s(", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE)); + for (i = 0; i < arity; i++) { + if (i > 0) + ADDSTR( ", ", bufp); + + char *b = Yap_TermToBuffer(args[i], 0); + if (!b) + return false; + ADDSTR( b, bufp); } - fputs(") :- ... ( _ ; _ ", stderr); - } else { - Term *args = &(b_ptr->cp_a1); - Yap_plwrite(MkAtomTerm(NameOfFunctor(f)), GLOBAL_Stream + 2, 0, 0, - GLOBAL_MaxPriority); - fputc('(', stderr); - for (i = 0; i < arity; i++) { - if (i > 0) - fputc(',', stderr); - Yap_plwrite(args[i], GLOBAL_Stream + 2, 0, 0, GLOBAL_MaxPriority); - } - } - fputc(')', stderr); + ADDSTR( ") ", bufp); + } } - fputc('\n', stderr); + ADDSTR( "\n", bufp); } - b_ptr = b_ptr->cp_b; + return true; } -} -/** - * Used for debugging. - * - */ -char * Yap_output_bug_location(yamop *yap_pc, int where_from, int psize) { - Atom pred_name; - UInt pred_arity; - Term pred_module; - Int cl; + void DumpActiveGoals(USES_REGS1) { + /* try to dump active goals */ + void *ep = YENV; /* and current environment */ + void *cp; + PredEntry *pe; + struct buf_struct_t buf0, *bufp = &buf0; - char *o = Malloc(256); - if ((cl = Yap_PredForCode(yap_pc, where_from, &pred_name, &pred_arity, - &pred_module)) == 0) { - /* system predicate */ - snprintf(o, 255, "%% %s", "meta-call"); - } else if (pred_module == 0) { - snprintf(o, 255, "in prolog:%s/%lu", RepAtom(pred_name)->StrOfAE, - (unsigned long int)pred_arity); - } else if (cl < 0) { - snprintf(o, 255, "%% %s:%s/%lu", RepAtom(AtomOfTerm(pred_module))->StrOfAE, - RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity); - } else { - snprintf(o, 255, "%% %s:%s/%lu at clause %lu", - RepAtom(AtomOfTerm(pred_module))->StrOfAE, - RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity, - (unsigned long int)cl); - } - return o; -} - -static yap_error_descriptor_t *add_bug_location(yap_error_descriptor_t *p, - yamop *codeptr, PredEntry *pe) { - CACHE_REGS - if (pe->ModuleOfPred == PROLOG_MODULE) - p->prologPredModule = AtomName(AtomProlog); - else - p->prologPredModule = AtomName(AtomOfTerm(pe->ModuleOfPred)); - if (pe->ArityOfPE) - p->prologPredName = AtomName(NameOfFunctor(pe->FunctorOfPred)); - else - p->prologPredName = AtomName((Atom)(pe->FunctorOfPred)); - p->prologPredArity = pe->ArityOfPE; - p->prologPredFile = AtomName(pe->src.OwnerFile); - p->prologPredLine = 0; - if (pe->src.OwnerFile) { - if (pe->PredFlags & MegaClausePredFlag) { - MegaClause *mcl; - mcl = ClauseCodeToMegaClause(pe->cs.p_code.FirstClause); - p->prologPredLine = mcl->ClLine; - } else { - void *clcode; - if (find_code_in_clause(pe, codeptr, &clcode, NULL) > 0) { - if (pe->PredFlags & LogUpdatePredFlag) { - LogUpdClause *cl = clcode; - - if (cl->ClFlags & FactMask) { - p->prologPredLine = cl->lusl.ClSource->ag.line_number; - } - } else if (pe->PredFlags & DynamicPredFlag) { - - p->prologPredLine = 0; - } else { - StaticClause *cl; - cl = clcode; - - if (cl->ClFlags & FactMask) { - p->prologPredLine = MkIntTerm(cl->usc.ClLine); - } else if (cl->ClFlags & SrcMask) { - p->prologPredLine = cl->usc.ClSource->ag.line_number; - } else - p->prologPredLine = 0; - } + buf = Malloc(4096); + lbuf = buf; + bufsize = 4096; + lbufsz = bufsize-256; + if (legal_env(YENV PASS_REGS) && YENV < ENV) + ep = YENV; + else if (legal_env(ENV PASS_REGS)) + ep = ENV; + while (true) { + if (!ONHEAP(cp) || (Unsigned(cp) & (sizeof(CELL) - 1))) + break; + PELOCK(71, pe); + if (pe->KindOfPE & 0xff00) { + UNLOCK(pe->PELock); + break; + } + if (cp <= ep) { + choiceptr p = cp; + pe = choicepoint_owner(p, NULL, NULL); + outputcp( p, bufp ); + cp = p->cp_b; + if (cp == ep) { + CELL *e = ep; + ep = (void*)e[E_E]; + } + cp = p; } else { - p->prologPredLine = 0; + CELL *e = ep; + pe = EnvPreg((yamop *)e); + if (!outputep( e, bufp )) + break; + ep = (void*)e[E_E]; + } + } + } + /** + * Used for debugging. + * + */ + char * Yap_output_bug_location(yamop *yap_pc, int where_from, int psize) { + Atom pred_name; + UInt pred_arity; + Term pred_module; + Int cl; + + char *o = Malloc(256); + if ((cl = Yap_PredForCode(yap_pc, where_from, &pred_name, &pred_arity, + &pred_module)) == 0) { + /* system predicate */ + snprintf(o, 255, "%% %s", "meta-call"); + } else if (pred_module == 0) { + snprintf(o, 255, "in prolog:%s/%lu", RepAtom(pred_name)->StrOfAE, + (unsigned long int)pred_arity); + } else if (cl < 0) { + snprintf(o, 255, "%% %s:%s/%lu", RepAtom(AtomOfTerm(pred_module))->StrOfAE, + RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity); + } else { + snprintf(o, 255, "%% %s:%s/%lu at clause %lu", + RepAtom(AtomOfTerm(pred_module))->StrOfAE, + RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity, + (unsigned long int)cl); + } + return o; + } + + static yap_error_descriptor_t *add_bug_location(yap_error_descriptor_t *p, + yamop *codeptr, PredEntry *pe) { + CACHE_REGS + if (pe->ModuleOfPred == PROLOG_MODULE) + p->prologPredModule = AtomName(AtomProlog); + else + p->prologPredModule = AtomName(AtomOfTerm(pe->ModuleOfPred)); + if (pe->ArityOfPE) + p->prologPredName = AtomName(NameOfFunctor(pe->FunctorOfPred)); + else + p->prologPredName = AtomName((Atom)(pe->FunctorOfPred)); + p->prologPredArity = pe->ArityOfPE; + p->prologPredFile = AtomName(pe->src.OwnerFile); + p->prologPredLine = 0; + if (pe->src.OwnerFile) { + if (pe->PredFlags & MegaClausePredFlag) { + MegaClause *mcl; + mcl = ClauseCodeToMegaClause(pe->cs.p_code.FirstClause); + p->prologPredLine = mcl->ClLine; + } else { + void *clcode; + if (find_code_in_clause(pe, codeptr, &clcode, NULL) > 0) { + if (pe->PredFlags & LogUpdatePredFlag) { + LogUpdClause *cl = clcode; + + if (cl->ClFlags & FactMask) { + p->prologPredLine = cl->lusl.ClSource->ag.line_number; + } + } else if (pe->PredFlags & DynamicPredFlag) { + + p->prologPredLine = 0; + } else { + StaticClause *cl; + cl = clcode; + + if (cl->ClFlags & FactMask) { + p->prologPredLine = MkIntTerm(cl->usc.ClLine); + } else if (cl->ClFlags & SrcMask) { + p->prologPredLine = cl->usc.ClSource->ag.line_number; + } else + p->prologPredLine = 0; + } + } else { + p->prologPredLine = 0; + } + } + } else if (pe->OpcodeOfPred == UNDEF_OPCODE) { + p->prologPredFile = "undefined"; + } else { + // by default, user_input + p->prologPredFile = AtomName(AtomUserIn); + p->prologPredLine = 0; + } + return p; + } + + yap_error_descriptor_t *Yap_pc_add_location(yap_error_descriptor_t *t, + void *pc0, void *b_ptr0, + void *env0) { + CACHE_REGS + yamop *xc = pc0; + // choiceptr b_ptr = b_ptr0; + // CELL *env = env0; + + PredEntry *pe; + if (PP == NULL) { + if (PredForCode(xc, NULL, NULL, NULL, &pe) <= 0) + return NULL; + } else + pe = PP; + if (pe != NULL + // pe->ModuleOfPred != PROLOG_MODULE && + // &&!(pe->PredFlags & HiddenPredFlag) + ) { + return add_bug_location(t, xc, pe); + } + return NULL; + } + + yap_error_descriptor_t *Yap_env_add_location(yap_error_descriptor_t *t, + void *cp0, void *b_ptr0, + void *env0, YAP_Int ignore_first) { + yamop *cp = cp0; + choiceptr b_ptr = b_ptr0; + CELL *env = env0; + while (true) { + if (b_ptr == NULL || env == NULL) + return NULL; + PredEntry *pe = EnvPreg(cp); + if (pe == PredTrue) + return NULL; + if (ignore_first <= 0 && + pe + // pe->ModuleOfPred != PROLOG_MODULE &&s + && !(pe->PredFlags & HiddenPredFlag)) { + return add_bug_location(t, cp, pe); + } else { + if (NULL && b_ptr && b_ptr->cp_env < env) { + cp = b_ptr->cp_cp; + env = b_ptr->cp_env; + b_ptr = b_ptr->cp_b; + } else { + cp = (yamop *)env[E_CP]; + env = ENV_Parent(env); + } + ignore_first--; + } } } - } else if (pe->OpcodeOfPred == UNDEF_OPCODE) { - p->prologPredFile = "undefined"; - } else { - // by default, user_input - p->prologPredFile = AtomName(AtomUserIn); - p->prologPredLine = 0; - } - return p; -} -yap_error_descriptor_t *Yap_pc_add_location(yap_error_descriptor_t *t, - void *pc0, void *b_ptr0, - void *env0) { - CACHE_REGS - yamop *xc = pc0; - // choiceptr b_ptr = b_ptr0; - // CELL *env = env0; - - PredEntry *pe; - if (PP == NULL) { - if (PredForCode(xc, NULL, NULL, NULL, &pe) <= 0) - return NULL; - } else - pe = PP; - if (pe != NULL - // pe->ModuleOfPred != PROLOG_MODULE && - // &&!(pe->PredFlags & HiddenPredFlag) - ) { - return add_bug_location(t, xc, pe); - } - return NULL; -} - -yap_error_descriptor_t *Yap_env_add_location(yap_error_descriptor_t *t, - void *cp0, void *b_ptr0, - void *env0, YAP_Int ignore_first) { - yamop *cp = cp0; - choiceptr b_ptr = b_ptr0; - CELL *env = env0; - while (true) { - if (b_ptr == NULL || env == NULL) - return NULL; - PredEntry *pe = EnvPreg(cp); - if (pe == PredTrue) - return NULL; - if (ignore_first <= 0 && - pe - // pe->ModuleOfPred != PROLOG_MODULE &&s - && !(pe->PredFlags & HiddenPredFlag)) { - return add_bug_location(t, cp, pe); - } else { + /* + Term Yap_env_location(yamop *cp, choiceptr b_ptr, CELL *env, Int ignore_first) + { while (true) { if (b_ptr == NULL || env == NULL) return TermNil; PredEntry + *pe = EnvPreg(cp); if (pe == PredTrue) return TermNil; if (ignore_first <= 0 + && pe + // pe->ModuleOfPred != PROLOG_MODULE &&s + && !(pe->PredFlags & HiddenPredFlag)) { + return add_bug_location(cp, pe); + } else { if (NULL && b_ptr && b_ptr->cp_env < env) { - cp = b_ptr->cp_cp; - env = b_ptr->cp_env; - b_ptr = b_ptr->cp_b; + cp = b_ptr->cp_cp; + env = b_ptr->cp_env; + b_ptr = b_ptr->cp_b; } else { - cp = (yamop *)env[E_CP]; - env = ENV_Parent(env); + cp = (yamop *)env[E_CP]; + env = ENV_Parent(env); } ignore_first--; + } + } + } + */ + + static Term mkloc(yap_error_descriptor_t *t) { return TermNil; } + + static Int clause_location(USES_REGS1) { + yap_error_descriptor_t t; + memset(&t, 0, sizeof(yap_error_descriptor_t)); + return Yap_unify(mkloc(Yap_pc_add_location(&t, P, B, ENV)), ARG1) && + Yap_unify(mkloc(Yap_env_add_location(&t, CP, B, ENV, 1)), ARG2); } - } -} -/* - Term Yap_env_location(yamop *cp, choiceptr b_ptr, CELL *env, Int ignore_first) - { while (true) { if (b_ptr == NULL || env == NULL) return TermNil; PredEntry - *pe = EnvPreg(cp); if (pe == PredTrue) return TermNil; if (ignore_first <= 0 - && pe - // pe->ModuleOfPred != PROLOG_MODULE &&s - && !(pe->PredFlags & HiddenPredFlag)) { - return add_bug_location(cp, pe); - } else { - if (NULL && b_ptr && b_ptr->cp_env < env) { - cp = b_ptr->cp_cp; - env = b_ptr->cp_env; - b_ptr = b_ptr->cp_b; - } else { - cp = (yamop *)env[E_CP]; - env = ENV_Parent(env); - } - ignore_first--; - } - } - } -*/ + static Int ancestor_location(USES_REGS1) { + yap_error_descriptor_t t; + memset(&t, 0, sizeof(yap_error_descriptor_t)); + return Yap_unify(mkloc(Yap_env_add_location(&t, CP, B, ENV, 2)), ARG2) && + Yap_unify(mkloc(Yap_env_add_location(&t, CP, B, ENV, 3)), ARG2); + } -static Term mkloc(yap_error_descriptor_t *t) { return TermNil; } + void Yap_InitStInfo(void) { + CACHE_REGS + Term cm = CurrentModule; -static Int clause_location(USES_REGS1) { - yap_error_descriptor_t t; - memset(&t, 0, sizeof(yap_error_descriptor_t)); - return Yap_unify(mkloc(Yap_pc_add_location(&t, P, B, ENV)), ARG1) && - Yap_unify(mkloc(Yap_env_add_location(&t, CP, B, ENV, 1)), ARG2); -} - -static Int ancestor_location(USES_REGS1) { - yap_error_descriptor_t t; - memset(&t, 0, sizeof(yap_error_descriptor_t)); - return Yap_unify(mkloc(Yap_env_add_location(&t, CP, B, ENV, 2)), ARG2) && - Yap_unify(mkloc(Yap_env_add_location(&t, CP, B, ENV, 3)), ARG2); -} - -void Yap_InitStInfo(void) { - CACHE_REGS - Term cm = CurrentModule; - - Yap_InitCPred("in_use", 2, in_use, - HiddenPredFlag | TestPredFlag | SafePredFlag | SyncPredFlag); + Yap_InitCPred("in_use", 2, in_use, + HiddenPredFlag | TestPredFlag | SafePredFlag | SyncPredFlag); #ifndef THREADS - Yap_InitCPred("toggle_static_predicates_in_use", 0, - toggle_static_predicates_in_use, - HiddenPredFlag | SafePredFlag | SyncPredFlag); + Yap_InitCPred("toggle_static_predicates_in_use", 0, + toggle_static_predicates_in_use, + HiddenPredFlag | SafePredFlag | SyncPredFlag); #endif - CurrentModule = HACKS_MODULE; - Yap_InitCPred("current_choicepoints", 1, p_all_choicepoints, 0); - Yap_InitCPred("current_continuations", 1, p_all_envs, 0); - Yap_InitCPred("choicepoint", 7, p_choicepoint_info, 0); - Yap_InitCPred("continuation", 4, env_info, 0); - Yap_InitCPred("cp_to_predicate", 5, p_cpc_info, 0); - CurrentModule = cm; - Yap_InitCPred("current_stack", 1, current_stack, HiddenPredFlag); - Yap_InitCPred("pred_for_code", 5, pred_for_code, HiddenPredFlag); - Yap_InitCPred("parent_pred", 3, parent_pred, HiddenPredFlag | SafePredFlag); - Yap_InitCPred("program_continuation", 3, program_continuation, - HiddenPredFlag | SafePredFlag); - Yap_InitCPred("clause_location", 2, clause_location, - HiddenPredFlag | SafePredFlag); - Yap_InitCPred("ancestor_location", 2, ancestor_location, - HiddenPredFlag | SafePredFlag); -} + CurrentModule = HACKS_MODULE; + Yap_InitCPred("current_choicepoints", 1, p_all_choicepoints, 0); + Yap_InitCPred("current_continuations", 1, p_all_envs, 0); + Yap_InitCPred("choicepoint", 7, p_choicepoint_info, 0); + Yap_InitCPred("continuation", 4, env_info, 0); + Yap_InitCPred("cp_to_predicate", 5, p_cpc_info, 0); + CurrentModule = cm; + Yap_InitCPred("current_stack", 1, current_stack, HiddenPredFlag); + Yap_InitCPred("pred_for_code", 5, pred_for_code, HiddenPredFlag); + Yap_InitCPred("parent_pred", 3, parent_pred, HiddenPredFlag | SafePredFlag); + Yap_InitCPred("program_continuation", 3, program_continuation, + HiddenPredFlag | SafePredFlag); + Yap_InitCPred("clause_location", 2, clause_location, + HiddenPredFlag | SafePredFlag); + Yap_InitCPred("ancestor_location", 2, ancestor_location, + HiddenPredFlag | SafePredFlag); + } diff --git a/C/stdpreds.c b/C/stdpreds.c index 5517c9091..8ffa8c46f 100755 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -1618,9 +1618,6 @@ void Yap_InitCPreds(void) { while (*p) (*(*p++))(); } -#if USE_MYDDAS - init_myddas(); -#endif #if CAMACHO { extern void InitForeignPreds(void); diff --git a/C/utilpreds.c b/C/utilpreds.c index bcb42b72d..903c08ca2 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -1,23 +1,25 @@ /************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: utilpreds.c * -* Last rev: 4/03/88 * -* mods: * -* comments: new utility predicates for YAP * -* * -*************************************************************************/ + * * + * YAP Prolog * + * * + * Yap Prolog was developed at NCCUP - Universidade do Porto * + * * + * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * + * * + ************************************************************************** + * * + * File: utilpreds.c * + * Last rev: 4/03/88 * + * mods: * + * comments: new utility predicates for YAP * + * * + *************************************************************************/ #ifdef SCCS static char SccsId[] = "@(#)utilpreds.c 1.3"; #endif /** + * @file utilpreds.c + * * @addtogroup Terms */ @@ -30,14 +32,106 @@ static char SccsId[] = "@(#)utilpreds.c 1.3"; #include "string.h" #endif + typedef struct { - Term old_var; - Term new_var; + Term old_var; + Term new_var; } *vcell; -static int copy_complex_term(CELL *, CELL *, int, int, CELL *, CELL * CACHE_TYPE); -static CELL vars_in_complex_term(CELL *, CELL *, Term CACHE_TYPE); +typedef struct non_single_struct_t { + CELL *ptd0; + CELL d0; + CELL *pt0, *pt0_end; +} non_singletons_t; + +#define WALK_COMPLEX_TERM__(LIST0, STRUCT0) \ + if (IsPairTerm(d0)) {\ + if (to_visit + 32 >= to_visit_max) {\ + goto aux_overflow;\ + }\ + LIST0;\ + ptd0 = RepPair(d0);\ + to_visit->pt0 = pt0;\ + to_visit->pt0_end = pt0_end;\ + to_visit->ptd0 = ptd0;\ + to_visit->d0 = *ptd0;\ + to_visit ++;\ + d0 = ptd0[0];\ + pt0 = ptd0;\ + *ptd0 = TermNil;\ + pt0_end = pt0 + 1;\ + goto list_loop;\ + } else if (IsApplTerm(d0)) {\ + register Functor f;\ + register CELL *ap2;\ + /* store the terms to visit */\ + ap2 = RepAppl(d0);\ + f = (Functor)(*ap2);\ +\ + if (IsExtensionFunctor(f)) {\ +\ + continue;\ + }\ + STRUCT0;\ + if (to_visit + 32 >= to_visit_max) {\ + goto aux_overflow;\ + }\ + to_visit->pt0 = pt0;\ + to_visit->pt0_end = pt0_end;\ + to_visit->ptd0 = ap2;\ + to_visit->d0 = *ap2;\ + to_visit ++;\ +\ + *ap2 = TermNil;\ + d0 = ArityOfFunctor(f);\ + pt0 = ap2;\ + pt0_end = ap2 + d0;\ + } + +#define WALK_COMPLEX_TERM() WALK_COMPLEX_TERM__({}, {}) + +#define def_trail_overflow() \ + trail_overflow:{ \ + pop_text_stack(lvl);\ + while (to_visit > to_visit0) {\ + to_visit --;\ + CELL *ptd0 = to_visit->ptd0;\ + *ptd0 = to_visit->d0;\ + }\ + LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;\ + LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *);\ + clean_tr(TR0 PASS_REGS);\ + HR = InitialH;\ + return 0L;\ +} + +#define def_aux_overflow() \ + aux_overflow:{ \ + size_t d1 = to_visit-to_visit0;\ + size_t d2 = to_visit_max-to_visit0;\ +to_visit0 = Realloc(to_visit0,(d2+128)*sizeof(struct non_single_struct_t)); \ + to_visit = to_visit0+d1;\ +to_visit_max = to_visit0+(d2+128); \ + pt0--;\ + goto restart;\ + } + +#define def_global_overflow() \ + global_overflow:{ \ + while (to_visit > to_visit0) { \ + to_visit --;\ + CELL *ptd0 = to_visit->ptd0;\ + *ptd0 = to_visit->d0;\ + }\ + pop_text_stack(lvl);\ + clean_tr(TR0 PASS_REGS);\ + HR = InitialH;\ + LOCAL_Error_TYPE = RESOURCE_ERROR_STACK;\ + LOCAL_Error_Size = (ASP-HR)*sizeof(CELL);\ + return false; } + + static Int p_non_singletons_in_term( USES_REGS1); static CELL non_singletons_in_complex_term(CELL *, CELL * CACHE_TYPE); static Int p_variables_in_term( USES_REGS1 ); @@ -45,6 +139,8 @@ static Int ground_complex_term(CELL *, CELL * CACHE_TYPE); static Int p_ground( USES_REGS1 ); static Int p_copy_term( USES_REGS1 ); static Int var_in_complex_term(CELL *, CELL *, Term CACHE_TYPE); +static int copy_complex_term(CELL *, CELL *, int, int, CELL *, CELL * CACHE_TYPE); +static CELL vars_in_complex_term(CELL *, CELL *, Term CACHE_TYPE); #ifdef DEBUG static Int p_force_trail_expansion( USES_REGS1 ); @@ -114,7 +210,7 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, /* fool the system into thinking we had a variable there */ *pt0 = AbsPair(HR); to_visit ++; - ground = TRUE; + ground = true; pt0 = ap2 - 1; pt0_end = ap2 + 1; ptf = HR; @@ -151,29 +247,29 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, *ptf++ = d0; /* you can just copy other extensions. */ } else #endif - if (!share) { - UInt sz; + if (!share) { + UInt sz; - *ptf++ = AbsAppl(HR); /* you can just copy other extensions. */ - /* make sure to copy floats */ - if (f== FunctorDouble) { - sz = sizeof(Float)/sizeof(CELL)+2; - } else if (f== FunctorLongInt) { - sz = 3; - } else if (f== FunctorString) { - sz = 3+ap2[1]; + *ptf++ = AbsAppl(HR); /* you can just copy other extensions. */ + /* make sure to copy floats */ + if (f== FunctorDouble) { + sz = sizeof(Float)/sizeof(CELL)+2; + } else if (f== FunctorLongInt) { + sz = 3; + } else if (f== FunctorString) { + sz = 3+ap2[1]; + } else { + CELL *pt = ap2+1; + sz = 2+sizeof(MP_INT)+(((MP_INT *)(pt+1))->_mp_alloc*sizeof(mp_limb_t)); + } + if (HR+sz > ASP - 2048) { + goto overflow; + } + memmove((void *)HR, (void *)ap2, sz*sizeof(CELL)); + HR += sz; } else { - CELL *pt = ap2+1; - sz = 2+sizeof(MP_INT)+(((MP_INT *)(pt+1))->_mp_alloc*sizeof(mp_limb_t)); + *ptf++ = d0; /* you can just copy other extensions. */ } - if (HR+sz > ASP - 2048) { - goto overflow; - } - memmove((void *)HR, (void *)ap2, sz*sizeof(CELL)); - HR += sz; - } else { - *ptf++ = d0; /* you can just copy other extensions. */ - } continue; } *ptf = AbsAppl(HR); @@ -241,7 +337,7 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, } Bind_NonAtt(ptd0, (CELL)ptf); ptf++; - } + } } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { @@ -287,7 +383,7 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, /* follow chain of multi-assigned variables */ return -1; -trail_overflow: + trail_overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ @@ -325,14 +421,14 @@ trail_overflow: reset_trail(TR0); LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; return -3; - } +} static Term handle_cp_overflow(int res, tr_fr_ptr TR0, UInt arity, Term t) { CACHE_REGS - XREGS[arity+1] = t; + XREGS[arity+1] = t; switch(res) { case -1: if (!Yap_gcl((ASP-HR)*sizeof(CELL), arity+1, ENV, gc_P(P,CP))) { @@ -453,13 +549,13 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { Term Yap_CopyTerm(Term inp) { CACHE_REGS - return CopyTerm(inp, 0, TRUE, TRUE PASS_REGS); + return CopyTerm(inp, 0, TRUE, TRUE PASS_REGS); } Term Yap_CopyTermNoShare(Term inp) { CACHE_REGS - return CopyTerm(inp, 0, FALSE, FALSE PASS_REGS); + return CopyTerm(inp, 0, FALSE, FALSE PASS_REGS); } static Int @@ -532,7 +628,7 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te HB = HR; to_visit0 = to_visit; - loop: + loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; @@ -544,7 +640,7 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te { if (IsPairTerm(d0)) { CELL *ap2 = RepPair(d0); - fprintf(stderr, "%ld \n", RepPair(ap2[0])- ptf); + fprintf(stderr, "%d \n", RepPair(ap2[0])- ptf); if (IsVarTerm(ap2[0]) && IN_BETWEEN(HB, (ap2[0]),HR)) { Term v = MkVarTerm(); *ptf = v; @@ -590,7 +686,7 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te ap2 = RepAppl(d0)+1; f = (Functor)(ap2[-1]); if (IsExtensionFunctor(f)) { - *ptf++ = d0; /* you can just copy other extensions. */ + *ptf++ = d0; /* you can just copy other extensions. */ continue; } if (IsApplTerm(ap2[0]) && IN_BETWEEN(HB, RepAppl(ap2[0]),HR)) { @@ -698,7 +794,7 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te } - Term +Term Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) { Term t = Deref(inp); Term tii = ti; @@ -708,7 +804,7 @@ Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) { *to = ti; return t; } else if (IsPrimitiveTerm(t)) { - *to = ti; + *to = ti; return t; } else if (IsPairTerm(t)) { CELL *ap; @@ -749,7 +845,7 @@ Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) { arity = ArityOfFunctor(f); HR += 1+arity; - { + { Int res; if ((res = break_rationals_complex_term(ap, ap+(arity), HB0+1, to, ti, HB0 PASS_REGS)) < 0) { HR = HB0; @@ -766,7 +862,7 @@ Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) { } } - static int +static int break_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term oi, CELL *HLow USES_REGS) { @@ -921,7 +1017,7 @@ break_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term oi, CELL return -3; } - Term +Term Yap_BreakTerm(Term inp, UInt arity, Term *to, Term ti USES_REGS) { Term t = Deref(inp); tr_fr_ptr TR0 = TR; @@ -973,21 +1069,21 @@ p_break_rational3( USES_REGS1 ) /* - FAST EXPORT ROUTINE. Export a Prolog term to something like: + FAST EXPORT ROUTINE. Export a Prolog term to something like: - CELL 0: offset for start of term - CELL 1: size of actual term (to be copied to stack) - CELL 2: the original term (just for reference) + CELL 0: offset for start of term + CELL 1: size of actual term (to be copied to stack) + CELL 2: the original term (just for reference) - Atoms and functors: - - atoms are either: - 0 and a char *string - -1 and a wchar_t *string - - functors are a CELL with arity and a string. + Atoms and functors: + - atoms are either: + 0 and a char *string + -1 and a wchar_t *string + - functors are a CELL with arity and a string. - Compiled Term. + Compiled Term. - */ +*/ static inline CELL *CellDifH(CELL *hptr, CELL *hlow) @@ -1042,14 +1138,14 @@ Functor export_functor(Functor f, char **hpp, char *buf, size_t len) return (Functor)(((char *)hptr-buf)+1); } -#define export_derefa_body(D,A,LabelUnk,LabelNonVar) \ - do { \ - if ((CELL *)(D) < CellDifH(HR,HLow)) { (A) = (CELL *)(D); break; } \ - (A) = (CELL *)(D); \ - (D) = *(CELL *)(D); \ - if(!IsVarTerm(D)) goto LabelNonVar; \ - LabelUnk: ; \ - } while (Unsigned(A) != (D)) +#define export_derefa_body(D,A,LabelUnk,LabelNonVar) \ + do { \ + if ((CELL *)(D) < CellDifH(HR,HLow)) { (A) = (CELL *)(D); break; } \ + (A) = (CELL *)(D); \ + (D) = *(CELL *)(D); \ + if(!IsVarTerm(D)) goto LabelNonVar; \ + LabelUnk: ; \ + } while (Unsigned(A) != (D)) static int @@ -1291,7 +1387,7 @@ export_complex_term(Term tf, CELL *pt0, CELL *pt0_end, char * buf, size_t len0, /* follow chain of multi-assigned variables */ return -1; -trail_overflow: + trail_overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ @@ -1368,7 +1464,7 @@ ExportTerm(Term inp, char * buf, size_t len, UInt arity, int newattvs USES_REGS) size_t Yap_ExportTerm(Term inp, char * buf, size_t len, UInt arity) { CACHE_REGS - return ExportTerm(inp, buf, len, arity, TRUE PASS_REGS); + return ExportTerm(inp, buf, len, arity, TRUE PASS_REGS); } @@ -1386,7 +1482,7 @@ addAtom(Atom t, char *buf) if (!*s) { return Yap_LookupAtom(s+1); } - return NULL; + return NULL; } static UInt @@ -1458,7 +1554,7 @@ import_pair(CELL *hp, char *abase, char *buf, CELL *amax) Term Yap_ImportTerm(char * buf) { CACHE_REGS - CELL *bc = (CELL *)buf; + CELL *bc = (CELL *)buf; size_t sz = bc[1]; Term tinp, tret; tinp = bc[2]; @@ -1539,74 +1635,29 @@ p_kill_exported_term( USES_REGS1 ) static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) { - register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); - register tr_fr_ptr TR0 = TR; + int lvl = push_text_stack(); + + struct non_single_struct_t + *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), + *to_visit0 = to_visit, + *to_visit_max = to_visit+1024; + register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); - to_visit0 = to_visit; loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; + restart: ++ pt0; ptd0 = pt0; d0 = *ptd0; + list_loop: deref_head(d0, vars_in_term_unk); vars_in_term_nvar: - { - if (IsPairTerm(d0)) { - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) { - continue; - } - /* store the terms to visit */ - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - } - continue; - } - + WALK_COMPLEX_TERM(); + continue ; derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); /* do or pt2 are unbound */ @@ -1629,21 +1680,18 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { -#ifdef RATIONAL_TREES - to_visit -= 3; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; - *pt0 = (CELL)to_visit[2]; -#else - to_visit -= 2; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; -#endif + to_visit--; + + pt0 = to_visit->pt0; + pt0_end = to_visit->pt0_end; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; goto loop; - } + } clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + pop_text_stack(lvl); + if (HR != InitialH) { /* close the list */ Term t2 = Deref(inp); @@ -1658,50 +1706,9 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter return(inp); } - trail_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - return 0L; - - aux_overflow: - LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - return 0L; - - global_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; - LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); - return 0L; + def_trail_overflow(); + def_aux_overflow(); + def_global_overflow(); } @@ -1841,7 +1848,7 @@ Yap_TermVariables( Term t, UInt arity USES_REGS ) /* variables in term t */ { Term out; - do { + do { t = Deref(t); if (IsVarTerm(t)) { return MkPairTerm(t, TermNil); @@ -1873,145 +1880,71 @@ typedef struct att_rec { static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) { int lvl = push_text_stack(); - att_rec_t *to_visit0, *to_visit = Malloc(1024*sizeof(att_rec_t)); - att_rec_t *to_visit_max; - register tr_fr_ptr TR0 = TR; + struct non_single_struct_t + *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), + *to_visit0 = to_visit, + *to_visit_max = to_visit+1024; + register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); - to_visit0 = to_visit; - to_visit_max = to_visit0+1024; restart: - do { - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - deref_head(d0, attvars_in_term_unk); - attvars_in_term_nvar: - { - if (IsPairTerm(d0)) { - if (to_visit + 32 >= to_visit_max) { - goto aux_overflow; - } - { - CELL *npt0 = RepPair(d0); - if(IsAtomicTerm(Deref(npt0[0]))) { - pt0 = npt0; - pt0_end = pt0 + 1; - continue; - } - } -#ifdef RATIONAL_TREES - to_visit->beg = pt0; - to_visit->end = pt0_end; - to_visit->oval = *pt0; - to_visit ++; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = pt0+2; - } else if (IsApplTerm(d0)) { - Functor f; - CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) { - continue; + while (pt0 < pt0_end) { + register CELL d0; + register CELL *ptd0; + ++ pt0; + ptd0 = pt0; + d0 = *ptd0; + list_loop: + deref_head(d0, attvars_in_term_unk); + attvars_in_term_nvar: + { + WALK_COMPLEX_TERM(); + continue; + } + + + derefa_body(d0, ptd0, attvars_in_term_unk, attvars_in_term_nvar); + if (IsAttVar(ptd0)) { + /* do or pt2 are unbound */ + attvar_record *a0 = RepAttVar(ptd0); + if (a0->AttFunc ==(Functor) TermNil) continue; + /* leave an empty slot to fill in later */ + if (HR+1024 > ASP) { + goto global_overflow; } + HR[1] = AbsPair(HR+2); + HR += 2; + HR[-2] = (CELL)&(a0->Done); /* store the terms to visit */ if (to_visit + 32 >= to_visit_max) { goto aux_overflow; } -#ifdef RATIONAL_TREES - to_visit->beg = pt0; - to_visit->end = pt0_end; - to_visit->oval = *pt0; + ptd0 = (CELL*)a0; + to_visit->pt0 = pt0; + to_visit->pt0_end = pt0_end; + to_visit->d0 = *ptd0; + to_visit->ptd0 = ptd0; to_visit ++; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - arity_t a = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + a; + *ptd0 = TermNil; + pt0 = ptd0; + pt0_end = &RepAttVar(ptd0)->Atts; } - continue; + } + /* Do we still have compound terms to visit */ + if (to_visit > to_visit0) { + to_visit--; + + pt0 = to_visit->pt0; + pt0_end = to_visit->pt0_end; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; + goto restart; } - - derefa_body(d0, ptd0, attvars_in_term_unk, attvars_in_term_nvar); - if (IsAttVar(ptd0)) { - /* do or pt2 are unbound */ - *ptd0 = TermNil; - /* next make sure noone will see this as a variable again */ - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } - } - TrailTerm(TR++) = (CELL)ptd0; - /* leave an empty slot to fill in later */ - if (HR+1024 > ASP) { - goto global_overflow; - } - HR[1] = AbsPair(HR+2); - HR += 2; - HR[-2] = (CELL)ptd0; - /* store the terms to visit */ - if (to_visit + 32 >= to_visit_max) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - - to_visit->beg = pt0; - to_visit->end = pt0_end; - to_visit->oval = *pt0; - to_visit ++; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = &RepAttVar(ptd0)->Value; - pt0_end = &RepAttVar(ptd0)->Atts; - } - continue; - } - /* Do we still have compound terms to visit */ - if (to_visit == to_visit0) - break; -#ifdef RATIONAL_TREES - to_visit --; - pt0 = to_visit->beg; - pt0_end = to_visit->end; - *pt0 = to_visit->oval; -#else - to_visit -= 2; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; -#endif - } while(true); - + clean_tr(TR0 PASS_REGS); - pop_text_stack(lvl); + pop_text_stack(lvl); if (HR != InitialH) { /* close the list */ Term t2 = Deref(inp); @@ -2026,46 +1959,8 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, return(inp); } - trail_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit --; - pt0 = to_visit->beg; - *pt0 = to_visit->oval; - } -#endif - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); - clean_tr(TR0 PASS_REGS); - pop_text_stack(lvl); - HR = InitialH; - return 0L; - - aux_overflow: - { - size_t d1 = to_visit-to_visit0; - size_t d2 = to_visit_max-to_visit0; - to_visit0 = Realloc(to_visit0,d2*sizeof(CELL*)+64*1024); - to_visit = to_visit0+d1; - to_visit_max = to_visit0+(d2+(64*1024))/sizeof(CELL **); -} -pt0--; -goto restart; - - global_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit --; - pt0 = to_visit->beg; - *pt0 = to_visit->oval; - } -#endif - clean_tr(TR0 PASS_REGS); -pop_text_stack(lvl); - HR = InitialH; - LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; - LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); - return 0L; + def_aux_overflow(); + def_global_overflow(); } @@ -2083,15 +1978,15 @@ p_term_attvars( USES_REGS1 ) /* variables in term t */ return Yap_unify(TermNil, ARG2); } else if (IsPairTerm(t)) { out = attvars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, TermNil PASS_REGS); + RepPair(t)+1, TermNil PASS_REGS); } else { Functor f = FunctorOfTerm(t); if (IsExtensionFunctor(f)) return Yap_unify(TermNil, ARG2); out = attvars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), TermNil PASS_REGS); + RepAppl(t)+ + ArityOfFunctor(f), TermNil PASS_REGS); } if (out == 0L) { if (!expand_vts( 3 PASS_REGS )) @@ -2139,7 +2034,12 @@ p_term_variables3( USES_REGS1 ) /* variables in term t */ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) { - register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); + int lvl = push_text_stack(); + + struct non_single_struct_t + *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), + *to_visit0 = to_visit, + *to_visit_max = to_visit+1024; register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); @@ -2159,65 +2059,19 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, } inp = TailOfTerm(inp); } - loop: + restart: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; ++ pt0; ptd0 = pt0; d0 = *ptd0; + list_loop: deref_head(d0, vars_within_term_unk); vars_within_term_nvar: { - if (IsPairTerm(d0)) { - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) { - continue; - } - /* store the terms to visit */ - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - } else if (d0 == TermFoundVar) { + WALK_COMPLEX_TERM() + else if (d0 == TermFoundVar) { /* leave an empty slot to fill in later */ if (HR+1024 > ASP) { goto global_overflow; @@ -2227,28 +2081,24 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, HR[-2] = (CELL)ptd0; *ptd0 = TermNil; } - continue; } + continue; derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { -#ifdef RATIONAL_TREES - to_visit -= 3; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; - *pt0 = (CELL)to_visit[2]; -#else - to_visit -= 2; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; -#endif - goto loop; + to_visit--; + + pt0 = to_visit->pt0; + pt0_end = to_visit->pt0_end; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; + goto restart; } clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + pop_text_stack(lvl); if (HR != InitialH) { HR[-1] = TermNil; return output; @@ -2256,51 +2106,10 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, return TermNil; } - trail_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - return 0L; - - aux_overflow: - LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - return 0L; - - global_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; - LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); - return 0L; + def_trail_overflow(); + def_aux_overflow(); + def_global_overflow(); } static Int @@ -2323,7 +2132,7 @@ p_variables_within_term( USES_REGS1 ) /* variables within term t */ else { Functor f = FunctorOfTerm(t); out = vars_within_complex_term(RepAppl(t), - RepAppl(t)+ + RepAppl(t)+ ArityOfFunctor(f), Deref(ARG1) PASS_REGS); } if (out == 0L) { @@ -2336,7 +2145,12 @@ p_variables_within_term( USES_REGS1 ) /* variables within term t */ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) { - register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); + int lvl = push_text_stack(); + + struct non_single_struct_t + *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), + *to_visit0 = to_visit, + *to_visit_max = to_visit+1024; register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); @@ -2356,65 +2170,19 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, } inp = TailOfTerm(inp); } - loop: + restart: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; ++ pt0; ptd0 = pt0; d0 = *ptd0; + list_loop: deref_head(d0, vars_within_term_unk); vars_within_term_nvar: { - if (IsPairTerm(d0)) { - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) { - continue; - } - /* store the terms to visit */ - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - } + WALK_COMPLEX_TERM(); + continue; } @@ -2439,21 +2207,17 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { -#ifdef RATIONAL_TREES - to_visit -= 3; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; - *pt0 = (CELL)to_visit[2]; -#else - to_visit -= 2; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; -#endif - goto loop; + to_visit--; + + pt0 = to_visit->pt0; + pt0_end = to_visit->pt0_end; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; + goto restart; } clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + pop_text_stack(lvl); if (HR != InitialH) { HR[-1] = TermNil; return output; @@ -2461,51 +2225,9 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, return TermNil; } - trail_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - return 0L; - - aux_overflow: - LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - return 0L; - - global_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; - LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); - return 0L; - + def_trail_overflow(); + def_aux_overflow(); + def_global_overflow(); } static Int @@ -2528,8 +2250,8 @@ p_new_variables_in_term( USES_REGS1 ) /* variables within term t */ else { Functor f = FunctorOfTerm(t); out = new_vars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), Deref(ARG1) PASS_REGS); + RepAppl(t)+ + ArityOfFunctor(f), Deref(ARG1) PASS_REGS); } if (out == 0L) { if (!expand_vts( 3 PASS_REGS )) @@ -2541,71 +2263,29 @@ p_new_variables_in_term( USES_REGS1 ) /* variables within term t */ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS) { - register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); + int lvl = push_text_stack(); + + struct non_single_struct_t + *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), + *to_visit0 = to_visit, + *to_visit_max = to_visit+1024; CELL *InitialH = HR; *HR++ = MkAtomTerm(AtomDollar); to_visit0 = to_visit; - loop: + restart: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; ++ pt0; ptd0 = pt0; d0 = *ptd0; + list_loop: deref_head(d0, vars_within_term_unk); vars_within_term_nvar: { - if (IsPairTerm(d0)) { - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) { - continue; - } - /* store the terms to visit */ - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - } - continue; + WALK_COMPLEX_TERM() + continue; } derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); @@ -2628,78 +2308,35 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { -#ifdef RATIONAL_TREES - to_visit -= 3; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; - *pt0 = (CELL)to_visit[2]; -#else - to_visit -= 2; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; -#endif - goto loop; + to_visit--; + + pt0 = to_visit->pt0; + pt0_end = to_visit->pt0_end; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; + goto restart; } clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - if (HR != InitialH) { +pop_text_stack(lvl); + if (HR > InitialH+1) { InitialH[0] = (CELL)Yap_MkFunctor(AtomDollar, (HR-InitialH)-1); return AbsAppl(InitialH); } else { return MkAtomTerm(AtomDollar); } - trail_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - return 0L; - - aux_overflow: - LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - return 0L; - - global_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; - LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); - return 0L; + + def_trail_overflow(); + def_aux_overflow(); + def_global_overflow(); } static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS) { - register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); + register CELL **to_visit0, + **to_visit = (CELL **)Yap_PreAllocCodeSpace(); CELL *InitialH = HR; to_visit0 = to_visit; @@ -2842,7 +2479,7 @@ p_free_variables_in_term( USES_REGS1 ) /* variables within term t */ Functor f = FunctorOfTerm(t); if (f == FunctorHat) { out = bind_vars_in_complex_term(RepAppl(t), - RepAppl(t)+1, TR0 PASS_REGS); + RepAppl(t)+1, TR0 PASS_REGS); if (out == 0L) { goto trail_overflow; } @@ -2873,7 +2510,7 @@ p_free_variables_in_term( USES_REGS1 ) /* variables within term t */ else { Functor f = FunctorOfTerm(t); out = free_vars_in_complex_term(RepAppl(t), - RepAppl(t)+ + RepAppl(t)+ ArityOfFunctor(f), TR0 PASS_REGS); } if (out == 0L) { @@ -2895,80 +2532,36 @@ p_free_variables_in_term( USES_REGS1 ) /* variables within term t */ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt0_end USES_REGS) { + int lvl = push_text_stack(); - register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); + struct non_single_struct_t *to_visit0, + *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), + *to_visit_max; register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); to_visit0 = to_visit; - loop: + to_visit_max = to_visit0+1024; + restart: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; ++ pt0; ptd0 = pt0; d0 = *ptd0; + list_loop: deref_head(d0, vars_in_term_unk); vars_in_term_nvar: { - if (IsPairTerm(d0)) { - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - - if (IsExtensionFunctor(f)) { - - continue; - } - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - /* store the terms to visit */ - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - } else if (d0 == TermFoundVar) { + WALK_COMPLEX_TERM() + else if (d0 == TermFoundVar) { CELL *pt2 = pt0; while(IsVarTerm(*pt2)) pt2 = (CELL *)(*pt2); - HR[0] = AbsPair(HR+2); + HR[1] = AbsPair(HR+2); + HR[0] = (CELL)pt2; HR += 2; - HR[-1] = (CELL)pt2; *pt2 = TermRefoundVar; } continue; @@ -2983,47 +2576,26 @@ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; - *pt0 = (CELL)to_visit[2]; - goto loop; + to_visit--; + + pt0 = to_visit->pt0; + pt0_end = to_visit->pt0_end; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; + goto restart; } clean_tr(TR0 PASS_REGS); + pop_text_stack(lvl); if (HR != InitialH) { - CELL *pt0 = InitialH, *pt1 = pt0; - while (pt0 < InitialH) { - if(Deref(pt0[0]) == TermFoundVar) { - pt1[0] = pt0[0]; - pt1[1] = AbsAppl(pt1+2); - pt1 += 2; - } - pt0 += 2; - } - } - if (HR != InitialH) { - /* close the list */ + /* close the list */ HR[-1] = Deref(ARG2); return output; } else { return ARG2; } - aux_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - clean_tr(TR0 PASS_REGS); - if (HR != InitialH) { - /* close the list */ - RESET_VARIABLE(HR-1); - } - return 0L; + def_aux_overflow(); } static Int @@ -3059,11 +2631,15 @@ p_non_singletons_in_term( USES_REGS1 ) /* non_singletons in term t */ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_REGS) { + int lvl = push_text_stack(); - register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); + struct non_single_struct_t *to_visit0, + *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), + *to_visit_max; to_visit0 = to_visit; - loop: + to_visit_max = to_visit0+1024; + restart: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; @@ -3071,137 +2647,74 @@ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_R ++pt0; ptd0 = pt0; d0 = *ptd0; + list_loop: deref_head(d0, vars_in_term_unk); vars_in_term_nvar: - { - if (IsPairTerm(d0)) { - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); + WALK_COMPLEX_TERM(); + continue; - if (IsExtensionFunctor(f)) { - continue; - } - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - /* store the terms to visit */ - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - } - continue; - } derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); -#ifdef RATIONAL_TREES + pop_text_stack(lvl); while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; - *pt0 = (CELL)to_visit[2]; + to_visit --; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; } -#endif return FALSE; } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { -#ifdef RATIONAL_TREES - to_visit -= 3; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; - *pt0 = (CELL)to_visit[2]; -#else - to_visit -= 2; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; -#endif - goto loop; + to_visit--; + + pt0 = to_visit->pt0; + pt0_end = to_visit->pt0_end; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; + goto restart; } + pop_text_stack(lvl); return TRUE; - aux_overflow: - /* unwind stack */ -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - return -1; -} + def_aux_overflow(); + } bool Yap_IsGroundTerm(Term t) { CACHE_REGS - while (TRUE) { - Int out; + while (TRUE) { + Int out; - if (IsVarTerm(t)) { - return FALSE; - } else if (IsPrimitiveTerm(t)) { - return TRUE; - } else if (IsPairTerm(t)) { - if ((out =ground_complex_term(RepPair(t)-1, - RepPair(t)+1 PASS_REGS)) >= 0) { - return out != 0; - } - } else { - Functor fun = FunctorOfTerm(t); - - if (IsExtensionFunctor(fun)) + if (IsVarTerm(t)) { + return FALSE; + } else if (IsPrimitiveTerm(t)) { return TRUE; - else if ((out = ground_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(fun) PASS_REGS)) >= 0) { - return out != 0; + } else if (IsPairTerm(t)) { + if ((out =ground_complex_term(RepPair(t)-1, + RepPair(t)+1 PASS_REGS)) >= 0) { + return out != 0; + } + } else { + Functor fun = FunctorOfTerm(t); + + if (IsExtensionFunctor(fun)) + return TRUE; + else if ((out = ground_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(fun) PASS_REGS)) >= 0) { + return out != 0; + } + } + if (out < 0) { + *HR++ = t; + if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { + Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in ground"); + return false; + } + t = *--HR; } } - if (out < 0) { - *HR++ = t; - if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { - Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in ground"); - return false; - } - t = *--HR; - } - } } static Int @@ -3354,32 +2867,32 @@ int Yap_SizeGroundTerm(Term t, int ground) { CACHE_REGS - if (IsVarTerm(t)) { - if (!ground) + if (IsVarTerm(t)) { + if (!ground) + return 1; + return 0; + } else if (IsPrimitiveTerm(t)) { return 1; - return 0; - } else if (IsPrimitiveTerm(t)) { - return 1; - } else if (IsPairTerm(t)) { - int sz = sz_ground_complex_term(RepPair(t)-1, RepPair(t)+1, ground PASS_REGS); - if (sz <= 0) - return sz; - return sz+2; -} else { - int sz = 0; - Functor fun = FunctorOfTerm(t); + } else if (IsPairTerm(t)) { + int sz = sz_ground_complex_term(RepPair(t)-1, RepPair(t)+1, ground PASS_REGS); + if (sz <= 0) + return sz; + return sz+2; + } else { + int sz = 0; + Functor fun = FunctorOfTerm(t); - if (IsExtensionFunctor(fun)) - return 1+ SizeOfExtension(t); + if (IsExtensionFunctor(fun)) + return 1+ SizeOfExtension(t); - sz = sz_ground_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(fun), - ground PASS_REGS); - if (sz <= 0) - return sz; - return 1+ArityOfFunctor(fun)+sz; - } + sz = sz_ground_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(fun), + ground PASS_REGS); + if (sz <= 0) + return sz; + return 1+ArityOfFunctor(fun)+sz; + } } static Int var_in_complex_term(register CELL *pt0, @@ -3550,52 +3063,52 @@ p_var_in_term( USES_REGS1 ) // And it has a few limitations - // 1. It will not work incrementally. -// 2. It will not produce the same results on little-endian and big-endian +// 2. It will not produce the same results on litle-endian and big-endian // machines. static unsigned int MurmurHashNeutral2 ( const void * key, int len, unsigned int seed ) { - const unsigned int m = 0x5bd1e995; - const int r = 24; + const unsigned int m = 0x5bd1e995; + const int r = 24; - unsigned int h = seed ^ len; + unsigned int h = seed ^ len; - const unsigned char * data = (const unsigned char *)key; + const unsigned char * data = (const unsigned char *)key; - while(len >= 4) - { - unsigned int k; + while(len >= 4) + { + unsigned int k; - k = data[0]; - k |= data[1] << 8; - k |= data[2] << 16; - k |= data[3] << 24; + k = data[0]; + k |= data[1] << 8; + k |= data[2] << 16; + k |= data[3] << 24; - k *= m; - k ^= k >> r; - k *= m; + k *= m; + k ^= k >> r; + k *= m; - h *= m; - h ^= k; + h *= m; + h ^= k; - data += 4; - len -= 4; - } + data += 4; + len -= 4; + } - switch(len) - { - case 3: h ^= data[2] << 16; - case 2: h ^= data[1] << 8; - case 1: h ^= data[0]; - h *= m; - }; + switch(len) + { + case 3: h ^= data[2] << 16; + case 2: h ^= data[1] << 8; + case 1: h ^= data[0]; + h *= m; + }; - h ^= h >> 13; - h *= m; - h ^= h >> 15; + h ^= h >> 13; + h *= m; + h ^= h >> 15; - return h; + return h; } static CELL * @@ -3603,20 +3116,20 @@ addAtomToHash(CELL *st, Atom at) { unsigned int len; - char *c = RepAtom(at)->StrOfAE; - int ulen = strlen(c); - /* fix hashing over empty atom */ - if (!ulen) { - return st; - } - if (ulen % CellSize == 0) { - len = ulen/CellSize; - } else { - len = ulen/CellSize; - len++; - } - st[len-1] = 0L; - strncpy((char *)st, c, ulen); + char *c = RepAtom(at)->StrOfAE; + int ulen = strlen(c); + /* fix hashing over empty atom */ + if (!ulen) { + return st; + } + if (ulen % CellSize == 0) { + len = ulen/CellSize; + } else { + len = ulen/CellSize; + len++; + } + st[len-1] = 0L; + strncpy((char *)st, c, ulen); return st+len; } @@ -3788,7 +3301,7 @@ Int Yap_TermHash(Term t, Int size, Int depth, int variant) { CACHE_REGS - unsigned int i1; + unsigned int i1; Term t1 = Deref(t); while (TRUE) { @@ -3933,7 +3446,7 @@ p_instantiated_term_hash( USES_REGS1 ) } static int variant_complex(register CELL *pt0, register CELL *pt0_end, register - CELL *pt1 USES_REGS) + CELL *pt1 USES_REGS) { tr_fr_ptr OLDTR = TR; register CELL **to_visit = (CELL **)ASP; @@ -4022,16 +3535,16 @@ static int variant_complex(register CELL *pt0, register CELL *pt0_end, register continue; } #ifdef RATIONAL_TREES - /* now link the two structures so that no one else will */ - /* come here */ - to_visit -= 4; - if ((CELL *)to_visit < HR+1024) - goto out_of_stack; - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = pt1; - to_visit[3] = (CELL *)*pt0; - *pt0 = d1; + /* now link the two structures so that no one else will */ + /* come here */ + to_visit -= 4; + if ((CELL *)to_visit < HR+1024) + goto out_of_stack; + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = pt1; + to_visit[3] = (CELL *)*pt0; + *pt0 = d1; #else /* store the terms to visit */ if (pt0 < pt0_end) { @@ -4175,7 +3688,7 @@ bool Yap_Variant(Term t1, Term t2) { CACHE_REGS - return is_variant(t1, t2, 0 PASS_REGS); + return is_variant(t1, t2, 0 PASS_REGS); } static Int @@ -4186,7 +3699,7 @@ p_variant( USES_REGS1 ) /* variant terms t1 and t2 */ static int subsumes_complex(register CELL *pt0, register CELL *pt0_end, register - CELL *pt1 USES_REGS) + CELL *pt1 USES_REGS) { register CELL **to_visit = (CELL **)ASP; tr_fr_ptr OLDTR = TR, new_tr; @@ -4415,8 +3928,8 @@ p_subsumes( USES_REGS1 ) /* subsumes terms t1 and t2 */ if (IsPairTerm(t1)) { if (IsPairTerm(t2)) { return(subsumes_complex(RepPair(t1)-1, - RepPair(t1)+1, - RepPair(t2)-1 PASS_REGS)); + RepPair(t1)+1, + RepPair(t2)-1 PASS_REGS)); } else return (FALSE); } else { @@ -4430,8 +3943,8 @@ p_subsumes( USES_REGS1 ) /* subsumes terms t1 and t2 */ return(unify_extension(f1, t1, RepAppl(t1), t2)); } return(subsumes_complex(RepAppl(t1), - RepAppl(t1)+ArityOfFunctor(f1), - RepAppl(t2) PASS_REGS)); + RepAppl(t1)+ArityOfFunctor(f1), + RepAppl(t2) PASS_REGS)); } } @@ -4682,7 +4195,7 @@ p_term_subsumer( USES_REGS1 ) /* term_subsumer terms t1 and t2 */ HB = B->cp_h; return Yap_unify(ARG3,tf); } - } else if (IsApplTerm(t1) && IsApplTerm(t2)) { + } else if (IsApplTerm(t1) && IsApplTerm(t2)) { Functor f1; if ((f1 = FunctorOfTerm(t1)) == FunctorOfTerm(t2)) { @@ -4817,64 +4330,40 @@ extern int vsc; int vsc; +#define RENUMBER_SINGLES\ + if (singles && ap2 >= InitialH && ap2 < HR) {\ + renumbervar(d0, numbv++ PASS_REGS);\ + continue;\ + } + + static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Int numbv, int singles USES_REGS) { int lvl = push_text_stack(); - att_rec_t *to_visit0, *to_visit = Malloc(1024*sizeof(att_rec_t)); - att_rec_t *to_visit_max; + + struct non_single_struct_t + *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), + *to_visit0 = to_visit, + *to_visit_max = to_visit+1024; register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; to_visit0 = to_visit; - to_visit_max = to_visit0+1024; -loop: + to_visit_max = to_visit0+1024; + restart: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; ++ pt0; ptd0 = pt0; d0 = *ptd0; + list_loop: deref_head(d0, vars_in_term_unk); vars_in_term_nvar: { - if (IsPairTerm(d0)) { - if (to_visit + 32 >= to_visit_max) { - goto aux_overflow; - } - to_visit->beg = pt0; - to_visit->end = pt0_end; - to_visit->oval = *pt0; - to_visit ++; - *pt0 = TermNil; - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - } else if (IsApplTerm(d0)) { - Functor f; - CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) { - continue; - } - if (singles && ap2 >= InitialH && ap2 < HR) { - renumbervar(d0, numbv++ PASS_REGS); - continue; - } - /* store the terms to visit */ - if (to_visit + 32 >= to_visit_max) { - goto aux_overflow; - } - to_visit->beg = pt0; - to_visit->end = pt0_end; - to_visit->oval = *pt0; - to_visit ++; - *pt0 = TermNil; - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - } + WALK_COMPLEX_TERM__({},RENUMBER_SINGLES); + continue; } @@ -4904,74 +4393,30 @@ loop: } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { -#ifdef RATIONAL_TREES - to_visit --; - pt0 = to_visit->beg; - pt0_end = to_visit->end; - *pt0 = to_visit->oval; -#else - to_visit -= 2; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; -#endif - goto loop; + to_visit--; + + pt0 = to_visit->pt0; + pt0_end = to_visit->pt0_end; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; + goto restart; } prune(B PASS_REGS); pop_text_stack(lvl); return numbv; - trail_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit --; - pt0 = to_visit->beg; - pt0_end = to_visit->end; - *pt0 = to_visit->oval; - } -#endif - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); - clean_tr(TR0 PASS_REGS); - HR = InitialH; - pop_text_stack(lvl); - return numbv-1; - - aux_overflow: - { - size_t d1 = to_visit-to_visit0; - size_t d2 = to_visit_max-to_visit0; - to_visit0 = Realloc(to_visit0,d2*sizeof(CELL*)+64*1024); - to_visit = to_visit0+d1; - to_visit_max = to_visit0+(d2+(64*1024))/sizeof(CELL **); -} -pt0--; -goto loop; - - global_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit --; - pt0 = to_visit->beg; - pt0_end = to_visit->end; - *pt0 = to_visit->oval; - } -#endif - clean_tr(TR0 PASS_REGS); - HR = InitialH; - LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; - LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); - pop_text_stack(lvl); - return numbv-1; - + def_trail_overflow(); + def_aux_overflow(); + def_global_overflow(); } Int Yap_NumberVars( Term inp, Int numbv, bool handle_singles ) /* - * numbervariables in term t */ + * numbervariables in term t */ { CACHE_REGS - Int out; + Int out; Term t; restart: @@ -4995,7 +4440,7 @@ Yap_NumberVars( Term inp, Int numbv, bool handle_singles ) /* Functor f = FunctorOfTerm(t); out = numbervars_in_complex_term(RepAppl(t), - RepAppl(t)+ + RepAppl(t)+ ArityOfFunctor(f), numbv, handle_singles PASS_REGS); } if (out < numbv) { @@ -5328,7 +4773,7 @@ UnnumberTerm(Term inp, UInt arity, int share USES_REGS) { Term Yap_UnNumberTerm(Term inp, int share) { CACHE_REGS - return UnnumberTerm(inp, 0, share PASS_REGS); + return UnnumberTerm(inp, 0, share PASS_REGS); } static Int @@ -5348,19 +4793,19 @@ Yap_SkipList(Term *l, Term **tailp) s = l; if ( IsPairTerm(*l) ) - { intptr_t power = 1, lam = 0; - do - { if ( power == lam ) - { s = l; - power *= 2; - lam = 0; - } - lam++; - length++; - l = RepPair(*l)+1; - do_derefa(v,l,derefa2_unk,derefa2_nonvar); - } while ( *l != *s && IsPairTerm(*l) ); - } + { intptr_t power = 1, lam = 0; + do + { if ( power == lam ) + { s = l; + power *= 2; + lam = 0; + } + lam++; + length++; + l = RepPair(*l)+1; + do_derefa(v,l,derefa2_unk,derefa2_nonvar); + } while ( *l != *s && IsPairTerm(*l) ); + } *tailp = l; return length; @@ -5483,121 +4928,121 @@ p_reset_variables( USES_REGS1 ) void Yap_InitUtilCPreds(void) { CACHE_REGS - Term cm = CurrentModule; + Term cm = CurrentModule; Yap_InitCPred("copy_term", 2, p_copy_term, 0); -/** @pred copy_term(? _TI_,- _TF_) is iso + /** @pred copy_term(? _TI_,- _TF_) is iso -Term _TF_ is a variant of the original term _TI_, such that for -each variable _V_ in the term _TI_ there is a new variable _V'_ -in term _TF_. Notice that: + Term _TF_ is a variant of the original term _TI_, such that for + each variable _V_ in the term _TI_ there is a new variable _V'_ + in term _TF_. Notice that: -+ suspended goals and attributes for attributed variables in _TI_ are also duplicated; -+ ground terms are shared between the new and the old term. + + suspended goals and attributes for attributed variables in _TI_ are also duplicated; + + ground terms are shared between the new and the old term. -If you do not want any sharing to occur please use -duplicate_term/2. + If you do not want any sharing to occur please use + duplicate_term/2. -*/ + */ Yap_InitCPred("duplicate_term", 2, p_duplicate_term, 0); -/** @pred duplicate_term(? _TI_,- _TF_) + /** @pred duplicate_term(? _TI_,- _TF_) -Term _TF_ is a variant of the original term _TI_, such that -for each variable _V_ in the term _TI_ there is a new variable - _V'_ in term _TF_, and the two terms do not share any -structure. All suspended goals and attributes for attributed variables -in _TI_ are also duplicated. + Term _TF_ is a variant of the original term _TI_, such that + for each variable _V_ in the term _TI_ there is a new variable + _V'_ in term _TF_, and the two terms do not share any + structure. All suspended goals and attributes for attributed variables + in _TI_ are also duplicated. -Also refer to copy_term/2. + Also refer to copy_term/2. -*/ + */ Yap_InitCPred("copy_term_nat", 2, p_copy_term_no_delays, 0); -/** @pred copy_term_nat(? _TI_,- _TF_) + /** @pred copy_term_nat(? _TI_,- _TF_) -As copy_term/2. Attributes however, are not copied but replaced -by fresh variables. + As copy_term/2. Attributes however, are not copied but replaced + by fresh variables. - */ + */ Yap_InitCPred("ground", 1, p_ground, SafePredFlag); -/** @pred ground( _T_) is iso + /** @pred ground( _T_) is iso -Succeeds if there are no free variables in the term _T_. + Succeeds if there are no free variables in the term _T_. -*/ + */ Yap_InitCPred("$variables_in_term", 3, p_variables_in_term, 0); Yap_InitCPred("$free_variables_in_term", 3, p_free_variables_in_term, 0); Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, 0); Yap_InitCPred("term_variables", 2, p_term_variables, 0); -/** @pred term_variables(? _Term_, - _Variables_) is iso + /** @pred term_variables(? _Term_, - _Variables_) is iso -Unify _Variables_ with the list of all variables of term - _Term_. The variables occur in the order of their first -appearance when traversing the term depth-first, left-to-right. + Unify _Variables_ with the list of all variables of term + _Term_. The variables occur in the order of their first + appearance when traversing the term depth-first, left-to-right. -*/ + */ Yap_InitCPred("term_variables", 3, p_term_variables3, 0); Yap_InitCPred("term_attvars", 2, p_term_attvars, 0); -/** @pred term_attvars(+ _Term_,- _AttVars_) + /** @pred term_attvars(+ _Term_,- _AttVars_) - _AttVars_ is a list of all attributed variables in _Term_ and -its attributes. I.e., term_attvars/2 works recursively through -attributes. This predicate is Cycle-safe. + _AttVars_ is a list of all attributed variables in _Term_ and + its attributes. I.e., term_attvars/2 works recursively through + attributes. This predicate is Cycle-safe. -*/ + */ Yap_InitCPred("is_list", 1, p_is_list, SafePredFlag|TestPredFlag); Yap_InitCPred("$is_list_or_partial_list", 1, p_is_list_or_partial_list, SafePredFlag|TestPredFlag); Yap_InitCPred("rational_term_to_tree", 4, p_break_rational, 0); -/** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms) + /** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms) -The term _TF_ is a forest representation (without cycles and repeated -terms) for the Prolog term _TI_. The term _TF_ is the main term. The -difference list _SubTerms_-_MoreSubterms_ stores terms of the form -_V=T_, where _V_ is a new variable occuring in _TF_, and _T_ is a copy -of a sub-term from _TI_. + The term _TF_ is a forest representation (without cycles and repeated + terms) for the Prolog term _TI_. The term _TF_ is the main term. The + difference list _SubTerms_-_MoreSubterms_ stores terms of the form + _V=T_, where _V_ is a new variable occuring in _TF_, and _T_ is a copy + of a sub-term from _TI_. -*/ + */ Yap_InitCPred("term_factorized", 3, p_break_rational3, 0); -/** @pred term_factorized(? _TI_,- _TF_, ?SubTerms) + /** @pred term_factorized(? _TI_,- _TF_, ?SubTerms) -Similar to rational_term_to_tree/4, but _SubTerms_ is a proper list. + Similar to rational_term_to_tree/4, but _SubTerms_ is a proper list. -*/ + */ Yap_InitCPred("=@=", 2, p_variant, 0); Yap_InitCPred("numbervars", 3, p_numbervars, 0); -/** @pred numbervars( _T_,+ _N1_,- _Nn_) + /** @pred numbervars( _T_,+ _N1_,- _Nn_) -Instantiates each variable in term _T_ to a term of the form: -`$VAR( _I_)`, with _I_ increasing from _N1_ to _Nn_. + Instantiates each variable in term _T_ to a term of the form: + `$VAR( _I_)`, with _I_ increasing from _N1_ to _Nn_. -*/ + */ Yap_InitCPred("unnumbervars", 2, p_unnumbervars, 0); -/** @pred unnumbervars( _T_,+ _NT_) + /** @pred unnumbervars( _T_,+ _NT_) -Replace every `$VAR( _I_)` by a free variable. + Replace every `$VAR( _I_)` by a free variable. -*/ + */ /* use this carefully */ Yap_InitCPred("$skip_list", 3, p_skip_list, SafePredFlag|TestPredFlag); Yap_InitCPred("$skip_list", 4, p_skip_list4, SafePredFlag|TestPredFlag); diff --git a/C/yap-args.c b/C/yap-args.c index 19fd28ee3..45eb54fff 100755 --- a/C/yap-args.c +++ b/C/yap-args.c @@ -146,7 +146,7 @@ static void init_globals(YAP_init_args *yap_init) { const char *Yap_BINDIR, *Yap_ROOTDIR, *Yap_SHAREDIR, *Yap_LIBDIR, *Yap_DLLDIR, *Yap_PLDIR, *Yap_BOOTSTRAP, *Yap_COMMONSDIR, *Yap_INPUT_STARTUP, - *Yap_OUTPUT_STARTUP, *Yap_BOOTFILE, *Yap_INCLUDEDIR; + *Yap_OUTPUT_STARTUP, *Yap_SOURCEBOOT, *Yap_INCLUDEDIR, *Yap_PLBOOTDIR; /** * consult loop in C: used to boot the system, butt supports goal execution and @@ -190,14 +190,24 @@ static bool load_file(const char *b_file USES_REGS) { Term vs = MkVarTerm(), pos = MkVarTerm(); t = YAP_ReadClauseFromStream(c_stream, vs, pos); // Yap_GetNèwSlot(t); - if (t == TermEof) + if (t == TermEof) break; if (t == 0) { - fprintf(stderr, "[ SYNTAX ERROR: while parsing stream %s at line %ld ]\n", + fprintf(stderr, "[ %s:%d: error: SYNTAX ERROR\n", b_file, GLOBAL_Stream[c_stream].linecount); - } else if (IsVarTerm(t) || t == TermNil) { - fprintf(stderr, "[ line: " Int_FORMAT ": term cannot be compiled ]", - GLOBAL_Stream[c_stream].linecount); + break; + } +// +// { +// char buu[1024]; +// +// YAP_WriteBuffer(t, buu, 1023, 0); +// fprintf(stderr, "[ %s ]\n" , buu); +// } + + if (IsVarTerm(t) || t == TermNil) { + fprintf(stderr, "[ unbound or []: while parsing %s at line %d ]\n", + GLOBAL_Stream[c_stream].linecount); } else if (IsApplTerm(t) && (FunctorOfTerm(t) == functor_query || FunctorOfTerm(t) == functor_command1)) { t = ArgOfTerm(1, t); @@ -227,9 +237,11 @@ static bool load_file(const char *b_file USES_REGS) { } static const char * EOLIST ="EOLINE"; - + static bool is_install; static bool is_dir( const char *path, const void *info) { + if (is_install) + return true; if (Yap_isDirectory( path )) return true; @@ -245,14 +257,17 @@ static const char * EOLIST ="EOLINE"; i = 1; } s[i] = '\0'; + if (info == NULL) + return true; return strcmp(info,s) == 0 || Yap_isDirectory( s ); } static bool is_file( const char *path, const void *info) { - - return Yap_Exists( path ); + if (is_install) + return true; + return Yap_Exists( path ); } static bool is_wfile( const char *path, const void *info) { @@ -270,34 +285,23 @@ static const char * EOLIST ="EOLINE"; const char *fmt = s1; va_list ap; char *buf = malloc(FILENAME_MAX + 1); -__android_log_print( - ANDROID_LOG_INFO, "YAPDroid", "try %s", s1); va_start(ap, s1); while (fmt != EOLIST) { - __android_log_print( ANDROID_LOG_INFO, "YAPDroid", "loop %s", fmt); - - if (fmt == NULL || fmt[0]=='\0') { + if (fmt == NULL || fmt[0]=='\0') { fmt = va_arg(ap, const char *); continue; } strncpy(buf, fmt, FILENAME_MAX); // Yap_AbsoluteFile(fmt,true), FILENAME_MAX); - __android_log_print( ANDROID_LOG_INFO, "YAPDroid", "triyimh %s", buf); if (test(buf,info)) { - __android_log_print( - ANDROID_LOG_INFO, "YAPDroid", "got %s", buf); - buf = realloc(buf, strlen(buf) + 1); + buf = realloc(buf, strlen(buf) + 1); va_end(ap); return buf; } - __android_log_print( - ANDROID_LOG_INFO, "YAPDroid", "tried %s, failed", buf); - fmt = va_arg(ap, const char *); + fmt = va_arg(ap, const char *); } - __android_log_print( - ANDROID_LOG_INFO, "YAPDroid", "failed search "); - va_end(ap); + va_end(ap); free(buf); return NULL; } @@ -311,14 +315,23 @@ static const char *join(const char *s0, const char *s1) { if (!s1 || s1[0] == '\0') return s0; // int lvl = push_text_stack(); - char *buf = malloc(FILENAME_MAX + 1); + char *buf = malloc(strlen(s0)+strlen(s1) + 2); strcpy(buf, s0); + if (Yap_dir_separator(s0[strlen(s0)-1])) { + if (Yap_dir_separator(s1[0])) { + s1 += 1; + } + } else { + if (!Yap_dir_separator(s1[0]-1)) { + strcat(buf, "/"); + } + } strcat(buf, s1); return buf; } static void Yap_set_locations(YAP_init_args *iap) { - +is_install= iap->install; /// ROOT_DIR is the home of the YAP system. It can be: /// -- provided by the user; /// -- obtained from DESTDIR + DE=efalkRoot @@ -328,8 +341,10 @@ static void Yap_set_locations(YAP_init_args *iap) { /// -- DESTDIR/ in Anaconda /// -- /usr/locall in most Unix style systems Yap_ROOTDIR = sel( is_dir, NULL, - iap->ROOTDIR, - getenv("YAPROOTDIR"), + iap->ROOTDIR, + getenv("YAPROOTDIR"), + join(getenv("DESTDIR"), YAP_ROOTDIR), + #if __ANDROID__ "/", #else @@ -341,14 +356,16 @@ static void Yap_set_locations(YAP_init_args *iap) { #endif EOLIST ); + __android_log_print( + ANDROID_LOG_INFO,"YAPDroid", "Yap_ROOTDIR %s", Yap_ROOTDIR); - /// BINDIR: where the OS stores header files, namely libYap... + /// BINDIR: where the OS stores header files, namely libYap... Yap_BINDIR = sel( is_dir, Yap_ROOTDIR, iap->BINDIR, getenv("YAPBINDIR"), #if !defined(__ANDROID__) join(getenv("DESTDIR"), YAP_BINDIR), #endif - join(Yap_ROOTDIR, "/bin"), + join(Yap_ROOTDIR, "bin"), EOLIST); /// LIBDIR: where the OS stores dynamic libraries, namely libYap... @@ -356,16 +373,14 @@ static void Yap_set_locations(YAP_init_args *iap) { #if !defined(__ANDROID__) join(getenv("DESTDIR"), YAP_LIBDIR), #endif - join(Yap_ROOTDIR, "/lib"), + join(Yap_ROOTDIR, "lib"), EOLIST); /// DLLDIR: where libraries can find expicitely loaded DLLs Yap_DLLDIR = sel(is_dir, Yap_LIBDIR, iap->DLLDIR, getenv("YAPLIBDIR"), -#if !defined(__ANDROID__) - join(getenv("DESTDIR"), YAP_DLLDIR), - join(Yap_LIBDIR, "/yap"), -#endif + join(getenv("DESTDIR"), YAP_DLLDIR), + join(Yap_LIBDIR, "/Yap"), EOLIST); /// INCLUDEDIR: where the OS stores header files, namely libYap... @@ -373,79 +388,74 @@ static void Yap_set_locations(YAP_init_args *iap) { #if !defined(__ANDROID__) join(getenv("DESTDIR"), YAP_INCLUDEDIR), #endif - join(Yap_ROOTDIR, "/include"), + join(Yap_ROOTDIR, "include"), EOLIST); - /// SHAREDIR: where OS & ARCH independent files live + + /// SHAREDIR: where OS & ARCH independent files live Yap_SHAREDIR = sel( is_dir, Yap_ROOTDIR, iap->SHAREDIR, getenv("YAPSHAREDIR"), -#if !defined(__ANDROID__) - join(getenv("DESTDIR"), YAP_SHAREDIR), - join(Yap_ROOTDIR, "/share"), +#if __ANDROID__ + "/data/data/pt.up.yap/files", "/assets", #endif - join(Yap_ROOTDIR, "/files"), + join(getenv("DESTDIR"), YAP_SHAREDIR), + join(Yap_ROOTDIR, "share"), + join(Yap_ROOTDIR, "files"), EOLIST); - /// PLDIR: where we can find Prolog files + __android_log_print( + ANDROID_LOG_INFO,"YAPDroid", "Yap_SHAREDIR %s", Yap_SHAREDIR); + + + + /// PLDIR: where we can find Prolog files Yap_PLDIR = sel( is_dir, Yap_SHAREDIR, iap->PLDIR, -#if __ANDROID__ - YAP_PLDIR, - "/assets/Yap", -#else - join(getenv("DESTDIR"), YAP_PLDIR), - join(Yap_SHAREDIR, "/Yap"), -#endif + join(getenv("DESTDIR"), join(Yap_SHAREDIR, "Yap")), + join(getenv("DESTDIR"), YAP_PLDIR), EOLIST); - /// ``COMMONSDIR: Prolog Commons + + __android_log_print( + ANDROID_LOG_INFO, "YAPDroid","Yap_PLDIR %s", Yap_PLDIR); + + /// ``COMMONSDIR: Prolog Commons Yap_COMMONSDIR = sel(is_dir, Yap_SHAREDIR, iap->COMMONSDIR, -#if __ANDROID__ - "/assets/PrologCommons", -#else - join(getenv("DESTDIR"), YAP_SHAREDIR "/PrologCommons"), - join(Yap_SHAREDIR, "PrologCommons"), -#endif - EOLIST); - /// BOOTPLDIR: where we can find Prolog bootstrap files - Yap_BOOTSTRAP = sel( is_file, NULL, iap->BOOTSTRAP, - YAP_BOOTSTRAP, - EOLIST); - /// BOOTFILE: where we can find the core Prolog boot file - -const char * Yap_PLBOOTDIR = sel( is_dir, Yap_PLDIR, -#if __ANDROID__ - "/assets/Yap/pl", -#else - join(Yap_PLDIR, "/pl"), -#endif - EOLIST); - - Yap_BOOTFILE = sel( is_wfile, Yap_PLBOOTDIR, iap->BOOTFILE, -#if __ANDROID__ - "/assets/Yap/pl/boot.yap", -#else - join(Yap_PLBOOTDIR, "/boot.yap"), -#endif - EOLIST); + join(getenv("DESTDIR"), join(Yap_SHAREDIR, "PrologCommons")), + EOLIST); + /// SOURCEBOOT: booting from the Prolog boot file at compilation-time so we should not assume pl is installed. + Yap_SOURCEBOOT = sel( is_file, Yap_AbsoluteFile("pl",false), iap->SOURCEBOOT, + YAP_SOURCEBOOT, + "boot.yap", + EOLIST); + __android_log_print( + ANDROID_LOG_INFO, "YAPDroid","Yap_SOURCEBOOT %s", Yap_SOURCEBOOT); + Yap_PLBOOTDIR = sel( is_dir, Yap_PLDIR, iap->BOOTDIR, + join(getenv("DESTDIR"),join(Yap_PLDIR, "pl")), + EOLIST); + __android_log_print( + ANDROID_LOG_INFO, "YAPDroid","Yap_BOOTSTRAP %s", Yap_BOOTSTRAP); +/// BOOTSTRAP: booting from the Prolog boot file after YAP is installed + Yap_BOOTSTRAP = sel( is_file, Yap_PLBOOTDIR, iap->BOOTSTRAP, + join(getenv("DESTDIR"),YAP_BOOTSTRAP), + join(getenv("DESTDIR"),join(Yap_PLBOOTDIR, "boot.yap")), + EOLIST); + __android_log_print( + ANDROID_LOG_INFO,"YAPDroid", "Yap_BOOTSTRAP %s", Yap_PLBOOTDIR); /// STARTUP: where we can find the core Prolog bootstrap file Yap_OUTPUT_STARTUP = - sel( is_wfile, Yap_AbsoluteFile(".",false), iap->OUTPUT_STARTUP, -#if defined(__ANDROID__) -EOLIST, -#else - YAP_OUTPUT_STARTUP, -#endif - "startup.yss", -EOLIST); + sel( is_wfile, ".", iap->OUTPUT_STARTUP, + YAP_OUTPUT_STARTUP, + join(getenv("DESTDIR"), join(Yap_DLLDIR, "startup.yss")), + join(getenv("DESTDIR"), join(Yap_DLLDIR,iap->OUTPUT_STARTUP)), + "startup.yss", + EOLIST); Yap_INPUT_STARTUP = sel( is_file, Yap_DLLDIR, iap->INPUT_STARTUP, "startup.yss", -#if __ANDROID__ -EOLIST, -#else + join(getenv("DESTDIR"), join(Yap_DLLDIR, "startup.yss")), +#if !defined(__ANDROID__) join(getenv("DESTDIR"), YAP_INPUT_STARTUP), #endif - join(Yap_DLLDIR, "/startup.yss"), "/usr/local/lib/Yap/startup.yss", "/usr/lib/Yap/startup.yss", EOLIST); @@ -464,6 +474,7 @@ EOLIST, static void print_usage(void) { fprintf(stderr, "\n[ Valid switches for command line arguments: ]\n"); fprintf(stderr, " -? Shows this screen\n"); + fprintf(stderr, " -B Used during compilation: boot from ../pl/boot.yap and generate a saved state. \n"); fprintf(stderr, " -b Boot file \n"); fprintf(stderr, " -dump-runtime-variables\n"); fprintf(stderr, " -f initialization file or \"none\"\n"); @@ -562,10 +573,10 @@ X_API YAP_file_type_t Yap_InitDefaults(void *x, char *saved_state, int argc, iap->Argc = argc; iap->Argv = argv; #if __ANDROID__ - iap->boot_file_type = YAP_BOOT_PL; + iap->boot_file_type = YAP_PL; iap->INPUT_STARTUP = NULL; iap->assetManager = NULL; - return YAP_BOOT_PL; + return YAP_PL; #else iap->boot_file_type = YAP_QLY; iap->INPUT_STARTUP = saved_state; @@ -574,14 +585,13 @@ X_API YAP_file_type_t Yap_InitDefaults(void *x, char *saved_state, int argc, } /** - * @short Paese command line + * @short Parse command line * @param argc number of arguments * @param argv arguments * @param iap options, see YAP_init_args * @return boot from saved state or restore; error */ -X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[], - YAP_init_args *iap) { +X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap) { char *p; size_t *ssize; @@ -593,18 +603,18 @@ X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[], case 'b': iap->boot_file_type = YAP_PL; if (p[1]) - iap->BOOTFILE = p + 1; + iap->BOOTSTRAP = p + 1; else if (argv[1] && *argv[1] != '-') { - iap->BOOTFILE = *++argv; + iap->BOOTSTRAP = *++argv; argc--; } break; case 'B': - iap->boot_file_type = YAP_BOOT_PL; + iap->boot_file_type = YAP_SOURCE_PL; if (p[1]) - iap->BOOTSTRAP = p + 1; + iap->SOURCEBOOT = p + 1; else if (argv[1] && *argv[1] != '-') { - iap->BOOTSTRAP = *++argv; + iap->SOURCEBOOT = *++argv; argc--; } iap->install = true; @@ -1086,6 +1096,7 @@ static void end_init(YAP_init_args *iap) { Yap_exit(0); LOCAL_PrologMode &= ~BootMode; CurrentModule = USER_MODULE; + LOCAL_SourceModule = USER_MODULE; } static void start_modules(void) { @@ -1103,7 +1114,8 @@ static void start_modules(void) { X_API void YAP_Init(YAP_init_args *yap_init) { bool try_restore = yap_init->boot_file_type == YAP_QLY; - bool do_bootstrap = yap_init->boot_file_type == YAP_BOOT_PL; + bool do_bootstrap = yap_init->boot_file_type == YAP_PL || + yap_init->boot_file_type == YAP_SOURCE_PL; struct ssz_t minfo; __android_log_print( ANDROID_LOG_INFO, "YAPDroid", "start init "); @@ -1123,8 +1135,9 @@ X_API void YAP_Init(YAP_init_args *yap_init) { // CACHE_REGS + CurrentModule = PROLOG_MODULE; - if (yap_init->QuietMode) { + if (yap_init->QuietMode) { setVerbosity(TermSilent); } if (yap_init->PrologRCFile != NULL) { @@ -1141,21 +1154,29 @@ X_API void YAP_Init(YAP_init_args *yap_init) { if (Yap_INPUT_STARTUP==NULL) try_restore = false; - if (do_bootstrap || !try_restore || + if (do_bootstrap || !try_restore || !Yap_SavedInfo(Yap_INPUT_STARTUP, &minfo.Trail, &minfo.Stack, &minfo.Heap)) { init_globals(yap_init); start_modules(); - CurrentModule = PROLOG_MODULE; - TermEof = MkAtomTerm(Yap_LookupAtom("end_of_file")); + TermEof = MkAtomTerm(Yap_LookupAtom("end_of_file")); LOCAL_consult_level = -1; __android_log_print( ANDROID_LOG_INFO, "YAPDroid", "init %s ", Yap_BOOTSTRAP); - load_file(Yap_BOOTSTRAP PASS_REGS); - setAtomicGlobalPrologFlag(RESOURCE_DATABASE_FLAG, - MkAtomTerm(Yap_LookupAtom(Yap_BOOTFILE))); - setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, false); + if (yap_init->install) { + load_file(Yap_SOURCEBOOT PASS_REGS); + setAtomicGlobalPrologFlag(RESOURCE_DATABASE_FLAG, + MkAtomTerm(Yap_LookupAtom(Yap_SOURCEBOOT))); + } + else { + load_file(Yap_BOOTSTRAP PASS_REGS); + setAtomicGlobalPrologFlag(RESOURCE_DATABASE_FLAG, + MkAtomTerm(Yap_LookupAtom(Yap_BOOTSTRAP))); + } + + CurrentModule = LOCAL_SourceModule = TermUser; + setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, false); } else { if (yap_init->QuietMode) { setVerbosity(TermSilent); @@ -1163,6 +1184,7 @@ X_API void YAP_Init(YAP_init_args *yap_init) { __android_log_print( ANDROID_LOG_INFO, "YAPDroid", "restore %s ",Yap_INPUT_STARTUP ); Yap_Restore(Yap_INPUT_STARTUP); + CurrentModule = LOCAL_SourceModule = TermUser; init_globals(yap_init); start_modules(); diff --git a/CMakeLists.txt b/CMakeLists.txt index 10fe55339..2c332760c 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -83,8 +83,9 @@ endif () ## options: libraries option(WITH_THREADED_CODE "threaded code" ON) +if (NOT ANDROID) option(WITH_MPI "Interface to OpenMPI/MPICH" ON) -option(WITH_READLINE "use readline or libedit" ON) + endif() option(WITH_JIT "just in Time Clause Compilation" OFF) if (APPLE) @@ -121,7 +122,7 @@ if (APPLE) GET_FILENAME_COMPONENT(MACPORTS_PREFIX ${MACPORTS_PREFIX} DIRECTORY) # "/opt/local/bin" doesn't have libs, so we get the parent directory - GET_FILENAME_COMPONENT(MACPORTS_PREFIX ${MACPORTS_PREFIX} DIRECTORY) + GET_FILENAME_COMPONENT(MACPORTS_PREFIX ${MACPORTS_PssREFIX} DIRECTORY) # "/opt/local" is where MacPorts lives, add `/lib` suffix and link LINK_DIRECTORIES(${LINK DIRECTORIES} ${MACPORTS_PREFIX}/lib) @@ -131,19 +132,35 @@ if (APPLE) endif() endif() -option (WITH_PACKAGES "packages and liaries that add value to YAP" ON) +OPTION(WITH_MYDDAS " Enable MYDDAS DBMS interface" ON) -OPTION(WITH_MYDDAS " Enable MYDDAS driver" ${WITH_PACKAGES}) -OPTION(WITH_SQLITE3 " Enable MYDDAS SQLITE3 driver" ${WITH_MYDDAS}) -OPTION(WITH_MYSQL " Enable MYDDAS MYSQL driver" ${WITH_MYDDAS}) +if (ANDROID) +option (WITH_PACKAGES "packages and libraries that add value to YAP" OFF) +OPTION(WITH_SWIG " Enable SWIG interfaces to foreign languages" ON) +OPTION(WITH_SQLITE3 " Enable MYDDAS SQLITE3 driver" ON) +else() + option (WITH_PACKAGES "packages and libraries that add value to YAP" ON) + OPTION(WITH_SWIG " Enable SWIG interfaces to foreign languages" ${WITH_PACKAGES}) + OPTION(WITH_SQLITE3 " Enable MYDDAS SQLITE3 driver" ${WITH_PACKAGES}) +endif() + OPTION(WITH_MYSQL " Enable MYDDAS MYSQL driver" ${WITH_MYDDAS}}) OPTION(WITH_ODBC " Enable MYDDAS ODBC driver" ${WITH_MYDDAS}) OPTION(WITH_POSTGRES " Enable MYDDAS POSTGRES driver" ${WITH_MYDDAS}) -OPTION(WITH_SQLITE3 " Enable MYDDAS SQLITE3 driver" ${WITH_MYDDAS}) -OPTION(WITH_SWIG " Enable SWIG interfaces to foreign languages" ${WITH_PACKAGES}) + + + +IF (WITH_SWIG) + find_host_package(SWIG) + # macro_log_feature (SWIG_FOUND "Swig" + # "Use SWIG Interface Generator " + # "http://www.swig.org" ON) + +ENDIF (WITH_SWIG) + OPTION(WITH_RAPTOR " Enable the RAPTOR RDF library" ${WITH_PACKAGES}) OPTION(WITH_XML2 " Enable the RAPTOR XML2 library" ${WITH_PACKAGES}) OPTION(WITH_XML " Enable the Prolog XML library" ${WITH_PACKAGES}) -OPTION(WITH_CLPBN" Enable the CLPBN and PFL probabilistic languages" ${WITH_PACKAGES}) +OPTION(WITH_CLPBN " Enable the CLPBN and PFL probabilistic languages" ${WITH_PACKAGES}) OPTION(WITH_HORUS " Enable the HORUS inference libraray for CLPBN and PFL" ${WITH_CLPBN}) option(WITH_PROBLOG "include Problog-I." ${WITH_PACKAGES}) OPTION(WITH_CPLINT " Enable the cplint probabilistic language" ${WITH_PACKAGES}) @@ -165,21 +182,16 @@ if (POLICY CMP0042) cmake_policy(SET CMP0042 NEW) endif () -function(add_to_group list output) - set(tmp ${${output}}) - foreach (path ${${list}}) - get_source_file_property(path ${path} LOCATION) - list(APPEND tmp ${path}) - endforeach () - set(${output} ${tmp} CACHE INTERNAL "prolog library files") -endfunction(add_to_group list output) +if (ANDROID) +function(add_to_dir list output) + endfunction(add_to_dir list output) function(add_to_libgroup el list) # add_custom_command( TARGET ${el} POST_BUILD # COMMAND ${CMAKE_COMMAND} -E copy $ ${CMAKE_BINARY_DIR}/packages/python/swig/yap4py # DEPENDS ${el} ) - list(APPEND ${list} ${${el}}) - set(${list} ${${list}} CACHE INTERNAL "prolog dll files") + #list(APPEND ${list} ${${el}}) + #set(${list} ${${list}} CACHE INTERNAL "prolog dll files") endfunction(add_to_libgroup el list) @@ -191,6 +203,11 @@ function(add_to_corelibgroup el list) set(${list} ${${list}} CACHE INTERNAL "prolog dll files") endfunction(add_to_corelibgroup el list) +else() + function(add_to_dir list output) + endfunction(add_to_dir list output) + +endif() if (ANDROID_OLD) macro(MY_add_custom_target) @@ -210,10 +227,6 @@ else () add_library(${arg1} OBJECT ${ARGN}) endmacro() endif () -macro(add_lib arg1) - add_library(${arg1} SHARED ${ARGN}) - add_to_libgroup(${arg1} YAP_DLLS) -endmacro() macro(add_corelib arg1) add_library(${arg1} SHARED ${ARGN}) add_to_corelibgroup(${arg1} YAP_DLLS) @@ -294,7 +307,7 @@ disallow_intree_builds() # set(CMAKE_BUILD_TYPE Debug) -if ($ENV{CONDA_BUILD}x STREQUAL "1x" ) + if ($ENV{CONDA_BUILD}x STREQUAL "1x" ) set(CMAKE_LIBRARY_ARCHITECTURE $ENV{PREFIX}) set(CMAKE_PREFIX_PATH $ENV{PREFIX}) set( R_COMMAND "$ENV{R}") @@ -311,7 +324,6 @@ ADD_CUSTOM_TARGET(run_install COMMAND ${CMAKE_MAKE_PROGRAM} install) - set(prefix ${CMAKE_INSTALL_PREFIX}) #BINDIR}) set(docdir ${CMAKE_INSTALL_PREFIX}/share/docs) #MANDIR}) @@ -327,8 +339,11 @@ set(YAP_PLDIR ${CMAKE_INSTALL_FULL_DATADIR}/Yap) set(YAP_INSTALL_INCLUDEDIR ${CMAKE_INSTALL_INCLUDEDIR}/Yap) set(YAP_INSTALL_LIBDIR ${CMAKE_INSTALL_LIBDIR}/Yap) +if (ANDROID) +set(YAP_INSTALL_DATADIR ${CMAKE_SOURCE_DIR}/../yaplib/src/generated/assets/Yap) + else() set(YAP_INSTALL_DATADIR ${CMAKE_INSTALL_DATADIR}/Yap) - +endif() # # # include( Sources ) @@ -350,7 +365,12 @@ find_package(GMP) list(APPEND YAP_SYSTEM_OPTIONS big_numbers) +include_directories(H + H/generated + include os OPTYap utf8proc JIT/HPP) +include_directories(BEFORE ${CMAKE_BINARY_DIR} ${CMAKE_TOP_BINARY_DIR}) +add_subdirectory( H ) if (GMP_INCLUDE_DIRS) #config.h needs this (TODO: change in code latter) @@ -520,6 +540,7 @@ endif (HAVE_GCC) # #option (YAP_SWI_IO ON) +#TODO: #TODO: if (WITH_CALL_TRACER) list(APPEND YAP_SYSTEM_OPTIONS "call_tracer " ${YAP_SYSTEM_OPTIONS}) @@ -528,41 +549,9 @@ endif (WITH_CALL_TRACER) set_property(DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS UTF8PROC=1) -include_directories(utf8proc packages/myddas packages/myddas/sqlite3/src ) - set_property(SOURCE ${LIBYAP_SOURCES} APPEND PROPERTY COMPILE_DEFINITIONS YAP_KERNEL=1) -IF (WITH_SWIG) - find_host_package(SWIG) - # macro_log_feature (SWIG_FOUND "Swig" - # "Use SWIG Interface Generator " - # "http://www.swig.org" ON) -ENDIF (WITH_SWIG) - -IF (WITH_MYDDAS) - if (ANDROID) - include_directories (packages/swig/android) - else() - - add_definitions(-DUSE_MYDDAS=1 -DMYDDAS_SQLITE3=1) - - if (MYSQL_FOUND) - add_definitions(= -DMYDDAS_MYSQL=1) - endif () - - if (ODBC_FOUND) - add_definitions(= -DMYDDAS_ODBC=1) - endif () - - if (MYSQL_POSTGRES) - add_definitions(= -DMYDDAS_POSTGRES=1) - endif () - endif(ANDROID) -endif(WITH_MYDDAS) - - - IF (WITH_PYTHON) include(python ) ENDIF (WITH_PYTHON) @@ -574,6 +563,46 @@ IF (WITH_R) ENDIF (WITH_R) +include(Sources) + + +ADD_SUBDIRECTORY(OPTYap) +ADD_SUBDIRECTORY(os) +ADD_SUBDIRECTORY(library/dialect/swi/fli) +ADD_SUBDIRECTORY(CXX) + +add_subDIRECTORY(utf8proc ) + + if(ANDROID) + + set(CXX_SWIG_OUTDIR ${CMAKE_BINARY_DIR}/packages/swig/android) + add_subdirectory(packages/swig/android) + add_definitions(-DMYDDAS=1 -DEMBEDDED_MYDDAS=1 -DMYDDAS_SQLITE3=1 -DEMBEDDED_SQLITE3=1) + link_directories(${CMAKE_SOURCE_DIR}/../sqlite-android/jni/${CMAKE_ANDROID_ARCH_ABI}) + + else() + add_definitions(-DMYDDAS=1 -DEMBEDDED_MYDDAS=1 -DMYDDAS_SQLITE3=1 ) + +endif() + if (MYSQL_FOUND) + add_definitions( -DMYDDAS_MYSQL=1) + endif () + + if (ODBC_FOUND) + add_definitions( -DMYDDAS_ODBC=1) + endif () + + if (POSTGRES_FOUND) + add_definitions( -DMYDDAS_POSTGRES=1) + endif() +#utf-8 is not aPconn option +# we use the nice UTF-8 package +#available at the Julia project + + +add_subDIRECTORY( packages/myddas ) + + List(APPEND YLIBS $) List(APPEND YLIBS $) List(APPEND YLIBS $) @@ -586,22 +615,20 @@ if (WIN32 OR ANDROID) endif () if (ANDROID) List(APPEND YLIBS $) - List(APPEND YLIBS $) + List(APPEND YLIBS $) + endif () endif () -include(Sources) - -add_corelib( # Sets the name of the library. +add_library( # Sets the name of the library. libYap # Sets the library as a shared library. SHARED - ${ENGINE_SOURCES} ${C_INTERFACE_SOURCES} - //${STATIC_SOURCES} + ${STATIC_SOURCES} # cmake object libraries ${YLIBS} ) @@ -616,18 +643,30 @@ if (READLINE_FOUND) endif () +if (ANDROID) + target_link_libraries(libYap sqliteX android log) +endif() + if (WIN32) target_link_libraries(libYap ${WINDLLS}) if (WITH_PYTHON AND PYTHON_INCLUDE_DIRS AND PYTHON_LIBRARIES) target_link_libraries(libYap ${PYTHON_LIBRARIES}) endif () + + if (WITH_PYTHON AND PYTHON_INCLUDE_DIRS AND PYTHON_LIBRARIES) + target_link_libraries(libYap ${PYTHON_LIBRARIES}) + endif () endif (WIN32) target_link_libraries(libYap m) + set_target_properties(libYap + PROPERTIES OUTPUT_NAME Yap + ) + set(YAP_STARTUP startup.yss) -set(YAP_BOOTFILE boot.yap ) +set(YAP_SOURCEBOOT boot.yap ) ## define system # Optional libraries that affect compilation @@ -646,13 +685,8 @@ string(SUBSTRING ${CMAKE_SHARED_LIBRARY_SUFFIX} 1 -1 SO_EXT) set_property(DIRECTORY PROPERTY CXX_STANDARD 11) -include_directories(H - H/generated - include os OPTYap utf8proc JIT/HPP) -include_directories(BEFORE ${CMAKE_BINARY_DIR} ${CMAKE_TOP_BINARY_DIR}) - if (ANDROID) - include_directories(CXX ${CMAKE_SOURCE_DIR}/../generated/src/jni) + include_directories(CXX ${CMAKE_SOURCE_DIR}/yaplib/../generated/src/jni) endif () include(Threads) # @@ -672,30 +706,6 @@ MY_set_target_properties(libYap ) -#utf-8 is not aPconn option -# we use the nice UTF-8 package -#available at the Julia project - -ADD_SUBDIRECTORY(OPTYap) -ADD_SUBDIRECTORY(os) -ADD_SUBDIRECTORY(packages/myddas) -ADD_SUBDIRECTORY(utf8proc) -ADD_SUBDIRECTORY(library/dialect/swi/fli) -ADD_SUBDIRECTORY(CXX) - - -add_subDIRECTORY(H) - -#bootstrap and saved state -add_subDIRECTORY(pl) - -ADD_SUBDIRECTORY(library) - -ADD_SUBDIRECTORY(swi/library "swiLibrary") - -set_target_properties(libYap - PROPERTIES OUTPUT_NAME Yap - ) # file(MAKE_DIRECTORY ${CMAKE_BINARY_DIR}/packages/python/swig/yap4py) @@ -717,20 +727,6 @@ if (WITH_PYTHON AND PYTHONLIBS_FOUND AND SWIG_FOUND) endif () -IF ( ANDROID) - set(CMAKE_SWIG_OUTDIR ${YAP_APP_DIR}/src/generated/java/pt/up/yap/lib ) - set(CMAKE_SWIG_OUTPUT ${YAP_APP_DIR}/src/generated/jni ) - set( SWIG_MODULE_NAME pt.up.yap.lib ) - - add_subDIRECTORY(packages/swig ) - - - - - target_link_libraries(libYap ${CMAKE_SOURCE_DIR}/../sqlite-android/jni/${ANDROID_ABI}/libsqliteX.so android log ) - -ENDIF () - message(STATUS "Building YAP packages version ${YAP_VERSION}") @@ -897,7 +893,7 @@ endif() #todo: use cmake target builds # option (USE_MAXPERFORMANCE -# "try using the best flags for specific architecture" OFF) +# "try using the best flags for specific architecture" ON) # option (USE_MAXMEMORY # "try using the best flags for using the memory to the most" ON) @@ -905,11 +901,11 @@ endif() #TODO: use cmake target builds # option (USE_DEBUGYAP -# "enable C-debugging for YAP" OFF) +# "enable C-debugging for YAP" ON) #TODO: use cmake arch/compiler # option (USE_CYGWIN -# "use cygwin library in WIN32" OFF) +# "use cygwin library in WIN32" ON) #TODO: @@ -987,8 +983,6 @@ endif(WITH_MPI) install(FILES ${INCLUDE_HEADERS} ${CONFIGURATION_HEADERS} DESTINATION ${CMAKE_INSTALL_INCLUDEDIR}/Yap ) - - macro_display_feature_log() if (POLICY CMP0058) cmake_policy(SET CMP0058 NEW) diff --git a/CXX/CMakeLists.txt b/CXX/CMakeLists.txt index ee974f924..1002365fc 100644 --- a/CXX/CMakeLists.txt +++ b/CXX/CMakeLists.txt @@ -14,7 +14,7 @@ if ( WIN32 OR ANDROID) set_property( DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS "_YAP_NOT_INSTALLED_=1;HAVE_CONFIG_H=1;_GNU_SOURCE;YAP_KERNEL=1" ) else() - add_lib(YAP++ ${CXX_SOURCES} ) + add_library(YAP++ ${CXX_SOURCES} ) if (WITH_PYTHON) target_link_libraries(YAP++ Py4YAP ) endif() diff --git a/CXX/yapi.cpp b/CXX/yapi.cpp index cff2c3d47..076c88054 100644 --- a/CXX/yapi.cpp +++ b/CXX/yapi.cpp @@ -599,11 +599,12 @@ bool YAPEngine::mgoal(Term t, Term tmod, bool release) { q.CurSlot = Yap_StartSlots(); q.p = P; q.cp = CP; + Term omod = CurrentModule; PredEntry *ap = nullptr; if (IsStringTerm(tmod)) tmod = MkAtomTerm(Yap_LookupAtom(StringOfTerm(tmod))); - YAPPredicate *p = new YAPPredicate(t, tmod, ts, "C++"); - if (p == nullptr || (ap = p->ap) == nullptr || + ap = Yap_get_pred(t, tmod, "C++"); + if (ap == nullptr || ap->OpcodeOfPred == UNDEF_OPCODE) { ap = rewriteUndefEngineQuery(ap, t, tmod); } @@ -627,6 +628,7 @@ bool YAPEngine::mgoal(Term t, Term tmod, bool release) { // std::cerr << "mgoal " << YAPTerm(tmod).text() << ":" << YAPTerm(t).text() << "\n"; YAP_LeaveGoal(result && !release, &q); + CurrentModule = LOCAL_SourceModule = omod; // PyEval_RestoreThread(_save); RECOVER_MACHINE_REGS(); return result; @@ -801,6 +803,7 @@ PredEntry *YAPQuery::rewriteUndefQuery() { PredEntry *YAPEngine::rewriteUndefEngineQuery(PredEntry *a, Term &tgoal, Term mod) { tgoal = Yap_MkApplTerm(FunctorCall, 1, &tgoal); + LOCAL_ActiveError->errorNo = YAP_NO_ERROR; return PredCall; // return YAPApplTerm(FunctorUndefinedQuery, ts); @@ -919,6 +922,7 @@ void YAPEngine::doInit(YAP_file_type_t BootMode, YAPEngineArgs *engineArgs) { // initq.cut(); // } CurrentModule = TermUser; + LOCAL_SourceModule = TermUser; } YAPEngine::YAPEngine(int argc, char *argv[], diff --git a/CXX/yapq.hh b/CXX/yapq.hh index c7a96a9f7..2616bcfdb 100644 --- a/CXX/yapq.hh +++ b/CXX/yapq.hh @@ -94,7 +94,7 @@ public: /// should be a callable /// goal. inline YAPQuery(const char *s) : YAPPredicate(s, goal, names, (nts = &ARG1)) { - __android_log_print(ANDROID_LOG_INFO, "YAPDroid", "got game %ld", + __android_log_print(ANDROID_LOG_INFO, "YAPDroid", "got game %d", LOCAL_CurSlot); openQuery(); @@ -175,11 +175,11 @@ struct X_API YAPEngineArgs : YAP_init_args { public: YAPEngineArgs() { + memset(this,0,sizeof(YAPEngineArgs)); // const std::string *s = new std::string("startup.yss"); Embedded = true; install = false; - - Yap_InitDefaults(this, nullptr, 0, nullptr); + Yap_InitDefaults(&this->start, nullptr, 0, nullptr); #if YAP_PYTHON Embedded = true; python_in_python = Py_IsInitialized(); @@ -231,12 +231,12 @@ public: inline const char *getOUTPUT_STARTUP() { return OUTPUT_STARTUP; }; - inline void setBOOTFILE(const char *fl) { - BOOTFILE = (const char *)malloc(strlen(fl) + 1); - strcpy((char *)BOOTFILE, fl); + inline void setSOURCEBOOT(const char *fl) { + SOURCEBOOT = (const char *)malloc(strlen(fl) + 1); + strcpy((char *)SOURCEBOOT, fl); }; - inline const char *getBOOTFILE() { return BOOTFILE; }; + inline const char *getSOURCEBOOT() { return SOURCEBOOT; }; inline void setPrologBOOTSTRAP(const char *fl) { BOOTSTRAP = (const char *)malloc(strlen(fl) + 1); @@ -298,7 +298,7 @@ public: __android_log_print( ANDROID_LOG_INFO, "YAPDroid", "start engine "); #ifdef __ANDROID__ - doInit(YAP_BOOT_PL, cargs); + doInit(YAP_PL, cargs); #else doInit(YAP_QLY, cargs); @@ -352,7 +352,8 @@ public: bool mgoal(Term t, Term tmod, bool release = false); /// current directory for the engine - bool goal(Term t, bool release = false) { + bool goal(YAPTerm t, bool release = false) { return goal(t.term(), release); } + bool goal(Term t, bool release = false) { return mgoal(t, Yap_CurrentModule(), release); } /// reset Prolog state diff --git a/H/CMakeLists.txt b/H/CMakeLists.txt index 546484dea..36a9e5da6 100644 --- a/H/CMakeLists.txt +++ b/H/CMakeLists.txt @@ -12,10 +12,10 @@ string(REGEX REPLACE "^LOCAL[^(]*[(][ \t]*([^,]+)[ \t]*,[ \t]*([^),]+).*" "#de list( APPEND tmp2 ${i2} "\n") endforeach() endif() -file( WRITE ${CMAKE_TOP_BINARY_DIR}/dlocals.h ${tmp2}) +file( WRITE ${CMAKE_BINARY_DIR}/dlocals.h ${tmp2}) -add_custom_command( OUTPUT ${CMAKE_TOP_BINARY_DIR}/dlocals.h - COMMAND ${CMAKE_COMMAND} -E COPY ${CMAKE_TOP_BINARY_DIR}/deflocals.h ${CMAKE_TOP_BINARY_DIR}/dlocals.h +add_custom_command( OUTPUT ${CMAKE_BINARY_DIR}/dlocals.h + COMMAND ${CMAKE_COMMAND} -E COPY ${CMAKE_BINARY_DIR}/deflocals.h ${CMAKE_BINARY_DIR}/dlocals.h DEPENDS locals.h ) diff --git a/H/Yap.h b/H/Yap.h index 0fd88ef99..e2764eb6f 100755 --- a/H/Yap.h +++ b/H/Yap.h @@ -175,7 +175,7 @@ typedef void *(*fptr_t)(void); extern const char *Yap_BINDIR, *Yap_ROOTDIR, *Yap_SHAREDIR, *Yap_LIBDIR, *Yap_DLLDIR, *Yap_PLDIR, *Yap_COMMONSDIR, *Yap_STARTUP,*Yap_INPUT_STARTUP,*Yap_OUTPUT_STARTUP, - *Yap_BOOTFILE, *Yap_INCLUDEDIR; + *Yap_SOURCEBOOT, *Yap_INCLUDEDIR; /* Basic exports */ diff --git a/H/YapGFlagInfo.h b/H/YapGFlagInfo.h index 64d3c279a..e797ce9ed 100644 --- a/H/YapGFlagInfo.h +++ b/H/YapGFlagInfo.h @@ -631,35 +631,7 @@ and if it is bound to `off` disable them. The default for YAP is YAP_FLAG(VARIABLE_NAMES_MAY_END_WITH_QUOTES_FLAG, "variable_names_may_end_with_quotes", true, booleanFlag, "false", NULL), - /**< - If `normal` allow printing of informational and banner messages, - such as the ones that are printed when consulting. If `silent` - disable printing these messages. It is `normal` by default except if - YAP is booted with the `-q` or `-L` flag. - - */ - YAP_FLAG(VERBOSE_FLAG, "verbose", true, isatom, "normal", NULL), - - /**< - - If `true` allow printing of informational messages when - searching for file names. If `false` disable printing these messages. It - is `false` by default except if YAP is booted with the `-L` - flag. - */ - YAP_FLAG(VERBOSE_FILE_SEARCH_FLAG, "verbose_file_search", true, booleanFlag, - "false", NULL), - - /**< - - If `true` allow printing of informational messages when - consulting files. If `false` disable printing these messages. It - is `true` by default except if YAP is booted with the `-L` - flag. - */ - YAP_FLAG(VERBOSE_LOAD_FLAG, "verbose_load", true, booleanFlag, "true", NULL), - /**< Read-only flag that returns a compound term with the current version of YAP. The term will have the name `yap` and arity 4, the diff --git a/H/YapLFlagInfo.h b/H/YapLFlagInfo.h index 0072c6a7e..643fbba46 100644 --- a/H/YapLFlagInfo.h +++ b/H/YapLFlagInfo.h @@ -101,37 +101,68 @@ Just fail */ YAP_FLAG(TYPEIN_MODULE_FLAG, "typein_module", true, isatom, "user", typein), - /**< -If the second argument is bound to a stream, set user_error to -this stream. If the second argument is unbound, unify the argument with -the current user_error stream. -By default, the user_error stream is set to a stream -corresponding to the Unix `stderr` stream. -The next example shows how to use this flag: -~~~{.prolog} -?- open( '/dev/null', append, Error, -[alias(mauri_tripa)] ). -Error = '$stream'(3) ? ; +/**< -no -?- set_prolog_flag(user_error, mauri_tripa). + If `normal` allow printing of informational and banner messages, + such as the ones that are printed when consulting. If `silent` + disable printing these messages. It is `normal` by default except if + YAP is booted with the `-q` or `-L` flag. -close(mauri_tripa). + */ + YAP_FLAG(VERBOSE_FLAG, "verbose", true, isatom, "normal", NULL), -yes -?- -~~~ -We execute three commands. First, we open a stream in write mode and -give it an alias, in this case `mauri_tripa`. Next, we set -user_error to the stream via the alias. Note that after we did so -prompts from the system were redirected to the stream -`mauri_tripa`. Last, we close the stream. At this point, YAP -automatically redirects the user_error alias to the original -`stderr`. -*/ + /**< + + If `true` allow printing of informational messages when + searching for file names. If `false` disable printing these messages. It + is `false` by default except if YAP is booted with the `-L` + flag. + */ + YAP_FLAG(VERBOSE_FILE_SEARCH_FLAG, "verbose_file_search", true, booleanFlag, + "false", NULL), + + /**< + + If `true` allow printing of informational messages when + consulting files. If `false` disable printing these messages. It + is `true` by default except if YAP is booted with the `-L` + flag. + */ + YAP_FLAG(VERBOSE_LOAD_FLAG, "verbose_load", true, booleanFlag, "true", NULL), + /**< + + If the second argument is bound to a stream, set user_error to + this stream. If the second argument is unbound, unify the argument with + the current user_error stream. + By default, the user_error stream is set to a stream + corresponding to the Unix `stderr` stream. + The next example shows how to use this flag: + + ~~~{.prolog} + ?- open( '/dev/null', append, Error, + [alias(mauri_tripa)] ). + + Error = '$stream'(3) ? ; + + no + ?- set_prolog_flag(user_error, mauri_tripa). + + close(mauri_tripa). + + yes + ?- + ~~~ + We execute three commands. First, we open a stream in write mode and + give it an alias, in this case `mauri_tripa`. Next, we set + user_error to the stream via the alias. Note that after we did so + prompts from the system were redirected to the stream + `mauri_tripa`. Last, we close the stream. At this point, YAP + automatically redirects the user_error alias to the original + `stderr`. + */ YAP_FLAG(USER_ERROR_FLAG, "user_error", true, stream, "user_error", set_error_stream), YAP_FLAG(USER_INPUT_FLAG, "user_input", true, stream, "user_input", diff --git a/H/Yapproto.h b/H/Yapproto.h index e7f0867ed..4171421b4 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -75,12 +75,12 @@ extern void Yap_FreeCodeSpace(void *); extern void *Yap_AllocAtomSpace(size_t); extern void *Yap_AllocCodeSpace(size_t); extern void *Yap_ReallocCodeSpace(void *, size_t); -extern ADDR Yap_AllocFromForeignArea(Int); +extern ADDR Yap_AllocFromForeignArea(size_t); extern int Yap_ExtendWorkSpace(Int); extern void Yap_FreeAtomSpace(void *); extern int Yap_FreeWorkSpace(void); -extern void Yap_InitMemory(UInt, UInt, UInt); -extern void Yap_InitExStacks(int, int, int); +extern void Yap_InitMemory(size_t, size_t, size_t); +extern void Yap_InitExStacks(int, size_t, size_t); /* amasm.c */ extern OPCODE Yap_opcode(op_numbers); @@ -239,20 +239,20 @@ extern void Yap_inform_profiler_of_clause__(void *, void *, struct pred_entry *, extern void Yap_tell_gprof(yamop *); /* globals.c */ -extern Term Yap_NewArena(UInt, CELL *); -extern CELL *Yap_GetFromArena(Term *, UInt, UInt); +extern Term Yap_NewArena(size_t, CELL *); +extern CELL *Yap_GetFromArena(Term *, size_t, UInt); extern void Yap_InitGlobals(void); extern Term Yap_SaveTerm(Term); extern Term Yap_SetGlobalVal(Atom, Term); extern Term Yap_GetGlobal(Atom); extern Int Yap_DeleteGlobal(Atom); -extern void Yap_AllocateDefaultArena(Int, Int, int); +extern void Yap_AllocateDefaultArena(size_t gsize, int wid); extern CELL *Yap_ArenaLimit(Term arena); /* grow.c */ extern Int Yap_total_stack_shift_time(void); extern void Yap_InitGrowPreds(void); -extern UInt Yap_InsertInGlobal(CELL *, UInt); +extern size_t Yap_InsertInGlobal(CELL *, size_t); extern int Yap_growheap(bool, size_t, void *); extern int Yap_growstack(size_t); extern int Yap_growtrail(size_t, bool); diff --git a/cmake/FindGMP.cmake b/cmake/FindGMP.cmake index e93282749..830c96545 100644 --- a/cmake/FindGMP.cmake +++ b/cmake/FindGMP.cmake @@ -17,7 +17,16 @@ if (ANDROID) set(GMP_INCLUDE_DIRS ${GMP_ROOT} CACHE PATH "include search path") set(GMP_LIBRARIES ${GMP_ROOT}/libgmp.so CACHE FILEPATH "include search path") set(GMP_LIBRARIES_DIR ${GMP_ROOT} CACHE PATH "include search path") - else() + else() + message("Bad call: ${GMP_ROOT} does not exist") + endif() +set( GMP_ROOT ${CMAKE_SOURCE_DIR}/../../gmp/${ANDROID_ABI} ) +if (EXISTS ${GMP_ROOT} ) + message("Looking good for ${GMP_ROOT}") + set(GMP_INCLUDE_DIRS ${GMP_ROOT} CACHE PATH "include search path") + set(GMP_LIBRARIES ${GMP_ROOT}/libgmp.so CACHE FILEPATH "include search path") + set(GMP_LIBRARIES_DIR ${GMP_ROOT} CACHE PATH "include search path") + else() message("Bad call: ${GMP_ROOT} does not exist") endif() find_path(GMP_INCLUDE_DIRS diff --git a/cmake/Sources.cmake b/cmake/Sources.cmake index 822c5e958..a891c4621 100644 --- a/cmake/Sources.cmake +++ b/cmake/Sources.cmake @@ -5,17 +5,6 @@ set (ABSMI_SOURCES C/absmi.c - C/absmi_insts.h - C/fli_absmi_insts.h - C/or_absmi_insts.h - C/control_absmi_insts.h - C/index_absmi_insts.h - C/prim_absmi_insts.h - C/cp_absmi_insts.h - C/lu_absmi_insts.h - C/unify_absmi_insts.h - C/fail_absmi_insts.h - C/meta_absmi_insts.h ) set (ENGINE_SOURCES diff --git a/config.h.cmake b/config.h.cmake index 16547a3bc..bc2ab1242 100644 --- a/config.h.cmake +++ b/config.h.cmake @@ -2035,13 +2035,13 @@ significant byte first (like Motorola and SPARC, unlike Intel). */ /* run-time boot */ -#ifndef YAP_BOOTFILE -#define YAP_BOOTFILE "${YAP_PLDIR}/pl/boot.yap" +#ifndef YAP_SOURCEBOOT +#define YAP_SOURCEBOOT "${CMAKE_SOURCE_DIR}/pl/boot.yap" #endif /* init-time boot */ #ifndef YAP_BOOTSTRAP -#define YAP_BOOTSTRAP "${CMAKE_SOURCE_DIR}/pl/boot.yap" +#define YAP_BOOTSTRAP "${YAP_PLDIR}/pl/boot.yap" #endif diff --git a/include/YapDefs.h b/include/YapDefs.h index 351139742..f1c27bcd0 100755 --- a/include/YapDefs.h +++ b/include/YapDefs.h @@ -96,7 +96,7 @@ typedef enum { YAP_SAVED_STATE = 0x0004, YAP_OBJ = 0x0008, YAP_PL = 0x0010, - YAP_BOOT_PL = 0x0030, + YAP_SOURCE_PL = 0x0030, YAP_QLY = 0x0040, YAP_EXE = 0x0080, YAP_FOUND_BOOT_ERROR = 0x0100, diff --git a/include/YapInit.h b/include/YapInit.h index 1912e42ce..b8c31a7a2 100644 --- a/include/YapInit.h +++ b/include/YapInit.h @@ -20,6 +20,8 @@ X_API YAP_file_type_t Yap_InitDefaults(void *init_args, char saved_state[], int Argc, char *Argv[]); typedef struct yap_boot_params { + //> struct marker + void *start; //> boot type as suggested by the user YAP_file_type_t boot_file_type; //> how files are organised: NULL is GNU/Linux way @@ -40,9 +42,11 @@ typedef struct yap_boot_params { const char *PLDIR; //> if NON-NULL, Prolog library, sets Yap_COMMONSDIR const char *COMMONSDIR; - //> if NON-NULL, name for a Prolog file to use when booting at run-time - const char *BOOTFILE; - //> if NON-NULL, name for a Prolog file to use when booting at compile-time + //> if NON-NULL, name for a Prolog file to use when booting at run-time + const char *BOOTDIR; + //> if NON-NULL, name for a Prolog directory that we shall use to start booting + const char *SOURCEBOOT; + //> if NON-NULL, name for a Prolog file to use when booting at compile-time const char *BOOTSTRAP; //> if NON-NULL, path where we can find the saved state const char *INPUT_STARTUP; diff --git a/library/CMakeLists.txt b/library/CMakeLists.txt index ccb01c7eb..d231de802 100644 --- a/library/CMakeLists.txt +++ b/library/CMakeLists.txt @@ -63,23 +63,19 @@ set (LIBRARY_PL ) -MY_add_subdirectory(dialect) -MY_add_subdirectory(clp) +add_subdirectory(dialect) +# add_subdirectory(clp) MY_add_subdirectory(matlab) -MY_add_subdirectory(matrix) -MY_add_subdirectory(random) -MY_add_subdirectory(regex) -MY_add_subdirectory(rltree) -MY_add_subdirectory(system) -MY_add_subdirectory(tries) +add_subdirectory(matrix) +add_subdirectory(random) +add_subdirectory(regex) +add_subdirectory(rltree) +add_subdirectory(system) +add_subdirectory(tries) MY_add_subdirectory(ytest) -add_to_group( LIBRARY_PL pl_library) +add_to_dir(LIBRARY_PL ${YAP_INSTALL_DATADIR}) install(FILES ${LIBRARY_PL} DESTINATION ${YAP_INSTALL_DATADIR}) -if (ANDROID) -file( INSTALL ${LIBRARY_PL} DESTINATION ${YAP_INSTALL_DATADIR} ) -endif() - include_directories("dialect/swi") diff --git a/library/android.yap b/library/android.yap deleted file mode 100644 index 13e33bde3..000000000 --- a/library/android.yap +++ /dev/null @@ -1,19 +0,0 @@ -%:- start_low_level_trace. - -:- module(user). -:- yap_flag(verbose,normal). - -query( String ) :- - yap_flag(typein_module, Mod), - atomic_to_term( String, Goal, VarNames ), - query_to_answer( Mod:Goal, VarNames, Status, Bindings), - output( Bindings, Status) . - -output( Bindings, Status) :- - (Status == answer -> true ; - Status == exit ->true - ), - write_query_answer( Bindings ), - nl(user_error). - -%:- [sqlitest]. \ No newline at end of file diff --git a/library/apply.yap b/library/apply.yap index fdac0ce03..7b791bdc0 100644 --- a/library/apply.yap +++ b/library/apply.yap @@ -7,7 +7,6 @@ * */ - :- module(apply_stub,[]). diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index 93443b87b..56a7693cc 100755 --- a/library/dialect/swi/fli/swi.c +++ b/library/dialect/swi/fli/swi.c @@ -2216,7 +2216,7 @@ X_API int PL_initialise(int myargc, char **myargv) { init_args.INPUT_STARTUP = NULL; #endif init_args.LIBDIR = NULL; - init_args.BOOTFILE = NULL; + init_args.SOURCEBOOT = NULL; init_args.HaltAfterBoot = true; init_args.FastBoot = FALSE; init_args.MaxTableSpaceSize = 0; diff --git a/library/lammpi/CMakeLists.txt b/library/lammpi/CMakeLists.txt index 74c189f4e..7094ab91a 100644 --- a/library/lammpi/CMakeLists.txt +++ b/library/lammpi/CMakeLists.txt @@ -67,7 +67,7 @@ set (MPI_YAP_SOURCES # program, EXECUTABLE is the MPI program, and ARGS are the arguments to # pass to the MPI program. # -add_lib(yap_mpi ${MPI_YAP_SOURCES}) +add_library(yap_mpi ${MPI_YAP_SOURCES}) target_link_libraries(yap_mpi libYap ${MPI_C_LIBRARIES}) diff --git a/library/maplist.yap b/library/maplist.yap index 22741f480..76368f864 100644 --- a/library/maplist.yap +++ b/library/maplist.yap @@ -10,76 +10,76 @@ * */ - :- module(maplist, - [maplist/2, - maplist/3, - maplist/4, - maplist/5, - maplist/6, - checklist/2, - checknodes/2, - convlist/3, - convlist/4, - foldl/4, - foldl/5, - foldl/6, - foldl/7, - foldl2/6, - foldl2/7, - foldl2/8, - foldl3/8, - foldl4/10, - include/3, - exclude/3, - mapnodes/3, - partition/4, - partition/5, - scanl/4, - scanl/5, - scanl/6, - scanl/7, - selectlist/3, - selectlist/4, - selectlists/5, - sumlist/4, - sumnodes/4 - ]). +:- module(maplist, + [maplist/2, + maplist/3, + maplist/4, + maplist/5, + maplist/6, + checklist/2, + checknodes/2, + convlist/3, + convlist/4, + foldl/4, + foldl/5, + foldl/6, + foldl/7, + foldl2/6, + foldl2/7, + foldl2/8, + foldl3/8, + foldl4/10, + include/3, + exclude/3, + mapnodes/3, + partition/4, + partition/5, + scanl/4, + scanl/5, + scanl/6, + scanl/7, + selectlist/3, + selectlist/4, + selectlists/5, + sumlist/4, + sumnodes/4 + ]). :- meta_predicate - selectlist(2,+,-), - selectlist(3,+,+,-), - checklist(1,+), - maplist(1,+), - maplist(2,+,-), - maplist(3,+,+,-), - maplist(4,+,+,+,-), - maplist(5,+,+,+,+,-), - convlist(2,+,-), - convlist(3,?,?,?), - mapnodes(2,+,-), - mapnodes_list(2,+,-), - checknodes(1,+), - checknodes_list(1,+), - sumlist(3,+,+,-), - sumnodes(3,+,+,-), - sumnodes_body(3,+,+,-,+,+), - include(1,+,-), - exclude(1,+,-), - partition(1,+,-,-), - partition(2,+,-,-,-), - foldl(3, +, +, -), - foldl2(5, +, +, -, +, -), - foldl2(6, +, ?, +, -, +, -), - foldl2(6, +, ?, ?, +, -, +, -), - foldl3(5, +, +, -, +, -, +, -), - foldl4(7, +, +, -, +, -, +, -, +, -), - foldl(4, +, +, +, -), - foldl(5, +, +, +, +, -), - foldl(6, +, +, +, +, +, -), - scanl(3, +, +, -), - scanl(4, +, +, +, -), - scanl(5, +, +, +, +, -), - scanl(6, +, +, +, +, +, -). + selectlist(2,+,-), + selectlist(3,+,+,-), + checklist(1,+), + maplist(1,+), + maplist(2,+,-), + maplist(3,+,+,-), + maplist(4,+,+,+,-), + maplist(5,+,+,+,+,-), + convlist(2,+,-), + convlist(3,?,?,?), + mapnodes(2,+,-), + mapnodes_list(2,+,-), + checknodes(1,+), + checknodes_list(1,+), + sumlist(3,+,+,-), + sumnodes(3,+,+,-), + sumnodes_body(3,+,+,-,+,+), + include(1,+,-), + exclude(1,+,-), + partition(1,+,-,-), + partition(2,+,-,-,-), + foldl(3, +, +, -), + foldl2(5, +, +, -, +, -), + foldl2(6, +, ?, +, -, +, -), + foldl2(6, +, ?, ?, +, -, +, -), + foldl3(5, +, +, -, +, -, +, -), + foldl4(7, +, +, -, +, -, +, -, +, -), + foldl(4, +, +, +, -), + foldl(5, +, +, +, +, -), + foldl(6, +, +, +, +, +, -), + scanl(3, +, +, -), + scanl(4, +, +, +, -), + scanl(5, +, +, +, +, -), + scanl(6, +, +, +, +, +, -). :- use_module(library(maputils)). :- use_module(library(lists), [append/3]). @@ -165,7 +165,7 @@ triple. See the example above. Same as selectlist/3. */ include(G,In,Out) :- - selectlist(G, In, Out). + selectlist(G, In, Out). /** @pred selectlist(1:Pred, + ListIn, ? ListOut)) @@ -175,26 +175,26 @@ include(G,In,Out) :- selectlist(_, [], []). selectlist(Pred, [In|ListIn], ListOut) :- (call(Pred, In) -> - ListOut = [In|NewListOut] + ListOut = [In|NewListOut] ; - ListOut = NewListOut + ListOut = NewListOut ), selectlist(Pred, ListIn, NewListOut). /** @pred selectlist( 2:Pred, + ListIn, + ListInAux, ? ListOut, ? ListOutAux) - + Creates _ListOut_ and _ListOutAux_ of all list elements of _ListIn_ and _ListInAux_ that pass the given test _Pred_. */ selectlists(_, [], [], [], []). selectlists(Pred, [In|ListIn], [In1|ListIn1], ListOut, ListOut1) :- (call(Pred, In, In1) -> - ListOut = [In|NewListOut], - ListOut1 = [In1|NewListOut1] + ListOut = [In|NewListOut], + ListOut1 = [In1|NewListOut1] ; - ListOut1 = NewListOut1, - ListOut = NewListOut + ListOut1 = NewListOut1, + ListOut = NewListOut ), selectlist(Pred, ListIn, ListIn1, NewListOut, NewListOut1). @@ -207,9 +207,9 @@ selectlists(Pred, [In|ListIn], [In1|ListIn1], ListOut, ListOut1) :- selectlist(_, [], [], []). selectlist(Pred, [In|ListIn], [In1|ListIn1], ListOut) :- (call(Pred, In, In1) -> - ListOut = [In|NewListOut] + ListOut = [In|NewListOut] ; - ListOut = NewListOut + ListOut = NewListOut ), selectlist(Pred, ListIn, ListIn1, NewListOut). @@ -222,9 +222,9 @@ selectlist(Pred, [In|ListIn], [In1|ListIn1], ListOut) :- exclude(_, [], []). exclude(Pred, [In|ListIn], ListOut) :- (call(Pred, In) -> - ListOut = NewListOut + ListOut = NewListOut ; - ListOut = [In|NewListOut] + ListOut = [In|NewListOut] ), exclude(Pred, ListIn, NewListOut). @@ -238,11 +238,11 @@ exclude(Pred, [In|ListIn], ListOut) :- partition(_, [], [], []). partition(Pred, [In|ListIn], List1, List2) :- (call(Pred, In) -> - List1 = [In|RList1], - List2 = RList2 + List1 = [In|RList1], + List2 = RList2 ; - List1 = RList1, - List2 = [In|RList2] + List1 = RList1, + List2 = [In|RList2] ), partition(Pred, ListIn, RList1, RList2). @@ -260,21 +260,21 @@ partition(_, [], [], [], []). partition(Pred, [In|ListIn], List1, List2, List3) :- call(Pred, In, Diff), ( Diff == (<) -> - List1 = [In|RList1], - List2 = RList2, - List3 = RList3 - ; - Diff == (=) -> - List1 = RList1, - List2 = [In|RList2], + List1 = [In|RList1], + List2 = RList2, List3 = RList3 ; - Diff == (>) -> - List1 = RList1, - List2 = RList2, - List3 = [In|RList3] + Diff == (=) -> + List1 = RList1, + List2 = [In|RList2], + List3 = RList3 ; - must_be(oneof([<,=,>]), Diff) + Diff == (>) -> + List1 = RList1, + List2 = RList2, + List3 = [In|RList3] + ; + must_be(oneof([<,=,>]), Diff) ), partition(Pred, ListIn, RList1, RList2, RList3). @@ -314,8 +314,8 @@ maplist(Pred, [In|ListIn]) :- */ maplist(_, [], []). maplist(Pred, [In|ListIn], [Out|ListOut]) :- - call(Pred, In, Out), - maplist(Pred, ListIn, ListOut). + call(Pred, In, Out), + maplist(Pred, ListIn, ListOut). /** @pred maplist(: Pred, ? L1, ? L2, ? L3) @@ -371,12 +371,12 @@ maplist(Pred, [A1|L1], [A2|L2], [A3|L3], [A4|L4], [A5|L5]) :- */ convlist(_, [], []). convlist(Pred, [Old|Olds], NewList) :- - call(Pred, Old, New), - !, - NewList = [New|News], - convlist(Pred, Olds, News). + call(Pred, Old, New), + !, + NewList = [New|News], + convlist(Pred, Olds, News). convlist(Pred, [_|Olds], News) :- - convlist(Pred, Olds, News). + convlist(Pred, Olds, News). /** @pred convlist(: Pred, ? ListIn, ?ExtraList, ? ListOut) @@ -394,12 +394,12 @@ convlist(Pred, [_|Olds], News) :- */ convlist(_, [], []). convlist(Pred, [Old|Olds], NewList) :- - call(Pred, Old, New), - !, - NewList = [New|News], - convlist(Pred, Olds, News). + call(Pred, Old, New), + !, + NewList = [New|News], + convlist(Pred, Olds, News). convlist(Pred, [_|Olds], News) :- - convlist(Pred, Olds, News). + convlist(Pred, Olds, News). /** @pred mapnodes(+ _Pred_, + _TermIn_, ? _TermOut_) @@ -461,8 +461,8 @@ sumlist(Pred, [H|T], AccIn, AccOut) :- sumnodes(Pred, Term, A0, A2) :- call(Pred, Term, A0, A1), (compound(Term) -> - functor(Term, _, N), - sumnodes_body(Pred, Term, A1, A2, 0, N) + functor(Term, _, N), + sumnodes_body(Pred, Term, A1, A2, 0, N) ; % simple term or variable A1 = A2 ). @@ -474,10 +474,10 @@ sumnodes_body(Pred, Term, A1, A3, N0, Ar) :- sumnodes(Pred, Arg, A1, A2), sumnodes_body(Pred, Term, A2, A3, N, Ar) ; - A1 = A3. + A1 = A3. - /******************************* +/******************************* * FOLDL * *******************************/ @@ -492,12 +492,12 @@ sumnodes_body(Pred, Term, A1, A3, N0, Ar) :- foldr/3. */ foldl(Goal, List, V0, V) :- - foldl_(List, Goal, V0, V). + foldl_(List, Goal, V0, V). foldl_([], _, V, V). foldl_([H|T], Goal, V0, V) :- - call(Goal, H, V0, V1), - foldl_(T, Goal, V1, V). + call(Goal, H, V0, V1), + foldl_(T, Goal, V1, V). /** @pred foldl(: _Pred_, + _List1_, + _List2_, ? _AccIn_, ? _AccOut_) @@ -515,35 +515,35 @@ foldl_([H|T], Goal, V0, V) :- == */ foldl(Goal, List1, List2, V0, V) :- - foldl_(List1, List2, Goal, V0, V). + foldl_(List1, List2, Goal, V0, V). foldl_([], [], _, V, V). foldl_([H1|T1], [H2|T2], Goal, V0, V) :- - call(Goal, H1, H2, V0, V1), - foldl_(T1, T2, Goal, V1, V). + call(Goal, H1, H2, V0, V1), + foldl_(T1, T2, Goal, V1, V). /** */ foldl(Goal, List1, List2, List3, V0, V) :- - foldl_(List1, List2, List3, Goal, V0, V). + foldl_(List1, List2, List3, Goal, V0, V). foldl_([], [], [], _, V, V). foldl_([H1|T1], [H2|T2], [H3|T3], Goal, V0, V) :- - call(Goal, H1, H2, H3, V0, V1), - foldl_(T1, T2, T3, Goal, V1, V). + call(Goal, H1, H2, H3, V0, V1), + foldl_(T1, T2, T3, Goal, V1, V). /** */ foldl(Goal, List1, List2, List3, List4, V0, V) :- - foldl_(List1, List2, List3, List4, Goal, V0, V). + foldl_(List1, List2, List3, List4, Goal, V0, V). foldl_([], [], [], [], _, V, V). foldl_([H1|T1], [H2|T2], [H3|T3], [H4|T4], Goal, V0, V) :- - call(Goal, H1, H2, H3, H4, V0, V1), - foldl_(T1, T2, T3, T4, Goal, V1, V). + call(Goal, H1, H2, H3, H4, V0, V1), + foldl_(T1, T2, T3, T4, Goal, V1, V). /** @@ -554,12 +554,12 @@ foldl_([H1|T1], [H2|T2], [H3|T3], [H4|T4], Goal, V0, V) :- */ foldl2(Goal, List, V0, V, W0, W) :- - foldl2_(List, Goal, V0, V, W0, W). + foldl2_(List, Goal, V0, V, W0, W). foldl2_([], _, V, V, W, W). foldl2_([H|T], Goal, V0, V, W0, W) :- - call(Goal, H, V0, V1, W0, W1), - foldl2_(T, Goal, V1, V, W1, W). + call(Goal, H, V0, V1, W0, W1), + foldl2_(T, Goal, V1, V, W1, W). /** v @pred foldl2(: _Pred_, + _List_, ? _List1_, ? _X0_, ? _X_, ? _Y0_, ? _Y_) @@ -568,12 +568,12 @@ v @pred foldl2(: _Pred_, + _List_, ? _List1_, ? _X0_, ? _X_, ? _Y0_, ? _Y_) _X_ and _Y_. */ foldl2(Goal, List1, List2, V0, V, W0, W) :- - foldl2_(List1, List2, Goal, V0, V, W0, W). + foldl2_(List1, List2, Goal, V0, V, W0, W). foldl2_([], [], _Goal, V, V, W, W). foldl2_([H1|T1], [H2|T2], Goal, V0, V, W0, W) :- - call(Goal, H1, H2, V0, V1, W0, W1), - foldl2_(T1, T2, Goal, V1, V, W1, W). + call(Goal, H1, H2, V0, V1, W0, W1), + foldl2_(T1, T2, Goal, V1, V, W1, W). /** @pred foldl2(: _Pred_, + _List_, ? _List1_, ? _List2_, ? _X0_, ? _X_, ? _Y0_, ? _Y_) @@ -583,12 +583,12 @@ foldl2_([H1|T1], [H2|T2], Goal, V0, V, W0, W) :- */ foldl2(Goal, List1, List2, List3, V0, V, W0, W) :- - foldl2_(List1, List2, List3, Goal, V0, V, W0, W). + foldl2_(List1, List2, List3, Goal, V0, V, W0, W). foldl2_([], [], [], _Goal, V, V, W, W). foldl2_([H1|T1], [H2|T2], [H3|T3], Goal, V0, V, W0, W) :- - call(Goal, H1, H2, H3, V0, V1, W0, W1), - foldl2_(T1, T2, T3, Goal, V1, V, W1, W). + call(Goal, H1, H2, H3, V0, V1, W0, W1), + foldl2_(T1, T2, T3, Goal, V1, V, W1, W). /** @@ -599,12 +599,12 @@ foldl2_([H1|T1], [H2|T2], [H3|T3], Goal, V0, V, W0, W) :- result in _X_, _Y_ and _Z_. */ foldl3(Goal, List, V0, V, W0, W, X0, X) :- - foldl3_(List, Goal, V0, V, W0, W, X0, X). + foldl3_(List, Goal, V0, V, W0, W, X0, X). foldl3_([], _, V, V, W, W, X, X). foldl3_([H|T], Goal, V0, V, W0, W, X0, X) :- - call(Goal, H, V0, V1, W0, W1, X0, X1), - fold3_(T, Goal, V1, V, W1, W, X1, X). + call(Goal, H, V0, V1, W0, W1, X0, X1), + fold3_(T, Goal, V1, V, W1, W, X1, X). /** @pred foldl4(: _Pred_, + _List1_, ? _List2_, ? _X0_, ? _X_, ? _Y0_, ? _Y_, ? _Z0_, ? _Z_, ? _W0_, ? _W_) @@ -614,7 +614,7 @@ foldl3_([H|T], Goal, V0, V, W0, W, X0, X) :- result in _X_, _Y_, _Z_ and _W_. */ foldl4(Goal, List, V0, V, W0, W, X0, X, Y0, Y) :- - foldl4_(List, Goal, V0, V, W0, W, X0, X, Y0, Y). + foldl4_(List, Goal, V0, V, W0, W, X0, X, Y0, Y). foldl4_([], _, V, V, W, W, X, X, Y, Y). foldl4_([H|T], Goal, V0, V, W0, W, X0, X, Y0, Y) :- @@ -623,7 +623,7 @@ foldl4_([H|T], Goal, V0, V, W0, W, X0, X, Y0, Y) :- - /******************************* +/******************************* * SCANL * *******************************/ @@ -656,12 +656,12 @@ operations is defined by: ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */ scanl(Goal, List, V0, [V0|Values]) :- - scanl_(List, Goal, V0, Values). + scanl_(List, Goal, V0, Values). scanl_([], _, _, []). scanl_([H|T], Goal, V, [VH|VT]) :- - call(Goal, H, V, VH), - scanl_(T, Goal, VH, VT). + call(Goal, H, V, VH), + scanl_(T, Goal, VH, VT). /** scanl(: _Pred_, + _List1_, + _List2_, ? _V0_, ? _Vs_) @@ -669,12 +669,12 @@ scanl_([H|T], Goal, V, [VH|VT]) :- Left scan of list. */ scanl(Goal, List1, List2, V0, [V0|Values]) :- - scanl_(List1, List2, Goal, V0, Values). + scanl_(List1, List2, Goal, V0, Values). scanl_([], [], _, _, []). scanl_([H1|T1], [H2|T2], Goal, V, [VH|VT]) :- - call(Goal, H1, H2, V, VH), - scanl_(T1, T2, Goal, VH, VT). + call(Goal, H1, H2, V, VH), + scanl_(T1, T2, Goal, VH, VT). /** scanl(: _Pred_, + _List1_, + _List2_, + _List3_, ? _V0_, ? _Vs_) @@ -682,12 +682,12 @@ scanl_([H1|T1], [H2|T2], Goal, V, [VH|VT]) :- Left scan of list. */ scanl(Goal, List1, List2, List3, V0, [V0|Values]) :- - scanl_(List1, List2, List3, Goal, V0, Values). + scanl_(List1, List2, List3, Goal, V0, Values). scanl_([], [], [], _, _, []). scanl_([H1|T1], [H2|T2], [H3|T3], Goal, V, [VH|VT]) :- - call(Goal, H1, H2, H3, V, VH), - scanl_(T1, T2, T3, Goal, VH, VT). + call(Goal, H1, H2, H3, V, VH), + scanl_(T1, T2, T3, Goal, VH, VT). /** scanl(: _Pred_, + _List1_, + _List2_, + _List3_, + _List4_, ? _V0_, ? _Vs_) @@ -695,645 +695,645 @@ scanl_([H1|T1], [H2|T2], [H3|T3], Goal, V, [VH|VT]) :- Left scan of list. */ scanl(Goal, List1, List2, List3, List4, V0, [V0|Values]) :- - scanl_(List1, List2, List3, List4, Goal, V0, Values). + scanl_(List1, List2, List3, List4, Goal, V0, Values). scanl_([], [], [], [], _, _, []). scanl_([H1|T1], [H2|T2], [H3|T3], [H4|T4], Goal, V, [VH|VT]) :- - call(Goal, H1, H2, H3, H4, V, VH), - scanl_(T1, T2, T3, T4, Goal, VH, VT). + call(Goal, H1, H2, H3, H4, V, VH), + scanl_(T1, T2, T3, T4, Goal, VH, VT). goal_expansion(checklist(Meta, List), Mod:Goal) :- - goal_expansion_allowed, - callable(Meta), - prolog_load_context(module, Mod), - aux_preds(Meta, MetaVars, Pred, PredVars, Proto), - !, - % the new goal - pred_name(checklist, 2, Proto, GoalName), - append(MetaVars, [List], GoalArgs), - Goal =.. [GoalName|GoalArgs], - % the new predicate declaration - HeadPrefix =.. [GoalName|PredVars], - append_args(HeadPrefix, [[]], Base), - append_args(HeadPrefix, [[In|Ins]], RecursionHead), - append_args(Pred, [In], Apply), - append_args(HeadPrefix, [Ins], RecursiveCall), - compile_aux([ - Base, - (RecursionHead :- Apply, RecursiveCall) - ], Mod). + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(checklist, 2, Proto, GoalName), + append(MetaVars, [List], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[]], Base), + append_args(HeadPrefix, [[In|Ins]], RecursionHead), + append_args(Pred, [In], Apply), + append_args(HeadPrefix, [Ins], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- Apply, RecursiveCall) + ], Mod). goal_expansion(maplist(Meta, List), Mod:Goal) :- - goal_expansion_allowed, - callable(Meta), - prolog_load_context(module, Mod), - aux_preds(Meta, MetaVars, Pred, PredVars, Proto), - !, - % the new goal - pred_name(maplist, 2, Proto, GoalName), - append(MetaVars, [List], GoalArgs), - Goal =.. [GoalName|GoalArgs], - % the new predicate declaration - HeadPrefix =.. [GoalName|PredVars], - append_args(HeadPrefix, [[]], Base), - append_args(HeadPrefix, [[In|Ins]], RecursionHead), - append_args(Pred, [In], Apply), - append_args(HeadPrefix, [Ins], RecursiveCall), - compile_aux([ - Base, - (RecursionHead :- Apply, RecursiveCall) - ], Mod). + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(maplist, 2, Proto, GoalName), + append(MetaVars, [List], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[]], Base), + append_args(HeadPrefix, [[In|Ins]], RecursionHead), + append_args(Pred, [In], Apply), + append_args(HeadPrefix, [Ins], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- Apply, RecursiveCall) + ], Mod). goal_expansion(maplist(Meta, ListIn, ListOut), Mod:Goal) :- - goal_expansion_allowed, - callable(Meta), - prolog_load_context(module, Mod), - aux_preds(Meta, MetaVars, Pred, PredVars, Proto), - !, - % the new goal - pred_name(maplist, 3, Proto, GoalName), - append(MetaVars, [ListIn, ListOut], GoalArgs), - Goal =.. [GoalName|GoalArgs], - % the new predicate declaration - HeadPrefix =.. [GoalName|PredVars], - append_args(HeadPrefix, [[], []], Base), - append_args(HeadPrefix, [[In|Ins], [Out|Outs]], RecursionHead), - append_args(Pred, [In, Out], Apply), - append_args(HeadPrefix, [Ins, Outs], RecursiveCall), - compile_aux([ - Base, - (RecursionHead :- Apply, RecursiveCall) - ], Mod). + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(maplist, 3, Proto, GoalName), + append(MetaVars, [ListIn, ListOut], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[], []], Base), + append_args(HeadPrefix, [[In|Ins], [Out|Outs]], RecursionHead), + append_args(Pred, [In, Out], Apply), + append_args(HeadPrefix, [Ins, Outs], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- Apply, RecursiveCall) + ], Mod). goal_expansion(maplist(Meta, L1, L2, L3), Mod:Goal) :- - goal_expansion_allowed, - callable(Meta), - prolog_load_context(module, Mod), - aux_preds(Meta, MetaVars, Pred, PredVars, Proto), - !, - % the new goal - pred_name(maplist, 4, Proto, GoalName), - append(MetaVars, [L1, L2, L3], GoalArgs), - Goal =.. [GoalName|GoalArgs], - % the new predicate declaration - HeadPrefix =.. [GoalName|PredVars], - append_args(HeadPrefix, [[], [], []], Base), - append_args(HeadPrefix, [[A1|A1s], [A2|A2s], [A3|A3s]], RecursionHead), - append_args(Pred, [A1, A2, A3], Apply), - append_args(HeadPrefix, [A1s, A2s, A3s], RecursiveCall), - compile_aux([ - Base, - (RecursionHead :- Apply, RecursiveCall) - ], Mod). + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(maplist, 4, Proto, GoalName), + append(MetaVars, [L1, L2, L3], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[], [], []], Base), + append_args(HeadPrefix, [[A1|A1s], [A2|A2s], [A3|A3s]], RecursionHead), + append_args(Pred, [A1, A2, A3], Apply), + append_args(HeadPrefix, [A1s, A2s, A3s], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- Apply, RecursiveCall) + ], Mod). goal_expansion(maplist(Meta, L1, L2, L3, L4), Mod:Goal) :- - goal_expansion_allowed, - callable(Meta), - prolog_load_context(module, Mod), - aux_preds(Meta, MetaVars, Pred, PredVars, Proto), - !, - % the new goal - pred_name(maplist, 5, Proto, GoalName), - append(MetaVars, [L1, L2, L3, L4], GoalArgs), - Goal =.. [GoalName|GoalArgs], - % the new predicate declaration - HeadPrefix =.. [GoalName|PredVars], - append_args(HeadPrefix, [[], [], [], []], Base), - append_args(HeadPrefix, [[A1|A1s], [A2|A2s], [A3|A3s], [A4|A4s]], RecursionHead), - append_args(Pred, [A1, A2, A3, A4], Apply), - append_args(HeadPrefix, [A1s, A2s, A3s, A4s], RecursiveCall), - compile_aux([ - Base, - (RecursionHead :- Apply, RecursiveCall) - ], Mod). + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(maplist, 5, Proto, GoalName), + append(MetaVars, [L1, L2, L3, L4], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[], [], [], []], Base), + append_args(HeadPrefix, [[A1|A1s], [A2|A2s], [A3|A3s], [A4|A4s]], RecursionHead), + append_args(Pred, [A1, A2, A3, A4], Apply), + append_args(HeadPrefix, [A1s, A2s, A3s, A4s], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- Apply, RecursiveCall) + ], Mod). goal_expansion(maplist(Meta, L1, L2, L3, L4, L5), Mod:Goal) :- - goal_expansion_allowed, - callable(Meta), - prolog_load_context(module, Mod), - aux_preds(Meta, MetaVars, Pred, PredVars, Proto), - !, - % the new goal - pred_name(maplist, 6, Proto, GoalName), - append(MetaVars, [L1, L2, L3, L4, L5], GoalArgs), - Goal =.. [GoalName|GoalArgs], - % the new predicate declaration - HeadPrefix =.. [GoalName|PredVars], - append_args(HeadPrefix, [[], [], [], [], []], Base), - append_args(HeadPrefix, [[A1|A1s], [A2|A2s], [A3|A3s], [A4|A4s], [A5|A5s]], RecursionHead), - append_args(Pred, [A1, A2, A3, A4, A5], Apply), - append_args(HeadPrefix, [A1s, A2s, A3s, A4s, A5s], RecursiveCall), - compile_aux([ - Base, - (RecursionHead :- Apply, RecursiveCall) - ], Mod). + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(maplist, 6, Proto, GoalName), + append(MetaVars, [L1, L2, L3, L4, L5], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[], [], [], [], []], Base), + append_args(HeadPrefix, [[A1|A1s], [A2|A2s], [A3|A3s], [A4|A4s], [A5|A5s]], RecursionHead), + append_args(Pred, [A1, A2, A3, A4, A5], Apply), + append_args(HeadPrefix, [A1s, A2s, A3s, A4s, A5s], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- Apply, RecursiveCall) + ], Mod). goal_expansion(selectlist(Meta, ListIn, ListOut), Mod:Goal) :- - goal_expansion_allowed, - callable(Meta), - prolog_load_context(module, Mod), - aux_preds(Meta, MetaVars, Pred, PredVars, Proto), - !, - % the new goal - pred_name(selectlist, 3, Proto, GoalName), - append(MetaVars, [ListIn, ListOut], GoalArgs), - Goal =.. [GoalName|GoalArgs], - % the new predicate declaration - HeadPrefix =.. [GoalName|PredVars], - append_args(HeadPrefix, [[], []], Base), - append_args(HeadPrefix, [[In|Ins], Outs], RecursionHead), - append_args(Pred, [In], Apply), - append_args(HeadPrefix, [Ins, NOuts], RecursiveCall), - compile_aux([ - Base, - (RecursionHead :- - (Apply -> Outs = [In|NOuts]; Outs = NOuts), - RecursiveCall) - ], Mod). + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(selectlist, 3, Proto, GoalName), + append(MetaVars, [ListIn, ListOut], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[], []], Base), + append_args(HeadPrefix, [[In|Ins], Outs], RecursionHead), + append_args(Pred, [In], Apply), + append_args(HeadPrefix, [Ins, NOuts], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- + (Apply -> Outs = [In|NOuts]; Outs = NOuts), + RecursiveCall) + ], Mod). goal_expansion(selectlist(Meta, ListIn, ListIn1, ListOut), Mod:Goal) :- - goal_expansion_allowed, - callable(Meta), - prolog_load_context(module, Mod), - aux_preds(Meta, MetaVars, Pred, PredVars, Proto), - !, - % the new goal - pred_name(selectlist, 3, Proto, GoalName), - append(MetaVars, [ListIn, ListIn1, ListOut], GoalArgs), - Goal =.. [GoalName|GoalArgs], - % the new predicate declaration - HeadPrefix =.. [GoalName|PredVars], - append_args(HeadPrefix, [[], [], []], Base), - append_args(HeadPrefix, [[In|Ins], [In1|Ins1], Outs], RecursionHead), - append_args(Pred, [In, In1], Apply), - append_args(HeadPrefix, [Ins, Ins1, NOuts], RecursiveCall), - compile_aux([ - Base, - (RecursionHead :- - (Apply -> Outs = [In|NOuts]; Outs = NOuts), - RecursiveCall) - ], Mod). + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(selectlist, 3, Proto, GoalName), + append(MetaVars, [ListIn, ListIn1, ListOut], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[], [], []], Base), + append_args(HeadPrefix, [[In|Ins], [In1|Ins1], Outs], RecursionHead), + append_args(Pred, [In, In1], Apply), + append_args(HeadPrefix, [Ins, Ins1, NOuts], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- + (Apply -> Outs = [In|NOuts]; Outs = NOuts), + RecursiveCall) + ], Mod). goal_expansion(selectlists(Meta, ListIn, ListIn1, ListOut, ListOut1), Mod:Goal) :- - goal_expansion_allowed, - callable(Meta), - prolog_load_context(module, Mod), - aux_preds(Meta, MetaVars, Pred, PredVars, Proto), - !, - % the new goal - pred_name(selectlist, 4, Proto, GoalName), - append(MetaVars, [ListIn, ListIn1, ListOut, ListOut1], GoalArgs), - Goal =.. [GoalName|GoalArgs], - % the new predicate declaration - HeadPrefix =.. [GoalName|PredVars], - append_args(HeadPrefix, [[], [], [], []], Base), - append_args(HeadPrefix, [[In|Ins], [In1|Ins1], Outs, Outs1], RecursionHead), - append_args(Pred, [In, In1], Apply), - append_args(HeadPrefix, [Ins, Ins1, NOuts, NOuts1], RecursiveCall), - compile_aux([ - Base, - (RecursionHead :- - (Apply -> Outs = [In|NOuts], Outs1 = [In1|NOuts1]; Outs = NOuts, Outs1 = NOuts1), - RecursiveCall) - ], Mod). + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(selectlist, 4, Proto, GoalName), + append(MetaVars, [ListIn, ListIn1, ListOut, ListOut1], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[], [], [], []], Base), + append_args(HeadPrefix, [[In|Ins], [In1|Ins1], Outs, Outs1], RecursionHead), + append_args(Pred, [In, In1], Apply), + append_args(HeadPrefix, [Ins, Ins1, NOuts, NOuts1], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- + (Apply -> Outs = [In|NOuts], Outs1 = [In1|NOuts1]; Outs = NOuts, Outs1 = NOuts1), + RecursiveCall) + ], Mod). % same as selectlist goal_expansion(include(Meta, ListIn, ListOut), Mod:Goal) :- - goal_expansion_allowed, - callable(Meta), - prolog_load_context(module, Mod), - aux_preds(Meta, MetaVars, Pred, PredVars, Proto), - !, - % the new goal - pred_name(include, 3, Proto, GoalName), - append(MetaVars, [ListIn, ListOut], GoalArgs), - Goal =.. [GoalName|GoalArgs], - % the new predicate declaration - HeadPrefix =.. [GoalName|PredVars], - append_args(HeadPrefix, [[], []], Base), - append_args(HeadPrefix, [[In|Ins], Outs], RecursionHead), - append_args(Pred, [In], Apply), - append_args(HeadPrefix, [Ins, NOuts], RecursiveCall), - compile_aux([ - Base, - (RecursionHead :- - (Apply -> Outs = [In|NOuts]; Outs = NOuts), - RecursiveCall) - ], Mod). + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(include, 3, Proto, GoalName), + append(MetaVars, [ListIn, ListOut], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[], []], Base), + append_args(HeadPrefix, [[In|Ins], Outs], RecursionHead), + append_args(Pred, [In], Apply), + append_args(HeadPrefix, [Ins, NOuts], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- + (Apply -> Outs = [In|NOuts]; Outs = NOuts), + RecursiveCall) + ], Mod). goal_expansion(exclude(Meta, ListIn, ListOut), Mod:Goal) :- - goal_expansion_allowed, - callable(Meta), - prolog_load_context(module, Mod), - aux_preds(Meta, MetaVars, Pred, PredVars, Proto), - !, - % the new goal - pred_name(exclude, 3, Proto, GoalName), - append(MetaVars, [ListIn, ListOut], GoalArgs), - Goal =.. [GoalName|GoalArgs], - % the new predicate declaration - HeadPrefix =.. [GoalName|PredVars], - append_args(HeadPrefix, [[], []], Base), - append_args(HeadPrefix, [[In|Ins], Outs], RecursionHead), - append_args(Pred, [In], Apply), - append_args(HeadPrefix, [Ins, NOuts], RecursiveCall), - compile_aux([ - Base, - (RecursionHead :- - (Apply -> Outs = NOuts; Outs = [In|NOuts]), - RecursiveCall) - ], Mod). + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(exclude, 3, Proto, GoalName), + append(MetaVars, [ListIn, ListOut], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[], []], Base), + append_args(HeadPrefix, [[In|Ins], Outs], RecursionHead), + append_args(Pred, [In], Apply), + append_args(HeadPrefix, [Ins, NOuts], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- + (Apply -> Outs = NOuts; Outs = [In|NOuts]), + RecursiveCall) + ], Mod). goal_expansion(partition(Meta, ListIn, List1, List2), Mod:Goal) :- - goal_expansion_allowed, - callable(Meta), - prolog_load_context(module, Mod), - aux_preds(Meta, MetaVars, Pred, PredVars, Proto), - !, - % the new goal - pred_name(partition, 4, Proto, GoalName), - append(MetaVars, [ListIn, List1, List2], GoalArgs), - Goal =.. [GoalName|GoalArgs], - % the new predicate declaration - HeadPrefix =.. [GoalName|PredVars], - append_args(HeadPrefix, [[], [], []], Base), - append_args(HeadPrefix, [[In|Ins], Outs1, Outs2], RecursionHead), - append_args(Pred, [In], Apply), - append_args(HeadPrefix, [Ins, NOuts1, NOuts2], RecursiveCall), - compile_aux([ - Base, - (RecursionHead :- - (Apply -> Outs1 = [In|NOuts1], Outs2 = NOuts2; Outs1 = NOuts1, Outs2 = [In|NOuts2]), - RecursiveCall) - ], Mod). + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(partition, 4, Proto, GoalName), + append(MetaVars, [ListIn, List1, List2], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[], [], []], Base), + append_args(HeadPrefix, [[In|Ins], Outs1, Outs2], RecursionHead), + append_args(Pred, [In], Apply), + append_args(HeadPrefix, [Ins, NOuts1, NOuts2], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- + (Apply -> Outs1 = [In|NOuts1], Outs2 = NOuts2; Outs1 = NOuts1, Outs2 = [In|NOuts2]), + RecursiveCall) + ], Mod). goal_expansion(partition(Meta, ListIn, List1, List2, List3), Mod:Goal) :- - goal_expansion_allowed, - callable(Meta), - prolog_load_context(module, Mod), - aux_preds(Meta, MetaVars, Pred, PredVars, Proto), - !, - % the new goal - pred_name(partition2, 5, Proto, GoalName), - append(MetaVars, [ListIn, List1, List2, List3], GoalArgs), - Goal =.. [GoalName|GoalArgs], - % the new predicate declaration - HeadPrefix =.. [GoalName|PredVars], - append_args(HeadPrefix, [[], [], [], []], Base), - append_args(HeadPrefix, [[In|Ins], Outs1, Outs2, Outs3], RecursionHead), - append_args(Pred, [In,Diff], Apply), - append_args(HeadPrefix, [Ins, NOuts1, NOuts2, NOuts3], RecursiveCall), - compile_aux([ - Base, - (RecursionHead :- - Apply, - (Diff == (<) -> - Outs1 = [In|NOuts1], - Outs2 = NOuts2, - Outs3 = NOuts3 - ; - Diff == (=) -> - Outs1 = NOuts1, - Outs2 = [In|NOuts2], - Outs3 = NOuts3 - ; - Diff == (>) -> - Outs1 = NOuts1, - Outs2 = NOuts2, - Outs3 = [In|NOuts3] - ; - must_be(oneof([<,=,>]), Diff) - ), - RecursiveCall) - ], Mod). + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(partition2, 5, Proto, GoalName), + append(MetaVars, [ListIn, List1, List2, List3], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[], [], [], []], Base), + append_args(HeadPrefix, [[In|Ins], Outs1, Outs2, Outs3], RecursionHead), + append_args(Pred, [In,Diff], Apply), + append_args(HeadPrefix, [Ins, NOuts1, NOuts2, NOuts3], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- + Apply, + (Diff == (<) -> + Outs1 = [In|NOuts1], + Outs2 = NOuts2, + Outs3 = NOuts3 + ; + Diff == (=) -> + Outs1 = NOuts1, + Outs2 = [In|NOuts2], + Outs3 = NOuts3 + ; + Diff == (>) -> + Outs1 = NOuts1, + Outs2 = NOuts2, + Outs3 = [In|NOuts3] + ; + must_be(oneof([<,=,>]), Diff) + ), + RecursiveCall) + ], Mod). goal_expansion(convlist(Meta, ListIn, ListOut), Mod:Goal) :- - goal_expansion_allowed, - callable(Meta), - prolog_load_context(module, Mod), - aux_preds(Meta, MetaVars, Pred, PredVars, Proto), - !, - % the new goal - pred_name(convlist, 3, Proto, GoalName), - append(MetaVars, [ListIn, ListOut], GoalArgs), - Goal =.. [GoalName|GoalArgs], - % the new predicate declaration - HeadPrefix =.. [GoalName|PredVars], - append_args(HeadPrefix, [[], []], Base), - append_args(HeadPrefix, [[In|Ins], Outs], RecursionHead), - append_args(Pred, [In, Out], Apply), - append_args(HeadPrefix, [Ins, NOuts], RecursiveCall), - compile_aux([ - Base, - (RecursionHead :- - (Apply -> Outs = [Out|NOuts]; Outs = NOuts), - RecursiveCall) - ], Mod). + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(convlist, 3, Proto, GoalName), + append(MetaVars, [ListIn, ListOut], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[], []], Base), + append_args(HeadPrefix, [[In|Ins], Outs], RecursionHead), + append_args(Pred, [In, Out], Apply), + append_args(HeadPrefix, [Ins, NOuts], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- + (Apply -> Outs = [Out|NOuts]; Outs = NOuts), + RecursiveCall) + ], Mod). goal_expansion(convlist(Meta, ListIn, ListExtra, ListOut), Mod:Goal) :- - goal_expansion_allowed, - callable(Meta), - prolog_load_context(module, Mod), - aux_preds(Meta, MetaVars, Pred, PredVars, Proto), - !, - % the new goal - pred_name(convlist, 4, Proto, GoalName), - append(MetaVars, [ListIn, ListExtra, ListOut], GoalArgs), - Goal =.. [GoalName|GoalArgs], - % the new predicate declaration - HeadPrefix =.. [GoalName|PredVars], - append_args(HeadPrefix, [[], [], []], Base), - append_args(HeadPrefix, [[In|Ins], [Extra|Extras], Outs], RecursionHead), - append_args(Pred, [In, Extra, Out], Apply), - append_args(HeadPrefix, [Ins, Extras, NOuts], RecursiveCall), - compile_aux([ - Base, - (RecursionHead :- - (Apply -> Outs = [Out|NOuts]; Outs = NOuts), - RecursiveCall) - ], Mod). + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(convlist, 4, Proto, GoalName), + append(MetaVars, [ListIn, ListExtra, ListOut], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[], [], []], Base), + append_args(HeadPrefix, [[In|Ins], [Extra|Extras], Outs], RecursionHead), + append_args(Pred, [In, Extra, Out], Apply), + append_args(HeadPrefix, [Ins, Extras, NOuts], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- + (Apply -> Outs = [Out|NOuts]; Outs = NOuts), + RecursiveCall) + ], Mod). goal_expansion(sumlist(Meta, List, AccIn, AccOut), Mod:Goal) :- - goal_expansion_allowed, - callable(Meta), - prolog_load_context(module, Mod), - aux_preds(Meta, MetaVars, Pred, PredVars, Proto), - !, - % the new goal - pred_name(sumlist, 4, Proto, GoalName), - append(MetaVars, [List, AccIn, AccOut], GoalArgs), - Goal =.. [GoalName|GoalArgs], - % the new predicate declaration - HeadPrefix =.. [GoalName|PredVars], - append_args(HeadPrefix, [[], Acc, Acc], Base), - append_args(HeadPrefix, [[In|Ins], Acc1, Acc2], RecursionHead), - append_args(Pred, [In, Acc1, Acc3], Apply), - append_args(HeadPrefix, [Ins, Acc3, Acc2], RecursiveCall), - compile_aux([ - Base, - (RecursionHead :- Apply, RecursiveCall) - ], Mod). + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(sumlist, 4, Proto, GoalName), + append(MetaVars, [List, AccIn, AccOut], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[], Acc, Acc], Base), + append_args(HeadPrefix, [[In|Ins], Acc1, Acc2], RecursionHead), + append_args(Pred, [In, Acc1, Acc3], Apply), + append_args(HeadPrefix, [Ins, Acc3, Acc2], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- Apply, RecursiveCall) + ], Mod). goal_expansion(foldl(Meta, List, AccIn, AccOut), Mod:Goal) :- - goal_expansion_allowed, - callable(Meta), - prolog_load_context(module, Mod), - aux_preds(Meta, MetaVars, Pred, PredVars, Proto), - !, - % the new goal - pred_name(foldl, 4, Proto, GoalName), - append(MetaVars, [List, AccIn, AccOut], GoalArgs), - Goal =.. [GoalName|GoalArgs], - % the new predicate declaration - HeadPrefix =.. [GoalName|PredVars], - append_args(HeadPrefix, [[], Acc, Acc], Base), - append_args(HeadPrefix, [[In|Ins], Acc1, Acc2], RecursionHead), - append_args(Pred, [In, Acc1, Acc3], Apply), - append_args(HeadPrefix, [Ins, Acc3, Acc2], RecursiveCall), - compile_aux([ - Base, - (RecursionHead :- Apply, RecursiveCall) - ], Mod). + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(foldl, 4, Proto, GoalName), + append(MetaVars, [List, AccIn, AccOut], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[], Acc, Acc], Base), + append_args(HeadPrefix, [[In|Ins], Acc1, Acc2], RecursionHead), + append_args(Pred, [In, Acc1, Acc3], Apply), + append_args(HeadPrefix, [Ins, Acc3, Acc2], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- Apply, RecursiveCall) + ], Mod). goal_expansion(foldl(Meta, List1, List2, AccIn, AccOut), Mod:Goal) :- - goal_expansion_allowed, - callable(Meta), - prolog_load_context(module, Mod), - aux_preds(Meta, MetaVars, Pred, PredVars, Proto), - !, - % the new goal - pred_name(foldl, 5, Proto, GoalName), - append(MetaVars, [List1, List2, AccIn, AccOut], GoalArgs), - Goal =.. [GoalName|GoalArgs], - % the new predicate declaration - HeadPrefix =.. [GoalName|PredVars], - append_args(HeadPrefix, [[], [], Acc, Acc], Base), - append_args(HeadPrefix, [[In|Ins], [I2|Is2], Acc1, Acc2], RecursionHead), - append_args(Pred, [In, I2, Acc1, Acc3], Apply), - append_args(HeadPrefix, [Ins, Is2, Acc3, Acc2], RecursiveCall), - compile_aux([ - Base, - (RecursionHead :- Apply, RecursiveCall) - ], Mod). + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(foldl, 5, Proto, GoalName), + append(MetaVars, [List1, List2, AccIn, AccOut], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[], [], Acc, Acc], Base), + append_args(HeadPrefix, [[In|Ins], [I2|Is2], Acc1, Acc2], RecursionHead), + append_args(Pred, [In, I2, Acc1, Acc3], Apply), + append_args(HeadPrefix, [Ins, Is2, Acc3, Acc2], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- Apply, RecursiveCall) + ], Mod). goal_expansion(foldl(Meta, List1, List2, List3, AccIn, AccOut), Mod:Goal) :- - goal_expansion_allowed, - callable(Meta), - prolog_load_context(module, Mod), - aux_preds(Meta, MetaVars, Pred, PredVars, Proto), - !, - % the new goal - pred_name(foldl, 6, Proto, GoalName), - append(MetaVars, [List1, List2, List3, AccIn, AccOut], GoalArgs), - Goal =.. [GoalName|GoalArgs], - % the new predicate declaration - HeadPrefix =.. [GoalName|PredVars], - append_args(HeadPrefix, [[], [], [], Acc, Acc], Base), - append_args(HeadPrefix, [[In|Ins], [I2|I2s], [I3|I3s], Acc1, Acc2], RecursionHead), - append_args(Pred, [In, I2, I3, Acc1, Acc3], Apply), - append_args(HeadPrefix, [Ins, I2s, I3s, Acc3, Acc2], RecursiveCall), - compile_aux([ - Base, - (RecursionHead :- Apply, RecursiveCall) - ], Mod). + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(foldl, 6, Proto, GoalName), + append(MetaVars, [List1, List2, List3, AccIn, AccOut], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[], [], [], Acc, Acc], Base), + append_args(HeadPrefix, [[In|Ins], [I2|I2s], [I3|I3s], Acc1, Acc2], RecursionHead), + append_args(Pred, [In, I2, I3, Acc1, Acc3], Apply), + append_args(HeadPrefix, [Ins, I2s, I3s, Acc3, Acc2], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- Apply, RecursiveCall) + ], Mod). goal_expansion(foldl2(Meta, List, AccIn, AccOut, W0, W), Mod:Goal) :- - goal_expansion_allowed, - callable(Meta), - prolog_load_context(module, Mod), - aux_preds(Meta, MetaVars, Pred, PredVars, Proto), - !, - % the new goal - pred_name(foldl2, 6, Proto, GoalName), - append(MetaVars, [List, AccIn, AccOut, W0, W], GoalArgs), - Goal =.. [GoalName|GoalArgs], - % the new predicate declaration - HeadPrefix =.. [GoalName|PredVars], - append_args(HeadPrefix, [[], Acc, Acc, W, W], Base), - append_args(HeadPrefix, [[In|Ins], Acc1, Acc2, W1, W2], RecursionHead), - append_args(Pred, [In, Acc1, Acc3, W1, W3], Apply), - append_args(HeadPrefix, [Ins, Acc3, Acc2, W3, W2], RecursiveCall), - compile_aux([ - Base, - (RecursionHead :- Apply, RecursiveCall) - ], Mod). + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(foldl2, 6, Proto, GoalName), + append(MetaVars, [List, AccIn, AccOut, W0, W], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[], Acc, Acc, W, W], Base), + append_args(HeadPrefix, [[In|Ins], Acc1, Acc2, W1, W2], RecursionHead), + append_args(Pred, [In, Acc1, Acc3, W1, W3], Apply), + append_args(HeadPrefix, [Ins, Acc3, Acc2, W3, W2], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- Apply, RecursiveCall) + ], Mod). goal_expansion(foldl2(Meta, List1, List2, AccIn, AccOut, W0, W), Mod:Goal) :- - goal_expansion_allowed, - callable(Meta), - prolog_load_context(module, Mod), - aux_preds(Meta, MetaVars, Pred, PredVars, Proto), - !, - % the new goal - pred_name(foldl2, 7, Proto, GoalName), - append(MetaVars, [List1, List2, AccIn, AccOut, W0, W], GoalArgs), - Goal =.. [GoalName|GoalArgs], - % the new predicate declaration - HeadPrefix =.. [GoalName|PredVars], - append_args(HeadPrefix, [[], [], Acc, Acc, W, W], Base), - append_args(HeadPrefix, [[In1|Ins1], [In2|Ins2], Acc1, Acc2, W1, W2], RecursionHead), - append_args(Pred, [In1, In2, Acc1, Acc3, W1, W3], Apply), - append_args(HeadPrefix, [Ins1, Ins2, Acc3, Acc2, W3, W2], RecursiveCall), - compile_aux([ - Base, - (RecursionHead :- Apply, RecursiveCall) - ], Mod). + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(foldl2, 7, Proto, GoalName), + append(MetaVars, [List1, List2, AccIn, AccOut, W0, W], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[], [], Acc, Acc, W, W], Base), + append_args(HeadPrefix, [[In1|Ins1], [In2|Ins2], Acc1, Acc2, W1, W2], RecursionHead), + append_args(Pred, [In1, In2, Acc1, Acc3, W1, W3], Apply), + append_args(HeadPrefix, [Ins1, Ins2, Acc3, Acc2, W3, W2], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- Apply, RecursiveCall) + ], Mod). goal_expansion(foldl2(Meta, List1, List2, List3, AccIn, AccOut, W0, W), Mod:Goal) :- - goal_expansion_allowed, - callable(Meta), - prolog_load_context(module, Mod), - aux_preds(Meta, MetaVars, Pred, PredVars, Proto), - !, - % the new goal - pred_name(foldl2, 7, Proto, GoalName), - append(MetaVars, [List1, List2, List3, AccIn, AccOut, W0, W], GoalArgs), - Goal =.. [GoalName|GoalArgs], - % the new predicate declaration - HeadPrefix =.. [GoalName|PredVars], - append_args(HeadPrefix, [[], [], [], Acc, Acc, W, W], Base), - append_args(HeadPrefix, [[In1|Ins1], [In2|Ins2], [In3|Ins3], Acc1, Acc2, W1, W2], RecursionHead), - append_args(Pred, [In1, In2, In3, Acc1, Acc3, W1, W3], Apply), - append_args(HeadPrefix, [Ins1, Ins2, Ins3, Acc3, Acc2, W3, W2], RecursiveCall), - compile_aux([ - Base, - (RecursionHead :- Apply, RecursiveCall) - ], Mod). + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(foldl2, 7, Proto, GoalName), + append(MetaVars, [List1, List2, List3, AccIn, AccOut, W0, W], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[], [], [], Acc, Acc, W, W], Base), + append_args(HeadPrefix, [[In1|Ins1], [In2|Ins2], [In3|Ins3], Acc1, Acc2, W1, W2], RecursionHead), + append_args(Pred, [In1, In2, In3, Acc1, Acc3, W1, W3], Apply), + append_args(HeadPrefix, [Ins1, Ins2, Ins3, Acc3, Acc2, W3, W2], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- Apply, RecursiveCall) + ], Mod). goal_expansion(foldl3(Meta, List, AccIn, AccOut, W0, W, X0, X), Mod:Goal) :- - goal_expansion_allowed, - callable(Meta), - prolog_load_context(module, Mod), - aux_preds(Meta, MetaVars, Pred, PredVars, Proto), - !, - % the new goal - pred_name(foldl3, 8, Proto, GoalName), - append(MetaVars, [List, AccIn, AccOut, W0, W, X0, X], GoalArgs), - Goal =.. [GoalName|GoalArgs], - % the new predicate declaration - HeadPrefix =.. [GoalName|PredVars], - append_args(HeadPrefix, [[], Acc, Acc, W, W, X, X], Base), - append_args(HeadPrefix, [[In|Ins], Acc1, Acc2, W1, W2, X1, X2], RecursionHead), - append_args(Pred, [In, Acc1, Acc3, W1, W3, X1, X3], Apply), - append_args(HeadPrefix, [Ins, Acc3, Acc2, W3, W2, X3, X2], RecursiveCall), - compile_aux([ - Base, - (RecursionHead :- Apply, RecursiveCall) - ], Mod). + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(foldl3, 8, Proto, GoalName), + append(MetaVars, [List, AccIn, AccOut, W0, W, X0, X], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[], Acc, Acc, W, W, X, X], Base), + append_args(HeadPrefix, [[In|Ins], Acc1, Acc2, W1, W2, X1, X2], RecursionHead), + append_args(Pred, [In, Acc1, Acc3, W1, W3, X1, X3], Apply), + append_args(HeadPrefix, [Ins, Acc3, Acc2, W3, W2, X3, X2], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- Apply, RecursiveCall) + ], Mod). goal_expansion(foldl4(Meta, List, AccIn, AccOut, W0, W, X0, X, Y0, Y), Mod:Goal) :- - goal_expansion_allowed, - callable(Meta), - prolog_load_context(module, Mod), - aux_preds(Meta, MetaVars, Pred, PredVars, Proto), - !, - % the new goal - pred_name(foldl4, 8, Proto, GoalName), - append(MetaVars, [List, AccIn, AccOut, W0, W, X0, X, Y0, Y], GoalArgs), - Goal =.. [GoalName|GoalArgs], - % the new predicate declaration - HeadPrefix =.. [GoalName|PredVars], - append_args(HeadPrefix, [[], Acc, Acc, W, W, X, X, Y, Y], Base), - append_args(HeadPrefix, [[In|Ins], Acc1, Acc2, W1, W2, X1, X2, Y1, Y2], RecursionHead), - append_args(Pred, [In, Acc1, Acc3, W1, W3, X1, X3, Y1, Y3], Apply), - append_args(HeadPrefix, [Ins, Acc3, Acc2, W3, W2, X3, X2, Y3, Y2], RecursiveCall), - compile_aux([ - Base, - (RecursionHead :- Apply, RecursiveCall) - ], Mod). + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(foldl4, 8, Proto, GoalName), + append(MetaVars, [List, AccIn, AccOut, W0, W, X0, X, Y0, Y], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[], Acc, Acc, W, W, X, X, Y, Y], Base), + append_args(HeadPrefix, [[In|Ins], Acc1, Acc2, W1, W2, X1, X2, Y1, Y2], RecursionHead), + append_args(Pred, [In, Acc1, Acc3, W1, W3, X1, X3, Y1, Y3], Apply), + append_args(HeadPrefix, [Ins, Acc3, Acc2, W3, W2, X3, X2, Y3, Y2], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- Apply, RecursiveCall) + ], Mod). goal_expansion(mapnodes(Meta, InTerm, OutTerm), Mod:Goal) :- - goal_expansion_allowed, - callable(Meta), - prolog_load_context(module, Mod), - aux_preds(Meta, MetaVars, Pred, PredVars, Proto), - !, - % the new goal - pred_name(mapnodes, 3, Proto, GoalName), - append(MetaVars, [[InTerm], [OutTerm]], GoalArgs), - Goal =.. [GoalName|GoalArgs], - % the new predicate declaration - HeadPrefix =.. [GoalName|PredVars], - append_args(HeadPrefix, [[], []], Base), - append_args(HeadPrefix, [[In|Ins], [Out|Outs]], RecursionHead), - append_args(Pred, [In, Temp], Apply), - append_args(HeadPrefix, [InArgs, OutArgs], SubRecursiveCall), - append_args(HeadPrefix, [Ins, Outs], RecursiveCall), - compile_aux([ - Base, - (RecursionHead :- - Apply, - (compound(Temp) - -> - Temp =.. [F|InArgs], - SubRecursiveCall, - Out =.. [F|OutArgs] - ; - Out = Temp - ), - RecursiveCall) - ], Mod). + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(mapnodes, 3, Proto, GoalName), + append(MetaVars, [[InTerm], [OutTerm]], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[], []], Base), + append_args(HeadPrefix, [[In|Ins], [Out|Outs]], RecursionHead), + append_args(Pred, [In, Temp], Apply), + append_args(HeadPrefix, [InArgs, OutArgs], SubRecursiveCall), + append_args(HeadPrefix, [Ins, Outs], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- + Apply, + (compound(Temp) + -> + Temp =.. [F|InArgs], + SubRecursiveCall, + Out =.. [F|OutArgs] + ; + Out = Temp + ), + RecursiveCall) + ], Mod). goal_expansion(checknodes(Meta, Term), Mod:Goal) :- - goal_expansion_allowed, - callable(Meta), - prolog_load_context(module, Mod), - aux_preds(Meta, MetaVars, Pred, PredVars, Proto), - !, - % the new goal - pred_name(checknodes, 2, Proto, GoalName), - append(MetaVars, [[Term]], GoalArgs), - Goal =.. [GoalName|GoalArgs], - % the new predicate declaration - HeadPrefix =.. [GoalName|PredVars], - append_args(HeadPrefix, [[]], Base), - append_args(HeadPrefix, [[In|Ins]], RecursionHead), - append_args(Pred, [In], Apply), - append_args(HeadPrefix, [Args], SubRecursiveCall), - append_args(HeadPrefix, [Ins], RecursiveCall), - compile_aux([ - Base, - (RecursionHead :- - Apply, - (compound(In) - -> - In =.. [_|Args],SubRecursiveCall - ; - true - ), - RecursiveCall) - ], Mod). + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(checknodes, 2, Proto, GoalName), + append(MetaVars, [[Term]], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[]], Base), + append_args(HeadPrefix, [[In|Ins]], RecursionHead), + append_args(Pred, [In], Apply), + append_args(HeadPrefix, [Args], SubRecursiveCall), + append_args(HeadPrefix, [Ins], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- + Apply, + (compound(In) + -> + In =.. [_|Args],SubRecursiveCall + ; + true + ), + RecursiveCall) + ], Mod). goal_expansion(sumnodes(Meta, Term, AccIn, AccOut), Mod:Goal) :- - goal_expansion_allowed, - callable(Meta), - prolog_load_context(module, Mod), - aux_preds(Meta, MetaVars, Pred, PredVars, Proto), - !, - % the new goal - pred_name(sumnodes, 4, Proto, GoalName), - append(MetaVars, [[Term], AccIn, AccOut], GoalArgs), - Goal =.. [GoalName|GoalArgs], - % the new predicate declaration - HeadPrefix =.. [GoalName|PredVars], - append_args(HeadPrefix, [[], Acc, Acc], Base), - append_args(HeadPrefix, [[In|Ins], Acc1, Acc2], RecursionHead), - append_args(Pred, [In, Acc1, Acc3], Apply), - append_args(HeadPrefix, [Args, Acc3, Acc4], SubRecursiveCall), - append_args(HeadPrefix, [Ins, Acc4, Acc2], RecursiveCall), - compile_aux([ - Base, - (RecursionHead :- - Apply, - (compound(In) - -> - In =.. [_|Args],SubRecursiveCall - ; - Acc3 = Acc4 - ), - RecursiveCall) - ], Mod). + goal_expansion_allowed, + callable(Meta), + prolog_load_context(module, Mod), + aux_preds(Meta, MetaVars, Pred, PredVars, Proto), + !, + % the new goal + pred_name(sumnodes, 4, Proto, GoalName), + append(MetaVars, [[Term], AccIn, AccOut], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[], Acc, Acc], Base), + append_args(HeadPrefix, [[In|Ins], Acc1, Acc2], RecursionHead), + append_args(Pred, [In, Acc1, Acc3], Apply), + append_args(HeadPrefix, [Args, Acc3, Acc4], SubRecursiveCall), + append_args(HeadPrefix, [Ins, Acc4, Acc2], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- + Apply, + (compound(In) + -> + In =.. [_|Args],SubRecursiveCall + ; + Acc3 = Acc4 + ), + RecursiveCall) + ], Mod). /** @} diff --git a/library/maputils.yap b/library/maputils.yap index 1846e27a2..372a17fe4 100644 --- a/library/maputils.yap +++ b/library/maputils.yap @@ -1,3 +1,4 @@ + /** * @file maputils.yap * @author VITOR SANTOS COSTA @@ -27,6 +28,14 @@ */ :- use_module(library(lists), [append/3]). +%% goal_expansion_allowed is semidet. +% +% `True` if we can use +% goal-expansion. +goal_expansion_allowed :- + once( prolog_load_context(_, _) ), % make sure we are compiling. + \+ current_prolog_flag(xref, true). + :- dynamic number_of_expansions/1. number_of_expansions(0). @@ -95,14 +104,6 @@ transformation_id(Id) :- assert(number_of_expansions(Id1)). transformation_id(0). -%% goal_expansion_allowed is semidet. -% -% `True` if we can use -% goal-expansion. -goal_expansion_allowed :- - once( prolog_load_context(_, _) ), % make sure we are compiling. - \+ current_prolog_flag(xref, true). - /** @} */ diff --git a/library/matrix/CMakeLists.txt b/library/matrix/CMakeLists.txt index 187fa8f3a..57f5eeed2 100644 --- a/library/matrix/CMakeLists.txt +++ b/library/matrix/CMakeLists.txt @@ -1,5 +1,5 @@ -add_lib(matrix matrix.c) +add_library(matrix matrix.c) target_link_libraries(matrix libYap) diff --git a/library/random/CMakeLists.txt b/library/random/CMakeLists.txt index 6503599fc..42768b896 100644 --- a/library/random/CMakeLists.txt +++ b/library/random/CMakeLists.txt @@ -1,13 +1,10 @@ set( LIBRANDOM_SOURCES yap_random.c) -add_lib(yap_random ${LIBRANDOM_SOURCES}) -if (ANDROID) -else() +add_library(yap_random ${LIBRANDOM_SOURCES}) target_link_libraries(yap_random libYap) set_target_properties (yap_random PROPERTIES PREFIX "") -endif() MY_install(TARGETS yap_random LIBRARY DESTINATION ${YAP_INSTALL_LIBDIR} diff --git a/library/regex/CMakeLists.txt b/library/regex/CMakeLists.txt index 37e32e7db..47061a25a 100644 --- a/library/regex/CMakeLists.txt +++ b/library/regex/CMakeLists.txt @@ -17,7 +17,7 @@ set ( REGEX_SOURCES -add_lib(regexp regexp.c ${REGEX_SOURCES}) +add_library(regexp regexp.c ${REGEX_SOURCES}) target_link_libraries(regexp libYap) diff --git a/library/rltree/CMakeLists.txt b/library/rltree/CMakeLists.txt index d5159263e..b9578fdc0 100644 --- a/library/rltree/CMakeLists.txt +++ b/library/rltree/CMakeLists.txt @@ -4,7 +4,7 @@ set ( RLTREE_SOURCES range_list.h ) -add_lib(yap_rl yap_rl.c ${RLTREE_SOURCES}) +add_library(yap_rl yap_rl.c ${RLTREE_SOURCES}) target_link_libraries(yap_rl libYap) diff --git a/library/system/CMakeLists.txt b/library/system/CMakeLists.txt index cc891c468..8683fd1ad 100644 --- a/library/system/CMakeLists.txt +++ b/library/system/CMakeLists.txt @@ -2,7 +2,7 @@ set( LIBSYSTEM_SOURCES sys.c crypto/md5.c ) set( LIBSYSTEM_HEADERS crypto/md5.h) -add_lib(sys ${LIBSYSTEM_SOURCES}) +add_library(sys ${LIBSYSTEM_SOURCES}) if (ANDROID) set (TARGET libYap) else() diff --git a/library/system/sys.c b/library/system/sys.c index 446a69984..393383ebd 100644 --- a/library/system/sys.c +++ b/library/system/sys.c @@ -237,8 +237,10 @@ static YAP_Bool list_directory(void) { #else #if __ANDROID__ { + extern AAssetManager *Yap_assetManager(void); + const char *dirName = buf + strlen("/assets/"); - AAssetManager *mgr = GLOBAL_VFS->priv[0].mgr; + AAssetManager *mgr = Yap_assetManager(); AAssetDir *de; const char *dp; diff --git a/library/tries/CMakeLists.txt b/library/tries/CMakeLists.txt index 5254208f8..67202b0a3 100644 --- a/library/tries/CMakeLists.txt +++ b/library/tries/CMakeLists.txt @@ -6,7 +6,7 @@ set ( TRIES_SOURCES tries.c ) -add_lib(tries ${TRIES_SOURCES}) +add_library(tries ${TRIES_SOURCES}) target_link_libraries(tries libYap) @@ -27,7 +27,7 @@ set ( ITRIES_SOURCES if (ANDROID OR WIN32) add_component ( otries ${TRIES_SOURCES} ) endif() -add_lib(itries ${ITRIES_SOURCES}) +add_library(itries ${ITRIES_SOURCES}) target_link_libraries(itries libYap) diff --git a/os/CMakeLists.txt b/os/CMakeLists.txt index 03b8fba72..628c097c4 100644 --- a/os/CMakeLists.txt +++ b/os/CMakeLists.txt @@ -1,5 +1,6 @@ set (YAPOS_HEADERS getw.h + iopreds.h yapio.h YapEncoding.h @@ -62,12 +63,7 @@ set (POSITION_INDEPENDENT_CODE TRUE) yio.yap ) -add_to_group( YAPOS_PL_SOURCES pl_os_library) +add_to_dir(YAPOS PL_SOURCES ${YAP_INSTALL_DATADIR}/os) - - if (ANDROID) - file(INSTALL ${YAPOS_PL_SOURCES} DESTINATION ${YAP_INSTALL_DATADIR}/os) -else() - install (FILES ${YAPOS_PL_SOURCES} + install (FILES ${YAPOS_PL_SOURCES} DESTINATION ${YAP_INSTALL_DATADIR}/os ) -endif() diff --git a/os/assets.c b/os/assets.c index b19fb5b15..18c7ae937 100644 --- a/os/assets.c +++ b/os/assets.c @@ -77,7 +77,7 @@ open_asset(VFS_t *me, const char *fname, const char *io_mode, int sno) { // AAssetDir *dp = AAssetManager_openDir( Yap_assetManager(), dirname(dir) ); // strcpy(dir, fname); // char *d = basename(dir); - am = AAssetManager_open(Yap_assetManager(), fname, io_mode); + am = AAssetManager_open(Yap_assetManager(), fname, AASSET_MODE_UNKNOWN); //if (am==NULL) // __android_log_print(ANDROID_LOG_INFO, "YAPDroid", "failed open %s <%s>", fname, strerror(errno) ); __android_log_print(ANDROID_LOG_INFO, "YAPDroid", "open %s <%s>", fname, io_mode); diff --git a/os/sysbits.c b/os/sysbits.c index 1f0794b2b..966ee2eaf 100644 --- a/os/sysbits.c +++ b/os/sysbits.c @@ -799,6 +799,7 @@ static const param_t expand_filename_defs[] = {EXPAND_FILENAME_DEFS()}; static Term do_expand_file_name(Term t1, Term opts USES_REGS) { xarg *args; expand_filename_enum_choices_t i; + bool use_system_expansion = true; const char *tmpe = NULL; const char *spec; @@ -1046,10 +1047,10 @@ static bool initSysPath(Term tlib, Term tcommons, bool dir_done, bool commons_done) { CACHE_REGS - if (!Yap_unify(tlib, MkAtomTerm(Yap_LookupAtom(Yap_PLDIR)))) + if (!Yap_PLDIR || !Yap_unify(tlib, MkAtomTerm(Yap_LookupAtom(Yap_PLDIR)))) return false; - return Yap_unify(tcommons, MkAtomTerm(Yap_LookupAtom(Yap_COMMONSDIR))); + return Yap_COMMONSDIR && Yap_unify(tcommons, MkAtomTerm(Yap_LookupAtom(Yap_COMMONSDIR))); } static Int libraries_directories(USES_REGS1) { @@ -1057,21 +1058,7 @@ static Int libraries_directories(USES_REGS1) { } static Int system_library(USES_REGS1) { -#if __ANDROID__ - static Term dir = 0; - Term t; - if (IsVarTerm(t = Deref(ARG1))) { - if (dir == 0) - return false; - return Yap_unify(dir, ARG1); - } - if (!IsAtomTerm(t)) - return false; - dir = t; - return true; -#else return initSysPath(ARG1, MkVarTerm(), false, true); -#endif } static Int commons_library(USES_REGS1) { diff --git a/packages/CLPBN/horus/CMakeLists.txt b/packages/CLPBN/horus/CMakeLists.txt index d86699a32..398582a5c 100644 --- a/packages/CLPBN/horus/CMakeLists.txt +++ b/packages/CLPBN/horus/CMakeLists.txt @@ -45,14 +45,14 @@ if (CMAKE_MAJOR_VERSION GREATER 2) ${CMAKE_CURRENT_SOURCE_DIR} ) - ADD_LIB(horus ${HORUS_SOURCES} HorusYap.cpp ) + add_library(horus ${HORUS_SOURCES} HorusYap.cpp ) if(DEFINED YAP_MAJOR_VERSION) TARGET_LINK_LIBRARIES(horus libYap ) else() - ADD_LIB(horus ${HORUS_SOURCES} ) + add_library(horus ${HORUS_SOURCES} ) endif() #set_property(TARGET horus PROPERTY CXX_STANDARD 11) diff --git a/packages/CMakeLists.txt b/packages/CMakeLists.txt index 436d9f9d8..7f7f2ce78 100644 --- a/packages/CMakeLists.txt +++ b/packages/CMakeLists.txt @@ -33,7 +33,7 @@ if (GECODE_FOUND) WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} ) - add_lib(gecode_yap ${GECODE_SOURCES}) + add_library(gecode_yap ${GECODE_SOURCES}) target_link_libraries(gecode_yap libYap ${GECODE_LIBRARIES}) diff --git a/packages/cplint/CMakeLists.txt b/packages/cplint/CMakeLists.txt index 01e2af35d..0b9767cf4 100644 --- a/packages/cplint/CMakeLists.txt +++ b/packages/cplint/CMakeLists.txt @@ -132,7 +132,7 @@ IF (CUDD_FOUND) ${CMAKE_CURRENT_BINARY_DIR}/../bdd ) - add_lib(bddem + add_library(bddem ${BDDEM_SOURCES} ) @@ -154,7 +154,7 @@ IF (CUDD_FOUND) ) - add_lib(cplint + add_library(cplint ${CPLINT_SOURCES} ) diff --git a/packages/cuda/CMakeLists.txt b/packages/cuda/CMakeLists.txt index 1582d0dca..e2f864430 100644 --- a/packages/cuda/CMakeLists.txt +++ b/packages/cuda/CMakeLists.txt @@ -77,7 +77,7 @@ cuda.c cuda.yap ) - cuda_add_lib(libcuda ${CUDA_SOURCES}) + cuda_add_library(libcuda ${CUDA_SOURCES}) target_link_libraries(libcuda libYap ${CUDA_LIBRARIES} ${CUDA_npp_LIBRARY} # ${CUDA_nppc_LIBRARY} diff --git a/packages/gecode/CMakeLists.txt b/packages/gecode/CMakeLists.txt index 8257f1fa7..75efe5f0d 100644 --- a/packages/gecode/CMakeLists.txt +++ b/packages/gecode/CMakeLists.txt @@ -32,7 +32,7 @@ if (GECODE_FOUND) WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} ) - add_lib(gecode_yap ${GECODE_SOURCES}) + add_library(gecode_yap ${GECODE_SOURCES}) target_link_libraries(gecode_yap libYap ${GECODE_LIBRARIES}) diff --git a/packages/myddas/CMakeLists.txt b/packages/myddas/CMakeLists.txt index 8ad4309c2..e16746177 100644 --- a/packages/myddas/CMakeLists.txt +++ b/packages/myddas/CMakeLists.txt @@ -13,7 +13,9 @@ set(MYDDAS_SOURCES myddas_top_level.c ) -include_directories(. sqlite3) +set_property(DIRECTORY + APPEND PROPERTY + INCLUDE_DIRECTORIES ${CMAKE_CURRENT_SOURCE_DIR} ${CMAKE_CURRENT_SOURCE_DIR}/sqlite3) set(MYDDAS_HEADERS @@ -21,27 +23,19 @@ set(MYDDAS_HEADERS myddas_statistics.h myddas_statistics_structs.h myddas_structs.h - myddas_top_level.c myddas_types.h) set(MYDDAS_UTIL_SOURCES myddas_util.c myddas_initialization.c) -set (MYDDAS_FLAGS -DUSE_MYDDAS=1) -set_property(GLOBAL - APPEND PROPERTY - COMPILE_DEFINITIONS - -DUSE_MYDDAS=1) - -include_directories(. sqlite3) add_subdirectory(sqlite3) -if (NOT ANDROID) add_subdirectory(mysql) add_subdirectory(odbc) add_subdirectory(postgres) -endif() + + set(CXX_SWIG_OUTDIR ${CMAKE_BINARY_DIR}/packages/swig/android) add_component(myddas ${MYDDAS_SOURCES} diff --git a/packages/myddas/myddas.h b/packages/myddas/myddas.h index f9c25bd11..d40bf95d0 100644 --- a/packages/myddas/myddas.h +++ b/packages/myddas/myddas.h @@ -1,3 +1,5 @@ + + #ifndef __MYDDAS_H__ #define __MYDDAS_H__ diff --git a/packages/myddas/myddas_initialization.c b/packages/myddas/myddas_initialization.c index 893eb7079..77b94424c 100644 --- a/packages/myddas/myddas_initialization.c +++ b/packages/myddas/myddas_initialization.c @@ -1,7 +1,6 @@ #include #include -#include #include "Yap.h" #include "myddas.h" #ifdef MYDDAS_STATS diff --git a/packages/myddas/myddas_shared.c b/packages/myddas/myddas_shared.c index e150165e3..9061cc05c 100644 --- a/packages/myddas/myddas_shared.c +++ b/packages/myddas/myddas_shared.c @@ -20,7 +20,7 @@ #include -#ifdef USE_MYDDAS +#ifdef MYDDAS #include "myddas.h" @@ -689,9 +689,9 @@ void init_myddas(void) { { return; } -#if USE_MYDDAS - Term cm=CurrentModule; - CurrentModule = USER_MODULE; +#if MYDDAS +Yap_InitMYDDAS_SharedPreds(); + Yap_InitBackMYDDAS_SharedPreds(); #define stringify(X) _stringify(X) #define _stringify(X) #X Yap_REGS.MYDDAS_GLOBAL_POINTER = NULL; @@ -699,26 +699,15 @@ void init_myddas(void) { MkAtomTerm(Yap_LookupAtom(stringify(MYDDAS_VERSION)))); Yap_HaltRegisterHook((HaltHookFunc)Yap_MYDDAS_delete_all_myddas_structs, NULL); - Yap_InitMYDDAS_SharedPreds(); - Yap_InitBackMYDDAS_SharedPreds(); #undef stringify #undef _stringify Yap_MYDDAS_delete_all_myddas_structs(); -#if defined MYDDAS_ODBC - Yap_InitBackMYDDAS_ODBCPreds(); - Yap_InitMYDDAS_ODBCPreds(); -#endif #if defined MYDDAS_TOP_LEVEL && \ defined MYDDAS_MYSQL // && defined HAVE_LIBREADLINE Yap_InitMYDDAS_TopLevelPreds(); -#endif - c_db_initialize_myddas(PASS_REGS1); -#ifdef __ANDROID__ - init_sqlite3(); #endif #endif myddas_initialised = true; - CurrentModule = cm; } #ifdef _WIN32 diff --git a/packages/myddas/mysql/CMakeLists.txt b/packages/myddas/mysql/CMakeLists.txt index 11ea1a432..34bb4587b 100644 --- a/packages/myddas/mysql/CMakeLists.txt +++ b/packages/myddas/mysql/CMakeLists.txt @@ -24,7 +24,7 @@ if (WITH_MYSQL) if (WIN32) add_library(YAPmysql OBJECT ${MYSQL_SOURCES}) else() - add_lib(YAPmysql ${MYSQL_SOURCES}) + add_library(YAPmysql ${MYSQL_SOURCES}) target_link_libraries(YAPmysql ${MYSQL_LIBRARIES} libYap) install(TARGETS YAPmysql RUNTIME DESTINATION ${YAP_INSTALL_LIBDIR} @@ -32,7 +32,7 @@ if (WITH_MYSQL) LIBRARY DESTINATION ${YAP_INSTALL_LIBDIR} ) endif() - include_directories(${MYSQL_INCLUDE_DIR} ..) + include_directories(${MYSQL_INCLUDE_DIR} ${CMAKE_CURRENT_SOURCE_DIR}/..) set_target_properties(YAPmysql PROPERTIES POSITION_INDEPENDENT_CODE ON PREFIX "" diff --git a/packages/myddas/odbc/CMakeLists.txt b/packages/myddas/odbc/CMakeLists.txt index 10f569118..40b4ea886 100644 --- a/packages/myddas/odbc/CMakeLists.txt +++ b/packages/myddas/odbc/CMakeLists.txt @@ -14,21 +14,17 @@ if (WITH_ODBC) # ODBC_INCLUDE_DIRECTORIES, where to find sql.h # ODBC_LIBRARIES, the libraries to link against to use ODBC # ODBC_FOUND. If false, you cannot build anything that requires Odbc. - add_lib(YAPodbc ${YAPODBC_SOURCES}) + add_library(YAPodbc ${YAPODBC_SOURCES}) target_link_libraries(YAPodbc libYap ${ODBC_LIBRARIES}) - include_directories (${ODBC_INCLUDE_DIRECTORIES} ..) - +set_property(DIRECTORY + APPEND PROPERTY + INCLUDE_DIRECTORIES ${ODBC_INCLUDE_DIRECTORIES} ${CMAKE_CURRENT_BINARY_DIR}/.. ${CMAKE_CURRENT_BINARY_DIR} ) + set_target_properties (YAPodbc PROPERTIES POSITION_INDEPENDENT_CODE ON PREFIX "" ) - list (APPEND MYDDAS_FLAGS -DMYDDAS_ODBC=1) - set (MYDDAS_FLAGS ${MYDDAS_FLAGS} ON PARENT_SCOPE) - set_property(GLOBAL APPEND PROPERTY COMPILE_DEFINITIONS - -DMYDDAS_ODBC=1) - - install(TARGETS YAPodbc LIBRARY DESTINATION ${YAP_INSTALL_LIBDIR} RUNTIME DESTINATION ${YAP_INSTALL_LIBDIR} diff --git a/packages/myddas/odbc/myddas_odbc.c b/packages/myddas/odbc/myddas_odbc.c index c2b2d16df..9d6d4d611 100644 --- a/packages/myddas/odbc/myddas_odbc.c +++ b/packages/myddas/odbc/myddas_odbc.c @@ -15,7 +15,7 @@ * * *************************************************************************/ -#if defined MYDDAS_ODBC +#if MYDDAS_ODBC #if !defined(ODBCVER) typedef void *SQLHDBC; diff --git a/packages/myddas/pl/CMakeLists.txt b/packages/myddas/pl/CMakeLists.txt index 09320f558..0e4afc8f9 100644 --- a/packages/myddas/pl/CMakeLists.txt +++ b/packages/myddas/pl/CMakeLists.txt @@ -23,6 +23,7 @@ foreach (filename ${MYDDAS_YPP}) get_filename_component(base ${filename} NAME_WE) set(base_abs ${MYDDAS_PL_OUTDIR}/${base}) set(outfile ${base_abs}.yap) + list(APPEND MYDDAS_YAP_FILES ${outfile}) execute_process( COMMAND ${CMAKE_C_COMPILER} ${MYDDAS_FLAGS} -x c -E -P -w ${CMAKE_CURRENT_SOURCE_DIR}/${filename} -o ${outfile} ) @@ -30,6 +31,7 @@ foreach (filename ${MYDDAS_YPP}) endforeach () foreach (dbms ${MYDDAS_DBMS} ) set(outfile ${MYDDAS_PL_OUTDIR}/myddas_${dbms}.yap) + list(APPEND MYDDAS_YAP_FILES ${outfile}) execute_process( COMMAND ${CMAKE_C_COMPILER} -D${dbms} -x c -E -P -w ${CMAKE_CURRENT_SOURCE_DIR}/myddas_driver.ypp -o ${outfile} ) @@ -37,8 +39,6 @@ foreach (dbms ${MYDDAS_DBMS} ) set_source_files_properties(outfile PROPERTIES GENERATED TRUE) endforeach() + list(APPEND MYDDAS_YAP_FILES ${CMAKE_CURRENT_SOURCE_DIR}/../sqlite3/sqlitest.yap ${CMAKE_CURRENT_SOURCE_DIR}/../sqlite3/chinook.db) - set( MYDDAS_YAP ${CMAKE_CURRENT_SOURCE_DIR}/../sqlite3/sqlitest.yap ${CMAKE_CURRENT_SOURCE_DIR}/../sqlite3/chinook.db) - add_to_group(MYDDAS_YAP pl_library ) - file(INSTALL ${MYDDAS_YAP} - DESTINATION ${MYDDAS_PL_OUTDIR} ) + install(FILES ${MYDDAS_YAP_FILES} DESTINATION ${YAP_INSTALL_DATADIR}) diff --git a/packages/myddas/pl/myddas.ypp b/packages/myddas/pl/myddas.ypp index 21bcabeb6..40b1ca32e 100644 --- a/packages/myddas/pl/myddas.ypp +++ b/packages/myddas/pl/myddas.ypp @@ -15,11 +15,6 @@ * * *************************************************************************/ -%%:- load_foreign_files([myddas], [], init_myddas). - -/* Initialize MYDDAS GLOBAL STRUCTURES */ -:- c_db_initialize_myddas. - #ifdef DEBUG :- yap_flag(single_var_warnings,on). :- yap_flag(write_strings,on). @@ -114,6 +109,12 @@ % myddas_mysql.ypp ]). + +:- load_foreign_files([myddas], [], init_myddas). + +/* Initialize MYDDAS GLOBAL STRUCTURES */ +:- c_db_initialize_myddas. + #ifdef MYDDAS_TOP_LEVEL :- use_module(myddas_top_level,[ db_top_level/4, diff --git a/packages/myddas/pl/myddas_driver.ypp b/packages/myddas/pl/myddas_driver.ypp index 4e94b3327..9431bf116 100644 --- a/packages/myddas/pl/myddas_driver.ypp +++ b/packages/myddas/pl/myddas_driver.ypp @@ -76,9 +76,7 @@ '$make_a_list'/2, '$write_or_not'/1 ]). -#ifndef __ANDROID__ :- load_foreign_files( [NAME()], [], INIT()). -#endif %-------------------------------------------------------- % Public Predicates diff --git a/packages/myddas/postgres/CMakeLists.txt b/packages/myddas/postgres/CMakeLists.txt index fcdd547fd..8fb6899ee 100644 --- a/packages/myddas/postgres/CMakeLists.txt +++ b/packages/myddas/postgres/CMakeLists.txt @@ -16,9 +16,12 @@ if (WITH_POSTGRES) # PostgreSQL_INCLUDE_DIRS - Include directories for PostgreSQL # PostgreSQL_LIBRARY_DIRS - Link directories for PostgreSQL libraries # PostgreSQL_LIBRARIES - The PostgreSQL libraries. - add_lib(YAPpostgres ${YAPPOSTGRES_SOURCES}) + add_library(YAPpostgres ${YAPPOSTGRES_SOURCES}) target_link_libraries(YAPpostgres libYap ${PostgreSQL_LIBRARIES}) - include_directories (${PostgreSQL_INCLUDE_DIRS} ..) + set_property(DIRECTORY + APPEND PROPERTY + INCLUDE_DIRECTORIES ${PostgreSQL_INCLUDE_DIRS} ${CMAKE_CURRENT_SOURCE_DIR}/.. ) + set_target_properties (YAPpostgres PROPERTIES POSITION_INDEPENDENT_CODE ON PREFIX "" diff --git a/packages/myddas/sqlite3/CMakeLists.txt b/packages/myddas/sqlite3/CMakeLists.txt index e8ad0d501..f06bd65ed 100644 --- a/packages/myddas/sqlite3/CMakeLists.txt +++ b/packages/myddas/sqlite3/CMakeLists.txt @@ -1,7 +1,6 @@ -if (WITH_SQLITE3) - message( " * Sqlite3 Data-Base (http://www.sqlite3.org), distributed with MYDDAS" ) + if (WITH_SQLITE3) set (SQLITE_TEST sqlitest.yap) @@ -9,21 +8,23 @@ if (WITH_SQLITE3) set( YAPSQLITE3_SOURCES myddas_sqlite3.c - src/sqlite3.h - src/sqlite3ext.h ) + message( " * Sqlite3 Data-Base (http://www.sqlite3.org), distributed with MYDDAS" ) + + add_to_dir(SQLITE_DB ${YAP_INSTALL_DATADIR}) + add_to_dir( SQLITE_TEST ${YAP_INSTALL_DATADIR}) + #sqlite3 is now in the system set (SQLITE3_FOUND ON CACHE PRIVATE "") - include_directories ( ${CMAKE_CURRENT_SOURCE_DIR} ${CMAKE_CURRENT_SOURCE_DIR}/..) +set_property(DIRECTORY + APPEND PROPERTY + INCLUDE_DIRECTORIES ${CMAKE_CURRENT_SOURCE_DIR}/.. ${CMAKE_CURRENT_SOURCE_DIR}/src ) - if (ANDROID) - add_definitions(-DSQLITE_FCNTL_MMAP_SIZE=0 ) - endif() add_definitions(-DSQLITE_ENABLE_COLUMN_METADATA=1 ) @@ -36,16 +37,18 @@ if (WITH_SQLITE3) SET_PROPERTY(DIRECTORY PROPERTY COMPILE_DEFINITIONS YAP_KERNEL=1 ) +message("ql ${EMBEDDED_SQLITE3}") + message( " * Sqlite3 Data-Base (http://www.sqlite3.org), distributed with MYDDAS" ) + if ( ANDROID ) + add_definitions(-DSQLITE_FCNTL_MMAP_SIZE=0 ) - if (ANDROID ) - add_library( YAPsqlite3 OBJECT + add_library( YAPsqlite3 OBJECT ${YAPSQLITE3_SOURCES} ) - else() + list(APPEND YAPSQLITE3_SOURCES src/sqlite3.c) - add_library( YAPsqlite3 SHARED ${YAPSQLITE3_SOURCES}) @@ -67,11 +70,11 @@ if (WITH_SQLITE3) endif() install(FILES ${SQLITE_DB} - DESTINATION ${YAP_PLDIR}/data + DESTINATION ${YAP_INSTALL_DATADIR}/data ) install(FILES ${SQLITE_TEST} - DESTINATION ${YAP_PLDIR}/test + DESTINATION ${YAP_INSTALL_DATADIR}/test ) endif() diff --git a/packages/myddas/sqlite3/myddas_sqlite3.c b/packages/myddas/sqlite3/myddas_sqlite3.c index 77f214ab5..164ef0b27 100644 --- a/packages/myddas/sqlite3/myddas_sqlite3.c +++ b/packages/myddas/sqlite3/myddas_sqlite3.c @@ -673,7 +673,6 @@ static void Yap_InitBackMYDDAS_SQLITE3Preds(void) { X_API void init_sqlite3(void) { Term cm = CurrentModule; - CurrentModule = MkAtomTerm(Yap_LookupAtom("user")); Yap_InitMYDDAS_SQLITE3Preds(); diff --git a/packages/python/CMakeLists.txt b/packages/python/CMakeLists.txt index d6265477d..a648b535e 100644 --- a/packages/python/CMakeLists.txt +++ b/packages/python/CMakeLists.txt @@ -9,7 +9,7 @@ include_directories( BEFORE ${PYTHON_INCLUDE_DIRS} ${CMAKE_BINARY_DIR} ${CMAKE_SOURCE_DIR}/include ${CMAKE_SOURCE_DIR}/os ${CMAKE_SOURCE_DIR}/H ${CMAKE_SOURCE_DIR}/OPTYap ) #talk to python.pl -add_lib(YAPPython pyload.c ${PYTHON_HEADERS} ) +add_library(YAPPython pyload.c ${PYTHON_HEADERS} ) if (WIN32) @@ -48,8 +48,6 @@ set (PYTHON_PL python.pl) install(FILES python.pl DESTINATION ${YAP_INSTALL_DATADIR} ) -add_to_group( PYTHON_PL pl_library ) - set_target_properties (YAPPython PROPERTIES PREFIX "") install(TARGETS YAPPython diff --git a/packages/python/swig/CMakeLists.txt b/packages/python/swig/CMakeLists.txt index 551b6fea0..a852c48b3 100644 --- a/packages/python/swig/CMakeLists.txt +++ b/packages/python/swig/CMakeLists.txt @@ -79,9 +79,7 @@ endif() install(FILES ${YAP4PY_PL} DESTINATION ${YAP_INSTALL_DATADIR} ) - -add_to_group( YAP4PY_PL pl_library ) - + if (WITH_DOCS AND DOXYGEN_FOUND) set(CMAKE_SWIG_FLAGS -DDOXYGEN=${DOXYGEN_FOUND}) diff --git a/packages/python/swig/yapi.pybk b/packages/python/swig/yapi.pybk index 6a90cd34f..f4607e15b 100644 --- a/packages/python/swig/yapi.pybk +++ b/packages/python/swig/yapi.pybk @@ -98,7 +98,7 @@ def live(): args = yap.YAPEngineArgs() args.setYapShareDir(os.path.join(yap_lib_path,"prolog")) args.setYapLibDir(yap_lib_path) - #args.setYapPrologBootFile(os.path.join(yap_lib_path."startup.yss")) + #args.setYapPrologSOURCEBOOT(os.path.join(yap_lib_path."startup.yss")) engine = yap.YAPEngine(args) engine.goal( use_module(library('yapi') ) ) loop = True diff --git a/packages/raptor/CMakeLists.txt b/packages/raptor/CMakeLists.txt index 769172279..e86c6574b 100644 --- a/packages/raptor/CMakeLists.txt +++ b/packages/raptor/CMakeLists.txt @@ -39,7 +39,7 @@ if (WIN32) set( CMAKE_REQUIRED_LIBRARIES ${CMAKE_REQUIRED_LIBRARIES} ${LIBXML2_LIBRARIES} ) else (WIN32) - ADD_LIB(libxml2 ${LIBXML2_SOURCES} ) + add_library(libxml2 ${LIBXML2_SOURCES} ) if(DEFINED YAP_MAJOR_VERSION) TARGET_LINK_LIBRARIES(libxml2 @@ -88,7 +88,7 @@ IF (RAPTOR_FOUND) raptor_yap.c ) - ADD_LIB(raptor ${RAPTOR_SOURCES} ) + add_library(raptor ${RAPTOR_SOURCES} ) if(DEFINED YAP_MAJOR_VERSION) TARGET_LINK_LIBRARIES(raptor diff --git a/packages/real/CMakeLists.txt b/packages/real/CMakeLists.txt index ba6a37a26..cfb293196 100644 --- a/packages/real/CMakeLists.txt +++ b/packages/real/CMakeLists.txt @@ -16,7 +16,7 @@ set_package_properties(R PROPERTIES DESCRIPTION "The R Project for Statistical Computing." URL "https://www.r-project.org/") -add_lib(real ${REAL_SOURCES}) +add_library(real ${REAL_SOURCES}) target_link_libraries (real ${LIBR_LIBRARIES} libYap) include_directories ( ${CMAKE_CURRENT_BINARY_DIR} diff --git a/packages/swi-minisat2/C/CMakeLists.txt b/packages/swi-minisat2/C/CMakeLists.txt index e14a6216b..455a145d3 100644 --- a/packages/swi-minisat2/C/CMakeLists.txt +++ b/packages/swi-minisat2/C/CMakeLists.txt @@ -24,7 +24,7 @@ pl-minisat.C ${CMAKE_CURRENT_SOURCE_DIR} ) - ADD_LIB(minisat2 ${MINISAT2_SOURCES} ${MINISAT2_HEADERS} ) + add_library(minisat2 ${MINISAT2_SOURCES} ${MINISAT2_HEADERS} ) set_target_properties (minisat2 PROPERTIES OUTPUT_NAME pl-minisat) set_target_properties (minisat2 PROPERTIES PREFIX "") diff --git a/packages/swig/CMakeLists.txt b/packages/swig/CMakeLists.txt index 1c1438487..5d116096d 100644 --- a/packages/swig/CMakeLists.txt +++ b/packages/swig/CMakeLists.txt @@ -10,8 +10,6 @@ set (SOURCES yap.i) -INCLUDE(${SWIG_USE_FILE}) - if (ANDROID) add_subdirectory(android) else(ANDROID) diff --git a/packages/swig/android/CMakeLists.txt b/packages/swig/android/CMakeLists.txt index b46f9a6c9..5acb124a2 100644 --- a/packages/swig/android/CMakeLists.txt +++ b/packages/swig/android/CMakeLists.txt @@ -1,68 +1,42 @@ # This is a CMake file for SWIG and Android - set(JAVA_SWIG_OUTDIR ${CMAKE_SOURCE_DIR}/../yaplib/src/generated/java/pt/up/yap/lib) - set(SWIG_CXX_DIR ${CMAKE_BINARY_DIR}/src/generated/jni) - FILE(MAKE_DIRECTORY ${CMAKE_BINARY_DIR}/src/generated/java/pt/up/yap/lib) - FILE(MAKE_DIRECTORY ${CMAKE_BINARY_DIR}/src/generated/assets/Yap/pl) - FILE(MAKE_DIRECTORY ${CMAKE_BINARY_DIR}/src/generated/assets/so) - FILE(MAKE_DIRECTORY ${CMAKE_BINARY_DIR}/src/generated/jni) - set(YAP_ASSETS ${CMAKE_SOURCE_DIR}/../yaplib/src/generated/assets/Yap) + set(GENERATED_SOURCE_DIR ${CMAKE_SOURCE_DIR}/../yaplib/src/generated) + + set(JAVA_SWIG_OUTDIR ${GENERATED_SOURCE_DIR}/java/pt/up/yap/lib) set(SWIG_SOURCES ${CMAKE_SOURCE_DIR}/packages/swig/yap.i) SET_SOURCE_FILES_PROPERTIES(${SWIG_SOURCES} PROPERTIES CPLUSPLUS ON) + FILE( MAKE_DIRECTORY ${GENERATED_SOURCE_DIR}/assets/Yap/pl) + FILE( MAKE_DIRECTORY ${GENERATED_SOURCE_DIR}/assets/os) + + include_directories( + ${CMAKE_CURRENT_SOURCE_DIR} + ${CMAKE_CURRENT_BINARY_DIR} ${CMAKE_SOURCE_DIR}/CXX - ) - set(GMP_ROOT ${CMAKE_SOURCE_DIR}/../gmp/${ANDROID_ABI}) - set(GMP_INCLUDE_DIRS ${GMP_ROOT}) - set(GMP_LIBRARIES ${GMP_ROOT}/libgmp.so) - - - file(INSTALL ${pl_library} DESTINATION ${YAP_ASSETS}) - file(INSTALL ${CMAKE_CURRENT_SOURCE_DIR}/android.yap DESTINATION ${YAP_ASSETS}) - - file(INSTALL ${pl_boot_library} DESTINATION ${YAP_ASSETS}/pl) - file(INSTALL ${pl_os_library} DESTINATION ${YAP_ASSETS}/os) - - - execute_process(COMMAND swig -c++ -java -package pt.up.yap.lib -O -outdir ${JAVA_SWIG_OUTDIR} -addextern -I${CMAKE_SOURCE_DIR}/CXX -I${CMAKE_SOURCE_DIR}/include -I${CMAKE_SOURCE_DIR}/H -I${CMAKE_SOURCE_DIR}/os -I${CMAKE_SOURCE_DIR}/OPTYap -I${CMAKE_BINARY_DIR} -I${GMP_INCLUDE_DIRS} -DX_API -o ${SWIG_CXX_DIR}/yapi_swig.cxx ${SWIG_SOURCES} + ${CMAKE_SOURCE_DIR}/include + ${CMAKE_BINARY_DIR} + ${CMAKE_SOURCE_DIR}/H + ${CMAKE_SOURCE_DIR}/os + ${CMAKE_SOURCE_DIR}/OPTYap ) - execute_process(COMMAND ${SWIG_EXECUTABLE} -c++ -java -package pt.up.yap.lib -O -outdir ${JAVA_SWIG_OUTDIR} -addextern -I${CMAKE_CURRENT_SOURCE_DIR} -o ${SWIG_CXX_DIR}/streamer_swig.cxx streamer.i - ) + add_custom_command( OUTPUT yapi_swig.cxx yapi_swig.hh + COMMAND swig -c++ -java -package pt.up.yap.lib -O -outdir ${JAVA_SWIG_OUTDIR} + -addextern -I${CMAKE_SOURCE_DIR}/CXX -I${CMAKE_SOURCE_DIR}/include + -I${CMAKE_SOURCE_DIR}/H -I${CMAKE_SOURCE_DIR}/os -I${CMAKE_SOURCE_DIR}/OPTYap + -I${CMAKE_BINARY_DIR} + -I${GMP_INCLUDE_DIRS} -DX_API -o yapi_swig.cxx ${SWIG_SOURCES} + DEPENDS ${CMAKE_SOURCE_DIR}/CXX/yapi.hh ${SWIG_SOURCES} + ) + add_custom_command( OUTPUT streamer_swig.cxx streamer_swig.hh + COMMAND swig -c++ -java -package pt.up.yap.lib -O -outdir ${JAVA_SWIG_OUTDIR} -addextern -I${CMAKE_CURRENT_SOURCE_DIR} -o streamer_swig.cxx streamer.i + DEPENDS ${CMAKE_SOURCE_DIR}/CXX/yapi.hh ${CMAKE_CURRENT_SOURCE_DIR}/streamer.i + ) - add_library(YAPJava OBJECT - ${CMAKE_BINARY_DIR}/src/generated/jni/streamer_swig.cxx - ${CMAKE_BINARY_DIR}/src/generated/jni/yapi_swig.cxx - streamer.cpp - ) - - set_target_properties(YAPJava PROPERTIES LINKER_LANGUAGE CXX) - - # GMP_FOUND - true if GMP/MPIR was found - # GMP_INCLUDE_DIRS - include search path - # GMP_LIBRARIES - libraries to link with - #config.h needs this (TODO: change in code latter) - include_directories(.;${GMP_INCLUDE_DIRS};${CMAKE_SOURCE_DIR}/include;${CMAKE_SOURCE_DIR}/H;${CMAKE_SOURCE_DIR}/H/generated;${CMAKE_SOURCE_DIR}/os;${CMAKE_SOURCE_DIR}/OPTYap;${CMAKE_BINARY_DIR};${CMAKE_CURRENT_SOURCE_DIR}) - - - if (FALSE) - - set(SWIG_ADD_MODULE YAPJava SHARED CPLUSPLUS ${SWIG_SOURCES}) - # Define swig module with given name and specified language - - - set(SWIG_LINK_LIBRARIES YAPJava YAP++ libYAP) - #- Link libraries to swig module - - - add_library(YAPJavaTop SHARED - main.cpp main.h - ) - - target_link_libraries(YAPJavaTop ${SWIG_MODULE_${YAPJava}_REAL_NAME} YAP++ libYap android) - - endif () + add_library(DROID OBJECT + yapi_swig.cxx streamer_swig.cxx streamer.cpp + ) diff --git a/packages/swig/android/streamer.cpp b/packages/swig/android/streamer.cpp index 39c458202..bdb2f2145 100644 --- a/packages/swig/android/streamer.cpp +++ b/packages/swig/android/streamer.cpp @@ -58,15 +58,39 @@ and_close(int sno) { static int and_put(int sno, int ch) { -buff0 += ch; - streamerInstance->display(buff0); - buff0.clear(); + buff0 += ch; + if (ch == '\n') { + streamerInstance->display(buff0); + buff0.clear(); + } return ch; } + +static int +and_wput(int sno, int ch) { + unsigned char b0[8]; + + size_t extra = put_utf8(b0, ch); + if (extra < 0) + PlIOError(DOMAIN_ERROR_ENCODING, MkIntegerTerm(ch), "ch %C found at putw", ch); + else if(extra==0) + return false; + for (int i=0; i < extra; i++) { + buff0 += b0[i]; + } + if (ch == '\n') { + streamerInstance->display(buff0); + buff0.clear(); + } + + return ch; +} + static int and_get(int sno) { + PlIOError(PERMISSION_ERROR_OUTPUT_STREAM, MkIntTerm(sno), "streamer is just for writing"); return EOF; } @@ -86,14 +110,16 @@ extern "C" { void Java_pt_up_yap_streamerJNI_swig_1module_1init(void) { andstream = new VFS_t(); - andstream->name = "/android/user_error"; + andstream->name = "/android/user"; andstream->vflags = VFS_CAN_WRITE | VFS_HAS_PREFIX; andstream->prefix = "/android"; andstream->suffix = NULL; andstream->open = and_open; andstream->close = and_close; andstream->get_char = and_get; + andstream->get_wchar = and_get; andstream->put_char = and_put; + andstream->put_wchar = and_wput; andstream->flush = and_flush; andstream->seek = and_seek; andstream->next = GLOBAL_VFS; diff --git a/packages/swig/java/JavaYAP.java b/packages/swig/java/JavaYAP.java.old similarity index 100% rename from packages/swig/java/JavaYAP.java rename to packages/swig/java/JavaYAP.java.old diff --git a/packages/swig/yap.i b/packages/swig/yap.i index e1c04863f..2f9e42cd6 100644 --- a/packages/swig/yap.i +++ b/packages/swig/yap.i @@ -139,17 +139,8 @@ class YAPEngine; #else - %typemap(in) arity_t { (jlong)($input); } - - - %typemap(in) jlong %{ - $1 = (jlong)$input; - %} - - %typemap(out) arity_t { *(jlong *)&$result = $1; } - - // Language independent exception handler +// Language independent exception handler // simplified version %include #endif diff --git a/packages/udi/b+tree/CMakeLists.txt b/packages/udi/b+tree/CMakeLists.txt index da4f93405..2998cb365 100644 --- a/packages/udi/b+tree/CMakeLists.txt +++ b/packages/udi/b+tree/CMakeLists.txt @@ -11,7 +11,7 @@ SET ( SOURCES b+tree_udi.c ) -ADD_LIB(udi_b+tree ${SOURCES}) +add_library(udi_b+tree ${SOURCES}) INSTALL(TARGETS udi_b+tree DESTINATION ${YAP_PL_LIBRARY_DIR}) INSTALL(FILES b+tree.yap DESTINATION ${YAP_PL_LIBRARY_DIR}) diff --git a/packages/udi/rtree/CMakeLists.txt b/packages/udi/rtree/CMakeLists.txt index dbd33f825..d56b4516d 100644 --- a/packages/udi/rtree/CMakeLists.txt +++ b/packages/udi/rtree/CMakeLists.txt @@ -11,7 +11,7 @@ SET ( SOURCES rtree_udi.c ) -ADD_LIB(udi_rtree ${SOURCES}) +add_library(udi_rtree ${SOURCES}) INSTALL(TARGETS udi_rtree DESTINATION ${YAP_PL_LIBRARY_DIR}) INSTALL(FILES rtree.yap DESTINATION ${YAP_PL_LIBRARY_DIR}) diff --git a/packages/udi/uthash/CMakeLists.txt b/packages/udi/uthash/CMakeLists.txt index f465e5986..1fc0b854c 100644 --- a/packages/udi/uthash/CMakeLists.txt +++ b/packages/udi/uthash/CMakeLists.txt @@ -10,7 +10,7 @@ SET ( SOURCES uthash_udi.c ) -ADD_LIB(udi_uthash ${SOURCES}) +add_library(udi_uthash ${SOURCES}) INSTALL(TARGETS udi_uthash DESTINATION ${YAP_PL_LIBRARY_DIR}) INSTALL(FILES uthash.yap DESTINATION ${YAP_PL_LIBRARY_DIR}) diff --git a/pl/CMakeLists.txt b/pl/CMakeLists.txt index d44f3d11e..608abad2d 100644 --- a/pl/CMakeLists.txt +++ b/pl/CMakeLists.txt @@ -1,12 +1,14 @@ set(PL_BOOT_SOURCES - absf.yap + absf.yap + android.yap arith.yap arithpreds.yap arrays.yap atoms.yap attributes.yap boot.yap - bootlists.yap + boot2.yap + bootlists.yap bootutils.yap builtins.yap callcount.yap @@ -62,13 +64,12 @@ set(PL_BOOT_SOURCES ypp.yap ) -add_to_group(PL_BOOT_SOURCES pl_boot_library) +add_to_dir(PL_BOOT_SOURCES ${YAP_INSTALL_DATADIR}/pl) if (ANDROID) add_custom_target(STARTUP DEPENDS ${PL_BOOT_SOURCES} ) - file (INSTALL ${PL_BOOT_SOURCES} DESTINATION ${YAP_INSTALL_DATADIR}/pl) elseif(CMAKE_CROSSCOMPILING) add_custom_target(STARTUP ALL SOURCES DEPENDS ${PL_BOOT_SOURCES} @@ -78,7 +79,7 @@ else () DEPENDS ${CMAKE_TOP_BINARY_DIR}/${YAP_STARTUP} ) add_custom_command(OUTPUT ${CMAKE_TOP_BINARY_DIR}/${YAP_STARTUP} - COMMAND yap-bin -B + COMMAND yap-bin -b VERBATIM DEPENDS ${PL_BOOT_SOURCES} yap-bin ) @@ -89,8 +90,8 @@ else () install(FILES ${CMAKE_TOP_BINARY_DIR}/${YAP_STARTUP} - DESTINATION ${YAP_INSTALL_LIBDIR} - ) + DESTINATION ${YAP_INSTALL_DATADIR}/pl) + endif() diff --git a/pl/absf.yap b/pl/absf.yap index 5c9014a98..f271bbec0 100755 --- a/pl/absf.yap +++ b/pl/absf.yap @@ -1,4 +1,4 @@ -/************************************************************************* +qqqqq/************************************************************************* * * * YAP Prolog * * * diff --git a/pl/android.yap b/pl/android.yap new file mode 100644 index 000000000..488204c7c --- /dev/null +++ b/pl/android.yap @@ -0,0 +1,22 @@ + +%:- start_low_level_trace. + +%:- module(android, +% [text_to_query/2]). + +:- initialization(yap_flag(verbose,_,normal)). + +:- meta_predicate( text_to_query( :, - ) ). + +text_to_query( MString, Status ) :- + strip_module( MString, Mod, String ), + atomic_to_term( String, Goal, VarNames ), + ( + is_list(Goal) -> G = ensure_loaded( Goal ) ; G = Goal ), + catch(query_to_answer( Mod:G, VarNames, Status, Bindings), + H,error_handler(H,error) + ), + write_query_answer( Bindings ), + nl(user_error). + +%:- [sqlitest]. diff --git a/pl/arith.yap b/pl/arith.yap index fcf94b4d6..fc05f4e19 100644 --- a/pl/arith.yap +++ b/pl/arith.yap @@ -1,3 +1,4 @@ + /************************************************************************* * * * YAP Prolog * @@ -118,19 +119,21 @@ do_not_compile_expressions :- set_value('$c_arith',[]). '$c_built_in'(IN, M, H, OUT) :- get_value('$c_arith',true), !, - do_c_built_in(IN, M, H, OUT). + '$yap_strip_module'(M:IN, M1, G1), + do_c_built_in(G1, M1, H, OUT). '$c_built_in'(IN, _, _H, IN). -do_c_built_in(G, M, H, OUT) :- var(G), !, - do_c_built_metacall(G, M, H, OUT). -do_c_built_in(Mod:G, _, H, OUT) :- - '$yap_strip_module'(Mod:G, M1, G1), - var(G1), !, - do_c_built_metacall(G1, M1, H, OUT). +do_c_built_in(G1, M1, H, OUT) :- + var(G1), !, + do_c_built_metacall(G1, M1, H, OUT). +do_c_built_in(G1, M1, H, OUT) :- + var(M1), !, + do_c_built_metacall(G1, M1, H, OUT). do_c_built_in('$do_error'( Error, Goal), M, Head, - throw(error(Error,M:(Head :- Goal))) - ) :- !. + throw(error(Error,M:(Head :- Goal))) + ) :- + !. do_c_built_in(system_error( Error, Goal), M, Head, ErrorG) :- !, do_c_built_in('$do_error'( Error, Goal), M, Head, ErrorG). @@ -144,10 +147,10 @@ do_c_built_in(X is Y, _, _, P) :- nonvar(Y), % Don't rewrite variables !, ( - number(Y) -> - P = ( X = Y); % This case reduces to an unification - expand_expr(Y, P0, X0), - '$drop_is'(X0, X, P0, P) + number(Y) -> + P = ( X = Y); % This case reduces to an unification + expand_expr(Y, P0, X0), + '$drop_is'(X0, X, P0, P) ). do_c_built_in(phrase(NT,Xs), Mod, H, NTXsNil) :- !, @@ -155,7 +158,6 @@ do_c_built_in(phrase(NT,Xs), Mod, H, NTXsNil) :- do_c_built_in(phrase(NT,Xs0,Xs), Mod, _, NewGoal) :- !, '$c_built_in_phrase'(NT, Xs0, Xs, Mod, NewGoal ). - do_c_built_in(Comp0, _, _, R) :- % now, do it for comparisons '$compop'(Comp0, Op, E, F), !, @@ -239,8 +241,10 @@ expand_expr(T, E, V) :- % after having expanded into Q % and giving as result P (the last argument) expand_expr(Op, X, O, Q, Q) :- - number(X), - catch(is( O, Op, X),_,fail), !. % do not do error handling at compile time + number(X), + !, + catch(is( O, Op, X),Error,bad_expr(Error,[Op, X])), !. + % do not do error handling at compile time expand_expr(Op, X, O, Q, P) :- '$unary_op_as_integer'(Op,IOp), '$do_and'(Q, is( O, IOp, X), P). @@ -254,7 +258,7 @@ expand_expr(Op, X, O, Q, P) :- % the elementar arithmetic operations [+,-,*,//] expand_expr(Op, X, Y, O, Q, Q) :- number(X), number(Y), - catch(is( O, Op, X, Y),_,fail), !. + catch(is( O, Op, X, Y),Error,bad_expr(Error,[Op, X, Y ])), !. expand_expr(+, X, Y, O, Q, P) :- !, '$preprocess_args_for_commutative'(X, Y, X1, Y1, E), '$do_and'(E, '$plus'(X1,Y1,O), F), diff --git a/pl/boot.yap b/pl/boot.yap index 815604cc3..4c8f1381e 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -111,18 +111,25 @@ private(_). % be careful here not to generate an undefined exception.. print_message(L,E) :- + %stop_low_level_trace, '$number_of_clauses'(print_message(L,E), prolog_complete, 1), !, (L = informational -> true ; - format( user_error, '~w in bootstrap: got ~w~n',[L,E]) + error(_,Info), + '$error_descriptor'(Info, Desc), + query_exception(prologPredFile, Desc, File), + query_exception(prologPredLine, Desc, FilePos), + format(user_error,'~a:~d: error:', [File,FilePos]), + '$print_exception'(Info), + format( user_error, '~w from bootstrap: got ~w~n',[L,E]) ). '$undefp0'([M|G], _Action) :- stream_property( loop_stream, [file_name(F), line_number(L)]), - format(user_error,'~a:~d error undefined:',[F,L]), + format(user_error,'~a:~d: error: undefined ~w~n:',[F,L,M:G]), fail ; format(user_error,' call to ~w~n',[M:G]), @@ -145,8 +152,12 @@ print_message(L,E) :- '$compile'(G, assertz, G, prolog, _R), '$system_meta_predicates'(L). + :- '$mk_dynamic'( prolog_file_type(_Ext, _NType), user). + :- '$new_multifile'( prolog_file_type(_Ext, _NType), user). + :- '$mk_dynamic'( '$meta_predicate'(_N,_M,_A,_P), prolog). :- '$new_multifile'( '$meta_predicate'(_N,_M,_A,_P), prolog). + :- '$new_multifile'('$full_clause_optimisation'(_H, _M, _B0, _BF), prolog). :- '$new_multifile'('$exec_directive'(_,_,_,_,_), prolog). @@ -305,181 +316,8 @@ initialize_prolog :- 'yapor.yap', 'qly.yap', 'spy.yap', - 'udi.yap']. - -%:- start_low_level_trace. - -:- meta_predicate(log_event(+,:)). - -:- dynamic prolog:'$user_defined_flag'/4. - -:- multifile prolog:debug_action_hook/1. - -:- multifile prolog:'$system_predicate'/2. - -:- '$opdec'(1150,fx,(mode),prolog). - -:- dynamic 'extensions_to_present_answer'/1. - -:- ['arrays.yap']. - -:- multifile user:portray_message/2. - -:- dynamic user:portray_message/2. - -/** @pred prolog:goal_expansion( :G,+ M,- NG) - @pred user:goalexpansion(+ G,+ M,- NG) - -The goal_expansion/3 hook is an user-defined -procedure that is called after term expansion when compiling or -asserting goals for each sub-goal in a clause. The first argument is -bound to the goal and the second to the module under which the goal - _G_ will execute. If goal_expansion/3 succeeds the new -sub-goal _NG_ will replace _G_ and will be processed in the same - way. If goal_expansion/3 fails the system will use the default -expandion mechanism. - -This hook is called: -- at compilation time; -- when running a query in the top-level - -Older versions of YAP would call this procedure at every meta-call. - - -*/ -:- multifile user:goal_expansion/3. - -:- dynamic user:goal_expansion/3. - -:- multifile user:goal_expansion/2. - -:- dynamic user:goal_expansion/2. - -:- multifile system:goal_expansion/2. - -:- dynamic system:goal_expansion/2. - -:- multifile goal_expansion/2. - -:- dynamic goal_expansion/2. - -:- use_module('messages.yap'). - -:- ['undefined.yap']. - -:- use_module('hacks.yap'). - - -:- use_module('attributes.yap'). -:- use_module('corout.yap'). -:- use_module('dialect.yap'). -:- use_module('dbload.yap'). -:- use_module('ypp.yap'). -:- use_module('../os/chartypes.yap'). -:- ensure_loaded('../os/edio.yap'). - -yap_hacks:cut_by(CP) :- '$$cut_by'(CP). - -:- '$change_type_of_char'(36,7). % Make $ a symbol character - -:- set_prolog_flag(generate_debug_info,true). - -% -% cleanup ensure loaded and recover some data-base space. -% -%:- ( recorded('$lf_loaded',_,R), erase(R), fail ; true ). -%:- ( recorded('$module',_,R), erase(R), fail ; true ). - -:- set_value('$user_module',user), '$protect'. - -:- style_check([+discontiguous,+multiple,+single_var]). - -% -% moved this to init_gc in sgc.c to separate the alpha -% -% :- yap_flag(gc,on). -% -% :- yap_flag(gc_trace,verbose` - -:- multifile - prolog:comment_hook/3. - -:- source. - -:- module(user). - - -/** @pred term_expansion( _T_,- _X_) - user:term_expansion( _T_,- _X_) - - -This user-defined predicate is called by `expand_term/3` to -preprocess all terms read when consulting a file. If it succeeds: - -+ -If _X_ is of the form `:- G` or `?- G`, it is processed as -a directive. -+ -If _X_ is of the form `$source_location`( _File_, _Line_): _Clause_` it is processed as if from `File` and line `Line`. - -+ -If _X_ is a list, all terms of the list are asserted or processed -as directives. -+ The term _X_ is asserted instead of _T_. - - - -*/ -:- multifile term_expansion/2. - -:- dynamic term_expansion/2. - -:- multifile system:term_expansion/2. - -:- dynamic system:term_expansion/2. - -:- multifile system:swi_predicate_table/4. - -/** @pred user:message_hook(+ _Term_, + _Kind_, + _Lines_) - - -Hook predicate that may be define in the module `user` to intercept -messages from print_message/2. _Term_ and _Kind_ are the -same as passed to print_message/2. _Lines_ is a list of -format statements as described with print_message_lines/3. - -This predicate should be defined dynamic and multifile to allow other -modules defining clauses for it too. - - -*/ -:- multifile user:message_hook/3. - -:- dynamic user:message_hook/3. - -/** @pred exception(+ _Exception_, + _Context_, - _Action_) - - -Dynamic predicate, normally not defined. Called by the Prolog system on run-time exceptions that can be repaired `just-in-time`. The values for _Exception_ are described below. See also catch/3 and throw/1. -If this hook preodicate succeeds it must instantiate the _Action_ argument to the atom `fail` to make the operation fail silently, `retry` to tell Prolog to retry the operation or `error` to make the system generate an exception. The action `retry` only makes sense if this hook modified the environment such that the operation can now succeed without error. - -+ `undefined_predicate` - _Context_ is instantiated to a predicate-indicator ( _Module:Name/Arity_). If the predicate fails Prolog will generate an existence_error exception. The hook is intended to implement alternatives to the SWI built-in autoloader, such as autoloading code from a database. Do not use this hook to suppress existence errors on predicates. See also `unknown`. -+ `undefined_global_variable` - _Context_ is instantiated to the name of the missing global variable. The hook must call nb_setval/2 or b_setval/2 before returning with the action retry. - -*/ - -:- multifile user:exception/3. - -:- dynamic user:exception/3. - -:- ensure_loaded('../pl/pathconf.yap'). - -:- current_prolog_flag(android,true), ensure_loaded('../android.yap'). - -:- set_prolog_flag(unknown,error). - + 'udi.yap', + 'boot2.yap']. %% @} diff --git a/pl/control.yap b/pl/control.yap index 19d7d3c4d..3db888f9b 100644 --- a/pl/control.yap +++ b/pl/control.yap @@ -389,23 +389,13 @@ version(T) :- fail. '$set_toplevel_hook'(_). -query_to_answer(G, V, Status, Vs, Bindings ) :- - gated_call( true, (G,'$delayed_goals'(G, V, Vs, LGs, _DCP)), Status, '$answer'( Status, LGs, Vs, Bindings ) ). - -'$answer'( exit, LGs, Vs, Bindings ) :- - !, - '$sort'(Vs, NVs), - '$prep_answer_var_by_var'(NVs, Bindings , LGs). -'$answer'( answer, LGs, Vs, Bindings) :- - !, - '$sort'(Vs, NVs), - '$prep_answer_var_by_var'(NVs, Bindings , LGs). -'$answer'(!, _, _,_). -'$answer'(fail,_,_,_). -'$answer'(exception(E),_,_,_) :- - '$LoopError'(E,error). -'$answer'(external_exception(_),_,_,_). - +query_to_answer(G, V, Status, LGs) :- + gated_call(true, + G, + Status, + true), + '$delayed_goals'(G, V, NV, LVGs, _DCP), + lists:append(NV, LVGs, LGs). %% @} diff --git a/pl/imports.yap b/pl/imports.yap index 8090fd8d5..77bf042d9 100644 --- a/pl/imports.yap +++ b/pl/imports.yap @@ -17,121 +17,125 @@ */ :- '$mk_dynamic'('$parent_module'(_,_),prolog). +mimp :- + recorded('$import',I,_), %'$import'(ExportingMod,ImportingMod,G0,G,_,_),_), +writeln(I), +%(ImportingMod:G :- ExportingMod:G0)), +fail. -'$get_undefined_predicates'(G, ImportingMod, G0, ExportingMod) :- - recorded('$import','$import'(ExportingModI,ImportingMod,G0I,G,_,_),_), - '$continue_imported'(ExportingMod, ExportingModI, G0, G0I). -% SWI builtin -'$get_undefined_predicates'(G, _ImportingMod, G, user) :- - nonvar(G), - '$pred_exists'(G, user). -% autoload -'$get_undefined_predicates'(G, ImportingMod, G0, ExportingMod) :- - prolog_flag(autoload, true), - prolog_flag(unknown, OldUnk, fail), - ( - '$autoload'(G, ImportingMod, ExportingModI, swi) - -> - prolog_flag(unknown, _, OldUnk) - ; - prolog_flag(unknown, _, OldUnk), - fail - ), - '$continue_imported'(ExportingMod, ExportingModI, G0, G). + +%:- start_low_level_trace. % parent module mechanism -'$get_undefined_predicates'(G, ImportingMod, G0, ExportingMod) :- - '$parent_module'(ImportingMod,ExportingModI), - '$continue_imported'(ExportingMod, ExportingModI, G0, G). -'$get_undefined_predicates'(G, _ImportingMod, G0, ExportingMod) :- - yap_flag(default_parent_module,ExportingModI), - '$continue_imported'(ExportingMod, ExportingModI, G0, G). +'$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, prolog) + -> + true + ; +% autoload + current_prolog_flag(autoload, true) +-> + '$autoload'(G, ImportingMod, ExportingMod, swi) +; + '$parent_module'(ImportingMod, NewImportingMod) + -> + '$get_undefined_predicates'(NewImportingMod:G, ExportingMod:G0). -'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :- - '$get_undefined_predicates'(G, ImportingMod, G0, ExportingMod), - !. - - -% be careful here not to generate an undefined exception. -'$imported_predicate'(G, _ImportingMod, G, prolog) :- - nonvar(G), '$is_system_predicate'(G, prolog), !. -'$imported_predicate'(G, ImportingMod, G0, ExportingMod) :- - ( var(G) -> true ; - var(ImportingMod) -> true ; - '$undefined'(G, ImportingMod) - ), - '$get_undefined_predicates'(G, ImportingMod, G0, ExportingMod), - ExportingMod \= ImportingMod. - - - % be careful here not to generate an undefined exception. - '$generate_imported_predicate'(G, ImportingMod, G0, ExportingMod) :- - ( - recorded('$import','$import'(ExportingModI,ImportingMod,G0I,G,_,_),_) - ; - '$parent_module'(ImportingMod,ExportingModI), - \+ recorded('$import','$import'(ExportingModI,ImportingMod,G0I,G,_,_),_) - ), - ImportingMod \= ExportingModI, - ( - '$undefined'(G, ExportingModI) - -> - '$generate_imported_predicate'(G, ExportingModI, G0, ExportingMod) - ; - G=G0, - ExportingModI=ExportingMod - ). - - /** - * - * @pred '$continue_imported'(+ModIn, +ModOut, +PredIn ,+PredOut) +/** + * + * @pred '$continue_imported'(+Modn, +ModOut, +Predn ,+PredOut) * * @return */ - '$continue_imported'(Mod,Mod,Pred,Pred) :- - '$pred_exists'(Pred, Mod), - !. - '$continue_imported'(FM,Mod,FPred,Pred) :- - recorded('$import','$import'(IM,Mod,IPred,Pred,_,_),_), - '$continue_imported'(FM, IM, FPred, IPred), !. - '$continue_imported'(FM,Mod,FPred,Pred) :- - prolog:'$parent_module'(Mod,IM), - '$continue_imported'(FM, IM, FPred, Pred). +'$continue_imported'(Mod:Pred,Mod,Pred) :- + '$pred_exists'(Pred, Mod), + !. +'$continue_imported'(FM:FPred,Mod:Pred) :- + '$get_undefined_predicates'(FM:FPred, ModI:PredI), + '$continue_imported'(ModI:PredI,Mod:Pred). + +% +'$get_undefined_pred'(ImportingMod:G, ExportingMod:G0) :- + must_be_callablle( ImportingMod:G ), + '$get_undefined_predicates'(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. + + +% check if current module redefines an imported predicate. +% and remove import. +% +'$not_imported'(H, Mod) :- + recorded('$import','$import'(NM,Mod,NH,H,_,_),R), + NM \= Mod, + functor(NH,N,Ar), + print_message(warning,redefine_imported(Mod,NM,N/Ar)), + erase(R), + fail. +'$not_imported'(_, _). - '$autoload'(G, _ImportingMod, ExportingMod, Dialect) :- - functor(G, Name, Arity), - '$pred_exists'(index(Name,Arity,ExportingMod,_),Dialect), - call(Dialect:index(Name,Arity,ExportingMod,_)), - !. - '$autoload'(G, ImportingMod, ExportingMod, _Dialect) :- - functor(G, N, K), - functor(G0, N, K), - '$autoloader_find_predicate'(G0,ExportingMod), - ExportingMod \= ImportingMod, - (recordzifnot('$import','$import'(ExportingMod,ImportingMod,G0,G0, N ,K),_) -> true ; true ). - - - '$autoloader_find_predicate'(G,ExportingModI) :- - '__NB_getval__'('$autoloader_set', true, false), !, - autoloader:find_predicate(G,ExportingModI). - '$autoloader_find_predicate'(G,ExportingModI) :- - yap_flag(autoload, true, false), - yap_flag( unknown, Unknown, fail), - yap_flag(debug, Debug, false), !, - load_files([library(autoloader), - autoloader:library('INDEX'), - swi:library('dialect/swi/INDEX')], - [autoload(true),if(not_loaded)]), - nb_setval('$autoloader_set', true), - yap_flag(autoload, _, true), - yap_flag( unknown, _, Unknown), - yap_flag( debug, _, Debug), - autoloader:find_predicate(G,ExportingModI). +'$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). - /** +'$autoload'(G, _mportingMod, ExportingMod, Dialect) :- + functor(G, Name, Arity), + '$pred_exists'(index(Name,Arity,ExportingMod,_),Dialect), + call(Dialect:index(Name,Arity,ExportingMod,_)), + !. +'$autoload'(G, ImportingMod, ExportingMod, _Dialect) :- + functor(G, N, K), + functor(G0, N, K), + '$autoloader_find_predicate'(G0,ExportingMod), + ExportingMod \= ImportingMod, +% assert_static(ExportingMod:G0 :- ImportingMod:G0), + (recordzifnot('$import','$import'(ExportingMod,ImportingMod,G0,G0, N ,K),_) -> true ; true ). + + +'$autoloader_find_predicate'(G,ExportingMod) :- + '__NB_getval__'('$autoloader_set', true, false), !, + autoloader:find_predicate(G,ExportingMod). +'$autoloader_find_predicate'(G,ExportingMod) :- + yap_flag(autoload, true, false), + yap_flag( unknown, Unknown, fail), + yap_flag(debug, Debug, false), !, + load_files([library(autoloader), + autoloader:library('NDEX'), + swi:library('dialect/swi/NDEX')], + [autoload(true),if(not_loaded)]), + nb_setval('$autoloader_set', true), + yap_flag(autoload, _, true), + yap_flag( unknown, _, Unknown), + yap_flag( debug, _, Debug), + autoloader:find_predicate(G,ExportingMod). + + + + +/** * * @} */ diff --git a/pl/listing.yap b/pl/listing.yap index fb10a8b86..fde0c7f51 100644 --- a/pl/listing.yap +++ b/pl/listing.yap @@ -1,3 +1,4 @@ + /************************************************************************* * * * YAP Prolog * @@ -97,30 +98,43 @@ listing(MV) :- listing(Stream, MV). listing(Stream, MV) :- - strip_module( MV, M, I), - '$mlisting'(Stream, I, M). -listing(_Stream, []) :- !. -listing(Stream, [MV|MVs]) :- !, - listing(Stream, MV), - listing(Stream, MVs). + '$yap_strip_module'( MV, M, I), + listing_(Stream, I, M), + !. + +listing_(Stream, V, M) :- + var(V), + !, + '$mlisting'(Stream, V, M). +listing_(_Stream, [], _) :- + !. +listing_(Stream, [MV|MVs], M) :- + !, + '$mlisting'(Stream, MV, M), + listing_(Stream, MVs, M). +listing_(Stream, MV, M) :- + '$mlisting'(Stream, MV, M). '$mlisting'(Stream, MV, M) :- ( var(MV) -> - MV = NA, - '$do_listing'(Stream, M, NA) - ; - atom(MV) -> - MV/_ = NA, - '$do_listing'(Stream, M, NA) - ; - MV = N//Ar -> ( integer(Ar) -> Ar2 is Ar+2, NA is N/Ar2 ; '$do_listing'(Stream, NA/Ar2, M), Ar2 >= 2, Ar is Ar2-2 ) - ; - MV = N/Ar, ( atom(N) -> true ; var(N) ), ( integer(Ar) -> true ; var(Ar) ) -> - '$do_listing'(Stream, M, MV) - ; - MV = M1:PP -> '$mlisting'(Stream, PP, M1) - ; - '$do_error'(type_error(predicate_indicator,MV),listing(Stream, MV) ) + MV = NA, + '$do_listing'(Stream, M, NA) + ; + atom(MV) -> + MV/_ = NA, + '$do_listing'(Stream, M, NA) + ; + MV = N//Ar -> + ( integer(Ar) -> Ar2 is Ar+2, NA is N/Ar2 ; + '$do_listing'(Stream, NA/Ar2, M), Ar2 >= 2, Ar is Ar2-2 ) + ; + MV = N/Ar, + ( atom(N) -> true ; var(N) ), + ( integer(Ar) -> true ; var(Ar) ) -> '$do_listing'(Stream, M, MV) + ; + MV = M1:PP -> '$mlisting'(Stream, PP, M1) + ; + '$do_error'(type_error(predicate_indicator,MV),listing(Stream, MV) ) ). '$do_listing'(Stream, M, Name/Arity) :- @@ -130,33 +144,33 @@ listing(Stream, [MV|MVs]) :- !, \+ '$undefined'(Pred, M), '$listing'(Name,Arity,M,Stream), fail - ; - true - ). + ; + true + ). % % at this point we are ground and we know who we want to list. % '$listing'(Name, Arity, M, Stream) :- - % skip by default predicates starting with $ - functor(Pred,Name,Arity), - '$list_clauses'(Stream,M,Pred). + % skip by default predicates starting with $ + functor(Pred,Name,Arity), + '$list_clauses'(Stream,M,Pred). '$listing'(_,_,_,_). '$funcspec'(Name/Arity,Name,Arity) :- !, atom(Name). '$funcspec'(Name,Name,0) :- atom(Name), !. '$funcspec'(Name,_,_) :- - '$do_error'(domain_error(predicate_spec,Name),listing(Name)). + '$do_error'(domain_error(predicate_spec,Name),listing(Name)). '$list_clauses'(Stream, M, Pred) :- - '$predicate_flags'(Pred,M,Flags,Flags), - (Flags /\ 0x48602000 =\= 0 - -> - nl(Stream), - fail - ; - ! - ). + '$predicate_flags'(Pred,M,Flags,Flags), + (Flags /\ 0x48602000 =\= 0 + -> + nl(Stream), + fail + ; + ! + ). '$list_clauses'(Stream, M, Pred) :- ( '$is_dynamic'(Pred, M) -> true ; '$is_log_updatable'(Pred, M) ), functor( Pred, N, Ar ), @@ -164,11 +178,11 @@ listing(Stream, [MV|MVs]) :- !, ( M == Mod -> - format( Stream, ':- dynamic ~q/~d.~n', [N,Ar]) + format( Stream, ':- dynamic ~q/~d.~n', [N,Ar]) ; - format( Stream, ':- dynamic ~q:~q/~d.~n', [M,N,Ar]) - ), - fail. + format( Stream, ':- dynamic ~q:~q/~d.~n', [M,N,Ar]) + ), + fail. '$list_clauses'(Stream, M, Pred) :- '$is_thread_local'(Pred, M), functor( Pred, N, Ar ), @@ -176,11 +190,11 @@ listing(Stream, [MV|MVs]) :- !, ( M == Mod -> - format( Stream, ':- thread_local ~q/~d.~n', [N,Ar]) + format( Stream, ':- thread_local ~q/~d.~n', [N,Ar]) ; - format( Stream, ':- thread_local ~q:~q/~d.~n', [M,N,Ar]) - ), - fail. + format( Stream, ':- thread_local ~q:~q/~d.~n', [M,N,Ar]) + ), + fail. '$list_clauses'(Stream, M, Pred) :- '$is_multifile'(Pred, M), functor( Pred, N, Ar ), @@ -188,36 +202,36 @@ listing(Stream, [MV|MVs]) :- !, ( M == Mod -> - format( Stream, ':- multifile ~q/~d.~n', [N,Ar]) + format( Stream, ':- multifile ~q/~d.~n', [N,Ar]) ; - format( Stream, ':- multifile ~q:~q/~d.~n', [M,N,Ar]) - ), - fail. + format( Stream, ':- multifile ~q:~q/~d.~n', [M,N,Ar]) + ), + fail. '$list_clauses'(Stream, M, Pred) :- - '$is_metapredicate'(Pred, M), + '$is_metapredicate'(Pred, M), functor( Pred, Name, Arity ), prolog:'$meta_predicate'(Name,M,Arity,PredDef), '$current_module'(Mod), ( M == Mod -> - format( Stream, ':- ~q.~n', [PredDef]) + format( Stream, ':- ~q.~n', [PredDef]) ; - format( Stream, ':- ~q:~q.~n', [M,PredDef]) - ), - fail. + format( Stream, ':- ~q:~q.~n', [M,PredDef]) + ), + fail. '$list_clauses'(Stream, _M, _Pred) :- - nl( Stream ), - fail. + nl( Stream ), + fail. '$list_clauses'(Stream, M, Pred) :- '$predicate_flags'(Pred,M,Flags,Flags), - % has to be dynamic, source, or log update. - Flags /\ 0x08402000 =\= 0, - '$clause'(Pred, M, Body, _), - '$current_module'(Mod), - ( M \= Mod -> H = M:Pred ; H = Pred ), - portray_clause(Stream,(H:-Body)), - fail. + % has to be dynamic, source, or log update. + Flags /\ 0x08402000 =\= 0, + clause(M:Pred, Body, _), + '$current_module'(Mod), + ( M \= Mod -> H = M:Pred ; H = Pred ), + portray_clause(Stream,(H:-Body)), + fail. /** @pred portray_clause(+ _S_,+ _C_) @@ -225,9 +239,9 @@ Write clause _C_ on stream _S_ as if written by listing/0. */ portray_clause(Stream, Clause) :- copy_term_nat(Clause, CopiedClause), - '$beautify_vs'(CopiedClause), - '$portray_clause'(Stream, CopiedClause), - fail. + '$beautify_vs'(CopiedClause), + '$portray_clause'(Stream, CopiedClause), + fail. portray_clause(_, _). /** @pred portray_clause(+ _C_) @@ -236,79 +250,80 @@ Write clause _C_ as if written by listing/0. */ portray_clause(Clause) :- - current_output(Stream), - portray_clause(Stream, Clause). + current_output(Stream), + portray_clause(Stream, Clause). '$portray_clause'(Stream, (Pred :- true)) :- !, - format(Stream, '~q.~n', [Pred]). + format(Stream, '~q.~n', [Pred]). '$portray_clause'(Stream, (Pred:-Body)) :- !, - format(Stream, '~q :-', [Pred]), - '$write_body'(Body, 3, ',', Stream), - format(Stream, '.~n', []). + format(Stream, '~q :-', [Pred]), + '$write_body'(Body, 3, ',', Stream), + format(Stream, '.~n', []). '$portray_clause'(Stream, Pred) :- - format(Stream, '~q.~n', [Pred]). + format(Stream, '~q.~n', [Pred]). -'$write_body'(X,I,T,Stream) :- var(X), !, - '$beforelit'(T,I,Stream), - writeq(Stream, '_'). -'$write_body'((P,Q), I, T, Stream) :- - !, - '$write_body'(P,I,T, Stream), - put(Stream, 0',), % - '$write_body'(Q,I,',',Stream). -'$write_body'((P->Q;S),I,_, Stream) :- - !, - format(Stream, '~n~*c(',[I,0' ]), - I1 is I+2, - '$write_body'(P,I1,'(',Stream), - format(Stream, '~n~*c->',[I,0' ]), - '$write_disj'((Q;S),I,I1,'->',Stream), - format(Stream, '~n~*c)',[I,0' ]). -'$write_body'((P->Q|S),I,_,Stream) :- - !, - format(Stream, '~n~*c(',[I,0' ]), - I1 is I+2, - '$write_body'(P,I,'(',Stream), - format(Stream, '~n~*c->',[I,0' ]), - '$write_disj'((Q|S),I,I1,'->',Stream), - format(Stream, '~n~*c)',[I,0' ]). -'$write_body'((P->Q),I,_,Stream) :- - !, - format(Stream, '~n~*c(',[I,0' ]), - I1 is I+2, - '$write_body'(P,I1,'(',Stream), - format(Stream, '~n~*c->',[I,0' ]), - '$write_body'(Q,I1,'->',Stream), - format(Stream, '~n~*c)',[I,0' ]). -'$write_body'((P;Q),I,_,Stream) :- - !, - format(Stream, '~n~*c(',[I,0' ]), - I1 is I+2, - '$write_disj'((P;Q),I,I1,'->',Stream), - format(Stream, '~n~*c)',[I,0' ]). -'$write_body'((P|Q),I,_,Stream) :- - !, - format(Stream, '~n~*c(',[I,0' ]), - I1 is I+2, - '$write_disj'((P|Q),I,I1,'->',Stream), - format(Stream, '~n~*c)',[I,0' ]). '$write_body'(X,I,T,Stream) :- - '$beforelit'(T,I,Stream), - writeq(Stream,X). + var(X), !, + '$beforelit'(T,I,Stream), + writeq(Stream, '_'). +'$write_body'((P,Q), I, T, Stream) :- + !, + '$write_body'(P,I,T, Stream), + put(Stream, 0',), % + '$write_body'(Q,I,',',Stream). +'$write_body'((P->Q;S),I,_, Stream) :- + !, + format(Stream, '~n~*c(',[I,0' ]), + I1 is I+2, + '$write_body'(P,I1,'(',Stream), + format(Stream, '~n~*c->',[I,0' ]), + '$write_disj'((Q;S),I,I1,'->',Stream), + format(Stream, '~n~*c)',[I,0' ]). +'$write_body'((P->Q|S),I,_,Stream) :- + !, + format(Stream, '~n~*c(',[I,0' ]), + I1 is I+2, + '$write_body'(P,I,'(',Stream), + format(Stream, '~n~*c->',[I,0' ]), + '$write_disj'((Q|S),I,I1,'->',Stream), + format(Stream, '~n~*c)',[I,0' ]). +'$write_body'((P->Q),I,_,Stream) :- + !, + format(Stream, '~n~*c(',[I,0' ]), + I1 is I+2, + '$write_body'(P,I1,'(',Stream), + format(Stream, '~n~*c->',[I,0' ]), + '$write_body'(Q,I1,'->',Stream), + format(Stream, '~n~*c)',[I,0' ]). +'$write_body'((P;Q),I,_,Stream) :- + !, + format(Stream, '~n~*c(',[I,0' ]), + I1 is I+2, + '$write_disj'((P;Q),I,I1,'->',Stream), + format(Stream, '~n~*c)',[I,0' ]). +'$write_body'((P|Q),I,_,Stream) :- + !, + format(Stream, '~n~*c(',[I,0' ]), + I1 is I+2, + '$write_disj'((P|Q),I,I1,'->',Stream), + format(Stream, '~n~*c)',[I,0' ]). +'$write_body'(X,I,T,Stream) :- + '$beforelit'(T,I,Stream), + writeq(Stream,X). '$write_disj'((Q;S),I0,I,C,Stream) :- !, - '$write_body'(Q,I,C,Stream), - format(Stream, '~n~*c;',[I0,0' ]), - '$write_disj'(S,I0,I,';',Stream). + '$write_body'(Q,I,C,Stream), + format(Stream, '~n~*c;',[I0,0' ]), + '$write_disj'(S,I0,I,';',Stream). '$write_disj'((Q|S),I0,I,C,Stream) :- !, - '$write_body'(Q,I,C,Stream), - format(Stream, '~n~*c|',[I0,0' ]), - '$write_disj'(S,I0,I,'|',Stream). + '$write_body'(Q,I,C,Stream), + format(Stream, '~n~*c|',[I0,0' ]), + '$write_disj'(S,I0,I,'|',Stream). '$write_disj'(S,_,I,C,Stream) :- - '$write_body'(S,I,C,Stream). + '$write_body'(S,I,C,Stream). '$beforelit'('(',_,Stream) :- !, @@ -324,11 +339,11 @@ portray_clause(Clause) :- '$v_transform'([]). '$v_transform'(['$VAR'(-1)|L]) :- - '$v_transform'(L). + '$v_transform'(L). '$vv_transform'([],_) :- !. '$vv_transform'(['$VAR'(M)|L],M) :- - N is M+1, - '$vv_transform'(L,N). + N is M+1, + '$vv_transform'(L,N). %% @} diff --git a/pl/load_foreign.yap b/pl/load_foreign.yap index cacb8058c..45e5937b0 100644 --- a/pl/load_foreign.yap +++ b/pl/load_foreign.yap @@ -62,6 +62,9 @@ YAP supports the SWI-Prolog interface to loading foreign code, the shlib package */ +load_foreign_files(_Objs,_Libs,Entry) :- + '$check_embedded'(Entry), + !. load_foreign_files(Objs,Libs,Entry) :- source_module(M), %G = load_foreign_files(Objs,Libs,Entry), diff --git a/pl/messages.yap b/pl/messages.yap index dd02a9afa..9209911f1 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -1014,9 +1014,7 @@ stub to ensure everything os ok prolog:print_message(Severity, Msg) :- \+ in, assert(in), - start_low_level_trace, ( prolog:print_message(Severity, Msg), fail; - stop_low_level_trace, retract(in) ). */ diff --git a/pl/meta.yap b/pl/meta.yap index e2a8cbaba..56054217e 100644 --- a/pl/meta.yap +++ b/pl/meta.yap @@ -13,7 +13,7 @@ */ - /** +/** @pred meta_predicate( Gi ) is directive Declares that this predicate manipulates references to predicates. @@ -43,46 +43,47 @@ The meta_predicate declaration is :- use_system_module( '$_arith', ['$c_built_in'/4]). meta_predicate(P) :- - source_module(SM), - '$meta_predicate'(P, SM). + source_module(SM), + '$meta_predicate'(P, SM). '$meta_predicate'(P,M) :- - var(P), - !, - '$do_error'(instantiation_error,meta_predicate(M:P)). + var(P), + !, + '$do_error'(instantiation_error,meta_predicate(M:P)). '$meta_predicate'(P,M) :- - var(M), - !, - '$do_error'(instantiation_error,meta_predicate(M:P)). + var(M), + !, + '$do_error'(instantiation_error,meta_predicate(M:P)). '$meta_predicate'((P,_Ps),M) :- - '$meta_predicate'(P,M), - fail. + '$meta_predicate'(P,M), + fail. '$meta_predicate'((_P,Ps),M) :- - !, - '$meta_predicate'(Ps,M). + !, + '$meta_predicate'(Ps,M). '$meta_predicate'( D, M ) :- - '$yap_strip_module'( M:D, M1, P), - P\==D, - !, - '$meta_predicate'( P, M1 ). + '$yap_strip_module'( M:D, M1, P), + P\==D, + !, + '$meta_predicate'( P, M1 ). '$meta_predicate'( D, M ) :- - functor(D,F,N), - '$install_meta_predicate'(D,M,F,N), - fail. + functor(D,F,N), + '$install_meta_predicate'(D,M,F,N), + fail. '$meta_predicate'( _D, _M ). '$install_meta_predicate'(P,M,_F,_N) :- - '$new_meta_pred'(P, M), - fail. -'$install_meta_predicate'(_P,M,F,N) :- - ( M = prolog -> M2 = _ ; M2 = M), - retractall(prolog:'$meta_predicate'(F,M2,N,_)), - fail. -'$install_meta_predicate'(P,M,F,N) :- - ( M = prolog -> M2 = _ ; M2 = M), - assertz('$meta_predicate'(F,M2,N,P)). + '$new_meta_pred'(P, M), + fail. - % comma has its own problems. +'$install_meta_predicate'(_P,M,F,N) :- + ( M = prolog -> M2 = _ ; M2 = M), + retractall(prolog:'$meta_predicate'(F,M2,N,_)), + fail. +'$install_meta_predicate'(P,M,F,N) :- + ( M = prolog -> M2 = _ ; M2 = M), + assertz('$meta_predicate'(F,M2,N,P)). + +% comma has its own problems. %% handle module transparent predicates by defining a %% new context module. @@ -96,31 +97,31 @@ meta_predicate(P) :- % I assume the clause has been processed, so the % var case is long gone! Yes :) '$clean_cuts'(G,('$current_choice_point'(DCP),NG)) :- - '$conj_has_cuts'(G,DCP,NG,OK), OK == ok, !. + '$conj_has_cuts'(G,DCP,NG,OK), OK == ok, !. '$clean_cuts'(G,G). '$clean_cuts'(G,DCP,NG) :- - '$conj_has_cuts'(G,DCP,NG,OK), OK == ok, !. + '$conj_has_cuts'(G,DCP,NG,OK), OK == ok, !. '$clean_cuts'(G,_,G). '$conj_has_cuts'(V,_,V, _) :- var(V), !. '$conj_has_cuts'(!,DCP,'$$cut_by'(DCP), ok) :- !. '$conj_has_cuts'((G1,G2),DCP,(NG1,NG2), OK) :- !, - '$conj_has_cuts'(G1, DCP, NG1, OK), - '$conj_has_cuts'(G2, DCP, NG2, OK). + '$conj_has_cuts'(G1, DCP, NG1, OK), + '$conj_has_cuts'(G2, DCP, NG2, OK). '$conj_has_cuts'((G1;G2),DCP,(NG1;NG2), OK) :- !, - '$conj_has_cuts'(G1, DCP, NG1, OK), - '$conj_has_cuts'(G2, DCP, NG2, OK). + '$conj_has_cuts'(G1, DCP, NG1, OK), + '$conj_has_cuts'(G2, DCP, NG2, OK). '$conj_has_cuts'((G1->G2),DCP,(G1;NG2), OK) :- !, - % G1: the system must have done it already - '$conj_has_cuts'(G2, DCP, NG2, OK). + % G1: the system must have done it already + '$conj_has_cuts'(G2, DCP, NG2, OK). '$conj_has_cuts'((G1*->G2),DCP,(G1;NG2), OK) :- !, - % G1: the system must have done it already - '$conj_has_cuts'(G2, DCP, NG2, OK). + % G1: the system must have done it already + '$conj_has_cuts'(G2, DCP, NG2, OK). '$conj_has_cuts'(if(G1,G2,G3),DCP,if(G1,NG2,NG3), OK) :- !, - % G1: the system must have done it already - '$conj_has_cuts'(G2, DCP, NG2, OK), - '$conj_has_cuts'(G3, DCP, NG3, OK). + % G1: the system must have done it already + '$conj_has_cuts'(G2, DCP, NG2, OK), + '$conj_has_cuts'(G3, DCP, NG3, OK). '$conj_has_cuts'(G,_,G, _). % return list of vars in expanded positions on the head of a clause. @@ -133,20 +134,20 @@ meta_predicate(P) :- '$do_module_u_vars'(M:H,UVars). '$do_module_u_vars'(M:H,UVars) :- - functor(H,F,N), - '$meta_predicate'(F,M,N,D), !, - '$do_module_u_vars'(N,D,H,UVars). + functor(H,F,N), + '$meta_predicate'(F,M,N,D), !, + '$do_module_u_vars'(N,D,H,UVars). '$do_module_u_vars'(_,[]). '$do_module_u_vars'(0,_,_,[]) :- !. '$do_module_u_vars'(I,D,H,LF) :- - arg(I,D,X), ( X=':' -> true ; integer(X)), - arg(I,H,A), '$uvar'(A, LF, L), !, - I1 is I-1, - '$do_module_u_vars'(I1,D,H,L). + arg(I,D,X), ( X=':' -> true ; integer(X)), + arg(I,H,A), '$uvar'(A, LF, L), !, + I1 is I-1, + '$do_module_u_vars'(I1,D,H,L). '$do_module_u_vars'(I,D,H,L) :- - I1 is I-1, - '$do_module_u_vars'(I1,D,H,L). + I1 is I-1, + '$do_module_u_vars'(I1,D,H,L). '$uvar'(Y, [Y|L], L) :- var(Y), !. % support all/3 @@ -165,30 +166,30 @@ meta_predicate(P) :- '$meta_expand'(G, _, CM, HVars, OG) :- var(G), !, - ( - lists:identical_member(G, HVars) + ( + lists:identical_member(G, HVars) -> - OG = G + OG = G ; - OG = CM:G + OG = CM:G ). % nothing I can do here: '$meta_expand'(G0, PredDef, CM, HVars, NG) :- - G0 =.. [Name|GArgs], - PredDef =.. [Name|GDefs], - functor(PredDef, Name, Arity ), - length(NGArgs, Arity), - NG =.. [Name|NGArgs], - '$expand_args'(GArgs, CM, GDefs, HVars, NGArgs). + G0 =.. [Name|GArgs], + PredDef =.. [Name|GDefs], + functor(PredDef, Name, Arity ), + length(NGArgs, Arity), + NG =.. [Name|NGArgs], + '$expand_args'(GArgs, CM, GDefs, HVars, NGArgs). '$expand_args'([], _, [], _, []). '$expand_args'([A|GArgs], CM, [M|GDefs], HVars, [NA|NGArgs]) :- - ( M == ':' -> true ; number(M) ), + ( M == ':' -> true ; number(M) ), !, - '$expand_arg'(A, CM, HVars, NA), - '$expand_args'(GArgs, CM, GDefs, HVars, NGArgs). + '$expand_arg'(A, CM, HVars, NA), + '$expand_args'(GArgs, CM, GDefs, HVars, NGArgs). '$expand_args'([A|GArgs], CM, [_|GDefs], HVars, [A|NGArgs]) :- - '$expand_args'(GArgs, CM, GDefs, HVars, NGArgs). + '$expand_args'(GArgs, CM, GDefs, HVars, NGArgs). % check if an argument should be expanded @@ -199,6 +200,72 @@ meta_predicate(P) :- '$expand_arg'(G, CM, _HVars, NCM:NG) :- '$yap_strip_module'(CM:G, NCM, NG). +'$match_mod'(G, _HMod, _SMod, M, O) :- + '$is_system_predicate'(G,M), + !, + O = G. +'$match_mod'(G, M, M, M, G) :- !. +'$match_mod'(G, _HM, _M, M, M:G). + +'$import_expansion'(none, MG, MG). +'$import_expansion'(_, M:G, M1:G1) :- + '$imported_predicate'(M:G, M1:G1), + !. +'$import_expansion'(_, MG, MG). + +'$end_goal_expansion'(G, G1, GOF, HM, SM, BM, H) :- + '$match_mod'(G, HM, SM, BM, G1), + '$c_built_in'(G1, BM, H, GO), + '$yap_strip_module'(BM:GO, MO, IGO), + '$match_mod'(IGO, HM, SM, MO, GOF). + +'$user_expansion'(none, MG, MG) :- + !. +'$user_expansion'(Ctx, M0N:G0N, M1:G1) :- + '_user_expand_goal'(M0N:G0N, M:G), + !, + ( M:G == M0N:G0N + -> + M1:G1 = M:G + ; + '$user_expansion'(Ctx, M:G, M1:G1) + ). +'$user_expansion'(_,MG, MG). + + +'$meta_expansion'(GMG, BM, HVars, GM:GF) :- + '$yap_strip_module'(BM:GMG, GM, G ), + functor(G, F, Arity ), + '$meta_predicate'(F, GM, Arity, PredDef), + !, + '$meta_expand'(G, PredDef, GM, HVars, GF). +'$meta_expansion'(GF, BM, _HVars, BM:GF). + +'$expand_goal'(G0, GF, GS, HM, SM, BM, HVars-H) :- + '$yap_strip_module'( BM:G0, M0N, G0N), + '$user_expansion'(HVars,M0N:G0N, M1:G1), + '$import_expansion'(HVars, M1:G1, M2:G2), + '$meta_expansion'(G2, M2, HVars, MG3), + '$yap_strip_module'(MG3, M4, B4), + '$end_goal_expansion'(B4, GF, GS, HM, SM, M4, H). + +/* +'$match_mod'(G, HMod, SMod, M, O) :- + ( + % \+ '$is_multifile'(G1,M), + %-> + '$is_system_predicate'(G,M) + -> + O = G + ; + M == HMod, M == SMod + -> + O = G + ; + O = M:G + ). +*/ + % expand module names in a body % args are: % goals to expand @@ -226,128 +293,128 @@ meta_predicate(P) :- % % % head variab'$expand_goals'(M:G,G1,GO,HM,SM,,_M,HVars)les. - % goals or arguments/sub-arguments? - % I cannot use call here because of format/3 +% goals or arguments/sub-arguments? +% I cannot use call here because of format/3 % modules: % A4: module for body of clause (this is the one used in looking up predicates) % A5: context module (this is the current context - % A6: head module (this is the one used in compiling and accessing). +% A6: head module (this is the one used in compiling and accessing). % % %'$expand_goals'(V,NG,NG,HM,SM,BM,HVars):- writeln(V), fail. '$expand_goals'(V,NG,NGO,HM,SM,BM,HVars-H) :- - var(V), - !, - ( lists:identical_member(V, HVars) - -> - '$expand_goals'(call(V),NG,NGO,HM,SM,BM,HVars-H) - ; - ( atom(BM) - -> - NG = call(BM:V), - NGO = '$execute_in_mod'(V,BM) - ; - '$expand_goals'(call(BM:V),NG,NGO,HM,SM,BM,HVars-H) - ) - ). + var(V), + !, + ( lists:identical_member(V, HVars) + -> + '$expand_goals'(call(V),NG,NGO,HM,SM,BM,HVars-H) + ; + ( atom(BM) + -> + NG = call(BM:V), + NGO = '$execute_in_mod'(V,BM) + ; + '$expand_goals'(call(BM:V),NG,NGO,HM,SM,BM,HVars-H) + ) + ). '$expand_goals'(BM:V,NG,NGO,HM,SM,_BM,HVarsH) :- - '$yap_strip_module'( BM:V, CM, G), - nonvar(CM), - !, - '$expand_goals'(G,NG,NGO,HM,SM,CM,HVarsH). + '$yap_strip_module'( BM:V, CM, G), + nonvar(CM), + !, + '$expand_goals'(G,NG,NGO,HM,SM,CM,HVarsH). '$expand_goals'(CM0:V,NG,NGO,HM,SM,BM,HVarsH) :- - strip_module( CM0:V, CM, G), - !, - '$expand_goals'(call(CM:G),NG,NGO,HM,SM,BM,HVarsH). + strip_module( CM0:V, CM, G), + !, + '$expand_goals'(call(CM:G),NG,NGO,HM,SM,BM,HVarsH). % if I don't know what the module is, I cannot do anything to the goal, % so I just put a call for later on. '$expand_goals'(V,NG,NGO,_HM,_SM,BM,_HVarsH) :- - var(BM), - !, + var(BM), + !, NG = call(BM:V), NGO = '$execute_wo_mod'(V,BM). '$expand_goals'(depth_bound_call(G,D), - depth_bound_call(G1,D), - ('$set_depth_limit_for_next_call'(D),GO), - HM,SM,BM,HVars) :- + depth_bound_call(G1,D), + ('$set_depth_limit_for_next_call'(D),GO), + HM,SM,BM,HVars) :- '$expand_goals'(G,G1,GO,HM,SM,BM,HVars), '$composed_built_in'(GO), !. '$expand_goals'((A,B),(A1,B1),(AO,BO),HM,SM,BM,HVars) :- !, - '$expand_goals'(A,A1,AO,HM,SM,BM,HVars), - '$expand_goals'(B,B1,BO,HM,SM,BM,HVars). + '$expand_goals'(A,A1,AO,HM,SM,BM,HVars), + '$expand_goals'(B,B1,BO,HM,SM,BM,HVars). '$expand_goals'((A;B),(A1;B1),(AO;BO),HM,SM,BM,HVars) :- var(A), !, - '$expand_goals'(A,A1,AO,HM,SM,BM,HVars), - '$expand_goals'(B,B1,BO,HM,SM,BM,HVars). + '$expand_goals'(A,A1,AO,HM,SM,BM,HVars), + '$expand_goals'(B,B1,BO,HM,SM,BM,HVars). '$expand_goals'((A*->B;C),(A1*->B1;C1), - ( - yap_hacks:current_choicepoint(DCP), - AO, - yap_hacks:cut_at(DCP),BO - ; - CO - ), - HM,SM,BM,HVars) :- !, - '$expand_goals'(A,A1,AOO,HM,SM,BM,HVars), - '$clean_cuts'(AOO, AO), - '$expand_goals'(B,B1,BO,HM,SM,BM,HVars), - '$expand_goals'(C,C1,CO,HM,SM,BM,HVars). + ( + yap_hacks:current_choicepoint(DCP), + AO, + yap_hacks:cut_at(DCP),BO + ; + CO + ), + HM,SM,BM,HVars) :- !, + '$expand_goals'(A,A1,AOO,HM,SM,BM,HVars), + '$clean_cuts'(AOO, AO), + '$expand_goals'(B,B1,BO,HM,SM,BM,HVars), + '$expand_goals'(C,C1,CO,HM,SM,BM,HVars). '$expand_goals'((A;B),(A1;B1),(AO;BO),HM,SM,BM,HVars) :- !, - '$expand_goals'(A,A1,AO,HM,SM,BM,HVars), - '$expand_goals'(B,B1,BO,HM,SM,BM,HVars). + '$expand_goals'(A,A1,AO,HM,SM,BM,HVars), + '$expand_goals'(B,B1,BO,HM,SM,BM,HVars). '$expand_goals'((A|B),(A1|B1),(AO|BO),HM,SM,BM,HVars) :- !, - '$expand_goals'(A,A1,AO,HM,SM,BM,HVars), - '$expand_goals'(B,B1,BO,HM,SM,BM,HVars). + '$expand_goals'(A,A1,AO,HM,SM,BM,HVars), + '$expand_goals'(B,B1,BO,HM,SM,BM,HVars). '$expand_goals'((A->B),(A1->B1),(AO->BO),HM,SM,BM,HVars) :- !, - '$expand_goals'(A,A1,AOO,HM,SM,BM,HVars), - '$clean_cuts'(AOO, AO), - '$expand_goals'(B,B1,BO,HM,SM,BM,HVars). + '$expand_goals'(A,A1,AOO,HM,SM,BM,HVars), + '$clean_cuts'(AOO, AO), + '$expand_goals'(B,B1,BO,HM,SM,BM,HVars). '$expand_goals'(\+G,\+G,A\=B,_HM,_BM,_SM,_HVars) :- nonvar(G), G = (A = B), !. '$expand_goals'(\+A,\+A1,(AO-> false;true),HM,SM,BM,HVars) :- !, - '$expand_goals'(A,A1,AOO,HM,SM,BM,HVars), - '$clean_cuts'(AOO, AO). + '$expand_goals'(A,A1,AOO,HM,SM,BM,HVars), + '$clean_cuts'(AOO, AO). '$expand_goals'(not(G),not(G),A\=B,_HM,_BM,_SM,_HVars) :- nonvar(G), G = (A = B), !. '$expand_goals'(not(A),not(A1),(AO-> false;true),HM,SM,BM,HVars) :- !, - '$expand_goals'(A,A1,AOO,HM,SM,BM,HVars), - '$clean_cuts'(AOO, AO). + '$expand_goals'(A,A1,AOO,HM,SM,BM,HVars), + '$clean_cuts'(AOO, AO). '$expand_goals'(once(A),once(A1), - ('$current_choice_point'(CP),AO,'$$cut_by'(CP)),HM,SM,BM,HVars) :- !, - '$expand_goals'(A,A1,AO0,HM,SM,BM,HVars), - '$clean_cuts'(AO0, CP, AO). + ('$current_choice_point'(CP),AO,'$$cut_by'(CP)),HM,SM,BM,HVars) :- !, + '$expand_goals'(A,A1,AO0,HM,SM,BM,HVars), + '$clean_cuts'(AO0, CP, AO). '$expand_goals'((:-A),(:-A1), - (:-AO),HM,SM,BM,HVars) :- !, - '$expand_goals'(A,A1,AO,HM,SM,BM,HVars). + (:-AO),HM,SM,BM,HVars) :- !, + '$expand_goals'(A,A1,AO,HM,SM,BM,HVars). '$expand_goals'(ignore(A),ignore(A1), - ('$current_choice_point'(CP),AO,'$$cut_by'(CP)-> true ; true),HM,SM,BM,HVars) :- !, - '$expand_goals'(A,A1,AO0,HM,SM,BM,HVars), + ('$current_choice_point'(CP),AO,'$$cut_by'(CP)-> true ; true),HM,SM,BM,HVars) :- !, + '$expand_goals'(A,A1,AO0,HM,SM,BM,HVars), '$clean_cuts'(AO0, AO). '$expand_goals'(forall(A,B),forall(A1,B1), - ((AO, ( BO-> false ; true)) -> false ; true),HM,SM,BM,HVars) :- !, - '$expand_goals'(A,A1,AO0,HM,SM,BM,HVars), - '$expand_goals'(B,B1,BO,HM,SM,BM,HVars), - '$clean_cuts'(AO0, AO). + ((AO, ( BO-> false ; true)) -> false ; true),HM,SM,BM,HVars) :- !, + '$expand_goals'(A,A1,AO0,HM,SM,BM,HVars), + '$expand_goals'(B,B1,BO,HM,SM,BM,HVars), + '$clean_cuts'(AO0, AO). '$expand_goals'(if(A,B,C),if(A1,B1,C1), - ('$current_choice_point'(DCP),AO,yap_hacks:cut_at(DCP),BO; CO),HM,SM,BM,HVars) :- !, - '$expand_goals'(A,A1,AO0,HM,SM,BM,HVars), - '$expand_goals'(B,B1,BO,HM,SM,BM,HVars), - '$expand_goals'(C,C1,CO,HM,SM,BM,HVars), - '$clean_cuts'(AO0, DCP, AO). + ('$current_choice_point'(DCP),AO,yap_hacks:cut_at(DCP),BO; CO),HM,SM,BM,HVars) :- !, + '$expand_goals'(A,A1,AO0,HM,SM,BM,HVars), + '$expand_goals'(B,B1,BO,HM,SM,BM,HVars), + '$expand_goals'(C,C1,CO,HM,SM,BM,HVars), + '$clean_cuts'(AO0, DCP, AO). '$expand_goals'((A*->B;C),(A1*->B1;C1), - ('$current_choice_point'(DCP),AO,yap_hacks:cut_at(DCP),BO; CO),HM,SM,BM,HVars) :- !, - '$expand_goals'(A,A1,AO0,HM,SM,BM,HVars), - '$expand_goals'(B,B1,BO,HM,SM,BM,HVars), - '$expand_goals'(C,C1,CO,HM,SM,BM,HVars), + ('$current_choice_point'(DCP),AO,yap_hacks:cut_at(DCP),BO; CO),HM,SM,BM,HVars) :- !, + '$expand_goals'(A,A1,AO0,HM,SM,BM,HVars), + '$expand_goals'(B,B1,BO,HM,SM,BM,HVars), + '$expand_goals'(C,C1,CO,HM,SM,BM,HVars), '$clean_cuts'(AO0, DCP, AO). '$expand_goals'((A*->B),(A1*->B1), - ('$current_choice_point'(DCP),AO,BO),HM,SM,BM,HVars) :- !, - '$expand_goals'(A,A1,AO0,HM,SM,BM,HVars), - '$expand_goals'(B,B1,BO,HM,SM,BM,HVars), + ('$current_choice_point'(DCP),AO,BO),HM,SM,BM,HVars) :- !, + '$expand_goals'(A,A1,AO0,HM,SM,BM,HVars), + '$expand_goals'(B,B1,BO,HM,SM,BM,HVars), '$clean_cuts'(AO0, DCP, AO). '$expand_goals'(true,true,true,_,_,_,_) :- !. '$expand_goals'(fail,fail,fail,_,_,_,_) :- !. @@ -357,77 +424,6 @@ meta_predicate(P) :- '$expand_goal'(GM, G1, GO, HM, SM, NBM, HVars). -'$import_expansion'(M:G, M1:G1) :- - '$imported_predicate'(G, M, G1, M1), - !. -'$import_expansion'(MG, MG). - -'$meta_expansion'(GMG, BM, HVars, GM:GF) :- - '$yap_strip_module'(GMG, GM, G ), - functor(G, F, Arity ), - '$meta_predicate'(F, GM, Arity, PredDef), - !, - '$meta_expand'(G, PredDef, BM, HVars, GF). -'$meta_expansion'(GMG, _BM, _HVars, GM:G) :- - '$yap_strip_module'(GMG, GM, G ). - -%% none -- metacalls - '$expand_goal'(G0, GF, GF, _HM, _SM, BM, none-_) :- - !, - '$yap_strip_module'( BM:G0, M0N, G0N), - '$user_expansion'(M0N:G0N, M1:G1), - '$import_expansion'(M1:G1, M2:G2), - '$meta_expansion'(M2:G2, M1, [], GF). -'$expand_goal'(G0, G1F, GOF, HM, SM, BM, HVars-H) :- - '$yap_strip_module'( BM:G0, M0N, G0N), - '$user_expansion'(M0N:G0N, M1:G1), - '$import_expansion'(M1:G1, M2:G2), - '$meta_expansion'(M2:G2, M1, HVars, M2B1F), - '$yap_strip_module'(M2B1F, M3, B1F), - '$end_goal_expansion'(B1F, G1F, GOF, HM, SM, M3, H). - -'$end_goal_expansion'(G, G1, GOF, HM, SM, BM, H) :- - '$match_mod'(G, HM, SM, BM, G1), - '$c_built_in'(G1, BM, H, GO), - '$yap_strip_module'(BM:GO, MO, IGO), - '$match_mod'(IGO, HM, SM, MO, GOF). - -'$user_expansion'(M0N:G0N, M1:G1) :- - '_user_expand_goal'(M0N:G0N, M:G), - !, - ( M:G == M0N:G0N - -> - M1:G1 = M:G - ; - '$user_expansion'(M:G, M1:G1) - ). -'$user_expansion'(MG, MG). - - - '$match_mod'(G, _HMod, _SMod, M, O) :- - '$is_system_predicate'(G,M), - !, - O = G. - '$match_mod'(G, M, M, M, G) :- !. - '$match_mod'(G, _HM, _M, M, M:G). - - -/* -'$match_mod'(G, HMod, SMod, M, O) :- - ( - % \+ '$is_multifile'(G1,M), - %-> - '$is_system_predicate'(G,M) - -> - O = G - ; - M == HMod, M == SMod - -> - O = G - ; - O = M:G - ). -*/ '$build_up'(HM, NH, SM, true, NH, true, NH) :- HM == SM, !. '$build_up'(HM, NH, _SM, true, HM:NH, true, HM:NH) :- !. @@ -438,40 +434,18 @@ meta_predicate(P) :- var(V), !. '$expand_clause_body'(true, _NH1, _HM1, _SM, _M, true, true ) :- !. '$expand_clause_body'(B, H, HM, SM, M, B1, BO ) :- - '$module_u_vars'(HM , H, UVars), % collect head variables in - % expanded positions - % support for SWI's meta primitive. - '$is_mt'(H, B, HM, SM, M, IB, BM), - '$expand_goals'(IB, B1, BO1, HM, SM, BM, UVars-H), + '$module_u_vars'(HM , H, UVars), % collect head variables in + % expanded positions + % support for SWI's meta primitive. + '$is_mt'(H, B, HM, SM, M, IB, BM), + '$expand_goals'(IB, B1, BO1, HM, SM, BM, UVars-H), ( - '$full_clause_optimisation'(H, BM, BO1, BO) + '$full_clause_optimisation'(H, BM, BO1, BO) -> - true + true ; - BO = BO1 - ). - -% -% check if current module redefines an imported predicate. -% and remove import. -% -'$not_imported'(H, Mod) :- - recorded('$import','$import'(NM,Mod,NH,H,_,_),R), - NM \= Mod, - functor(NH,N,Ar), - print_message(warning,redefine_imported(Mod,NM,N/Ar)), - erase(R), - fail. -'$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). - + BO = BO1 + ). % expand arguments of a meta-predicate @@ -488,7 +462,7 @@ meta_predicate(P) :- % A5: context module (this is the current context % A4: module for body of clause (this is the one used in looking up predicates) % - % has to be last!!! +% 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. '$head_and_body'(HB, H, B), % HB is H :- B. diff --git a/pl/modules.yap b/pl/modules.yap index 625094b1d..95ce44332 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -42,7 +42,7 @@ '$do_import'/3, '$extend_exports'/3, '$get_undefined_pred'/4, - '$imported_predicate'/4, + '$imported_predicate'/2, '$meta_expand'/6, '$meta_predicate'/2, '$meta_predicate'/4, @@ -297,6 +297,29 @@ use_module(F,Is) :- functor(G1, N1, K1), '$module_produced by'(M,MI,N1,K1). +% +% check if current module redefines an imported predicate. +% and remove import. +% +'$not_imported'(H, Mod) :- + recorded('$import','$import'(NM,Mod,NH,H,_,_),R), + NM \= Mod, + functor(NH,N,Ar), + print_message(warning,redefine_imported(Mod,NM,N/Ar)), + erase(R), + fail. +'$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 diff --git a/pl/newmod.yap b/pl/newmod.yap index 2c535783a..4b2569575 100644 --- a/pl/newmod.yap +++ b/pl/newmod.yap @@ -31,7 +31,7 @@ module(N) :- module(N) :- atom(N), !, % set it as current module. - '$current_module'(_,N). + '$change_module'(N). module(N) :- '$do_error'(type_error(atom,N),module(N)). diff --git a/pl/pathconf.yap b/pl/pathconf.yap index 30e9e3dca..6bd41773d 100644 --- a/pl/pathconf.yap +++ b/pl/pathconf.yap @@ -14,7 +14,7 @@ :- module(user). /** -@pred library_directory(?Directory:atom) is nondet, dynamic +@pred user:library_directory(?Directory:atom) is nondet, dynamic Dynamic, multi-file predicate that succeeds when _Directory_ is a current library directory name. Asserted in the user module. @@ -26,24 +26,24 @@ reconsult/1, use_module/1, ensure_loaded/1, and load_files/2. This directory is initialized by a rule that calls the system predicate system_library/1. */ -:- multifile library_directory/1. -:- discontiguous library_directory/1. -:- dynamic library_directory/1. +:- multifile user:library_directory/1. +:- discontiguous user:library_directory/1. +:- dynamic user:library_directory/1. %% Specifies the set of directories where % one can find Prolog libraries. % -library_directory(Home) :- - current_prolog_flag(prolog_library_directory, Home), +user:library_directory(Home) :- + current_prolog_flag(library_directory, Home), Home \= ''. % 1. honor YAPSHAREDIR -library_directory( Dir ) :- +user:library_directory( Dir ) :- getenv( 'YAPSHAREDIR', Dir). %% 2. honor user-library -library_directory( '~/share/Yap' ). +user:library_directory( '~/share/Yap' ). %% 3. honor current directory -library_directory( '.' ). +user:library_directory( '.' ). %% 4. honor default location. -library_directory( Dir ) :- +user:library_directory( Dir ) :- system_library( Dir ). /** @@ -54,12 +54,12 @@ library_directory( Dir ) :- This directory is initialized as a rule that calls the system predicate library_directories/2. */ -:- dynamic commons_directory/1. -:- discontiguous commons_directory/1. -:- multifile commons_directory/1. +:- dynamic user:commons_directory/1. +:- discontiguous user:commons_directory/1. +:- multifile user:commons_directory/1. -commons_directory( Path ):- +user:commons_directory( Path ):- system_commons( Path ). /** @@ -81,7 +81,7 @@ foreign_directory(Home) :- Home \= ''. foreign_directory(C) :- current_prolog_flag(windows, true), - file_search_path(path, C). + user:file_search_path(path, C). foreign_directory( '.'). foreign_directory(yap('lib/Yap')). %foreign_directory( Path ):- @@ -96,64 +96,64 @@ foreign_directory(yap('lib/Yap')). uses one of dll, so, or dylib for shared objects. Initial definition is: ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~prolog - prolog_file_type(yap, prolog). - prolog_file_type(pl, prolog). - prolog_file_type(prolog, prolog). - prolog_file_type(qly, prolog). - prolog_file_type(qly, qly). - prolog_file_type(A, prolog) :- + user:prolog_file_type(yap, prolog). + user:prolog_file_type(pl, prolog). + user:prolog_file_type(prolog, prolog). + user:prolog_file_type(qly, prolog). + user:prolog_file_type(qly, qly). + user:prolog_file_type(A, prolog) :- current_prolog_flag(associate, A), A \== prolog, A \==pl, A \== yap. - prolog_file_type(A, executable) :- + user:prolog_file_type(A, executable) :- current_prolog_flag(shared_object_extension, A). - prolog_file_type(pyd, executable). + user:prolog_file_type(pyd, executable). ~~~~~~~~~~~~~~~~~~~~~ */ -:- multifile prolog_file_type/2. -:- discontiguous prolog_file_type/2. -:- dynamic prolog_file_type/2. +:- multifile user:prolog_file_type/2. +:- discontiguous user:prolog_file_type/2. +:- dynamic user:prolog_file_type/2. -prolog_file_type(yap, prolog). -prolog_file_type(pl, prolog). -prolog_file_type(prolog, prolog). -prolog_file_type(A, prolog) :- +user:prolog_file_type(yap, prolog). +user:prolog_file_type(pl, prolog). +user:prolog_file_type(prolog, prolog). +user:prolog_file_type(A, prolog) :- current_prolog_flag(associate, A), A \== prolog, A \== pl, A \== yap. -prolog_file_type(qly, qly). -prolog_file_type(A, executable) :- +user:prolog_file_type(qly, qly). +user:prolog_file_type(A, executable) :- current_prolog_flag(shared_object_extension, A). - prolog_file_type(pyd, executable). + user:prolog_file_type(pyd, executable). /** - @pred file_search_path(+Name:atom, -Directory:atom) is nondet + @pred user:file_search_path(+Name:atom, -Directory:atom) is nondet Allows writing file names as compound terms. The _Name_ and _DIRECTORY_ must be atoms. The predicate may generate multiple solutions. The predicate is originally defined as follows: ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl -file_search_path(library, Dir) :- - library_directory(Dir). -file_search_path(commons, Dir) :- +user:file_search_path(library, Dir) :- + user:library_directory(Dir). +user:file_search_path(commons, Dir) :- commons_directory(Dir). -file_search_path(swi, Home) :- +user:file_search_path(swi, Home) :- current_prolog_flag(home, Home). -file_search_path(yap, Home) :- +user:file_search_path(yap, Home) :- current_prolog_flag(home, Home). -file_search_path(system, Dir) :- +user:file_search_path(system, Dir) :- prolog_flag(host_type, Dir). -file_search_path(foreign, Dir) :- +user:file_search_path(foreign, Dir) :- foreign_directory(Dir). -file_search_path(executable, Dir) :- +user:file_search_path(executable, Dir) :- foreign_directory(Dir). -file_search_path(executable, Dir) :- +user:file_search_path(executable, Dir) :- foreign_directory(Dir). -file_search_path(path, C) :- +user:file_search_path(path, C) :- ( getenv('PATH', A), ( current_prolog_flag(windows, true) -> atomic_list_concat(B, ;, A) @@ -165,30 +165,30 @@ file_search_path(path, C) :- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Thus, `compile(library(A))` will search for a file using - library_directory/1 to obtain the prefix, + user:library_directory/1 to obtain the prefix, whereas 'compile(system(A))` would look at the `host_type` flag. */ -:- multifile file_search_path/2. +:- multifile user:file_search_path/2. -:- dynamic file_search_path/2. -:- discontiguous file_search_path/2. +:- dynamic user:file_search_path/2. +:- discontiguous user:file_search_path/2. -file_search_path(library, Dir) :- - library_directory(Dir). -file_search_path(commons, Dir) :- - commons_directory(Dir). -file_search_path(swi, Home) :- +user:file_search_path(library, Dir) :- + user:library_directory(Dir). +user:file_search_path(commons, Dir) :- + user:commons_directory(Dir). +user:file_search_path(swi, Home) :- current_prolog_flag(home, Home). -file_search_path(yap, Home) :- +user:file_search_path(yap, Home) :- current_prolog_flag(home, Home). -file_search_path(system, Dir) :- +user:file_search_path(system, Dir) :- prolog_flag(host_type, Dir). -file_search_path(foreign, Dir) :- +user:file_search_path(foreign, Dir) :- foreign_directory(Dir). -file_search_path(executable, Dir) :- +user:file_search_path(executable, Dir) :- foreign_directory(Dir). -file_search_path(path, C) :- +user:file_search_path(path, C) :- ( getenv('PATH', A), ( current_prolog_flag(windows, true) -> atomic_list_concat(B, ;, A) @@ -197,5 +197,4 @@ file_search_path(path, C) :- lists:member(C, B) ). - %% @} diff --git a/pl/preddyns.yap b/pl/preddyns.yap index d2b5809e3..a9922e23f 100644 --- a/pl/preddyns.yap +++ b/pl/preddyns.yap @@ -1,5 +1,5 @@ - % The next predicates are applicable only - % to dynamic code +% The next predicates are applicable only +% to dynamic code /** @file preddyns.yap */ @@ -50,7 +50,7 @@ assert(Clause) :- '$assert'(Clause, assertz, _). '$assert'(Clause, Where, R) :- -'$yap_strip_clause'(Clause, _, _Clause0), + '$yap_strip_clause'(Clause, _, _Clause0), '$expand_clause'(Clause,C0,C), '$$compile'(C, Where, C0, R). @@ -99,72 +99,72 @@ assert(Clause, Ref) :- '$head_and_body'(C,H,B), '$assertat_d'(assertz,H,B,C0,Mod,_). '$assertz_dynamic'(X,C,C0,Mod) :- - '$head_and_body'(C,H,B), - functor(H,N,A), - ('$check_if_reconsulted'(N,A) -> - true + '$head_and_body'(C,H,B), + functor(H,N,A), + ('$check_if_reconsulted'(N,A) -> + true ; - (X/\8)=:=0 -> - '$inform_as_reconsulted'(N,A), - '$remove_all_d_clauses'(H,Mod) + (X/\8)=:=0 -> + '$inform_as_reconsulted'(N,A), + '$remove_all_d_clauses'(H,Mod) ; - true - ), - '$assertat_d'(assertz,H,B,C0,Mod,_). + true + ), + '$assertat_d'(assertz,H,B,C0,Mod,_). '$remove_all_d_clauses'(H,M) :- - '$is_multifile'(H, M), !, - functor(H, Na, A), - '$erase_all_mf_dynamic'(Na,A,M). + '$is_multifile'(H, M), !, + functor(H, Na, A), + '$erase_all_mf_dynamic'(Na,A,M). '$remove_all_d_clauses'(H,M) :- - '$recordedp'(M:H,_,R), erase(R), fail. + '$recordedp'(M:H,_,R), erase(R), fail. '$remove_all_d_clauses'(_,_). '$erase_all_mf_dynamic'(Na,A,M) :- - source_location( F , _), - recorded('$multifile_dynamic'(_,_,_), '$mf'(Na,A,M,F,R), R1), - erase(R1), - erase(R), - fail. + source_location( F , _), + recorded('$multifile_dynamic'(_,_,_), '$mf'(Na,A,M,F,R), R1), + erase(R1), + erase(R), + fail. '$erase_all_mf_dynamic'(_,_,_). '$assertat_d'(asserta,Head,Body,C0,Mod,R) :- !, - '$compile_dynamic'((Head:-Body), asserta, C0, Mod, CR), + '$compile_dynamic'((Head:-Body), asserta, C0, Mod, CR), ( get_value('$abol',true) -> - '$predicate_flags'(Head,Mod,Fl,Fl), - ( Fl /\ 0x20000000 =\= 0 -> '$check_multifile_pred'(Head,Mod,Fl) ; true ) + '$predicate_flags'(Head,Mod,Fl,Fl), + ( Fl /\ 0x20000000 =\= 0 -> '$check_multifile_pred'(Head,Mod,Fl) ; true ) ; - true + true ), - '$head_and_body'(C0, H0, B0), - '$recordap'(Mod:Head,(H0 :- B0),R,CR), - ( '$is_multifile'(Head, Mod) -> + '$head_and_body'(C0, H0, B0), + '$recordap'(Mod:Head,(H0 :- B0),R,CR), + ( '$is_multifile'(Head, Mod) -> source_location(F, _), functor(H0, Na, Ar), recorda('$multifile_dynamic'(_,_,_), '$mf'(Na,Ar,Mod,F,R), _) - ; - true - ). + ; + true + ). '$assertat_d'(assertz,Head,Body,C0,Mod,R) :- - '$compile_dynamic'((Head:-Body), assertz, C0, Mod, CR), + '$compile_dynamic'((Head:-Body), assertz, C0, Mod, CR), ( get_value('$abol',true) -> - '$predicate_flags'(Head,Mod,Fl,Fl), - ( Fl /\ 0x20000000 =\= 0 -> '$check_multifile_pred'(Head,Mod,Fl) ; true ) + '$predicate_flags'(Head,Mod,Fl,Fl), + ( Fl /\ 0x20000000 =\= 0 -> '$check_multifile_pred'(Head,Mod,Fl) ; true ) ; - true + true ), - '$head_and_body'(C0, H0, B0), - '$recordzp'(Mod:Head,(H0 :- B0),R,CR), - ( '$is_multifile'(H0, Mod) -> + '$head_and_body'(C0, H0, B0), + '$recordzp'(Mod:Head,(H0 :- B0),R,CR), + ( '$is_multifile'(H0, Mod) -> source_location(F, _), functor(H0, Na, Ar), recordz('$multifile_dynamic'(_,_,_), '$mf'(Na,Ar,Mod,F,R), _) - ; - true - ). + ; + true + ). /** @pred retract(+ _C_) is iso @@ -178,68 +178,65 @@ source/0 ( (see Setting the Compiler)). */ retract( C ) :- strip_module( C, M, C0), - '$check_head_and_body'(M:C0,M1,H,B,retract(M:C)), - '$predicate_flags'(H, M1, F, F), - '$retract2'(F, H, M1, B,_). + '$check_head_and_body'(M:C0,M1,H,B,retract(M:C)), + '$predicate_flags'(H, M1, F, F), + '$retract2'(F, H, M1, B,_). '$retract2'(F, H, M, B, R) :- - F /\ 0x08000000 =:= 0x08000000, !, - % '$is_log_updatable'(H, M), !, - '$log_update_clause'(H,M,B,R), - ( F /\ 0x20000000 =:= 0x20000000, recorded('$mf','$mf_clause'(_,_,_,_,R),MR), erase(MR), fail ; true), - erase(R). + F /\ 0x08000000 =:= 0x08000000, !, + % '$is_log_updatable'(H, M), !, + '$log_update_clause'(H,M,B,R), + ( F /\ 0x20000000 =:= 0x20000000, recorded('$mf','$mf_clause'(_,_,_,_,R),MR), erase(MR), fail ; true), + erase(R). '$retract2'(F, H, M, B, R) :- - % '$is_dynamic'(H,M), !, - F /\ 0x00002000 =:= 0x00002000, !, - '$recordedp'(M:H,(H:-B),R), - ( F /\ 0x20000000 =:= 0x20000000, recorded('$mf','$mf_clause'(_,_,_,_,MRef),MR), erase(MR), erase(MRef), fail ; true), - erase(R). + % '$is_dynamic'(H,M), !, + F /\ 0x00002000 =:= 0x00002000, !, + '$recordedp'(M:H,(H:-B),R), + ( F /\ 0x20000000 =:= 0x20000000, recorded('$mf','$mf_clause'(_,_,_,_,MRef),MR), erase(MR), erase(MRef), fail ; true), + erase(R). '$retract2'(_, H,M,_,_) :- - '$undefined'(H,M), !, - functor(H,Na,Ar), - '$dynamic'(Na/Ar,M), - fail. + '$undefined'(H,M), !, + functor(H,Na,Ar), + '$dynamic'(Na/Ar,M), + fail. '$retract2'(_, H,M,B,_) :- - functor(H,Na,Ar), - \+ '$dynamic'(Na/Ar,M), - '$do_error'(permission_error(modify,static_procedure,Na/Ar),retract(M:(H:-B))). + functor(H,Na,Ar), + \+ '$dynamic'(Na/Ar,M), + '$do_error'(permission_error(modify,static_procedure,Na/Ar),retract(M:(H:-B))). /** @pred retract(+ _C_,- _R_) Erases from the program the clause _C_ whose database reference is _R_. The predicate must be dynamic. - - - */ retract(M:C,R) :- !, '$yap_strip_module'( C, M, H0), '$retract'(H0, M, R). '$retract'(C, M0, R) :- - db_reference(R), - '$check_head_and_body'(M0:C,M,H,B,retract(C,R)), - dynamic(H,M), - !, - instance(R,(H:-B)), - erase(R). + db_reference(R), + '$check_head_and_body'(M0:C,M,H,B,retract(C,R)), + dynamic(H,M), + !, + instance(R,(H:-B)), + erase(R). '$retract'(C,M0,R) :- - '$check_head_and_body'(M0:C,M,H,B,retract(C,R)), - var(R), !, - '$retract2'(H, M, B, R). + '$check_head_and_body'(M0:C,M,H,B,retract(C,R)), + var(R), !, + '$retract2'(H, M, B, R). '$retract'(C,M,_) :- - '$fetch_predicate_indicator_from_clause'(C, M, PI), + '$fetch_predicate_indicator_from_clause'(C, M, PI), \+ '$dynamic'(PI), - '$do_error'(permission_error(modify,static_procedure,PI),retract(M:C)). + '$do_error'(permission_error(modify,static_procedure,PI),retract(M:C)). '$fetch_predicate_indicator_from_clause'((C :- _), M:Na/Ar) :- -!, + !, '$yap_strip_module'(C, M, C1), functor(C1, Na, Ar). '$fetch_predicate_indicator_from_clause'(C, M:Na/Ar) :- '$yap_strip_module'(C, M, C1), - functor(C1, Na, Ar). + functor(C1, Na, Ar). /** @pred retractall(+ _G_) is iso @@ -263,11 +260,11 @@ retractall(V) :- ; '$undefined'(T,M) -> - '$dynamic'(Na/Ar,M) + '$dynamic'(Na/Ar,M) ; '$is_dynamic'(T,M) -> - '$erase_all_clauses_for_dynamic'(T, M) + '$erase_all_clauses_for_dynamic'(T, M) ; '$do_error'(permission_error(modify,static_procedure,Na/Ar),retractall(T)) ). @@ -297,12 +294,12 @@ retractall(V) :- '$retractall_lu_mf'(_T,_M,_Na,_Ar). '$erase_lu_mf_clause'(Na,Ar,M,R) :- - recorded('$mf','$mf_clause'(_,Na,Ar,M,R),MR), - erase(MR), - fail. + recorded('$mf','$mf_clause'(_,Na,Ar,M,R),MR), + erase(MR), + fail. '$erase_lu_mf_clause'(_Na,_Ar,_M,R) :- - erase(R), - fail. + erase(R), + fail. '$retractall_lu_mf'(_,_,_,_). '$erase_all_clauses_for_dynamic'(T, M) :- @@ -310,25 +307,25 @@ retractall(V) :- erase(R), fail. '$erase_all_clauses_for_dynamic'(T,M) :- - '$recordedp'(M:T,_,_), fail. + '$recordedp'(M:T,_,_), fail. '$erase_all_clauses_for_dynamic'(_,_). /* support for abolish/1 */ '$abolishd'(T, M) :- - '$is_multifile'(T,M), - functor(T,Name,Arity), - recorded('$mf','$mf_clause'(_,Name,Arity,M,Ref),R), - erase(R), - erase(Ref), - fail. + '$is_multifile'(T,M), + functor(T,Name,Arity), + recorded('$mf','$mf_clause'(_,Name,Arity,M,Ref),R), + erase(R), + erase(Ref), + fail. '$abolishd'(T, M) :- - recorded('$import','$import'(_,M,_,T,_,_),R), - erase(R), - fail. + recorded('$import','$import'(_,M,_,T,_,_),R), + erase(R), + fail. '$abolishd'(T, M) :- - '$purge_clauses'(T,M), fail. + '$purge_clauses'(T,M), fail. '$abolishd'(T, M) :- - '$kill_dynamic'(T,M), fail. + '$kill_dynamic'(T,M), fail. '$abolishd'(_, _). @@ -342,19 +339,19 @@ as a dynamic predicate following either `logical` or */ dynamic_predicate(P,Sem) :- - '$bad_if_is_semantics'(Sem, dynamic(P,Sem)). + '$bad_if_is_semantics'(Sem, dynamic(P,Sem)). dynamic_predicate(P,Sem) :- - '$log_upd'(OldSem), - ( Sem = logical -> '$switch_log_upd'(1) ; '$switch_log_upd'(0) ), - '$current_module'(M), - '$dynamic'(P, M), - '$switch_log_upd'(OldSem). + '$log_upd'(OldSem), + ( Sem = logical -> '$switch_log_upd'(1) ; '$switch_log_upd'(0) ), + '$current_module'(M), + '$dynamic'(P, M), + '$switch_log_upd'(OldSem). '$bad_if_is_semantics'(Sem, Goal) :- - var(Sem), !, - '$do_error'(instantiation_error,Goal). + var(Sem), !, + '$do_error'(instantiation_error,Goal). '$bad_if_is_semantics'(Sem, Goal) :- - Sem \= immediate, Sem \= logical, !, - '$do_error'(domain_error(semantics_indicator,Sem),Goal). + Sem \= immediate, Sem \= logical, !, + '$do_error'(domain_error(semantics_indicator,Sem),Goal). %% @} diff --git a/pl/preds.yap b/pl/preds.yap index 8e5a3a7b3..2bb938faf 100644 --- a/pl/preds.yap +++ b/pl/preds.yap @@ -19,44 +19,44 @@ * @file preds.yap */ :- system_module( '$_preds', [abolish/1, - abolish/2, - assert/1, - assert/2, - assert_static/1, - asserta/1, - asserta/2, - asserta_static/1, - assertz/1, - assertz/2, - assertz_static/1, - clause/2, - clause/3, - clause_property/2, - compile_predicates/1, - current_key/2, - current_predicate/1, - current_predicate/2, - dynamic_predicate/2, - hide_predicate/1, - nth_clause/3, - predicate_erased_statistics/4, - predicate_property/2, - predicate_statistics/4, - retract/1, - retract/2, - retractall/1, - stash_predicate/1, - system_predicate/1, - system_predicate/2, - unknown/2], ['$assert_static'/5, - '$assertz_dynamic'/4, - '$clause'/4, - '$current_predicate'/4, - '$init_preds'/0, - '$noprofile'/2, - '$public'/2, - '$unknown_error'/1, - '$unknown_warning'/1]). + abolish/2, + assert/1, + assert/2, + assert_static/1, + asserta/1, + asserta/2, + asserta_static/1, + assertz/1, + assertz/2, + assertz_static/1, + clause/2, + clause/3, + clause_property/2, + compile_predicates/1, + current_key/2, + current_predicate/1, + current_predicate/2, + dynamic_predicate/2, + hide_predicate/1, + nth_clause/3, + predicate_erased_statistics/4, + predicate_property/2, + predicate_statistics/4, + retract/1, + retract/2, + retractall/1, + stash_predicate/1, + system_predicate/1, + system_predicate/2, + unknown/2], ['$assert_static'/5, + '$assertz_dynamic'/4, + '$clause'/4, + '$current_predicate'/4, + '$init_preds'/0, + '$noprofile'/2, + '$public'/2, + '$unknown_error'/1, + '$unknown_warning'/1]). /** * @defgroup Database The Clausal Data Base @@ -80,23 +80,23 @@ and therefore he should try to avoid them whenever possible. */ :- use_system_module( '$_boot', ['$check_head_and_body'/4, - '$check_if_reconsulted'/2, - '$head_and_body'/3, - '$inform_as_reconsulted'/2]). + '$check_if_reconsulted'/2, + '$head_and_body'/3, + '$inform_as_reconsulted'/2]). :- use_system_module( '$_errors', ['$do_error'/2]). :- use_system_module( '$_init', ['$do_log_upd_clause'/6, - '$do_log_upd_clause0'/6, - '$do_log_upd_clause_erase'/6, - '$do_static_clause'/5]). + '$do_log_upd_clause0'/6, + '$do_log_upd_clause_erase'/6, + '$do_static_clause'/5]). :- use_system_module( '$_modules', ['$imported_pred'/4, - '$meta_predicate'/4, - '$module_expansion'/5]). + '$meta_predicate'/4, + '$module_expansion'/5]). :- use_system_module( '$_preddecls', ['$check_multifile_pred'/3, - '$dynamic'/2]). + '$dynamic'/2]). :- use_system_module( '$_strict_iso', ['$check_iso_strict_clause'/1]). @@ -176,25 +176,25 @@ clause(P,Q,R) :- '$yap_strip_module'(P, M, T), '$yap_strip_module'(M0:H, M1, H1), ( - M == M1 + M == M1 -> - H1 = T + H1 = T ; - M1:H1 = T + M1:H1 = T ). clause(V0,Q,R) :- '$yap_strip_module'(V0, M, V), must_be_of_type( callable, V ), '$clause'(V,M,Q,R). +'$clause'(P,M,Q,R) :- + '$is_log_updatable'(P, M), !, + '$log_update_clause'(P,M,Q,R). '$clause'(P,M,Q,R) :- '$is_exo'(P, M), !, Q = true, R = '$exo_clause'(M,P), '$execute0'(P, M). -'$clause'(P,M,Q,R) :- - '$is_log_updatable'(P, M), !, - '$log_update_clause'(P,M,Q,R). '$clause'(P,M,Q,R) :- '$is_source'(P, M), !, '$static_clause'(P,M,Q,R). @@ -204,10 +204,10 @@ clause(V0,Q,R) :- '$clause'(P,M,Q,R) :- \+ '$undefined'(P,M), ( '$is_system_predicate'(P,M) -> true ; - '$number_of_clauses'(P,M,N), N > 0 ), + '$number_of_clauses'(P,M,N), N > 0 ), functor(P,Name,Arity), '$do_error'(permission_error(access,private_procedure,Name/Arity), - clause(M:P,Q,R)). + clause(M:P,Q,R)). '$init_preds' :- once('$do_static_clause'(_,_,_,_,_)), @@ -260,15 +260,15 @@ abolish(N0,A) :- '$abolish'(N,A,Mod). '$abolish'(N,A,M) :- var(N), !, - '$do_error'(instantiation_error,abolish(M:N,A)). + '$do_error'(instantiation_error,abolish(M:N,A)). '$abolish'(N,A,M) :- var(A), !, - '$do_error'(instantiation_error,abolish(M:N,A)). + '$do_error'(instantiation_error,abolish(M:N,A)). '$abolish'(N,A,M) :- ( recorded('$predicate_defs','$predicate_defs'(N,A,M,_),R) -> erase(R) ), fail. '$abolish'(N,A,M) :- functor(T,N,A), - ( '$is_dynamic'(T, M) -> '$abolishd'(T,M) ; - /* else */ '$abolishs'(T,M) ). + ( '$is_dynamic'(T, M) -> '$abolishd'(T,M) ; + /* else */ '$abolishs'(T,M) ). /** @pred abolish(+ _PredSpec_) is iso @@ -293,9 +293,9 @@ abolish(X0) :- '$old_abolish'(X,M). '$new_abolish'(V,M) :- var(V), !, - '$abolish_all_in_module'(M). + '$abolish_all_in_module'(M). '$new_abolish'(A/V,M) :- atom(A), var(V), !, - '$abolish_all_atoms'(A,M). + '$abolish_all_atoms'(A,M). '$new_abolish'(Na//Ar1, M) :- integer(Ar1), !, @@ -314,15 +314,15 @@ abolish(X0) :- '$do_error'(type_error(predicate_indicator,T),abolish(M:T)). '$abolish_all_in_module'(M) :- - '$current_predicate'(Na, M, S, _), - functor(S, Na, Ar), + '$current_predicate'(Na, M, S, _), + functor(S, Na, Ar), '$new_abolish'(Na/Ar, M), fail. '$abolish_all_in_module'(_). '$abolish_all_atoms'(Na, M) :- - '$current_predicate'(Na,M,S,_), - functor(S, Na, Ar), + '$current_predicate'(Na,M,S,_), + functor(S, Na, Ar), '$new_abolish'(Na/Ar, M), fail. '$abolish_all_atoms'(_,_). @@ -365,41 +365,41 @@ abolish(X0) :- '$do_error'(type_error(atom,M), Msg). '$old_abolish'(V,M) :- var(V), !, - ( true -> % current_prolog_flag(language, sicstus) -> - '$do_error'(instantiation_error,abolish(M:V)) - ; - '$abolish_all_old'(M) - ). + ( true -> % current_prolog_flag(language, sicstus) -> + '$do_error'(instantiation_error,abolish(M:V)) + ; + '$abolish_all_old'(M) + ). '$old_abolish'(N/A, M) :- !, '$abolish'(N, A, M). '$old_abolish'(A,M) :- atom(A), !, - ( current_prolog_flag(language, iso) -> - '$do_error'(type_error(predicate_indicator,A),abolish(M:A)) - ; - '$abolish_all_atoms_old'(A,M) - ). + ( current_prolog_flag(language, iso) -> + '$do_error'(type_error(predicate_indicator,A),abolish(M:A)) + ; + '$abolish_all_atoms_old'(A,M) + ). '$old_abolish'([], _) :- !. '$old_abolish'([H|T], M) :- !, '$old_abolish'(H, M), '$old_abolish'(T, M). '$old_abolish'(T, M) :- '$do_error'(type_error(predicate_indicator,T),abolish(M:T)). '$abolish_all_old'(M) :- - '$current_predicate'(Na, M, S, _), + '$current_predicate'(Na, M, S, _), functor( S, Na, Ar ), '$abolish'(Na, Ar, M), fail. '$abolish_all_old'(_). '$abolish_all_atoms_old'(Na, M) :- - '$current_predicate'(Na, M, S, _), + '$current_predicate'(Na, M, S, _), functor(S, Na, Ar), '$abolish'(Na, Ar, M), fail. '$abolish_all_atoms_old'(_,_). '$abolishs'(G, M) :- '$system_predicate'(G,M), !, - functor(G,Name,Arity), - '$do_error'(permission_error(modify,static_procedure,Name/Arity),abolish(M:G)). + functor(G,Name,Arity), + '$do_error'(permission_error(modify,static_procedure,Name/Arity),abolish(M:G)). '$abolishs'(G, Module) :- current_prolog_flag(language, sicstus), % only do this in sicstus mode '$undefined'(G, Module), @@ -410,7 +410,7 @@ abolish(X0) :- functor(G,Name,Arity), recorded('$mf','$mf_clause'(_,Name,Arity,M,_Ref),R), erase(R), -% no need erase(Ref), + % no need erase(Ref), fail. '$abolishs'(T, M) :- recorded('$import','$import'(_,M,_,_,T,_,_),R), @@ -430,7 +430,7 @@ stash_predicate(P0) :- '$stash_predicate2'(P, M). '$stash_predicate2'(V, M) :- var(V), !, - '$do_error'(instantiation_error,stash_predicate(M:V)). + '$do_error'(instantiation_error,stash_predicate(M:V)). '$stash_predicate2'(N/A, M) :- !, functor(S,N,A), '$stash_predicate'(S, M) . @@ -496,22 +496,22 @@ or built-in. */ predicate_property(Pred,Prop) :- ( - current_predicate(_,Pred), - '$yap_strip_module'(Pred, Mod, TruePred) + 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) + '$pred_exists'(TruePred, Mod) -> - M = Mod, - NPred = TruePred - ; + M = Mod, + NPred = TruePred + ; '$get_undefined_pred'(TruePred, Mod, NPred, M) ), - '$predicate_property'(NPred,M,Mod,Prop). + '$predicate_property'(NPred,M,Mod,Prop). '$predicate_property'(P,M,_,built_in) :- '$is_system_predicate'(P,M). @@ -540,7 +540,7 @@ predicate_property(Pred,Prop) :- once(recorded('$module','$module'(_TFN,M,_S,Publics,_L),_)), lists:memberchk(N/A,Publics). '$predicate_property'(_P,M,M0,imported_from(M)) :- - M \= M0. + M \= M0. '$predicate_property'(P,Mod,_,number_of_clauses(NCl)) :- '$number_of_clauses'(P,Mod,NCl). '$predicate_property'(P,Mod,_,file(F)) :- @@ -556,7 +556,7 @@ Given predicate _P_, _NCls_ is the number of clauses for indices to those clauses (in bytes). */ predicate_statistics(V,NCls,Sz,ISz) :- var(V), !, - '$do_error'(instantiation_error,predicate_statistics(V,NCls,Sz,ISz)). + '$do_error'(instantiation_error,predicate_statistics(V,NCls,Sz,ISz)). predicate_statistics(P0,NCls,Sz,ISz) :- strip_module(P0, M, P), '$predicate_statistics'(P,M,NCls,Sz,ISz). @@ -582,7 +582,7 @@ of space required to store indices to those clauses (in bytes). */ predicate_erased_statistics(P,NCls,Sz,ISz) :- - var(P), !, + var(P), !, current_predicate(_,P), predicate_erased_statistics(P,NCls,Sz,ISz). predicate_erased_statistics(P0,NCls,Sz,ISz) :- @@ -595,24 +595,24 @@ Defines the relation: _P_ is a currently defined predicate whose name is the at */ current_predicate(A,T0) :- '$yap_strip_module'(T0, M, T), - ( var(M) - -> - '$all_current_modules'(M) + ( var(M) + -> + '$all_current_modules'(M) ; - true + true ), -(nonvar(T) -> functor(T, A, _) ; true ), + (nonvar(T) -> functor(T, A, _) ; true ), ( - '$current_predicate'(A,M, T, user) + '$current_predicate'(A,M, T, user) ; - (nonvar(T) - -> - '$imported_predicate'(T, M, T1, M1) - ; - '$generate_imported_predicate'(T, M, T1, M1) - ), - functor(T1, A, _), - \+ '$is_system_predicate'(T1,M1) + (nonvar(T) + -> + '$imported_predicate'(M:T, M1:T1) + ; + '$imported_predicate'(M:T, M1:T1) + ), + functor(T1, A, _), + \+ '$is_system_predicate'(T1,M1) ). /** @pred system_predicate( ?_P_ ) @@ -623,39 +623,39 @@ system_predicate(P0) :- '$yap_strip_module'(P0, M0, P), ( M= M0 ; M0 \= user, M = user ; M0 \= prolog, M = prolog ), ( - var(P) + var(P) -> - P = A/Arity, - '$current_predicate'(A, M, T, system), - functor(T, A, Arity), - '$is_system_predicate'( T, M) + P = A/Arity, + '$current_predicate'(A, M, T, system), + functor(T, A, Arity), + '$is_system_predicate'( T, M) ; - ground(P), P = A/Arity + ground(P), P = A/Arity -> - functor(T, A, Arity), - '$current_predicate'(A, M, T, system), - '$is_system_predicate'( T, M) + functor(T, A, Arity), + '$current_predicate'(A, M, T, system), + '$is_system_predicate'( T, M) ; - ground(P), P = A//Arity2 + ground(P), P = A//Arity2 -> - Arity is Arity2+2, - functor(T, A, Arity), - '$current_predicate'(A, M, T, system), - '$is_system_predicate'( T, M) + Arity is Arity2+2, + functor(T, A, Arity), + '$current_predicate'(A, M, T, system), + '$is_system_predicate'( T, M) ; - P = A/Arity + P = A/Arity -> - '$current_predicate'(A, M, T, system), - '$is_system_predicate'( T, M), - functor(T, A, Arity) + '$current_predicate'(A, M, T, system), + '$is_system_predicate'( T, M), + functor(T, A, Arity) ; - P = A//Arity2 + P = A//Arity2 -> - '$current_predicate'(A, M, T, system), - '$is_system_predicate'( T, M), - functor(T, A, Arity), - Arity >= 2, - Arity2 is Arity-2 + '$current_predicate'(A, M, T, system), + '$is_system_predicate'( T, M), + functor(T, A, Arity), + Arity >= 2, + Arity2 is Arity-2 ; '$do_error'(type_error(predicate_indicator,P), system_predicate(P0)) @@ -673,12 +673,12 @@ system_predicate(P0) :- system_predicate(A, P0) :- '$yap_strip_module'(P0, M, P), ( - nonvar(P) + nonvar(P) -> - '$current_predicate'(A, M, P, system), - '$is_system_predicate'( P, M) + '$current_predicate'(A, M, P, system), + '$is_system_predicate'( P, M) ; - '$current_predicate'(A, M, P, system) + '$current_predicate'(A, M, P, system) ). @@ -698,27 +698,27 @@ current_predicate(F0) :- '$c_i_predicate'( A/N, M ) :- !, ( - ground(A/N) + ground(A/N) -> - atom(A), integer(N), - functor(S, A, N), - current_predicate(A, M:S) + atom(A), integer(N), + functor(S, A, N), + current_predicate(A, M:S) ; - current_predicate(A, M:S), - functor(S, A, N) - ). + current_predicate(A, M:S), + functor(S, A, N) + ). '$c_i_predicate'( A//N, M ) :- ( - ground(A) + ground(A) -> - atom(A), integer(N), - N2 is N+2, - functor(S, A, N2), - current_predicate(A, M:S) + atom(A), integer(N), + N2 is N+2, + functor(S, A, N2), + current_predicate(A, M:S) ; - current_predicate(A, M:S), - functor(S, A, N2), - N is N2-2 + current_predicate(A, M:S), + functor(S, A, N2), + N is N2-2 ). /** @pred current_key(? _A_,? _K_) @@ -736,10 +736,10 @@ current_key(A,K) :- '$ifunctor'(Pred,Na,Ar) :- (Ar > 0 -> - functor(Pred, Na, Ar) + functor(Pred, Na, Ar) ; - Pred = Na - ). + Pred = Na + ). /** @pred compile_predicates(: _ListOfNameArity_) @@ -814,7 +814,7 @@ clause_property(ClauseRef, predicate(PredicateIndicator)) :- % '$set_flag'(P, M, trace, off) :- '$predicate_flags'(P,M,F,F), - FN is F \/ 0x400000000, + FN is F \/ 0x400000000, '$predicate_flags'(P,M,F,FN). /** diff --git a/pl/top.yap b/pl/top.yap index b48018a63..9845b32fb 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -14,7 +14,7 @@ * \*/ :- '$system_meta_predicates'([ - gated_call(0,0,?,0), + gated_call(0,0,?,0), catch(0,?,0), log_event(+,:)]). diff --git a/pl/udi.yap b/pl/udi.yap index 2b057fb8c..80858a6fc 100644 --- a/pl/udi.yap +++ b/pl/udi.yap @@ -37,3 +37,4 @@ udi(Pred) :- '$udi_init'(Pred). + diff --git a/pl/undefined.yap b/pl/undefined.yap index 3c11f1a1d..4b01e029d 100644 --- a/pl/undefined.yap +++ b/pl/undefined.yap @@ -67,8 +67,8 @@ followed by the failure of that call. :- multifile user:unknown_predicate_handler/3. undefined_query(G0, M0, Cut) :- - recorded('$import','$import'(M,M0,G,G0,_,_),_), - '$call'(G, Cut, G, M). + recorded('$import','$import'(M,M0,G,G0,_,_),_), + '$call'(G, Cut, G, M). '$handle_error'(error,Goal,Mod) :- functor(Goal,Name,Arity), @@ -104,50 +104,41 @@ undefined_query(G0, M0, Cut) :- '$yap_strip_module'(M0:G0, EM0, GM0), user:unknown_predicate_handler(GM0,EM0,MG), !. -'$undefp_search'(M0:G0, M:G) :- -'$get_undefined_predicates'(G, M0, G0, M), !. - - -:- abolish('$undefp'/2). - +'$undefp_search'(M0:G0, MG) :- +'$get_undefined_predicates'(M0:G0, MG), !. % undef handler -'$undefp'([M0|G0],_) :- +'$undefp'([M0|G0],MG) :- % make sure we do not loop on undefined predicates - setup_call_catcher_cleanup( '$undef_set'(Action,Debug,Current), - '$search_def'(M0,G0,MG), - Port, - '$undef_reset'(Port,M0:G0,MG,Action,Debug,Current) - ). + '$search_def'(M0:G0,MG,Action,Debug,Current). '$undef_set'(Action,Debug,Current) :- yap_flag( unknown, Action, fail), yap_flag( debug, Debug, false), '$stop_creeping'(Current). -'$search_def'(M0,G0,NG:NM) :- - '$undefp_search'(M0:G0, NM:NG), - !, - '$pred_exists'(NG,NM). -'$undef_reset'(exit,_G0,NG:NM,Action,Debug,Current) :- +'$search_def'(M0:G0,NM:NG,Action,Debug,Current) :- + '$undefp_search'(M0:G0, NM:NG), + '$pred_exists'(NG,NM), + !, yap_flag( unknown, _, Action), yap_flag( debug, _, Debug), nonvar(NG), nonvar(NM), - ( - Current == true - -> - % carry on signal processing - '$start_creep'([NM|NG], creep) - ; - '$execute0'(NG, NM) - ). -'$undef_reset'(_,M0:G0,_NG,Action,Debug,_Current) :- + ( + Current == true + -> + % carry on signal processing + '$start_creep'([NM|NG], creep) + ; + '$execute0'(NG, NM) + ). +'$search_def'(M0:G0,_,Action,Debug,_Current) :- yap_flag( unknown, _, Action), yap_flag( debug, _, Debug), -'$start_creep'([prolog|true], creep), +'$start_creep'([prolog|true], creep), '$handle_error'(Action,G0,M0). :- '$undefp_handler'('$undefp'(_,_), prolog). @@ -155,11 +146,11 @@ undefined_query(G0, M0, Cut) :- /** @pred unknown(- _O_,+ _N_) The unknown predicate, informs about what the user wants to be done - when there are no clauses for a predicate. Using unknown/3 is - strongly deprecated. We recommend setting the `unknown` prolog - flag for generic behaviour, and calling the hook - user:unknown_predicate_handler/3 to fine-tune specific cases - undefined goals. + when there are no clauses for a predicate. Using unknown/3 is + strongly deprecated. We recommend setting the `unknown` prolog + flag for generic behaviour, and calling the hook + user:unknown_predicate_handler/3 to fine-tune specific cases + undefined goals. */ diff --git a/swi/library/CMakeLists.txt b/swi/library/CMakeLists.txt index a597c0649..8b8889098 100644 --- a/swi/library/CMakeLists.txt +++ b/swi/library/CMakeLists.txt @@ -37,12 +37,8 @@ set (LIBRARY_PL ) - if (ANDROID) - file(INSTALL ${LIBRARY_PL} DESTINATION ${YAP_INSTALL_DATADIR}) - endif() - install(FILES ${LIBRARY_PL} DESTINATION ${YAP_INSTALL_DATADIR} ) - add_to_group( LIBRARY_PL pl_library ) + add_to_dir (LIBRARY_PL YAP_INSTALL_DATADIR ) diff --git a/swi/library/plunit.pl b/swi/library/plunit.pl index e6b4586dd..5b4e6ffb8 100644 --- a/swi/library/plunit.pl +++ b/swi/library/plunit.pl @@ -1,5 +1,7 @@ /* Part of SWI-Prolog + @file plunit.pl + Author: Jan Wielemaker E-mail: J.Wielemaker@cs.vu.nl WWW: http://www.swi-prolog.org @@ -43,7 +45,8 @@ test_report/1 % +What ]). -/** Unit Testing +/** @defgroup PlUnit Unit Testing +@ingroup library Unit testing environment for SWI-Prolog and SICStus Prolog. For usage, please visit http://www.swi-prolog.org/pldoc/package/plunit.html.