1 | #!/usr/local/bin/perl |
---|
2 | ########################################################################### |
---|
3 | # $Id: spSpolyLoop.pl,v 1.2 1998-03-19 16:05:53 obachman Exp $ |
---|
4 | |
---|
5 | ########################################################################### |
---|
6 | ## |
---|
7 | ## FILE: spSpolyLoops.pl |
---|
8 | ## PURPOSE: Generates spSpolyLoop's and spGetSpolyLoop as specified by |
---|
9 | ## variable @input. Writes result to stdout, warning/errors to stderr. |
---|
10 | ## AUTHOR: obachman (3/98) |
---|
11 | ## |
---|
12 | |
---|
13 | |
---|
14 | |
---|
15 | |
---|
16 | ########################################################################### |
---|
17 | ## |
---|
18 | ## Supporting procedures |
---|
19 | ## |
---|
20 | |
---|
21 | sub Warning |
---|
22 | { |
---|
23 | print STDERR $_[0], "\n"; |
---|
24 | } |
---|
25 | |
---|
26 | |
---|
27 | # Each occureence of CALL_<fn>(...) in $string is replaced by |
---|
28 | # `eval fn(..., $argv)'. Modified string is returned. |
---|
29 | sub Expand |
---|
30 | { |
---|
31 | local($string, $argv) = @_; |
---|
32 | local(@lines, @call, $call, $prefix, $postfix, $whitespaces, $result); |
---|
33 | local($i, $j); |
---|
34 | |
---|
35 | @lines = split(/\n/, $_[0]); |
---|
36 | for ($i = 0; $i <= $#lines; $i++) |
---|
37 | { |
---|
38 | if ($lines[$i] =~ /CALL_/) |
---|
39 | { |
---|
40 | ($whitespaces, $prefix, $call, $postfix) = &ParseLine($lines[$i]); |
---|
41 | #insert $argv as last argument to call |
---|
42 | if ($call =~ /\(\s*\)$/) |
---|
43 | { |
---|
44 | $call =~ s/\(\s*\)$/\(\$argv\)/; |
---|
45 | } |
---|
46 | else |
---|
47 | { |
---|
48 | $call =~ s/\)$/\,\$argv\)/; |
---|
49 | } |
---|
50 | $call = "& ".$call.";"; |
---|
51 | $call = eval $call; |
---|
52 | @call = split(/\n/,"$whitespaces$prefix$call$postfix"); |
---|
53 | for ($j=1; $j <= $#call; $j++) |
---|
54 | { |
---|
55 | $call[$j] = $whitespaces.$call[$j]; |
---|
56 | } |
---|
57 | $lines[$i] = join("\n", @call); |
---|
58 | } |
---|
59 | } |
---|
60 | $result = join("\n", @lines); |
---|
61 | if ($call) |
---|
62 | { |
---|
63 | return (&Expand($result)); |
---|
64 | } |
---|
65 | else |
---|
66 | { |
---|
67 | return $result; |
---|
68 | } |
---|
69 | } |
---|
70 | |
---|
71 | # takes a line containing CALL_ apart into and returns |
---|
72 | # ($whitespace, $prefix, $call, $postfix) |
---|
73 | sub ParseLine |
---|
74 | { |
---|
75 | local($line) = @_; |
---|
76 | local($i, $c_start, $c_length, $bcount); |
---|
77 | local($whitespace, $prefix, $call, $postfix); |
---|
78 | |
---|
79 | while(substr($line, $i, 1) =~ /\s/ && $i <= length($line)) |
---|
80 | { |
---|
81 | $whitespace = $whitespace.substr($line, $i, 1); |
---|
82 | $i++; |
---|
83 | } |
---|
84 | |
---|
85 | while(substr($line, $i) !~ /^CALL_/ && $i <= length($line)) |
---|
86 | { |
---|
87 | $prefix = $prefix.substr($line, $i, 1); |
---|
88 | $i++; |
---|
89 | } |
---|
90 | |
---|
91 | $i = $i+5; |
---|
92 | $c_start = $i; |
---|
93 | while(substr($line, $i, 1) ne "(" && $i <= length($line)) |
---|
94 | { |
---|
95 | $i++; |
---|
96 | } |
---|
97 | if (substr($line, $i, 1) eq "(") |
---|
98 | { |
---|
99 | $bcount = 1; |
---|
100 | $i++; |
---|
101 | while ($bcount > 0 && $i <= length($line)) |
---|
102 | { |
---|
103 | if (substr($line, $i, 1) eq ")") |
---|
104 | { |
---|
105 | $bcount--; |
---|
106 | } |
---|
107 | elsif (substr($line, $i, 1) eq "(") |
---|
108 | { |
---|
109 | $bcount++; |
---|
110 | } |
---|
111 | elsif (substr($line, $i, 1) eq "\"") |
---|
112 | { |
---|
113 | $i++; |
---|
114 | while ((substr($line, $i, 1) ne "\"" || |
---|
115 | substr($line, $i-1, 1) eq "\\") && |
---|
116 | $i <= length($line)) |
---|
117 | { |
---|
118 | $i++; |
---|
119 | } |
---|
120 | } |
---|
121 | $i++; |
---|
122 | } |
---|
123 | } |
---|
124 | $call = substr($line, $c_start, $i - $c_start); |
---|
125 | $postfix = substr($line, $i); |
---|
126 | return ($whitespace, $prefix, $call, $postfix); |
---|
127 | } |
---|
128 | |
---|
129 | |
---|
130 | ########################################################################### |
---|
131 | ## |
---|
132 | ## Specification of the properties which determine an spSpolyLoop |
---|
133 | ## |
---|
134 | ## Properties need to have following syntax: propVAL, where prop is |
---|
135 | ## short "prefix" name of properties, and needs to be in lower caps, and |
---|
136 | ## VAL is possible value and needs to be in all upper caps. |
---|
137 | ## |
---|
138 | ## Furthermore, observe the following conventions |
---|
139 | ## @Protperty = ("propGEN", "propVAL1", ...) |
---|
140 | ## $EnumType{prop} = Property |
---|
141 | ## GetProperty($string) should always return a valid value. |
---|
142 | |
---|
143 | ## need to hard-wire properties here, because they are needed in the interface to surrounding C++-code: |
---|
144 | |
---|
145 | @Properties = ("ch", "ot", "hom", "nw"); |
---|
146 | @Characteristics = ("chGEN", "chMODP"); |
---|
147 | $EnumType{"ch"} = "Characteristics"; |
---|
148 | sub GetCharacteristic |
---|
149 | { |
---|
150 | foreach $element (split('_', $_[0])) |
---|
151 | { |
---|
152 | return ($element) if ($element =~ /^ch/ && |
---|
153 | grep(/$element/, @Characteristics)); |
---|
154 | } |
---|
155 | return $Characteristics[0]; |
---|
156 | } |
---|
157 | |
---|
158 | @OrderingTypes = ("otGEN", "otEXP", "otCOMPEXP", "otEXPCOMP"); |
---|
159 | $EnumType{"ot"} = "OrderingTypes"; |
---|
160 | sub GetOrderingType |
---|
161 | { |
---|
162 | foreach $element (split('_', $_[0])) |
---|
163 | { |
---|
164 | return ($element) if ($element =~ /^ot/ && |
---|
165 | grep(/$element/, @OrderingTypes)); |
---|
166 | } |
---|
167 | return $OrderingTypes[0]; |
---|
168 | } |
---|
169 | |
---|
170 | @Homogs = ("homGEN", "homYES"); |
---|
171 | $EnumType{"hom"} = "Homogs"; |
---|
172 | sub GetHomog |
---|
173 | { |
---|
174 | foreach $element (split('_', $_[0])) |
---|
175 | { |
---|
176 | return ($element) if ($element =~ /^hom/ && |
---|
177 | grep(/$element/, @Homogs)); |
---|
178 | } |
---|
179 | return $Homogs[0]; |
---|
180 | } |
---|
181 | |
---|
182 | @NumWords = ("nwGEN", "nwONE", "nwTWO", "nwEVEN", "nwODD"); |
---|
183 | $EnumType{"nw"} = "NumWords"; |
---|
184 | sub GetNumWords |
---|
185 | { |
---|
186 | foreach $element (split('_', $_[0])) |
---|
187 | { |
---|
188 | return ($element) if ($element =~ /^nw/ && |
---|
189 | grep(/$element/, @NumWords)); |
---|
190 | } |
---|
191 | return $NumWords[0]; |
---|
192 | } |
---|
193 | |
---|
194 | # given a list of "short" prefix properties, generate enumeration type |
---|
195 | # specification for each property |
---|
196 | sub Generate_EnumTypes |
---|
197 | { |
---|
198 | local(@evalues, $source); |
---|
199 | |
---|
200 | foreach $key (@_) |
---|
201 | { |
---|
202 | $etype = $EnumType{$key}; |
---|
203 | if ($etype =~ /\w+/) |
---|
204 | { |
---|
205 | @evalues = eval '@'.$etype; |
---|
206 | if ($#evalues >= 0) |
---|
207 | { |
---|
208 | $source = $source."typedef enum $etype {". $evalues[0] . " = 0"; |
---|
209 | shift @evalues; |
---|
210 | foreach $evalue (@evalues) |
---|
211 | { |
---|
212 | $source = $source.", $evalue"; |
---|
213 | } |
---|
214 | $source = $source."} $etype;\n"; |
---|
215 | } |
---|
216 | else |
---|
217 | { |
---|
218 | Warning("No enum values for type: $etype"); |
---|
219 | } |
---|
220 | } |
---|
221 | else |
---|
222 | { |
---|
223 | Warning("Unknown enumeration type index: $key"); |
---|
224 | } |
---|
225 | } |
---|
226 | return $source; |
---|
227 | } |
---|
228 | |
---|
229 | ########################################################################### |
---|
230 | ## |
---|
231 | ## Template of the spSpolyLoop |
---|
232 | ## Is modified by Expand |
---|
233 | ## |
---|
234 | |
---|
235 | $spSpolyLoopBodyTemplate = <<_EOT_ |
---|
236 | (poly a1, poly a2, poly monom, poly spNoether) |
---|
237 | { |
---|
238 | poly a = monom, // collects the result |
---|
239 | b = pNew(), // stores a1*monom |
---|
240 | c; // used for temporary storage |
---|
241 | number tm = pGetCoeff(monom), // coefficient of monom |
---|
242 | tneg = CALL_NCOPYNEG(tm), // - (coefficient of monom) |
---|
243 | tb; // used for tm*coeff(a1) |
---|
244 | |
---|
245 | |
---|
246 | if (a2==NULL) goto Finish; // we are done if a2 is 0 |
---|
247 | |
---|
248 | CALL_PCOPYADDFAST(b, a1, monom); // now a2 != NULL -- set up b |
---|
249 | |
---|
250 | // MAIN LOOP: |
---|
251 | Top: // compare b = monom*a1 and a2 w.r.t. monomial ordering |
---|
252 | register long d; |
---|
253 | CALL_COMPARE(b, a2, d); |
---|
254 | |
---|
255 | Equal: // b equals a2 |
---|
256 | assume(pComp0(b, a2) == 0); |
---|
257 | tb = CALL_NMULT("pGetCoeff(a1)",tm); |
---|
258 | if (!CALL_NEQUAL("pGetCoeff(a2)",tb)) |
---|
259 | { |
---|
260 | pSetCoeff0(a2,CALL_NSUB("pGetCoeff(a2)",tb)); // adjust coeff of a2 |
---|
261 | a = pNext(a) = a2; // append a2 to result and advance a2 |
---|
262 | pIter(a2); |
---|
263 | } |
---|
264 | else |
---|
265 | { // coeffs are equal, so their difference is 0: |
---|
266 | c = a2; // do not append anything to result: Delete a2 and advance |
---|
267 | pIter(a2); |
---|
268 | CALL_NDELETE("&pGetCoeff(c)"); |
---|
269 | pFree1(c); |
---|
270 | } |
---|
271 | CALL_NDELETE("&tb"); |
---|
272 | pIter(a1); |
---|
273 | if (a2 == NULL || a1 == NULL) goto Finish; // are we done ? |
---|
274 | CALL_PCOPYADDFAST(b, a1, monom); // No! So, get new b = a1*monom |
---|
275 | goto Top; |
---|
276 | |
---|
277 | NotEqual: // b != a2 |
---|
278 | if (d < 0) // b < a2: |
---|
279 | { |
---|
280 | assume(pComp0(b, a2) == -1); |
---|
281 | a = pNext(a) = a2;// append a2 to result and advance a2 |
---|
282 | pIter(a2); |
---|
283 | if (a2==NULL) goto Finish;; |
---|
284 | goto Top; |
---|
285 | } |
---|
286 | else // now d >= 0, i.e., b > a2 |
---|
287 | { |
---|
288 | assume(pComp0(b, a2) == 1); |
---|
289 | pSetCoeff0(b,CALL_NMULT("pGetCoeff(a1)",tneg)); |
---|
290 | a = pNext(a) = b; // append b to result and advance a1 |
---|
291 | pIter(a1); |
---|
292 | b = pNew(); |
---|
293 | if (a1 == NULL) goto Finish; // are we done? |
---|
294 | CALL_PCOPYADDFAST(b, a1, monom); // No! So, update b = a1*monom |
---|
295 | goto Top; |
---|
296 | } |
---|
297 | |
---|
298 | Finish: // a1 or a2 is NULL: Clean-up time |
---|
299 | assume(a1 == NULL || a2 == NULL); |
---|
300 | if (a1 == NULL) // append rest of a2 to result |
---|
301 | pNext(a) = a2; |
---|
302 | else // append (- a1*monom) to result |
---|
303 | CALL_MULTCOPYX(a1, monom, a, tneg, spNoether); |
---|
304 | CALL_NDELETE("&tneg"); |
---|
305 | pFree1(b); |
---|
306 | } |
---|
307 | _EOT_ |
---|
308 | ; |
---|
309 | |
---|
310 | ########################################################################### |
---|
311 | ## |
---|
312 | ## "Macros" needed in expansion of spSpolyLoop |
---|
313 | ## |
---|
314 | sub NCOPYNEG |
---|
315 | { |
---|
316 | local($number, $argv) = @_; |
---|
317 | |
---|
318 | return "npNegM($number)" if (GetCharacteristic($argv) eq "chMODP"); |
---|
319 | return "nNeg(nCopy($number))"; |
---|
320 | } |
---|
321 | |
---|
322 | sub NDELETE |
---|
323 | { |
---|
324 | local($number, $argv) = @_; |
---|
325 | |
---|
326 | return "" if (GetCharacteristic($argv) eq "chMODP"); |
---|
327 | return "nDelete($number)"; |
---|
328 | } |
---|
329 | |
---|
330 | sub NMULT |
---|
331 | { |
---|
332 | local($m1, $m2, $argv) = @_; |
---|
333 | |
---|
334 | return "npMultM($m1, $m2)" if (GetCharacteristic($argv) eq "chMODP"); |
---|
335 | return "nMult($m1, $m2)"; |
---|
336 | } |
---|
337 | |
---|
338 | sub NSUB |
---|
339 | { |
---|
340 | local($m1, $m2, $argv) = @_; |
---|
341 | |
---|
342 | return "npSubM($m1, $m2)" if (GetCharacteristic($argv) eq "chMODP"); |
---|
343 | return "nSub($m1, $m2)"; |
---|
344 | } |
---|
345 | |
---|
346 | sub NEQUAL |
---|
347 | { |
---|
348 | local($m1, $m2, $argv) = @_; |
---|
349 | |
---|
350 | return "npEqualM($m1, $m2)" if (GetCharacteristic($argv) eq "chMODP"); |
---|
351 | return "nEqual($m1, $m2)"; |
---|
352 | } |
---|
353 | |
---|
354 | sub MULTCOPYX |
---|
355 | { |
---|
356 | local($p, $monom, $n, $exp, $spNoether, $argv) = @_; |
---|
357 | |
---|
358 | return "spMultCopyX($p, $monom, $n, $exp, $spNoether)" |
---|
359 | if (GetCharacteristic($argv) eq "chMODP"); |
---|
360 | return "spGMultCopyX($p, $monom, $n, $exp, $spNoether)"; |
---|
361 | } |
---|
362 | |
---|
363 | sub PCOPYADDFAST |
---|
364 | { |
---|
365 | return "pCopyAddFast($_[0], $_[1], $_[2])"; |
---|
366 | } |
---|
367 | |
---|
368 | ########################################################################### |
---|
369 | ## |
---|
370 | ## COMPARE "macro": Besides generating th source code which |
---|
371 | ## accomplishes monomial comparisons, it also generates the (global) |
---|
372 | ## string $rargv charcaterising the generated spSpolyLoop |
---|
373 | ## |
---|
374 | sub COMPARE |
---|
375 | { |
---|
376 | local($p1, $p2, $d, $argv) = @_; |
---|
377 | local($ot, $hom, $nw, $res); |
---|
378 | |
---|
379 | $rargv = &GetCharacteristic($argv); |
---|
380 | $ot = &GetOrderingType($argv); |
---|
381 | $rargv = $rargv."_".$ot; |
---|
382 | if ($ot eq "otCOMPEXP" || |
---|
383 | $ot eq "otEXPCOMP" || |
---|
384 | $ot eq "otEXP") |
---|
385 | { |
---|
386 | if ($ot eq "otCOMPEXP") |
---|
387 | { |
---|
388 | $res = "$d = pGetComp($p2) - pGetComp($p1);\n"; |
---|
389 | $res = $res."NonZeroTestA($d, pComponentOrder, goto NotEqual);\n"; |
---|
390 | $ot = "otEXP"; |
---|
391 | } |
---|
392 | $hom = &GetHomog($argv); |
---|
393 | $rargv = $rargv."_".$hom; |
---|
394 | if ($hom ne "homYES") |
---|
395 | { |
---|
396 | $res = $res."$d = pGetOrder($p1) - pGetOrder($p2);\n"; |
---|
397 | $res = $res."NonZeroTestA($d, pOrdSgn, goto NotEqual);\n"; |
---|
398 | } |
---|
399 | $nw = &GetNumWords($argv); |
---|
400 | $rargv = $rargv."_".$nw; |
---|
401 | $res = join("_", $res, pMonComp, $ot, $nw); |
---|
402 | if ($nw eq "nwONE" || $nw eq "nwTWO") |
---|
403 | { |
---|
404 | $res = $res."($p1, $p2, $d, NonZeroA($d, pLexSgn, goto NotEqual ), goto Equal);" |
---|
405 | } |
---|
406 | else |
---|
407 | { |
---|
408 | $res = $res."($p1, $p2, pVariables1W, $d, NonZeroA($d, pLexSgn, goto NotEqual ), goto Equal);"; |
---|
409 | } |
---|
410 | return $res; |
---|
411 | } |
---|
412 | else |
---|
413 | { |
---|
414 | # general ordering type |
---|
415 | return ("if (($d = pComp0($p1, $p2))) goto NotEqual; else goto Equal;"); |
---|
416 | } |
---|
417 | } |
---|
418 | |
---|
419 | |
---|
420 | ########################################################################### |
---|
421 | ## |
---|
422 | ## Generates an spSpolyLoop from a given "$argv" input string, |
---|
423 | ## i.e. property string |
---|
424 | ## |
---|
425 | ## Returns spSpolyLoop and sets global associative array |
---|
426 | ## $loops{$rargv} to generated loop. |
---|
427 | ## |
---|
428 | |
---|
429 | sub Generate_SpolyLoop |
---|
430 | { |
---|
431 | local($argv)= @_; |
---|
432 | local($loopbody); |
---|
433 | |
---|
434 | $loopbody = &Expand($spSpolyLoopBodyTemplate, $argv); |
---|
435 | |
---|
436 | Warning("Can not realize $argv: Changed to $rargv") if ($argv ne $rargv); |
---|
437 | |
---|
438 | if (grep(/$rargv/, keys(%loops))) |
---|
439 | { |
---|
440 | Warning("Duplicate entry $rargv: Ignoring $argv"); |
---|
441 | return; |
---|
442 | } |
---|
443 | else |
---|
444 | { |
---|
445 | $loops{$rargv} = "static void spSpolyLoop_$rargv\n$loopbody\n"; |
---|
446 | return ($loops{$rargv}); |
---|
447 | } |
---|
448 | } |
---|
449 | |
---|
450 | #gnerates SpolyLoops from array of $argv strings |
---|
451 | sub Generate_SpolyLoops |
---|
452 | { |
---|
453 | local(%loops); |
---|
454 | |
---|
455 | foreach $argv (@_) |
---|
456 | { |
---|
457 | Generate_SpolyLoop($argv); |
---|
458 | } |
---|
459 | return (%loops); |
---|
460 | } |
---|
461 | |
---|
462 | ########################################################################### |
---|
463 | ## |
---|
464 | ## Generates array of $argv strings from a given input string by |
---|
465 | ## "orthoganization", i.e. komma-separated entries in input string are |
---|
466 | ## replaced by two argv strings containing the respective entrie. |
---|
467 | ## |
---|
468 | |
---|
469 | sub FlattenInputString |
---|
470 | { |
---|
471 | local($str) = @_; |
---|
472 | |
---|
473 | if ($str =~ /_/) |
---|
474 | { |
---|
475 | local(@parts, $head, @subresults, @result); |
---|
476 | @parts = split(/_/, $str); |
---|
477 | $head = shift(@parts); |
---|
478 | @subresults = &FlattenInputString(join("_", @parts)); |
---|
479 | foreach $part (split(/,/, $head)) |
---|
480 | { |
---|
481 | foreach $subresult (@subresults) |
---|
482 | { |
---|
483 | @result = (@result, $part."_".$subresult); |
---|
484 | } |
---|
485 | } |
---|
486 | return (@result); |
---|
487 | } |
---|
488 | return (split(/,/, $str)); |
---|
489 | } |
---|
490 | |
---|
491 | # generate array of $argv strings from array of input strings |
---|
492 | sub FlattenInput |
---|
493 | { |
---|
494 | local(@result); |
---|
495 | foreach $entry (@_) |
---|
496 | { |
---|
497 | $entry =~ s/\s//; |
---|
498 | @result = (@result, & FlattenInputString($entry)); |
---|
499 | } |
---|
500 | return @result; |
---|
501 | } |
---|
502 | |
---|
503 | |
---|
504 | ########################################################################### |
---|
505 | ## |
---|
506 | ## GetSpolyLoop routines |
---|
507 | ## They all work on valid $argv strings, only. |
---|
508 | ## |
---|
509 | |
---|
510 | ## Given a $prefix and an array of $argv's, return all the "next" |
---|
511 | ## values, i.e. strings deliminted by $prefix and next '_'. |
---|
512 | sub GetNextKeys |
---|
513 | { |
---|
514 | local($prefix, @values, $value); |
---|
515 | |
---|
516 | $prefix = shift(@_); |
---|
517 | $prefix = $prefix."_" unless ($prefix eq ""); |
---|
518 | foreach $element (@_) |
---|
519 | { |
---|
520 | if ($prefix eq "") |
---|
521 | { |
---|
522 | ($value = $element) =~ s/^([a-zA-Z]*)(\w*)/\1/; |
---|
523 | @values = ($value, @values) unless grep(/^$value$/, @values); |
---|
524 | } |
---|
525 | elsif ($element =~ /^$prefix/) |
---|
526 | { |
---|
527 | ($value = $element) =~ s/^($prefix)([a-zA-Z]*)(\w*)/\2/; |
---|
528 | @values = ($value, @values) unless grep(/^$value$/, @values); |
---|
529 | } |
---|
530 | } |
---|
531 | return @values; |
---|
532 | } |
---|
533 | |
---|
534 | # recursively generates "GetSpolyLoop" by working through all $argv's |
---|
535 | # which math $prefix |
---|
536 | # Sets $checks{$prefix}, if $prefix eq $argv |
---|
537 | sub GenerateBody_GetSpolyLoop |
---|
538 | { |
---|
539 | local($prefix, $nextprefix, $source, $newsource, $prop, $curr_prop, $gen_key); |
---|
540 | |
---|
541 | $prefix = shift(@_); |
---|
542 | |
---|
543 | #check for exact match -- then we are done |
---|
544 | if (grep(/^$prefix$/, @_)) |
---|
545 | { |
---|
546 | $checks{$prefix} = "return spSpolyLoop_$prefix;\n"; |
---|
547 | return ($checks{$prefix}); |
---|
548 | } |
---|
549 | |
---|
550 | foreach $key (GetNextKeys($prefix, @_)) |
---|
551 | { |
---|
552 | if ($key =~ /\w+/) |
---|
553 | { |
---|
554 | # get prop, |
---|
555 | ($prop = $key) =~ s/([a-z]*)([A-Z]*)/\1/; |
---|
556 | #check prop against exiting ones |
---|
557 | if ($curr_prop) |
---|
558 | { |
---|
559 | if ($prop ne $curr_prop) |
---|
560 | { |
---|
561 | Warning("Different propes at same level: $prop : $curr_prop"); |
---|
562 | next; |
---|
563 | } |
---|
564 | } |
---|
565 | else |
---|
566 | { |
---|
567 | $curr_prop = $prop; |
---|
568 | } |
---|
569 | # delay handling of "GEN" field |
---|
570 | if ($key =~ /GEN/) |
---|
571 | { |
---|
572 | $gen_key = $key; |
---|
573 | next; |
---|
574 | } |
---|
575 | # let's work recursively |
---|
576 | if ($prefix eq "") |
---|
577 | { |
---|
578 | $nextprefix = $key; |
---|
579 | } |
---|
580 | else |
---|
581 | { |
---|
582 | $nextprefix = $prefix."_".$key; |
---|
583 | } |
---|
584 | $newsource=GenerateBody_GetSpolyLoop($nextprefix,grep(/$nextprefix/,@_)); |
---|
585 | if ($newsource) |
---|
586 | { |
---|
587 | $source = $source."if ($prop == $key)\n{\n".$newsource."}\n"; |
---|
588 | } |
---|
589 | } |
---|
590 | } |
---|
591 | |
---|
592 | # take care of general key, if it exists |
---|
593 | if ($gen_key) |
---|
594 | { |
---|
595 | $gen_key = $prefix."_".$gen_key unless ($prefix eq ""); |
---|
596 | $source = $source . GenerateBody_GetSpolyLoop($gen_key,grep(/$gen_key/,@_)); |
---|
597 | } |
---|
598 | return ($source); |
---|
599 | } |
---|
600 | |
---|
601 | |
---|
602 | sub Generate_GetSpolyLoop |
---|
603 | { |
---|
604 | local($header); |
---|
605 | |
---|
606 | $header = "static spSpolyLoopProc spGetSpolyLoop("; |
---|
607 | |
---|
608 | foreach $key (@Properties) |
---|
609 | { |
---|
610 | $etype = $EnumType{$key}; |
---|
611 | if ($etype =~ /\w+/) |
---|
612 | { |
---|
613 | $header = $header."$etype $key,"; |
---|
614 | } |
---|
615 | } |
---|
616 | chop($header); |
---|
617 | |
---|
618 | return ($header. |
---|
619 | ")\n{\n" . |
---|
620 | GenerateBody_GetSpolyLoop("", @_). |
---|
621 | "return NULL;\n}\n"); |
---|
622 | } |
---|
623 | |
---|
624 | |
---|
625 | ########################################################################### |
---|
626 | ## |
---|
627 | ## Input Specification |
---|
628 | ## |
---|
629 | |
---|
630 | @input = ("chMODP". |
---|
631 | "_otEXP,otCOMPEXP,otEXPCOMP". |
---|
632 | "_homGEN,homYES". |
---|
633 | "_nwONE,nwTWO,nwEVEN,nwODD"); |
---|
634 | |
---|
635 | |
---|
636 | #flatten out input |
---|
637 | @finput = &FlattenInput(@input); |
---|
638 | |
---|
639 | #generate loops |
---|
640 | %loops = & Generate_SpolyLoops(@finput); |
---|
641 | |
---|
642 | # Generate GetSpolyLoop based on generated loops |
---|
643 | $getspolyloop = & Generate_GetSpolyLoop(sort(keys(%loops))); |
---|
644 | |
---|
645 | # Output results |
---|
646 | print & Generate_EnumTypes(@Properties); |
---|
647 | |
---|
648 | foreach $key (sort(keys(%checks))) |
---|
649 | { |
---|
650 | print $loops{$key}; |
---|
651 | } |
---|
652 | |
---|
653 | print $getspolyloop; |
---|
654 | |
---|
655 | |
---|
656 | |
---|
657 | |
---|
658 | |
---|
659 | |
---|
660 | |
---|
661 | |
---|
662 | |
---|
663 | |
---|
664 | |
---|
665 | |
---|
666 | |
---|