/*-------------------------------------------------------------------------* * PL_GET_PRED_INDICATOR * * * * returns the functor and initializes the arity of the predicate indicator* * func= -1 if it is a variable, arity= -1 if it is a variable * *-------------------------------------------------------------------------*/ int Pl_Get_Pred_Indicator(WamWord pred_indic_word, Bool must_be_ground, int *arity) { WamWord word, tag_mask; int func; DEREF(pred_indic_word, word, tag_mask); if (tag_mask == TAG_REF_MASK && must_be_ground) Pl_Err_Instantiation(); if (!Pl_Get_Structure(ATOM_CHAR('/'), 2, pred_indic_word)) { if (!Flag_Value(FLAG_STRICT_ISO) && Pl_Rd_Callable(word, &func, arity) != NULL) return func; Pl_Err_Type(pl_type_predicate_indicator, pred_indic_word); } pl_pi_name_word = Pl_Unify_Variable(); pl_pi_arity_word = Pl_Unify_Variable(); if (must_be_ground) func = Pl_Rd_Atom_Check(pl_pi_name_word); else { DEREF(pl_pi_name_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) func = -1; else func = Pl_Rd_Atom_Check(pl_pi_name_word); } if (must_be_ground) { *arity = Pl_Rd_Positive_Check(pl_pi_arity_word); if (*arity > MAX_ARITY) Pl_Err_Representation(pl_representation_max_arity); } else { DEREF(pl_pi_arity_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) *arity = -1; else { *arity = Pl_Rd_Positive_Check(pl_pi_arity_word); if (*arity > MAX_ARITY) Pl_Err_Representation(pl_representation_max_arity); } } return func; }
/*-------------------------------------------------------------------------* * PL_FD_DOM_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Dom_2(WamWord fdv_word, WamWord list_word) { WamWord word, tag_mask; WamWord *fdv_adr; int x, end; int vec_elem; Pl_Check_For_Un_List(list_word); Fd_Deref_Check_Fd_Var(fdv_word, word, tag_mask); if (tag_mask == TAG_INT_MASK) { x = UnTag_INT(word); if (!Pl_Get_List(list_word) || !Pl_Unify_Integer(x)) return FALSE; list_word = Pl_Unify_Variable(); } else { fdv_adr = UnTag_FDV(word); if (Is_Interval(Range(fdv_adr))) { end = Max(fdv_adr); for (x = Min(fdv_adr); x <= end; x++) { if (!Pl_Get_List(list_word) || !Pl_Unify_Integer(x)) return FALSE; list_word = Pl_Unify_Variable(); } } else { VECTOR_BEGIN_ENUM(Vec(fdv_adr), vec_elem); if (!Pl_Get_List(list_word) || !Pl_Unify_Integer(vec_elem)) return FALSE; list_word = Pl_Unify_Variable(); VECTOR_END_ENUM; } } return Pl_Get_Nil(list_word); }
/*-------------------------------------------------------------------------* * PL_STREAM_POSITION_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Stream_Position_2(WamWord sora_word, WamWord position_word) { WamWord word, tag_mask; WamWord p_word[4]; PlLong p[4]; int i; int stm; StmInf *pstm; stm = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_EXIST); pstm = pl_stm_tbl[stm]; Pl_Stream_Get_Position(pstm, p, p + 1, p + 2, p + 3); if (!Pl_Get_Structure(pl_atom_stream_position, 4, position_word)) dom_error: Pl_Err_Domain(pl_domain_stream_position, position_word); for (i = 0; i < 4; i++) { p_word[i] = Pl_Unify_Variable(); DEREF(p_word[i], word, tag_mask); if (tag_mask != TAG_REF_MASK && tag_mask != TAG_INT_MASK) goto dom_error; } for (i = 0; i < 4; i++) if (!Pl_Get_Integer(p[i], p_word[i])) return FALSE; return TRUE; }
/*-------------------------------------------------------------------------* * PL_TERM_VARIABLES_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Term_Variables_3(WamWord start_word, WamWord list_word, WamWord tail_word) { PlLong *p; /* only check if no Tail since if there is no vars in Term * then List = Tail and Tail can be any term */ if (tail_word == NOT_A_WAM_WORD) Pl_Check_For_Un_List(list_word); var_ptr = pl_glob_dico_var; /* pl_glob_dico_var: stores variables */ Pl_Treat_Vars_Of_Term(start_word, TRUE, Collect_Variable); for(p = pl_glob_dico_var; p < var_ptr; p++) { if (!Pl_Get_List(list_word) || !Pl_Unify_Value(*p)) return FALSE; list_word = Pl_Unify_Variable(); } if (tail_word == NOT_A_WAM_WORD) return Pl_Get_Nil(list_word); return Pl_Unify(list_word, tail_word); }
/*-------------------------------------------------------------------------* * PL_SET_STREAM_POSITION_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Set_Stream_Position_2(WamWord sora_word, WamWord position_word) { WamWord word, tag_mask; WamWord p_word[4]; int p[4]; int i; int stm; StmInf *pstm; stm = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_EXIST); pstm = pl_stm_tbl[stm]; if (!pstm->prop.reposition) Pl_Err_Permission(pl_permission_operation_reposition, pl_permission_type_stream, sora_word); DEREF(position_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (!Pl_Get_Structure(pl_atom_stream_position, 4, position_word)) dom_error: Pl_Err_Domain(pl_domain_stream_position, position_word); for (i = 0; i < 4; i++) { p_word[i] = Pl_Unify_Variable(); DEREF(p_word[i], word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask != TAG_INT_MASK) goto dom_error; p[i] = UnTag_INT(word); } return Pl_Stream_Set_Position(pstm, SEEK_SET, p[0], p[1], p[2], p[3]) == 0; }
/*-------------------------------------------------------------------------* * PL_BLT_UNIV * * * *-------------------------------------------------------------------------*/ Bool FC Pl_Blt_Univ(WamWord term_word, WamWord list_word) { WamWord word, tag_mask; WamWord *adr; WamWord car_word; int lst_length; WamWord *arg1_adr; WamWord *term_adr, *lst_adr, *stc_adr; WamWord functor_word, functor_tag; int functor; int arity; Pl_Set_C_Bip_Name("=..", 2); DEREF(term_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) goto list_to_term; /* from term to list functor+args */ if (tag_mask == TAG_LST_MASK) { adr = UnTag_LST(word); car_word = Tag_ATM(ATOM_CHAR('.')); lst_length = 1 + 2; arg1_adr = &Car(adr); } else if (tag_mask == TAG_STC_MASK) { adr = UnTag_STC(word); car_word = Tag_ATM(Functor(adr)); lst_length = 1 + Arity(adr); arg1_adr = &Arg(adr, 0); } #ifndef NO_USE_FD_SOLVER else if (tag_mask == TAG_FDV_MASK) { adr = UnTag_FDV(word); car_word = Tag_REF(adr); /* since Dont_Separate_Tag */ lst_length = 1 + 0; } #endif else /* TAG_ATM/INT/FLT_MASK */ { car_word = word; lst_length = 1 + 0; } Pl_Check_For_Un_List(list_word); Pl_Unset_C_Bip_Name(); for (;;) { if (!Pl_Get_List(list_word) || !Pl_Unify_Value(car_word)) return FALSE; list_word = Pl_Unify_Variable(); if (--lst_length == 0) break; car_word = *arg1_adr++; } return Pl_Get_Nil(list_word); /* from list functor+args to term */ list_to_term: term_adr = UnTag_REF(word); DEREF(list_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word == NIL_WORD) Pl_Err_Domain(pl_domain_non_empty_list, list_word); if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, list_word); lst_adr = UnTag_LST(word); DEREF(Car(lst_adr), functor_word, functor_tag); if (functor_tag == TAG_REF_MASK) Pl_Err_Instantiation(); DEREF(Cdr(lst_adr), word, tag_mask); if (word == NIL_WORD) { if (functor_tag != TAG_ATM_MASK && functor_tag != TAG_INT_MASK && functor_tag != TAG_FLT_MASK) Pl_Err_Type(pl_type_atomic, functor_word); term_word = functor_word; goto finish; } if (functor_tag != TAG_ATM_MASK) Pl_Err_Type(pl_type_atom, functor_word); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, list_word); functor = UnTag_ATM(functor_word); stc_adr = H; H++; /* space for f/n maybe lost if a list */ arity = 0; for (;;) { arity++; lst_adr = UnTag_LST(word); DEREF(Car(lst_adr), word, tag_mask); Do_Copy_Of_Word(tag_mask, word); /* since Dont_Separate_Tag */ Global_Push(word); DEREF(Cdr(lst_adr), word, tag_mask); if (word == NIL_WORD) break; if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, list_word); } if (arity > MAX_ARITY) Pl_Err_Representation(pl_representation_max_arity); if (functor == ATOM_CHAR('.') && arity == 2) /* a list */ term_word = Tag_LST(stc_adr + 1); else { *stc_adr = Functor_Arity(functor, arity); term_word = Tag_STC(stc_adr); } finish: Bind_UV(term_adr, term_word); Pl_Unset_C_Bip_Name(); return TRUE; }