/*-------------------------------------------------------------------------* * PL_TYPE_OF_TERM * * * *-------------------------------------------------------------------------*/ int Pl_Type_Of_Term(WamWord start_word) { WamWord word, tag_mask; DEREF(start_word, word, tag_mask); return Tag_From_Tag_Mask(tag_mask); }
/*-------------------------------------------------------------------------* * PL_TERM_SIZE * * * *-------------------------------------------------------------------------*/ int Pl_Term_Size(WamWord start_word) { WamWord word, tag_mask; WamWord *adr; int i; int n = 0; /* init to zero for terminal_rec */ terminal_rec: DEREF(start_word, word, tag_mask); switch (Tag_From_Tag_Mask(tag_mask)) { #ifndef NO_USE_FD_SOLVER case FDV: /* 1+ for <REF,->fdv_adr> since Dont_Separate_Tag */ return n + 1 + Fd_Variable_Size(UnTag_FDV(word)); #endif case FLT: #if WORD_SIZE == 32 return n + 1 + 2; #else return n + 1 + 1; #endif case LST: adr = UnTag_LST(word); adr = &Car(adr); n += 1 + Pl_Term_Size(*adr++); start_word = *adr; goto terminal_rec; case STC: adr = UnTag_STC(word); n += 2; /* tagged word + f_n */ i = Arity(adr); adr = &Arg(adr, 0); while (--i) n += Pl_Term_Size(*adr++); start_word = *adr; goto terminal_rec; default: return n + 1; } }
static void Show_List_Arg(int depth, WamWord *lst_adr) { WamWord word, tag_mask; terminal_rec: depth--; Show_Term(depth, MAX_ARG_OF_FUNCTOR_PREC, GENERAL_TERM, Car(lst_adr)); if (depth == 0) /* dots already written by Show_Term */ return; DEREF(Cdr(lst_adr), word, tag_mask); switch (Tag_From_Tag_Mask(tag_mask)) { case REF: SHOW_LIST_PIPE; Show_Global_Var(UnTag_REF(word)); break; case ATM: if (word != NIL_WORD) { SHOW_LIST_PIPE; if (Try_Portray(word)) return; Show_Atom(GENERAL_TERM, UnTag_ATM(word)); } break; #ifndef NO_USE_FD_SOLVER case FDV: SHOW_LIST_PIPE; if (Try_Portray(word)) return; Show_Fd_Variable(UnTag_FDV(word)); break; #endif case INT: SHOW_LIST_PIPE; if (Try_Portray(word)) return; Show_Integer(UnTag_INT(word)); break; case FLT: SHOW_LIST_PIPE; if (Try_Portray(word)) return; Show_Float(Pl_Obtain_Float(UnTag_FLT(word))); break; case LST: Out_Char(','); if (space_args) Out_Space(); lst_adr = UnTag_LST(word); goto terminal_rec; break; case STC: SHOW_LIST_PIPE; if (Try_Portray(word)) return; Show_Structure(depth, MAX_ARG_OF_FUNCTOR_PREC, GENERAL_TERM, UnTag_STC(word)); break; } }
/*-------------------------------------------------------------------------* * SHOW_TERM * * * *-------------------------------------------------------------------------*/ static void Show_Term(int depth, int prec, int context, WamWord term_word) { WamWord word, tag_mask; WamWord *adr; if (depth == 0) { Show_Atom(GENERAL_TERM, atom_dots); return; } DEREF(term_word, word, tag_mask); if (tag_mask != TAG_REF_MASK && Try_Portray(word)) return; switch (Tag_From_Tag_Mask(tag_mask)) { case REF: adr = UnTag_REF(word); if (Is_A_Local_Adr(adr)) { Globalize_Local_Unbound_Var(adr, word); adr = UnTag_REF(word); } Show_Global_Var(adr); break; case ATM: Show_Atom(context, UnTag_ATM(word)); break; #ifndef NO_USE_FD_SOLVER case FDV: Show_Fd_Variable(UnTag_FDV(word)); break; #endif case INT: Show_Integer(UnTag_INT(word)); break; case FLT: Show_Float(Pl_Obtain_Float(UnTag_FLT(word))); break; case LST: adr = UnTag_LST(word); if (ignore_op) { Out_String("'.'("); Show_Term(depth - 1, MAX_ARG_OF_FUNCTOR_PREC, GENERAL_TERM, Car(adr)); Out_Char(','); Show_Term(depth - 1, MAX_ARG_OF_FUNCTOR_PREC, GENERAL_TERM, Cdr(adr)); Out_Char(')'); } else { Out_Char('['); Show_List_Arg(depth, adr); Out_Char(']'); } break; case STC: adr = UnTag_STC(word); Show_Structure(depth, prec, context, adr); break; } }
/*-------------------------------------------------------------------------* * PL_TERM_COMPARE * * * *-------------------------------------------------------------------------*/ long Pl_Term_Compare(WamWord start_u_word, WamWord start_v_word) { WamWord u_word, u_tag_mask; WamWord v_word, v_tag_mask; WamWord u_tag, v_tag; int u_func, u_arity; WamWord *u_arg_adr; int v_func, v_arity; WamWord *v_arg_adr; int i, x; double d1, d2; DEREF(start_u_word, u_word, u_tag_mask); DEREF(start_v_word, v_word, v_tag_mask); u_tag = Tag_From_Tag_Mask(u_tag_mask); v_tag = Tag_From_Tag_Mask(v_tag_mask); switch (u_tag) { case REF: return (v_tag != REF) ? -1 : UnTag_REF(u_word) - UnTag_REF(v_word); #ifndef NO_USE_FD_SOLVER case FDV: if (v_tag == REF) return 1; return (v_tag != FDV) ? -1 : UnTag_FDV(u_word) - UnTag_FDV(v_word); #endif case FLT: if (v_tag == REF #ifndef NO_USE_FD_SOLVER || v_tag == FDV #endif ) return 1; if (v_tag != FLT) return -1; d1 = Pl_Obtain_Float(UnTag_FLT(u_word)); d2 = Pl_Obtain_Float(UnTag_FLT(v_word)); return (d1 < d2) ? -1 : (d1 == d2) ? 0 : 1; case INT: if (v_tag == REF || #ifndef NO_USE_FD_SOLVER v_tag == FDV || #endif v_tag == FLT) return 1; return (v_tag != INT) ? -1 : UnTag_INT(u_word) - UnTag_INT(v_word); case ATM: if (v_tag == REF || #ifndef NO_USE_FD_SOLVER v_tag == FDV || #endif v_tag == FLT || v_tag == INT) return 1; return (v_tag != ATM) ? -1 : strcmp(pl_atom_tbl[UnTag_ATM(u_word)].name, pl_atom_tbl[UnTag_ATM(v_word)].name); } /* u_tag == LST / STC */ v_arg_adr = Pl_Rd_Compound(v_word, &v_func, &v_arity); if (v_arg_adr == NULL) /* v_tag != LST / STC */ return 1; u_arg_adr = Pl_Rd_Compound(u_word, &u_func, &u_arity); if (u_arity != v_arity) return u_arity - v_arity; if (u_func != v_func) return strcmp(pl_atom_tbl[u_func].name, pl_atom_tbl[v_func].name); for (i = 0; i < u_arity; i++) if ((x = Pl_Term_Compare(*u_arg_adr++, *v_arg_adr++)) != 0) return x; return 0; }
/*-------------------------------------------------------------------------* * COPY_TERM_REC * * * * p is the next address to use to store the rest of a term. * *-------------------------------------------------------------------------*/ static void Copy_Term_Rec(WamWord *dst_adr, WamWord *src_adr, WamWord **p) { WamWord word, tag_mask; WamWord *adr; WamWord *q; int i; terminal_rec: DEREF(*src_adr, word, tag_mask); switch (Tag_From_Tag_Mask(tag_mask)) { case REF: adr = UnTag_REF(word); q = *p; if (adr < q && adr >= base_copy) /* already a copy */ { *dst_adr = word; return; } if (top_vars >= end_vars) Pl_Err_Representation(pl_representation_too_many_variables); *top_vars++ = word; /* word to restore */ *top_vars++ = (WamWord) adr; /* address to restore */ *adr = *dst_adr = Tag_REF(dst_adr); /* bind to a new copy */ return; #ifndef NO_USE_FD_SOLVER case FDV: adr = UnTag_FDV(word); q = *p; if (adr < q && adr >= base_copy) /* already a copy */ { *dst_adr = Tag_REF(adr); /* since Dont_Separate_Tag */ return; } if (top_vars >= end_vars) Pl_Err_Representation(pl_representation_too_many_variables); *top_vars++ = word; /* word to restore */ *top_vars++ = (WamWord) adr; /* address to restore */ q = *p; *p = q + Fd_Copy_Variable(q, adr); *adr = *dst_adr = Tag_REF(q); /* bind to a new copy */ return; #endif case FLT: adr = UnTag_FLT(word); q = *p; q[0] = adr[0]; #if WORD_SIZE == 32 q[1] = adr[1]; *p = q + 2; #else *p = q + 1; #endif *dst_adr = Tag_FLT(q); return; case LST: adr = UnTag_LST(word); q = *p; *dst_adr = Tag_LST(q); *p = &Cdr(q) + 1; q = &Car(q); adr = &Car(adr); Copy_Term_Rec(q++, adr++, p); dst_adr = q; src_adr = adr; goto terminal_rec; case STC: adr = UnTag_STC(word); q = *p; *dst_adr = Tag_STC(q); Functor_And_Arity(q) = Functor_And_Arity(adr); i = Arity(adr); *p = &Arg(q, i - 1) + 1; q = &Arg(q, 0); adr = &Arg(adr, 0); while (--i) Copy_Term_Rec(q++, adr++, p); dst_adr = q; src_adr = adr; goto terminal_rec; default: *dst_adr = word; return; } }