My Project
Loading...
Searching...
No Matches
p_Procs_Set.h
Go to the documentation of this file.
1/****************************************
2* Computer Algebra System SINGULAR *
3****************************************/
4/***************************************************************
5 * File: p_Procs_Set.h
6 * Purpose: Procedures for setting p_Procs at run time
7 * Note: this file is included by p_Procs_Dynamic/Static.cc
8 * The macros
9 * DoSetProc(what, field, length, ord)
10 * InitSetProc(field, length ord)
11 * have to be defined before this file is included
12 * Author: obachman (Olaf Bachmann)
13 * Created: 12/00
14 *******************************************************************/
15
16#include "reporter/reporter.h"
17#include "misc/auxiliary.h"
18#ifdef HAVE_SHIFTBBA
19#include "shiftop.h"
20#endif
21
22// extract p_Procs properties from a ring
23static inline p_Field p_FieldIs(ring r)
24{
25 if (rField_is_Zp(r))
26 return FieldZp;
27 if (rField_is_R(r)) return FieldR;
28 if (rField_is_GF(r)) return FieldGF;
29 if (rField_is_Q(r)) return FieldQ;
30#ifdef HAVE_MORE_FIELDS_IMPLEMENTED
31 if (rField_is_long_R(r)) return FieldLong_R;
32 if (rField_is_long_C(r)) return FieldLong_C;
33 if (rField_is_Zp_a(r)) return FieldZp_a;
34 if (rField_is_Q_a(r)) return FieldQ_a;
35#endif
36 if (rField_is_Ring(r)) return RingGeneral;
37 return FieldGeneral;
38}
39
40static inline p_Length p_LengthIs(ring r)
41{
42 assume(r->ExpL_Size > 0);
43 // here is a quick hack to take care of p_MemAddAdjust
44 if (r->NegWeightL_Offset != NULL) return LengthGeneral;
45 if (r->ExpL_Size == 1) return LengthOne;
46 if (r->ExpL_Size == 2) return LengthTwo;
47 if (r->ExpL_Size == 3) return LengthThree;
48 if (r->ExpL_Size == 4) return LengthFour;
49 if (r->ExpL_Size == 5) return LengthFive;
50 if (r->ExpL_Size == 6) return LengthSix;
51 if (r->ExpL_Size == 7) return LengthSeven;
52 if (r->ExpL_Size == 8) return LengthEight;
53 return LengthGeneral;
54}
55
56static inline int p_IsNomog(long* sgn, int l)
57{
58 int i;
59 for (i=0;i<l;i++)
60 if (sgn[i] > 0) return 0;
61
62 return 1;
63}
64
65static inline int p_IsPomog(long* sgn, int l)
66{
67 int i;
68 for (i=0;i<l;i++)
69 if (sgn[i] < 0) return 0;
70 return 1;
71}
72
73static inline p_Ord p_OrdIs(ring r)
74{
75 long* sgn = r->ordsgn;
76 long l = r->ExpL_Size;
77 int zero = 0;
78
79 if (sgn[l-1] == 0)
80 {
81 l--;
82 zero = 1;
83 }
84
85 // we always favour the pomog cases
86 if (p_IsPomog(sgn,l)) return (zero ? OrdPomogZero : OrdPomog);
87 if (p_IsNomog(sgn,l)) return (zero ? OrdNomogZero : OrdNomog);
88
89 assume(l > 1);
90
91 if (sgn[0] == -1 && p_IsPomog(&sgn[1], l-1))
92 return (zero ? OrdNegPomogZero : OrdNegPomog);
93 if (sgn[l-1] == -1 && p_IsPomog(sgn, l-1))
94 return (zero ? OrdPomogNegZero : OrdPomogNeg);
95
96 if (sgn[0] == 1 && p_IsNomog(&sgn[1], l-1))
97 return (zero ? OrdPosNomogZero : OrdPosNomog);
98 if (sgn[l-1] == 1 && p_IsNomog(sgn, l-1))
99 return (zero ? OrdNomogPosZero : OrdNomogPos);
100
101 assume(l > 2);
102
103 if (sgn[0] == 1 && sgn[1] == 1 && p_IsNomog(&sgn[2], l-2))
104 return (zero ? OrdPosPosNomogZero : OrdPosPosNomog);
105
106 if (sgn[0] == 1 && sgn[l-1] == 1 && p_IsNomog(&sgn[1], l-2))
107 return (zero ? OrdPosNomogPosZero : OrdPosNomogPos);
108
109 if (sgn[0] == -1 && sgn[1] == 1 && p_IsNomog(&sgn[2], l-2))
110 return (zero ? OrdNegPosNomogZero : OrdNegPosNomog);
111
112 return OrdGeneral;
113}
114
115// fields of this struct are set by DoSetProc
117
118#ifdef RDEBUG
119// if set, then SetProcs sets only names, instead of functions
121#endif
122
123// (which##_Proc_Ptr)F ->-> cast_vptr_to_A<which##_Proc_Ptr>(F)?
124#define CheckProc(which) \
125do \
126{ \
127 if (p_Procs->which == NULL) \
128 { \
129 dReportBug("p_Procs is NULL"); \
130 WarnS("Singular will work properly, but much slower"); \
131 WarnS("If you chose a coef ring, it may not work at all");\
132 p_Procs->which = (which##_Proc_Ptr)( \
133 which##__FieldGeneral_LengthGeneral_OrdGeneral); \
134 } \
135} \
136while (0);
137
138void nc_p_ProcsSet(ring rGR, p_Procs_s* p_Procs);
139
140// Choose a set of p_Procs
141void p_ProcsSet(ring r, p_Procs_s* p_Procs)
142{
143 p_Field field = p_FieldIs(r);
145 p_Ord ord = p_OrdIs(r);
146
147 assume(p_Procs != NULL);
148 memset(p_Procs, 0, sizeof(p_Procs_s));
149 _p_procs = p_Procs;
150
151 SetProcs(field, length, ord);
152 extern poly p_Mult_nn_pthread(poly p, const number n, const ring r);
153 #ifdef NV_OPS
154 if ((field==FieldZp) && (r->cf->ch>NV_MAX_PRIME))
155 {
156 // set all (mult/div.) routines to FieldGeneral-variants
157 SetProcs(FieldGeneral, length,ord); // p_Mult_nn, ...
158 // set all non-mult/div. routines to FieldZp-variants
159 SetProcs_nv(FieldZp, length,ord); // p_Delete, p_ShallowCopyDelete...
160 }
161 if (field==RingGeneral)
162 {
163 if (nCoeff_is_Domain(r->cf))
165 // FieldGeneral vs. RingGeneral: HAVE_ZERODIVISORS
166 else
168 }
169 #endif
178 CheckProc(pp_Mult_mm_Noether);
182 CheckProc(pp_Mult_Coeff_mm_DivSelectMult);
184 CheckProc(p_kBucketSetLm);
185
186/*
187 assume(p_Procs->pp_Mult_mm_Noether != pp_Mult_mm_Noether__FieldGeneral_LengthGeneral_OrdGeneral ||
188 p_Procs->p_Minus_mm_Mult_qq == p_Minus_mm_Mult_qq__FieldGeneral_LengthGeneral_OrdGeneral ||
189 r->OrdSgn == 1 || r->LexOrder);
190*/
191 {
192 _p_procs->p_mm_Mult=_p_procs->p_Mult_mm;
193 _p_procs->pp_mm_Mult=_p_procs->pp_Mult_mm;
194 }
195#ifdef HAVE_PLURAL
196#ifndef SING_NDEBUG
197 if (rIsPluralRing(r))
198 {
199 dReportError("Setting pProcs in p_ProcsSet (rDebugPrint!?)!!!");
200 nc_p_ProcsSet(r, _p_procs); // Setup non-commutative p_Procs table!
201 }
202#endif
203#endif
204#ifdef HAVE_SHIFTBBA
205 if (r->isLPring)
206 {
207 _p_procs->pp_Mult_mm = shift_pp_Mult_mm;
208 _p_procs->p_Mult_mm = shift_p_Mult_mm;
209 _p_procs->p_mm_Mult = shift_p_mm_Mult;
210 _p_procs->pp_mm_Mult = shift_pp_mm_Mult;
211 _p_procs->p_Minus_mm_Mult_qq = shift_p_Minus_mm_Mult_qq;
212 // Unsupported procs:
213 _p_procs->pp_Mult_mm_Noether = shift_pp_Mult_mm_Noether_STUB;
214 _p_procs->pp_Mult_Coeff_mm_DivSelect = shift_pp_Mult_Coeff_mm_DivSelect_STUB;
215 _p_procs->pp_Mult_Coeff_mm_DivSelectMult = shift_pp_Mult_Coeff_mm_DivSelectMult_STUB;
216 }
217#endif
218}
219
220#ifdef RDEBUG
221void p_Debug_GetSpecNames(const ring r, const char* &field, const char* &length, const char* &ord)
222{
223 /*p_Field e_field =*/ (void) p_FieldIs(r);
224 /*p_Length e_length =*/ (void) p_LengthIs(r);
225 /*p_Ord e_ord =*/ (void) p_OrdIs(r);
226
229 ord = p_OrdEnum_2_String(p_OrdIs(r));
230}
231
232void p_Debug_GetProcNames(const ring r, p_Procs_s* p_Procs)
233{
234 set_names = 1;
235 p_ProcsSet(r, p_Procs); // changes p_Procs!!!
236 set_names = 0;
237}
238#endif // RDEBUG
int sgn(const Rational &a)
Definition GMPrat.cc:430
All the auxiliary stuff.
int l
Definition cfEzgcd.cc:100
int i
Definition cfEzgcd.cc:132
int p
Definition cfModGcd.cc:4086
static FORCE_INLINE BOOLEAN nCoeff_is_Domain(const coeffs r)
returns TRUE, if r is a field or r has no zero divisors (i.e is a domain)
Definition coeffs.h:734
#define STATIC_VAR
Definition globaldefs.h:7
static BOOLEAN length(leftv result, leftv arg)
Definition interval.cc:257
#define assume(x)
Definition mod2.h:389
int dReportError(const char *fmt,...)
Definition dError.cc:44
#define NV_MAX_PRIME
Definition modulop.h:37
#define NULL
Definition omList.c:12
p_Length
@ LengthFive
@ LengthFour
@ LengthThree
@ LengthEight
@ LengthSix
@ LengthGeneral
@ LengthOne
@ LengthSeven
@ LengthTwo
p_Field
@ FieldQ
@ FieldZp
@ RingGeneral
@ FieldZp_a
@ FieldQ_a
@ FieldLong_R
@ FieldLong_C
@ FieldR
@ FieldGeneral
@ FieldGF
static const char * p_FieldEnum_2_String(p_Field field)
#define SetProcs_ring(field, length, ord)
p_Ord
@ OrdNomogZero
@ OrdPomogNegZero
@ OrdPosNomog
@ OrdNegPomogZero
@ OrdPosNomogPosZero
@ OrdNegPomog
@ OrdPomogNeg
@ OrdPomog
@ OrdPosNomogZero
@ OrdPosPosNomogZero
@ OrdPosNomogPos
@ OrdGeneral
@ OrdNomog
@ OrdNegPosNomogZero
@ OrdNomogPos
@ OrdPomogZero
@ OrdPosPosNomog
@ OrdNegPosNomog
@ OrdNomogPosZero
#define SetProcs(field, length, ord)
static const char * p_OrdEnum_2_String(p_Ord ord)
static const char * p_LengthEnum_2_String(p_Length length)
static int p_IsPomog(long *sgn, int l)
Definition p_Procs_Set.h:65
static p_Length p_LengthIs(ring r)
Definition p_Procs_Set.h:40
static p_Ord p_OrdIs(ring r)
Definition p_Procs_Set.h:73
void nc_p_ProcsSet(ring rGR, p_Procs_s *p_Procs)
static int p_IsNomog(long *sgn, int l)
Definition p_Procs_Set.h:56
STATIC_VAR int set_names
void p_ProcsSet(ring r, p_Procs_s *p_Procs)
#define CheckProc(which)
STATIC_VAR p_Procs_s * _p_procs
void p_Debug_GetProcNames(const ring r, p_Procs_s *p_Procs)
void p_Debug_GetSpecNames(const ring r, const char *&field, const char *&length, const char *&ord)
static p_Field p_FieldIs(ring r)
Definition p_Procs_Set.h:23
static poly p_Neg(poly p, const ring r)
Definition p_polys.h:1109
static poly p_Add_q(poly p, poly q, const ring r)
Definition p_polys.h:938
static poly pp_Mult_mm(poly p, poly m, const ring r)
Definition p_polys.h:1033
static poly p_Merge_q(poly p, poly q, const ring r)
Definition p_polys.h:1228
static poly pp_Mult_nn(poly p, number n, const ring r)
Definition p_polys.h:994
static poly p_ShallowCopyDelete(poly p, const ring r, omBin bin)
Definition p_polys.h:930
static poly p_Mult_nn(poly p, number n, const ring r)
Definition p_polys.h:960
static void p_Delete(poly *p, const ring r)
Definition p_polys.h:903
static poly p_Mult_mm(poly p, poly m, const ring r)
Definition p_polys.h:1053
static poly p_Minus_mm_Mult_qq(poly p, const poly m, const poly q, int &lp, int lq, const poly spNoether, const ring r)
Definition p_polys.h:1072
static poly pp_Mult_Coeff_mm_DivSelect(poly p, const poly m, const ring r)
Definition p_polys.h:1092
static poly p_Copy(poly p, const ring r)
returns a copy of p
Definition p_polys.h:848
static BOOLEAN rField_is_R(const ring r)
Definition ring.h:524
static BOOLEAN rField_is_Zp_a(const ring r)
Definition ring.h:535
static BOOLEAN rField_is_Zp(const ring r)
Definition ring.h:506
struct p_Procs_s p_Procs_s
Definition ring.h:24
static BOOLEAN rIsPluralRing(const ring r)
we must always have this test!
Definition ring.h:406
static BOOLEAN rField_is_long_C(const ring r)
Definition ring.h:551
static BOOLEAN rField_is_Q_a(const ring r)
Definition ring.h:545
static BOOLEAN rField_is_Q(const ring r)
Definition ring.h:512
static BOOLEAN rField_is_long_R(const ring r)
Definition ring.h:548
static BOOLEAN rField_is_GF(const ring r)
Definition ring.h:527
#define rField_is_Ring(R)
Definition ring.h:491
poly shift_pp_Mult_Coeff_mm_DivSelect_STUB(poly, const poly, int &, const ring)
Definition shiftop.cc:319
poly shift_p_Minus_mm_Mult_qq(poly p, poly m, poly q, int &Shorter, const poly, const ring ri)
Definition shiftop.cc:269
poly shift_pp_mm_Mult(poly p, const poly m, const ring ri)
Definition shiftop.cc:145
poly shift_pp_Mult_mm_Noether_STUB(poly p, const poly m, const poly, int &ll, const ring ri)
Definition shiftop.cc:288
poly shift_p_mm_Mult(poly p, const poly m, const ring ri)
Definition shiftop.cc:212
poly shift_p_Mult_mm(poly p, const poly m, const ring ri)
Definition shiftop.cc:89
poly shift_pp_Mult_mm(poly p, const poly m, const ring ri)
Definition shiftop.cc:21
poly shift_pp_Mult_Coeff_mm_DivSelectMult_STUB(poly, const poly, const poly, const poly, int &, const ring)
Definition shiftop.cc:313