From 92994fb0e41c691c54db3d23e267e48fb97ad7e4 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 21 Dec 2018 22:44:18 +0000 Subject: [PATCH 1/8] debugging --- pl/undefined.yap | 1 - 1 file changed, 1 deletion(-) diff --git a/pl/undefined.yap b/pl/undefined.yap index fd2d14731..3c11f1a1d 100644 --- a/pl/undefined.yap +++ b/pl/undefined.yap @@ -113,7 +113,6 @@ undefined_query(G0, M0, Cut) :- % undef handler '$undefp'([M0|G0],_) :- -start_low_level_trace, % make sure we do not loop on undefined predicates setup_call_catcher_cleanup( '$undef_set'(Action,Debug,Current), From 9e1a2ad41e78349d3c55800599ac2e2b5b84ab01 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 7 Jan 2019 14:59:08 +0000 Subject: [PATCH 2/8] fix term predicates --- C/utilpreds.c | 1717 +++++++++++++++++-------------------------------- 1 file changed, 581 insertions(+), 1136 deletions(-) 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); From c2ebd2857cb416e0c9dfa6829117909f6c6e051b Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 7 Jan 2019 14:59:20 +0000 Subject: [PATCH 3/8] Android related patches simpify meta-processing. --- packages/swig/java/{JavaYAP.java => JavaYAP.java.old} | 0 {library => pl}/android.yap | 0 2 files changed, 0 insertions(+), 0 deletions(-) rename packages/swig/java/{JavaYAP.java => JavaYAP.java.old} (100%) rename {library => pl}/android.yap (100%) 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/library/android.yap b/pl/android.yap similarity index 100% rename from library/android.yap rename to pl/android.yap From 64513287822f84273183269a6e255553bc7df462 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 9 Jan 2019 09:32:09 +0000 Subject: [PATCH 4/8] myddas --- C/alloc.c | 25 +- C/c_interface.c | 14 +- C/cdmgr.c | 2 +- C/exec.c | 5 +- C/globals.c | 30 +- C/init.c | 10 +- C/load_foreign.c | 24 +- C/modules.c | 1 + C/qlyr.c | 2 +- C/stack.c | 1190 ++++++++++--------- C/stdpreds.c | 3 - C/yap-args.c | 240 ++-- CMakeLists.txt | 211 ++-- CXX/CMakeLists.txt | 2 +- CXX/yapi.cpp | 8 +- CXX/yapq.hh | 19 +- H/CMakeLists.txt | 6 +- H/Yap.h | 2 +- H/YapGFlagInfo.h | 28 - H/YapLFlagInfo.h | 81 +- H/Yapproto.h | 14 +- cmake/FindGMP.cmake | 11 +- cmake/Sources.cmake | 11 - config.h.cmake | 6 +- include/YapDefs.h | 2 +- include/YapInit.h | 10 +- library/CMakeLists.txt | 22 +- library/apply.yap | 1 - library/dialect/swi/fli/swi.c | 2 +- library/lammpi/CMakeLists.txt | 2 +- library/maplist.yap | 1454 +++++++++++------------ library/maputils.yap | 17 +- library/matrix/CMakeLists.txt | 2 +- library/random/CMakeLists.txt | 5 +- library/regex/CMakeLists.txt | 2 +- library/rltree/CMakeLists.txt | 2 +- library/system/CMakeLists.txt | 2 +- library/system/sys.c | 4 +- library/tries/CMakeLists.txt | 4 +- os/CMakeLists.txt | 10 +- os/assets.c | 2 +- os/sysbits.c | 19 +- packages/CLPBN/horus/CMakeLists.txt | 4 +- packages/CMakeLists.txt | 2 +- packages/cplint/CMakeLists.txt | 4 +- packages/cuda/CMakeLists.txt | 2 +- packages/gecode/CMakeLists.txt | 2 +- packages/myddas/CMakeLists.txt | 12 +- packages/myddas/myddas.h | 2 + packages/myddas/myddas_shared.c | 17 +- packages/myddas/mysql/CMakeLists.txt | 2 +- packages/myddas/odbc/CMakeLists.txt | 14 +- packages/myddas/odbc/myddas_odbc.c | 2 +- packages/myddas/pl/CMakeLists.txt | 8 +- packages/myddas/pl/myddas.ypp | 9 +- packages/myddas/pl/myddas_driver.ypp | 2 - packages/myddas/postgres/CMakeLists.txt | 7 +- packages/myddas/sqlite3/CMakeLists.txt | 23 +- packages/python/CMakeLists.txt | 4 +- packages/python/swig/CMakeLists.txt | 4 +- packages/python/swig/yapi.pybk | 2 +- packages/raptor/CMakeLists.txt | 4 +- packages/real/CMakeLists.txt | 2 +- packages/swi-minisat2/C/CMakeLists.txt | 2 +- packages/swig/CMakeLists.txt | 2 - packages/swig/android/CMakeLists.txt | 84 +- packages/swig/android/streamer.cpp | 34 +- packages/swig/yap.i | 11 +- packages/udi/b+tree/CMakeLists.txt | 2 +- packages/udi/rtree/CMakeLists.txt | 2 +- packages/udi/uthash/CMakeLists.txt | 2 +- pl/CMakeLists.txt | 13 +- pl/absf.yap | 2 +- pl/android.yap | 27 +- pl/arith.yap | 38 +- pl/boot.yap | 192 +-- pl/control.yap | 22 +- pl/imports.yap | 210 ++-- pl/listing.yap | 271 +++-- pl/load_foreign.yap | 3 + pl/messages.yap | 2 - pl/meta.yap | 470 ++++---- pl/modules.yap | 25 +- pl/newmod.yap | 2 +- pl/pathconf.yap | 117 +- pl/preddyns.yap | 211 ++-- pl/preds.yap | 304 ++--- pl/top.yap | 2 +- pl/udi.yap | 1 + pl/undefined.yap | 59 +- swi/library/CMakeLists.txt | 6 +- swi/library/plunit.pl | 5 +- 92 files changed, 2833 insertions(+), 2923 deletions(-) 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/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 9b31c68d8..e84f60e1b 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -121,7 +121,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 +131,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 +181,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 +202,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 +226,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 +306,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 +323,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 +338,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 +364,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) @@ -528,41 +547,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) @@ -573,7 +560,6 @@ IF (WITH_R) add_subDIRECTORY(packages/real) ENDIF (WITH_R) - List(APPEND YLIBS $) List(APPEND YLIBS $) List(APPEND YLIBS $) @@ -586,22 +572,56 @@ 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. + 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) + + else() + add_definitions(-DMYDDAS=1 -DEMBEDDED_MYDDAS=1 -DMYDDAS_SQLITE3=1 ) + +endif() + if (WITH_MYSQL) + add_definitions( -DMYDDAS_MYSQL=1) + endif () + + if (WITH_ODBC) + add_definitions( -DMYDDAS_ODBC=1) + endif () + + if (WITH_POSTGRES) + 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(OPTYap) +ADD_SUBDIRECTORY(os) +ADD_SUBDIRECTORY(library/dialect/swi/fli) +ADD_SUBDIRECTORY(CXX) + +add_subDIRECTORY(utf8proc ) +add_subDIRECTORY( packages/myddas ) + + +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 +636,30 @@ if (READLINE_FOUND) endif () +if (ANDROID) + target_link_libraries(libYap 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 +678,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 +699,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 +720,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 +886,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 +894,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 +976,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/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..5fd1150d3 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,23 @@ 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) + -DMYDDAS=1) -include_directories(. sqlite3) add_subdirectory(sqlite3) -if (NOT ANDROID) add_subdirectory(mysql) add_subdirectory(odbc) add_subdirectory(postgres) -endif() 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_shared.c b/packages/myddas/myddas_shared.c index e150165e3..94bbb46fa 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,7 @@ void init_myddas(void) { { return; } -#if USE_MYDDAS - Term cm=CurrentModule; - CurrentModule = USER_MODULE; +#if MYDDAS #define stringify(X) _stringify(X) #define _stringify(X) #X Yap_REGS.MYDDAS_GLOBAL_POINTER = NULL; @@ -699,26 +697,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..f2bc4cd7d 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} 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..4fd39e152 100644 --- a/packages/myddas/pl/myddas.ypp +++ b/packages/myddas/pl/myddas.ypp @@ -15,10 +15,7 @@ * * *************************************************************************/ -%%:- load_foreign_files([myddas], [], init_myddas). - -/* Initialize MYDDAS GLOBAL STRUCTURES */ -:- c_db_initialize_myddas. +:- load_foreign_files([myddas], [], init_myddas). #ifdef DEBUG :- yap_flag(single_var_warnings,on). @@ -114,6 +111,10 @@ % myddas_mysql.ypp ]). + +/* 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..2c0b1c3f8 100644 --- a/packages/myddas/sqlite3/CMakeLists.txt +++ b/packages/myddas/sqlite3/CMakeLists.txt @@ -1,6 +1,6 @@ -if (WITH_SQLITE3) +if (MYDDAS_SQLITE3) - message( " * Sqlite3 Data-Base (http://www.sqlite3.org), distributed with MYDDAS" ) + # message( " * Sqlite3 Data-Base (http://www.sqlite3.org), distributed with MYDDAS" ) set (SQLITE_TEST sqlitest.yap) @@ -13,12 +13,18 @@ if (WITH_SQLITE3) src/sqlite3ext.h ) + 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 ${ODBC_INCLUDE_DIRECTORIES} ${CMAKE_CURRENT_BINARY_DIR}/.. ${CMAKE_CURRENT_BINARY_DIR} ) + if (ANDROID) add_definitions(-DSQLITE_FCNTL_MMAP_SIZE=0 ) @@ -37,14 +43,13 @@ if (WITH_SQLITE3) SET_PROPERTY(DIRECTORY PROPERTY COMPILE_DEFINITIONS YAP_KERNEL=1 ) - if (ANDROID ) + list(APPEND YAPSQLITE3_SOURCES src/sqlite3.c) + + if (XXANDROID ) add_library( YAPsqlite3 OBJECT ${YAPSQLITE3_SOURCES} ) - else() - list(APPEND YAPSQLITE3_SOURCES src/sqlite3.c) - add_library( YAPsqlite3 SHARED ${YAPSQLITE3_SOURCES}) @@ -67,11 +72,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/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/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..032db1ff8 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} @@ -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 index 13e33bde3..488204c7c 100644 --- a/pl/android.yap +++ b/pl/android.yap @@ -1,19 +1,22 @@ + %:- start_low_level_trace. -:- module(user). -:- yap_flag(verbose,normal). +%:- module(android, +% [text_to_query/2]). + +:- initialization(yap_flag(verbose,_,normal)). -query( String ) :- - yap_flag(typein_module, Mod), +:- meta_predicate( text_to_query( :, - ) ). + +text_to_query( MString, Status ) :- + strip_module( MString, Mod, String ), 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 - ), + ( + 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]. \ No newline at end of file +%:- [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 c00c55652..3db888f9b 100644 --- a/pl/control.yap +++ b/pl/control.yap @@ -389,21 +389,13 @@ version(T) :- fail. '$set_toplevel_hook'(_). -query_to_answer(G, V, Status, Vs) :- - gated_call( true, (G,'$delayed_goals'(G, V, Vs, LGs, _DCP)), Status, '$answer'( Status, LGs, Vs ) ). - -'$answer'( exit, LGs, Vs) :- - !. %, -%'$process_answer'(Vs, LGs). -'$answer'( answer, LGs, Vs) :- - !. %, -% '$process_answer'(Vs, LGs, Bindings). -'$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. From 29c004d62a936e32e71af1462b17125de58a77ac Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 9 Jan 2019 13:59:58 +0000 Subject: [PATCH 5/8] android --- CMakeLists.txt | 85 +++++++++++++----------- packages/myddas/CMakeLists.txt | 8 +-- packages/myddas/myddas_initialization.c | 1 - packages/myddas/myddas_shared.c | 2 + packages/myddas/mysql/CMakeLists.txt | 2 +- packages/myddas/pl/myddas.ypp | 4 +- packages/myddas/sqlite3/CMakeLists.txt | 26 ++++---- packages/myddas/sqlite3/myddas_sqlite3.c | 1 - pl/CMakeLists.txt | 2 +- 9 files changed, 66 insertions(+), 65 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index e84f60e1b..70da63661 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) @@ -539,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}) @@ -560,6 +562,47 @@ IF (WITH_R) add_subDIRECTORY(packages/real) 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 $) @@ -572,47 +615,11 @@ if (WIN32 OR ANDROID) endif () if (ANDROID) List(APPEND YLIBS $) - List(APPEND YLIBS $) + List(APPEND YLIBS $) endif () endif () -include(Sources) - - - 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) - - else() - add_definitions(-DMYDDAS=1 -DEMBEDDED_MYDDAS=1 -DMYDDAS_SQLITE3=1 ) - -endif() - if (WITH_MYSQL) - add_definitions( -DMYDDAS_MYSQL=1) - endif () - - if (WITH_ODBC) - add_definitions( -DMYDDAS_ODBC=1) - endif () - - if (WITH_POSTGRES) - 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(OPTYap) -ADD_SUBDIRECTORY(os) -ADD_SUBDIRECTORY(library/dialect/swi/fli) -ADD_SUBDIRECTORY(CXX) - -add_subDIRECTORY(utf8proc ) -add_subDIRECTORY( packages/myddas ) - add_library( # Sets the name of the library. libYap @@ -637,7 +644,7 @@ if (READLINE_FOUND) endif () if (ANDROID) - target_link_libraries(libYap android log) + target_link_libraries(libYap sqliteX android log) endif() if (WIN32) diff --git a/packages/myddas/CMakeLists.txt b/packages/myddas/CMakeLists.txt index 5fd1150d3..e16746177 100644 --- a/packages/myddas/CMakeLists.txt +++ b/packages/myddas/CMakeLists.txt @@ -29,18 +29,14 @@ set(MYDDAS_UTIL_SOURCES myddas_util.c myddas_initialization.c) - -set_property(GLOBAL - APPEND PROPERTY - COMPILE_DEFINITIONS - -DMYDDAS=1) - add_subdirectory(sqlite3) add_subdirectory(mysql) add_subdirectory(odbc) add_subdirectory(postgres) + set(CXX_SWIG_OUTDIR ${CMAKE_BINARY_DIR}/packages/swig/android) + add_component(myddas ${MYDDAS_SOURCES} ${MYDDAS_UTIL_SOURCES} 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 94bbb46fa..9061cc05c 100644 --- a/packages/myddas/myddas_shared.c +++ b/packages/myddas/myddas_shared.c @@ -690,6 +690,8 @@ void init_myddas(void) { return; } #if MYDDAS +Yap_InitMYDDAS_SharedPreds(); + Yap_InitBackMYDDAS_SharedPreds(); #define stringify(X) _stringify(X) #define _stringify(X) #X Yap_REGS.MYDDAS_GLOBAL_POINTER = NULL; diff --git a/packages/myddas/mysql/CMakeLists.txt b/packages/myddas/mysql/CMakeLists.txt index f2bc4cd7d..34bb4587b 100644 --- a/packages/myddas/mysql/CMakeLists.txt +++ b/packages/myddas/mysql/CMakeLists.txt @@ -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/pl/myddas.ypp b/packages/myddas/pl/myddas.ypp index 4fd39e152..40b1ca32e 100644 --- a/packages/myddas/pl/myddas.ypp +++ b/packages/myddas/pl/myddas.ypp @@ -15,8 +15,6 @@ * * *************************************************************************/ -:- load_foreign_files([myddas], [], init_myddas). - #ifdef DEBUG :- yap_flag(single_var_warnings,on). :- yap_flag(write_strings,on). @@ -112,6 +110,8 @@ ]). +:- load_foreign_files([myddas], [], init_myddas). + /* Initialize MYDDAS GLOBAL STRUCTURES */ :- c_db_initialize_myddas. diff --git a/packages/myddas/sqlite3/CMakeLists.txt b/packages/myddas/sqlite3/CMakeLists.txt index 2c0b1c3f8..f06bd65ed 100644 --- a/packages/myddas/sqlite3/CMakeLists.txt +++ b/packages/myddas/sqlite3/CMakeLists.txt @@ -1,7 +1,6 @@ -if (MYDDAS_SQLITE3) - # message( " * Sqlite3 Data-Base (http://www.sqlite3.org), distributed with MYDDAS" ) + if (WITH_SQLITE3) set (SQLITE_TEST sqlitest.yap) @@ -9,10 +8,10 @@ if (MYDDAS_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}) @@ -23,13 +22,9 @@ if (MYDDAS_SQLITE3) set_property(DIRECTORY APPEND PROPERTY - INCLUDE_DIRECTORIES ${ODBC_INCLUDE_DIRECTORIES} ${CMAKE_CURRENT_BINARY_DIR}/.. ${CMAKE_CURRENT_BINARY_DIR} ) - + 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 ) @@ -42,15 +37,18 @@ set_property(DIRECTORY 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 ) - list(APPEND YAPSQLITE3_SOURCES src/sqlite3.c) - - if (XXANDROID ) - add_library( YAPsqlite3 OBJECT + add_library( YAPsqlite3 OBJECT ${YAPSQLITE3_SOURCES} ) else() - + + list(APPEND YAPSQLITE3_SOURCES src/sqlite3.c) + add_library( YAPsqlite3 SHARED ${YAPSQLITE3_SOURCES}) 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/pl/CMakeLists.txt b/pl/CMakeLists.txt index 032db1ff8..608abad2d 100644 --- a/pl/CMakeLists.txt +++ b/pl/CMakeLists.txt @@ -79,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 ) From 670bfd421d80e152160f5e9732ead7a81c39a01f Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 18 Jan 2019 03:49:42 +0000 Subject: [PATCH 6/8] meta --- CMakeLists.txt | 83 +++++++++++++++++------------------- library/regex/CMakeLists.txt | 2 +- pl/CMakeLists.txt | 14 +++--- 3 files changed, 46 insertions(+), 53 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 70da63661..dd11fab71 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -65,6 +65,9 @@ if (POLICY CMP0003) endif () if (POLICY CMP0068) cmake_policy(SET CMP0068 NEW) + endif() +if (POLICY CMP0075) +cmake_policy(SET CMP0075 NEW) endif () ## options: compilation flags @@ -169,7 +172,7 @@ option(WITH_LBFGS "interface with lbfgs" ${WITH_PACKAGES}) option(WITH_PRISM "use PRISM system in YAP" ${WITH_PACKAGES}) option(WITH_PYTHON "Allow Python->YAP and YAP->Python" ${WITH_PACKAGES}) option(WITH_R "Use R Interface" ${WITH_PACKAGES}) -option(WITH_JAVA "Try to use Java (currently Java 6,7,8)" ${WITH_PACKAGES}) +option(WITH_JAVA "Try to use Java (currently Java )" ${WITH_PACKAGES}) set(CMAKE_POSITION_INDEPENDENT_CODE TRUE) set(CMAKE_WINDOWS_EXPORT_ALL_SYMBOLS TRUE) @@ -312,16 +315,17 @@ disallow_intree_builds() set(CMAKE_PREFIX_PATH $ENV{PREFIX}) set( R_COMMAND "$ENV{R}") set_property(DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS CONDA_BUILD=1) - list (APPEND CMAKE_REQUIRED_INCLUDES - ${PREFIX}/include - ${SYS_PREFIX}/include - ) set(YAP_IS_MOVABLE 1) endif() ADD_CUSTOM_TARGET(run_install COMMAND ${CMAKE_MAKE_PROGRAM} install) + list (APPEND CMAKE_REQUIRED_INCLUDES + ${PREFIX}/include + ${SYS_PREFIX}/include + ) + set(prefix ${CMAKE_INSTALL_PREFIX}) #BINDIR}) @@ -365,13 +369,6 @@ 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) include_directories(${GMP_INCLUDE_DIRS}) @@ -388,13 +385,20 @@ if (WITH_READLINE) # ADD_SUBDIRECTORY(console/terminal) if (READLINE_FOUND) - include_directories(${READLINE_INCLUDE_DIR}) # required for configure - list(APPEND CMAKE_REQUIRED_LIBRARIES ${READLINE_LIBRARIES}) - list(APPEND CMAKE_REQUIRED_INCLUDES ${READLINE_INCLUDE_DIR}) + list(APPEND CMAKE_REQUIRED_INCLUDES ${READLINE_INCLUDE_DIR} + ${READLINE_INCLUDE_DIR}/readline + ) endif () endif() +include_directories(H + H/generated + include os OPTYap utf8proc JIT/HPP) +include_directories(BEFORE ${CMAKE_BINARY_DIR}) + +add_subdirectory( H ) + #MPI STUFF # library/mpi/mpi.c library/mpi/mpe.c # library/lammpi/yap_mpi.c library/lammpi/hash.c library/lammpi/prologterms2c.c @@ -493,7 +497,7 @@ endif () ## (but later on when installing) #SET(CMAKE_BUILD_WITH_INSTALL_RPATH FALSE) # -## SET(CMAKE_INSTALL_FULL_RPATH ${CMAKE_TOP_BINARY_DIR}) +## SET(CMAKE_INSTALL_FULL_RPATH ${CMAKE_BINARY_DIR}) # ## add the automatically determined parts of the RPATH ## which point to directories outside the build tree to the install RPATH @@ -518,6 +522,9 @@ ELSE() LIST(APPEND CMAKE_INSTALL_RPATH @loader_path/../../../lib) ENDIF() +set(YAP_STARTUP startup.yss) +set(YAP_SOURCEBOOT boot.yap ) + # Model Specific if (HAVE_GCC) set_property(DIRECTORY APPEND PROPERTY COMPILE_OPTIONS -Wall) @@ -571,6 +578,10 @@ ADD_SUBDIRECTORY(os) ADD_SUBDIRECTORY(library/dialect/swi/fli) ADD_SUBDIRECTORY(CXX) +ADD_SUBDIRECTORY(pl) + +ADD_SUBDIRECTORY(library) + add_subDIRECTORY(utf8proc ) if(ANDROID) @@ -612,10 +623,12 @@ if (WIN32 OR ANDROID) List(APPEND YLIBS $) if (WIN32 AND WITH_PYTHON) List(APPEND YLIBS $) + list (APPEND WINDLLS ${PYTHON_LIBRARIES}) endif () if (ANDROID) List(APPEND YLIBS $) List(APPEND YLIBS $) + set(ANDROID_LIBRARIES sqliteX android log) endif () endif () @@ -633,40 +646,20 @@ add_library( # Sets the name of the library. ${YLIBS} ) -if (GMP_FOUND) - target_link_libraries(libYap ${GMP_LIBRARIES}) -endif (GMP_FOUND) - -if (READLINE_FOUND) - target_link_libraries(libYap ${READLINE_LIBRARIES}) - # required for configure - -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) + target_link_libraries(libYap + m + ${GMP_LIBRARIES} + ${READLINE_LIBRARIES} + ${ANDROID_LIBRARIES} + ${WINDLLS} + ${PYTHON_LIBRARIES} + ) set_target_properties(libYap PROPERTIES OUTPUT_NAME Yap ) -set(YAP_STARTUP startup.yss) -set(YAP_SOURCEBOOT boot.yap ) ## define system # Optional libraries that affect compilation @@ -686,7 +679,7 @@ set_property(DIRECTORY PROPERTY CXX_STANDARD 11) if (ANDROID) - include_directories(CXX ${CMAKE_SOURCE_DIR}/yaplib/../generated/src/jni) + include_directories(CXX ${CMAKE_SOURCE_DIR}/../yaplib/generated/src/jni) endif () include(Threads) # diff --git a/library/regex/CMakeLists.txt b/library/regex/CMakeLists.txt index 47061a25a..0331c2ffd 100644 --- a/library/regex/CMakeLists.txt +++ b/library/regex/CMakeLists.txt @@ -23,7 +23,7 @@ target_link_libraries(regexp libYap) set_target_properties (regexp PROPERTIES PREFIX "") TARGET_INCLUDE_DIRECTORIES (regexp PUBLIC BEFORE - ${CMAKE_TOP_SOURCE_DIR}/include;${CMAKE_CURRENT_BINARY_DIR};${CMAKE_CURRENT_SOURCE_DIR} ) + ${CMAKE_SOURCE_DIR}/include;${CMAKE_CURRENT_BINARY_DIR};${CMAKE_CURRENT_SOURCE_DIR} ) install(TARGETS regexp LIBRARY DESTINATION ${YAP_INSTALL_LIBDIR} diff --git a/pl/CMakeLists.txt b/pl/CMakeLists.txt index 608abad2d..9697c2d7e 100644 --- a/pl/CMakeLists.txt +++ b/pl/CMakeLists.txt @@ -1,4 +1,4 @@ -set(PL_BOOT_SOURCES +set(11PL_BOOT_SOURCES absf.yap android.yap arith.yap @@ -76,21 +76,21 @@ elseif(CMAKE_CROSSCOMPILING) ) else () add_custom_target(STARTUP ALL - DEPENDS ${CMAKE_TOP_BINARY_DIR}/${YAP_STARTUP} + DEPENDS ${CMAKE_BINARY_DIR}/${YAP_STARTUP} ) - add_custom_command(OUTPUT ${CMAKE_TOP_BINARY_DIR}/${YAP_STARTUP} - COMMAND yap-bin -b + add_custom_command(OUTPUT ${CMAKE_BINARY_DIR}/${YAP_STARTUP} + COMMAND yap-bin -B ${CMAKE_SOURCE_DIR}/pl/boot.yap VERBATIM DEPENDS ${PL_BOOT_SOURCES} yap-bin ) # install(CODE "execute_process(COMMAND ./yap -B -# WORKING_DIRECTORY ${CMAKE_TOP_BINARY_DIR})" +# WORKING_DIRECTORY ${CMAKE_BINARY_DIR})" # DEPENDS Py4YAP ${PL_BOOT_SOURCES} yap-bin ) - install(FILES ${CMAKE_TOP_BINARY_DIR}/${YAP_STARTUP} - DESTINATION ${YAP_INSTALL_DATADIR}/pl) + install(FILES ${CMAKE_BINARY_DIR}/${YAP_STARTUP} + DESTINATION ${YAP_INSTALL_LIBDIR}) endif() From 8e2864c0cf30d4a5c4d15bdb7ddf00c5575316bd Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 18 Jan 2019 20:36:50 +0000 Subject: [PATCH 7/8] offshore --- pl/boot2.yap | 209 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 209 insertions(+) create mode 100644 pl/boot2.yap diff --git a/pl/boot2.yap b/pl/boot2.yap new file mode 100644 index 000000000..7b0bef42f --- /dev/null +++ b/pl/boot2.yap @@ -0,0 +1,209 @@ +/************************************************************************* +* * +* YAP Prolog * +* * +* Yap Prolog was developed at NCCUP - Universidade do Porto * +* * +* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-2014 * +* * +************************************************************************** +* * +* File: boot.yap * +* Last rev: 8/2/88 * +* mods: * +* commen ts: boot file for Prolog * +* * +*************************************************************************/ + +/** + @file boot2.yap + @brief YAP bootstrap, now in full Prolog. + + + @addtogroup TopLevel Top-Level and Boot Predicates + + @ingroup builtins + @{ + + +*/ + + + +:- 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('pathconf.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'). +:- use_module('../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). + +:- current_prolog_flag(android,true)->use_module(user:'android.yap') ; true. + + +/** @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. + +*/ + +:- module(user). + + +:- multifile user:exception/3. + +:- dynamic user:exception/3. + + +:- set_prolog_flag(unknown,error). + +%% @} + From 86decdddde9b9cab1f410d6da12c34717a4237b5 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 21 Jan 2019 01:11:42 +0000 Subject: [PATCH 8/8] modules --- C/absmi.c | 56 +- C/c_interface.c | 9 +- C/dbase.c | 4 +- C/errors.c | 60 +- C/modules.c | 4 +- C/utilpreds.c | 46 +- C/yap-args.c | 1187 +++++++++++++++-------------- CMakeLists.txt | 22 +- H/YapGFlagInfo.h | 35 +- include/YapError.h | 2 +- library/CMakeLists.txt | 2 - library/autoloader.yap | 9 +- library/maplist.yap | 54 +- library/system/sys_config.h | 2 +- packages/clpqr/CMakeLists.txt | 5 +- packages/clpqr/clpr.pl | 2 +- packages/jpl/src/c/CMakeLists.txt | 2 +- packages/python/pybips.c | 2 +- packages/python/swig/README.md | 45 +- packages/python/swig/setup.py | 8 +- pl/CMakeLists.txt | 2 +- pl/boot.yap | 5 +- pl/consult.yap | 12 +- pl/debug.yap | 2 +- pl/error.yap | 35 +- pl/imports.yap | 18 +- pl/modules.yap | 12 +- pl/preddyns.yap | 2 +- pl/preds.yap | 183 +---- pl/threads.yap | 12 +- pl/top.yap | 21 +- pl/undefined.yap | 4 +- swi/library/CMakeLists.txt | 2 + {library => swi/library}/INDEX.pl | 0 swi/library/autoloader.yap | 132 ++++ 35 files changed, 1041 insertions(+), 957 deletions(-) rename {library => swi/library}/INDEX.pl (100%) create mode 100644 swi/library/autoloader.yap diff --git a/C/absmi.c b/C/absmi.c index fcd31e639..1ec017858 100755 --- a/C/absmi.c +++ b/C/absmi.c @@ -916,24 +916,26 @@ static int interrupt_dexecute(USES_REGS1) { static void undef_goal(USES_REGS1) { PredEntry *pe = PredFromDefCode(P); - BEGD(d0); -/* avoid trouble with undefined dynamic procedures */ -/* I assume they were not locked beforehand */ -#if defined(YAPOR) || defined(THREADS) + /* avoid trouble with undefined dynamic procedures */ + /* I assume they were not locked beforehand */ + #if defined(YAPOR) || defined(THREADS) if (!PP) { PELOCK(19, pe); PP = pe; } #endif - if (pe->PredFlags & (DynamicPredFlag | LogUpdatePredFlag | MultiFileFlag) ) { + BACKUP_MACHINE_REGS(); +if (pe->PredFlags & (DynamicPredFlag | LogUpdatePredFlag | MultiFileFlag) ) { #if defined(YAPOR) || defined(THREADS) UNLOCKPE(19, PP); PP = NULL; #endif CalculateStackGap(PASS_REGS1); P = FAILCODE; + RECOVER_MACHINE_REGS(); return; } +#if DEBUG if (UndefCode == NULL || UndefCode->OpcodeOfPred == UNDEF_OPCODE) { fprintf(stderr,"call to undefined Predicates %s ->", IndicatorOfPred(pe)); Yap_DebugPlWriteln(ARG1); @@ -946,16 +948,28 @@ static void undef_goal(USES_REGS1) { #endif CalculateStackGap(PASS_REGS1); P = FAILCODE; + RECOVER_MACHINE_REGS(); return; } +#endif #if defined(YAPOR) || defined(THREADS) UNLOCKPE(19, PP); PP = NULL; -#endif - if (pe->ArityOfPE == 0) { - d0 = MkAtomTerm((Atom)(pe->FunctorOfPred)); + #endif + CELL o = AbsPair(HR); + if (pe->ModuleOfPred == PROLOG_MODULE) { + if (CurrentModule == PROLOG_MODULE) + HR[0] = TermProlog; + else + HR[0] = CurrentModule; } else { - d0 = AbsAppl(HR); + HR[0] = Yap_Module_Name(pe); + } + HR += 2; + if (pe->ArityOfPE == 0) { + HR[-1] = MkAtomTerm((Atom)(pe->FunctorOfPred)); + } else { + HR[-1] = AbsAppl(HR); *HR++ = (CELL)pe->FunctorOfPred; CELL *ip=HR; UInt imax = pe->ArityOfPE; @@ -984,30 +998,20 @@ static void undef_goal(USES_REGS1) { ENDD(d1); } } - ARG1 = AbsPair(HR); - HR[1] = d0; -ENDD(d0); - if (pe->ModuleOfPred == PROLOG_MODULE) { - if (CurrentModule == PROLOG_MODULE) - HR[0] = TermProlog; - else - HR[0] = CurrentModule; - } else { - HR[0] = Yap_Module_Name(pe); - } - ARG2 = Yap_getUnknownModule(Yap_GetModuleEntry(HR[0])); - HR += 2; + ARG1 = o; + ARG2 = MkVarTerm(); #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) low_level_trace(enter_pred, UndefCode, XREGS + 1); #endif /* LOW_LEVEL_TRACE */ P = UndefCode->CodeOfPred; + RECOVER_MACHINE_REGS(); } static void spy_goal(USES_REGS1) { PredEntry *pe = PredFromDefCode(P); - + BACKUP_MACHINE_REGS(); #if defined(YAPOR) || defined(THREADS) if (!PP) { PELOCK(14, pe); @@ -1027,6 +1031,7 @@ static void spy_goal(USES_REGS1) { PP = NULL; } #endif + RECOVER_MACHINE_REGS(); return; } } @@ -1044,6 +1049,7 @@ static void spy_goal(USES_REGS1) { } #endif Yap_NilError(CALL_COUNTER_UNDERFLOW_EVENT, ""); + RECOVER_MACHINE_REGS(); return; } LOCAL_PredEntriesCounter--; @@ -1055,6 +1061,7 @@ static void spy_goal(USES_REGS1) { } #endif Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, ""); + RECOVER_MACHINE_REGS(); return; } if ((pe->PredFlags & (CountPredFlag | ProfiledPredFlag | SpiedPredFlag)) == @@ -1066,6 +1073,7 @@ static void spy_goal(USES_REGS1) { } #endif P = pe->cs.p_code.TrueCodeOfPred; + RECOVER_MACHINE_REGS(); return; } } @@ -1084,6 +1092,7 @@ static void spy_goal(USES_REGS1) { PP = NULL; } #endif + RECOVER_MACHINE_REGS(); return; } } @@ -1153,6 +1162,7 @@ static void spy_goal(USES_REGS1) { low_level_trace(enter_pred, pt0, XREGS + 1); #endif /* LOW_LEVEL_TRACE */ } + RECOVER_MACHINE_REGS(); } Int Yap_absmi(int inp) { diff --git a/C/c_interface.c b/C/c_interface.c index b757f8b93..756abb7af 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -1725,6 +1725,7 @@ X_API YAP_PredEntryPtr YAP_AtomToPredInModule(YAP_Atom at, Term mod) { return RepPredProp(PredPropByAtom(at, mod)); } +/* static int run_emulator(USES_REGS1) { int out; @@ -1732,6 +1733,7 @@ static int run_emulator(USES_REGS1) { LOCAL_PrologMode |= UserCCallMode; return out; } +*/ X_API bool YAP_EnterGoal(YAP_PredEntryPtr ape, CELL *ptr, YAP_dogoalinfo *dgi) { CACHE_REGS @@ -2210,8 +2212,10 @@ X_API Term YAP_ReadClauseFromStream(int sno, Term vs, Term pos) { BACKUP_MACHINE_REGS(); Term t = Yap_read_term( sno, - MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1, &vs), - MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomTermPosition, 1), + MkPairTerm( + Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1, &vs), + MkPairTerm( + Yap_MkApplTerm(Yap_MkFunctor(AtomTermPosition, 1), 1, &pos), TermNil)), true); @@ -2268,6 +2272,7 @@ X_API char *YAP_WriteBuffer(Term t, char *buf, size_t sze, int flags) { } } } + return out.val.c = pop_output_text_stack(l,buf); } /// write a a term to n user-provided buffer: make sure not tp diff --git a/C/dbase.c b/C/dbase.c index db253b349..70c6deea2 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -4000,7 +4000,7 @@ static void EraseLogUpdCl(LogUpdClause *clau) { if (ap->cs.p_code.NOfClauses > 1) { if (ap->TimeStampOfPred >= TIMESTAMP_RESET) Yap_UpdateTimestamps(ap); - ++ap->TimeStampOfPred; + ++(ap->TimeStampOfPred); /* fprintf(stderr,"- * %x--%d--%ul\n",ap,ap->TimeStampOfPred,ap->ArityOfPE);*/ ap->LastCallOfPred = LUCALL_RETRACT; @@ -4017,7 +4017,7 @@ static void EraseLogUpdCl(LogUpdClause *clau) { ap->LastCallOfPred = LUCALL_ASSERT; } } - clau->ClTimeEnd = ap->TimeStampOfPred; + //clau->ClTimeEnd = ap->TimeStampOfPred; Yap_RemoveClauseFromIndex(ap, clau->ClCode); /* release the extra reference */ } diff --git a/C/errors.c b/C/errors.c index 53c53bd7f..2e02c1cbe 100755 --- a/C/errors.c +++ b/C/errors.c @@ -41,8 +41,8 @@ #define set_key_i(k, ks, q, i, t) \ if (strcmp(ks, q) == 0) { \ - i->k = IsIntegerTerm(t) ? IntegerOfTerm(t) : 0; \ - return IsIntegerTerm(t); \ + i->k = IsIntegerTerm(t) ? IntegerOfTerm(t) : 0; \ + return IsIntegerTerm(t); \ } #define set_key_s(k, ks, q, i, t) \ @@ -99,7 +99,7 @@ if (strcmp(ks, q) == 0) { \ #define query_key_s(k, ks, q, i) \ if (strcmp(ks, q) == 0 ) \ -{ if (i->k) return MkAtomTerm(Yap_LookupAtom(i->k)); else return TermNil; } +{ if (i->k) return MkAtomTerm(Yap_LookupAtom(i->k)); else return TermEmptyAtom; } #define query_key_t(k, ks, q, i) \ @@ -1258,15 +1258,25 @@ static Int is_callable(USES_REGS1) { return false; } -static Int is_predicate_indicator(USES_REGS1) { +/** + * @pred is_predicate_indicator( Term, Module, Name, Arity ) + * + * This predicates can be used to verify if Term is a predicate indicator, that is of the form: + * + Name/Arity + * + Name//Arity-2 + * + Module:Name/Arity + * + Module:Name//Arity-2 + * + * if it is, it will extract the predicate's module, name, and arity. + */ +static Int get_predicate_indicator(USES_REGS1) { Term G = Deref(ARG1); // Term Context = Deref(ARG2); Term mod = CurrentModule; G = Yap_YapStripModule(G, &mod); if (IsVarTerm(G)) { - Yap_Error(INSTANTIATION_ERROR, G, NULL); - return false; + Yap_ThrowError(INSTANTIATION_ERROR, G, NULL); } if (!IsVarTerm(mod) && !IsAtomTerm(mod)) { Yap_Error(TYPE_ERROR_ATOM, G, NULL); @@ -1275,13 +1285,34 @@ static Int is_predicate_indicator(USES_REGS1) { if (IsApplTerm(G)) { Functor f = FunctorOfTerm(G); if (IsExtensionFunctor(f)) { - Yap_Error(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL); + Yap_ThrowError(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL); } if (f == FunctorSlash || f == FunctorDoubleSlash) { - return true; + Term name = ArgOfTerm(1,G), arity = ArgOfTerm(2,G); + if (IsVarTerm(name)) { + Yap_ThrowError(INSTANTIATION_ERROR, name, NULL); + } else if (!IsAtomTerm(name)) { + Yap_ThrowError(TYPE_ERROR_ATOM, name, NULL); + } + if (IsVarTerm(arity)) { + Yap_ThrowError(INSTANTIATION_ERROR, arity, NULL); + } else if (!IsIntegerTerm(arity)) { + Yap_ThrowError(TYPE_ERROR_INTEGER, arity, NULL); + } else { + Int ar = IntegerOfTerm(arity); + if (ar < 0) { + Yap_ThrowError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, arity, NULL); + } + if ( f == FunctorDoubleSlash) { + arity = MkIntegerTerm(ar+2); + } + return Yap_unify(mod, ARG2) && + Yap_unify(name, ARG3) && + Yap_unify(arity, ARG4); + } + } } - } - Yap_Error(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL); + Yap_ThrowError(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL); return false; } @@ -1296,9 +1327,8 @@ void Yap_InitErrorPreds(void) { Yap_InitCPred("$query_exception", 3, query_exception, 0); Yap_InitCPred("$drop_exception", 1, drop_exception, 0); Yap_InitCPred("$close_error", 0, close_error, HiddenPredFlag); - Yap_InitCPred("is_boolean", 2, is_boolean, TestPredFlag); - Yap_InitCPred("is_callable", 2, is_callable, TestPredFlag); - Yap_InitCPred("is_atom", 2, is_atom, TestPredFlag); - Yap_InitCPred("is_predicate_indicator", 2, is_predicate_indicator, - TestPredFlag); + Yap_InitCPred("is_boolean", 1, is_boolean, TestPredFlag); + Yap_InitCPred("is_callable", 1, is_callable, TestPredFlag); + Yap_InitCPred("is_atom", 1, is_atom, TestPredFlag); + Yap_InitCPred("get_predicate_indicator", 4, get_predicate_indicator, 0); } diff --git a/C/modules.c b/C/modules.c index 3aac99e55..798e05cb5 100644 --- a/C/modules.c +++ b/C/modules.c @@ -6,7 +6,7 @@ * * * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * * * -*************************************************************** f*********** +************************************************************************** * * File: modules.c * * Last rev: * @@ -24,7 +24,7 @@ static char SccsId[] = "%W% %G%"; #include "YapHeap.h" #include "Yatom.h" -static Int current_module(USES_REGS1); +static Int currgent_module(USES_REGS1); static Int current_module1(USES_REGS1); static ModEntry *LookupModule(Term a); static ModEntry *LookupSystemModule(Term a); diff --git a/C/utilpreds.c b/C/utilpreds.c index 903c08ca2..2a60761b5 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -93,12 +93,12 @@ typedef struct non_single_struct_t { #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;\ }\ + pop_text_stack(lvl);\ LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;\ LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *);\ clean_tr(TR0 PASS_REGS);\ @@ -640,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, "%d \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; @@ -2656,13 +2656,13 @@ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_R derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); - pop_text_stack(lvl); while (to_visit > to_visit0) { to_visit --; CELL *ptd0 = to_visit->ptd0; *ptd0 = to_visit->d0; } - return FALSE; + pop_text_stack(lvl); + return false; } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { @@ -2675,7 +2675,7 @@ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_R goto restart; } pop_text_stack(lvl); - return TRUE; + return true; def_aux_overflow(); } @@ -4340,6 +4340,7 @@ int vsc; static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Int numbv, int singles USES_REGS) { + int lvl = push_text_stack(); struct non_single_struct_t @@ -4480,6 +4481,7 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share int ground = share; Int max = -1; + int lvl = push_text_stack(); HB = HLow; to_visit0 = to_visit; loop: @@ -4501,7 +4503,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share } *ptf = AbsPair(HR); ptf++; -#ifdef RATIONAL_TREES if (to_visit+1 >= (struct cp_frame *)AuxSp) { goto heap_overflow; } @@ -4513,18 +4514,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share /* fool the system into thinking we had a variable there */ *pt0 = AbsPair(HR); to_visit ++; -#else - if (pt0 < pt0_end) { - if (to_visit+1 >= (struct cp_frame *)AuxSp) { - goto heap_overflow; - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->ground = ground; - to_visit ++; - } -#endif ground = share; pt0 = ap2 - 1; pt0_end = ap2 + 1; @@ -4553,6 +4542,7 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share Int id = IntegerOfTerm(ap2[1]); ground = FALSE; if (id < -1) { + pop_text_stack(lvl); Yap_Error(RESOURCE_ERROR_STACK, TermNil, "unnumber vars cannot cope with VAR(-%d)", id); return 0L; } @@ -4587,7 +4577,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share *ptf = AbsAppl(HR); ptf++; /* store the terms to visit */ -#ifdef RATIONAL_TREES if (to_visit+1 >= (struct cp_frame *)AuxSp) { goto heap_overflow; } @@ -4599,18 +4588,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share /* fool the system into thinking we had a variable there */ *pt0 = AbsAppl(HR); to_visit ++; -#else - if (pt0 < pt0_end) { - if (to_visit+1 >= (struct cp_frame *)AuxSp) { - goto heap_overflow; - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->ground = ground; - to_visit ++; - } -#endif ground = (f != FunctorMutable) && share; d0 = ArityOfFunctor(f); pt0 = ap2; @@ -4661,6 +4638,7 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share /* restore our nice, friendly, term to its original state */ clean_dirty_tr(TR0 PASS_REGS); HB = HB0; + pop_text_stack(lvl); return ground; overflow: @@ -4669,7 +4647,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share /* we've done it */ /* restore our nice, friendly, term to its original state */ HB = HB0; -#ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit --; pt0 = to_visit->start_cp; @@ -4677,9 +4654,9 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share ptf = to_visit->to; *pt0 = to_visit->oldv; } -#endif reset_trail(TR0); /* follow chain of multi-assigned variables */ + pop_text_stack(lvl); return -1; heap_overflow: @@ -4688,7 +4665,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share /* we've done it */ /* restore our nice, friendly, term to its original state */ HB = HB0; -#ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit --; pt0 = to_visit->start_cp; @@ -4696,9 +4672,9 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share ptf = to_visit->to; *pt0 = to_visit->oldv; } -#endif reset_trail(TR0); LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; + pop_text_stack(lvl); return -3; } diff --git a/C/yap-args.c b/C/yap-args.c index 45eb54fff..f03161571 100755 --- a/C/yap-args.c +++ b/C/yap-args.c @@ -76,11 +76,13 @@ static void init_globals(YAP_init_args *yap_init) { #endif /* YAPOR || TABLING */ #ifdef YAPOR Yap_init_yapor_workers(); + if ( #if YAPOR_THREADS - if (Yap_thread_self() != 0) { + Yap_thread_self() != 0 #else - if (worker_id != 0) { + worker_id != 0 #endif + ) { #if defined(YAPOR_COPY) || defined(YAPOR_SBA) /* In the SBA we cannot just happily inherit registers @@ -96,7 +98,7 @@ static void init_globals(YAP_init_args *yap_init) { P = GETWORK_FIRST_TIME; Yap_exec_absmi(FALSE, YAP_EXEC_ABSMI); Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "abstract machine unexpected exit (YAP_Init)"); + "abstract machine unexpected exit (YAP_Init)"); } #endif /* YAPOR */ RECOVER_MACHINE_REGS(); @@ -118,25 +120,25 @@ static void init_globals(YAP_init_args *yap_init) { } if (yap_init->PrologRCFile) { Yap_PutValue(AtomConsultOnBoot, - MkAtomTerm(Yap_LookupAtom(yap_init->PrologRCFile))); + MkAtomTerm(Yap_LookupAtom(yap_init->PrologRCFile))); /* This must be done again after restore, as yap_flags has been overwritten .... */ setBooleanGlobalPrologFlag(HALT_AFTER_CONSULT_FLAG, - yap_init->HaltAfterBoot); + yap_init->HaltAfterBoot); } if (yap_init->PrologTopLevelGoal) { Yap_PutValue(AtomTopLevelGoal, - MkAtomTerm(Yap_LookupAtom(yap_init->PrologTopLevelGoal))); + MkAtomTerm(Yap_LookupAtom(yap_init->PrologTopLevelGoal))); } if (yap_init->PrologGoal) { Yap_PutValue(AtomInitGoal, - MkAtomTerm(Yap_LookupAtom(yap_init->PrologGoal))); + MkAtomTerm(Yap_LookupAtom(yap_init->PrologGoal))); } if (yap_init->PrologAddPath) { Yap_PutValue(AtomExtendFileSearchPath, - MkAtomTerm(Yap_LookupAtom(yap_init->PrologAddPath))); + MkAtomTerm(Yap_LookupAtom(yap_init->PrologAddPath))); } if (yap_init->QuietMode) { @@ -144,9 +146,10 @@ 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_SOURCEBOOT, *Yap_INCLUDEDIR, *Yap_PLBOOTDIR; + *Yap_PLDIR, *Yap_BOOTSTRAP, *Yap_COMMONSDIR, *Yap_INPUT_STARTUP, + *Yap_OUTPUT_STARTUP, *Yap_SOURCEBOOT, *Yap_INCLUDEDIR, *Yap_PLBOOTDIR; /** * consult loop in C: used to boot the system, butt supports goal execution and @@ -157,21 +160,21 @@ static bool load_file(const char *b_file USES_REGS) { Term t; int c_stream, osno, oactive; - Functor functor_query = Yap_MkFunctor(Yap_LookupAtom("?-"), 1); + Functor functor_query = Yap_MkFunctor(Yap_LookupAtom("?-"), 1); Functor functor_command1 = Yap_MkFunctor(Yap_LookupAtom(":-"), 1); Functor functor_compile2 = Yap_MkFunctor(Yap_LookupAtom("c_compile"), 1); /* consult in C */ int lvl = push_text_stack(); char *full; - /* the consult mode does not matter here, really */ + /* the consult mode does not matter here, really */ if ((osno = Yap_CheckAlias(AtomLoopStream)) < 0) { osno = 0; } c_stream = YAP_InitConsult(YAP_BOOT_MODE, b_file, &full, &oactive); - __android_log_print( - ANDROID_LOG_INFO, "YAPDroid", "done init_ consult %s ",b_file); - if (c_stream < 0) { + __android_log_print( + ANDROID_LOG_INFO, "YAPDroid", "done init_consult %s ",b_file); + if (c_stream < 0) { fprintf(stderr, "[ FATAL ERROR: could not open file %s ]\n", b_file); pop_text_stack(lvl); exit(1); @@ -181,51 +184,54 @@ static bool load_file(const char *b_file USES_REGS) { return false; } __android_log_print( - ANDROID_LOG_INFO, "YAPDroid", "do reset %s ",b_file); + ANDROID_LOG_INFO, "YAPDroid", "do reset %s ",b_file); - do { + while (t != TermEof) { CACHE_REGS - YAP_Reset(YAP_FULL_RESET, false); - Yap_StartSlots(); + YAP_Reset(YAP_FULL_RESET, false); + Yap_StartSlots(); Term vs = MkVarTerm(), pos = MkVarTerm(); t = YAP_ReadClauseFromStream(c_stream, vs, pos); // Yap_GetNèwSlot(t); - if (t == TermEof) - break; - if (t == 0) { - fprintf(stderr, "[ %s:%d: error: SYNTAX ERROR\n", - b_file, 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)) { + if (t == TermEof || t == TermNil) { + continue; + } else if (t == 0) { + fprintf(stderr, "%s:" Int_FORMAT " :0: error: SYNTAX ERROR\n", + b_file, GLOBAL_Stream[c_stream].linecount); + // + // { + // char buu[1024]; + //1 + // YAP_WriteBuffer(t, buu, 1023, 0); + // fprintf(stderr, "[ %s ]\n" , buu); + // } + continue; + } else if (IsVarTerm(t)) { + fprintf(stderr, "%s:" Int_FORMAT ":0: error: unbound or NULL parser output\n\n", + b_file, + GLOBAL_Stream[c_stream].linecount); + continue; + } else if (IsApplTerm(t) && + (FunctorOfTerm(t) == functor_query || + FunctorOfTerm(t) == functor_command1)) { t = ArgOfTerm(1, t); if (IsApplTerm(t) && FunctorOfTerm(t) == functor_compile2) { - load_file(RepAtom(AtomOfTerm(ArgOfTerm(1, t)))->StrOfAE); + load_file(RepAtom(AtomOfTerm(ArgOfTerm(1, t)))->StrOfAE); Yap_ResetException(LOCAL_ActiveError); + continue; } else { - YAP_RunGoalOnce(t); + YAP_RunGoalOnce(t); } } else { YAP_CompileClause(t); } + yap_error_descriptor_t *errd; - if ((errd = Yap_GetException(LOCAL_ActiveError)) && (errd->errorNo != YAP_NO_ERROR)) { - fprintf(stderr, "%s:%ld:0: Error %s %s Found\n", errd->errorFile, - (long int)errd->errorLine, errd->classAsText, errd->errorAsText); + if ((errd = Yap_GetException(LOCAL_ActiveError)) && + (errd->errorNo != YAP_NO_ERROR)) { + fprintf(stderr, "%s:" Int_FORMAT ":0: error: %s/%s %s\n\n", b_file, errd->errorLine, errd->errorAsText, errd->classAsText, errd->errorMsg); } - } while (true); + } BACKUP_MACHINE_REGS(); YAP_EndConsult(c_stream, &osno, full); if (!Yap_AddAlias(AtomLoopStream, osno)) { @@ -233,24 +239,24 @@ static bool load_file(const char *b_file USES_REGS) { return false; } pop_text_stack(lvl); - return true; + return t == TermEof; } static const char * EOLIST ="EOLINE"; - static bool is_install; +static bool is_install; - static bool is_dir( const char *path, const void *info) { - if (is_install) - return true; +static bool is_dir( const char *path, const void *info) { + if (is_install) + return true; - if (Yap_isDirectory( path )) - return true; - char s[YAP_FILENAME_MAX + 1]; - Int i = strlen(path); - strncpy(s, path, YAP_FILENAME_MAX); + if (Yap_isDirectory( path )) + return true; + char s[YAP_FILENAME_MAX + 1]; + Int i = strlen(path); + strncpy(s, path, YAP_FILENAME_MAX); while (--i) { if (Yap_dir_separator((int)path[i])) - break; + break; } if (i == 0) { s[0] = '.'; @@ -258,80 +264,84 @@ static const char * EOLIST ="EOLINE"; } s[i] = '\0'; if (info == NULL) - return true; + return true; return strcmp(info,s) == 0 || Yap_isDirectory( s ); - } - - static bool is_file( const char *path, const void *info) { - if (is_install) - return true; - return Yap_Exists( path ); - } - - static bool is_wfile( const char *path, const void *info) { - - return true; - } +} + +static bool is_file( const char *path, const void *info) { + if (is_install) + return true; + return Yap_Exists( path ); +} + +static bool is_wfile( const char *path, const void *info) { + + return true; +} - typedef bool testf(const char *s, const void *info); +typedef bool testf(const char *s, const void *info); /// /// - static const char *sel( - testf test, const void *info, const char *s1, ...) { - const char *fmt = s1; -va_list ap; - char *buf = malloc(FILENAME_MAX + 1); +static const char *sel( + testf test, const void *info, const char *s1, ...) { + const char *fmt = s1; + va_list ap; + char *buf = malloc(FILENAME_MAX + 1); - va_start(ap, s1); - while (fmt != EOLIST) { - if (fmt == NULL || fmt[0]=='\0') { - fmt = va_arg(ap, const char *); - continue; - } - strncpy(buf, fmt, FILENAME_MAX); // Yap_AbsoluteFile(fmt,true), FILENAME_MAX); - if (test(buf,info)) { - buf = realloc(buf, strlen(buf) + 1); - va_end(ap); - return buf; - } - fmt = va_arg(ap, const char *); - } - - va_end(ap); - free(buf); -return NULL; + va_start(ap, s1); + while (fmt != EOLIST) { + if (fmt == NULL || fmt[0]=='\0') { + fmt = va_arg(ap, const char *); + continue; } + strncpy(buf, fmt, FILENAME_MAX); // Yap_AbsoluteFile(fmt,true), FILENAME_MAX); + if (test(buf,info)) { + buf = realloc(buf, strlen(buf) + 1); + va_end(ap); + return buf; + } + fmt = va_arg(ap, const char *); + } + + va_end(ap); + free(buf); + return NULL; +} static const char *join(const char *s0, const char *s1) { CACHE_REGS - if (!s0 || s0[0] == '\0') - return s1; + if (!s0 || s0[0] == '\0') { + if (s1 && s1[0]) + return s1; + else + return NULL; + } if (!s1 || s1[0] == '\0') return s0; // int lvl = push_text_stack(); 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; - } + if (Yap_dir_separator(s1[0])) { + s1 += 1; + } } else { if (!Yap_dir_separator(s1[0]-1)) { - strcat(buf, "/"); - } + strcat(buf, "/"); + } } strcat(buf, s1); return buf; } static void Yap_set_locations(YAP_init_args *iap) { -is_install= iap->install; + 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 @@ -339,136 +349,137 @@ is_install= iap->install; /// It is: // --_not useful in Android, WIN32; /// -- DESTDIR/ in Anaconda - /// -- /usr/locall in most Unix style systems - Yap_ROOTDIR = sel( is_dir, NULL, - iap->ROOTDIR, - getenv("YAPROOTDIR"), - join(getenv("DESTDIR"), YAP_ROOTDIR), + /// -- /usr/loca77l in most Unix style systems + Yap_ROOTDIR = sel( is_dir, NULL, + iap->ROOTDIR, + getenv("YAPROOTDIR"), + join(getenv("DESTDIR"), YAP_ROOTDIR), #if __ANDROID__ - "/", + "/", #else - join(getenv("DESTDIR"), YAP_ROOTDIR), - join(getenv("DESTDIR"), join(getenv("ḦOME"),".local")), - join(getenv("DESTDIR"), "/usr/local"), - join(getenv("DESTDIR"), "/usr"), - join(getenv("DESTDIR"), "/opt"), + join(getenv("DESTDIR"), YAP_ROOTDIR), + join(getenv("DESTDIR"), join(getenv("ḦOME"),".local")), + join(getenv("DESTDIR"), "/usr/local"), + join(getenv("DESTDIR"), "/usr"), + join(getenv("DESTDIR"), "/opt"), #endif - EOLIST - ); - __android_log_print( - ANDROID_LOG_INFO,"YAPDroid", "Yap_ROOTDIR %s", Yap_ROOTDIR); + EOLIST + ); + __android_log_print( + ANDROID_LOG_INFO,"YAPDroid", "Yap_ROOTDIR %s", Yap_ROOTDIR); - /// BINDIR: where the OS stores header files, namely libYap... - Yap_BINDIR = sel( is_dir, Yap_ROOTDIR, iap->BINDIR, - getenv("YAPBINDIR"), + /// 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), + join(getenv("DESTDIR"), YAP_BINDIR), #endif - join(Yap_ROOTDIR, "bin"), - EOLIST); + join(Yap_ROOTDIR, "bin"), + EOLIST); /// LIBDIR: where the OS stores dynamic libraries, namely libYap... - Yap_LIBDIR = sel( is_dir, Yap_ROOTDIR, iap->LIBDIR, + Yap_LIBDIR = sel( is_dir, Yap_ROOTDIR, iap->LIBDIR, #if !defined(__ANDROID__) - join(getenv("DESTDIR"), YAP_LIBDIR), + join(getenv("DESTDIR"), YAP_LIBDIR), #endif - join(Yap_ROOTDIR, "lib"), - EOLIST); + join(Yap_ROOTDIR, "lib"), + EOLIST); /// DLLDIR: where libraries can find expicitely loaded DLLs - Yap_DLLDIR = sel(is_dir, Yap_LIBDIR, iap->DLLDIR, - getenv("YAPLIBDIR"), - join(getenv("DESTDIR"), YAP_DLLDIR), - join(Yap_LIBDIR, "/Yap"), - EOLIST); + Yap_DLLDIR = sel(is_dir, Yap_LIBDIR, iap->DLLDIR, + getenv("YAPLIBDIR"), + join(getenv("DESTDIR"), YAP_DLLDIR), + join(Yap_DLLDIR, "Yap"), + EOLIST); /// INCLUDEDIR: where the OS stores header files, namely libYap... - Yap_INCLUDEDIR = sel(is_dir, Yap_ROOTDIR, iap->INCLUDEDIR, + Yap_INCLUDEDIR = sel(is_dir, Yap_ROOTDIR, iap->INCLUDEDIR, #if !defined(__ANDROID__) - join(getenv("DESTDIR"), YAP_INCLUDEDIR), + join(getenv("DESTDIR"), YAP_INCLUDEDIR), #endif join(Yap_ROOTDIR, "include"), EOLIST); - /// SHAREDIR: where OS & ARCH independent files live - Yap_SHAREDIR = sel( is_dir, Yap_ROOTDIR, iap->SHAREDIR, - getenv("YAPSHAREDIR"), + /// SHAREDIR: where OS & ARCH independent files live + Yap_SHAREDIR = sel( is_dir, Yap_ROOTDIR, iap->SHAREDIR, + getenv("YAPSHAREDIR"), #if __ANDROID__ - "/data/data/pt.up.yap/files", - "/assets", + "/data/data/pt.up.yap/files", + "/assets", #endif - join(getenv("DESTDIR"), YAP_SHAREDIR), - join(Yap_ROOTDIR, "share"), - join(Yap_ROOTDIR, "files"), - EOLIST); - __android_log_print( - ANDROID_LOG_INFO,"YAPDroid", "Yap_SHAREDIR %s", Yap_SHAREDIR); + join(getenv("DESTDIR"), YAP_SHAREDIR), + join(Yap_ROOTDIR, "share"), + join(Yap_ROOTDIR, "files"), + EOLIST); + __android_log_print( + ANDROID_LOG_INFO,"YAPDroid", "Yap_SHAREDIR %s", Yap_SHAREDIR); - /// PLDIR: where we can find Prolog files + /// PLDIR: where we can find Prolog files Yap_PLDIR = sel( is_dir, Yap_SHAREDIR, iap->PLDIR, - join(getenv("DESTDIR"), join(Yap_SHAREDIR, "Yap")), - join(getenv("DESTDIR"), YAP_PLDIR), - EOLIST); + join(getenv("DESTDIR"), join(Yap_SHAREDIR, "Yap")), + EOLIST); - __android_log_print( - ANDROID_LOG_INFO, "YAPDroid","Yap_PLDIR %s", Yap_PLDIR); + __android_log_print( + ANDROID_LOG_INFO, "YAPDroid","Yap_PLDIR %s", Yap_PLDIR); - /// ``COMMONSDIR: Prolog Commons + /// ``COMMONSDIR: Prolog Commons Yap_COMMONSDIR = sel(is_dir, Yap_SHAREDIR, iap->COMMONSDIR, - join(getenv("DESTDIR"), join(Yap_SHAREDIR, "PrologCommons")), - 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); + Yap_SOURCEBOOT = sel( is_file, Yap_AbsoluteFile("pl",false), iap->SOURCEBOOT, + YAP_SOURCEBOOT, + "boot.yap", + "../pl/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, ".", 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); + 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", - join(getenv("DESTDIR"), join(Yap_DLLDIR, "startup.yss")), + "startup.yss", + join(getenv("DESTDIR"), join(Yap_DLLDIR, "startup.yss")), #if !defined(__ANDROID__) - join(getenv("DESTDIR"), YAP_INPUT_STARTUP), + join(getenv("DESTDIR"), YAP_INPUT_STARTUP), #endif - "/usr/local/lib/Yap/startup.yss", - "/usr/lib/Yap/startup.yss", - EOLIST); + "/usr/local/lib/Yap/startup.yss", + "/usr/lib/Yap/startup.yss", + EOLIST); - if (Yap_ROOTDIR) + if (Yap_ROOTDIR) setAtomicGlobalPrologFlag(HOME_FLAG, - MkAtomTerm(Yap_LookupAtom(Yap_ROOTDIR))); + MkAtomTerm(Yap_LookupAtom(Yap_ROOTDIR))); if (Yap_PLDIR) setAtomicGlobalPrologFlag(PROLOG_LIBRARY_DIRECTORY_FLAG, - MkAtomTerm(Yap_LookupAtom(Yap_PLDIR))); + MkAtomTerm(Yap_LookupAtom(Yap_PLDIR))); if (Yap_DLLDIR) setAtomicGlobalPrologFlag(PROLOG_FOREIGN_DIRECTORY_FLAG, - MkAtomTerm(Yap_LookupAtom(Yap_DLLDIR))); + MkAtomTerm(Yap_LookupAtom(Yap_DLLDIR))); } static void print_usage(void) { @@ -485,16 +496,16 @@ static void print_usage(void) { fprintf(stderr, " -L run Prolog file and exit\n"); fprintf(stderr, " -p extra path for file-search-path\n"); fprintf(stderr, " -hSize Heap area in Kbytes (default: %d, minimum: %d)\n", - DefHeapSpace, MinHeapSpace); + DefHeapSpace, MinHeapSpace); fprintf(stderr, - " -sSize Stack area in Kbytes (default: %d, minimum: %d)\n", - DefStackSpace, MinStackSpace); + " -sSize Stack area in Kbytes (default: %d, minimum: %d)\n", + DefStackSpace, MinStackSpace); fprintf(stderr, - " -tSize Trail area in Kbytes (default: %d, minimum: %d)\n", - DefTrailSpace, MinTrailSpace); + " -tSize Trail area in Kbytes (default: %d, minimum: %d)\n", + DefTrailSpace, MinTrailSpace); fprintf(stderr, " -GSize Max Area for Global Stack\n"); fprintf(stderr, - " -LSize Max Area for Local Stack (number must follow L)\n"); + " -LSize Max Area for Local Stack (number must follow L)\n"); fprintf(stderr, " -TSize Max Area for Trail (number must follow T)\n"); fprintf(stderr, " -nosignals disable signal handling from Prolog\n"); fprintf(stderr, "\n[Execution Modes]\n"); @@ -506,18 +517,18 @@ static void print_usage(void) { #ifdef TABLING fprintf(stderr, - " -ts Maximum table space area in Mbytes (default: unlimited)\n"); + " -ts Maximum table space area in Mbytes (default: unlimited)\n"); #endif /* TABLING */ -#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \ - defined(YAPOR_THREADS) +#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \ + defined(YAPOR_THREADS) fprintf(stderr, " -w Number of workers (default: %d)\n", - DEFAULT_NUMBERWORKERS); + DEFAULT_NUMBERWORKERS); fprintf(stderr, - " -sl Loop scheduler executions before look for hiden " - "shared work (default: %d)\n", - DEFAULT_SCHEDULERLOOP); + " -sl Loop scheduler executions before look for hiden " + "shared work (default: %d)\n", + DEFAULT_SCHEDULERLOOP); fprintf(stderr, " -d Value of delayed release of load (default: %d)\n", - DEFAULT_DELAYEDRELEASELOAD); + DEFAULT_DELAYEDRELEASELOAD); #endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */ /* nf: Preprocessor */ /* fprintf(stderr," -DVar=Name Persistent definition\n"); */ @@ -564,14 +575,14 @@ static int dump_runtime_variables(void) { } X_API YAP_file_type_t Yap_InitDefaults(void *x, char *saved_state, int argc, - char *argv[]) { + char *argv[]) { if (!LOCAL_TextBuffer) LOCAL_TextBuffer = Yap_InitTextAllocator(); YAP_init_args *iap = x; memset(iap, 0, sizeof(YAP_init_args)); - iap->Argc = argc; - iap->Argv = argv; + iap->Argc = argc; + iap->Argv = argv; #if __ANDROID__ iap->boot_file_type = YAP_PL; iap->INPUT_STARTUP = NULL; @@ -601,401 +612,401 @@ X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_a if (*p == '-') switch (*++p) { case 'b': - iap->boot_file_type = YAP_PL; - if (p[1]) - iap->BOOTSTRAP = p + 1; - else if (argv[1] && *argv[1] != '-') { - iap->BOOTSTRAP = *++argv; - argc--; - } - break; + iap->boot_file_type = YAP_PL; + if (p[1]) + iap->BOOTSTRAP = p + 1; + else if (argv[1] && *argv[1] != '-') { + iap->BOOTSTRAP = *++argv; + argc--; + } + break; case 'B': - iap->boot_file_type = YAP_SOURCE_PL; - if (p[1]) - iap->SOURCEBOOT = p + 1; - else if (argv[1] && *argv[1] != '-') { - iap->SOURCEBOOT = *++argv; - argc--; - } - iap->install = true; - break; + iap->boot_file_type = YAP_SOURCE_PL; + if (p[1]) + iap->SOURCEBOOT = p + 1; + else if (argv[1] && *argv[1] != '-') { + iap->SOURCEBOOT = *++argv; + argc--; + } + iap->install = true; + break; case '?': - print_usage(); - exit(EXIT_SUCCESS); + print_usage(); + exit(EXIT_SUCCESS); case 'q': - iap->QuietMode = TRUE; - break; -#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \ - defined(YAPOR_THREADS) + iap->QuietMode = TRUE; + break; +#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \ + defined(YAPOR_THREADS) case 'w': - ssize = &(iap->NumberWorkers); - goto GetSize; + ssize = &(iap->NumberWorkers); + goto GetSize; case 'd': - if (!strcmp("dump-runtime-variables", p)) - return dump_runtime_variables(); - ssize = &(iap->DelayedReleaseLoad); - goto GetSize; + if (!strcmp("dump-runtime-variables", p)) + return dump_runtime_variables(); + ssize = &(iap->DelayedReleaseLoad); + goto GetSize; #else case 'd': - if (!strcmp("dump-runtime-variables", p)) - return dump_runtime_variables(); + if (!strcmp("dump-runtime-variables", p)) + return dump_runtime_variables(); #endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */ case 'F': - /* just ignore for now */ - argc--; - argv++; - break; + /* just ignore for now */ + argc--; + argv++; + break; case 'f': - iap->FastBoot = TRUE; - if (argc > 1 && argv[1][0] != '-') { - argc--; - argv++; - if (strcmp(*argv, "none")) { - iap->PrologRCFile = *argv; - } - break; - } - break; - // execution mode + iap->FastBoot = TRUE; + if (argc > 1 && argv[1][0] != '-') { + argc--; + argv++; + if (strcmp(*argv, "none")) { + iap->PrologRCFile = *argv; + } + break; + } + break; + // execution mode case 'J': - switch (p[1]) { - case '0': - iap->ExecutionMode = YAPC_INTERPRETED; - break; - case '1': - iap->ExecutionMode = YAPC_MIXED_MODE_USER; - break; - case '2': - iap->ExecutionMode = YAPC_MIXED_MODE_ALL; - break; - case '3': - iap->ExecutionMode = YAPC_COMPILE_USER; - break; - case '4': - iap->ExecutionMode = YAPC_COMPILE_ALL; - break; - default: - fprintf(stderr, "[ YAP unrecoverable error: unknown switch -%c%c ]\n", - *p, p[1]); - exit(EXIT_FAILURE); - } - p++; - break; + switch (p[1]) { + case '0': + iap->ExecutionMode = YAPC_INTERPRETED; + break; + case '1': + iap->ExecutionMode = YAPC_MIXED_MODE_USER; + break; + case '2': + iap->ExecutionMode = YAPC_MIXED_MODE_ALL; + break; + case '3': + iap->ExecutionMode = YAPC_COMPILE_USER; + break; + case '4': + iap->ExecutionMode = YAPC_COMPILE_ALL; + break; + default: + fprintf(stderr, "[ YAP unrecoverable error: unknown switch -%c%c ]\n", + *p, p[1]); + exit(EXIT_FAILURE); + } + p++; + break; case 'G': - ssize = &(iap->MaxGlobalSize); - goto GetSize; - break; + ssize = &(iap->MaxGlobalSize); + goto GetSize; + break; case 's': case 'S': - ssize = &(iap->StackSize); -#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \ - defined(YAPOR_THREADS) - if (p[1] == 'l') { - p++; - ssize = &(iap->SchedulerLoop); - } + ssize = &(iap->StackSize); +#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \ + defined(YAPOR_THREADS) + if (p[1] == 'l') { + p++; + ssize = &(iap->SchedulerLoop); + } #endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */ - goto GetSize; + goto GetSize; case 'a': case 'A': - ssize = &(iap->AttsSize); - goto GetSize; + ssize = &(iap->AttsSize); + goto GetSize; case 'T': - ssize = &(iap->MaxTrailSize); - goto get_trail_size; + ssize = &(iap->MaxTrailSize); + goto get_trail_size; case 't': - ssize = &(iap->TrailSize); + ssize = &(iap->TrailSize); #ifdef TABLING - if (p[1] == 's') { - p++; - ssize = &(iap->MaxTableSpaceSize); - } + if (p[1] == 's') { + p++; + ssize = &(iap->MaxTableSpaceSize); + } #endif /* TABLING */ get_trail_size: - if (*++p == '\0') { - if (argc > 1) - --argc, p = *++argv; - else { - fprintf(stderr, - "[ YAP unrecoverable error: missing size in flag %s ]", - argv[0]); - print_usage(); - exit(EXIT_FAILURE); - } - } - { - unsigned long int i = 0, ch; - while ((ch = *p++) >= '0' && ch <= '9') - i = i * 10 + ch - '0'; - switch (ch) { - case 'M': - case 'm': - i *= 1024; - ch = *p++; - break; - case 'g': - i *= 1024 * 1024; - ch = *p++; - break; - case 'k': - case 'K': - ch = *p++; - break; - } - if (ch) { - iap->PrologTopLevelGoal = add_end_dot(*argv); - } else { - *ssize = i; - } - } - break; + if (*++p == '\0') { + if (argc > 1) + --argc, p = *++argv; + else { + fprintf(stderr, + "[ YAP unrecoverable error: missing size in flag %s ]", + argv[0]); + print_usage(); + exit(EXIT_FAILURE); + } + } + { + unsigned long int i = 0, ch; + while ((ch = *p++) >= '0' && ch <= '9') + i = i * 10 + ch - '0'; + switch (ch) { + case 'M': + case 'm': + i *= 1024; + ch = *p++; + break; + case 'g': + i *= 1024 * 1024; + ch = *p++; + break; + case 'k': + case 'K': + ch = *p++; + break; + } + if (ch) { + iap->PrologTopLevelGoal = add_end_dot(*argv); + } else { + *ssize = i; + } + } + break; case 'h': case 'H': - ssize = &(iap->HeapSize); + ssize = &(iap->HeapSize); GetSize: - if (*++p == '\0') { - if (argc > 1) - --argc, p = *++argv; - else { - fprintf(stderr, - "[ YAP unrecoverable error: missing size in flag %s ]", - argv[0]); - print_usage(); - exit(EXIT_FAILURE); - } - } - { - unsigned long int i = 0, ch; - while ((ch = *p++) >= '0' && ch <= '9') - i = i * 10 + ch - '0'; - switch (ch) { - case 'M': - case 'm': - i *= 1024; - ch = *p++; - break; - case 'g': - case 'G': - i *= 1024 * 1024; - ch = *p++; - break; - case 'k': - case 'K': - ch = *p++; - break; - } - if (ch) { - fprintf( - stderr, - "[ YAP unrecoverable error: illegal size specification %s ]", - argv[-1]); - Yap_exit(1); - } - *ssize = i; - } - break; + if (*++p == '\0') { + if (argc > 1) + --argc, p = *++argv; + else { + fprintf(stderr, + "[ YAP unrecoverable error: missing size in flag %s ]", + argv[0]); + print_usage(); + exit(EXIT_FAILURE); + } + } + { + unsigned long int i = 0, ch; + while ((ch = *p++) >= '0' && ch <= '9') + i = i * 10 + ch - '0'; + switch (ch) { + case 'M': + case 'm': + i *= 1024; + ch = *p++; + break; + case 'g': + case 'G': + i *= 1024 * 1024; + ch = *p++; + break; + case 'k': + case 'K': + ch = *p++; + break; + } + if (ch) { + fprintf( + stderr, + "[ YAP unrecoverable error: illegal size specification %s ]", + argv[-1]); + Yap_exit(1); + } + *ssize = i; + } + break; #ifdef DEBUG case 'P': - if (p[1] != '\0') { - while (p[1] != '\0') { - int ch = p[1]; - if (ch >= 'A' && ch <= 'Z') - ch += ('a' - 'A'); - if (ch >= 'a' && ch <= 'z') - GLOBAL_Option[ch - 96] = 1; - p++; - } - } else { - YAP_SetOutputMessage(); - } - break; + if (p[1] != '\0') { + while (p[1] != '\0') { + int ch = p[1]; + if (ch >= 'A' && ch <= 'Z') + ch += ('a' - 'A'); + if (ch >= 'a' && ch <= 'z') + GLOBAL_Option[ch - 96] = 1; + p++; + } + } else { + YAP_SetOutputMessage(); + } + break; #endif case 'L': - if (p[1] && p[1] >= '0' && - p[1] <= '9') /* hack to emulate SWI's L local option */ - { - ssize = &(iap->MaxStackSize); - goto GetSize; - } - iap->QuietMode = TRUE; - iap->HaltAfterBoot = true; + if (p[1] && p[1] >= '0' && + p[1] <= '9') /* hack to emulate SWI's L local option */ + { + ssize = &(iap->MaxStackSize); + goto GetSize; + } + iap->QuietMode = TRUE; + iap->HaltAfterBoot = true; case 'l': - p++; - if (!*++argv) { - fprintf(stderr, - "%% YAP unrecoverable error: missing load file name\n"); - exit(1); - } else if (!strcmp("--", *argv)) { - /* shell script, the next entry should be the file itself */ - iap->PrologRCFile = argv[1]; - argc = 1; - break; - } else { - iap->PrologRCFile = *argv; - argc--; - } - if (*p) { - /* we have something, usually, of the form: - -L -- - FileName - ExtraArgs - */ - /* being called from a script */ - while (*p && (*p == ' ' || *p == '\t')) - p++; - if (p[0] == '-' && p[1] == '-') { - /* ignore what is next */ - argc = 1; - } - } - break; - /* run goal before top-level */ + p++; + if (!*++argv) { + fprintf(stderr, + "%% YAP unrecoverable error: missing load file name\n"); + exit(1); + } else if (!strcmp("--", *argv)) { + /* shell script, the next entry should be the file itself */ + iap->PrologRCFile = argv[1]; + argc = 1; + break; + } else { + iap->PrologRCFile = *argv; + argc--; + } + if (*p) { + /* we have something, usually, of the form: + -L -- + FileName + ExtraArgs + */ + /* being called from a script */ + while (*p && (*p == ' ' || *p == '\t')) + p++; + if (p[0] == '-' && p[1] == '-') { + /* ignore what is next */ + argc = 1; + } + } + break; + /* run goal before top-level */ case 'g': - if ((*argv)[0] == '\0') - iap->PrologGoal = *argv; - else { - argc--; - if (argc == 0) { - fprintf(stderr, " [ YAP unrecoverable error: missing " - "initialization goal for option 'g' ]\n"); - exit(EXIT_FAILURE); - } - argv++; - iap->PrologGoal = *argv; - } - break; - /* run goal as top-level */ + if ((*argv)[0] == '\0') + iap->PrologGoal = *argv; + else { + argc--; + if (argc == 0) { + fprintf(stderr, " [ YAP unrecoverable error: missing " + "initialization goal for option 'g' ]\n"); + exit(EXIT_FAILURE); + } + argv++; + iap->PrologGoal = *argv; + } + break; + /* run goal as top-level */ case 'z': - if ((*argv)[0] == '\0') - iap->PrologTopLevelGoal = *argv; - else { - argc--; - if (argc == 0) { - fprintf(stderr, " [ YAP unrecoverable error: missing goal for " - "option 'z' ]\n"); - exit(EXIT_FAILURE); - } - argv++; - iap->PrologTopLevelGoal = add_end_dot(*argv); - } - iap->HaltAfterBoot = true; - break; + if ((*argv)[0] == '\0') + iap->PrologTopLevelGoal = *argv; + else { + argc--; + if (argc == 0) { + fprintf(stderr, " [ YAP unrecoverable error: missing goal for " + "option 'z' ]\n"); + exit(EXIT_FAILURE); + } + argv++; + iap->PrologTopLevelGoal = add_end_dot(*argv); + } + iap->HaltAfterBoot = true; + break; case 'n': - if (!strcmp("nosignals", p)) { - iap->PrologCannotHandleInterrupts = true; - break; - } - break; + if (!strcmp("nosignals", p)) { + iap->PrologCannotHandleInterrupts = true; + break; + } + break; case '-': - if (!strcmp("-nosignals", p)) { - iap->PrologCannotHandleInterrupts = true; - break; - } else if (!strncmp("-output-saved-state=", p, - strlen("-output-saved-state="))) { - iap->OUTPUT_STARTUP = p + strlen("-output-saved-state="); - } else if (!strncmp("-home=", p, strlen("-home="))) { - iap->ROOTDIR = p + strlen("-home="); - } else if (!strncmp("-system-library-directory=", p, - strlen("-system-library-directory="))) { - iap->LIBDIR = p + strlen("-system-library-directory="); - } else if (!strncmp("-system-shared-directory=", p, - strlen("-system-shared-directory="))) { - iap->SHAREDIR = p + strlen("-system-shared-directory="); - } else if (!strncmp("-prolog-library-directory=", p, - strlen("-prolog-library-directory="))) { - iap->PLDIR = p + strlen("-prolog-library-directory="); - } else if (!strncmp("-dll-library-directory=", p, - strlen("-dll-library-directory="))) { - iap->DLLDIR = p + strlen("-dll-library-directory="); - } else if (!strncmp("-home=", p, strlen("-home="))) { - iap->ROOTDIR = p + strlen("-home="); - } else if (!strncmp("-cwd=", p, strlen("-cwd="))) { - if (!Yap_ChDir(p + strlen("-cwd="))) { - fprintf(stderr, " [ YAP unrecoverable error in setting cwd: %s ]\n", - strerror(errno)); - } - } else if (!strncmp("-stack=", p, strlen("-stack="))) { - ssize = &(iap->StackSize); - p += strlen("-stack="); - goto GetSize; - } else if (!strncmp("-trail=", p, strlen("-trail="))) { - ssize = &(iap->TrailSize); - p += strlen("-trail="); - goto GetSize; - } else if (!strncmp("-heap=", p, strlen("-heap="))) { - ssize = &(iap->HeapSize); - p += strlen("-heap="); - goto GetSize; - } else if (!strncmp("-max-stack=", p, strlen("-max-stack="))) { - ssize = &(iap->MaxStackSize); - p += strlen("-max-stack="); - goto GetSize; - } else if (!strncmp("-max-trail=", p, strlen("-max-trail="))) { - ssize = &(iap->MaxTrailSize); - p += strlen("-max-trail="); - goto GetSize; - } else if (!strncmp("-max-heap=", p, strlen("-max-heap="))) { - ssize = &(iap->MaxHeapSize); - p += strlen("-max-heap="); - goto GetSize; - } else if (!strncmp("-goal=", p, strlen("-goal="))) { - iap->PrologGoal = p + strlen("-goal="); - } else if (!strncmp("-top-level=", p, strlen("-top-level="))) { - iap->PrologTopLevelGoal = p + strlen("-top-level="); - } else if (!strncmp("-table=", p, strlen("-table="))) { - ssize = &(iap->MaxTableSpaceSize); - p += strlen("-table="); - goto GetSize; - } else if (!strncmp("-", p, strlen("-="))) { - ssize = &(iap->MaxTableSpaceSize); - p += strlen("-table="); - /* skip remaining arguments */ - argc = 1; - } - break; + if (!strcmp("-nosignals", p)) { + iap->PrologCannotHandleInterrupts = true; + break; + } else if (!strncmp("-output-saved-state=", p, + strlen("-output-saved-state="))) { + iap->OUTPUT_STARTUP = p + strlen("-output-saved-state="); + } else if (!strncmp("-home=", p, strlen("-home="))) { + iap->ROOTDIR = p + strlen("-home="); + } else if (!strncmp("-system-library-directory=", p, + strlen("-system-library-directory="))) { + iap->LIBDIR = p + strlen("-system-library-directory="); + } else if (!strncmp("-system-shared-directory=", p, + strlen("-system-shared-directory="))) { + iap->SHAREDIR = p + strlen("-system-shared-directory="); + } else if (!strncmp("-prolog-library-directory=", p, + strlen("-prolog-library-directory="))) { + iap->PLDIR = p + strlen("-prolog-library-directory="); + } else if (!strncmp("-dll-library-directory=", p, + strlen("-dll-library-directory="))) { + iap->DLLDIR = p + strlen("-dll-library-directory="); + } else if (!strncmp("-home=", p, strlen("-home="))) { + iap->ROOTDIR = p + strlen("-home="); + } else if (!strncmp("-cwd=", p, strlen("-cwd="))) { + if (!Yap_ChDir(p + strlen("-cwd="))) { + fprintf(stderr, " [ YAP unrecoverable error in setting cwd: %s ]\n", + strerror(errno)); + } + } else if (!strncmp("-stack=", p, strlen("-stack="))) { + ssize = &(iap->StackSize); + p += strlen("-stack="); + goto GetSize; + } else if (!strncmp("-trail=", p, strlen("-trail="))) { + ssize = &(iap->TrailSize); + p += strlen("-trail="); + goto GetSize; + } else if (!strncmp("-heap=", p, strlen("-heap="))) { + ssize = &(iap->HeapSize); + p += strlen("-heap="); + goto GetSize; + } else if (!strncmp("-max-stack=", p, strlen("-max-stack="))) { + ssize = &(iap->MaxStackSize); + p += strlen("-max-stack="); + goto GetSize; + } else if (!strncmp("-max-trail=", p, strlen("-max-trail="))) { + ssize = &(iap->MaxTrailSize); + p += strlen("-max-trail="); + goto GetSize; + } else if (!strncmp("-max-heap=", p, strlen("-max-heap="))) { + ssize = &(iap->MaxHeapSize); + p += strlen("-max-heap="); + goto GetSize; + } else if (!strncmp("-goal=", p, strlen("-goal="))) { + iap->PrologGoal = p + strlen("-goal="); + } else if (!strncmp("-top-level=", p, strlen("-top-level="))) { + iap->PrologTopLevelGoal = p + strlen("-top-level="); + } else if (!strncmp("-table=", p, strlen("-table="))) { + ssize = &(iap->MaxTableSpaceSize); + p += strlen("-table="); + goto GetSize; + } else if (!strncmp("-", p, strlen("-="))) { + ssize = &(iap->MaxTableSpaceSize); + p += strlen("-table="); + /* skip remaining arguments */ + argc = 1; + } + break; case 'p': - if ((*argv)[0] == '\0') - iap->PrologAddPath = *argv; - else { - argc--; - if (argc == 0) { - fprintf(stderr, " [ YAP unrecoverable error: missing paths for " - "option 'p' ]\n"); - exit(EXIT_FAILURE); - } - argv++; - iap->PrologAddPath = *argv; - } - break; - /* nf: Begin preprocessor code */ + if ((*argv)[0] == '\0') + iap->PrologAddPath = *argv; + else { + argc--; + if (argc == 0) { + fprintf(stderr, " [ YAP unrecoverable error: missing paths for " + "option 'p' ]\n"); + exit(EXIT_FAILURE); + } + argv++; + iap->PrologAddPath = *argv; + } + break; + /* nf: Begin preprocessor code */ case 'D': { - char *var, *value; - ++p; - var = p; - if (var == NULL || *var == '\0') - break; - while (*p != '=' && *p != '\0') - ++p; - if (*p == '\0') - break; - *p = '\0'; - ++p; - value = p; - if (*value == '\0') - break; - if (iap->def_c == YAP_MAX_YPP_DEFS) - break; - iap->def_var[iap->def_c] = var; - iap->def_value[iap->def_c] = value; - ++(iap->def_c); - break; + char *var, *value; + ++p; + var = p; + if (var == NULL || *var == '\0') + break; + while (*p != '=' && *p != '\0') + ++p; + if (*p == '\0') + break; + *p = '\0'; + ++p; + value = p; + if (*value == '\0') + break; + if (iap->def_c == YAP_MAX_YPP_DEFS) + break; + iap->def_var[iap->def_c] = var; + iap->def_value[iap->def_c] = value; + ++(iap->def_c); + break; } - /* End preprocessor code */ + /* End preprocessor code */ default: { - fprintf(stderr, "[ YAP unrecoverable error: unknown switch -%c ]\n", - *p); - print_usage(); - exit(EXIT_FAILURE); + fprintf(stderr, "[ YAP unrecoverable error: unknown switch -%c ]\n", + *p); + print_usage(); + exit(EXIT_FAILURE); } } else { @@ -1044,20 +1055,20 @@ bool Yap_Embedded; static void init_hw(YAP_init_args *yap_init, struct ssz_t *spt) { Yap_page_size = Yap_InitPageSize(); /* init memory page size, required by - later functions */ + later functions */ #if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) Yap_init_yapor_global_local_memory(); #endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA */ if (yap_init->Embedded) { yap_init->install = false; GLOBAL_PrologShouldHandleInterrupts = - yap_init->PrologCannotHandleInterrupts = true; + yap_init->PrologCannotHandleInterrupts = true; } else { GLOBAL_PrologShouldHandleInterrupts = - !yap_init->PrologCannotHandleInterrupts; + !yap_init->PrologCannotHandleInterrupts; } Yap_InitSysbits(0); /* init signal handling and time, required by later - functions */ + functions */ GLOBAL_argv = yap_init->Argv; GLOBAL_argc = yap_init->Argc; @@ -1115,10 +1126,10 @@ 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_PL || - yap_init->boot_file_type == YAP_SOURCE_PL; + yap_init->boot_file_type == YAP_SOURCE_PL; struct ssz_t minfo; - __android_log_print( - ANDROID_LOG_INFO, "YAPDroid", "start init "); + __android_log_print( + ANDROID_LOG_INFO, "YAPDroid", "start init "); if (YAP_initialized) /* ignore repeated calls to YAP_Init */ return; @@ -1130,14 +1141,14 @@ X_API void YAP_Init(YAP_init_args *yap_init) { minfo.Trail = 0, minfo.Stack = 0, minfo.Trail = 0; init_hw(yap_init, &minfo); Yap_InitWorkspace(yap_init, minfo.Heap, minfo.Stack, minfo.Trail, 0, - yap_init->MaxTableSpaceSize, yap_init->NumberWorkers, - yap_init->SchedulerLoop, yap_init->DelayedReleaseLoad); + yap_init->MaxTableSpaceSize, yap_init->NumberWorkers, + yap_init->SchedulerLoop, yap_init->DelayedReleaseLoad); // CACHE_REGS CurrentModule = PROLOG_MODULE; - if (yap_init->QuietMode) { + if (yap_init->QuietMode) { setVerbosity(TermSilent); } if (yap_init->PrologRCFile != NULL) { @@ -1146,7 +1157,7 @@ X_API void YAP_Init(YAP_init_args *yap_init) { restore will print out messages .... */ setBooleanGlobalPrologFlag(HALT_AFTER_CONSULT_FLAG, - yap_init->HaltAfterBoot); + yap_init->HaltAfterBoot); } /* tell the system who should cope with interrupts */ Yap_ExecutionMode = yap_init->ExecutionMode; @@ -1156,41 +1167,41 @@ X_API void YAP_Init(YAP_init_args *yap_init) { try_restore = false; if (do_bootstrap || !try_restore || !Yap_SavedInfo(Yap_INPUT_STARTUP, &minfo.Trail, &minfo.Stack, - &minfo.Heap)) { + &minfo.Heap)) { init_globals(yap_init); start_modules(); - 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); + ANDROID_LOG_INFO, "YAPDroid", "init %s ", Yap_BOOTSTRAP); if (yap_init->install) { - load_file(Yap_SOURCEBOOT PASS_REGS); - setAtomicGlobalPrologFlag(RESOURCE_DATABASE_FLAG, - MkAtomTerm(Yap_LookupAtom(Yap_SOURCEBOOT))); + 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))); + load_file(Yap_BOOTSTRAP PASS_REGS); + setAtomicGlobalPrologFlag(RESOURCE_DATABASE_FLAG, + MkAtomTerm(Yap_LookupAtom(Yap_BOOTSTRAP))); } CurrentModule = LOCAL_SourceModule = TermUser; - setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, false); + setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, false); } else { if (yap_init->QuietMode) { - setVerbosity(TermSilent); - } + setVerbosity(TermSilent); + } __android_log_print( - ANDROID_LOG_INFO, "YAPDroid", "restore %s ",Yap_INPUT_STARTUP ); + ANDROID_LOG_INFO, "YAPDroid", "restore %s ",Yap_INPUT_STARTUP ); Yap_Restore(Yap_INPUT_STARTUP); - CurrentModule = LOCAL_SourceModule = TermUser; + CurrentModule = LOCAL_SourceModule = TermUser; init_globals(yap_init); start_modules(); if (yap_init->install && Yap_OUTPUT_STARTUP) { setAtomicGlobalPrologFlag(RESOURCE_DATABASE_FLAG, - MkAtomTerm(Yap_LookupAtom(Yap_INPUT_STARTUP))); + MkAtomTerm(Yap_LookupAtom(Yap_INPUT_STARTUP))); setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, true); } LOCAL_consult_level = -1; @@ -1199,7 +1210,7 @@ X_API void YAP_Init(YAP_init_args *yap_init) { if (yap_init->install && Yap_OUTPUT_STARTUP) { Term t = MkAtomTerm(Yap_LookupAtom(Yap_OUTPUT_STARTUP)); Term g = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("qsave_program"), 1), - 1, &t); + 1, &t); YAP_RunGoalOnce(g); } diff --git a/CMakeLists.txt b/CMakeLists.txt index dd11fab71..bdcc46d1c 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -375,22 +375,30 @@ if (GMP_INCLUDE_DIRS) endif () -if (WITH_READLINE) +# - Find the readline library +# This module defines +# READLINE_INCLUDE_DIR, path to readline/readline.h, etc. +# READLINE_LIBRARIES, the libraries required to use READLINE. +# READLINE_FOUND, If false, do not try to use READLINE. +# also defined, but not for general use are +# READLINE_readline_LIBRARY, where to find the READLINE library. +# READLINE_ncurses_LIBRARY, where to find the ncurses library [might not be defined] + include(FindReadline) - List(APPEND YAP_SYSTEM_OPTIONS readline) + option (WITH_READLINE "use Readline" ON) # include subdirectories configuration ## after we have all functionality in # # ADD_SUBDIRECTORY(console/terminal) if (READLINE_FOUND) + List(APPEND YAP_SYSTEM_OPTIONS readline) # required for configure - list(APPEND CMAKE_REQUIRED_INCLUDES ${READLINE_INCLUDE_DIR} + include_directories( ${READLINE_INCLUDE_DIR} ${READLINE_INCLUDE_DIR}/readline ) endif () -endif() include_directories(H H/generated @@ -450,7 +458,6 @@ set(DEF_STACKSPACE 0) set(DEF_HEAPSPACE 0) set(DEF_TRAILSPACE 0) -# option (RATIONAL_TREES "support infinite rational trees" ON) # dd_definitions (-D) ## don't touch these opts @@ -582,8 +589,12 @@ ADD_SUBDIRECTORY(pl) ADD_SUBDIRECTORY(library) +ADD_SUBDIRECTORY(swi/library) + add_subDIRECTORY(utf8proc ) + + if(ANDROID) set(CXX_SWIG_OUTDIR ${CMAKE_BINARY_DIR}/packages/swig/android) @@ -612,6 +623,7 @@ endif() add_subDIRECTORY( packages/myddas ) +add_subDIRECTORY( packages/clpqr ) List(APPEND YLIBS $) diff --git a/H/YapGFlagInfo.h b/H/YapGFlagInfo.h index e797ce9ed..f8466d7dd 100644 --- a/H/YapGFlagInfo.h +++ b/H/YapGFlagInfo.h @@ -354,23 +354,12 @@ vxu `on` consider `$` a lower case character. */ YAP_FLAG(LANGUAGE_FLAG, "language", true, isatom, "yap", NULL), - /**< if defined, first location where YAP expects to find the YAP Prolog - library. Takes precedence over library_directory */ - YAP_FLAG(PROLOG_LIBRARY_DIRECTORY_FLAG, "prolog_library_directory", true, - isatom, "", NULL), - - /**< if defined, first location where YAP expects to find the YAP Prolog - shared libraries (DLLS). Takes precedence over executable_directory/2. */ /**< `max_arity is iso ` - YAP_FLAG(MAX_ARITY_FLAG, "max_arity", false, isatom, "unbounded", NULL), Read-only flag telling the maximum arity of a functor. Takes the value `unbounded` for the current version of YAP. */ - YAP_FLAG(PROLOG_FOREIGN_DIRECTORY_FLAG, "prolog_foreign_directory", true, - isatom, "", NULL), - - + YAP_FLAG(MAX_ARITY_FLAG, "max_arity", false, isatom, "unbounded", NULL), YAP_FLAG(MAX_TAGGED_INTEGER_FLAG, "max_tagged_integer", false, at2n, "INT_MAX", NULL), @@ -378,7 +367,14 @@ vxu `on` consider `$` a lower case character. YAP_FLAG(MAX_WORKERS_FLAG, "max_workers", false, at2n, "MAX_WORKERS", NULL), YAP_FLAG(MIN_TAGGED_INTEGER_FLAG, "min_tagged_integer", false, at2n, "INT_MIN", NULL), - YAP_FLAG(N_OF_INTEGER_KEYS_IN_DB_FLAG, "n_of_integer_keys_in_db", false, ro, + + + YAP_FLAG(MODULE_INDEPENDENT_OPERATORS_FLAG, "module_independent_operators", + true, booleanFlag, "false", NULL), + + + + YAP_FLAG(N_OF_INTEGER_KEYS_IN_DB_FLAG, "n_of_integer_keys_in_db", false, ro, "256", NULL), YAP_FLAG(OCCURS_CHECK_FLAG, "occurs_check", true, booleanFlag, "false", NULL), @@ -407,8 +403,16 @@ vxu `on` consider `$` a lower case character. "true", NULL), - YAP_FLAG(MODULE_INDEPENDENT_OPERATORS_FLAG, "module_independent_operators", - true, booleanFlag, "false", NULL), + /**< if defined, first location where YAP expects to find the YAP Prolog + library. Takes precedence over library_directory */ + YAP_FLAG(PROLOG_LIBRARY_DIRECTORY_FLAG, "prolog_library_directory", true, + isatom, "", NULL), + + /**< if defined, first location where YAP expects to find the YAP Prolog + shared libraries (DLLS). Takes precedence over executable_directory/2. */ + YAP_FLAG(PROLOG_FOREIGN_DIRECTORY_FLAG, "prolog_foreign_directory", true, + isatom, "", NULL), + YAP_FLAG(OPTIMISE_FLAG, "optimise", true, booleanFlag, "false", NULL), YAP_FLAG(OS_ARGV_FLAG, "os_argv", false, os_argv, "@boot", NULL), @@ -566,7 +570,6 @@ and if it is bound to `off` disable them. The default for YAP is */ YAP_FLAG(TABLING_MODE_FLAG, "tabling_mode", true, isatom, "[]", NULL), - YAP_FLAG(THREADS_FLAG, "threads", false, ro, "MAX_THREADS", NULL), YAP_FLAG(TIMEZONE_FLAG, "timezone", false, ro, "18000", NULL), /**< `toplevel_hook ` diff --git a/include/YapError.h b/include/YapError.h index 83bfb4e0c..246e5c81f 100644 --- a/include/YapError.h +++ b/include/YapError.h @@ -53,7 +53,7 @@ extern void Yap_ThrowError__(const char *file, const char *function, int lineno, ; #define Yap_NilError(id, ...) \ - Yap_Error__(false, __FILE__, __FUNCTION__, __LINE__, id, TermNil, __VA_ARGS__) +Yap_Error__(false, __FILE__, __FUNCTION__, __LINE__, id, TermNil, __VA_ARGS__) #define Yap_InitError(id, ...) \ Yap_InitError__(__FILE__, __FUNCTION__, __LINE__, id, TermNil, __VA_ARGS__) diff --git a/library/CMakeLists.txt b/library/CMakeLists.txt index d231de802..219c2b7f0 100644 --- a/library/CMakeLists.txt +++ b/library/CMakeLists.txt @@ -1,11 +1,9 @@ set (LIBRARY_PL - INDEX.pl apply.yap apply_macros.yap arg.yap assoc.yap atts.yap - autoloader.yap avl.yap bhash.yap charsio.yap diff --git a/library/autoloader.yap b/library/autoloader.yap index 2037a5825..621ade734 100644 --- a/library/autoloader.yap +++ b/library/autoloader.yap @@ -120,10 +120,7 @@ find_predicate(G,ExportingModI) :- var(G), index(Name,Arity,ExportingModI,File), functor(G, Name, Arity), - ensure_file_loaded(File). + ensure_loaded(File). + +:- ensure_loaded('INDEX'). -ensure_file_loaded(File) :- - loaded(File), !. -ensure_file_loaded(File) :- - load_files(autoloader:File,[silent(true),if(not_loaded)]), - assert(loaded(File)). diff --git a/library/maplist.yap b/library/maplist.yap index 76368f864..7d4cc40d2 100644 --- a/library/maplist.yap +++ b/library/maplist.yap @@ -705,7 +705,7 @@ scanl_([H1|T1], [H2|T2], [H3|T3], [H4|T4], Goal, V, [VH|VT]) :- goal_expansion(checklist(Meta, List), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -726,7 +726,7 @@ goal_expansion(checklist(Meta, List), Mod:Goal) :- goal_expansion(maplist(Meta, List), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -747,7 +747,7 @@ goal_expansion(maplist(Meta, List), Mod:Goal) :- goal_expansion(maplist(Meta, ListIn, ListOut), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -768,7 +768,7 @@ goal_expansion(maplist(Meta, ListIn, ListOut), Mod:Goal) :- goal_expansion(maplist(Meta, L1, L2, L3), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -789,7 +789,7 @@ goal_expansion(maplist(Meta, L1, L2, L3), Mod:Goal) :- goal_expansion(maplist(Meta, L1, L2, L3, L4), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -810,7 +810,7 @@ goal_expansion(maplist(Meta, L1, L2, L3, L4), Mod:Goal) :- goal_expansion(maplist(Meta, L1, L2, L3, L4, L5), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -831,7 +831,7 @@ goal_expansion(maplist(Meta, L1, L2, L3, L4, L5), Mod:Goal) :- goal_expansion(selectlist(Meta, ListIn, ListOut), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -854,7 +854,7 @@ goal_expansion(selectlist(Meta, ListIn, ListOut), Mod:Goal) :- goal_expansion(selectlist(Meta, ListIn, ListIn1, ListOut), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -877,7 +877,7 @@ goal_expansion(selectlist(Meta, ListIn, ListIn1, ListOut), Mod:Goal) :- goal_expansion(selectlists(Meta, ListIn, ListIn1, ListOut, ListOut1), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -901,7 +901,7 @@ goal_expansion(selectlists(Meta, ListIn, ListIn1, ListOut, ListOut1), Mod:Goal) % same as selectlist goal_expansion(include(Meta, ListIn, ListOut), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -924,7 +924,7 @@ goal_expansion(include(Meta, ListIn, ListOut), Mod:Goal) :- goal_expansion(exclude(Meta, ListIn, ListOut), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -947,7 +947,7 @@ goal_expansion(exclude(Meta, ListIn, ListOut), Mod:Goal) :- goal_expansion(partition(Meta, ListIn, List1, List2), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -970,7 +970,7 @@ goal_expansion(partition(Meta, ListIn, List1, List2), Mod:Goal) :- goal_expansion(partition(Meta, ListIn, List1, List2, List3), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1010,7 +1010,7 @@ goal_expansion(partition(Meta, ListIn, List1, List2, List3), Mod:Goal) :- goal_expansion(convlist(Meta, ListIn, ListOut), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1033,7 +1033,7 @@ goal_expansion(convlist(Meta, ListIn, ListOut), Mod:Goal) :- goal_expansion(convlist(Meta, ListIn, ListExtra, ListOut), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1056,7 +1056,7 @@ goal_expansion(convlist(Meta, ListIn, ListExtra, ListOut), Mod:Goal) :- goal_expansion(sumlist(Meta, List, AccIn, AccOut), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1077,7 +1077,7 @@ goal_expansion(sumlist(Meta, List, AccIn, AccOut), Mod:Goal) :- goal_expansion(foldl(Meta, List, AccIn, AccOut), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1098,7 +1098,7 @@ goal_expansion(foldl(Meta, List, AccIn, AccOut), Mod:Goal) :- goal_expansion(foldl(Meta, List1, List2, AccIn, AccOut), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1119,7 +1119,7 @@ goal_expansion(foldl(Meta, List1, List2, AccIn, AccOut), Mod:Goal) :- goal_expansion(foldl(Meta, List1, List2, List3, AccIn, AccOut), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1140,7 +1140,7 @@ goal_expansion(foldl(Meta, List1, List2, List3, AccIn, AccOut), Mod:Goal) :- goal_expansion(foldl2(Meta, List, AccIn, AccOut, W0, W), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1161,7 +1161,7 @@ goal_expansion(foldl2(Meta, List, AccIn, AccOut, W0, W), Mod:Goal) :- goal_expansion(foldl2(Meta, List1, List2, AccIn, AccOut, W0, W), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1182,7 +1182,7 @@ goal_expansion(foldl2(Meta, List1, List2, AccIn, AccOut, W0, W), Mod:Goal) :- goal_expansion(foldl2(Meta, List1, List2, List3, AccIn, AccOut, W0, W), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1203,7 +1203,7 @@ goal_expansion(foldl2(Meta, List1, List2, List3, AccIn, AccOut, W0, W), Mod:Goal goal_expansion(foldl3(Meta, List, AccIn, AccOut, W0, W, X0, X), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1224,7 +1224,7 @@ goal_expansion(foldl3(Meta, List, AccIn, AccOut, W0, W, X0, X), Mod:Goal) :- goal_expansion(foldl4(Meta, List, AccIn, AccOut, W0, W, X0, X, Y0, Y), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1245,7 +1245,7 @@ goal_expansion(foldl4(Meta, List, AccIn, AccOut, W0, W, X0, X, Y0, Y), Mod:Goal) goal_expansion(mapnodes(Meta, InTerm, OutTerm), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1277,7 +1277,7 @@ goal_expansion(mapnodes(Meta, InTerm, OutTerm), Mod:Goal) :- goal_expansion(checknodes(Meta, Term), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, @@ -1307,7 +1307,7 @@ goal_expansion(checknodes(Meta, Term), Mod:Goal) :- goal_expansion(sumnodes(Meta, Term, AccIn, AccOut), Mod:Goal) :- goal_expansion_allowed, - callable(Meta), + is_callable(Meta), prolog_load_context(module, Mod), aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, diff --git a/library/system/sys_config.h b/library/system/sys_config.h index 17e29d49d..ace898575 100644 --- a/library/system/sys_config.h +++ b/library/system/sys_config.h @@ -5,7 +5,7 @@ /* Define to 1 if you have the header file. */ #ifndef HAVE_APR_1_APR_MD5_H -#define HAVE_APR_1_APR_MD5_H 1 +/* #undef HAVE_APR_1_APR_MD5_H */ #endif diff --git a/packages/clpqr/CMakeLists.txt b/packages/clpqr/CMakeLists.txt index b66383937..a00ed9b11 100644 --- a/packages/clpqr/CMakeLists.txt +++ b/packages/clpqr/CMakeLists.txt @@ -19,7 +19,10 @@ set (CLPQRPRIV clpqr/class.pl clpqr/dump.pl clpqr/project.pl clpqr/redund.pl) set (LIBPL clpr.pl clpq.pl ${CLPRPRIV} ${CLPQPRIV} ${CLPQRPRIV} ) -install ( FILES ${YAP_INSTALL_DATADIR} DESTINATION ${YAP_INSTALL_DATADIR} ) +install ( FILES ${CLPQPRIV} DESTINATION ${YAP_INSTALL_DATADIR}/clpq ) +install ( FILES ${CLPRPRIV} DESTINATION ${YAP_INSTALL_DATADIR}/clpr ) +install ( FILES ${CLPQRPRIV} DESTINATION ${YAP_INSTALL_DATADIR}/clpqr ) +install ( FILES clpr.pl clpq.pl DESTINATION ${YAP_INSTALL_DATADIR} ) # $(PL) -q -f $(srcdir)/clpr_test.pl -g test,halt -t 'halt(1)' diff --git a/packages/clpqr/clpr.pl b/packages/clpqr/clpr.pl index d84070ba4..2669b337e 100644 --- a/packages/clpqr/clpr.pl +++ b/packages/clpqr/clpr.pl @@ -128,7 +128,7 @@ minimise variable _V_ dump/3%, projecting_assert/1 ]). -:- expects_dialect(swi). +%:- expects_dialect(swi). % % Don't report export of private predicates from clpr diff --git a/packages/jpl/src/c/CMakeLists.txt b/packages/jpl/src/c/CMakeLists.txt index 5c309c77e..9e7415b5e 100644 --- a/packages/jpl/src/c/CMakeLists.txt +++ b/packages/jpl/src/c/CMakeLists.txt @@ -1,6 +1,6 @@ # set(CMAKE_MACOSX_RPATH 1) -add_lib(jplYap jpl.h jpl.c hacks.h) +add_library(jplYap jpl.c) include_directories (${JAVA_INCLUDE_PATH} ${JAVA_INCLUDE_PATH2} ${JAVA_AWT_PATH} ) diff --git a/packages/python/pybips.c b/packages/python/pybips.c index 986162d01..a160dc1e6 100644 --- a/packages/python/pybips.c +++ b/packages/python/pybips.c @@ -762,7 +762,7 @@ PyObject *term_to_nametuple(const char *s, arity_t arity, PyObject *tuple) { } else { PyStructSequence_Desc *desc = PyMem_Calloc(sizeof(PyStructSequence_Desc), 1); desc->name = PyMem_Malloc(strlen(s) + 1); - strcpy(desc->name, s); + strcpy((char *)desc->name, s); desc->doc = "YAPTerm"; desc->fields = pnull; desc->n_in_sequence = arity; diff --git a/packages/python/swig/README.md b/packages/python/swig/README.md index 90f64fe05..d609f6392 100644 --- a/packages/python/swig/README.md +++ b/packages/python/swig/README.md @@ -1,16 +1,14 @@ -The YAP Prolog System {#main} -=========== +
![The YAP Logo](docs/icons/yap_128x128x32.png)
NOTE: this version of YAP is still experimental, documentation may be out of date. -Introduction -++++++++++ +## Introduction This document provides User information on version 6.3.4 of -YAP (*Yet Another Prolog*). The YAP Prolog System is a +YAP (Yet Another Prolog). The YAP Prolog System is a high-performance Prolog compiler developed at Universidade do Porto. YAP supports stream Input/Output, sockets, modules, exceptions, Prolog debugger, C-interface, dynamic code, internal @@ -18,6 +16,7 @@ Porto. YAP supports stream Input/Output, sockets, modules, We explicitly allow both commercial and non-commercial use of YAP. + YAP is based on the David H. D. Warren's WAM (Warren Abstract Machine), with several optimizations for better performance. YAP follows the Edinburgh tradition, and was originally designed to be largely @@ -48,33 +47,47 @@ different licenses. If you have a question about this software, desire to add code, found a bug, want to request a feature, or wonder how to get further assistance, -please send e-mail to `yap-users AT lists.sourceforge.net. To -subscribe to the mailing list, visit the [YAP Mailing list page](https://lists.sourceforge.net/lists/listinfo/yap-users). +please send e-mail to . To +subscribe to the mailing list, visit the page +. On-line documentation is available for [YAP](http://www.dcc.fp.pt/~vsc/yap/) + + The packages are, in alphabetical order: -+ The CHR package developed by Tom Schrijvers, Christian Holzbaur, and Jan Wielemaker. ++ The CHR package developed by Tom Schrijvers, +Christian Holzbaur, and Jan Wielemaker. + The CLP(BN) package and Horus toolkit developed by Tiago Gomes, and Vítor Santos Costa. -+ The CLP(R) package developed by Leslie De Koninck, Bart Demoen, Tom Schrijvers, and Jan Wielemaker, based on the CLP(Q,R) implementation by Christian Holzbaur. ++ The CLP(R) package developed by Leslie De Koninck, Bart Demoen, Tom +Schrijvers, and Jan Wielemaker, based on the CLP(Q,R) implementation +by Christian Holzbaur. -+ The CPLint package developed by Fabrizio Riguzzi's research laboratory at the [University of Ferrara](http://www.ing.unife.it/Docenti/FabrizioRiguzzi/). ++ The CPLint package developed by Fabrizio Riguzzi's research +laboratory at the [University of Ferrara](http://www.ing.unife.it/Docenti/FabrizioRiguzzi/) -+ The CUDA interface package developed by Carlos Martínez, Jorge Buenabad, Inês Dutra and Vítor Santos Costa. ++ The CUDA interface package developed by Carlos Martínez, Jorge +Buenabad, Inês Dutra and Vítor Santos Costa. + The [GECODE](http://www.gecode.org) interface package developed by Denys Duchier and Vítor Santos Costa. + The [JPL](http://www.swi-prolog.org/packages/jpl/) (Java-Prolog Library) package developed by . -+ The minisat SAT solver interface developed by Michael Codish, Vitaly Lagoon, and Peter J. Stuckey. + The minisat SAT solver interface developed by Michael Codish, + Vitaly Lagoon, and Peter J. Stuckey. -+ The MYDDAS relational data-base interface developed at the Universidade do Porto by Tiago Soares, Michel Ferreira, and Ricardo Rocha. ++ The MYDDAS relational data-base interface developed at the + Universidade do Porto by Tiago Soares, Michel Ferreira, and Ricardo Rocha. -+ The [PRISM](http://rjida.meijo-u.ac.jp/prism/) logic-based programming system for statistical modeling developed at the Sato Research Laboratory, TITECH, Japan. ++ The [PRISM](http://rjida.meijo-u.ac.jp/prism/) logic-based +programming system for statistical modeling developed at the Sato +Research Laboratory, TITECH, Japan. -+ The ProbLog 1 system developed by the [ProbLog](https://dtai.cs.kuleuven.be/problog) team in the DTAI group of KULeuven. ++ The ProbLog 1 system developed by the [ProbLog](https://dtai.cs.kuleuven.be/problog) team in the +DTAI group of KULeuven. -+ The [R](http://stoics.org.uk/~nicos/sware/packs/real/) interface package developed by Nicos Angelopoulos, Vítor Santos Costa, João Azevedo, Jan Wielemaker, and Rui Camacho. ++ The [R](http://stoics.org.uk/~nicos/sware/packs/real/) interface package developed by Nicos Angelopoulos, +Vítor Santos Costa, João Azevedo, Jan Wielemaker, and Rui Camacho. diff --git a/packages/python/swig/setup.py b/packages/python/swig/setup.py index 23c49be72..3082198f7 100644 --- a/packages/python/swig/setup.py +++ b/packages/python/swig/setup.py @@ -65,11 +65,11 @@ if platform.system() == 'Windows': win_libs = ['wsock32','ws2_32'] my_extra_link_args = ['-Wl,-export-all-symbols'] elif platform.system() == 'Darwin': - my_extra_link_args = ['-L','..','-Wl,-rpath,'+abspath(join(sysconfig.get_path('platlib'),'yap4py')),'-Wl,-rpath,/usr/local/lib','-Wl,-rpath,../yap4py'] + my_extra_link_args = ['-L','..','-Wl,-rpath,'+abspath(join(sysconfig.get_path('platlib'),'yap4py')),'-Wl,-rpath,/lib','-Wl,-rpath,../yap4py'] win_libs = [] local_libs = ['Py4YAP'] elif platform.system() == 'Linux': - my_extra_link_args = ['-L','..','-Wl,-rpath,'+abspath(join(sysconfig.get_path('platlib'),'yap4py')),'-Wl,-rpath,/usr/local/lib','-Wl,-rpath,'+join('/usr/local/lib','..'),'-Wl,-rpath,../yap4py'] + my_extra_link_args = ['-L','..','-Wl,-rpath,'+abspath(join(sysconfig.get_path('platlib'),'yap4py')),'-Wl,-rpath,/lib','-Wl,-rpath,'+join('/lib','..'),'-Wl,-rpath,../yap4py'] win_libs = [] local_libs = ['Py4YAP'] @@ -91,10 +91,10 @@ extensions = [Extension('_yap', native_sources, ('PYTHONSWIG', '1'), ('_GNU_SOURCE', '1')], runtime_library_dirs=[ - abspath(join(sysconfig.get_path('platlib'),'yap4py')), abspath(sysconfig.get_path('platlib')),'/usr/local/lib'], + abspath(join(sysconfig.get_path('platlib'),'yap4py')), abspath(sysconfig.get_path('platlib')),'/lib'], swig_opts=['-modern', '-c++', '-py3', '-DX_API', '-Iyap4py/include' ], - library_dirs=[".",'../../..','/usr/local/lib'], + library_dirs=[".",'../../..','/lib'], extra_link_args=my_extra_link_args, libraries=['Yap','gmp']+win_libs+local_libs, include_dirs=['/home/vsc/github/yap-6.3/H', diff --git a/pl/CMakeLists.txt b/pl/CMakeLists.txt index 9697c2d7e..36b79a68a 100644 --- a/pl/CMakeLists.txt +++ b/pl/CMakeLists.txt @@ -1,4 +1,4 @@ -set(11PL_BOOT_SOURCES +set(PL_BOOT_SOURCES absf.yap android.yap arith.yap diff --git a/pl/boot.yap b/pl/boot.yap index 4c8f1381e..4837158ca 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -53,7 +53,6 @@ private(_). true/0], ['$$compile'/4, '$call'/4, '$catch'/3, - '$check_callable'/2, '$check_head_and_body'/4, '$check_if_reconsulted'/2, '$clear_reconsulting'/0, @@ -118,7 +117,7 @@ print_message(L,E) :- -> true ; - error(_,Info), + system_error(_,Info), '$error_descriptor'(Info, Desc), query_exception(prologPredFile, Desc, File), query_exception(prologPredLine, Desc, FilePos), @@ -132,7 +131,7 @@ print_message(L,E) :- format(user_error,'~a:~d: error: undefined ~w~n:',[F,L,M:G]), fail ; - format(user_error,' call to ~w~n',[M:G]), + format(user_error,' call to undefined procedure ~w~n',[M:G]), fail. :- '$undefp_handler'('$undefp0'(_,_),prolog). diff --git a/pl/consult.yap b/pl/consult.yap index a7b1f71f6..5920f944e 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -265,7 +265,7 @@ load_files(Files0,Opts) :- '$lf_option'(sandboxed, 24, false). '$lf_option'(scope_settings, 25, false). '$lf_option'(modified, 26, _). -'$lf_option'('$context_module', 27, _). +'$lf_option'(source_module, 27, _). '$lf_option'('$parent_topts', 28, _). '$lf_option'(must_be_module, 29, false). '$lf_option'('$source_pos', 30, _). @@ -317,12 +317,12 @@ load_files(Files0,Opts) :- '__NB_getval__'('$lf_status', OldTOpts, fail), nonvar(OldTOpts), functor( OldTOpts, opt, LastOpt ), '$lf_opt'(autoload, OldTOpts, OldAutoload), - '$lf_opt'('$context_module', OldTOpts, OldContextModule) + '$lf_opt'(source_module, OldTOpts, OldContextModule) ; current_prolog_flag(autoload, OldAutoload), functor( OldTOpts, opt, LastOpt ), '$lf_opt'(autoload, OldTOpts, OldAutoload), - '$lf_opt'('$context_module', OldTOpts, OldContextModule) + '$lf_opt'(source_module, OldTOpts, OldContextModule) ), functor( TOpts, opt, LastOpt ), ( source_location(ParentF, Line) -> true ; ParentF = user_input, Line = -1 ), @@ -448,7 +448,7 @@ load_files(Files0,Opts) :- ( Val == false -> true ; Val == true -> true ; '$do_error'(domain_error(unimplemented_option,register(Val)),Call) ). -'$process_lf_opt'('$context_module', Mod, Call) :- +'$process_lf_opt'(source_module, Mod, Call) :- ( atom(Mod) -> true ; '$do_error'(type_error(atom,Mod),Call) ). @@ -724,7 +724,7 @@ db_files(Fs) :- set_stream( Stream, [alias(loop_stream), encoding(Encoding)] ), '__NB_getval__'('$loop_streams',Sts0, Sts0=[]), nb_setval('$loop_streams',[Stream|Sts0]), - '$lf_opt'('$context_module', TOpts, ContextModule), + '$lf_opt'(source_module, TOpts, ContextModule), '$lf_opt'(reexport, TOpts, Reexport), '$lf_opt'(qcompile, TOpts, QCompiling), '__NB_getval__'('$qcompile', ContextQCompiling, ContextQCompiling = never), @@ -1359,7 +1359,7 @@ account the following observations: '$reexport'( TOpts, File, Reexport, Imports, OldF ) :- ( Reexport == false -> true ; ( '$lf_opt'('$parent_topts', TOpts, OldTOpts), - '$lf_opt'('$context_module', OldTOpts, OldContextModule) + '$lf_opt'(source_module, OldTOpts, OldContextModule) -> true ; diff --git a/pl/debug.yap b/pl/debug.yap index 04223319d..ca648226f 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -477,7 +477,7 @@ be lost. '$trace_goal'(G, M, GoalNumber, H) :- '$undefined'(G, M), !, - '$get_undefined_pred'(G, M, Goal, NM), + '$get_undefined_pred'(M:G, NM:Goal), ( ( M == NM ; NM == prolog), G == Goal -> yap_flag( unknown, Action ), diff --git a/pl/error.yap b/pl/error.yap index 864484bd2..c71a0d1a9 100644 --- a/pl/error.yap +++ b/pl/error.yap @@ -10,8 +10,10 @@ [ must_be_of_type/2, % +Type, +Term must_be_of_type/3, % +Type, +Term, +Comment must_be/2, % +Type, +Term + must_be_callable/1, % +Type, +Term must_be/3, % +Type, +Term, +Comment type_error/2, % +Type, +Term + must_be_called/1, % must_be_in_domain/2, % +Domain, +Term % must_be_in_domain/3, % +Domain, +Term, +Comment domain_error/3, % +Domain, +Values, +Term @@ -21,7 +23,9 @@ must_bind_to_type/2, % +Type, ?Term instantiation_error/1, % +Term representation_error/1, % +Reason - is_of_type/2 % +Type, +Term + is_of_type/2, % +Type, +Term + is_callable/1, + is_callable/2 ]), []) . /** @@ -104,13 +108,13 @@ must_be(Type, X, Comment) :- must_be_of_type(callable, X) :- !, - is_callable(X, _). + is_callable(X). must_be_of_type(atom, X) :- !, - is_atom(X, _). + is_atom(X). must_be_of_type(module, X) :- !, - is_atom(X, _). + is_atom(X). must_be_of_type(predicate_indicator, X) :- !, is_predicate_indicator(X, _). @@ -120,19 +124,12 @@ must_be_of_type(Type, X) :- ; is_not(Type, X) ). -inline(must_be_of_type( atom, X ), is_atom(X, _) ). -inline(must_be_of_type( module, X ), is_module(X, _) ). -inline(must_be_of_type( callable, X ), is_callable(X, _) ). -inline(must_be_of_type( callable, X ), is_callable(X, _) ). -inline(must_be_atom( X ), is_callable(X, _) ). -inline(must_be_module( X ), is_atom(X, _) ). - must_be_of_type(predicate_indicator, X, Comment) :- !, is_predicate_indicator(X, Comment). -must_be_of_type(callable, X, Comment) :- +must_be_of_type(callable, X, _Comment) :- !, - is_callable(X, Comment). + is_callable(X). must_be_of_type(Type, X, _Comment) :- ( has_type(Type, X) -> true @@ -335,4 +332,16 @@ must_be_instantiated(X) :- must_be_instantiated(X, Comment) :- ( var(X) -> instantiation_error(X, Comment) ; true). +must_be_callable(X) :- + is_callable(X). + + +inline(must_be_of_type( atom, X ), is_atom(X) ). +inline(must_be_of_type( module, X ), is_atom(X) ). +inline(must_be_of_type( callable, X ), is_callable(X) ). +inline(must_be_atom( X ), is_atom(X) ). +inline(must_be_module( X ), is_atom(X) ). +inline(must_be_callable( X ), is_callable(X) ). +inline(is_callable( X,_ ), is_callable(X) ). + %% @} diff --git a/pl/imports.yap b/pl/imports.yap index 77bf042d9..10c759ed7 100644 --- a/pl/imports.yap +++ b/pl/imports.yap @@ -60,7 +60,7 @@ fail. % '$get_undefined_pred'(ImportingMod:G, ExportingMod:G0) :- - must_be_callablle( ImportingMod:G ), + must_be_callable( ImportingMod:G ), '$get_undefined_predicates'(ImportingMod:G, ExportingMod:G0). % be careful here not to generate an undefined exception. @@ -94,7 +94,7 @@ fail. '$verify_import'(_M:G, prolog:G) :- '$is_system_predicate'(G, prolog). '$verify_import'(M:G, NM:NG) :- - '$get_undefined_pred'(G, M, NG, NM), + '$get_undefined_predicates'(M:G, M, NM:NG), !. '$verify_import'(MG, MG). @@ -111,8 +111,13 @@ fail. 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 ). + (recordzifnot('$import','$import'(ExportingMod,ImportingMod,G0,G0, N ,K),_), + \+ '$system_predicate'(G0,prolog) + -> + '$compile'((G:-ExportingMod:G0), reconsult ,(ImportingMod:G:-ExportingMod:G0), ImportingMod, _) + ; + true + ). '$autoloader_find_predicate'(G,ExportingMod) :- @@ -122,10 +127,7 @@ fail. 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)]), + load_files([library(autoloader)],[silent(true)]), nb_setval('$autoloader_set', true), yap_flag(autoload, _, true), yap_flag( unknown, _, Unknown), diff --git a/pl/modules.yap b/pl/modules.yap index 95ce44332..87fb38cbd 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -302,7 +302,7 @@ use_module(F,Is) :- % and remove import. % '$not_imported'(H, Mod) :- - recorded('$import','$import'(NM,Mod,NH,H,_,_),R), + recorded('$import','$import'(NM,Mod,NH,H,_,_),R), NM \= Mod, functor(NH,N,Ar), print_message(warning,redefine_imported(Mod,NM,N/Ar)), @@ -470,10 +470,14 @@ export_list(Module, List) :- G1=..[N1|Args], ( '$check_import'(M0,ContextMod,N1,K) -> ( ContextMod == prolog -> - recordzifnot('$import','$import'(M0,user,G0,G1,N1,K),_), - fail + recordzifnot('$import','$import'(M0,user,G0,G1,N1,K),_), + \+ '$is_system_predicate'(G1, prolog), + '$compile'((G1:-M0:G0), reconsult,(user:G1:-M0:G0) , user, R), + fail ; recordaifnot('$import','$import'(M0,ContextMod,G0,G1,N1,K),_), + \+ '$is_system_predicate'(G1, prolog), + '$compile'((G1:-M0:G0), reconsult,(ContextMod:G1:-M0:G0) , ContextMod, R), fail ; true @@ -535,7 +539,7 @@ other source modules. This built-in was introduced by SWI-Prolog. In YAP, by default, modules only inherit from `prolog`. This extension allows predicates in the current module (see module/2 and module/1) to inherit from `user` or other modules. - + x2 */ set_base_module(ExportingModule) :- var(ExportingModule), diff --git a/pl/preddyns.yap b/pl/preddyns.yap index a9922e23f..ab4aee3f0 100644 --- a/pl/preddyns.yap +++ b/pl/preddyns.yap @@ -248,7 +248,7 @@ Retract all the clauses whose head matches the goal _G_. Goal */ retractall(V) :- '$yap_strip_module'(V,M,P), - is_callable(M,P), + is_callable(M:P), '$retractall'(P,M). '$retractall'(T,M) :- diff --git a/pl/preds.yap b/pl/preds.yap index 2bb938faf..9cb45460b 100644 --- a/pl/preds.yap +++ b/pl/preds.yap @@ -248,163 +248,55 @@ nth_clause(V,I,R) :- '$nth_clause'(P,M,I,R) :- '$fetch_nth_clause'(P,M,I,R). + +/** + @pred abolish(+ _PredSpec_) is iso + + +Deletes the predicate given by _PredSpec_ from the database. All +state on the predicate, including whether it is dynamic or static, +multifile, or meta-predicate, will be lost. The specification must +include the name and arity, and it may include module +information. Under iso language mode this built-in will only +abolish dynamic procedures. Under other modes it will abolish any +procedures. + +Older versions of YAP would accept unbound arguments; please use +current_predicate/2 to enumerate the predicates you want to discard. + +*/ +abolish(X) :- + get_predicate_indicator(X, M, Na, Ar), + functor(H, Na, Ar), + ( '$is_dynamic'(H, M) -> '$abolishd'(H, M) ; + '$undefined'(H, M) -> true ; + current_prolog_flag(language, iso) -> '$do_error'(permission_error(modify,static_procedure,Na/Ar),abolish(X)) ; + '$abolishs'(H,M) + ). + /** @pred abolish(+ _P_,+ _N_) Completely delete the predicate with name _P_ and arity _N_. It will remove both static and dynamic predicates. All state on the predicate, including whether it is dynamic or static, multifile, or meta-predicate, will be lost. -*/ -abolish(N0,A) :- - strip_module(N0, Mod, N), !, - '$abolish'(N,A,Mod). - -'$abolish'(N,A,M) :- var(N), !, - '$do_error'(instantiation_error,abolish(M:N,A)). -'$abolish'(N,A,M) :- var(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) ). - -/** @pred abolish(+ _PredSpec_) is iso - - -Deletes the predicate given by _PredSpec_ from the database. If -§§ _PredSpec_ is an unbound variable, delete all predicates for the -current module. The -specification must include the name and arity, and it may include module -information. Under iso language mode this built-in will only abolish -dynamic procedures. Under other modes it will abolish any procedures. +abolish/2 is similar to abolish/1, but it always tries to erase static properties. It should not be confused with SICStus Prolog abolish/2, which is abolish/1 plus a list of options. */ -abolish(X0) :- - strip_module(X0,M,X), - '$abolish'(X,M). - -'$abolish'(X,M) :- - current_prolog_flag(language, sicstus), !, - '$new_abolish'(X,M). -'$abolish'(X, M) :- - '$old_abolish'(X,M). - -'$new_abolish'(V,M) :- var(V), !, - '$abolish_all_in_module'(M). -'$new_abolish'(A/V,M) :- atom(A), var(V), !, - '$abolish_all_atoms'(A,M). -'$new_abolish'(Na//Ar1, M) :- - integer(Ar1), - !, - Ar is Ar1+2, - '$new_abolish'(Na//Ar, M). -'$new_abolish'(Na/Ar, M) :- +abolish(N,A) :- + get_predicate_indicator(N/A, M, Na, Ar), functor(H, Na, Ar), - '$is_dynamic'(H, M), !, - '$abolishd'(H, M). -'$new_abolish'(Na/Ar, M) :- % succeed for undefined procedures. - functor(T, Na, Ar), - '$undefined'(T, M), !. -'$new_abolish'(Na/Ar, M) :- - '$do_error'(permission_error(modify,static_procedure,Na/Ar),abolish(M:Na/Ar)). -'$new_abolish'(T, M) :- - '$do_error'(type_error(predicate_indicator,T),abolish(M:T)). + ( '$is_dynamic'(H, M) -> '$abolishd'(H, M) ; + '$undefined'(H, M) -> true ; + '$abolishs'(H,M) + ). -'$abolish_all_in_module'(M) :- - '$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), - '$new_abolish'(Na/Ar, M), - fail. -'$abolish_all_atoms'(_,_). - -'$check_error_in_predicate_indicator'(V, Msg) :- - var(V), !, - '$do_error'(instantiation_error, Msg). -'$check_error_in_predicate_indicator'(M:S, Msg) :- !, - '$check_error_in_module'(M, Msg), - '$check_error_in_predicate_indicator'(S, Msg). -'$check_error_in_predicate_indicator'(S, Msg) :- - S \= _/_, - S \= _//_, !, - '$do_error'(type_error(predicate_indicator,S), Msg). -'$check_error_in_predicate_indicator'(Na/_, Msg) :- - var(Na), !, - '$do_error'(instantiation_error, Msg). -'$check_error_in_predicate_indicator'(Na/_, Msg) :- - \+ atom(Na), !, - '$do_error'(type_error(atom,Na), Msg). -'$check_error_in_predicate_indicator'(_/Ar, Msg) :- - var(Ar), !, - '$do_error'(instantiation_error, Msg). -'$check_error_in_predicate_indicator'(_/Ar, Msg) :- - \+ integer(Ar), !, - '$do_error'(type_error(integer,Ar), Msg). -'$check_error_in_predicate_indicator'(_/Ar, Msg) :- - Ar < 0, !, - '$do_error'(domain_error(not_less_than_zero,Ar), Msg). -% not yet implemented! -%'$check_error_in_predicate_indicator'(Na/Ar, Msg) :- -% Ar < maxarity, !, -% '$do_error'(type_error(representation_error(max_arity),Ar), Msg). - -'$check_error_in_module'(M, Msg) :- - var(M), !, - '$do_error'(instantiation_error, Msg). -'$check_error_in_module'(M, Msg) :- - \+ atom(M), !, - '$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) - ). -'$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) - ). -'$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, _), - functor( S, Na, Ar ), - '$abolish'(Na, Ar, M), - fail. -'$abolish_all_old'(_). - -'$abolish_all_atoms_old'(Na, M) :- - '$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)). -'$abolishs'(G, Module) :- - current_prolog_flag(language, sicstus), % only do this in sicstus mode - '$undefined'(G, Module), +'$abolishs'(G, M) :- + '$system_predicate'(G,M), !, functor(G,Name,Arity), - print_message(warning,no_match(abolish(Module:Name/Arity))). + '$do_error'(permission_error(modify,static_procedure,Name/Arity),abolish(M:G)). '$abolishs'(G, M) :- '$is_multifile'(G,M), functor(G,Name,Arity), @@ -420,6 +312,7 @@ abolish(X0) :- '$purge_clauses'(G, M), fail. '$abolishs'(_, _). + /** @pred stash_predicate(+ _Pred_) Make predicate _Pred_ invisible to new code, and to `current_predicate/2`, `listing`, and friends. New predicates with the same name and @@ -509,7 +402,7 @@ predicate_property(Pred,Prop) :- M = Mod, NPred = TruePred ; - '$get_undefined_pred'(TruePred, Mod, NPred, M) + '$get_undefined_pred'(Mod:TruePred, M:NPred) ), '$predicate_property'(NPred,M,Mod,Prop). diff --git a/pl/threads.yap b/pl/threads.yap index 5fe496375..ca03a31a6 100644 --- a/pl/threads.yap +++ b/pl/threads.yap @@ -73,7 +73,7 @@ for MS-Windows. '$thread_gfetch'/1, '$thread_local'/2]). -:- use_system_module( '$_boot', ['$check_callable'/2, +:- use_system_module( '$_boot', [ '$run_at_thread_start'/0, '$system_catch'/4]). @@ -162,7 +162,7 @@ Create a new Prolog detached thread using default options. See thread_create/3. */ thread_create(Goal) :- G0 = thread_create(Goal), - '$check_callable'(Goal, G0), + is_callable(Goal), '$thread_options'([detached(true)], [], Stack, Trail, System, Detached, AtExit, G0), '$thread_new_tid'(Id), % '$erase_thread_info'(Id), % this should not be here @@ -184,7 +184,7 @@ Create a new Prolog thread using default options. See thread_create/3. */ thread_create(Goal, Id) :- G0 = thread_create(Goal, Id), - '$check_callable'(Goal, G0), + is_callable(Goal), ( nonvar(Id) -> '$do_error'(uninstantiation_error(Id),G0) ; true ), '$thread_options'([], [], Stack, Trail, System, Detached, AtExit, G0), '$thread_new_tid'(Id), @@ -243,7 +243,7 @@ data from their stacks. */ thread_create(Goal, Id, Options) :- G0 = thread_create(Goal, Id, Options), - '$check_callable'(Goal,G0), + is_callable(Goal), ( nonvar(Id) -> '$do_error'(uninstantiation_error(Id),G0) ; true ), '$thread_options'(Options, Alias, Stack, Trail, System, Detached, AtExit, G0), '$thread_new_tid'(Id), @@ -564,7 +564,7 @@ using instead the `at_exit/1` option of thread_create/3. */ thread_at_exit(Goal) :- - '$check_callable'(Goal,thread_at_exit(Goal)), + is_callable(Goal), '$thread_self'(Id0), recordz('$thread_exit_hook',[Id0|Goal],_). @@ -1284,7 +1284,7 @@ thread_sleep(Time) :- thread_signal(Id, Goal) :- '$check_thread_or_alias'(Id, thread_signal(Id, Goal)), - '$check_callable'(Goal, thread_signal(Id, Goal)), + is_callable(Goal), '$thread_id_alias'(Id0, Id), ( recorded('$thread_signal', [Id0| _], R), erase(R), fail ; true diff --git a/pl/top.yap b/pl/top.yap index 9845b32fb..242fbc30f 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -731,19 +731,6 @@ write_query_answer( Bindings ) :- % */ '$execute0'(G, CurMod). -'$check_callable'(V,G) :- var(V), !, - '$do_error'(instantiation_error,G). -'$check_callable'(M:_G1,G) :- var(M), !, - '$do_error'(instantiation_error,G). -'$check_callable'(_:G1,G) :- !, - '$check_callable'(G1,G). -'$check_callable'(A,G) :- number(A), !, - '$do_error'(type_error(callable,A),G). -'$check_callable'(R,G) :- db_reference(R), !, - '$do_error'(type_error(callable,R),G). -'$check_callable'(_,_). - - '$loop'(Stream,exo) :- prolog_flag(agc_margin,Old,0), prompt1(': '), prompt(_,' '), @@ -861,16 +848,16 @@ gated_call(Setup, Goal, Catcher, Cleanup) :- % % split head and body, generate an error if body is unbound. % -'$check_head_and_body'(C,M,H,B,P) :- +'$check_head_and_body'(C,M,H,B,_P) :- '$yap_strip_module'(C,M1,(MH:-B0)), !, '$yap_strip_module'(M1:MH,M,H), ( M == M1 -> B = B0 ; B = M1:B0), - is_callable(M:H,P). + is_callable(M:H). -'$check_head_and_body'(MH, M, H, true, P) :- +'$check_head_and_body'(MH, M, H, true, _XsP) :- '$yap_strip_module'(MH,M,H), - is_callable(M:H,P). + is_callable(M:H). % term expansion % % return two arguments: Expanded0 is the term after "USER" expansion. diff --git a/pl/undefined.yap b/pl/undefined.yap index 4b01e029d..016ca7cf3 100644 --- a/pl/undefined.yap +++ b/pl/undefined.yap @@ -72,9 +72,7 @@ undefined_query(G0, M0, Cut) :- '$handle_error'(error,Goal,Mod) :- functor(Goal,Name,Arity), - 'program_continuation'(PMod,PName,PAr), - '$do_error'(existence_error(procedure,Name/Arity), - context(Mod:Goal,PMod:PName/PAr)). + '$do_error'(existence_error(procedure,Name/Arity), Mod:Goal). '$handle_error'(warning,Goal,Mod) :- functor(Goal,Name,Arity), 'program_continuation'(PMod,PName,PAr), diff --git a/swi/library/CMakeLists.txt b/swi/library/CMakeLists.txt index 8b8889098..2c8c5c614 100644 --- a/swi/library/CMakeLists.txt +++ b/swi/library/CMakeLists.txt @@ -1,5 +1,7 @@ set (LIBRARY_PL +INDEX.pl aggregate.pl + autoloader.yap base64.pl broadcast.pl ctypes.pl diff --git a/library/INDEX.pl b/swi/library/INDEX.pl similarity index 100% rename from library/INDEX.pl rename to swi/library/INDEX.pl diff --git a/swi/library/autoloader.yap b/swi/library/autoloader.yap new file mode 100644 index 000000000..b37ac4102 --- /dev/null +++ b/swi/library/autoloader.yap @@ -0,0 +1,132 @@ +/** + * @file autoloader.yap + + */ +:- module(autoloader,[make_library_index/0]). + +:- use_module(library(lists),[append/3]). + +:- dynamic exported/3, loaded/1. + +make_library_index :- + scan_library_exports, + scan_swi_exports. + +scan_library_exports :- + % init table file. + open('INDEX.pl', write, W), + close(W), + scan_exports('../GPL/aggregate', library(aggregate)), + scan_exports(apply, library(apply)), + scan_exports(arg, library(arg)), + scan_exports(assoc, library(assoc)), + scan_exports(avl, library(avl)), + scan_exports(bhash, library(bhash)), + scan_exports(charsio, library(charsio)), + scan_exports('../packages/chr/chr_swi', library(chr)), + scan_exports(clp/clpfd, library(clpfd)), + scan_exports('../packages/clpqr/clpr', library(clpr)), + scan_exports(gensym, library(gensym)), + scan_exports(heaps, library(heaps)), + scan_exports('../packages/jpl/jpl', library(jpl)), + scan_exports(lists, library(lists)), + scan_exports(nb, library(nb)), + scan_exports(occurs, library(occurs)), + scan_exports('../LGPL/option', library(option)), + scan_exports(ordsets, library(ordsets)), + scan_exports(pairs, library(pairs)), + scan_exports('../LGPL/prolog_xref', library(prolog_xref)), + scan_exports('../packages/plunit/plunit', library(plunit)), + scan_exports(queues, library(queues)), + scan_exports(random, library(random)), + scan_exports(rbtrees, library(rbtrees)), + scan_exports('../LGPL/readutil', library(readutil)), + scan_exports(regexp, library(regexp)), + scan_exports('../LGPL/shlib', library(shlib)), + scan_exports(system, library(system)), + scan_exports(terms, library(terms)), + scan_exports(timeout, library(timeout)), + scan_exports(trees, library(trees)). + +scan_exports(Library, CallName) :- + absolute_file_name(Library, Path, + [ file_type(prolog), + access(read), + file_errors(fail) + ]), + open(Path, read, O), + !, + get_exports(O, Exports, Module), + close(O), + open('INDEX.pl', append, W), + publish_exports(Exports, W, CallName, Module), + close(W). +scan_exports(Library) :- + format(user_error,'[ warning: library ~w not defined ]~n',[Library]). + +% +% SWI is the only language that uses autoload. +% +scan_swi_exports :- + retractall(exported(_,_,_)), + absolute_file_name(dialect/swi, Path, + [ file_type(prolog), + access(read), + file_errors(fail) + ]), + open(Path, read, O), + get_exports(O, Exports, Module), + get_reexports(O, Reexports, Exports), + close(O), + open('dialect/swi/INDEX.pl', write, W), + publish_exports(Reexports, W, library(dialect/swi), Module), + close(W). + +get_exports(O, Exports, Module) :- + read(O, (:- module(Module,Exports))), !. +get_exports(O, Exports, Module) :- + get_exports(O, Exports, Module). + +get_reexports(O, Exports, ExportsL) :- + read(O, (:- reexport(_File,ExportsI))), !, + get_reexports(O, Exports0, ExportsL), + append(ExportsI, Exports0, Exports). +get_reexports(_, Exports, Exports). + +publish_exports([], _, _, _). +publish_exports([F/A|Exports], W, Path, Module) :- + publish_export(F, A, W, Path, Module), + publish_exports(Exports, W, Path, Module). +publish_exports([F//A0|Exports], W, Path, Module) :- + A is A0+2, + publish_export(F, A, W, Path, Module), + publish_exports(Exports, W, Path, Module). +publish_exports([op(_,_,_)|Exports], W, Path, Module) :- + publish_exports(Exports, W, Path, Module). + +publish_export(F, A, _, _, Module) :- + exported(F, A, M), M \= Module, !, + format(user_error,'[ warning: clash between ~a and ~a over ~a/~d ]~n',[Module,M,F,A]). +publish_export(F, A, W, Path, Module) :- + assert(exported(F, A, Module)), !, + portray_clause(W, index(F, A, Module, Path)). + +find_predicate(G,ExportingModI) :- + nonvar(G), !, + functor(G, Name, Arity), + index(Name,Arity,ExportingModI,File), + ensure_file_loaded(File). +find_predicate(G,ExportingModI) :- + var(G), + index(Name,Arity,ExportingModI,File), + functor(G, Name, Arity), + ensure_file_loaded(File). + +ensure_file_loaded(File) :- + loaded(File), !. +ensure_file_loaded(File) :- + load_files(autoloader:File,[silent(true),if(not_loaded)]), + assert(loaded(File)). + +:- include('INDEX'). +