void YAPQuery::openQuery() { CACHE_REGS arity_t arity = ap->ArityOfPE; if (arity) { Term *ts; Term t = goal; if (IsPairTerm(t)) { ts = RepPair(t); } else { ts = RepAppl(t) + 1; } for (arity_t i = 0; i < arity; i++) { XREGS[i + 1] = ts[i]; } } // oq = LOCAL_execution; // LOCAL_execution = this; q_open = true; q_state = 0; q_flags = true; // PL_Q_PASS_EXCEPTION; q_p = P; q_cp = CP; // make sure this is safe q_handles = Yap_StartSlots(); }
static int bind_varnames(term_t varnames ARG_LD) { CACHE_REGS Term t = Yap_GetFromSlot(varnames); while(!IsVarTerm(t) && IsPairTerm(t)) { Term tl = HeadOfTerm(t); Functor f; Term tv, t2, t1; if (!IsApplTerm(tl)) return FALSE; if ((f = FunctorOfTerm(tl)) != FunctorEq) { return FALSE; } t1 = ArgOfTerm(1, tl); if (IsVarTerm(t1)) { return PL_error(NULL, 0, "variable_names", ERR_INSTANTIATION, 0, t1); } t2 = ArgOfTerm(2, tl); tv = Yap_MkApplTerm(LOCAL_FunctorVar, 1, &t1); if (IsVarTerm(t2)) { Bind_and_Trail(VarOfTerm(t2), tv); } t = TailOfTerm(t); } return TRUE; }
/* copy to a new list of terms */ static Int build_new_list(CELL *pt, Term t USES_REGS) { Int out = 0; if (IsVarTerm(t)) return(-1); if (t == TermNil) return(0); restart: while (IsPairTerm(t)) { out++; pt[0] = HeadOfTerm(t); t = TailOfTerm(t); if (IsVarTerm(t)) return(-1); if (t == TermNil) { return(out); } pt += 2; if (pt > ASP - 4096) { if (!Yap_gcl((ASP-HR)*sizeof(CELL), 2, ENV, gc_P(P,CP))) { Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); return(FALSE); } t = Deref(ARG1); pt = HR; out = 0; goto restart; } } return(-1); }
static bool bind_variable_names(Term t USES_REGS) { while (!IsVarTerm(t) && IsPairTerm(t)) { Term tl = HeadOfTerm(t); Functor f; Term tv, t2, t1; if (!IsApplTerm(tl)) return FALSE; if ((f = FunctorOfTerm(tl)) != FunctorEq) { return FALSE; } t1 = ArgOfTerm(1, tl); if (IsVarTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "variable_names"); return false; } t2 = ArgOfTerm(2, tl); tv = Yap_MkApplTerm(FunctorDollarVar, 1, &t1); if (IsVarTerm(t2)) { YapBind(VarOfTerm(t2), tv); } t = TailOfTerm(t); } return true; }
static Term get_matrix_element(Term t1, Term t2 USES_REGS) { if (!IsPairTerm(t2)) { if (t2 == MkAtomTerm(AtomLength)) { Int sz = 1; while (IsApplTerm(t1)) { Functor f = FunctorOfTerm(t1); if (NameOfFunctor(f) != AtomNil) { return MkIntegerTerm(sz); } sz *= ArityOfFunctor(f); t1 = ArgOfTerm(1, t1); } return MkIntegerTerm(sz); } Yap_ArithError(TYPE_ERROR_EVALUABLE, t2, "X is Y^[A]"); return FALSE; } while (IsPairTerm(t2)) { Int indx; Term indxt = Eval(HeadOfTerm(t2) PASS_REGS); if (!IsIntegerTerm(indxt)) { Yap_ArithError(TYPE_ERROR_EVALUABLE, t2, "X is Y^[A]"); return FALSE; } indx = IntegerOfTerm(indxt); if (!IsApplTerm(t1)) { Yap_ArithError(TYPE_ERROR_EVALUABLE, t1, "X is Y^[A]"); return FALSE; } else { Functor f = FunctorOfTerm(t1); if (ArityOfFunctor(f) < indx) { Yap_ArithError(TYPE_ERROR_EVALUABLE, t1, "X is Y^[A]"); return FALSE; } } t1 = ArgOfTerm(indx, t1); t2 = TailOfTerm(t2); } if (t2 != TermNil) { Yap_ArithError(TYPE_ERROR_EVALUABLE, t2, "X is Y^[A]"); return FALSE; } return Eval(t1 PASS_REGS); }
Term YAPListTerm::car() { Term to = gt(); if (IsPairTerm(to)) return (HeadOfTerm(to)); else { Yap_Error(TYPE_ERROR_LIST, to, ""); throw YAPError(); } }
Term YAPListTerm::cdr() { Term to = gt(); if (IsPairTerm(to)) return (TailOfTerm(to)); else if (to == TermNil) return TermNil; /* error */ throw YAPError(SOURCE(), TYPE_ERROR_LIST, to, ""); }
Term YAPListTerm::car() { Term to = gt(); if (IsPairTerm(to)) return (HeadOfTerm(to)); else { throw YAPError(SOURCE(), TYPE_ERROR_LIST, to, ""); return TermUnique; } }
static Term add_names(Term t, Term tail) { Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1); Yap_unify(t, ArgOfTerm(1, topt)); if (IsPairTerm(tail) || tail == TermNil) { return MkPairTerm(topt, tail); } else { return MkPairTerm(topt, MkPairTerm(tail, TermNil)); } }
static Term add_priority(Term t, Term tail) { Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomPriority, 1), 1); Yap_unify(t, ArgOfTerm(1, topt)); if (IsPairTerm(tail) || tail == TermNil) { return MkPairTerm(topt, tail); } else { return MkPairTerm(topt, MkPairTerm(tail, TermNil)); } }
Term &YAPListTerm::operator[](arity_t i) { BACKUP_MACHINE_REGS(); Term t0 = gt(); Term tf = 0; while (IsPairTerm(t0)) { if (i == 0) { tf = HeadOfTerm(t0); break; } else { t0 = TailOfTerm(t0); i--; } } RECOVER_MACHINE_REGS(); return RepPair(tf)[i]; }
static Int open_mem_read_stream (USES_REGS1) /* $open_mem_read_stream(+List,-Stream) */ { Term t, ti; int sno; Int sl = 0, nchars = 0; char *nbuf; ti = Deref(ARG1); while (ti != TermNil) { if (IsVarTerm(ti)) { Yap_Error(INSTANTIATION_ERROR, ti, "open_mem_read_stream"); return (FALSE); } else if (!IsPairTerm(ti)) { Yap_Error(TYPE_ERROR_LIST, ti, "open_mem_read_stream"); return (FALSE); } else { sl++; ti = TailOfTerm(ti); } } while ((nbuf = (char *)Yap_AllocAtomSpace((sl+1)*sizeof(char))) == NULL) { if (!Yap_growheap(FALSE, (sl+1)*sizeof(char), NULL)) { Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage); return(FALSE); } } ti = Deref(ARG1); while (ti != TermNil) { Term ts = HeadOfTerm(ti); if (IsVarTerm(ts)) { Yap_Error(INSTANTIATION_ERROR, ARG1, "open_mem_read_stream"); return (FALSE); } else if (!IsIntTerm(ts)) { Yap_Error(TYPE_ERROR_INTEGER, ARG1, "open_mem_read_stream"); return (FALSE); } nbuf[nchars++] = IntOfTerm(ts); ti = TailOfTerm(ti); } nbuf[nchars] = '\0'; sno = Yap_open_buf_read_stream(nbuf, nchars, &LOCAL_encoding, MEM_BUF_CODE); t = Yap_MkStream (sno); return (Yap_unify (ARG2, t)); }
YAP_tag_t YAPTerm::tag() { Term tt = gt(); if (IsVarTerm(tt)) { CELL *pt = VarOfTerm(tt); if (IsUnboundVar(pt)) { CACHE_REGS if (IsAttVar(pt)) return YAP_TAG_ATT; return YAP_TAG_UNBOUND; } return YAP_TAG_REF; } if (IsPairTerm(tt)) return YAP_TAG_PAIR; if (IsAtomOrIntTerm(tt)) { if (IsAtomTerm(tt)) return YAP_TAG_ATOM; return YAP_TAG_INT; } else { Functor f = FunctorOfTerm(tt); if (IsExtensionFunctor(f)) { if (f == FunctorDBRef) { return YAP_TAG_DBREF; } if (f == FunctorLongInt) { return YAP_TAG_LONG_INT; } if (f == FunctorBigInt) { big_blob_type bt = (big_blob_type)RepAppl(tt)[1]; switch (bt) { case BIG_INT: return YAP_TAG_BIG_INT; case BIG_RATIONAL: return YAP_TAG_RATIONAL; default: return YAP_TAG_OPAQUE; } } } return YAP_TAG_APPL; } }
static inline int rational_tree(Term d0) { CACHE_REGS CELL **to_visit_max = (CELL **)AuxBase, **to_visit = (CELL **)AuxSp; if (IsPairTerm(d0)) { CELL *pt0 = RepPair(d0); return Yap_rational_tree_loop(pt0-1, pt0+1, to_visit, to_visit_max); } else if (IsApplTerm(d0)) { CELL *pt0 = RepAppl(d0); Functor f = (Functor)(*pt0); if (IsExtensionFunctor(f)) return FALSE; return Yap_rational_tree_loop(pt0, pt0+ArityOfFunctor(f), to_visit, to_visit_max); } else return FALSE; }
Term &YAPTerm::operator[](arity_t i) { BACKUP_MACHINE_REGS(); Term t0 = gt(); Term *tf = nullptr; if (IsApplTerm(t0)) { // Functor f = FunctorOfTerm(t0); // if (IsExtensionFunctor(f)) // return 0; tf = RepAppl(t0) + (i + 1); } else if (IsPairTerm(t0)) { if (i == 0) tf = RepPair(t0); else if (i == 1) tf = RepPair(t0) + 1; RECOVER_MACHINE_REGS(); } else { throw YAPError(SOURCE(), TYPE_ERROR_COMPOUND, t0, ""); } RECOVER_MACHINE_REGS(); return *tf; }
static int unbind_variable_names(Term t USES_REGS) { while (!IsVarTerm(t) && IsPairTerm(t)) { Term tl = HeadOfTerm(t); Functor f; Term *tp2, t1; if (!IsApplTerm(tl)) return FALSE; if ((f = FunctorOfTerm(tl)) != FunctorEq) { return FALSE; } t1 = ArgOfTerm(1, tl); tp2 = RepAppl(tl) + 2; while (*tp2 != t1) { tp2 = (CELL *)*tp2; } RESET_VARIABLE(tp2); t = TailOfTerm(t); } return TRUE; }
Term &YAPTerm::operator[](arity_t i) { BACKUP_MACHINE_REGS(); Term t0 = gt(); Term tf = 0; if (IsApplTerm(t0)) { // Functor f = FunctorOfTerm(t0); // if (IsExtensionFunctor(f)) // return 0; tf = RepAppl(t0)[(i + 1)]; } else if (IsPairTerm(t0)) { if (i == 0) tf = HeadOfTerm(t0); else if (i == 1) tf = TailOfTerm(t0); RECOVER_MACHINE_REGS(); tf = RepPair(tf)[i]; } RECOVER_MACHINE_REGS(); Yap_Error(TYPE_ERROR_COMPOUND, tf, ""); throw YAPError(); }
Term YAPTerm::getArg(arity_t i) { BACKUP_MACHINE_REGS(); Term tf = 0; Term t0 = gt(); if (IsApplTerm(t0)) { if (i > ArityOfFunctor(FunctorOfTerm(t0))) throw YAPError(SOURCE(), DOMAIN_ERROR_OUT_OF_RANGE, t0, "t0.getArg()"); tf = (ArgOfTerm(i, t0)); } else if (IsPairTerm(t0)) { if (i == 1) tf = (HeadOfTerm(t0)); else if (i == 2) tf = (TailOfTerm(t0)); else throw YAPError(SOURCE(), DOMAIN_ERROR_OUT_OF_RANGE, t0, "t0.getArg()"); } else { throw YAPError(SOURCE(), TYPE_ERROR_COMPOUND, t0, "t0.getArg()"); } RECOVER_MACHINE_REGS(); return tf; }
static void reset_trail(tr_fr_ptr tr_top, tr_fr_ptr trp) { register CELL aux_cell; /* unbinding variables */ while (tr_top != trp) { aux_cell = TrailTerm(--trp); /* check for global or local variables */ if (IsVarTerm(aux_cell)) { /* clean up the trail when we backtrack */ /* shouldn't this test always succeed? */ if (Unsigned((Int)(aux_cell)-(Int)(H_FZ)) > Unsigned((Int)(B_FZ)-(Int)(H_FZ))) { RESET_VARIABLE(STACK_TO_SBA(aux_cell)); } else { RESET_VARIABLE(aux_cell); } } else if (IsPairTerm(aux_cell)) { /* avoid frozen segments */ if ((ADDR) RepPair(aux_cell) > HeapTop) { trp = (tr_fr_ptr) RepPair(aux_cell); } #ifdef MULTI_ASSIGNMENT_VARIABLES } else { CELL *aux_ptr = RepAppl(aux_cell); trp--; if (Unsigned((Int)(aux_ptr)-(Int)(H_FZ)) > Unsigned((Int)(B_FZ)-(Int)(H_FZ))) { *STACK_TO_SBA(aux_ptr) = TrailTerm(trp); } else { *aux_ptr = TrailTerm(trp); } #endif /* MULTI_ASSIGNMENT_VARIABLES */ } } }
YAPPredicate::YAPPredicate(Term &t, Term &tmod, CELL *&ts, const char *pname) { Term t0 = t; ap = nullptr; restart: if (IsVarTerm(t)) { throw YAPError(SOURCE(), INSTANTIATION_ERROR, t0, pname); } else if (IsAtomTerm(t)) { ap = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod)); ts = nullptr; } else if (IsIntegerTerm(t) && tmod == IDB_MODULE) { ts = nullptr; ap = Yap_FindLUIntKey(IntegerOfTerm(t)); } else if (IsPairTerm(t)) { t = Yap_MkApplTerm(FunctorCsult, 1, &t); goto restart; } else if (IsApplTerm(t)) { Functor fun = FunctorOfTerm(t); if (IsExtensionFunctor(fun)) { throw YAPError(SOURCE(), TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), pname); } if (fun == FunctorModule) { tmod = ArgOfTerm(1, t); if (IsVarTerm(tmod)) { throw YAPError(SOURCE(), INSTANTIATION_ERROR, t0, pname); } if (!IsAtomTerm(tmod)) { throw YAPError(SOURCE(), TYPE_ERROR_ATOM, t0, pname); } t = ArgOfTerm(2, t); goto restart; } ap = RepPredProp(Yap_GetPredPropByFunc(fun, tmod)); ts = RepAppl(t) + 1; } else { throw YAPError(SOURCE(), TYPE_ERROR_CALLABLE, t0, pname); } }
int q_share_work(int worker_p) { register tr_fr_ptr aux_tr; register CELL aux_cell; LOCK_OR_FRAME(LOCAL_top_or_fr); if (REMOTE_prune_request(worker_p)) { /* worker p with prune request */ UNLOCK_OR_FRAME(LOCAL_top_or_fr); return FALSE; } YAPOR_ERROR_CHECKING(q_share_work, Get_OrFr_pend_prune_cp(LOCAL_top_or_fr) && BRANCH_LTT(worker_p, OrFr_depth(LOCAL_top_or_fr)) < OrFr_pend_prune_ltt(LOCAL_top_or_fr)); /* there is no pending prune with worker p at right --> safe move to worker p branch */ CUT_reset_prune_request(); if(Get_LOCAL_prune_request()){ UNLOCK_OR_FRAME(LOCAL_top_or_fr); return FALSE; } BRANCH(worker_id, OrFr_depth(LOCAL_top_or_fr)) = BRANCH(worker_p, OrFr_depth(LOCAL_top_or_fr)); UNLOCK_OR_FRAME(LOCAL_top_or_fr); /* unbind variables */ aux_tr = LOCAL_top_cp->cp_tr; TABLING_ERROR_CHECKING(q_share_work, TR < aux_tr); while (aux_tr != TR) { aux_cell = TrailTerm(--TR); /* check for global or local variables */ if (IsVarTerm(aux_cell)) { RESET_VARIABLE(aux_cell); #ifdef TABLING } else if (IsPairTerm(aux_cell)) { aux_cell = (CELL) RepPair(aux_cell); if (IN_BETWEEN(LOCAL_TrailBase, aux_cell, LOCAL_TrailTop)) { /* avoid frozen segments */ TR = (tr_fr_ptr) aux_cell; TABLING_ERROR_CHECKING(q_share_work, TR > (tr_fr_ptr) LOCAL_TrailTop); TABLING_ERROR_CHECKING(q_share_work, TR < aux_tr); } #endif /* TABLING */ #ifdef MULTI_ASSIGNMENT_VARIABLES } else if (IsApplTerm(aux_cell)) { CELL *aux_ptr = RepAppl(aux_cell); Term aux_val = TrailTerm(--aux_tr); *aux_ptr = aux_val; #endif /* MULTI_ASSIGNMENT_VARIABLES */ } } OPTYAP_ERROR_CHECKING(q_share_work, LOCAL_top_cp != LOCAL_top_cp_on_stack); OPTYAP_ERROR_CHECKING(q_share_work, YOUNGER_CP(B_FZ, LOCAL_top_cp)); YAPOR_ERROR_CHECKING(q_share_work, LOCAL_reply_signal != worker_ready); /* make sharing request */ LOCK_WORKER(worker_p); if (BITMAP_member(GLOBAL_bm_idle_workers, worker_p) || REMOTE_share_request(worker_p) != MAX_WORKERS) { /* worker p is idle or has another request */ UNLOCK_WORKER(worker_p); return FALSE; } REMOTE_share_request(worker_p) = worker_id; UNLOCK_WORKER(worker_p); /* wait for an answer */ while (LOCAL_reply_signal == worker_ready); if (LOCAL_reply_signal == no_sharing) { /* sharing request refused */ LOCAL_reply_signal = worker_ready; return FALSE; } /* copy trail stack ? */ LOCK(LOCAL_lock_signals); if (LOCAL_p_fase_signal > trail) { LOCAL_q_fase_signal = trail; UNLOCK(LOCAL_lock_signals); Q_COPY_TRAIL_FROM(worker_p); } else { UNLOCK(LOCAL_lock_signals); goto sync_with_p; } /* copy global stack ? */ LOCK(LOCAL_lock_signals); if (LOCAL_p_fase_signal > global) { LOCAL_q_fase_signal = global; UNLOCK(LOCAL_lock_signals); Q_COPY_GLOBAL_FROM(worker_p); } else { UNLOCK(LOCAL_lock_signals); goto sync_with_p; } /* copy local stack ? */ while (LOCAL_reply_signal < nodes_shared); LOCK(LOCAL_lock_signals); if (LOCAL_p_fase_signal > local) { LOCAL_q_fase_signal = local; UNLOCK(LOCAL_lock_signals); Q_COPY_LOCAL_FROM(worker_p); } else UNLOCK(LOCAL_lock_signals); sync_with_p: #ifdef TABLING REMOTE_reply_signal(worker_p) = worker_ready; #else REMOTE_reply_signal(worker_p) = copy_done; #endif /* TABLING */ while (LOCAL_reply_signal != copy_done); #if INCREMENTAL_COPY /* install fase --> TR and LOCAL_top_cp->cp_tr are equal */ aux_tr = ((choiceptr) LOCAL_start_local_copy)->cp_tr; TR = ((choiceptr) LOCAL_end_local_copy)->cp_tr; Yap_NEW_MAHASH((ma_h_inner_struct *)HR); while (TR != aux_tr) { aux_cell = TrailTerm(--aux_tr); if (IsVarTerm(aux_cell)) { if (aux_cell < LOCAL_start_global_copy || EQUAL_OR_YOUNGER_CP((choiceptr)LOCAL_end_local_copy, (choiceptr)aux_cell)) { YAPOR_ERROR_CHECKING(q_share_work, (CELL *)aux_cell < H0); YAPOR_ERROR_CHECKING(q_share_work, (ADDR)aux_cell > LOCAL_LocalBase); #ifdef TABLING *((CELL *) aux_cell) = TrailVal(aux_tr); #else *((CELL *) aux_cell) = *((CELL *) (worker_offset(worker_p) + aux_cell)); #endif /* TABLING */ } #ifdef TABLING } else if (IsPairTerm(aux_cell)) { aux_cell = (CELL) RepPair(aux_cell); if (IN_BETWEEN(LOCAL_TrailBase, aux_cell, LOCAL_TrailTop)) { /* avoid frozen segments */ aux_tr = (tr_fr_ptr) aux_cell; } #endif /* TABLING */ #ifdef MULTI_ASSIGNMENT_VARIABLES } else if (IsApplTerm(aux_cell)) { CELL *cell_ptr = RepAppl(aux_cell); if (((CELL *)aux_cell < LOCAL_top_cp->cp_h || EQUAL_OR_YOUNGER_CP(LOCAL_top_cp, (choiceptr)aux_cell)) && !Yap_lookup_ma_var(cell_ptr)) { /* first time we found the variable, let's put the new value */ #ifdef TABLING *cell_ptr = TrailVal(aux_tr); #else *cell_ptr = *((CELL *) (worker_offset(worker_p) + (CELL)cell_ptr)); #endif /* TABLING */ } /* skip the old value */ aux_tr--; #endif /* MULTI_ASSIGNMENT_VARIABLES */ } } #endif /* incremental */ /* update registers and return */ PUT_OUT_ROOT_NODE(worker_id); #ifndef TABLING REMOTE_reply_signal(worker_p) = worker_ready; #endif /* TABLING */ TR = (tr_fr_ptr) LOCAL_end_trail_copy; LOCAL_reply_signal = worker_ready; PUT_IN_REQUESTABLE(worker_id); #ifdef TABLING adjust_freeze_registers(); #endif /* TABLING */ return TRUE; }
static int unifiable_complex(CELL *pt0, CELL *pt0_end, CELL *pt1) { CACHE_REGS #ifdef THREADS #undef Yap_REGS register REGSTORE *regp = Yap_regp; #define Yap_REGS (*regp) #elif defined(SHADOW_REGS) #if defined(B) || defined(TR) register REGSTORE *regp = &Yap_REGS; #define Yap_REGS (*regp) #endif /* defined(B) || defined(TR) || defined(HB) */ #endif #ifdef SHADOW_HB register CELL *HBREG = HB; #endif /* SHADOW_HB */ struct unif_record *unif = (struct unif_record *)AuxBase; struct v_record *to_visit = (struct v_record *)AuxSp; #define unif_base ((struct unif_record *)AuxBase) #define to_visit_base ((struct v_record *)AuxSp) loop: while (pt0 < pt0_end) { register CELL *ptd0 = pt0+1; register CELL d0; ++pt1; pt0 = ptd0; d0 = *ptd0; deref_head(d0, unifiable_comp_unk); unifiable_comp_nvar: { register CELL *ptd1 = pt1; register CELL d1 = *ptd1; deref_head(d1, unifiable_comp_nvar_unk); unifiable_comp_nvar_nvar: if (d0 == d1) continue; if (IsPairTerm(d0)) { if (!IsPairTerm(d1)) { goto cufail; } /* now link the two structures so that no one else will */ /* come here */ /* store the terms to visit */ if (RATIONAL_TREES || pt0 < pt0_end) { to_visit --; #ifdef RATIONAL_TREES unif++; #endif if ((void *)to_visit < (void *)unif) { CELL **urec = (CELL **)unif; to_visit = (struct v_record *)Yap_shift_visit((CELL **)to_visit, &urec, NULL); unif = (struct unif_record *)urec; } to_visit->start0 = pt0; to_visit->end0 = pt0_end; to_visit->start1 = pt1; #ifdef RATIONAL_TREES unif[-1].old = *pt0; unif[-1].ptr = pt0; *pt0 = d1; #endif } pt0_end = (pt0 = RepPair(d0) - 1) + 2; pt1 = RepPair(d1) - 1; continue; } if (IsApplTerm(d0)) { register Functor f; register CELL *ap2, *ap3; if (!IsApplTerm(d1)) { goto cufail; } /* store the terms to visit */ ap2 = RepAppl(d0); ap3 = RepAppl(d1); f = (Functor) (*ap2); /* compare functors */ if (f != (Functor) *ap3) goto cufail; if (IsExtensionFunctor(f)) { if (unify_extension(f, d0, ap2, d1)) continue; goto cufail; } /* now link the two structures so that no one else will */ /* come here */ /* store the terms to visit */ if (RATIONAL_TREES || pt0 < pt0_end) { to_visit --; #ifdef RATIONAL_TREES unif++; #endif if ((void *)to_visit < (void *)unif) { CELL **urec = (CELL **)unif; to_visit = (struct v_record *)Yap_shift_visit((CELL **)to_visit, &urec, NULL); unif = (struct unif_record *)urec; } to_visit->start0 = pt0; to_visit->end0 = pt0_end; to_visit->start1 = pt1; #ifdef RATIONAL_TREES unif[-1].old = *pt0; unif[-1].ptr = pt0; *pt0 = d1; #endif } d0 = ArityOfFunctor(f); pt0 = ap2; pt0_end = ap2 + d0; pt1 = ap3; continue; } goto cufail; derefa_body(d1, ptd1, unifiable_comp_nvar_unk, unifiable_comp_nvar_nvar); /* d1 and pt2 have the unbound value, whereas d0 is bound */ *(ptd1) = d0; DO_TRAIL(ptd1, d0); continue; } derefa_body(d0, ptd0, unifiable_comp_unk, unifiable_comp_nvar); /* first arg var */ { register CELL d1; register CELL *ptd1; ptd1 = pt1; d1 = ptd1[0]; /* pt2 is unbound */ deref_head(d1, unifiable_comp_var_unk); unifiable_comp_var_nvar: /* pt2 is unbound and d1 is bound */ *ptd0 = d1; DO_TRAIL(ptd0, d1); continue; derefa_body(d1, ptd1, unifiable_comp_var_unk, unifiable_comp_var_nvar); /* ptd0 and ptd1 are unbound */ UnifyAndTrailGlobalCells(ptd0, ptd1); } } /* Do we still have compound terms to visit */ if (to_visit < to_visit_base) { pt0 = to_visit->start0; pt0_end = to_visit->end0; pt1 = to_visit->start1; to_visit++; goto loop; } #ifdef RATIONAL_TREES /* restore bindigs */ while (unif-- != unif_base) { CELL *pt0; pt0 = unif->ptr; *pt0 = unif->old; } #endif return TRUE; cufail: #ifdef RATIONAL_TREES /* restore bindigs */ while (unif-- != unif_base) { CELL *pt0; pt0 = unif->ptr; *pt0 = unif->old; } #endif return FALSE; #ifdef THREADS #undef Yap_REGS #define Yap_REGS (*Yap_regp) #elif defined(SHADOW_REGS) #if defined(B) || defined(TR) #undef Yap_REGS #endif /* defined(B) || defined(TR) */ #endif }
static int unifiable(CELL d0, CELL d1) { CACHE_REGS #if THREADS #undef Yap_REGS register REGSTORE *regp = Yap_regp; #define Yap_REGS (*regp) #elif SHADOW_REGS #if defined(B) || defined(TR) register REGSTORE *regp = &Yap_REGS; #define Yap_REGS (*regp) #endif /* defined(B) || defined(TR) */ #endif #if SHADOW_HB register CELL *HBREG = HB; #endif register CELL *pt0, *pt1; deref_head(d0, unifiable_unk); unifiable_nvar: /* d0 is bound */ deref_head(d1, unifiable_nvar_unk); unifiable_nvar_nvar: /* both arguments are bound */ if (d0 == d1) return TRUE; if (IsPairTerm(d0)) { if (!IsPairTerm(d1)) { return (FALSE); } pt0 = RepPair(d0); pt1 = RepPair(d1); return (unifiable_complex(pt0 - 1, pt0 + 1, pt1 - 1)); } else if (IsApplTerm(d0)) { pt0 = RepAppl(d0); d0 = *pt0; if (!IsApplTerm(d1)) return (FALSE); pt1 = RepAppl(d1); d1 = *pt1; if (d0 != d1) { return (FALSE); } else { if (IsExtensionFunctor((Functor)d0)) { switch(d0) { case (CELL)FunctorDBRef: return(pt0 == pt1); case (CELL)FunctorLongInt: return(pt0[1] == pt1[1]); case (CELL)FunctorString: return(strcmp( (const char *)(pt0+2), (const char *)(pt1+2)) == 0); case (CELL)FunctorDouble: return(FloatOfTerm(AbsAppl(pt0)) == FloatOfTerm(AbsAppl(pt1))); #ifdef USE_GMP case (CELL)FunctorBigInt: return(Yap_gmp_tcmp_big_big(AbsAppl(pt0),AbsAppl(pt0)) == 0); #endif /* USE_GMP */ default: return(FALSE); } } return (unifiable_complex(pt0, pt0 + ArityOfFunctor((Functor) d0), pt1)); } } else { return (FALSE); } deref_body(d1, pt1, unifiable_nvar_unk, unifiable_nvar_nvar); /* d0 is bound and d1 is unbound */ *(pt1) = d0; DO_TRAIL(pt1, d0); return (TRUE); deref_body(d0, pt0, unifiable_unk, unifiable_nvar); /* pt0 is unbound */ deref_head(d1, unifiable_var_unk); unifiable_var_nvar: /* pt0 is unbound and d1 is bound */ *pt0 = d1; DO_TRAIL(pt0, d1); return TRUE; deref_body(d1, pt1, unifiable_var_unk, unifiable_var_nvar); /* d0 and pt1 are unbound */ UnifyAndTrailCells(pt0, pt1); return (TRUE); #if THREADS #undef Yap_REGS #define Yap_REGS (*Yap_regp) #elif SHADOW_REGS #if defined(B) || defined(TR) #undef Yap_REGS #endif /* defined(B) || defined(TR) */ #endif }
static void share_private_nodes(int worker_q) { int depth; choiceptr AuxB; or_fr_ptr or_frame, previous_or_frame; /* initialize auxiliary variables */ AuxB = B; previous_or_frame = NULL; depth = OrFr_depth(LOCAL_top_or_fr); /* sharing loop */ while (AuxB != LOCAL_top_cp) { depth++; ALLOC_OR_FRAME(or_frame); INIT_LOCK(OrFr_lock(or_frame)); OrFr_node(or_frame) = AuxB; OrFr_alternative(or_frame) = AuxB->cp_ap; OrFr_pend_prune_cp(or_frame) = NULL; OrFr_nearest_leftnode(or_frame) = LOCAL_top_or_fr; OrFr_qg_solutions(or_frame) = NULL; BITMAP_clear(OrFr_members(or_frame)); BITMAP_insert(OrFr_members(or_frame), worker_id); BITMAP_insert(OrFr_members(or_frame), worker_q); if (AuxB->cp_ap && YAMOP_SEQ(AuxB->cp_ap)) { AuxB->cp_ap = GETWORK_SEQ; } else { AuxB->cp_ap = GETWORK; } AuxB->cp_or_fr = or_frame; AuxB = AuxB->cp_b; if (previous_or_frame) { OrFr_nearest_livenode(previous_or_frame) = OrFr_next(previous_or_frame) = or_frame; } previous_or_frame = or_frame; } /* initialize last or-frame pointer */ or_frame = AuxB->cp_or_fr; if (previous_or_frame) { OrFr_nearest_livenode(previous_or_frame) = OrFr_next(previous_or_frame) = or_frame; } /* update depth */ if (depth >= MAX_BRANCH_DEPTH) Yap_Error(INTERNAL_ERROR, TermNil, "maximum depth exceded (share_private_nodes)"); or_frame = B->cp_or_fr; while (or_frame != LOCAL_top_or_fr) { unsigned int branch; if (OrFr_alternative(or_frame)) { branch = YAMOP_OR_ARG(OrFr_alternative(or_frame)) + 1; } else { branch = 1; } branch |= YAMOP_CUT_FLAG; /* in doubt, assume cut */ BRANCH(worker_id, depth) = BRANCH(worker_q, depth) = branch; OrFr_depth(or_frame) = depth--; or_frame = OrFr_next_on_stack(or_frame); } /* update old shared nodes */ while (or_frame != REMOTE_top_or_fr(worker_q)) { LOCK_OR_FRAME(or_frame); BRANCH(worker_q, OrFr_depth(or_frame)) = BRANCH(worker_id, OrFr_depth(or_frame)); BITMAP_insert(OrFr_members(or_frame), worker_q); UNLOCK_OR_FRAME(or_frame); or_frame = OrFr_next_on_stack(or_frame); } /* move conditional bindings to BA */ { tr_fr_ptr top, tr_ptr; top = LOCAL_top_cp->cp_tr; tr_ptr = TR; while (tr_ptr != top) { CELL aux_cell = TrailTerm(--tr_ptr); if (IsVarTerm(aux_cell) && ((CELL *)aux_cell < B->cp_h || (choiceptr)aux_cell > B) && !((CELL *)aux_cell < H_FZ || (choiceptr)aux_cell > B_FZ)) { CELL *ptr = STACK_TO_SBA(aux_cell); *ptr = TrailVal(tr_ptr); *(CELL *)aux_cell = (CELL)ptr; } else if (IsPairTerm(aux_cell) && (ADDR) RepPair(aux_cell) > HeapTop) { /* avoid frozen segments */ aux_cell = (CELL) RepPair(aux_cell); tr_ptr = (tr_fr_ptr) aux_cell; #ifdef MULTI_ASSIGNMENT_VARIABLES } else { CELL *cell_ptr = RepAppl(aux_cell); /* first do as a for a standard cell */ if ((cell_ptr < B->cp_h || cell_ptr > (CELL *)B) && !(cell_ptr < H_FZ || (choiceptr)cell_ptr > B_FZ)) { CELL *ptr = STACK_TO_SBA(cell_ptr); /* we may have several bindings in the trail */ if ((CELL)ptr != *cell_ptr) { *ptr = TrailVal(tr_ptr); *cell_ptr = (CELL)ptr; } } /* but we also need to skip the old value */ tr_ptr--; #endif /* MULTI_ASSIGNMENT_VARIABLES */ } } } /* update frozen registers */ B_FZ = B; H_FZ = B->cp_h; TR_FZ = B->cp_tr; /* update top shared nodes */ REMOTE_top_cp(worker_q) = LOCAL_top_cp = B; REMOTE_top_or_fr(worker_q) = LOCAL_top_or_fr = LOCAL_top_cp->cp_or_fr; /* update prune request */ if (LOCAL_prune_request) { CUT_send_prune_request(worker_q, LOCAL_prune_request); } /* update load and return */ REMOTE_load(worker_q) = LOCAL_load = 0; }
inline static Int compare(Term t1, Term t2) /* compare terms t1 and t2 */ { if (t1 == t2) return 0; if (IsVarTerm(t1)) { if (IsVarTerm(t2)) return Signed(t1) - Signed(t2); return -1; } else if (IsVarTerm(t2)) { /* get rid of variables */ return 1; } if (IsAtomOrIntTerm(t1)) { if (IsAtomTerm(t1)) { if (IsAtomTerm(t2)) return cmp_atoms(AtomOfTerm(t1), AtomOfTerm(t2)); if (IsPrimitiveTerm(t2)) return 1; if (IsStringTerm(t2)) return 1; return -1; } else { if (IsIntTerm(t2)) { return IntOfTerm(t1) - IntOfTerm(t2); } if (IsApplTerm(t2)) { Functor fun2 = FunctorOfTerm(t2); switch ((CELL)fun2) { case double_e: return 1; case long_int_e: return IntOfTerm(t1) - LongIntOfTerm(t2); #ifdef USE_GMP case big_int_e: return Yap_gmp_tcmp_int_big(IntOfTerm(t1), t2); #endif case db_ref_e: return 1; case string_e: return -1; } } return -1; } } else if (IsPairTerm(t1)) { if (IsApplTerm(t2)) { Functor f = FunctorOfTerm(t2); if (IsExtensionFunctor(f)) return 1; else { if (f != FunctorDot) return strcmp(".", RepAtom(NameOfFunctor(f))->StrOfAE); else { return compare_complex(RepPair(t1) - 1, RepPair(t1) + 1, RepAppl(t2)); } } } if (IsPairTerm(t2)) { return ( compare_complex(RepPair(t1) - 1, RepPair(t1) + 1, RepPair(t2) - 1)); } else return 1; } else { /* compound term */ Functor fun1 = FunctorOfTerm(t1); if (IsExtensionFunctor(fun1)) { /* float, long, big, dbref */ switch ((CELL)fun1) { case double_e: { if (IsFloatTerm(t2)) return (rfloat(FloatOfTerm(t1) - FloatOfTerm(t2))); if (IsRefTerm(t2)) return 1; return -1; } case long_int_e: { if (IsIntTerm(t2)) return LongIntOfTerm(t1) - IntOfTerm(t2); if (IsFloatTerm(t2)) { return 1; } if (IsLongIntTerm(t2)) return LongIntOfTerm(t1) - LongIntOfTerm(t2); #ifdef USE_GMP if (IsBigIntTerm(t2)) { return Yap_gmp_tcmp_int_big(LongIntOfTerm(t1), t2); } #endif if (IsRefTerm(t2)) return 1; return -1; } #ifdef USE_GMP case big_int_e: { if (IsIntTerm(t2)) return Yap_gmp_tcmp_big_int(t1, IntOfTerm(t2)); if (IsFloatTerm(t2)) { return 1; } if (IsLongIntTerm(t2)) return Yap_gmp_tcmp_big_int(t1, LongIntOfTerm(t2)); if (IsBigIntTerm(t2)) { return Yap_gmp_tcmp_big_big(t1, t2); } if (IsRefTerm(t2)) return 1; return -1; } #endif case string_e: { if (IsApplTerm(t2)) { Functor fun2 = FunctorOfTerm(t2); switch ((CELL)fun2) { case double_e: return 1; case long_int_e: return 1; #ifdef USE_GMP case big_int_e: return 1; #endif case db_ref_e: return 1; case string_e: return strcmp((char *)StringOfTerm(t1), (char *)StringOfTerm(t2)); } return -1; } return -1; } case db_ref_e: if (IsRefTerm(t2)) return Unsigned(RefOfTerm(t2)) - Unsigned(RefOfTerm(t1)); return -1; } } if (!IsApplTerm(t2)) { if (IsPairTerm(t2)) { Int out; Functor f = FunctorOfTerm(t1); if (!(out = ArityOfFunctor(f)) - 2) out = strcmp((char *)RepAtom(NameOfFunctor(f))->StrOfAE, "."); return out; } return 1; } else { Functor fun2 = FunctorOfTerm(t2); Int r; if (IsExtensionFunctor(fun2)) { return 1; } r = ArityOfFunctor(fun1) - ArityOfFunctor(fun2); if (r) return r; r = cmp_atoms(NameOfFunctor(fun1), NameOfFunctor(fun2)); if (r) return r; else return (compare_complex(RepAppl(t1), RepAppl(t1) + ArityOfFunctor(fun1), RepAppl(t2))); } } }
static Int p_setarg( USES_REGS1 ) { CELL ti = Deref(ARG1), ts = Deref(ARG2), t3 = Deref(ARG3); Int i; if (IsVarTerm(t3) && VarOfTerm(t3) > H &&VarOfTerm(t3) < ASP) { /* local variable */ Term tn = MkVarTerm(); Bind_Local(VarOfTerm(t3), tn); t3 = tn; } if (IsVarTerm(ti)) { Yap_Error(INSTANTIATION_ERROR,ti,"setarg/3"); return FALSE; } else { if (IsIntTerm(ti)) i = IntOfTerm(ti); else { Term te = Yap_Eval(ti); if (IsIntegerTerm(te)) { i = IntegerOfTerm(te); } else { Yap_Error(TYPE_ERROR_INTEGER,ti,"setarg/3"); return FALSE; } } } if (IsVarTerm(ts)) { Yap_Error(INSTANTIATION_ERROR,ts,"setarg/3"); } else if(IsApplTerm(ts)) { CELL *pt; if (IsExtensionFunctor(FunctorOfTerm(ts))) { Yap_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3"); return FALSE; } if (i < 1 || i > (Int)ArityOfFunctor(FunctorOfTerm(ts))) { if (i<0) Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3"); return FALSE; if (i==0) Yap_Error(DOMAIN_ERROR_NOT_ZERO,ts,"setarg/3"); return FALSE; } pt = RepAppl(ts)+i; /* the evil deed is to be done now */ MaBind(pt, t3); } else if(IsPairTerm(ts)) { CELL *pt; if (i < 1 || i > 2) { if (i<0) Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3"); return FALSE; } pt = RepPair(ts)+i-1; /* the evil deed is to be done now */ MaBind(pt, t3); } else { Yap_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3"); return FALSE; } return TRUE; }
static Int compare_complex(register CELL *pt0, register CELL *pt0_end, register CELL *pt1) { CACHE_REGS register CELL **to_visit = (CELL **)HR; register Int out = 0; loop: while (pt0 < pt0_end) { register CELL d0, d1; ++pt0; ++pt1; d0 = Derefa(pt0); d1 = Derefa(pt1); if (IsVarTerm(d0)) { if (IsVarTerm(d1)) { out = Signed(d0) - Signed(d1); if (out) goto done; } else { out = -1; goto done; } } else if (IsVarTerm(d1)) { out = 1; goto done; } else { if (d0 == d1) continue; else if (IsAtomTerm(d0)) { if (IsAtomTerm(d1)) out = cmp_atoms(AtomOfTerm(d0), AtomOfTerm(d1)); else if (IsPrimitiveTerm(d1)) out = 1; else out = -1; /* I know out must be != 0 */ goto done; } else if (IsIntTerm(d0)) { if (IsIntTerm(d1)) out = IntOfTerm(d0) - IntOfTerm(d1); else if (IsFloatTerm(d1)) { out = 1; } else if (IsLongIntTerm(d1)) { out = IntOfTerm(d0) - LongIntOfTerm(d1); #ifdef USE_GMP } else if (IsBigIntTerm(d1)) { out = Yap_gmp_tcmp_int_big(IntOfTerm(d0), d1); #endif } else if (IsRefTerm(d1)) out = 1; else out = -1; if (out != 0) goto done; } else if (IsFloatTerm(d0)) { if (IsFloatTerm(d1)) { out = rfloat(FloatOfTerm(d0) - FloatOfTerm(d1)); } else if (IsRefTerm(d1)) { out = 1; } else { out = -1; } if (out != 0) goto done; } else if (IsStringTerm(d0)) { if (IsStringTerm(d1)) { out = strcmp((char *)StringOfTerm(d0), (char *)StringOfTerm(d1)); } else if (IsIntTerm(d1)) out = 1; else if (IsFloatTerm(d1)) { out = 1; } else if (IsLongIntTerm(d1)) { out = 1; #ifdef USE_GMP } else if (IsBigIntTerm(d1)) { out = 1; #endif } else if (IsRefTerm(d1)) { out = 1; } else { out = -1; } if (out != 0) goto done; } else if (IsLongIntTerm(d0)) { if (IsIntTerm(d1)) out = LongIntOfTerm(d0) - IntOfTerm(d1); else if (IsFloatTerm(d1)) { out = 1; } else if (IsLongIntTerm(d1)) { out = LongIntOfTerm(d0) - LongIntOfTerm(d1); #ifdef USE_GMP } else if (IsBigIntTerm(d1)) { out = Yap_gmp_tcmp_int_big(LongIntOfTerm(d0), d1); #endif } else if (IsRefTerm(d1)) { out = 1; } else { out = -1; } if (out != 0) goto done; } #ifdef USE_GMP else if (IsBigIntTerm(d0)) { if (IsIntTerm(d1)) { out = Yap_gmp_tcmp_big_int(d0, IntOfTerm(d1)); } else if (IsFloatTerm(d1)) { out = 1; } else if (IsLongIntTerm(d1)) { out = Yap_gmp_tcmp_big_int(d0, LongIntOfTerm(d1)); } else if (IsBigIntTerm(d1)) { out = Yap_gmp_tcmp_big_big(d0, d1); } else if (IsRefTerm(d1)) out = 1; else out = -1; if (out != 0) goto done; } #endif else if (IsPairTerm(d0)) { if (!IsPairTerm(d1)) { if (IsApplTerm(d1)) { Functor f = FunctorOfTerm(d1); if (IsExtensionFunctor(f)) out = 1; else if (!(out = 2 - ArityOfFunctor(f))) out = strcmp(".", (char *)RepAtom(NameOfFunctor(f))->StrOfAE); } else out = 1; goto done; } #ifdef RATIONAL_TREES to_visit[0] = pt0; to_visit[1] = pt0_end; to_visit[2] = pt1; to_visit[3] = (CELL *)*pt0; to_visit += 4; *pt0 = d1; #else /* store the terms to visit */ if (pt0 < pt0_end) { to_visit[0] = pt0; to_visit[1] = pt0_end; to_visit[2] = pt1; to_visit += 3; } #endif pt0 = RepPair(d0) - 1; pt0_end = RepPair(d0) + 1; pt1 = RepPair(d1) - 1; continue; } else if (IsRefTerm(d0)) { if (IsRefTerm(d1)) out = Unsigned(RefOfTerm(d1)) - Unsigned(RefOfTerm(d0)); else out = -1; goto done; } else if (IsApplTerm(d0)) { register Functor f; register CELL *ap2, *ap3; if (!IsApplTerm(d1)) { out = 1; goto done; } else { /* store the terms to visit */ Functor f2; ap2 = RepAppl(d0); ap3 = RepAppl(d1); f = (Functor)(*ap2); if (IsExtensionFunctor(f)) { out = 1; goto done; } f2 = (Functor)(*ap3); if (IsExtensionFunctor(f2)) { out = -1; goto done; } /* compare functors */ if (f != (Functor)*ap3) { if (!(out = ArityOfFunctor(f) - ArityOfFunctor(f2))) out = cmp_atoms(NameOfFunctor(f), NameOfFunctor(f2)); goto done; } #ifdef RATIONAL_TREES to_visit[0] = pt0; to_visit[1] = pt0_end; to_visit[2] = pt1; to_visit[3] = (CELL *)*pt0; to_visit += 4; *pt0 = d1; #else /* store the terms to visit */ if (pt0 < pt0_end) { to_visit[0] = pt0; to_visit[1] = pt0_end; to_visit[2] = pt1; to_visit += 3; } #endif d0 = ArityOfFunctor(f); pt0 = ap2; pt0_end = ap2 + d0; pt1 = ap3; continue; } } } } /* Do we still have compound terms to visit */ if (to_visit > (CELL **)HR) { #ifdef RATIONAL_TREES to_visit -= 4; pt0 = to_visit[0]; pt0_end = to_visit[1]; pt1 = to_visit[2]; *pt0 = (CELL)to_visit[3]; #else to_visit -= 3; pt0 = to_visit[0]; pt0_end = to_visit[1]; pt1 = to_visit[2]; #endif goto loop; } done: /* failure */ #ifdef RATIONAL_TREES while (to_visit > (CELL **)HR) { to_visit -= 4; pt0 = to_visit[0]; pt0_end = to_visit[1]; pt1 = to_visit[2]; *pt0 = (CELL)to_visit[3]; } #endif return (out); }
int Yap_rational_tree_loop(CELL *pt0, CELL *pt0_end, CELL **to_visit, CELL **to_visit_max) { CELL ** base = to_visit; rtree_loop: while (pt0 < pt0_end) { register CELL *ptd0; register CELL d0; ptd0 = ++pt0; pt0 = ptd0; d0 = *ptd0; deref_head(d0, rtree_loop_unk); rtree_loop_nvar: { if (d0 == TermFoundVar) goto cufail; if (IsPairTerm(d0)) { to_visit -= 3; if (to_visit < to_visit_max) { to_visit = Yap_shift_visit(to_visit, &to_visit_max, &base); } to_visit[0] = pt0; to_visit[1] = pt0_end; to_visit[2] = (CELL *)*pt0; *pt0 = TermFoundVar; pt0_end = (pt0 = RepPair(d0) - 1) + 2; continue; } if (IsApplTerm(d0)) { register Functor f; register CELL *ap2; /* store the terms to visit */ ap2 = RepAppl(d0); f = (Functor) (*ap2); /* compare functors */ if (IsExtensionFunctor(f)) { continue; } to_visit -= 3; if (to_visit < to_visit_max) { to_visit = Yap_shift_visit(to_visit, &to_visit_max, &base); } to_visit[0] = pt0; to_visit[1] = pt0_end; to_visit[2] = (CELL *)*pt0; *pt0 = TermFoundVar; d0 = ArityOfFunctor(f); pt0 = ap2; pt0_end = ap2 + d0; continue; } continue; } derefa_body(d0, ptd0, rtree_loop_unk, rtree_loop_nvar); } /* Do we still have compound terms to visit */ if (to_visit < base) { pt0 = to_visit[0]; pt0_end = to_visit[1]; *pt0 = (CELL)to_visit[2]; to_visit += 3; goto rtree_loop; } return FALSE; cufail: /* we found an infinite term */ while (to_visit < (CELL **)base) { CELL *pt0; pt0 = to_visit[0]; *pt0 = (CELL)to_visit[2]; to_visit += 3; } return TRUE; }
static Term Eval(Term t USES_REGS) { if (IsVarTerm(t)) { return Yap_ArithError(INSTANTIATION_ERROR,t,"in arithmetic"); } else if (IsNumTerm(t)) { return t; } else if (IsAtomTerm(t)) { ExpEntry *p; Atom name = AtomOfTerm(t); if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 0)))) { /* error */ Term ti[2]; /* error */ ti[0] = t; ti[1] = MkIntTerm(0); t = Yap_MkApplTerm(FunctorSlash, 2, ti); return Yap_ArithError(TYPE_ERROR_EVALUABLE, t, "atom %s in arithmetic expression", RepAtom(name)->StrOfAE); } return Yap_eval_atom(p->FOfEE); } else if (IsApplTerm(t)) { Functor fun = FunctorOfTerm(t); if (fun == FunctorString) { const char *s = StringOfTerm(t); if (s[1] == '\0') return MkIntegerTerm(s[0]); return Yap_ArithError(TYPE_ERROR_EVALUABLE, t, "string in arithmetic expression"); } else if ((Atom)fun == AtomFoundVar) { return Yap_ArithError(TYPE_ERROR_EVALUABLE, TermNil, "cyclic term in arithmetic expression"); } else { Int n = ArityOfFunctor(fun); Atom name = NameOfFunctor(fun); ExpEntry *p; Term t1, t2; if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, n)))) { Term ti[2]; /* error */ ti[0] = t; ti[1] = MkIntegerTerm(n); t = Yap_MkApplTerm(FunctorSlash, 2, ti); return Yap_ArithError(TYPE_ERROR_EVALUABLE, t, "functor %s/%d for arithmetic expression", RepAtom(name)->StrOfAE,n); } if (p->FOfEE == op_power && p->ArityOfEE == 2) { t2 = ArgOfTerm(2, t); if (IsPairTerm(t2)) { return get_matrix_element(ArgOfTerm(1, t), t2 PASS_REGS); } } *RepAppl(t) = (CELL)AtomFoundVar; t1 = Eval(ArgOfTerm(1,t) PASS_REGS); if (t1 == 0L) { *RepAppl(t) = (CELL)fun; return FALSE; } if (n == 1) { *RepAppl(t) = (CELL)fun; return Yap_eval_unary(p->FOfEE, t1); } t2 = Eval(ArgOfTerm(2,t) PASS_REGS); *RepAppl(t) = (CELL)fun; if (t2 == 0L) return FALSE; return Yap_eval_binary(p->FOfEE,t1,t2); } } /* else if (IsPairTerm(t)) */ { if (TailOfTerm(t) != TermNil) { return Yap_ArithError(TYPE_ERROR_EVALUABLE, t, "string must contain a single character to be evaluated as an arithmetic expression"); } return Eval(HeadOfTerm(t) PASS_REGS); } }
xarg * Yap_ArgListToVector (Term listl, const param_t *def, int n) { CACHE_REGS xarg *a = calloc( n , sizeof(xarg) ); if (IsApplTerm(listl) && FunctorOfTerm(listl) == FunctorModule) listl = ArgOfTerm(2,listl); if (!IsPairTerm(listl) && listl != TermNil) { if (IsVarTerm(listl) ) { free( a ); LOCAL_Error_TYPE = INSTANTIATION_ERROR; LOCAL_Error_Term = listl; return NULL; } if (IsAtomTerm(listl) ) { xarg *na = matchKey( AtomOfTerm(listl), a, n, def); if (!na) { free( a ); LOCAL_Error_TYPE = TYPE_ERROR_LIST; LOCAL_Error_Term = listl; return NULL; } } else if (IsApplTerm(listl)) { Functor f = FunctorOfTerm( listl ); if (IsExtensionFunctor(f)) { free( a ); LOCAL_Error_TYPE = TYPE_ERROR_LIST; LOCAL_Error_Term = listl; return NULL; } arity_t arity = ArityOfFunctor( f ); if (arity != 1) { free( a ); LOCAL_Error_TYPE = TYPE_ERROR_LIST; LOCAL_Error_Term = listl; return NULL; } xarg *na = matchKey( NameOfFunctor( f ), a, n, def); if (!na) { free( a ); LOCAL_Error_TYPE = TYPE_ERROR_LIST; LOCAL_Error_Term = listl; return NULL; } } else { free( a ); LOCAL_Error_TYPE = TYPE_ERROR_LIST; LOCAL_Error_Term = listl; return NULL; } listl = MkPairTerm( listl, TermNil ); } while (IsPairTerm(listl)) { Term hd = HeadOfTerm( listl ); listl = TailOfTerm( listl ); if (IsVarTerm(hd) || IsVarTerm(listl)) { LOCAL_Error_TYPE = INSTANTIATION_ERROR; if (IsVarTerm(hd)) { LOCAL_Error_Term = hd; } else { LOCAL_Error_Term = listl; } free( a ); return NULL; } if (IsAtomTerm(hd)) { xarg *na = matchKey( AtomOfTerm( hd ), a, n, def); if (!na) return NULL; na->used = true; na->tvalue = TermNil; continue; } else if (IsApplTerm( hd )) { Functor f = FunctorOfTerm( hd ); if (IsExtensionFunctor(f)) { LOCAL_Error_TYPE = TYPE_ERROR_PARAMETER; LOCAL_Error_Term = hd; free( a ); return NULL; } arity_t arity = ArityOfFunctor( f ); if (arity != 1) { LOCAL_Error_TYPE = DOMAIN_ERROR_OUT_OF_RANGE; LOCAL_Error_Term = hd; free( a ); return NULL; } xarg *na = matchKey( NameOfFunctor( f ), a, n, def); if (!na) { free( a ); return NULL; } na->used = 1; na->tvalue = ArgOfTerm(1, hd); } else { LOCAL_Error_TYPE = TYPE_ERROR_PARAMETER; free( a ); return NULL; } } if (IsVarTerm(listl)) { LOCAL_Error_TYPE = INSTANTIATION_ERROR; LOCAL_Error_Term = listl; free( a ); return NULL; } else if (listl != TermNil) { LOCAL_Error_TYPE = TYPE_ERROR_LIST; LOCAL_Error_Term = listl; free( a ); return NULL; } return a; }