/*-------------------------------------------------------------------------* * PL_FD_PROLOG_TO_ARRAY_INT * * * *-------------------------------------------------------------------------*/ WamWord * Pl_Fd_Prolog_To_Array_Int(WamWord list_word) { WamWord word, tag_mask; WamWord save_list_word; WamWord *lst_adr; WamWord val; int n = 0; WamWord *array; WamWord *save_array; array = CS; save_list_word = list_word; save_array = array; array++; /* +1 for the nb of elems */ for (;;) { DEREF(list_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word == NIL_WORD) break; if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, save_list_word); lst_adr = UnTag_LST(word); DEREF(Car(lst_adr), word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask != TAG_INT_MASK) Pl_Err_Type(pl_type_integer, word); val = UnTag_INT(word); *array++ = val; n++; list_word = Cdr(lst_adr); } *save_array = n; CS = array; return save_array; }
/*-------------------------------------------------------------------------* * PL_FD_LIST_INT_TO_RANGE * * * *-------------------------------------------------------------------------*/ void Pl_Fd_List_Int_To_Range(Range *range, WamWord list_word) { WamWord word, tag_mask; WamWord save_list_word; WamWord *lst_adr; WamWord val; int n = 0; save_list_word = list_word; range->extra_cstr = FALSE; Vector_Allocate_If_Necessary(range->vec); Pl_Vector_Empty(range->vec); for (;;) { DEREF(list_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word == NIL_WORD) break; if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, save_list_word); lst_adr = UnTag_LST(word); DEREF(Car(lst_adr), word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask != TAG_INT_MASK) Pl_Err_Type(pl_type_integer, word); val = UnTag_INT(word); if ((unsigned) val > (unsigned) pl_vec_max_integer) range->extra_cstr = TRUE; else { Vector_Set_Value(range->vec, val); n++; } list_word = Cdr(lst_adr); } if (n == 0) Set_To_Empty(range); else Pl_Range_From_Vector(range); }
/*-------------------------------------------------------------------------* * PL_FD_PROLOG_TO_FD_VAR * * * *-------------------------------------------------------------------------*/ WamWord * Pl_Fd_Prolog_To_Fd_Var(WamWord arg_word, Bool pl_var_ok) { WamWord word, tag_mask; WamWord *adr, *fdv_adr; DEREF(arg_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) { if (!pl_var_ok) Pl_Err_Instantiation(); adr = UnTag_REF(word); fdv_adr = Pl_Fd_New_Variable(); Bind_UV(adr, Tag_REF(fdv_adr)); return fdv_adr; } if (tag_mask == TAG_INT_MASK) return Pl_Fd_New_Int_Variable(UnTag_INT(word)); if (tag_mask == TAG_FDV_MASK) return UnTag_FDV(word); Pl_Err_Type(pl_type_fd_variable, word); return NULL; }
/*-------------------------------------------------------------------------* * READ_ARG * * * *-------------------------------------------------------------------------*/ static WamWord Read_Arg(WamWord **lst_adr) { WamWord word, tag_mask; WamWord *adr; WamWord car_word; DEREF(**lst_adr, word, tag_mask); if (tag_mask != TAG_LST_MASK) { if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word == NIL_WORD) Pl_Err_Domain(pl_domain_non_empty_list, word); Pl_Err_Type(pl_type_list, word); } adr = UnTag_LST(word); car_word = Car(adr); *lst_adr = &Cdr(adr); DEREF(car_word, word, tag_mask); return word; }
/*-------------------------------------------------------------------------* * PL_SETARG_4 * * * *-------------------------------------------------------------------------*/ Bool Pl_Setarg_4(WamWord arg_no_word, WamWord term_word, WamWord new_value_word, WamWord undo_word) { WamWord word, tag_mask; int func, arity; int undo; WamWord *arg_adr; int arg_no; arg_adr = Pl_Rd_Compound_Check(term_word, &func, &arity); arg_no = Pl_Rd_Positive_Check(arg_no_word) - 1; undo = Pl_Rd_Boolean_Check(undo_word); DEREF(new_value_word, word, tag_mask); if (!undo && tag_mask != TAG_ATM_MASK && tag_mask != TAG_INT_MASK) Pl_Err_Type(pl_type_atomic, word); /* pl_type_atomic but float not allowed */ if ((unsigned) arg_no >= (unsigned) arity) return FALSE; if (undo) Bind_OV((arg_adr + arg_no), word); else arg_adr[arg_no] = word; return TRUE; }
/*-------------------------------------------------------------------------* * PL_NAME_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Name_2(WamWord atomic_word, WamWord codes_word) { WamWord word, tag_mask; int syn_flag; Bool is_number; char *str; DEREF(atomic_word, word, tag_mask); if (tag_mask == TAG_ATM_MASK) return Pl_Atom_Codes_2(word, codes_word); if (tag_mask == TAG_INT_MASK || tag_mask == TAG_FLT_MASK) return Pl_Number_Codes_2(word, codes_word); if (tag_mask != TAG_REF_MASK) Pl_Err_Type(pl_type_atomic, word); str = Pl_Rd_Codes_Check(codes_word); syn_flag = Flag_Value(syntax_error); Flag_Value(syntax_error) = PF_ERR_FAIL; is_number = String_To_Number(str, word); /* only fails on syn err */ Flag_Value(syntax_error) = syn_flag; if (is_number) return TRUE; return Pl_Un_String(str, word); }
/*-------------------------------------------------------------------------* * 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_CHECK_FOR_BOOL_VAR * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Check_For_Bool_Var(WamWord x_word) { WamWord word, tag_mask; WamWord *adr, *fdv_adr; Range range; DEREF(x_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) { adr = UnTag_REF(word); fdv_adr = Pl_Fd_New_Bool_Variable(); Bind_UV(adr, Tag_REF(fdv_adr)); return TRUE; } if (tag_mask == TAG_INT_MASK) return (unsigned long) (UnTag_INT(word)) <= 1; if (tag_mask != TAG_FDV_MASK) Pl_Err_Type(pl_type_fd_variable, word); fdv_adr = UnTag_FDV(word); if (Min(fdv_adr) > 1) return FALSE; if (Max(fdv_adr) <= 1) return TRUE; /* here max > 1 */ if (Min(fdv_adr) == 1) return Pl_Fd_Unify_With_Integer0(fdv_adr, 1); /* here min == 0 */ if (!Pl_Range_Test_Value(Range(fdv_adr), 1)) return Pl_Fd_Unify_With_Integer0(fdv_adr, 0); /* Check Bool == X in 0..1 */ Pl_Fd_Before_Add_Cstr(); if (Is_Sparse(Range(fdv_adr))) { Range_Init_Interval(&range, 0, 1); if (!Pl_Fd_Tell_Range_Range(fdv_adr, &range)) return FALSE; } else if (!Pl_Fd_Tell_Interv_Interv(fdv_adr, 0, 1)) return FALSE; return Pl_Fd_After_Add_Cstr(); }
/*-------------------------------------------------------------------------* * PL_FD_PROLOG_TO_VALUE * * * *-------------------------------------------------------------------------*/ int Pl_Fd_Prolog_To_Value(WamWord arg_word) { WamWord word, tag_mask; DEREF(arg_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask != TAG_INT_MASK) Pl_Err_Type(pl_type_integer, word); return UnTag_INT(word); }
/*-------------------------------------------------------------------------* * PL_NUMBER_ATOM_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Number_Atom_2(WamWord number_word, WamWord atom_word) { WamWord word, tag_mask; char *str; DEREF(atom_word, word, tag_mask); if (tag_mask == TAG_ATM_MASK) return String_To_Number(pl_atom_tbl[UnTag_ATM(word)].name, number_word); if (tag_mask != TAG_REF_MASK) Pl_Err_Type(pl_type_atom, word); DEREF(number_word, word, tag_mask); if (tag_mask == TAG_INT_MASK) { sprintf(pl_glob_buff, "%" PL_FMT_d, UnTag_INT(word)); return Pl_Un_String_Check(pl_glob_buff, atom_word); } str = Pl_Float_To_String(Pl_Rd_Number_Check(word)); return Pl_Un_String_Check(str, atom_word); }
/*-------------------------------------------------------------------------* * PL_FD_REIFIED_IN * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Reified_In(WamWord x_word, WamWord l_word, WamWord u_word, WamWord b_word) { WamWord word, tag_mask; WamWord b_tag_mask, x_tag_mask; WamWord *adr, *fdv_adr; PlLong x; PlLong b = -1; /* a var */ int min, max; int x_min, x_max; Range *r; // Bool pl_fd_domain(WamWord x_word, WamWord l_word, WamWord u_word); /* from fd_values_c.c (optimized version) */ Bool Pl_Fd_Domain_Interval(WamWord x_word, int min, int max); /* from fd_values_fd.fd */ Bool pl_fd_not_domain(WamWord x_word, WamWord l_word, WamWord u_word); min = Pl_Fd_Prolog_To_Value(l_word); if (min < 0) min = 0; max = Pl_Fd_Prolog_To_Value(u_word); DEREF(x_word, word, tag_mask); x_word = word; x_tag_mask = tag_mask; if (tag_mask != TAG_REF_MASK && tag_mask != TAG_FDV_MASK && tag_mask != TAG_INT_MASK) { err_type_fd: Pl_Err_Type(pl_type_fd_variable, word); return FALSE; } DEREF(b_word, word, tag_mask); b_word = word; b_tag_mask = tag_mask; if (tag_mask != TAG_REF_MASK && tag_mask != TAG_FDV_MASK && tag_mask != TAG_INT_MASK) goto err_type_fd; if (x_tag_mask == TAG_INT_MASK) { x = UnTag_INT(x_word); b = (x >= min) && (x <= max); unif_b: return Pl_Get_Integer(b, b_word); } if (b_tag_mask == TAG_INT_MASK) { b = UnTag_INT(b_word); if (b == 0) return pl_fd_not_domain(x_word, l_word, u_word); return (b == 1) && Pl_Fd_Domain_Interval(x_word, min, max); } if (x_tag_mask == TAG_REF_MASK) /* make an FD var */ { adr = UnTag_REF(x_word); fdv_adr = Pl_Fd_New_Variable(); Bind_UV(adr, Tag_REF(fdv_adr)); } else fdv_adr = UnTag_FDV(x_word); r = Range(fdv_adr); x_min = r->min; x_max = r->max; if (x_min >= min && x_max <= max) { b = 1; goto unif_b; } if (min > max || x_max < min || x_min > max) /* NB: if L..U is empty then B = 0 */ { b = 0; goto unif_b; } if (!Pl_Fd_Check_For_Bool_Var(b_word)) return FALSE; PRIM_CSTR_4(pl_truth_x_in_l_u, x_word, l_word, u_word, b_word); return TRUE; }
/*-------------------------------------------------------------------------* * PL_ATOM_CONCAT_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Atom_Concat_3(WamWord atom1_word, WamWord atom2_word, WamWord atom3_word) { WamWord word, tag_mask; int tag1, tag2, tag3; AtomInf *patom1, *patom2, *patom3; char *str; int l; DEREF(atom1_word, word, tag_mask); if (tag_mask != TAG_REF_MASK && tag_mask != TAG_ATM_MASK) Pl_Err_Type(pl_type_atom, atom1_word); tag1 = tag_mask; atom1_word = word; DEREF(atom2_word, word, tag_mask); if (tag_mask != TAG_REF_MASK && tag_mask != TAG_ATM_MASK) Pl_Err_Type(pl_type_atom, atom2_word); tag2 = tag_mask; atom2_word = word; DEREF(atom3_word, word, tag_mask); if (tag_mask != TAG_REF_MASK && tag_mask != TAG_ATM_MASK) Pl_Err_Type(pl_type_atom, atom3_word); tag3 = tag_mask; atom3_word = word; if (tag3 == TAG_REF_MASK && (tag1 == TAG_REF_MASK || tag2 == TAG_REF_MASK)) Pl_Err_Instantiation(); if (tag1 == TAG_ATM_MASK) { patom1 = pl_atom_tbl + UnTag_ATM(atom1_word); if (tag2 == TAG_ATM_MASK) { patom2 = pl_atom_tbl + UnTag_ATM(atom2_word); l = patom1->prop.length + patom2->prop.length; MALLOC_STR(l); strcpy(str, patom1->name); strcpy(str + patom1->prop.length, patom2->name); return Pl_Get_Atom(Create_Malloc_Atom(str), atom3_word); } patom3 = pl_atom_tbl + UnTag_ATM(atom3_word); l = patom3->prop.length - patom1->prop.length; if (l < 0 || strncmp(patom1->name, patom3->name, patom1->prop.length) != 0) return FALSE; MALLOC_STR(l); strcpy(str, patom3->name + patom1->prop.length); return Pl_Get_Atom(Create_Malloc_Atom(str), atom2_word); } if (tag2 == TAG_ATM_MASK) /* here tag1 == REF */ { patom2 = pl_atom_tbl + UnTag_ATM(atom2_word); patom3 = pl_atom_tbl + UnTag_ATM(atom3_word); l = patom3->prop.length - patom2->prop.length; if (l < 0 || strncmp(patom2->name, patom3->name + l, patom2->prop.length) != 0) return FALSE; MALLOC_STR(l); strncpy(str, patom3->name, l); str[l] = '\0'; return Pl_Get_Atom(Create_Malloc_Atom(str), atom1_word); } /* A1 and A2 are variables: non deterministic case */ patom3 = pl_atom_tbl + UnTag_ATM(atom3_word); if (patom3->prop.length > 0) { A(0) = atom1_word; A(1) = atom2_word; A(2) = (WamWord) patom3; A(3) = (WamWord) (patom3->name + 1); Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(ATOM_CONCAT_ALT, 0), 4); } return Pl_Get_Atom(pl_atom_void, atom1_word) && Pl_Get_Atom_Tagged(atom3_word, atom2_word); }
/*-------------------------------------------------------------------------* * PL_SUB_ATOM_5 * * * *-------------------------------------------------------------------------*/ Bool Pl_Sub_Atom_5(WamWord atom_word, WamWord before_word, WamWord length_word, WamWord after_word, WamWord sub_atom_word) { WamWord word, tag_mask; AtomInf *patom; AtomInf *psub_atom = NULL; /* only for the compiler */ int length; PlLong b, l, a; int b1, l1, a1; Bool nondet; int mask = 0; char *str; patom = pl_atom_tbl + Pl_Rd_Atom_Check(atom_word); length = patom->prop.length; DEREF_LG(before_word, b); DEREF_LG(length_word, l); DEREF_LG(after_word, a); DEREF(sub_atom_word, word, tag_mask); if (tag_mask != TAG_REF_MASK && tag_mask != TAG_ATM_MASK) Pl_Err_Type(pl_type_atom, word); sub_atom_word = word; if (tag_mask == TAG_ATM_MASK) { psub_atom = pl_atom_tbl + UnTag_ATM(word); l = psub_atom->prop.length; if (!Pl_Get_Integer(l, length_word)) return FALSE; if ((mask & 5) == 5 && length != b + l + a) /* B and A fixed */ return FALSE; if (mask & 4) /* B fixed */ { a = length - b - l; return strncmp(patom->name + b, psub_atom->name, l) == 0 && Pl_Get_Integer(a, after_word); } if (mask & 1) /* A fixed */ { b = length - l - a; return strncmp(patom->name + b, psub_atom->name, l) == 0 && Pl_Get_Integer(b, before_word); } mask = 8; /* set sub_atom as fixed */ } switch (mask) /* mask <= 7, B L A (1: fixed, 0: var) */ { case 0: /* nothing fixed */ case 2: /* L fixed */ case 4: /* B fixed */ a = length - b - l; nondet = TRUE; break; case 1: /* A fixed */ l = length - b - a; nondet = TRUE; break; case 3: /* L A fixed */ b = length - l - a; nondet = FALSE; break; case 5: /* B A fixed */ l = length - b - a; nondet = FALSE; break; case 6: /* B L fixed */ case 7: /* B L A fixed */ a = length - b - l; nondet = FALSE; break; default: /* sub_atom fixed */ if ((str = strstr(patom->name + b, psub_atom->name)) == NULL) return FALSE; b = str - patom->name; a = length - b - l; nondet = TRUE; break; } if (b < 0 || l < 0 || a < 0) return FALSE; if (nondet && Compute_Next_BLA(mask, patom, psub_atom, b, l, a, &b1, &l1, &a1)) { /* non deterministic case */ A(0) = before_word; A(1) = length_word; A(2) = after_word; A(3) = sub_atom_word; A(4) = (WamWord) patom; A(5) = (WamWord) psub_atom; A(6) = mask; A(7) = b1; A(8) = l1; A(9) = a1; Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(SUB_ATOM_ALT, 0), 10); } if (mask <= 7) { MALLOC_STR(l); strncpy(str, patom->name + b, l); str[l] = '\0'; Pl_Get_Atom(Create_Malloc_Atom(str), sub_atom_word); Pl_Get_Integer(l, length_word); } return Pl_Get_Integer(b, before_word) && Pl_Get_Integer(a, after_word); }
/*-------------------------------------------------------------------------* * PL_FD_PROLOG_TO_ARRAY_FDV * * * *-------------------------------------------------------------------------*/ WamWord * Pl_Fd_Prolog_To_Array_Fdv(WamWord list_word, Bool pl_var_ok) { WamWord word, tag_mask; WamWord save_list_word; WamWord *lst_adr; int n = 0; WamWord *save_array; WamWord *array; /* compute the length of the list to */ /* reserve space in the heap for the */ /* array before pushing new FD vars. */ save_list_word = list_word; for (;;) { DEREF(list_word, word, tag_mask); if (tag_mask != TAG_LST_MASK) break; lst_adr = UnTag_LST(word); n++; list_word = Cdr(lst_adr); } array = CS; CS = CS + n + 1; list_word = save_list_word; save_array = array; array++; /* +1 for the nb of elems */ for (;;) { DEREF(list_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word == NIL_WORD) break; if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, save_list_word); lst_adr = UnTag_LST(word); *array++ = (WamWord) Pl_Fd_Prolog_To_Fd_Var(Car(lst_adr), pl_var_ok); list_word = Cdr(lst_adr); } *save_array = n; return save_array; }
/*-------------------------------------------------------------------------* * 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; }
/*-------------------------------------------------------------------------* * PL_BLT_FUNCTOR * * * *-------------------------------------------------------------------------*/ Bool FC Pl_Blt_Functor(WamWord term_word, WamWord functor_word, WamWord arity_word) { WamWord word, tag_mask; WamWord *adr; WamWord tag_functor; int arity; Bool res; Pl_Set_C_Bip_Name("functor", 3); DEREF(term_word, word, tag_mask); if (tag_mask != TAG_REF_MASK) { if (tag_mask == TAG_LST_MASK) res = Pl_Un_Atom_Check(ATOM_CHAR('.'), functor_word) && Pl_Un_Integer_Check(2, arity_word); else if (tag_mask == TAG_STC_MASK) { adr = UnTag_STC(word); res = Pl_Un_Atom_Check(Functor(adr), functor_word) && Pl_Un_Integer_Check(Arity(adr), arity_word); } else res = Pl_Unify(word, functor_word) && Pl_Un_Integer_Check(0, arity_word); goto finish; } /* tag_mask == TAG_REF_MASK */ DEREF(functor_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask != TAG_ATM_MASK && tag_mask != TAG_INT_MASK && tag_mask != TAG_FLT_MASK) Pl_Err_Type(pl_type_atomic, functor_word); tag_functor = tag_mask; functor_word = word; arity = Pl_Rd_Positive_Check(arity_word); if (arity > MAX_ARITY) Pl_Err_Representation(pl_representation_max_arity); if (tag_functor == TAG_ATM_MASK && UnTag_ATM(functor_word) == ATOM_CHAR('.') && arity == 2) { res = (Pl_Get_List(term_word)) ? Pl_Unify_Void(2), TRUE : FALSE; goto finish; } if (tag_functor == TAG_ATM_MASK && arity > 0) { res = (Pl_Get_Structure(UnTag_ATM(functor_word), arity, term_word)) ? Pl_Unify_Void(arity), TRUE : FALSE; goto finish; } if (arity != 0) Pl_Err_Type(pl_type_atom, functor_word); res = Pl_Unify(functor_word, term_word); finish: Pl_Unset_C_Bip_Name(); return res; }
/*-------------------------------------------------------------------------* * PL_FD_REIFIED_IN * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Reified_In(WamWord x_word, WamWord l_word, WamWord u_word, WamWord b_word) { WamWord word, tag_mask; WamWord b_tag_mask, x_tag_mask; WamWord *adr, *fdv_adr; int x; int l = Pl_Rd_Integer_Check(l_word); int u = Pl_Rd_Integer_Check(u_word); int b = -1; /* a var */ Range *r; int x_min, x_max; Bool pl_fd_domain(WamWord x_word, WamWord l_word, WamWord u_word); Bool pl_fd_not_domain(WamWord x_word, WamWord l_word, WamWord u_word); DEREF(x_word, word, tag_mask); x_word = word; x_tag_mask = tag_mask; if (tag_mask != TAG_REF_MASK && tag_mask != TAG_FDV_MASK && tag_mask != TAG_INT_MASK) { err_type_fd: Pl_Err_Type(pl_type_fd_variable, word); return FALSE; } DEREF(b_word, word, tag_mask); b_word = word; b_tag_mask = tag_mask; if (tag_mask != TAG_REF_MASK && tag_mask != TAG_FDV_MASK && tag_mask != TAG_INT_MASK) goto err_type_fd; if (x_tag_mask == TAG_INT_MASK) { x = UnTag_INT(x_word); b = (x >= l) && (x <= u); unif_b: return Pl_Get_Integer(b, b_word); } if (b_tag_mask == TAG_INT_MASK) { b = UnTag_INT(b_word); if (b == 0) return pl_fd_not_domain(x_word, l_word, u_word); return (b == 1) && pl_fd_domain(x_word, l_word, u_word); } if (x_tag_mask == TAG_REF_MASK) /* make an FD var */ { adr = UnTag_REF(x_word); fdv_adr = Pl_Fd_New_Variable(); Bind_UV(adr, Tag_REF(fdv_adr)); } else fdv_adr = UnTag_FDV(x_word); r = Range(fdv_adr); x_min = r->min; x_max = r->max; if (x_min >= l && x_max <= u) { b = 1; goto unif_b; } if (l > u || x_max < l || x_min > u) /* NB: if L..U is empty then B = 0 */ { b = 0; goto unif_b; } if (!Pl_Fd_Check_For_Bool_Var(b_word)) return FALSE; PRIM_CSTR_4(pl_truth_x_in_l_u, x_word, l_word, u_word, b_word); return TRUE; }
/*-------------------------------------------------------------------------* * NORMALIZE * * * * This functions normalizes a term. * * Input: * * e_word: term to normalize * * sign : current sign of the term (-1 or +1) * * * * Output: * * p : the associated polynomial term * * * * Normalizes the term and loads it into p. * * Non-Linear operations are simplified and loaded into a stack to be * * executed later. * * * * T1*T2 : T1 and T2 are normalized to give the polynomials p1 and p2, with* * p1 = c1 + a1X1 + a2X2 + ... + anXn * * p2 = c2 + b1X1 + b2X2 + ... + bmXm * * and replaced by c1*c2 + * * a1X1 * c2 + a1X1 * b1X1 + ... + a1X1 * bmXm * * ... * * anX1 * c2 + anXn * b1X1 + ... + anXn * bmXm * * * * T1**T2: T1 and T2 are loaded into 2 new words word1 and word2 that can * * be integers or variables (tagged words). The code emitted * * depends on 3 possibilities (var**var is not allowed) * * (+ optim 1**T2, 0**T2, T1**0, T1**1), NB 0**0=1 * *-------------------------------------------------------------------------*/ static Bool Normalize(WamWord e_word, int sign, Poly *p) { WamWord word, tag_mask; WamWord *adr; WamWord *fdv_adr; WamWord word1, word2, word3; WamWord f_n, le_word, re_word; int i; PlLong n1, n2, n3; terminal_rec: DEREF(e_word, word, tag_mask); if (tag_mask == TAG_FDV_MASK) { fdv_adr = UnTag_FDV(word); Add_Monom(p, sign, 1, Tag_REF(fdv_adr)); return TRUE; } if (tag_mask == TAG_INT_MASK) { n1 = UnTag_INT(word); if (n1 > MAX_COEF_FOR_SORT) sort = TRUE; Add_Cst_To_Poly(p, sign, n1); return TRUE; } if (tag_mask == TAG_REF_MASK) { if (vars_sp - vars_tbl >= VARS_STACK_SIZE) Pl_Err_Resource(pl_resource_too_big_fd_constraint); *vars_sp++ = word; Add_Monom(p, sign, 1, word); return TRUE; } if (tag_mask == TAG_ATM_MASK) { word = Pl_Put_Structure(ATOM_CHAR('/'), 2); Pl_Unify_Value(e_word); Pl_Unify_Integer(0); type_error: Pl_Err_Type(pl_type_fd_evaluable, word); } if (tag_mask != TAG_STC_MASK) goto type_error; adr = UnTag_STC(word); f_n = Functor_And_Arity(adr); for (i = 0; i < NB_OF_OP; i++) if (arith_tbl[i] == f_n) break; le_word = Arg(adr, 0); re_word = Arg(adr, 1); switch (i) { case PLUS_1: e_word = le_word; goto terminal_rec; case PLUS_2: if (!Normalize(le_word, sign, p)) return FALSE; e_word = re_word; goto terminal_rec; case MINUS_2: if (!Normalize(le_word, sign, p)) return FALSE; e_word = re_word; sign = -sign; goto terminal_rec; case MINUS_1: e_word = le_word; sign = -sign; goto terminal_rec; case TIMES_2: #ifdef DEVELOP_TIMES_2 #if 1 /* optimize frequent use: INT*VAR */ DEREF(le_word, word, tag_mask); if (tag_mask != TAG_INT_MASK) goto any; n1 = UnTag_INT(word); if (n1 > MAX_COEF_FOR_SORT) sort = TRUE; DEREF(re_word, word, tag_mask); if (tag_mask != TAG_REF_MASK) { if (tag_mask != TAG_FDV_MASK) goto any; else { fdv_adr = UnTag_FDV(word); word = Tag_REF(fdv_adr); } } Add_Monom(p, sign, n1, word); return TRUE; any: #endif { Poly p1, p2; int i1, i2; New_Poly(p1); New_Poly(p2); if (!Normalize(le_word, 1, &p1) || !Normalize(re_word, 1, &p2)) return FALSE; Add_Cst_To_Poly(p, sign, p1.c * p2.c); for (i1 = 0; i1 < p1.nb_monom; i1++) { Add_Monom(p, sign, p1.m[i1].a * p2.c, p1.m[i1].x_word); for (i2 = 0; i2 < p2.nb_monom; i2++) if (!Add_Multiply_Monom(p, sign, p1.m + i1, p2.m + i2)) return FALSE; } for (i2 = 0; i2 < p2.nb_monom; i2++) Add_Monom(p, sign, p2.m[i2].a * p1.c, p2.m[i2].x_word); return TRUE; } #else if (!Load_Term_Into_Word(le_word, &word1) || !Load_Term_Into_Word(re_word, &word2)) return FALSE; if (Tag_Is_INT(word1)) { n1 = UnTag_INT(word1); if (Tag_Is_INT(word2)) { n2 = UnTag_INT(word2); n1 = n1 * n2; Add_Cst_To_Poly(p, sign, n1); return TRUE; } Add_Monom(p, sign, n1, word2); return TRUE; } if (Tag_Is_INT(word2)) { n2 = UnTag_INT(word2); Add_Monom(p, sign, n2, word1); return TRUE; } word1 = (word1 == word2) ? Push_Delayed_Cstr(DC_X2_EQ_Y, word1, 0, 0) : Push_Delayed_Cstr(DC_XY_EQ_Z, word1, word2, 0); Add_Monom(p, sign, 1, word1); return TRUE; #endif case POWER_2: if (!Load_Term_Into_Word(le_word, &word1) || !Load_Term_Into_Word(re_word, &word2)) return FALSE; if (Tag_Is_INT(word1)) { n1 = UnTag_INT(word1); if (Tag_Is_INT(word2)) { n2 = UnTag_INT(word2); if ((n1 = Pl_Power(n1, n2)) < 0) return FALSE; Add_Cst_To_Poly(p, sign, n1); return TRUE; } if (n1 == 1) { Add_Cst_To_Poly(p, sign, 1); return TRUE; } word = (n1 == 0) ? Push_Delayed_Cstr(DC_ZERO_POWER_N_EQ_Y, word2, 0, 0) : Push_Delayed_Cstr(DC_A_POWER_N_EQ_Y, word1, word2, 0); goto end_power; } if (Tag_Mask_Of(word2) != TAG_INT_MASK) Pl_Err_Instantiation(); else { n2 = UnTag_INT(word2); if (n2 == 0) { Add_Cst_To_Poly(p, sign, 1); return TRUE; } word = (n2 == 1) ? word1 : (n2 == 2) ? Push_Delayed_Cstr(DC_X2_EQ_Y, word1, 0, 0) : Push_Delayed_Cstr(DC_X_POWER_A_EQ_Y, word1, word2, 0); } end_power: Add_Monom(p, sign, 1, word); return TRUE; case MIN_2: if (!Load_Term_Into_Word(le_word, &word1) || !Load_Term_Into_Word(re_word, &word2)) return FALSE; if (Tag_Is_INT(word1)) { n1 = UnTag_INT(word1); if (Tag_Is_INT(word2)) { n2 = UnTag_INT(word2); n1 = math_min(n1, n2); Add_Cst_To_Poly(p, sign, n1); return TRUE; } word = Push_Delayed_Cstr(DC_MIN_X_A_EQ_Z, word2, word1, 0); goto end_min; } if (Tag_Is_INT(word2)) word = Push_Delayed_Cstr(DC_MIN_X_A_EQ_Z, word1, word2, 0); else word = Push_Delayed_Cstr(DC_MIN_X_Y_EQ_Z, word1, word2, 0); end_min: Add_Monom(p, sign, 1, word); return TRUE; case MAX_2: if (!Load_Term_Into_Word(le_word, &word1) || !Load_Term_Into_Word(re_word, &word2)) return FALSE; if (Tag_Is_INT(word1)) { n1 = UnTag_INT(word1); if (Tag_Is_INT(word2)) { n2 = UnTag_INT(word2); n1 = math_max(n1, n2); Add_Cst_To_Poly(p, sign, n1); return TRUE; } word = Push_Delayed_Cstr(DC_MAX_X_A_EQ_Z, word2, word1, 0); goto end_max; } if (Tag_Is_INT(word2)) word = Push_Delayed_Cstr(DC_MAX_X_A_EQ_Z, word1, word2, 0); else word = Push_Delayed_Cstr(DC_MAX_X_Y_EQ_Z, word1, word2, 0); end_max: Add_Monom(p, sign, 1, word); return TRUE; case DIST_2: if (!Load_Term_Into_Word(le_word, &word1) || !Load_Term_Into_Word(re_word, &word2)) return FALSE; if (Tag_Is_INT(word1)) { n1 = UnTag_INT(word1); if (Tag_Is_INT(word2)) { n2 = UnTag_INT(word2); n1 = (n1 >= n2) ? n1 - n2 : n2 - n1; Add_Cst_To_Poly(p, sign, n1); return TRUE; } word = Push_Delayed_Cstr(DC_ABS_X_MINUS_A_EQ_Z, word2, word1, 0); goto end_dist; } if (Tag_Is_INT(word2)) word = Push_Delayed_Cstr(DC_ABS_X_MINUS_A_EQ_Z, word1, word2, 0); else word = Push_Delayed_Cstr(DC_ABS_X_MINUS_Y_EQ_Z, word1, word2, 0); end_dist: Add_Monom(p, sign, 1, word); return TRUE; case QUOT_2: word3 = Make_Self_Ref(H); /* word3 = remainder */ Global_Push(word3); goto quot_rem; case REM_2: word3 = Make_Self_Ref(H); /* word3 = remainder */ Global_Push(word3); goto quot_rem; case QUOT_REM_3: quot_rem: if (!Load_Term_Into_Word(le_word, &word1) || !Load_Term_Into_Word(re_word, &word2) || (i == QUOT_REM_3 && !Load_Term_Into_Word(Arg(adr, 2), &word3))) return FALSE; if (Tag_Is_INT(word1)) { n1 = UnTag_INT(word1); if (Tag_Is_INT(word2)) { n2 = UnTag_INT(word2); if (n2 == 0) return FALSE; n3 = n1 % n2; if (i == QUOT_2 || i == QUOT_REM_3) { if (i == QUOT_REM_3) PRIM_CSTR_2(pl_x_eq_c, word3, word); else H--; /* recover word3 space */ n3 = n1 / n2; } Add_Cst_To_Poly(p, sign, n3); return TRUE; } word = Push_Delayed_Cstr(DC_QUOT_REM_A_Y_R_EQ_Z, word1, word2, word3); goto end_quot_rem; } if (Tag_Is_INT(word2)) word = Push_Delayed_Cstr(DC_QUOT_REM_X_A_R_EQ_Z, word1, word2, word3); else word = Push_Delayed_Cstr(DC_QUOT_REM_X_Y_R_EQ_Z, word1, word2, word3); end_quot_rem: Add_Monom(p, sign, 1, (i == REM_2) ? word3 : word); return TRUE; case DIV_2: if (!Load_Term_Into_Word(le_word, &word1) || !Load_Term_Into_Word(re_word, &word2)) return FALSE; if (Tag_Is_INT(word1)) { n1 = UnTag_INT(word1); if (Tag_Is_INT(word2)) { n2 = UnTag_INT(word2); if (n2 == 0 || n1 % n2 != 0) return FALSE; n1 /= n2; Add_Cst_To_Poly(p, sign, n1); return TRUE; } word = Push_Delayed_Cstr(DC_DIV_A_Y_EQ_Z, word1, word2, 0); goto end_div; } if (Tag_Is_INT(word2)) word = Push_Delayed_Cstr(DC_DIV_X_A_EQ_Z, word1, word2, 0); else word = Push_Delayed_Cstr(DC_DIV_X_Y_EQ_Z, word1, word2, 0); end_div: Add_Monom(p, sign, 1, word); return TRUE; default: word = Pl_Put_Structure(ATOM_CHAR('/'), 2); Pl_Unify_Atom(Functor(adr)); Pl_Unify_Integer(Arity(adr)); goto type_error; } return TRUE; }
/*-------------------------------------------------------------------------* * LOAD_MATH_EXPRESSION * * * *-------------------------------------------------------------------------*/ static WamWord Load_Math_Expression(WamWord exp) { WamWord word, tag_mask; WamWord *adr; WamWord *lst_adr; ArithInf *arith; DEREF(exp, word, tag_mask); if (tag_mask == TAG_INT_MASK || tag_mask == TAG_FLT_MASK) return word; if (tag_mask == TAG_LST_MASK) { lst_adr = UnTag_LST(word); DEREF(Cdr(lst_adr), word, tag_mask); if (word != NIL_WORD) { word = Pl_Put_Structure(ATOM_CHAR('/'), 2); Pl_Unify_Atom(ATOM_CHAR('.')); Pl_Unify_Integer(2); Pl_Err_Type(pl_type_evaluable, word); } DEREF(Car(lst_adr), word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask != TAG_INT_MASK) { Pl_Err_Type(pl_type_integer, word); } return word; } if (tag_mask == TAG_STC_MASK) { adr = UnTag_STC(word); arith = (ArithInf *) Pl_Hash_Find(arith_tbl, Functor_And_Arity(adr)); if (arith == NULL) { word = Pl_Put_Structure(ATOM_CHAR('/'), 2); Pl_Unify_Atom(Functor(adr)); Pl_Unify_Integer(Arity(adr)); Pl_Err_Type(pl_type_evaluable, word); } if (Arity(adr) == 1) return (*(arith->fct)) (Load_Math_Expression(Arg(adr, 0))); return (*(arith->fct)) (Load_Math_Expression(Arg(adr, 0)), Load_Math_Expression(Arg(adr, 1))); } if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask == TAG_ATM_MASK) { word = Pl_Put_Structure(ATOM_CHAR('/'), 2); Pl_Unify_Value(exp); Pl_Unify_Integer(0); /* then type_error */ } Pl_Err_Type(pl_type_evaluable, word); return word; }
/*-------------------------------------------------------------------------* * SIMPLIFY * * * * This function returns the result of the simplified boolean expression * * given in e_word. NOT operators are only applied to variables. * * * * Input: * * sign : current sign of the boolean term (-1 (inside a ~) or +1) * * e_word: boolean term to simplify * * * * Output: * * The returned result is a pointer to a node of the following form: * * * * for binary boolean not operator (~): * * [1]: variable involved (tagged word) * * [0]: operator NOT * * * * for unary boolean operators (<=> ~<=> ==> ~==> /\ ~/\ \/ ~\/): * * [2]: right boolean exp (pointer to node) * * [1]: left boolean exp (pointer to node) * * [0]: operator (EQUIV, NEQUIV, IMPLY, NIMPLY, AND, NAND, OR, NOR) * * * * for boolean false value (0): * * [0]: ZERO * * * * for boolean true value (1): * * [0]: ONE * * * * for boolean variable: * * [0]: tagged word * * * * for binary math operators (= \= < >= > <=) (partial / full AC): * * [2]: right math exp (tagged word) * * [1]: left math exp (tagged word) * * [0]: operator (EQ, NEQ, LT, LTE, EQ_F, NEQ_F, LT_F, LTE_F) * * (GT, GTE, GT_F, and GTE_F becomes LT, LTE, LT_F and LTE_F) * * * * These nodes are stored in a hybrid stack. NB: XOR same as NEQUIV * *-------------------------------------------------------------------------*/ static WamWord * Simplify(int sign, WamWord e_word) { WamWord word, tag_mask; WamWord *adr; WamWord f_n, le_word, re_word; int op, n; WamWord *exp, *sp1; WamWord l, r; #ifdef DEBUG printf("ENTERING %5ld: %2d: ", sp - stack, sign); Pl_Write(e_word); printf("\n"); #endif exp = sp; if (sp - stack > BOOL_STACK_SIZE - 5) Pl_Err_Resource(pl_resource_too_big_fd_constraint); DEREF(e_word, word, tag_mask); if (tag_mask == TAG_REF_MASK || tag_mask == TAG_FDV_MASK) { adr = UnTag_Address(word); if (vars_sp - vars_tbl == VARS_STACK_SIZE) Pl_Err_Resource(pl_resource_too_big_fd_constraint); *vars_sp++ = word; *vars_sp++ = 0; /* bool var */ if (sign != 1) *sp++ = NOT; *sp++ = Tag_REF(adr); return exp; } if (tag_mask == TAG_INT_MASK) { n = UnTag_INT(word); if ((unsigned) n > 1) goto type_error; *sp++ = ZERO + ((sign == 1) ? n : 1 - n); return exp; } if (tag_mask == TAG_ATM_MASK) { word = Pl_Put_Structure(ATOM_CHAR('/'), 2); Pl_Unify_Value(e_word); Pl_Unify_Integer(0); type_error: Pl_Err_Type(pl_type_fd_bool_evaluable, word); } if (tag_mask != TAG_STC_MASK) goto type_error; adr = UnTag_STC(word); f_n = Functor_And_Arity(adr); if (bool_xor == f_n) op = NEQUIV; else { for (op = 0; op < NB_OF_OP; op++) if (bool_tbl[op] == f_n) break; if (op == NB_OF_OP) { word = Pl_Put_Structure(ATOM_CHAR('/'), 2); Pl_Unify_Atom(Functor(adr)); Pl_Unify_Integer(Arity(adr)); goto type_error; } } le_word = Arg(adr, 0); re_word = Arg(adr, 1); if (op == NOT) return Simplify(-sign, le_word); if (sign != 1) op = (op % 2 == EQ % 2) ? op + 1 : op - 1; if (op >= EQ && op <= LTE_F) { Add_Fd_Variables(le_word); Add_Fd_Variables(re_word); n = (op == GT || op == GT_F) ? op - 2 : (op == GTE || op == GTE_F) ? op + 2 : op; *sp++ = n; *sp++ = (n == op) ? le_word : re_word; *sp++ = (n == op) ? re_word : le_word; return exp; } sp += 3; exp[0] = op; exp[1] = (WamWord) Simplify(1, le_word); sp1 = sp; exp[2] = (WamWord) Simplify(1, re_word); l = *(WamWord *) (exp[1]); r = *(WamWord *) (exp[2]); /* NB: beware when calling below Simplify() (while has been just called above) * this can ran into stack overflow (N^2 space complexity). * Try to recover the stack before calling Simplify(). * Other stack recovery are less important (e.g. when only using exp[1]). * * In the following exp[] += sizeof(WamWord) is used to "skip" the NOT * in a simplification (points to the next cell). */ switch (op) { case EQUIV: if (l == ZERO) /* 0 <=> R is ~R */ { sp = exp; return Simplify(-1, re_word); } if (l == ONE) /* 1 <=> R is R */ { return (WamWord *) exp[2]; } if (r == ZERO) /* L <=> 0 is ~L */ { sp = exp; return Simplify(-1, le_word); } if (r == ONE) /* L <=> 1 is L */ { sp = sp1; return (WamWord *) exp[1]; } if (l == NOT) /* ~X <=> R is X <=> ~R */ { exp[1] += sizeof(WamWord); sp = sp1; exp[2] = (WamWord) Simplify(-1, re_word); break; } if (r == NOT) /* L <=> ~X is ~L <=> X */ { /* NB: cannot recover the stack */ exp[1] = (WamWord) Simplify(-1, le_word); exp[2] += sizeof(WamWord); break; } break; case NEQUIV: if (l == ZERO) /* 0 ~<=> R is R */ { return (WamWord *) exp[2]; } if (l == ONE) /* 1 ~<=> R is ~R */ { sp = exp; return Simplify(-1, re_word); } if (r == ZERO) /* L ~<=> 0 is L */ { sp = sp1; return (WamWord *) exp[1]; } if (r == ONE) /* L ~<=> 1 is ~L */ { sp = exp; return Simplify(-1, le_word); } if (l == NOT) /* ~X ~<=> R is X <=> R */ { exp[0] = EQUIV; exp[1] += sizeof(WamWord); break; } if (r == NOT) /* L ~<=> ~X is L <=> X */ { exp[0] = EQUIV; exp[2] += sizeof(WamWord); break; } if (IsVar(l) && !IsVar(r)) /* X ~<=> R is X <=> ~R */ { exp[0] = EQUIV; sp = sp1; exp[2] = (WamWord) Simplify(-1, re_word); break; } if (IsVar(r) && !IsVar(l)) /* L ~<=> X is L <=> ~X */ { exp[0] = EQUIV; /* NB: cannot recover the stack */ exp[1] = (WamWord) Simplify(-1, le_word); break; } break; case IMPLY: if (l == ZERO || r == ONE) /* 0 ==> R is 1 , L ==> 1 is 1 */ { sp = exp; *sp++ = ONE; break; } if (l == ONE) /* 1 ==> R is R */ { return (WamWord *) exp[2]; } if (r == ZERO) /* L ==> 0 is ~L */ return sp = exp, Simplify(-1, le_word); if (l == NOT) /* ~X ==> R is X \/ R */ { exp[0] = OR; exp[1] += sizeof(WamWord); break; } if (r == NOT) /* L ==> ~X is X ==> ~L */ { exp[1] = exp[2] + sizeof(WamWord); exp[2] = (WamWord) Simplify(-1, le_word); break; } break; case NIMPLY: if (l == ZERO || r == ONE) /* 0 ~==> R is 0 , L ~==> 1 is 0 */ { sp = exp; *sp++ = ZERO; break; } if (l == ONE) /* 1 ~==> R is ~R */ { sp = exp; return Simplify(-1, re_word); } if (r == ZERO) /* L ~==> 0 is L */ { sp = sp1; return (WamWord *) exp[1]; } if (l == NOT) /* ~X ~==> R is X ~\/ R */ { exp[0] = NOR; exp[1] += sizeof(WamWord); break; } if (r == NOT) /* L ~==> ~X is L /\ X */ { exp[0] = AND; exp[2] += sizeof(WamWord); break; } break; case AND: if (l == ZERO || r == ZERO) /* 0 /\ R is 0 , L /\ 0 is 0 */ { sp = exp; *sp++ = ZERO; break; } if (l == ONE) /* 1 /\ R is R */ { return (WamWord *) exp[2]; } if (r == ONE) /* L /\ 1 is L */ { sp = sp1; return (WamWord *) exp[1]; } if (l == NOT) /* ~X /\ R is R ~==> X */ { exp[0] = NIMPLY; word = exp[1]; exp[1] = exp[2]; exp[2] = word + sizeof(WamWord); break; } if (r == NOT) /* L /\ ~X is L ~==> X */ { exp[0] = NIMPLY; exp[2] += sizeof(WamWord); break; } break; case NAND: if (l == ZERO || r == ZERO) /* 0 ~/\ R is 1 , L ~/\ 0 is 1 */ { sp = exp; *sp++ = ONE; break; } if (l == ONE) /* 1 ~/\ R is ~R */ { sp = exp; return Simplify(-1, re_word); } if (r == ONE) /* L ~/\ 1 is ~L */ { sp = exp; return Simplify(-1, le_word); } if (l == NOT) /* ~X ~/\ R is R ==> X */ { exp[0] = IMPLY; word = exp[1]; exp[1] = exp[2]; exp[2] = word + sizeof(WamWord); break; } if (r == NOT) /* L ~/\ ~X is L ==> X */ { exp[0] = IMPLY; exp[2] += sizeof(WamWord); break; } break; case OR: if (l == ONE || r == ONE) /* 1 \/ R is 1 , L \/ 1 is 1 */ { sp = exp; *sp++ = ONE; break; } if (l == ZERO) /* 0 \/ R is R */ { return (WamWord *) exp[2]; } if (r == ZERO) /* L \/ 0 is L */ { sp = sp1; return (WamWord *) exp[1]; } if (l == NOT) /* ~X \/ R is X ==> R */ { exp[0] = IMPLY; exp[1] += sizeof(WamWord); break; } if (r == NOT) /* L \/ ~X is X ==> L */ { exp[0] = IMPLY; word = exp[1]; exp[1] = exp[2] + sizeof(WamWord); exp[2] = word; break; } break; case NOR: if (l == ONE || r == ONE) /* 1 ~\/ R is 0 , L ~\/ 1 is 0 */ { sp = exp; *sp++ = ZERO; break; } if (l == ZERO) /* 0 ~\/ R is ~R */ { sp = exp; return Simplify(-1, re_word); } if (r == ZERO) /* L ~\/ 0 is ~L */ { sp = exp; return Simplify(-1, le_word); } if (l == NOT) /* ~X ~\/ R is X ~==> R */ { exp[0] = NIMPLY; exp[1] += sizeof(WamWord); break; } if (r == NOT) /* L ~\/ ~X is X ~==> L */ { exp[0] = NIMPLY; word = exp[1]; exp[1] = exp[2] + sizeof(WamWord); exp[2] = word; break; } break; } return exp; }